20
$\begingroup$

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 graphics

$\endgroup$
  • 2
    $\begingroup$ You should report the problem to Wolfram Support. I can reproduce it in 10.4.1. $\endgroup$ – Szabolcs May 9 '16 at 20:30
  • $\begingroup$ Maybe: HighlightGraphR[g_, vertices_] := HighlightGraph[ VertexReplace[g, Thread[VertexList[g] -> ToString /@ VertexList[g] ]], ToString /@ vertices] $\endgroup$ – ZYX May 9 '16 at 20:39
  • $\begingroup$ a simpler example : HighlightGraph[Graph[{{1}, {2}}, {{1} <-> {2}}], {{1}, {2}}] $\endgroup$ – kglr May 9 '16 at 21:12
16
$\begingroup$

We can reproduce the problem in a simpler example:

g = Graph[{{1}, {2}}, {{1} <-> {2}}]

Mathematica graphics

HighlightGraph[g, {{1}, {2}}]

Mathematica graphics

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}}

$\endgroup$
  • 2
    $\begingroup$ which version of Mathematica are you using? I got In[7]:= GraphComputation`GraphHighlightDump`vertexEdgeExtract[{{1}, {2}}, g] Out[7]= {{{1}, {2}}, {}} $\endgroup$ – halmir May 10 '16 at 13:25
  • $\begingroup$ @halmir, i am using version 9 (windows 10) $\endgroup$ – kglr May 10 '16 at 19:03
12
$\begingroup$

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 *)
$\endgroup$
8
+500
$\begingroup$

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 wether 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]}] 

enter image description here

So, introducing a Vertex primitive might still be a good idea.

Improvements and suggestions are welcome!

Update

  1. Added a fix for a case that {1} and not 1 is the only vertex to be highlighted.
  2. Reformulated the fix such that it gets applied automatically after autoload.
  3. Fixed the issue for Subgraph.
  4. Defined new rules for 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:

enter image description here

And the fixed version from above produces:

enter code here

$\endgroup$
  • $\begingroup$ @Szabolcs Thank you very much for the flowers! Can we expect that the bugfix will be made part of IGraph/M? $\endgroup$ – Henrik Schumacher Dec 21 '17 at 16:31
5
$\begingroup$

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}}}]

enter image description here

And for kglr's example:

g = Graph[{{1}, {2}}, {{1} <-> {2}}];
HighlightGraph[g, Vertex /@ {{1}, {2}}]

enter image description here

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.

$\endgroup$
  • $\begingroup$ While it is true that 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$ – Szabolcs Dec 5 '17 at 22:51
  • $\begingroup$ What I am trying to say is that I consider failure acceptable when the second argument is a vertex or a list of vertices (for vertices with the head List). It should be possible to disambiguate these by providing a list of lists of objects as the second argument of HighlightGraph. $\endgroup$ – Szabolcs Dec 5 '17 at 22:56
2
$\begingroup$

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];
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.