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
Overlay3CycleTree[graph_]:=Module[{simple,coordinates,triangles,len,triedge,tricoord,tree},coordinates=Transpose[{VertexList[graph],GraphEmbedding[graph]}];simple=Graph[UndirectedEdge@@@EdgeList[SimpleGraph[graph]]];triangles=Sort[Sort[First/@#]&/@FindCycle[simple,{3},All]];len=Length[triangles];triedge=Select[Subsets[Range[len],{2}],Length[Intersection@@triangles[[#]]]2&];tricoord=Table[Insphere[Last/@coordinates[[Flatten[Position[First/@coordinates,#]&/@triangles[[tri]]]]]][[1]],{tri,1,Length[triangles]}];tree=Graph[Range[len],triedge,VertexCoordinatesThread[Range[len]tricoord],EdgeStyleRed,VertexStyleRed,VertexSize.01];tree];
(*hgraph[max_]:=Graph[UndirectedEdge@@@Flatten[Table[Sort/@(Partition[Table[2kPi/(2^n),{k,0,2^n-1}],2,1,1]/Pi),{n,1,max+1}],1]]*)
tgraph[max_]:=Module[{inf,len,triangles,triedge,tricoord2,argPoint},argPoint[arg_]:={Cos[arg],Sin[arg]};inf=Flatten[Table[Sort/@(Partition[Table[2kPi/(2^n),{k,0,2^n-1}],2,1,1]/Pi),{n,1,max+1}],1];triangles=SortBy[First/@#&/@FindCycle[Graph[UndirectedEdge@@@Union[inf]],{3},All],Max[Denominator/@#]&];len=Length[triangles];triedge=Select[Subsets[Range[len],{2}],Length[Intersection@@triangles[[#]]]2&];tricoord2=Table[(Log[2,Max[Denominator/@triangles[[k]]]]+2)Reverse[N[Mean[argPoint[Pi#]&/@triangles[[k]]]]],{k,1,len}];Graph[Range[len],triedge,VertexCoordinatesThread[Range[len]tricoord2]]]
hgraph[layers_]:=Module[{inf,extra,gg,coordinates,recenter,twist},If[layers<3,Return[Graph[UndirectedEdge@@@Flatten[Table[Sort/@(Partition[Table[2kPi/(2^n),{k,0,2^n-1}],2,1,1]/Pi),{n,1,layers+1}],1],VertexSizeSmall]]];inf=Flatten[Table[Sort/@(Partition[Table[2kPi/(2^n),{k,0,2^n-1}],2,1,1]/Pi),{n,1,layers+1}],1];extra=Select[Union[Flatten[inf]],Denominator[#]2^layers&];gg=Graph[UndirectedEdge@@@Join[inf,{#,2Numerator[#]}&/@extra,Partition[2Numerator/@extra,2,1,1]],GraphLayout"TutteEmbedding",VertexSize(1/6)^Sqrt[layers],EdgeStyle(#White&/@UndirectedEdge@@@Join[{#,2Numerator[#]}&/@extra,Partition[2Numerator/@extra,2,1,1]]),VertexStyle(#{White,EdgeForm[White]}&/@(2Numerator/@extra))];coordinates=Take[Transpose[{VertexList[gg],GraphEmbedding[gg]}],Length[Union[Flatten[inf,1]]]];recenter=Mean[{coordinates[[1,2]],coordinates[[2,2]]}];coordinates={#[[1]],#[[2]]-recenter}&/@coordinates;twist=RotationMatrix[3Pi/2+Arg[coordinates[[1,2]].{1,I}]];coordinates={#[[1]],Chop[#[[2]].twist]}&/@coordinates;Graph[UndirectedEdge@@@inf,VertexCoordinatesRule@@@coordinates,VertexSizeSmall]]
Table[Show[hgraph[k]],{k,1,6}]
Table[Show[Overlay3CycleTree[hgraph[k]]],{k,1,6}]
Table[Show[hgraph[k],Overlay3CycleTree[hgraph[k]]],{k,1,6}]
pts=;triangles=;Chop[Area[Polygon[pts[[#]]]]&/@triangles-1]//Tally
Out[]=
{{0,510}}
Table[Graphics[{EdgeForm[Black],White,Polygon[pts[[#]]]&/@Take[triangles,2^n-2]}],{n,2,7}]
Out[]=
ee=Union[Flatten[Sort/@Subsets[pts[[#]],{2}]&/@Take[triangles,2^8-2],1]];vv=Union[Flatten[ee,1]];gg=Graph[UndirectedEdge@@@ee,VertexCoordinatesThread[vvvv]];oo=Overlay3CycleTree[gg];oo
Circles
Circles
Code
Code
In[]:=
CurvatureToPoints[{a_,b_,c_}]:=0,1a+1b,++2
1
a
-a+b
(a+b)c
bc+a(b+c)
2
(a+b)
2
c
In[]:=
Curvature[{a_,b_,c_}]:=a+b+c+2
ab+ac+bc
In[]:=
CircleCenter[{{a_,b_,c_},{p_,q_,r_}}]:=With{d=Curvature[{a,b,c}]},Withj=,k=,Drop[First[Sort[{{Abs[Norm[p-j]-(Abs[1/a]+Abs[1/d])],d,j},{Abs[Norm[p-k]-(Abs[1/a]+Abs[1/d])],d,k}}]],1]
adp+bdq+cdr+2
abpq+acpr+bcqr
2
d
2
d
2
d
2
d
adp+bdq+cdr-2
abpq+acpr+bcqr
2
d
2
d
2
d
2
d
In[]:=
CurvatureOut[{a_,b_,c_}]:=a+b+c-2
ab+ac+bc
In[]:=
CircleCenterOut[{{a_,b_,c_},{p_,q_,r_}}]:=With{d=CurvatureOut[{a,b,c}]},d,
adp+bdq+cdr+2
abpq+acpr+bcqr
2
d
2
d
2
d
2
d
In[]:=
ToComplex[{a_,b_}]:=a+bI
In[]:=
InitialFour[k_]:=With[{pts=Flatten[{{CircleCenterOut[{k,CurvatureToPoints[k]}]},Transpose[{k,CurvatureToPoints[k]}]},1]},{pts,Sort[{Curvature[First/@Drop[pts,{#}]],Drop[Range[4],{#}]}&/@Range[4]]}]
In[]:=
Shuff[{a_,b_,c_},d_]:={{a,b,d},{a,c,d},{b,c,d}}
In[]:=
colors={LightGray,Green,Blue,Cyan,LightBlue,Yellow,Brown,Orange,LightGreen,LightPurple,LightBrown,LightRed};
Plan
Plan
Not graphs. To fix the foldovers I’ll need to dig into
Trees overlaidd on existing graph
Trees overlaidd on existing graph
Make trees regular
Make trees regular
Circle packing
Circle packing
Triangles same area
Triangles same area
Farey graph
Farey graph