# Message Boards

Posted 3 years ago
3732 Views
|
4 Replies
|
8 Total Likes
|
 AdvanceJust 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}] ] 
4 Replies
Sort By:
Posted 3 years ago
 Simple and elegant! Thanks for sharing! Can this be extended to n-gons? pentagon? hexagon?
Posted 3 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: