# Circle Morphing into a triangle

Posted 3 years ago
5227 Views
|
5 Replies
|
13 Total Likes
|
 In this youtube video Coding Challenge #81.1: Circle Morphing there is this guy solving a Javascript code challenge about morphing an equilateral triangle into a circle. Here is a one-line Wolfram expression written in a pure functional style that returns the solution using only built-in function. {Interpolation[#2, InterpolationOrder -> 1], Most@Array[# &, 50, {#1, #2}] & @@ #1} &~MapThread~( Partition[#, 2, 1] & /@ {First@Transpose@#, #} &@Table[{Cos@x, Sin@x}, {x, -Pi/6, 2 Pi - Pi/6, 2 Pi/3}]) // Join @@ MapThread[Transpose@{#2, #1@#2} &, Transpose@#] & // Transpose@{#, Most@N@Table[{Cos@x, Sin@x}, {x, -Pi/6, 2 Pi - Pi/6, 2 Pi/(Length@#)}]} & // Animate[.5 (Sin@k First@# + (1 - Sin@k) Last@#) & /@ Append[#, First@#] // Graphics[{Thickness@.01, Line@#}, PlotRange -> {{-.5, .5}, {-.6, .6}}] &, {k, 0, Pi/2}, AnimationDirection -> ForwardBackward, AnimationRate -> .5] &  Attachments: Answer
5 Replies
Sort By:
Posted 3 years ago
 "one-line"nicely done! Answer
Posted 3 years ago
 tri[n_] = Sum[RealAbs[x Cos[(2 \[Pi] i)/3] + y Sin[(2 \[Pi] i)/3] - 1/3]^ n, {i, 3}] - 1; ContourPlot[ Evaluate[Table[tri[n] == 0, {n, 2, 10}]], {x, -1.5, 1.5}, {y, -1.5, 1.5}]  Answer
Posted 3 years ago
 Interesting! But it seems that your code simply plots different polynomial functions. I would not call this a proper morphing. In my example, we start with some points forming a tringle and some points forming the circle. Then, all the intermediate lists of points are generated by averaging the corresponding points with a shifting weight. As a matter of fact, if you replace the first table (which defines the three triangle vertexes) Table[{Cos@x, Sin@x}, {x, -Pi/6, 2 Pi - Pi/6, 2 Pi/3}] with some random points like RandomReal[{},{8,2}] the code generates a morphing from those random points to the circle. In general you can even get rid of the circle and start with two lists of points having the same lenght; my code will morph one into the other. Answer
Posted 3 years ago
 Here's a similar idea, with different coding, and a dynamic clock to animate the morphing: CirclePoints[{1., Pi/2}, 3*25] // {Join @@ MapThread[Most@*Subdivide, {#, RotateLeft@#, #2 {1, 1, 1}}] &[CirclePoints[{1., Pi/2}, 3 ], Length@#/3], #} & // Graphics[ GraphicsComplex[ {Cos[Clock[Infinity]], Sin[Clock[Infinity]]}^2 .# // Dynamic, {EdgeForm[Thick], White, Polygon@Range@Length@First@#} ], PlotRange -> 1.02] & Answer
Posted 3 years ago - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming! Answer