public
Last active

GraphPlotHighlight: A modification of Mathematica's GraphPlot -- An attempted answer to http://stackoverflow.com/q/4091728/421225

  • Download Gist
GraphPlotHighlight
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
Needs["GraphUtilities`"];
 
Clear[GraphPlotHighlight]
 
Protect[HighlightColor, HighlightThickness];
Options[GraphPlotHighlight] = Join[Options[GraphPlot],
{HighlightColor -> LightBlue, HighlightThickness -> .15}];
 
GraphPlotHighlight[edges:{((_ -> _) | (List|Tooltip)[_ -> _, _])..},
hl:{___}:{}, opts:OptionsPattern[]] :=
Module[{coords, HLcoords, Ncoords, verts, vpos},
verts = VertexList[edges /. Tooltip -> List];
coords =
GraphCoordinates[edges,
FilterRules[Options[GraphPlotHighlight], Options[GraphPlot]],
FilterRules[{opts}, Options[GraphPlot]]];
vpos = Position[verts, Alternatives @@ hl];
HLcoords = Extract[coords, vpos];
Ncoords = Complement[coords, HLcoords];
AppendTo[HLcoords, First[HLcoords] + .002];
Show[ (* draw the background highlighting *)
Graphics[{OptionValue[HighlightColor], CapForm["Round"],
JoinForm["Round"],
Thickness[OptionValue[HighlightThickness]], Line[HLcoords],
Polygon[HLcoords],
(* sometimes the above draws over a non-
selected vertex... so here's a quick "fix" *)
OptionValue[Background] /. None -> White,
Disk[#, 1.4 OptionValue[HighlightThickness]] & /@ Ncoords}],
(* Finally draw the graph *)
GraphPlot[edges, VertexCoordinateRules -> Thread[verts -> coords],
FilterRules[{opts}, Options[GraphPlot]],
FilterRules[Options[GraphPlotHighlight], Options[GraphPlot]]]]]
 
 
(* A simple example where the highlight goes over a non-highlighted vertex *)
 
SetOptions[GraphPlotHighlight, VertexLabeling -> True,
HighlightColor -> LightRed, HighlightThickness -> .1,
VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .08], Black,
Text[#2, #1]} &), Method -> "SpringElectricalEmbedding"];
 
GraphPlotHighlight[{b -> c, a -> b, c -> a, e -> c, {f -> c, "f\[Rule]c"},
Tooltip[d -> b, "d\[Rule]b"], e -> a}, {b, d, e}]
 
 
(* Yaroslav's example *)
 
SetOptions[GraphPlotHighlight,
VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .15], Black,
Text[#2, #1]} &), EdgeRenderingFunction -> ({Black, Line[#]} &)];
 
edges = GraphData[{"Grid", {3, 3}}, "EdgeRules"];
colors = {LightBlue, LightGreen, LightRed, LightMagenta};
vsets = {{8, 5, 2}, {7, 5, 8}, {9, 6, 3}, {8, 1, 2}};
MapThread[GraphPlotHighlight[edges, #1, HighlightColor -> #2] &, {vsets, colors}]

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.