In[]:=
argPoint[arg_]:={Cos[arg],Sin[arg]};
In[]:=
PLine[arg1_,arg2_]:=IfNCos
arg2-arg1
2
0,Line[{argPoint[arg1],argPoint[arg2]}],IfN[arg2-arg1>π],PLine[arg2,arg1],IfN[arg2-arg1]<0,PLine[arg1,arg2+2π],CircleSec
arg2-arg1
2
argPoint
arg1+arg2
2
,Tan
arg2-arg1
2
,arg2+
π
2
,arg1-
π
2
+If[N[arg2+π]>arg1,2π,0];
In[]:=
PPerp[{arg1_,arg2_},arg3_]:=2ArcTan@@intersectionline[argPoint[arg1],argPoint[arg2]],lineargPoint[arg3],arg3+
π
2
-arg3;
In[]:=
line[p1_List,p2_List]:=line[p1,ArcTan@@(p2-p1)];
In[]:=
intersection[line[{x1_,y1_},a1_],line[{x2_,y2_},a2_]]:={x1,y1}+argPoint[a1](a/.Flatten[{NSolve[{x1+aCos[a1]x2+bCos[a2],y1+aSin[a1]y2+bSin[a2]},{a,b}],a
6
10.
}]);
In[]:=
PTree[a1_,{a2_,a3_},lev_]:=If[lev0,PLine[a2,a3],{PLine[a2,a3],PTree[a2,{PPerp[{a2,a3},a1],a3},lev-1],PTree[a3,{a2,PPerp[{a2,a3},a1]},lev-1]}];
In[]:=
trinest[{a1_,a2_,a3_},lev_]:={PTree[a1,{a2,a3},lev],PTree[a2,{a3,a1},lev],PTree[a3,{a1,a2},lev]};
In[]:=
With[{t1=Pi/2,t2=Pi},Table[Graphics[{​​{RGBColor[.33,.26,.78],Circle[]},​​Line[{{-1,0},{1,0}}],​​trinest[N[{0,t1,If[t2t1,t2+.001,t2]}],recursion]​​},​​PlotRange1.05,ImageSizeTiny],{recursion,0,7}]]
Out[]=
In[]:=
Table[Graphics[{{RGBColor[.33,.26,.78],Circle[]},​​Line[{{0,-1},{0,1}}],​​Table[PLine[#[[1]],#[[2]]]&/@N[Partition[Table[2kPi/(2^n),{k,0,2^n-1}],2,1,1]],{n,1,step+1}]},ImageSize->Tiny,PlotRange{{-1,1},{-1,1}}],​​{step,8}]
Out[]=
In[]:=
Graph[Rule@@@#,GraphLayout"SpringElectricalEmbedding",ImageSizeTiny,VertexStyleResourceFunction["WolframPhysicsProjectStyleData"]["SpatialGraph","VertexStyle"],​​EdgeStyleResourceFunction["WolframPhysicsProjectStyleData"]["SpatialGraph","EdgeLineStyle"]]&/@ResourceFunction["WolframModel"][{{x,y},{y,z}}{{w,x},{w,y},{x,y},{y,z}},{{0,0},{0,0}},9,"StatesList"]
Out[]=
Out[]=