Mixing
Label Product of a Graph with itself
Clash Royale CLAN TAG#URR8PPP
up vote
2
down vote
favorite
Defn Let $mathcalG=(mathcalV,mathcalE)$ and $mathcalG' = (mathcalV', mathcalE')$ be two labeled graphs with alphabet $mathcalA$. The labeled graph product $mathcalG * mathcalG'$ is defined as follows:
- The vertex set of $mathcalG * mathcalG'$ is the Cartesian product $mathcalV times mathcalV'$.
- Given $(g, g')$ and $(h, h') in mathcalV times mathcalV'$ and $a in mathcalA$, there is a labeled edge $(g,g') oversetalongrightarrow (h,h')$ if and only if there is an edge $g oversetalongrightarrow h$ in $mathcalG$ and an edge $g' oversetalongrightarrow h'$ in $mathcalG'$.
Given a labeled graph $mathcalG$, I am trying to efficiently implement the labeled graph product $mathcalG*mathcalG$. If it helps, the graphs I'm concerned with will always have the following properties:
$mathcalG$ will be right-resolving (aka a Shannon graph), that is, all edges leaving a given vertex bear distinct labels.- For each label $a in mathcalA$ and each vertex $v in mathcalV$, there is an edge leaving $v$ with label $a$, i.e., $v oversetalongrightarrow 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)oversetalongrightarrow(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)oversetalongrightarrow(j',i')$, but this only has a speedup by a factor of roughly $1/2$.
performance-tuning graphs-and-networks
asked 1 hour ago
erfink
319110
add a comment |Â
up vote
2
down vote
favorite
Defn Let $mathcalG=(mathcalV,mathcalE)$ and $mathcalG' = (mathcalV', mathcalE')$ be two labeled graphs with alphabet $mathcalA$. The labeled graph product $mathcalG * mathcalG'$ is defined as follows:
- The vertex set of $mathcalG * mathcalG'$ is the Cartesian product $mathcalV times mathcalV'$.
- Given $(g, g')$ and $(h, h') in mathcalV times mathcalV'$ and $a in mathcalA$, there is a labeled edge $(g,g') oversetalongrightarrow (h,h')$ if and only if there is an edge $g oversetalongrightarrow h$ in $mathcalG$ and an edge $g' oversetalongrightarrow h'$ in $mathcalG'$.
Given a labeled graph $mathcalG$, I am trying to efficiently implement the labeled graph product $mathcalG*mathcalG$. If it helps, the graphs I'm concerned with will always have the following properties:
$mathcalG$ will be right-resolving (aka a Shannon graph), that is, all edges leaving a given vertex bear distinct labels.- For each label $a in mathcalA$ and each vertex $v in mathcalV$, there is an edge leaving $v$ with label $a$, i.e., $v oversetalongrightarrow 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)oversetalongrightarrow(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)oversetalongrightarrow(j',i')$, but this only has a speedup by a factor of roughly $1/2$.
performance-tuning graphs-and-networks
asked 1 hour ago
erfink
319110
add a comment |Â
up vote
2
down vote
favorite
up vote
2
down vote
favorite
Defn Let $mathcalG=(mathcalV,mathcalE)$ and $mathcalG' = (mathcalV', mathcalE')$ be two labeled graphs with alphabet $mathcalA$. The labeled graph product $mathcalG * mathcalG'$ is defined as follows:
- The vertex set of $mathcalG * mathcalG'$ is the Cartesian product $mathcalV times mathcalV'$.
- Given $(g, g')$ and $(h, h') in mathcalV times mathcalV'$ and $a in mathcalA$, there is a labeled edge $(g,g') oversetalongrightarrow (h,h')$ if and only if there is an edge $g oversetalongrightarrow h$ in $mathcalG$ and an edge $g' oversetalongrightarrow h'$ in $mathcalG'$.
Given a labeled graph $mathcalG$, I am trying to efficiently implement the labeled graph product $mathcalG*mathcalG$. If it helps, the graphs I'm concerned with will always have the following properties:
$mathcalG$ will be right-resolving (aka a Shannon graph), that is, all edges leaving a given vertex bear distinct labels.- For each label $a in mathcalA$ and each vertex $v in mathcalV$, there is an edge leaving $v$ with label $a$, i.e., $v oversetalongrightarrow 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)oversetalongrightarrow(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)oversetalongrightarrow(j',i')$, but this only has a speedup by a factor of roughly $1/2$.
performance-tuning graphs-and-networks
asked 1 hour ago
erfink
319110
Defn Let $mathcalG=(mathcalV,mathcalE)$ and $mathcalG' = (mathcalV', mathcalE')$ be two labeled graphs with alphabet $mathcalA$. The labeled graph product $mathcalG * mathcalG'$ is defined as follows:
- The vertex set of $mathcalG * mathcalG'$ is the Cartesian product $mathcalV times mathcalV'$.
- Given $(g, g')$ and $(h, h') in mathcalV times mathcalV'$ and $a in mathcalA$, there is a labeled edge $(g,g') oversetalongrightarrow (h,h')$ if and only if there is an edge $g oversetalongrightarrow h$ in $mathcalG$ and an edge $g' oversetalongrightarrow h'$ in $mathcalG'$.
Given a labeled graph $mathcalG$, I am trying to efficiently implement the labeled graph product $mathcalG*mathcalG$. If it helps, the graphs I'm concerned with will always have the following properties:
$mathcalG$ will be right-resolving (aka a Shannon graph), that is, all edges leaving a given vertex bear distinct labels.- For each label $a in mathcalA$ and each vertex $v in mathcalV$, there is an edge leaving $v$ with label $a$, i.e., $v oversetalongrightarrow 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)oversetalongrightarrow(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)oversetalongrightarrow(j',i')$, but this only has a speedup by a factor of roughly $1/2$.
performance-tuning graphs-and-networks
performance-tuning graphs-and-networks
asked 1 hour ago
erfink
319110
asked 1 hour ago
erfink
319110
asked 1 hour ago
erfink
319110
asked 1 hour ago
erfink
319110
asked 1 hour ago
erfink
319110
319110
add a comment |Â
add a comment |Â
2 Answers
2
active
oldest
votes
up vote
3
down vote
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.
answered 1 hour ago
Carl Woll
59.6k278154
Wow! Very nice...I may need to finally figure out associations. Getting a timing value of0.75forn=500instead of 8.5minutes. Thank you!!
– erfink
1 hour ago
add a comment |Â
up vote
1
down vote
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. Moreover, I'd like to have the label 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 a suitable transpose of the tensor 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 = Transpose[
SparseArray[
Table[TensorProduct[GA[[i]], HA[[i]]], i, 1, m]],
1, 2, 4, 3, 5];
GHpat = GHA["NonzeroPositions"];
GH = Map[X [Function] X[[2 ;; 3]] -> X[[4 ;; 5]], X[[1]], GHpat];
My computer performs this task in 0.097 seconds. However, 0.0895 seconds (more thatn 90%!) are used just for transforming from and into the inefficient data format (list of rules). So, the actual computation needs less than 0.008 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.
Edit
And even this can be improved by observing that GH[[i]] is essentially the KroneckerProduct of GA[[i]] and HA[[i]]
GHA = ArrayReshape[
SparseArray[ Table[KroneckerProduct[GA[[i]], HA[[i]]], i, 1, m]],
m, Gn, Gn, Hn, Hn];
answered 20 mins ago
Henrik Schumacher
40.9k258123
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!
– erfink
12 mins ago
add a comment |Â
2 Answers
2
active
oldest
votes
2 Answers
2
active
oldest
votes
active
oldest
votes
active
oldest
votes
up vote
3
down vote
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.
answered 1 hour ago
Carl Woll
59.6k278154
Wow! Very nice...I may need to finally figure out associations. Getting a timing value of0.75forn=500instead of 8.5minutes. Thank you!!
– erfink
1 hour ago
add a comment |Â
up vote
3
down vote
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.
answered 1 hour ago
Carl Woll
59.6k278154
Wow! Very nice...I may need to finally figure out associations. Getting a timing value of0.75forn=500instead of 8.5minutes. Thank you!!
– erfink
1 hour ago
add a comment |Â
up vote
3
down vote
up vote
3
down vote
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.
answered 1 hour ago
Carl Woll
59.6k278154
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.
answered 1 hour ago
Carl Woll
59.6k278154
answered 1 hour ago
Carl Woll
59.6k278154
answered 1 hour ago
Carl Woll
59.6k278154
answered 1 hour ago
Carl Woll
59.6k278154
59.6k278154
Wow! Very nice...I may need to finally figure out associations. Getting a timing value of0.75forn=500instead of 8.5minutes. Thank you!!
– erfink
1 hour ago
add a comment |Â
Wow! Very nice...I may need to finally figure out associations. Getting a timing value of0.75forn=500instead of 8.5minutes. Thank you!!
– erfink
1 hour ago
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!!– erfink
1 hour ago
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!!– erfink
1 hour ago
add a comment |Â
up vote
1
down vote
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. Moreover, I'd like to have the label 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 a suitable transpose of the tensor 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 = Transpose[
SparseArray[
Table[TensorProduct[GA[[i]], HA[[i]]], i, 1, m]],
1, 2, 4, 3, 5];
GHpat = GHA["NonzeroPositions"];
GH = Map[X [Function] X[[2 ;; 3]] -> X[[4 ;; 5]], X[[1]], GHpat];
My computer performs this task in 0.097 seconds. However, 0.0895 seconds (more thatn 90%!) are used just for transforming from and into the inefficient data format (list of rules). So, the actual computation needs less than 0.008 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.
Edit
And even this can be improved by observing that GH[[i]] is essentially the KroneckerProduct of GA[[i]] and HA[[i]]
GHA = ArrayReshape[
SparseArray[ Table[KroneckerProduct[GA[[i]], HA[[i]]], i, 1, m]],
m, Gn, Gn, Hn, Hn];
answered 20 mins ago
Henrik Schumacher
40.9k258123
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!
– erfink
12 mins ago
add a comment |Â
up vote
1
down vote
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. Moreover, I'd like to have the label 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 a suitable transpose of the tensor 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 = Transpose[
SparseArray[
Table[TensorProduct[GA[[i]], HA[[i]]], i, 1, m]],
1, 2, 4, 3, 5];
GHpat = GHA["NonzeroPositions"];
GH = Map[X [Function] X[[2 ;; 3]] -> X[[4 ;; 5]], X[[1]], GHpat];
My computer performs this task in 0.097 seconds. However, 0.0895 seconds (more thatn 90%!) are used just for transforming from and into the inefficient data format (list of rules). So, the actual computation needs less than 0.008 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.
Edit
And even this can be improved by observing that GH[[i]] is essentially the KroneckerProduct of GA[[i]] and HA[[i]]
GHA = ArrayReshape[
SparseArray[ Table[KroneckerProduct[GA[[i]], HA[[i]]], i, 1, m]],
m, Gn, Gn, Hn, Hn];
answered 20 mins ago
Henrik Schumacher
40.9k258123
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!
– erfink
12 mins ago
add a comment |Â
up vote
1
down vote
up vote
1
down vote
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. Moreover, I'd like to have the label 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 a suitable transpose of the tensor 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 = Transpose[
SparseArray[
Table[TensorProduct[GA[[i]], HA[[i]]], i, 1, m]],
1, 2, 4, 3, 5];
GHpat = GHA["NonzeroPositions"];
GH = Map[X [Function] X[[2 ;; 3]] -> X[[4 ;; 5]], X[[1]], GHpat];
My computer performs this task in 0.097 seconds. However, 0.0895 seconds (more thatn 90%!) are used just for transforming from and into the inefficient data format (list of rules). So, the actual computation needs less than 0.008 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.
Edit
And even this can be improved by observing that GH[[i]] is essentially the KroneckerProduct of GA[[i]] and HA[[i]]
GHA = ArrayReshape[
SparseArray[ Table[KroneckerProduct[GA[[i]], HA[[i]]], i, 1, m]],
m, Gn, Gn, Hn, Hn];
answered 20 mins ago
Henrik Schumacher
40.9k258123
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. Moreover, I'd like to have the label 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 a suitable transpose of the tensor 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 = Transpose[
SparseArray[
Table[TensorProduct[GA[[i]], HA[[i]]], i, 1, m]],
1, 2, 4, 3, 5];
GHpat = GHA["NonzeroPositions"];
GH = Map[X [Function] X[[2 ;; 3]] -> X[[4 ;; 5]], X[[1]], GHpat];
My computer performs this task in 0.097 seconds. However, 0.0895 seconds (more thatn 90%!) are used just for transforming from and into the inefficient data format (list of rules). So, the actual computation needs less than 0.008 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.
Edit
And even this can be improved by observing that GH[[i]] is essentially the KroneckerProduct of GA[[i]] and HA[[i]]
GHA = ArrayReshape[
SparseArray[ Table[KroneckerProduct[GA[[i]], HA[[i]]], i, 1, m]],
m, Gn, Gn, Hn, Hn];
answered 20 mins ago
Henrik Schumacher
40.9k258123
edited 9 mins ago
answered 20 mins ago
Henrik Schumacher
40.9k258123
answered 20 mins ago
Henrik Schumacher
40.9k258123
answered 20 mins ago
Henrik Schumacher
40.9k258123
40.9k258123
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!
– erfink
12 mins ago
add a comment |Â
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!
– erfink
12 mins ago
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!
– erfink
12 mins ago
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!
– erfink
12 mins ago
add a comment |Â
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
StackExchange.ready(
function ()
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f183201%2flabel-product-of-a-graph-with-itself%23new-answer', 'question_page');
);
Post as a guest
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password