Message Boards Message Boards

GROUPS:

Circle Morphing into a triangle

Posted 1 year ago
2000 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] &
Attachment

Attachments:
5 Replies

"one-line"

nicely done!

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

enter image description here

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.

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

enter image description here - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming!

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