Message Boards Message Boards

GROUPS:

[GIF] Ennea (nonagons centered on unit circle)

Posted 6 years ago
5007 Views
|
5 Replies
|
15 Total Likes
|

Twenty 9-gons rotating on a blue background

Ennea

I described some of my difficulties making this in this thread, where you can also see the (slightly gross) solution I eventually came up with.

Anyway, technical details aside, this is conceptually pretty simple: 20 regular 9-gons centered on points on the unit circle, rotating. It was inspired by some work of Thomas Davis.

Given the technique used to produce it, a Manipulate is kind of pointless, so here's the exact code used to generate the GIF:

ninegons = Module[{n, m, cols},
   n = 9;
   m = 20;
   cols = Insert[#, First[#], 4] &[RGBColor /@ {"#E45171", "#F8A79B", "#F8D99B", "#002C6A"}];
   ParallelTable[Module[{imglist},
       imglist = Table[Graphics[Table[{FaceForm[Directive[Blend[cols[[;; 4]], Mod[\[Theta]/(2 \[Pi]), 1]], Opacity[.1]]], 
            EdgeForm[Directive[Blend[cols[[;; 4]], Mod[\[Theta]/(2 \[Pi]), 1]], Thickness[.004]]], 
            Polygon[Table[{Cos[\[Theta] + \[Pi]/2] + Cos[\[Phi] + \[Theta] + 2 \[Pi]/n (1/2 - Cos[t]/2 + Mod[n/4, 1])], 
               Sin[\[Theta] + \[Pi]/2] + Sin[\[Phi] + \[Theta] + 2 \[Pi]/n (1/2 - Cos[t]/2 + Mod[n/4, 1])]}, 
                {\[Phi], 0, 2 \[Pi] - 2 \[Pi]/n, 2 \[Pi]/n}]]}, 
            {\[Theta], 2 \[Pi] i/m, 2 \[Pi] (m + i - 2)/m, 2 \[Pi]/m}], 
          PlotRange -> 3, ImageSize -> 540, Background -> None], 
          {i,1, m}];
       ImageCompose[Graphics[Background -> cols[[5]], ImageSize -> 540], Blend[imglist]]
       ], {t, 0, \[Pi] - #, #}] &[\[Pi]/40]];

Export[NotebookDirectory[] <> "ninegons.gif", ninegons, "DisplayDurations" -> {1/24}]
5 Replies

Very nice. You might consider also submitting a version to demonstrations.wolfram.com.

Beautiful, @Clayton Shonkwiler and quite hypnotic.

Awesome! Makes me want to try re-creating some of this guy's stuff.

@Tom Ackerman I have seen a lot of similar works, including those by PATAKK. Here is a fluid polyhedral blob from PATAKK:

enter image description here

And here is Wolfram Language version that a user named Rahul built on Stack Exchange forum:

enter image description here

Needs["PolyhedronOperations`"]
poly = Geodesate[PolyhedronData["Dodecahedron", "Faces"], 4];

amplitude = 0.15;
twist = 4;
verts = poly[[1]];
faces = poly[[2]];
phases = RandomReal[2 Pi, Length[verts]];
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];

duration = 1.5;
fps = 24;
frames = Most@
   Table[Graphics3D[{EdgeForm[], newpoly[t]}, 
     PlotRange -> Table[{-(1 + amplitude), (1 + amplitude)}, {3}], 
     ViewPoint -> Front, Background -> Black, Boxed -> False], {t, 0, 
     2 Pi, 2 Pi/(duration fps)}];
ListAnimate[frames, fps]

enter image description here -- you have earned Featured Contributor Badge enter image description here Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract