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]
In[]:=
Out[]=
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}}]
In[]:=
{{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}}
Out[]=
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}}]
In[]:=
{{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}}
Out[]=
init
In[]:=
{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r},{p1y,p2y},{p2y,p1y},{p1g,p2g},{p2g,p1g}}
Out[]=
Join[Table[{0,0,0},2],Table[{0,0},6]]
In[]:=
{{0,0,0},{0,0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0}}
Out[]=
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]
In[]:=
Out[]=
FindCanonicalHypergraph[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r},{p1y,p2y},{p2y,p1y},{p1g,p2g},{p2g,p1g}}]
In[]:=
{{1,2,3},{4,5,6},{1,4},{4,1},{2,5},{5,2},{3,6},{6,3}}
Out[]=
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"]]
In[]:=
$Aborted[]
Out[]=
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"]]
In[]:=
Out[]=
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"]]
In[]:=
Out[]=
GraphPlot[HypergraphToGraph[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}},10,"FinalState"]]]
In[]:=
Out[]=
GraphPlot3D[HypergraphToGraph[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}},10,"FinalState"]]]
In[]:=
Out[]=
HypergraphPlot[{{1,2,3},{4,5,6},{1,4},{4,1},{2,5},{5,2},{3,6},{6,3}}]
In[]:=
Out[]=
wm=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}},10,"FinalState"];
In[]:=
ReconstructedSurface[wm,8]
In[]:=
Out[]=
ReconstructedSurface[wm,3]
In[]:=
Out[]=
ReconstructedSurface[wm,4]
In[]:=
Out[]=
ReconstructedSurface[wm,11]
In[]:=
Out[]=