2
$\begingroup$

I would like the following two graphs to be SameQ:

Graph[{1, 2, 3, 4, 6, 7, 5}, 
 {UndirectedEdge[1, 2, 1], 
  UndirectedEdge[3, 4, 1], 
  UndirectedEdge[6, 7, 2], 
  UndirectedEdge[4, 5, 2]}, 
 {EdgeLabels -> {"EdgeTag"}, 
  VertexLabels -> {6 -> "B", 
    3 -> "B", 5 -> "A", 
    7 -> "A", 4 -> "B", 
    2 -> "A", 1 -> "A"}}]

enter image description here

and

Graph[{a, b, c, d, e, f, g}, {UndirectedEdge[a, b, 2], 
   UndirectedEdge[c, d, 1], UndirectedEdge[f, g, 1], 
   UndirectedEdge[d, e, 2]}, {EdgeLabels -> {"EdgeTag"}, 
   VertexLabels -> {f -> "A", c -> "B", e -> "A", g -> "A", d -> "B", 
     b -> "B", a -> "A"}}]

enter image description here

Because they have the same label structure up to a permutation in the order of the disconnected graphs and because the edges are undirected. Or in a sentence : because the graphs look the same with a B-B-A then an A-B then a A-A regardless of the order they are in. Note that I considered simple chains here which is what I am working with at the moment but in the future I might have to upgrade to graphs that have vertices with a higher connectivity degree although they should not have any loops or multiple edges.

EDIT : Ideally I would like a canonical form for both.

IGBlissCanonicalGraph from the

IGraphM` 

package does nearly that using vertex colors but it removes the edge tags. Is there a way to identify the graphs above while preserving the edge tags ? Maybe I should drop the edge tags and consider something else ? Maybe I should work with a dual graph instead ?

Note that the vertex label categories A and B makes the problem more restrictive than just checking if the graphs verify IsomorphicGraphQ

EDIT : I learned that VF2 in IGraphM works with edge colors, I am checking if I can make a dictionary with edge tags.

VF2 might work but it does not offer a canonical form. If no one answers then I will add that turning the graphs to molecules and using methods to identify molecules is what I did in the past for this problem but the method is slow when working with thousands of graphs.

$\endgroup$
10
  • $\begingroup$ SameQ[EdgeList[g1], EdgeList[g2]] (* True *) $\endgroup$
    – Alan
    Commented Nov 27, 2022 at 21:58
  • $\begingroup$ @Alan I might have chosen a bad choice but I can't rely on the values of the vertices they can be arbitrarily chosen with Unique for example. The only thing I can rely on is the labels. I will see if I can change my post and I will consider whether I can rewrite the code so that your suggestion would work. $\endgroup$ Commented Nov 27, 2022 at 22:06
  • $\begingroup$ IGraph/M has the VF2 algorithm which can handle edge colours. However, VF2 cannot produce a canonical labelling. It can merely determine if two graphs are isomorphic. Is this sufficient for you? If not, the best approach is trying to think up an encoding of edge coloured graphs into purely vertex coloured graphs. For example, it might be worth thinking about whether subdividing each edge with a single vertex and assigning the edge colour to that vertex yields an equivalent problem. You would need to make sure that vertex and edge colours do not clash. $\endgroup$
    – Szabolcs
    Commented Nov 28, 2022 at 7:53
  • $\begingroup$ Ah, I see from your update that you found VF2. If you want the canonical form, I suggest you go with the edge subdivision approach. Note that I don't have time to think through the details and implement it today, so I won't post an answer. $\endgroup$
    – Szabolcs
    Commented Nov 28, 2022 at 7:55
  • $\begingroup$ @Szabolcs The edge subdivision sounds like a good idea. It sounds feasible enough that I might be able to implement it. I also have another idea of reducing the graph to it's color connectivity usingRelationshipGraph regardless of the numbers/values in the vertices. Thanks for the idea I will see what it does. $\endgroup$ Commented Nov 28, 2022 at 10:23

1 Answer 1

1
$\begingroup$

@Szabolcs suggestion to introduce new vertices at the middle of the edges worked at least in this case.

I will explain the method and provide the code in the event that it is of use to someone else. Note that in the past I converted graphs to molecules and then used molecule nomenclature to obtain a canonical representation. If instead the reader just wants to check that the graphs are isomorphic while preserving labels of vertices and maybe edges,then they may use other functions in IGraphM or perhaps the molecule framework although I did not use it like that.

The idea is to find a canonical graph for a colored graph where the colors are represented by the labels on the graph. Specifically, there are colors that correspond to vertex labels and introduced auxiliary vertices that are "colored" according to the tag label. One may then use IGBlissCanonicalGraph from

IGraphM`

