3
$\begingroup$

Defn Let $\mathcal{G}=(\mathcal{V},\mathcal{E})$ and $\mathcal{G}' = (\mathcal{V}', \mathcal{E}')$ be two labeled graphs with alphabet $\mathcal{A}$. The labeled graph product $\mathcal{G} * \mathcal{G}'$ is defined as follows:

  • The vertex set of $\mathcal{G} * \mathcal{G}'$ is the Cartesian product $\mathcal{V} \times \mathcal{V}'$.
  • Given $(g, g')$ and $(h, h') \in \mathcal{V} \times \mathcal{V}'$ and $a \in \mathcal{A}$, there is a labeled edge $(g,g') \overset{a}{\longrightarrow} (h,h')$ if and only if there is an edge $g \overset{a}{\longrightarrow} h$ in $\mathcal{G}$ and an edge $g' \overset{a}{\longrightarrow} h'$ in $\mathcal{G}'$.

Given a labeled graph $\mathcal{G}$, I am trying to efficiently implement the labeled graph product $\mathcal{G}*\mathcal{G}$. If it helps, the graphs I'm concerned with will always have the following properties:

  • $\mathcal{G}$ will be right-resolving (aka a Shannon graph), that is, all edges leaving a given vertex bear distinct labels.
  • For each label $a \in \mathcal{A}$ and each vertex $v \in \mathcal{V}$, there is an edge leaving $v$ with label $a$, i.e., $v \overset{a}{\longrightarrow} \dots$.

For example, consider the graph

graph= {{1 -> 3, "a"}, {1 -> 5, "b"}, {2 -> 1, "a"}, {3 -> 2, "a"}, {3 -> 4, "b"}, {4 -> 1, "a"}, {5 -> 6, "a"}, {5 -> 4, "b"}, {6 -> 1,"a"}, {0 -> 0, "a"}, {0 -> 0, "b"}, {2 -> 0, "b"}, {4 -> 0,  "b"}, {6 -> 0, "b"}}

I have approached this problem by first defining a function that, given a vertex and a label, returns the target of the corresponding edge:

 leavingEdgeTarget[vertex_, edgeLabel_, graph_] := Select[Select[graph, #[[1, 1]] == vertex &], #[[2]] == edgeLabel &][[ 1, 1, 2]]

and then using the following function:

 labelProduct[graph_] := With[
  {vertexList = VertexList@Graph@graph[[All, 1]],
  alphabet = Union@graph[[All, 2]]}, 
    Flatten[#, 2] &@
     ParallelTable[{{v1,v2} -> 
      {leavingEdgeTarget[v1, label,graph], 
       leavingEdgeTarget[v2, label, graph]}, 
      label},
       {v1, vertexList}, 
       {v2, vertexList},
       {label, alphabet}
      ]
  ]

So for example, labelProduct[graph] returns the following graph with 49 vertices and 98 edges:

{{{1,1}->{3,3},"a"}, {{1,1}->{5,5}, "b"}, {{1,3}->{3,2},"a"},...,{{0,0}->{0,0},"b"}}

Q: How can I speed this up?

For small graphs, this runs reasonably fast (and seems to get a very nice speedup from the use of ParallelTable). However, it starts to take quite a while for larger graphs (100+ vertices). Consider the graph

SeedRandom[0];
n = 100;
randomGraph = 
  Flatten[#, 1]&@
   Table[{i -> RandomInteger[{1, n}], label},
         {i, 1, n}, 
         {label, Range[3]}
        ];

On my machine (32GB memory, 8 logical cores @3.7GHz) I get the following values for labelProduct[randomGraph];//AbsoluteTiming different values of n:

  n   AbsoluteTiming
 10   0.022
 20   0.072
 50   0.600
100   4.418
150  14.524
200  34.193
250  66.879
500  529.8=8m49.8s

I can achieve a small timing benefit by only generating the edges $(i,j)\overset{a}{\longrightarrow}(i', j')$ with $i \leq j$ and then find the remaining edges in the label product by noting that there is also an edge $(j,i)\overset{a}{\longrightarrow}(j',i')$, but this only has a speedup by a factor of roughly $1/2$.

$\endgroup$
4
$\begingroup$

Why not just group vertices by their labels, and then use Tuples to generate the new vertices? For example:

grp = GroupBy[graph, Last -> First, Replace[Tuples[#,2], t_ :> Thread[t, Rule], {1}]&]

<|"a" -> {{1, 1} -> {3, 3}, {1, 2} -> {3, 1}, {1, 3} -> {3, 2}, {1, 4} -> {3, 1}, {1, 5} -> {3, 6}, {1, 6} -> {3, 1}, {1, 0} -> {3, 0}, {2, 1} -> {1, 3}, {2, 2} -> {1, 1}, {2, 3} -> {1, 2}, {2, 4} -> {1, 1}, {2, 5} -> {1, 6}, {2, 6} -> {1, 1}, {2, 0} -> {1, 0}, {3, 1} -> {2, 3}, {3, 2} -> {2, 1}, {3, 3} -> {2, 2}, {3, 4} -> {2, 1}, {3, 5} -> {2, 6}, {3, 6} -> {2, 1}, {3, 0} -> {2, 0}, {4, 1} -> {1, 3}, {4, 2} -> {1, 1}, {4, 3} -> {1, 2}, {4, 4} -> {1, 1}, {4, 5} -> {1, 6}, {4, 6} -> {1, 1}, {4, 0} -> {1, 0}, {5, 1} -> {6, 3}, {5, 2} -> {6, 1}, {5, 3} -> {6, 2}, {5, 4} -> {6, 1}, {5, 5} -> {6, 6}, {5, 6} -> {6, 1}, {5, 0} -> {6, 0}, {6, 1} -> {1, 3}, {6, 2} -> {1, 1}, {6, 3} -> {1, 2}, {6, 4} -> {1, 1}, {6, 5} -> {1, 6}, {6, 6} -> {1, 1}, {6, 0} -> {1, 0}, {0, 1} -> {0, 3}, {0, 2} -> {0, 1}, {0, 3} -> {0, 2}, {0, 4} -> {0, 1}, {0, 5} -> {0, 6}, {0, 6} -> {0, 1}, {0, 0} -> {0, 0}}, "b" -> {{1, 1} -> {5, 5}, {1, 3} -> {5, 4}, {1, 5} -> {5, 4}, {1, 0} -> {5, 0}, {1, 2} -> {5, 0}, {1, 4} -> {5, 0}, {1, 6} -> {5, 0}, {3, 1} -> {4, 5}, {3, 3} -> {4, 4}, {3, 5} -> {4, 4}, {3, 0} -> {4, 0}, {3, 2} -> {4, 0}, {3, 4} -> {4, 0}, {3, 6} -> {4, 0}, {5, 1} -> {4, 5}, {5, 3} -> {4, 4}, {5, 5} -> {4, 4}, {5, 0} -> {4, 0}, {5, 2} -> {4, 0}, {5, 4} -> {4, 0}, {5, 6} -> {4, 0}, {0, 1} -> {0, 5}, {0, 3} -> {0, 4}, {0, 5} -> {0, 4}, {0, 0} -> {0, 0}, {0, 2} -> {0, 0}, {0, 4} -> {0, 0}, {0, 6} -> {0, 0}, {2, 1} -> {0, 5}, {2, 3} -> {0, 4}, {2, 5} -> {0, 4}, {2, 0} -> {0, 0}, {2, 2} -> {0, 0}, {2, 4} -> {0, 0}, {2, 6} -> {0, 0}, {4, 1} -> {0, 5}, {4, 3} -> {0, 4}, {4, 5} -> {0, 4}, {4, 0} -> {0, 0}, {4, 2} -> {0, 0}, {4, 4} -> {0, 0}, {4, 6} -> {0, 0}, {6, 1} -> {0, 5}, {6, 3} -> {0, 4}, {6, 5} -> {0, 4}, {6, 0} -> {0, 0}, {6, 2} -> {0, 0}, {6, 4} -> {0, 0}, {6, 6} -> {0, 0}}|>

Then, your desired edges can be obtained with:

gproduct = Catenate @ KeyValueMap[Function[{k, v}, Thread[{v,k}]]] @ grp

{{{1, 1} -> {3, 3}, "a"}, {{1, 2} -> {3, 1}, "a"}, {{1, 3} -> {3, 2}, "a"}, {{1, 4} -> {3, 1}, "a"}, {{1, 5} -> {3, 6}, "a"}, {{1, 6} -> {3, 1}, "a"}, {{1, 0} -> {3, 0}, "a"}, {{2, 1} -> {1, 3}, "a"}, {{2, 2} -> {1, 1}, "a"}, {{2, 3} -> {1, 2}, "a"}, {{2, 4} -> {1, 1}, "a"}, {{2, 5} -> {1, 6}, "a"}, {{2, 6} -> {1, 1}, "a"}, {{2, 0} -> {1, 0}, "a"}, {{3, 1} -> {2, 3}, "a"}, {{3, 2} -> {2, 1}, "a"}, {{3, 3} -> {2, 2}, "a"}, {{3, 4} -> {2, 1}, "a"}, {{3, 5} -> {2, 6}, "a"}, {{3, 6} -> {2, 1}, "a"}, {{3, 0} -> {2, 0}, "a"}, {{4, 1} -> {1, 3}, "a"}, {{4, 2} -> {1, 1}, "a"}, {{4, 3} -> {1, 2}, "a"}, {{4, 4} -> {1, 1}, "a"}, {{4, 5} -> {1, 6}, "a"}, {{4, 6} -> {1, 1}, "a"}, {{4, 0} -> {1, 0}, "a"}, {{5, 1} -> {6, 3}, "a"}, {{5, 2} -> {6, 1}, "a"}, {{5, 3} -> {6, 2}, "a"}, {{5, 4} -> {6, 1}, "a"}, {{5, 5} -> {6, 6}, "a"}, {{5, 6} -> {6, 1}, "a"}, {{5, 0} -> {6, 0}, "a"}, {{6, 1} -> {1, 3}, "a"}, {{6, 2} -> {1, 1}, "a"}, {{6, 3} -> {1, 2}, "a"}, {{6, 4} -> {1, 1}, "a"}, {{6, 5} -> {1, 6}, "a"}, {{6, 6} -> {1, 1}, "a"}, {{6, 0} -> {1, 0}, "a"}, {{0, 1} -> {0, 3}, "a"}, {{0, 2} -> {0, 1}, "a"}, {{0, 3} -> {0, 2}, "a"}, {{0, 4} -> {0, 1}, "a"}, {{0, 5} -> {0, 6}, "a"}, {{0, 6} -> {0, 1}, "a"}, {{0, 0} -> {0, 0}, "a"}, {{1, 1} -> {5, 5}, "b"}, {{1, 3} -> {5, 4}, "b"}, {{1, 5} -> {5, 4}, "b"}, {{1, 0} -> {5, 0}, "b"}, {{1, 2} -> {5, 0}, "b"}, {{1, 4} -> {5, 0}, "b"}, {{1, 6} -> {5, 0}, "b"}, {{3, 1} -> {4, 5}, "b"}, {{3, 3} -> {4, 4}, "b"}, {{3, 5} -> {4, 4}, "b"}, {{3, 0} -> {4, 0}, "b"}, {{3, 2} -> {4, 0}, "b"}, {{3, 4} -> {4, 0}, "b"}, {{3, 6} -> {4, 0}, "b"}, {{5, 1} -> {4, 5}, "b"}, {{5, 3} -> {4, 4}, "b"}, {{5, 5} -> {4, 4}, "b"}, {{5, 0} -> {4, 0}, "b"}, {{5, 2} -> {4, 0}, "b"}, {{5, 4} -> {4, 0}, "b"}, {{5, 6} -> {4, 0}, "b"}, {{0, 1} -> {0, 5}, "b"}, {{0, 3} -> {0, 4}, "b"}, {{0, 5} -> {0, 4}, "b"}, {{0, 0} -> {0, 0}, "b"}, {{0, 2} -> {0, 0}, "b"}, {{0, 4} -> {0, 0}, "b"}, {{0, 6} -> {0, 0}, "b"}, {{2, 1} -> {0, 5}, "b"}, {{2, 3} -> {0, 4}, "b"}, {{2, 5} -> {0, 4}, "b"}, {{2, 0} -> {0, 0}, "b"}, {{2, 2} -> {0, 0}, "b"}, {{2, 4} -> {0, 0}, "b"}, {{2, 6} -> {0, 0}, "b"}, {{4, 1} -> {0, 5}, "b"}, {{4, 3} -> {0, 4}, "b"}, {{4, 5} -> {0, 4}, "b"}, {{4, 0} -> {0, 0}, "b"}, {{4, 2} -> {0, 0}, "b"}, {{4, 4} -> {0, 0}, "b"}, {{4, 6} -> {0, 0}, "b"}, {{6, 1} -> {0, 5}, "b"}, {{6, 3} -> {0, 4}, "b"}, {{6, 5} -> {0, 4}, "b"}, {{6, 0} -> {0, 0}, "b"}, {{6, 2} -> {0, 0}, "b"}, {{6, 4} -> {0, 0}, "b"}, {{6, 6} -> {0, 0}, "b"}}

which is the same as your result up to ordering.

| improve this answer | |
$\endgroup$
  • $\begingroup$ Wow! Very nice...I may need to finally figure out associations. Getting a timing value of 0.75 for n=500 instead of 8.5minutes. Thank you!! $\endgroup$ – erfink Oct 5 '18 at 20:57
2
$\begingroup$

I am not 100% sure whether my thinking is correct. But let's see.

Let's start with two random labeled graphs.

SeedRandom[0];
n = 100;
G = Flatten[#, 1] &@ Table[{i -> RandomInteger[{1, n}], label}, {i, 1, n}, {label,Range[3]}];
H = Flatten[#, 1] &@ Table[{i -> RandomInteger[{1, n}], label}, {i, 1, n}, {label, Range[3]}];

Personally, I don't like lists of rules. I prefer packed arrays for their efficiency. Moreover, I'd like to have the labels in front for later use. So, let's reorder.

Gpat = Developer`ToPackedArray[Block[{Rule = Sequence}, G]][[All, {3, 1, 2}]];
Hpat = Developer`ToPackedArray[Block[{Rule = Sequence}, H]][[All, {3, 1, 2}]];

Now let's create some "adjacency matrices".

m = Max[Max[Gpat[[All, 1]]], Max[Hpat[[All, 1]]]];
Gn = Max[Gpat[[All, 2 ;;]]];
Hn = Max[Hpat[[All, 2 ;;]]];
GA = SparseArray[Gpat -> 1, {m, Gn, Gn}];
HA = SparseArray[Hpat -> 1, {m, Hn, Hn}];

More precisely, GA[[i]] is the adjacency matrix of the subgraph of G that consists precisely of those edges with label i. Same for HA[[i]]. In my understanding, the respective adjacency matrix HA[[i]] of the labeled product graph is essentially the Kronecker product of GA[[i]] with HA[[i]]. So, let's generate it, extract its "NonzeroPositions" (these correspond to labeled edges in the new graph) and reorder again in order to obtain a list with entries of the form {{i1,i2}->{j1,j2}, label}.

GHA = ArrayReshape[
 SparseArray@MapThread[KroneckerProduct, {GA, HA}], 
 {m, Gn, Gn, Hn, Hn}
 ];
GHpat = GHA["NonzeroPositions"];
GH = Transpose[{Thread[GHpat[[All, 2 ;; 3]] -> GHpat[[All, 4 ;; 5]]], 
GHpat[[All, 1]]}];

My Haswell Quad Core laptop performs this task in 0.0346 seconds. However, 0.0313 seconds (more than 90%!) are used just for transforming from and into the inefficient data format (list of rules). So, the actual computation needs less than 0.0033 seconds. For n = 500, the pure computation needs 0.113 seconds while the final transformation into GH takes 0.926 seconds.

As I said in the beginning, I am not sure whether this is correct. But you have already an implementation, so that checking it should be easier for you than for me.

| improve this answer | |
$\endgroup$
  • $\begingroup$ Hmm, very nice observation re: the tensor product of adjacency matrices. I'll have to think about that a bit more, but it seems very intriguing. I might have to rework other data structures to make full use of the benefits of packed arrays; will have to decide if that time savings is worthwhile. Thanks for the answer! $\endgroup$ – erfink Oct 5 '18 at 21:46

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.