Bug introduced in 9.0 or earlier and fixed in 11.3
HighlightGraph does not work.
HighlightGraph[Graph[{{0, 0}, {0, 1}, {1, 0}, {1, 1}}, {{0, 0} \[UndirectedEdge] {0, 1}}], {{0, 0}, {0, 1}}]
In Mathematica 9 I see:
Mathematica Stack Exchange is a question and answer site for users of Wolfram Mathematica. It only takes a minute to sign up.
Sign up to join this communityBug introduced in 9.0 or earlier and fixed in 11.3
HighlightGraph does not work.
HighlightGraph[Graph[{{0, 0}, {0, 1}, {1, 0}, {1, 1}}, {{0, 0} \[UndirectedEdge] {0, 1}}], {{0, 0}, {0, 1}}]
In Mathematica 9 I see:
We can reproduce the problem in a simpler example:
g = Graph[{{1}, {2}}, {{1} <-> {2}}]
HighlightGraph[g, {{1}, {2}}]
HighlightGraph
invokes the function GraphComputation`GraphHighlightDump`vertexEdgeExtract
to get the list of vertices and edges to be highlighted. For the example above, this function returns {1,2}
as the list of vertices to be highlighted,
GraphComputation`GraphHighlightDump`vertexEdgeExtract[{{1}, {2}}, g]
{{1, 2}, {}}
not {{1},{2}}
. Since 1
and 2
are not in VertexList[g]
nothing is highlighted.
The culprit lies deeper in a function called by GraphComputation`GraphHighlightDump`vertexEdgeExtract
, namely, in the function GraphComputation`GraphHighlightDump`veExtract
. The code for this function is
GraphComputation`GraphHighlightDump`veExtract[
GraphComputation`GraphHighlightDump`set_,
GraphComputation`GraphHighlightDump`g_,
GraphComputation`GraphHighlightDump`vbag_,
GraphComputation`GraphHighlightDump`ebag_] /;
VertexQ[GraphComputation`GraphHighlightDump`g,
GraphComputation`GraphHighlightDump`set] :=
Internal`StuffBag[GraphComputation`GraphHighlightDump`vbag,
GraphComputation`GraphHighlightDump`set, 1]
If we remove the 1
in the last line, i.e., change the definition of veExtract
to
GraphComputation`GraphHighlightDump`veExtract[
GraphComputation`GraphHighlightDump`set_,
GraphComputation`GraphHighlightDump`g_,
GraphComputation`GraphHighlightDump`vbag_,
GraphComputation`GraphHighlightDump`ebag_] /;
VertexQ[GraphComputation`GraphHighlightDump`g,
GraphComputation`GraphHighlightDump`set] :=
Internal`StuffBag[GraphComputation`GraphHighlightDump`vbag,
GraphComputation`GraphHighlightDump`set]
then we get the correct vertex list to be highlighted:
GraphComputation`GraphHighlightDump`vertexEdgeExtract[{{1}, {2}}, g]
{{{1}, {2}}, {}}
TO DO: I couldn't figure out how/where to make the appropriate changes to get HighlightGraph
working as expected.
Notes: An example to see how the third argument of Internal`StuffBag
is working:
bag1 = Internal`Bag[];
bag2 = Internal`Bag[];
Internal`StuffBag[bag1, #, 1] & /@ {{1}, {2}};
Internal`StuffBag[bag2, #] & /@ {{1}, {2}};
Internal`BagPart[bag1, All]
{1, 2}
Internal`BagPart[bag2, All]
{{1}, {2}}
In[7]:= GraphComputation`GraphHighlightDump`vertexEdgeExtract[{{1}, {2}}, g] Out[7]= {{{1}, {2}}, {}}
$\endgroup$
This is clearly a bug, which appears when the the vertex names are lists. You should report it to Wolfram Support: http://support.wolfram.com/
I can reproduce it with version 10.4.1.
Proof that lists as vertex names are reasonable: some functions return such graphs. Example:
pts = RandomInteger[{1, 5}, {10, 2}];
g = NearestNeighborGraph[pts]
VertexList[g]
(* {{2, 5}, {5, 2}, {5, 5}, {4, 5}, {3, 3}, {5, 1}, {1, 3}} *)
HighlightGraph[g, Take[pts, 2]] (* Doesn't highlight *)
HighlightGraph[g, {Take[pts, 2]}] (* Also doesn't highlight, even though this syntax is unambiguous *)
Okay, forget what I wrote in the other post. It took quite a while but I think I finally found the bug. That would not have been possible without the great spelunking tool PrintDefinition
. The issue is within the function GraphComputation`GraphHighlightDump`setHighlight
:
Needs["GeneralUtilities`"]
HighlightGraph;
PrintDefinitions[GraphComputation`GraphHighlightDump`setHighlight];
setHighlight[g_, i_] /; VertexQ[g, i] :=
(PropertyValue[{g, i}, GraphHighlight] = True;);
setHighlight[g_, i_List] := Scan[setHighlight[g, #1] &, i]; setHighlight[g_, i_] /; EdgeQ[g, i] :=
(PropertyValue[{g, i}, GraphHighlight] = True;);
Attributes[setHighlightProperties] := {HoldAll};
Let's consider kglr's toy model:
g = Graph[{{1}, {2}}, {{1} <-> {2}}];
data = {{1}, {2}};
HighlightGraph[g, data]
After calling HighlightMesh[g,data]
(after traveling through a maze of calls to many other functions), we arrive at the call setHighlight[g_, {{{1},{2}},{}}]
(here, {}
represents the empty set of edges to be highlighted).
This activates the second SetDelayed
for setHighlight
and so we start to scan through the set {{{1},{2}},{}}
.
At some instance, we arrive at the call
PropertyValue[{g, {1}}, GraphHighlight] = True
and although there is no error message, it fails. We also cannot retrieve any property values with PropertyValue[{g, {1}}, <prop>]
, even if we try to set them beforehand (e.g. with the VertexLabel
option). So, this is pretty broken. Note that PropertyValue
is a kernel function and we can do nothing about it. However, we can prevent that these calls are made by making the following redefinition which has essentially the same effect (modulo a deep copy of the graph). So, this is my proposition for a fix:
Unprotect[HighlightGraph];
HighlightGraph =.
HighlightGraph := (
System`Dump`AutoLoad[
Hold[HighlightGraph],
Hold[HighlightGraph],
"Network`GraphHighlight`"
] /; System`Dump`TestLoad;
GraphComputation`GraphHighlightDump`setHighlight[g_, i_] /;
VertexQ[g, i] := Block[{gh},
gh = GraphHighlight /. Options[g];
If[Length[gh] == 0, gh = {}];
(*This is a very slow workaround, only meant as fallback.
Should be avoided at all cost!*)
g = Graph[g, GraphHighlight -> Join[gh, {i}]];
];
GraphComputation`GraphHighlightDump`setHighlight[g_, i_List] :=
Block[{gh},
With[{vlist = Select[i, VertexQ[g, #] &]},
gh = GraphHighlight /. Options[g];
If[Length[gh] == 0, gh = {}];
(*This enforces a deep copy (?) of the graph but does it only once for all vertices detected.*)
g = Graph[g, GraphHighlight -> Join[gh, vlist]];
(*Proceed as usual for all remaining data.*)
Scan[
GraphComputation`GraphHighlightDump`setHighlight[g, #] &,
Complement[i, vlist]
];
]
];
GraphComputation`GraphHighlightDump`setHighlight[
g_,
GraphComputation`GraphHighlightDump`iSubgraph[v_, e_]
] := (
(*Parse vertex and edge list; do not use Scan in order to avoid the call to setHighlight[g, i]/;VertexQ[g,i]:=...*)
GraphComputation`GraphHighlightDump`setHighlight[g, Join[v, e]]
);
GraphComputation`GraphHighlightDump`setGroupProperty[g_, i_, color_] /; VertexQ[g, i] := Block[{gh, style},
{gh, style} = {GraphHighlight, GraphHighlightStyle} /. Options[g];
If[Length[gh] == 0, gh = {}];
If[Length[style] == 0, style = {}];
(*This is a very slow workaround, only meant as fallback. Should be avoided at all cost!*)
g = Graph[g,
GraphHighlight -> Join[gh, {i}],
GraphHighlightStyle ->
Join[style, {i -> {VertexStyle -> color}}];
];];
GraphComputation`GraphHighlightDump`setGroupProperty[g_, i_List, color_] := Block[{gh, style},
With[{vlist = Select[i, VertexQ[g, #] &]},
{gh, style} = {GraphHighlight, GraphHighlightStyle} /. Options[g];
If[Length[gh] == 0, gh = {}];
If[Length[style] == 0, style = {}];
(*This enforces a deep copy (?) of the graph but does it only once for all vertices detected.*)
g = Graph[g,
GraphHighlight -> Join[gh, vlist],
GraphHighlightStyle ->
Join[style, Table[j -> {VertexStyle -> color}, {j, vlist}]]
];
(*Proceed as usual for all remaining data.*)
Scan[
GraphComputation`GraphHighlightDump`setGroupProperty[g, #, color] &,
Complement[i, vlist]
];
]
];
GraphComputation`GraphHighlightDump`setGroupProperty[
g_,
GraphComputation`GraphHighlightDump`iSubgraph[v_, e_],
color_
] := (
(*Parse vertex and edge list; do not use Scan in order to avoid the call to setGroupProperty[g,i]/;VertexQ[g,i]:=...*)
GraphComputation`GraphHighlightDump`setGroupProperty[g, Join[v, e], color]
);
(*Making sure that kglr's bugfix is available in older versions, too.*)
GraphComputation`GraphHighlightDump`veExtract[set_, g_, vbag_, ebag_] /; VertexQ[g, set] := (
Internal`StuffBag[vbag, set]
);
(*Not sure whether this is set correctly in older version.*)
GraphComputation`GraphHighlightDump`veExtract[
GraphComputation`GraphHighlightDump`iSubgraph[v_, e_], g_, vbag_, ebag_] := (
Internal`StuffBag[ebag, e, 1];
Internal`StuffBag[vbag, v, 1]
);
HighlightGraph
);
Protect[HighlightGraph];
This seems to work, at least for the examples from the other post. Note that I am using version MMA 11.0.1 and that this version does not contain the bug in veExtract
that kglr found.
Of course, one can enforce to break it by introducing ambiguities like these:
g = Graph[{1, 2, {1, 2}, {{1, 2}}}, {UndirectedEdge[1, 2],
UndirectedEdge[1, {1, 2}]}, VertexLabels -> "Name"];
HighlightGraph[g, {{{1, 2}}, 1, 2, UndirectedEdge[1, 2]}]
So, introducing a Vertex
primitive might still be a good idea.
Improvements and suggestions are welcome!
Update
{1}
and not 1
is the only vertex to
be highlighted.Subgraph
.setGroupProperty
in order to fix the issue for lists of list.Here is a demonstration of the newest changes:
n = 24;
m = Floor[n/3];
SeedRandom[123];
H = RandomGraph[{n, 2 n}, VertexLabels -> "Name"];
rules = Normal@AssociationThread[Transpose[{Range[n]}], Range[n]];
G = VertexReplace[H, Reverse /@ rules]; // AbsoluteTiming
v1 = DeleteDuplicates@RandomChoice[VertexList[G], m];
v2 = Complement[DeleteDuplicates@RandomChoice[VertexList[G], m], v1];
HighlightGraph[G, {Subgraph[G, v1], Subgraph[G, v2]}]
The original version leads to:
And the fixed version from above produces:
I am afraid, the only unambiguous solution would be to introduce a keyword for vertices, e.g. Vertex
. Compare that to the need for Key
when addressing associations whose keys contain integers. Let's see what we can do.
Fortunately, HighlightGraph
is Protected
and ReadProtected
but not Locked
, so we can mess around with it. We can see the code with
Needs["GeneralUtilities`"]
PrintDefinitions[HighlightGraph];
Warning
People who have the tendency to get nervous when unprotecting symbols: Stop. Reading. Now.
The code
For some weird reason I had to Clear
HighlightGraph
first, in order to overwrite its definitions. Here is what I do:
Vertex::usage =
"\!\(Vertex[\*
StyleBox[\"vertex\", \"TI\"]]\) represents a \
vertex used to access vertices in a graph.";
Protect[Vertex];
HighlightGraph;
Unprotect[HighlightGraph];
ClearAttributes[HighlightGraph, ReadProtected];
Clear[HighlightGraph];
Begin["GraphComputation`GraphHighlightDump`"];
HighlightGraph[graph_, None, opts : OptionsPattern[]] :=
HighlightGraph[graph, {}, opts];
HighlightGraph[graph_?GraphQ, {}, opts : OptionsPattern[]] :=
Block[{res}, res = Flatten[{opts}];
GraphComputation`CloneGraph[GraphComputation`GraphHighlightDump`graph, res]
];
HighlightGraph[e_List, {}, opts : OptionsPattern[]] :=
Block[{res, graph},
graph = Graph[e];
(
res = Flatten[{opts}];
GraphComputation`CloneGraph[graph, res]
) /; GraphQ[graph]];
HighlightGraph[graph_?GraphQ, data_, opts : OptionsPattern[]] :=
Block[{res, nopts, dopts, n, vertexlookup, vertexreverselookup,
edgelookup, edgereverselookup, g, h, gdata},
nopts = FilterRules[Flatten[{opts}], Options[HighlightGraph]];
dopts = Complement[Options[HighlightGraph], Options[Graph]];
If[dopts =!= {}, nopts = Join[nopts, dopts]];
res = If[FirstPosition[data, Vertex] === Missing["NotFound"],
GraphComputation`GraphHighlightDump`highlightGraph[graph, data, nopts]
,
n = VertexCount[graph];
vertexlookup = AssociationThread[VertexList[graph], Range[n]];
vertexreverselookup =
AssociationThread[Range[n], VertexList[graph]];
With[{edges = EdgeList[graph] /. vertexlookup},
edgelookup = AssociationThread[EdgeList[graph], edges];
edgereverselookup = AssociationThread[edges, EdgeList[graph]];
];
g = AdjacencyGraph[AdjacencyMatrix[graph]];
gdata = data /. KeyMap[Vertex, vertexlookup] /. edgelookup;
h = GraphComputation`GraphHighlightDump`highlightGraph[g, gdata, nopts];
Graph[graph,
Join[{GraphHighlight -> (GraphHighlight /. Options[h] /. vertexreverselookup)},
FilterRules[Options[h], Except[GraphHighlight]]]]
];
res /; res =!= $Failed];
HighlightGraph[e_List, data_, opts : OptionsPattern[]] :=
Block[{res, h, nopts, dopts, vlist, elist, graph},
graph = Graph[e];
(
res = HighlightGraph[graph, data, opts];
res /; res =!= $Failed
) /; GraphQ[graph]]
HighlightGraph[expr___] := (messageHighlightGraph[expr]; Null /; False);
End[];
Protect[HighlightGraph];
The main SetDelayed
is the one which is defined for the pattern HighlightGraph[graph_?GraphQ, data_, opts : OptionsPattern[]]
. This is where we try to slip in. What I do is the following: The original HighlightMesh
has no problems with integer vertices. So, I merely replace all the vertices by integers (that's where we need the wrapper Vertex
around vertices appearing in data
. Afterwards I run the usual backend of HighlightGraph
, grab the options of its output, transform that back to the original vertices and append it to the original graph. That's it.
Some examples
A usage example for the OP's example:
graph = Graph[{{0, 0}, {0, 1}, {1, 0}, {1, 1}}, {{0, 0} <-> {0, 1}},
VertexLabels -> "Name"];
HighlightGraph[graph, {Vertex /@ {{0, 0}, {0, 1}}}]
And for kglr's example:
g = Graph[{{1}, {2}}, {{1} <-> {2}}];
HighlightGraph[g, Vertex /@ {{1}, {2}}]
Apart from that, I haven't tested it too thoroughly. Maybe this won't work in all cases or break something else. So, better not run any nukular power plant with it. And maybe this is not very performant (quite many replacements that have to be made).
Edit
Added detection for occurence of the symbol Vertex
. If not found, the standard implementation is used.
HighlightGraph[g, {1,2}]
and even HighlightGraph[g, {{1,2}}]
are ambiguous (is {1,2}
a vertex or a list of vertices?), HighlightGraph[g, {{{1,2}}}]
is unambiguous. I actually didn't realize that this syntax is not documented: HighlightGraph[CycleGraph[10], {{1, 2, 3}, {4, 5, 6}}]
. The situation is a bit similar to Extract
: in Extract[list, 1]
, 1
is an index. In Extract[list, {1,2}]
we have a single position spec instead of two indices. in Extract[list, {{1,2},{1,3}}]
we have two position specs.
$\endgroup$
List
). It should be possible to disambiguate these by providing a list of lists of objects as the second argument of HighlightGraph
.
$\endgroup$
Faced the same issue on Mathematica 11.0
Workaround started with @ZYX's comment extended to PathGraph too for DirectedEdges
. However this can be further extended for Optional Parameters
HighlightGraphR[g_, vertices_] := Block[{vt, gt},
vt = ToString /@ vertices;
gt = VertexReplace[g, Thread[VertexList[g] -> ToString /@ VertexList[g]]];
HighlightGraph[gt, PathGraph[vt, DirectedEdges->True]]
]
HighlightGraphR[g, v];
HighlightGraphR[g_, vertices_] := HighlightGraph[ VertexReplace[g, Thread[VertexList[g] -> ToString /@ VertexList[g] ]], ToString /@ vertices]
$\endgroup$HighlightGraph[Graph[{{1}, {2}}, {{1} <-> {2}}], {{1}, {2}}]
$\endgroup$