10
$\begingroup$

I am seeking to use the undocumented Mathematica function

GraphComputation`GraphProduct[G1,G2,type]

to compute the lexicographic product of graphs G1 and G2. I can get this function to work for the Cartesian product but not for the Lexicographic product. Does anyone know how it works?

$\endgroup$
  • $\begingroup$ Can you provide a specific example you're trying to get to work? $\endgroup$ – Lukas Lang May 13 '18 at 17:43
  • $\begingroup$ for example let G1 = CompleteGraph[3] and G2 = CycleGraph[5], and then use GraphComputation`GraphProduct[G1,G2,"Lexicographic"]. $\endgroup$ – clive elphick May 13 '18 at 18:14
  • 3
    $\begingroup$ A better question is: how to implement this type of product? I don't see any reason to assume that the undocumented function you mention could do this. $\endgroup$ – Szabolcs May 13 '18 at 18:52
9
$\begingroup$

Playing around with Szabolcs' implementation, it appeared to me that the adjacency matrix of the lexicographic product can be easily described by KroneckerProduct. This led me to a second method, which seems to have better performance characteristics.

lexicographicProduct2[G_?UndirectedGraphQ, H_?UndirectedGraphQ, 
  opts : OptionsPattern[]] := AdjacencyGraph[
  Tuples[{VertexList[G], VertexList[H]}],
  With[{
    nG = VertexCount[G],
    nH = VertexCount[H]
    },
   Plus[
    KroneckerProduct[AdjacencyMatrix[G], ConstantArray[1, {nH, nH}]],
    KroneckerProduct[IdentityMatrix[nG, SparseArray], AdjacencyMatrix[H]]
    ]
   ],
  opts
  ]

Here is a short timing comparison:

G = CycleGraph[20];
H = CycleGraph[30];
K1 = lexicographicProduct[G, H]; // RepeatedTiming // First
K2 = lexicographicProduct2[G, H]; // RepeatedTiming // First
K1 == K2

1.40

0.0543

True

Edit

The product graphs have the tendency to be rather dense, so AdjacencyGraph might not be the best choice to construct it from the adjacency matrix: Doing so leads to a graph with GraphComputation`GraphRepresentation returning "Simple" which is in fact a sparse representation. The following leads to a result whose GraphComputation`GraphRepresentation equals "Incidence". This is also almost 10 times faster than lexicographicProduct2 and even faster than Mathe172's fix for GraphComputation`GraphProduct (at least on my machine).

lexicographicProduct3[G_?UndirectedGraphQ, H_?UndirectedGraphQ, opts : OptionsPattern[]] := Graph[
  Tuples[{VertexList[G], VertexList[H]}], 
  With[{nG = VertexCount[G], nH = VertexCount[H]},
    UpperTriangularize[Plus[
      KroneckerProduct[AdjacencyMatrix[G], ConstantArray[1, {nH, nH}]], 
      KroneckerProduct[IdentityMatrix[nG, SparseArray], AdjacencyMatrix[H]]
      ]
     ]]["NonzeroPositions"],
  opts
  ]

K3 = lexicographicProduct3[G, H]; // RepeatedTiming // First
VertexList[K2] == VertexList[K3]
EdgeList[K2] == EdgeList[K3]

0.0059

True

True

$\endgroup$
8
$\begingroup$

So I got GraphComputation`GraphProduct to work, and it appears to be even faster:

Unprotect[GraphComputation`GraphProduct];
DownValues[GraphComputation`GraphProduct] = 
  DownValues[GraphComputation`GraphProduct] /. "Lexicographic" -> "Lexicographical";
Protect[GraphComputation`GraphProduct];


K1 = lexicographicProduct[G, H, VertexLabels -> "Name"]; // 
  RepeatedTiming // First
K2 = lexicographicProduct2[G, H, VertexLabels -> "Name"]; // 
  RepeatedTiming // First
K3 = GraphComputation`GraphProduct[G, H, "Lexicographical"]; // 
  RepeatedTiming // First
IsomorphicGraphQ[K1, K2] && IsomorphicGraphQ[K2, K3]
(* 1.09 *)
(* 0.041 *)
(* 0.0086 *)
(* True *)

The issue is that there appears to be a typo in the definition of the function: The top-level GraphProduct function expects "Lexicographic", while the inner function expects "Lexicographical", leading to the unexpected error.

Note: Obviously, the function is undocumented, so be careful. Especially given that it's not even possible to call the function without fixing it up first.

$\endgroup$
  • 1
    $\begingroup$ I guess this is exactly what OP was after. Let's hope this functionality becomes public API in M12.0. Some improvements were promised for 12.0. $\endgroup$ – Szabolcs May 14 '18 at 10:20
  • 1
    $\begingroup$ Despite being undocumented, it might be worth reporting ... $\endgroup$ – Szabolcs May 14 '18 at 10:20
  • $\begingroup$ @Szabolcs Good point - I've reported it now, let's see what they say $\endgroup$ – Lukas Lang May 15 '18 at 7:34
7
$\begingroup$

I did not know what lexicographic product was, so I looked it up.

If performance is not critical, you can implement the definition quite directly.

lexicographicProduct[g1_?UndirectedGraphQ, g2_?UndirectedGraphQ, opt : OptionsPattern[]] := 
 RelationGraph[
   (* two nodes are connected if their corresponding nodes in the first graph are connected *)
   EdgeQ[g1, First[#1] \[UndirectedEdge] First[#2]] || 
   (* or their corresponding nodes in the first graph are the same and their corresponding nodes in the second graph are connected *)
   (First[#1] === First[#2] && EdgeQ[g2, Last[#1] \[UndirectedEdge] Last[#2]]) &,

   (* the vertices are the cartesian product of the two vertex sets *)
   Tuples[{VertexList[g1], VertexList[g2]}],

   (* also allow setting graph options *)
   opt
 ]

lexicographicProduct[CycleGraph[5], CycleGraph[3]]

enter image description here

$\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.