0
$\begingroup$

I was looking for a nice visualization of the homotopy of the square to the circle.

I produced the following code. Albeit, it isn't great, but it works out OK.

My question is:

Is there a better way to get Mathematica to homotope one curve into another?

z[t_] = {1/2 Cos[2 Pi t], 1/2 Sin[2 Pi t] + 1/2};
Manipulate[ParametricPlot[{{z[t]},
   (*)First 8th of the circle CC-Direction (/*)
   (1 - s) {1/2, 1/2 + t/2} + (s)*z[t/8],
   (*)Second 8th of the circle CC-Direction (/*)
   (1 - s) {1/2 + -t/2, 1} + (s)*z[t/8 + 1/8],
   (*)Third 8th of the circle CC-Direction (/*)
   (1 - s) {-t/2, 1} + (s)*z[t/8 + 2/8],
   (*)Fourth 8th of the circle CC-Direction  (/*)
   (1 - s) {-1/2, 1 - t/2} + (s)*z[t/8 + 3/8],
   (*)Fifth 8th of the circle CC-Direction  (/*)
   (1 - s) {-1/2, 1/2 - t/2} + (s)*z[t/8 + 4/8],
   (*)Sixth 8th of the circle CC-Direction  (/*)
   (1 - s) {t/2 - 1/2, 0} + (s)*z[t/8 + 5/8],
   (*) Seventh 8th of the circle CC-Direction  (/*)
   (1 - s) {t/2, 0} + (s)*z[t/8 + 6/8],
   (*)Eigth 8th of the circle CC-Direction  (/*)
   (1 - s) {1/2, t/2} + (s)*z[t/8 + 7/8]},
  {t, 0, 1}, Axes -> False], {s, 0, 1}]
$\endgroup$
3
$\begingroup$

You already got the correct idea implemented. Everything else is refactoring your code to make it more readable/changeable and to include eye candy.

curve1 = {Cos[2 π #], Sin[2 π #]} &;

curve2 = Piecewise[{
  {{1, 8 #}, # <= 1/8},
  {{2 - 8 #1, 1}, # <= 3/8},
  {{-1, 4 - 8 #1}, # <= 5/8},
  {{-6 + 8 #1, -1}, # <= 7/8},
  {{1, -8 + 8 #1}, True}}] &;

background = 
  ParametricPlot[{curve1[x], curve2[x]}, {x, 0, 1}, PlotStyle -> {Red, Green}];

Manipulate[
 Animate[Show[background, 
   ParametricPlot[d curve1[x] + (1 - d) curve2[x], {x, 0, 1} , 
    PlotStyle -> Blue], 
   Graphics[{PointSize[.02], Red, Point[curve1[t]], Green, 
     Point[curve2[t]], Blue, 
     Point[d curve1[t] + (1 - d) curve2[t]]}]], {t, 0, 1}],
  {{d, .5}, 0, 1}]

enter image description here

$\endgroup$
3
$\begingroup$

An easy parametric realization is

Show@Table[
ContourPlot[Abs[x]^(2 u) + Abs[y]^(2 u) == 1, {x, -1, 1}, {y, -1,1},MaxRecursion -> 3], {u,Join[Range[.1, 1, .1], 1/Range[.1, 1, .1]]}]

enter image description here

which covers the map "cross-rhombus-circle-square"

$\endgroup$
2
$\begingroup$

How is this one?

Φ = {ϕ, p} \[Function] Normalize[{Cos[ϕ], Sin[ϕ]}, Norm[#, p] &]
Manipulate[
 ParametricPlot[Φ[ϕ, 1 + Tan[s Pi/2]], {ϕ, -π, π}, 
  PlotRange -> {{-1.1, 1.1}, {-1.1, 1.1}}
  ],
 {s, 0, 0.9999999999}]
$\endgroup$
  • $\begingroup$ This is an excellent answer for the square to the circle, and vice versa. However, I'm looking for something a little more general. I'm hoping there is some feature that I haven't been able to find in my searching, or some technique I may not be aware of. $\endgroup$ – Chickenmancer Jul 16 '18 at 20:29
  • $\begingroup$ Is it about homotopies or isotopies. Homotopies are easy as long as you allow the curves to move through all of $\R^d$ since $\R^d$ is simply connected. Isotopies are more difficult and in general, two curves need not be isotopic to each other. $\endgroup$ – Henrik Schumacher Jul 16 '18 at 20:32
  • $\begingroup$ I'm just considering homotopies for now. $\endgroup$ – Chickenmancer Jul 16 '18 at 20:41
  • $\begingroup$ Then \[Gamma][s] (1 - t) + t \[Eta][s] should do for each pair if parameterized curves \[Gamma] and \[Eta]. $\endgroup$ – Henrik Schumacher Jul 16 '18 at 20:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.