Message Boards

WOLFRAM COMMUNITY

10764 Views

5 Replies

15 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

[GIF] Ennea (nonagons centered on unit circle)

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 9 years ago

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}]

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}]

POSTED BY: Clayton Shonkwiler

5 Replies

Sort By:

EDITORIAL BOARD

EDITORIAL BOARD, WOLFRAM

Posted 4 years ago

-- you have earned *Featured Contributor Badge* 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!

POSTED BY: EDITORIAL BOARD

Tom Ackerman

Tom Ackerman, Wolfram|Alpha

Posted 9 years ago

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

POSTED BY: Tom Ackerman

Vitaliy Kaurov

Vitaliy Kaurov, WOLFRAM Research

Posted 9 years ago

@Tom Ackerman I have seen a lot of similar works, including those by PATAKK. Here is a fluid polyhedral blob from PATAKK: And here is Wolfram Language version that a user named Rahul built on Stack Exchange forum: 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]

@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]

POSTED BY: Vitaliy Kaurov