Message Boards

WOLFRAM COMMUNITY

11925 Views

5 Replies

13 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Staff Picks Mathematics Recreation Dynamic Interactivity Geometry Graphics and Visualization Wolfram Language Challenges

Circle Morphing into a triangle

Nicola Cattabiani

Nicola Cattabiani, University of Brescia

Posted 7 years ago

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:

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

POSTED BY: Nicola Cattabiani

5 Replies

Sort By:

Sander Huisman

Sander Huisman, University of Twente

Posted 7 years ago

"one-line" nicely done!

POSTED BY: Sander Huisman

Frank Kampas

Frank Kampas, Physicist at Large Consulting

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

POSTED BY: Frank Kampas

Nicola Cattabiani

Nicola Cattabiani, University of Brescia

Posted 7 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.

POSTED BY: Nicola Cattabiani

Michael Rogers

Michael Rogers, Emory University

Posted 7 years ago

Here's a similar idea, with different coding, and a dynamic clock to animate the morphing: CirclePoints[{1., Pi/2}, 325] // {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] &

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

POSTED BY: Michael Rogers