Mathematica Asked by ZYX on March 26, 2021
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:
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 *)
Answered by Szabolcs on March 26, 2021
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}}
Answered by kglr on March 26, 2021
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];
Answered by Neel Basu on March 26, 2021
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.
Answered by Henrik Schumacher on March 26, 2021
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:
Answered by Henrik Schumacher on March 26, 2021
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP