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}}
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