In[]:=
ReconstructedSurface[WolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p6g},{p3g,p4y},{p4y,p3g},{p4g,p5y},{p5y,p4g},{p5g,p6y},{p6y,p5g},{p6g,p3y}},init,9,"FinalState"],5]
Out[]=
In[]:=
ReconstructedSurface[WolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p6g},{p3g,p4y},{p4y,p3g},{p4g,p5y},{p5y,p4g},{p5g,p6y},{p6y,p5g},{p6g,p3y}},init,10,"FinalState"],5]
In[]:=
FindCanonicalWolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p6g},{p3g,p4y},{p4y,p3g},{p4g,p5y},{p5y,p4g},{p5g,p6y},{p6y,p5g},{p6g,p3y}}]
Out[]=
{{1,2,3},{4,5,6},{1,4},{4,1}}{{2,7,8},{3,9,10},{5,11,12},{6,13,14},{7,10},{10,7},{8,13},{13,8},{9,12},{12,9},{11,14},{14,11}}
In[]:=
FindCanonicalWolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p6g},{p3g,p4y},{p4y,p3g},{p4g,p5y},{p5y,p4g},{p5g,p6y},{p6y,p5g},{p6g,p3y}}]
Out[]=
{{1,2,3},{4,5,6},{1,4},{4,1}}{{2,7,8},{3,9,10},{5,11,12},{6,13,14},{7,10},{10,7},{8,13},{13,8},{9,12},{12,9},{11,14},{14,11}}
In[]:=
init
Out[]=
{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r},{p1y,p2y},{p2y,p1y},{p1g,p2g},{p2g,p1g}}
In[]:=
Join[Table[{0,0,0},2],Table[{0,0},6]]
Out[]=
{{0,0,0},{0,0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0}}
In[]:=
wm1=WolframModel[{{1,2,3},{4,5,6},{1,4},{4,1}}{{2,7,8},{3,9,10},{5,11,12},{6,13,14},{7,10},{10,7},{8,13},{13,8},{9,12},{12,9},{11,14},{14,11}},{{0,0,0},{0,0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0}},9,"FinalState"];
In[]:=
HypergraphPlot[wm1]
Out[]=
In[]:=
FindCanonicalHypergraph[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r},{p1y,p2y},{p2y,p1y},{p1g,p2g},{p2g,p1g}}]
Out[]=
{{1,2,3},{4,5,6},{1,4},{4,1},{2,5},{5,2},{3,6},{6,3}}
In[]:=
HypergraphPlot[WolframModel[{{1,2,3},{4,5,6},{1,4}}{{2,7,8},{3,9,10},{5,11,12},{6,13,14},{13,8},{7,10},{9,12},{11,14}},{{1,2,3},{4,5,6},{1,4},{4,1},{2,5},{5,2},{3,6},{6,3}},10,"FinalState"]]
Out[]=
$Aborted[]
In[]:=
HypergraphPlot[WolframModel[{{1,2,3},{4,5,6},{1,4}}{{2,7,8},{3,9,10},{5,11,12},{6,13,14},{13,8},{7,10},{9,12},{11,14}},{{1,2,3},{4,5,6},{1,4},{4,1},{2,5},{5,2},{3,6},{6,3}},8,"FinalState"]]
Out[]=
In[]:=
HypergraphPlot[WolframModel[{{1,2,3},{4,5,6},{1,4}}{{2,7,8},{3,9,10},{5,11,12},{6,13,14},{13,8},{7,10},{9,12},{11,14}},{{1,2,3},{4,5,6},{1,4},{2,5},{3,6}},8,"FinalState"]]
Out[]=
