Message Boards Message Boards

[GIF] Square and Triangle Curve Shortening Flows

GROUPS:

A few months ago, the thread Circle Morphing into a triangle came up. This thread falls short of discussing curvature flows, including the famous curve shortening flow. This is an important topic, leading to the more general Ricci flow, as discussed by Jim Isenberg on Numberfile. The purpose of this thread is to elaborate upon the earlier calculations by deforming square and triangle elliptic curves into circles, while preserving the interior area. As discussed elsewhere, the circle solves Dido's problem, to enclose maximum area by the least amount of cow's hide. Thus an area-preserving flow ending with a circle, by reverse logic, will usually be a curve lengthening flow. This can be proven rigorously for the two examples here by integrating the perimeter as a Fourier series expansion. Building upon the earlier humorous Arrival thread, future posts may explore seemingly obvious connections between elliptic curves and Zen drawings, especially Sengai's drawing, sometimes called "Circle, Triangle, Square", as seen on the cover of "The Zen Art Book" . Additional information about these calculations will eventually be made available in the form of a more serious article.

Curve Parameterizations and Areas

Quartic\[Phi]0 = ArcSin[Sqrt[4 \[Alpha] \[CapitalPhi]]]/2;
QuarticF[1] = 1/Sqrt[\[CapitalPhi]] Cos[Quartic\[Phi]0 - Pi/2];
QuarticF[2] = 1/Sqrt[\[CapitalPhi]] Cos[Quartic\[Phi]0];

Cubic\[Phi]0 = (2/3) ArcSin[3 Sqrt[3] x/2];
CubicF[n_] := 
 Sqrt[\[Alpha]] Divide[1 + 2 Cos[Cubic\[Phi]0 - n 2 Pi/3], 3 x] /. {
   x -> Sqrt[\[Alpha] ] \[CapitalPhi]}

A3 = \[Alpha] Hypergeometric2F1[1/3, 2/3, 2, 27 \[Alpha]/4];
A4 = \[Alpha] Hypergeometric2F1[1/2, 1/2, 2, \[Alpha]];

Triangle Animation: "△ Grow And Flow △"

TriangleGrow = PolarPlot[{
      1, Evaluate[
       Sqrt[1/A3] CubicF[1] /. \[CapitalPhi] -> 
          Cos[3 \[Phi]] /. {\[Alpha] -> 4/27}], Evaluate[
       Sqrt[1/A3 /. {\[Alpha] -> 4/27}] CubicF[1] /. \[CapitalPhi] -> 
          Cos[3 \[Phi]] /. {\[Alpha] -> #/1000 (4/27)}]}, {\[Phi], 0, 
      2 Pi}, PlotRange -> {{-2, 2}, {-2, 2}},
     PlotStyle -> {Gray, Gray, Directive[Thick, Black]}, 
     Axes -> False] & /@ (10 Range[0, 100]);

TriangleFlow = PolarPlot[{
      1, Evaluate[
       Sqrt[1/A3] CubicF[1] /. \[CapitalPhi] -> 
          Cos[3 \[Phi]] /. {\[Alpha] -> 4/27}], Evaluate[
       Sqrt[1/A3] CubicF[1] /. \[CapitalPhi] -> 
          Cos[3 \[Phi]] /. {\[Alpha] -> #/1000 (1/27)}]}, {\[Phi], 0, 
      2 Pi},
     PlotRange -> {{-2, 2}, {-2, 2}}, 
     PlotStyle -> {Gray, Gray, Directive[Thick, Black]}, 
     Axes -> False] & /@ Reverse[10 Range[400]];

TriangleFinal = PolarPlot[{
    Evaluate[
     Sqrt[1/A3] CubicF[1] /. \[CapitalPhi] -> 
        Cos[3 \[Phi]] /. {\[Alpha] -> 4/27}], 1}, {\[Phi], 0, 2 Pi},
   PlotRange -> {{-2, 2}, {-2, 2}}, 
   PlotStyle -> {Gray, Directive[Thick, Black]}, Axes -> False];

TriangleGrowFlow = Join[TriangleGrow, Table[TriangleGrow[[-1]], {100}],
   TriangleFlow, Table[TriangleFinal, {100}]];

ListAnimate[TriangleGrowFlow];

TriangleGrowFlow Youtube Video

Square Animation: "□ Grow and Flow □"

SquareGrow = PolarPlot[{
       1, 
       Evaluate[
        Sqrt[1/A4] QuarticF[
            1] /. \[CapitalPhi] -> (Cos[\[Phi]] Sin[\[Phi]])^2 /. {\
\[Alpha] -> 1}], Evaluate[
        Sqrt[1/A4 /. {\[Alpha] -> 1}] QuarticF[
            1] /. \[CapitalPhi] -> (Cos[\[Phi]] Sin[\[Phi]])^2 /. {\
\[Alpha] -> #/1000}]}, {\[Phi], 0, 2 Pi}, 
      PlotRange -> {{-2, 2}, {-2, 2}},
      PlotStyle -> {Gray, Gray, Directive[Thick, Black]}, 
      Axes -> False] & /@ (10 Range[0, 100]) // Quiet;

SquareFlow = PolarPlot[{
       1, 
       Evaluate[
        Sqrt[1/A4] QuarticF[
            1] /. \[CapitalPhi] -> (Cos[\[Phi]] Sin[\[Phi]])^2 /. {\
\[Alpha] -> 1}], Evaluate[
        Sqrt[1/A4] QuarticF[
            1] /. \[CapitalPhi] -> (Cos[\[Phi]] Sin[\[Phi]])^2 /. {\
\[Alpha] -> #/1000}]}, {\[Phi], 0, 2 Pi},
      PlotRange -> {{-2, 2}, {-2, 2}}, 
      PlotStyle -> {Gray, Gray, Directive[Thick, Black]}, 
      Axes -> False] & /@ Reverse[10 Range[100]] // Quiet;

SquareFinal = PolarPlot[{
     Evaluate[
      Sqrt[1/A4] QuarticF[

          1] /. \[CapitalPhi] -> (Cos[\[Phi]] Sin[\[Phi]])^2 /. {\
\[Alpha] -> 1}], 1}, {\[Phi], 0, 2 Pi},
    PlotRange -> {{-2, 2}, {-2, 2}}, 
    PlotStyle -> {Gray, Directive[Thick, Black]}, Axes -> False] // 
   Quiet;

SquareGrowFlow = Join[SquareGrow, Table[SquareGrow[[-1]], {100}],
   SquareFlow, Table[SquareFinal, {100}]];

ListAnimate[SquareGrowFlow]

Square Grow Flow Youtube Video

POSTED BY: Brad Klee
Answer
1 month ago

Group Abstract Group Abstract