Icosahedron fractal
Sándor Kabai
A double tower of icosahedra is aligned along each edge of a larger enveloping icosahedron. A tower stacks gradually diminishing icosahedra on the face of an icosahedron. The rate of reduction is 1/2, and each tower could theoretically have an infinite number of icosahedra converging to a vertex of the enveloping icosahedron. Each icosahedron in the assembly could be replaced with a fractal icosahedron to form an infinite fractal structure.
A double tower of icosahedra is aligned along each edge of a larger enveloping icosahedron. A tower stacks gradually diminishing icosahedra on the face of an icosahedron. The rate of reduction is 1/2, and each tower could theoretically have an infinite number of icosahedra converging to a vertex of the enveloping icosahedron. Each icosahedron in the assembly could be replaced with a fractal icosahedron to form an infinite fractal structure.
In[]:=
fi=1.618;alf=ArcTan[fi];bet=ArcTan[1/fi];bet1=ArcTan[1/fi^2];ico=GraphicsComplex[PolyhedronData["Icosahedron","VertexCoordinates"],Polygon[PolyhedronData["Icosahedron","FaceIndices"]]];icoc=Rotate[{ico},alf+bet1,{0,1,0}];tow1=Table[{Translate[Scale[icoc,(1/2^i)*{1,1,1},{0,0,0}],Sum[1/2^n,{n,1,i}]*{0,0,2.2673}]},{i,1}];tow2=Rotate[Rotate[tow1,-Pi/3,{0,0,1}],-2alf-bet1,{0,1,0}];edge=Rotate[{icoc,tow1,tow2},Pi/2-bet1,{0,1,0}];icoline={AbsoluteThickness[5],GraphicsComplex[PolyhedronData["Icosahedron","VertexCoordinates"],Line[PolyhedronData["Icosahedron","EdgeIndices"]]]};icoedge=Scale[Rotate[Rotate[icoline,alf,{0,1,0}],Pi/2,{0,0,1}],fi^3{1,1,1}];e1=Translate[edge,{0,0,2.618}];e2=Rotate[e1,Pi,{1,0,0}];e3=Rotate[Rotate[{e1,e2},Pi/2,{1,0,0}],Pi/2,{0,0,1}];e4=Rotate[Rotate[{e1,e2},Pi/2,{0,0,1}],Pi/2,{1,0,0}];e5=Table[Rotate[Rotate[{e1,e2,e3,Yellow,e4},bet,{0,1,0}],i2Pi/5,{0,0,1}],{i,5}];icoenv=Scale[icoline,fi^3{1,1,1},{0,0,0}];Graphics3D[{e5,Red,icoenv},ViewPoint->{0,0,100},BoxedFalse,SphericalRegionTrue]
Out[]=
In[]:=
Graphics3D[{edge,icoedge},ViewPoint->{0,0,100},BoxedFalse,SphericalRegionTrue]
Out[]=
In[]:=
icofr=Scale[e5,1/fi^3{1,1,1},{0,0,0}];icoc=Rotate[{icofr},alf+bet1,{0,1,0}];tow1=Table[{Translate[Scale[icoc,(1/2^i)*{1,1,1},{0,0,0}],Sum[1/2^n,{n,1,i}]*{0,0,2.2673}]},{i,1}];tow2=Rotate[Rotate[tow1,-Pi/3,{0,0,1}],-2alf-bet1,{0,1,0}];edge=Rotate[{icoc,tow1,tow2},Pi/2-bet1,{0,1,0}];icoline1={AbsoluteThickness[7],GraphicsComplex[PolyhedronData["Icosahedron","VertexCoordinates"],Line[PolyhedronData["Icosahedron","EdgeIndices"]]]};icoenv1=Scale[icoline1,fi^3{1,1,1},{0,0,0}];e1=Translate[edge,{0,0,2.618}];e2=Rotate[e1,Pi,{1,0,0}];e3=Rotate[Rotate[{e1,e2},Pi/2,{1,0,0}],Pi/2,{0,0,1}];e4=Rotate[Rotate[{e1,e2},Pi/2,{0,0,1}],Pi/2,{1,0,0}];fin=Table[Rotate[Rotate[{e1,e2,RGBColor[0,1,1],e3,Yellow,e4},bet,{0,1,0}],i2Pi/5,{0,0,1}],{i,5}];Graphics3D[{fin,Red,icoenv1},ViewPoint->{0,0,100},BoxedFalse,SphericalRegionTrue]