Message Boards Message Boards

[GIF] Come Back (Fun with the square)

Fun with the square

Come Back

Same basic code as yesterday, but messed around with so that it's much less obvious that the underlying object is a regular octagon. No deep math, but fun nonetheless.

The code:

DynamicModule[{n = 8, k = 6, r, cols, verts},
 cols = RGBColor /@ {"#00ADB5", "#EEEEEE", "#FF5722", "#303841"};
 Manipulate[
  r = Cos[s];
  verts = 
   Table[(1 - r (-1)^(i + 1)) {Cos[2 ? i/n - ? (r + 1)/8], 
      Sin[2 ? i/n - ? (r + 1)/8]}, {i, 0, n - 1}];
  Graphics[{Thickness[.0075], CapForm["Round"], Opacity[.8], 
    Table[{Blend[cols[[;; 3]], 1 - Abs[11/5 t - 11/10]], 
      Line[{t verts[[i]] + (1 - t) RotateRight[verts, 3][[i]], 
        t RotateLeft[verts, k][[i]] + (1 - t) RotateLeft[verts, 
            k + 1][[i]]}]}, {i, 1, n - 1, 2}, {t, 1/12, 11/12, 
      1/12}]}, PlotRange -> 3, ImageSize -> 540, 
   Background -> cols[[4]]], {s, 0, ?}]]
9 Replies
Posted 5 years ago

This entry of Clayton's has been out for quite a while, but let me just belatedly write in to say that the expression for the Line[] can be simplified quite a bit:

Line[{{t, 1 - t}.verts[[{i, Mod[i - 3, n, 1]}]],
      {t, 1 - t}.verts[[Mod[i + k + {0, 1}, n, 1]]]}]

where we use Mod[] with an offset to find the required indices, instead of having to perform RotateLeft[]/RotateRight[].


A slight modification of the original code gives a pretty variation:

star-pentagon transition

DynamicModule[{n = 10, k = 6, r, verts,
               cols = RGBColor /@ {"#00adb5", "#eeeeee", "#ff5722", "#303841"}},
              Manipulate[r = Cos[s];
                         verts = Table[(1 - r (-1)^i)
                                       AngleVector[2 ? (i - 1)/n - ? (r + 1)/8],
                                       {i, n}];
                         Graphics[{Directive[Thickness[.0075], CapForm["Round"],
                                             Opacity[.8]],
                                   Table[{Blend[cols[[; ;-2]],
                                                1 - Abs[11/5 t - 11/10]],
                                          Line[{{t, 1 - t} .
                                                verts[[{i, Mod[i - 5, n, 1]}]],
                                                {t, 1 - t} .
                                                verts[[Mod[i + k + {0, 1}, n, 1]]]}]},
                                         {i, 1, n - 1, 2}, {t, 1/12, 11/12, 1/12}]},
                                  PlotRange -> 3, ImageSize -> 540,
                                  Background -> cols[[-1]]], {s, 0, 2 ?}]]
POSTED BY: J. M.

Nice! Love the pentagon and star!

Something about this colour scheme feels very 80s, yet modern. I think you're on to something here...

POSTED BY: Bianca Eifert

@Daniel Lichtblau I had never heard of Auskiewicz before, but his stuff is very cool. Reminds me a little of a current artist I like quite a bit, dalek.

I have an advantage there, having grown up across the street from him.

That dalek work is quite nice. Given the geographical proximity I have to wonder if or to what extent he is familiar with Anuskiewicz: Richard has been featured at the Brooklyn Museum and the Whitney amongst (many) other places.

POSTED BY: Daniel Lichtblau

enter image description here - another post of yours has been selected for the Staff Picks group, congratulations !

We are happy to see you at the tops of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!

POSTED BY: Moderation Team

@Moderation Team Awesome, thanks!

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