to get a canonical form for the auxiliary graph with introduced vertices labeling edge tags then remove them.

There is a lot of code involved in going back and forth between vertex labels and edge tags and the colored graph used by IGBlissCanonical Graph:

I used a helper function that acts as Nothing but for graphs in the sense that it deletes a vertex and connects the adjacent vertices. The code also places the edge tag encoded by the vertex.

Note: \[Ellipsis]=…

vertexNothing[graph_,v_]:=
Module[{connected…vertices,result},

connected…vertices=
Rest@VertexInComponent[graph,{v[[1]]},1];

result=VertexContract[graph,{connected…vertices[[1]],v[[1]]}];

EdgeDelete[result,UndirectedEdge@@connected…vertices]
//EdgeAdd[#,UndirectedEdge@@Append[connected…vertices,v[[2]]]]&
] 

Next install IGraphM from http://szhorvat.net/pelican/igraphm-a-mathematica-interface-for-igraph.html

then load IGraphM

<< IGraphM`

Then the function that canonicalizes the graph:

canonicalize[graph_]:=
Module[{edges,new…edges,graph•mod,
introduced…vertices, new,
colors,graph•canonical•aux,
vertex…labels, rm…duplicates…vertex…labels,
labels,introduced…vertices…to…remove,
color…dictionary,edge…tags,
result,color…to…tag,new…labels},

edges=EdgeList@graph;
new…edges=
edges /. a_Overscript[\[UndirectedEdge], c_]b_:> Module[{label},
                        ##&[a\[UndirectedEdge]new[c,label],new[c,label]\[UndirectedEdge]b]
                        ]
;
(* replace previous edges with new…edges  *)
graph•mod=
EdgeDelete[graph,edges]
// EdgeAdd[#,new…edges] &
;
introduced…vertices=
Cases[VertexList@graph•mod, _new]
;
edge…tags=
introduced…vertices//Map[Last]//DeleteDuplicates ;
;
vertex…labels=
AnnotationValue[graph,VertexLabels]
;
rm…duplicates…vertex…labels=
Sort@DeleteDuplicates[vertex…labels[[All,2]]]
;
color…dictionary=
Thread[rm…duplicates…vertex…labels->
                       (rm…duplicates…vertex…labels 
                       //Length //Range)]
;
colors=
(vertex…labels/. color…dictionary)~
Join~(#->(Length@rm…duplicates…vertex…labels
          +#[[1]])&/@introduced…vertices) 
//Association
;
color…to…tag=Reverse/@Normal@colors /.new[a_,b_]:>a
;
graph•canonical•aux=
IGBlissCanonicalGraph[{graph•mod,"VertexColors"->colors}]
;
labels=
AnnotationValue[graph•canonical•aux,
                AnnotationRules]
// MapAt[Last@*Last,{All,2}]
;
introduced…vertices…to…remove=
Cases[labels,HoldPattern[s_->m_ 
                        /; m>Length@rm…duplicates…vertex…labels
                        ]
              :> {s,(m/. color…to…tag)}]
;
result=
Fold[vertexNothing,
graph•canonical•aux,
introduced…vertices…to…remove]
;
new…labels=
Select[#[[1]]<=Max[VertexList@result]&]@labels
;
AnnotationValue[result,VertexLabels]=
ReplaceAt[new…labels,Reverse/@color…dictionary,{All,2}]
;
Graph[result, DeleteCases[Options[graph],VertexLabels->_]]
]

test :

graph = Graph[{1, 2, 3, 4, 6, 7, 5}, {UndirectedEdge[1, 2, 1], 
UndirectedEdge[3, 4, 1], UndirectedEdge[6, 7, 2], 
UndirectedEdge[4, 5, 2]}, {EdgeLabels -> {"EdgeTag"}, 
VertexLabels -> {6 -> "B", 3 -> "B", 5 -> "A", 7 -> "A", 4 -> "B",
   2 -> "A", 1 -> "A"}}];


graph2 = 
  Graph[{a, b, c, d, e, f, g}, {UndirectedEdge[a, b, 2], 
    UndirectedEdge[c, d, 1], UndirectedEdge[f, g, 1], 
    UndirectedEdge[d, e, 2]}, {EdgeLabels -> {"EdgeTag"}, 
    VertexLabels -> {f -> "A", c -> "B", e -> "A", g -> "A", d -> "B",
       b -> "B", a -> "A"}}];

canonicalize[graph2]-canonicalize[graph] (* needs to be 
evaluated twice the first time for an unknown reason  *)

(* 0 *)

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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