You are using a browser not supported by the Wolfram Cloud
Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.
I understand and wish to continue anyway »
WOLFRAM NOTEBOOK
Ordered Network Layout Debugging
Ordered Network Layout Debugging
Max Piskunov : 9a28d3dec6dc8d0699ef9a16a2145b5ae79faf3d
Source Code
Source Code
In[]:=
getResourceFunction[filename_]:=NotebookEvaluate[FileNameJoin[filename],EvaluationElements"InitializationCell"]
In[]:=
getResourceFunction[FileNameJoin[{$Dropbox,"Physics/CodeDevelopment/FunctionRepositorySources",#<>".nb"}]]&/@{"OrderedGraphModelPlot"};
Debugging
Debugging
In[]:=
InputForm[OrderedGraphModelPlot[{{6,9,12},{11,7,1},{5,10,2},{8,4,3}}]]
Out[]//InputForm=
Graph[{1, 2, 3, 4}, {UndirectedEdge[1, 2], UndirectedEdge[1, 3], UndirectedEdge[1, 4],
UndirectedEdge[2, 4], UndirectedEdge[2, 3], UndirectedEdge[3, 4]},
{EdgeStyle -> {Directive[GrayLevel[0.5], Thickness[Large]]},
GraphLayout -> {Dimension -> 2}, PerformanceGoal -> Quality,
VertexCoordinates -> {{0.880095814601738, 0.013156064124647815},
{0.013242690904806398, 0.}, {0.8663279571038569, 0.8780079864151075}, {0.,
0.8656690492208879}}, VertexShapeFunction ->
{Function[{center$, name$, size$},
If[name$ <= Length[{{6, 9, 12}, {11, 7, 1}, {5, 10, 2}, {8, 4, 3}}],
IconObject[center$, (If[IntegerQ[#1], {coordinates$7149[[Quotient[2 + #1, 3]]],
#1, name$}, {coordinates$7149[[Length[{{6, 9, 12}, {11, 7, 1}, {5, 10, 2}, {
8, 4, 3}}] + First[#1]]], #1}] & ) /@
{{6, 9, 12}, {11, 7, 1}, {5, 10, 2}, {8, 4, 3}}[[name$]], Max[size$]],
{LightGray, Dotted, Circle[center$, Max[size$]]}]]}, VertexSize -> {Small},
VertexStyle -> {Directive[GrayLevel[0.5], Thickness[Large]]}}]
UndirectedEdge[2, 4], UndirectedEdge[2, 3], UndirectedEdge[3, 4]},
{EdgeStyle -> {Directive[GrayLevel[0.5], Thickness[Large]]},
GraphLayout -> {Dimension -> 2}, PerformanceGoal -> Quality,
VertexCoordinates -> {{0.880095814601738, 0.013156064124647815},
{0.013242690904806398, 0.}, {0.8663279571038569, 0.8780079864151075}, {0.,
0.8656690492208879}}, VertexShapeFunction ->
{Function[{center$, name$, size$},
If[name$ <= Length[{{6, 9, 12}, {11, 7, 1}, {5, 10, 2}, {8, 4, 3}}],
IconObject[center$, (If[IntegerQ[#1], {coordinates$7149[[Quotient[2 + #1, 3]]],
#1, name$}, {coordinates$7149[[Length[{{6, 9, 12}, {11, 7, 1}, {5, 10, 2}, {
8, 4, 3}}] + First[#1]]], #1}] & ) /@
{{6, 9, 12}, {11, 7, 1}, {5, 10, 2}, {8, 4, 3}}[[name$]], Max[size$]],
{LightGray, Dotted, Circle[center$, Max[size$]]}]]}, VertexSize -> {Small},
VertexStyle -> {Directive[GrayLevel[0.5], Thickness[Large]]}}]
In[]:=
OrderedGraphModelPlot[{{6,9,12},{11,7,1},{5,10,2},{8,4,3}}]
Out[]=
shapeFunction=Function[{center$,name$,size$},If[name$≤4,IconObject[center$,(If[IntegerQ[#1],{coordinates$7149〚Quotient[2+#1,3]〛,#1,name$},{coordinates$7149〚4+First[#1]〛,#1}]&)/@{{6,9,12},{11,7,1},{5,10,2},{8,4,3}}〚name$〛,Max[size$]],{LightGray,Dotted,Circle[center$,Max[size$]]}]];
In[]:=
shapeFunction[{0.880095814601738,0.013156064124647815},1,0.1]
Out[]=
In[]:=
Graphics[{shapeFunction[{0.880095814601738,0.013156064124647815},1,0.1],shapeFunction[{0.013242690904806398,0.},2,0.1],Point[{{0.880095814601738,0.013156064124647815},{0.013242690904806398,0.},{0.8663279571038569,0.8780079864151075},{0.,0.8656690492208879}}],Point[coordinates$7149]}]
Out[]=
In[]:=
Graph[{1,2,3,4},{12,13,14,24,23,34},{EdgeStyle{Directive[GrayLevel[0.5],Thickness[Large]]},GraphLayout{"Dimension"2},PerformanceGoal"Speed",VertexCoordinates{{0.880095814601738,0.013156064124647815},{0.013242690904806398,0.},{0.8663279571038569,0.8780079864151075},{0.,0.8656690492208879}},VertexShapeFunction{Function[{center$,name$,size$},If[name$≤4,IconObject[center$,(If[IntegerQ[#1],{coordinates$7149〚Quotient[2+#1,3]〛,#1,name$},{coordinates$7149〚4+First[#1]〛,#1}]&)/@{{6,9,12},{11,7,1},{5,10,2},{8,4,3}}〚name$〛,Max[size$]],{LightGray,Dotted,Circle[center$,Max[size$]]}]]},VertexSize{Small},VertexStyle{Directive[GrayLevel[0.5],Thickness[Large]]}},AxesTrue,EpilogPoint[coordinates$7149]]
Out[]=
In[]:=
Graph[{1,2,3,4},{12,13,14,24,23,34},{EdgeStyle{Directive[GrayLevel[0.5],Thickness[Large]]},GraphLayout{"Dimension"2},PerformanceGoal"Quality",VertexCoordinates{{0.880095814601738,0.013156064124647815},{0.013242690904806398,0.},{0.8663279571038569,0.8780079864151075},{0.,0.8656690492208879}},VertexShapeFunction{Function[{center$,name$,size$},Echo[If[name$≤4,IconObject[center$,(If[IntegerQ[#1],{coordinates$7149〚Quotient[2+#1,3]〛,#1,name$},{coordinates$7149〚4+First[#1]〛,#1}]&)/@{{6,9,12},{11,7,1},{5,10,2},{8,4,3}}〚name$〛,Max[size$]],{LightGray,Dotted,Circle[center$,Max[size$]]}]]]},VertexSize{Small},VertexStyle{Directive[GrayLevel[0.5],Thickness[Large]]}},AxesTrue,EpilogPoint[coordinates$7149]]
»
,Disk[{0.880096,0.0131561},0.0432481,{-3.05378,-0.769763}],,Disk[{0.880096,0.0131561},0.0432481,{-0.769763,1.51427}],,Disk[{0.880096,0.0131561},0.0432481,{1.51427,3.22941}]
»
,Disk[{0.0132427,0.},0.0432481,{3.94203,1.65802}],,Disk[{0.0132427,0.},0.0432481,{1.65802,-0.0571952}],,Disk[{0.0132427,0.},0.0432481,{-0.0571952,-2.34116}]
»
,Disk[{0.866328,0.878008},0.0432481,{-1.48361,-3.19898}],,Disk[{0.866328,0.878008},0.0432481,{3.08421,0.800316}],,Disk[{0.866328,0.878008},0.0432481,{0.800316,-1.48361}]
»
,Disk[{0.,0.865669},0.0432481,{0.0872233,2.37124}],,Disk[{0.,0.865669},0.0432481,{-3.91195,-1.62788}],,Disk[{0.,0.865669},0.0432481,{-1.62788,0.0872233}]
Out[]=
In[]:=
Graph{1,2,3,4},{12,13,14,24,23,34},EdgeStyle{Directive[GrayLevel[0.5],Thickness[Large]]},GraphLayout{"Dimension"2},PerformanceGoal"Quality",VertexCoordinates{{0.880095814601738,0.013156064124647815},{0.013242690904806398,0.},{0.8663279571038569,0.8780079864151075},{0.,0.8656690492208879}},VertexShapeFunctionFunction{center$,name$,size$},,Disk[center$,0.04324807514183682`,{-3.0537795870018405`,-0.7697634994034039`}],,Disk[center$,0.04324807514183681`,{-0.7697634994034037`,1.514271168283424`}],,Disk[center$,0.04324807514183681`,{1.5142711682834242`,3.229405720177746`}],VertexSize{Small},VertexStyle{Directive[GrayLevel[0.5],Thickness[Large]]},EpilogPoint[coordinates$7149]
Out[]=