Message Boards

WOLFRAM COMMUNITY

10473 Views

4 Replies

8 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Staff Picks Mathematics Visual Arts Dynamic Interactivity Geometry Graphics and Visualization Wolfram Language

[GIF] Advance (Morphing squares)

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 8 years ago

Advance Just some recursive squares morphing into diamonds. Source code: midpoints[pts_] := Mean[{#, RotateLeft[#]} &[pts]]; smootherstep[x_] := 6 x^5 - 15 x^4 + 10 x^3; DynamicModule[ {cols = RGBColor /@ {"#2677bb", "#fbfbfb"}, pts = 2 Sqrt[2] CirclePoints[4], t}, Animate[ t = smootherstep[Mod[s, 1]]; Graphics[{ Table[{FaceForm[ If[OddQ[i] && s < 1 \|\| EvenQ[i] && s >= 1, cols[[1]], cols[[2]]]], Polygon[Riffle[#[[i]], (1 + t) midpoints[#[[i]]]]]}, {i, 1, Length[#]}] &@NestList[midpoints, pts, 30]}, PlotRange -> {{-4/3.99, 4/3.99}, {-.99, .99}}, ImageSize -> {800, 600}], {s, 0, 2}] ]

Morphing squares

Advance

Just some recursive squares morphing into diamonds.

Source code:

midpoints[pts_] := Mean[{#, RotateLeft[#]} &[pts]];

smootherstep[x_] := 6 x^5 - 15 x^4 + 10 x^3;

DynamicModule[
 {cols = RGBColor /@ {"#2677bb", "#fbfbfb"}, 
  pts = 2 Sqrt[2] CirclePoints[4], t},
 Animate[
  t = smootherstep[Mod[s, 1]];
  Graphics[{
    Table[{FaceForm[
         If[OddQ[i] && s < 1 || EvenQ[i] && s >= 1, cols[[1]], cols[[2]]]], 
        Polygon[Riffle[#[[i]], (1 + t) midpoints[#[[i]]]]]}, {i, 1, Length[#]}] &@NestList[midpoints, pts, 30]},
   PlotRange -> {{-4/3*.99, 4/3*.99}, {-.99, .99}}, ImageSize -> {800, 600}],
  {s, 0, 2}]
 ]

POSTED BY: Clayton Shonkwiler

4 Replies

Sort By:

EDITORIAL BOARD

EDITORIAL BOARD, WOLFRAM

Posted 8 years ago

- Congratulations! This post is now Staff Pick! Thank you for your wonderful contributions. Please, keep them coming!

POSTED BY: EDITORIAL BOARD

Sander Huisman

Sander Huisman, University of Twente

Posted 8 years ago

Nice! But it 'hurts' watching it morph, my brain can't handle it, not a good idea...

POSTED BY: Sander Huisman

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 8 years ago

Sure. Just use `CirclePoints[n]` instead of `CirclePoints[4]` and make the appropriate modification to the scaling on `midpoints[#[[i]]]`. Plug in your preferred `n` in the following code and play around with `depth` until the center completely fills in: midpoints[pts_] := Mean[{#, RotateLeft[#]} &[pts]]; smootherstep[x_] := 6 x^5 - 15 x^4 + 10 x^3; DynamicModule[ {n = 8, depth = 100, cols = RGBColor /@ {"#2677bb", "#fbfbfb"}, pts, t}, pts = 2 Sqrt[2.] CirclePoints[n]; Animate[ t = smootherstep[Mod[s, 1]]; Graphics[{ Table[ {FaceForm[If[OddQ[i] && s < 1 \|\| EvenQ[i] && s >= 1, cols[[1]], cols[[2]]]], Polygon[Riffle[#[[i]], (1 + t (Sec[?/n]^2 - 1)) midpoints[#[[i]]]]]}, {i, 1, Length[#]}] &@NestList[midpoints, pts, depth]}, PlotRange -> 1, ImageSize -> 540], {s, 0., 2}] ] Here's what comes out for octagons:

Sure. Just use CirclePoints[n] instead of CirclePoints[4] and make the appropriate modification to the scaling on midpoints[#[[i]]].

Plug in your preferred n in the following code and play around with depth until the center completely fills in:

midpoints[pts_] := Mean[{#, RotateLeft[#]} &[pts]];

smootherstep[x_] := 6 x^5 - 15 x^4 + 10 x^3;

DynamicModule[
 {n = 8, depth = 100, cols = RGBColor /@ {"#2677bb", "#fbfbfb"}, pts, t},
 pts = 2 Sqrt[2.] CirclePoints[n];
 Animate[
  t = smootherstep[Mod[s, 1]];
  Graphics[{
    Table[
       {FaceForm[If[OddQ[i] && s < 1 || EvenQ[i] && s >= 1, cols[[1]], cols[[2]]]], 
        Polygon[Riffle[#[[i]], (1 + t (Sec[?/n]^2 - 1)) midpoints[#[[i]]]]]},
       {i, 1, Length[#]}] &@NestList[midpoints, pts, depth]},
   PlotRange -> 1, ImageSize -> 540],
  {s, 0., 2}]
 ]

Here's what comes out for octagons:

Morphing nested octagons