In[]:=
geodesic[{z1_,z2_}]:=Module[{x1=Re[z1],x2=Re[z2],y1=Im[z1],y2=Im[z2],det,center,arg1,arg2,argMax,argMin},det=4(x1*y2-y1*x2);If[Abs[det]<10^(-3),Line[{{x1,y1},{x2,y2}}],center=2/det((Im[z2-z1]+Im[z2]Abs[z1]^2-Im[z1]Abs[z2]^2)+I*(Re[z1-z2]+Re[z1]Abs[z2]^2-Re[z2]Abs[z1]^2));arg1=Arg[z1-center];arg2=Arg[z2-center];argMax=Max[arg1,arg2];argMin=Min[arg1,arg2];If[argMax-argMin≥Pi,argMin=argMin+2Pi];Circle[{Re[center],Im[center]},Abs[center-z1],{argMin,argMax}]]];
In[]:=
vertex[kot_,n_]:=Module[{abs,r=(Sin[Pi/n]/Sin[(kot+Pi)/2])^2/(1-(Sin[Pi/n]/Sin[(kot+Pi)/2])^2)},abs=Sqrt[1+2r-2Sqrt[r(1+r)]Cos[Pi-kot/2-Pi/2-Pi/n]];abs*Cos[Pi/n]+I*abs*Sin[Pi/n]];
In[]:=
rotate[zc_,kot_,z_]:=(E^(I*kot)(z-zc)/(1-z*Conjugate[zc])+zc)/(1+E^(I*kot)Conjugate[zc](z-zc)/(1-z*Conjugate[zc]));
In[]:=
rotateGeodesic[{zc_,z_},kot_]:={(E^(I*kot)(z-zc)/(1-z*Conjugate[zc])+zc)/(1+E^(I*kot)Conjugate[zc](z-zc)/(1-z*Conjugate[zc])),zc};
In[]:=
reflectnGon[stranica_,n_,m_]:=Rest[NestList[rotateGeodesic[#,2Pi/m]&,stranica,n-1]];
In[]:=
fillAround[nGon_,n_,m_]:=Flatten[Map[reflectnGon[Reverse[#],n,m]&,nGon],1];
In[]:=
geodesicsForTiling[n_,m_,nivo_,c_]:=Module[{oglisca0,oglisca},oglisca0=N[Partition[Map[(#+c)/(1+Conjugate[c]#)&,NestList[rotate[0,2Pi/n,#]&,vertex[2Pi/m,n],n]],2,1]];oglisca=Flatten[NestList[fillAround[#,n,m]&,oglisca0,nivo],2];oglisca0=Partition[oglisca,2];oglisca=Xgeodesic/@Union[Round[Map[Sort,oglisca0],.001]]];
In[]:=
geodesicsForTilingGray[n_,m_,nivo_,c_]:=Module[{oglisca0,oglisca},oglisca0=N[Partition[Map[(#+c)/(1+Conjugate[c]#)&,NestList[rotate[0,2Pi/n,#]&,vertex[2Pi/m,n],n]],2,1]];oglisca=Round[NestList[fillAround[#,n,m]&,oglisca0,nivo],.0001];oglisca0=Map[geodesic/@#&,oglisca];oglisca=DeleteDuplicates[Flatten[Table[Prepend[oglisca0[[i]],Opacity[(nivo+2-i)/(nivo+1)]],{i,nivo+1}],1]](*oglisca=Union[Round[Map[Sort,oglisca0],.0001]]*)];
In[]:=
nivo[n_,m_]:=If[n>3,Floor[m/2],If[m7,11,If[m8,10,If[m≤20,9,7]]]];
In[]:=
noMin[n_]:=If[n3,7,If[n4,5,If[n5||n6,4,3]]];noMax[n_]:=If[MemberQ[{3,4,5},n],13,If[n6,10,8]]
In[]:=
obj37=With[{n=3,m=7},geodesicsForTiling[n,m,nivo[n,m],0]]
Out[]=
In[]:=
Graphics[%]
Out[]=
In[]:=
obj37/.Circle[{x_,y_},r_,{t1_,t2_}]f[{x+rCos[t1],y+rSin[t1]},{x+rCos[t2],y+rSin[t2]}]
In[]:=
Graph[%283/.fUndirectedEdge]
Out[]=
In[]:=
obj37=With[{n=3,m=7},geodesicsForTiling[n,m,nivo[n,m],0]]
Out[]=
In[]:=
hg37=Graph[%287/.Xgeodesic[{a_,b_}]:>UndirectedEdge[a,b]]
Out[]=
In[]:=
GraphPlot3D[%]
Out[]=
Sphere section
Sphere section
Given refinement to make it n edges around the sphere
r^d (1 + r^2 R)
All lengths are measured in units of the elementary length
Bumps
Bumps