Code 1 (continuous but incorrect final embedding)
Code 1 (continuous but incorrect final embedding)
In[]:=
<<SetReplace`
In[]:=
hyperToGraph=SetReplace`OrderedHypergraphPlot`PackagePrivate`hyperedgesToGraph$regions;
In[]:=
constrainedEmbedding=SetReplace`OrderedHypergraphPlot`PackagePrivate`constrainedGraphEmbedding;
In[]:=
ListAnimate[With[{plotRange=(PlotRange/.AbsoluteOptions[Last@#,PlotRange])},Show[#,PlotRangeplotRange]&/@#]&@FoldList[Graph[hyperToGraph[#2],GraphLayout"SpringElectricalEmbedding",VertexCoordinates(VertexList[hyperToGraph[#2]]/.constrainedEmbedding[hyperToGraph[#2],Thread[VertexList[#](VertexCoordinates/.AbsoluteOptions[#,VertexCoordinates])&@#1]])]&,Graph[hyperToGraph[#〚1〛],GraphLayout"SpringElectricalEmbedding"],Rest@#]&@WolframModel[{{0,1},{0,2},{0,3}}{{4,5},{5,4},{4,6},{6,4},{5,6},{6,5},{4,1},{5,2},{6,3},{1,6},{3,4}},{{0,1},{0,2},{0,3}},4]["UpdatedStatesList"]]
Out[]=
In[]:=
OrderedHypergraphPlot@WolframModel[{{0,1},{0,2},{0,3}}{{4,5},{5,4},{4,6},{6,4},{5,6},{6,5},{4,1},{5,2},{6,3},{1,6},{3,4}},{{0,1},{0,2},{0,3}},4]["FinalState"]
Out[]=
Code 2 (discontinuous but correct final embedding)
Code 2 (discontinuous but correct final embedding)
In[]:=
ListAnimate[With[{plotRange=(PlotRange/.AbsoluteOptions[Last@#,PlotRange])},Show[#,PlotRangeplotRange]&/@#]&@FoldList[Graph[hyperToGraph[#2],GraphLayout{"SpringElectricalEmbedding","InitialValues"(VertexList[hyperToGraph[#2]]/.constrainedEmbedding[hyperToGraph[#2],Thread[VertexList[#](VertexCoordinates/.AbsoluteOptions[#,VertexCoordinates])&@#1]])}]&,Graph[hyperToGraph[#〚1〛],GraphLayout"SpringElectricalEmbedding"],Rest@#]&@WolframModel[{{0,1},{0,2},{0,3}}{{4,5},{5,4},{4,6},{6,4},{5,6},{6,5},{4,1},{5,2},{6,3},{1,6},{3,4}},{{0,1},{0,2},{0,3}},4]["UpdatedStatesList"]]
Out[]=