Have you heard of geodesic dome and the related architectural ideas of German engineer Walther Bauersfeld and Buckminster Fuller -- American architect, systems theorist, writer, designer, inventor, philosopher, and futurist. Think of Montreal Biosphere, the Climatron greenhouse at the Missouri Botanical Garden in St. Louis, or Science World in Vancouver, Canada:
But sometimes such smooth familiar shapes hide in seemingly not relevant objects -- like in digital art animation we will build in this post. Below I do minimal explanation and update of the code from our sister form on Stack Exchange. Programmers there decided to recreate digital art by Paolo Čerić in the Wolfram Language.
Let’s start from a very simple polyhedron shape -- dodecahedron:
Dodecahedron[]//Graphics3D
Out[]=
To create a geodesic dome from it subdivide faces into triangles and project on to a sphere (source):
In the Wolfram Language there are a few ways to do this. We will use the Wolfram Function Repository entry GeodesateMesh (while alternatively we could go with built in in 13.1 GeodesicPolyhedron). The integer 4 defines order-4 regular tessellation of each face.
gd = ResourceFunction["GeodesateMesh"][Dodecahedron[], 4]
Out[]=
Next we simply got from a Mesh to a GraphicsComplex, which is best suitable for Graphics3D function:
poly = GraphicsComplex[MeshCoordinates[gd], MeshCells[gd, 2]]
Out[]=
GraphicsComplex[{{-0.794654,0.57735,-0.187592},{-0.844774,0.472802,-0.250632},
⋯478⋯
,{-0.823386,0.251148,0.508881},{-0.786966,0.118632,0.605484}},{
⋯1⋯
}]
Full expression not available
(
original memory size:
227.2 kB)
Now will define some parameters:
In[]:=
amplitude = 0.15;​​twist = 4;​​verts = poly[[1]];​​faces = poly[[2]];​​phases = RandomReal[2 Pi, Length[verts]];
and functions for twisting each face randomly but smoothly without tearing gaps using RotationMatrix:
In[]:=
newverts[t_] := ​​ MapIndexed[{Sequence @@ (RotationMatrix[twist Last[#1]].Most[#1]), ​​ Last[#1]} (1 + amplitude Sin[t + phases[[First@#2]]]) &, ​​ verts];​​newpoly[t_] := GraphicsComplex[newverts[t], faces];
And finally the next code builds a sequence of frames
In[]:=
duration = 1.5;​​fps = 24;​​frames = Most@​​ Table[Graphics3D[{EdgeForm[], newpoly[t]}, ​​ PlotRange -> Table[{-(1 + amplitude), (1 + amplitude)}, {3}],ViewAnglePi/6,​​ ViewPoint -> Front, Background -> Black, Boxed -> False,ImageSize250], {t, 0, ​​ 2 Pi, 2 Pi/(duration fps)}];
that can be exported to an animation, like a GIF or a video:
Export["geodesate.gif",frames,"DisplayDurations"->.03]//AbsoluteTiming
Out[]=
{34.7315,geodesate.gif}
or animated within the notebook using, for instance ListAnimate:
ListAnimate[frames, fps,AnimationRunningFalse]
Out[]=
Looks nothing like a geodesic dome? Well, we just added a little twist to it :-)

CITE THIS NOTEBOOK

Twisting faces of geodesic dome​
by Vitaliy Kaurov​
Wolfram Community, STAFF PICKS, August 16, 2022
​https://community.wolfram.com/groups/-/m/t/2599801