3
$\begingroup$

Is it possible to create such kind of GIF via Mathematica?

animation

$\endgroup$
9
  • 7
    $\begingroup$ It is possible... $\endgroup$
    – Apple
    Nov 30, 2014 at 15:09
  • 5
    $\begingroup$ As @Chenminqi answered, it is possible. But before anyone actually show you the ways, it would be better you show the effort you have made. So what have you tried? $\endgroup$
    – Silvia
    Nov 30, 2014 at 15:13
  • $\begingroup$ @Silvia Writing code.. $\endgroup$
    – Apple
    Nov 30, 2014 at 15:35
  • 2
    $\begingroup$ a little bit related: Morphing a “sheet of paper” into a torus $\endgroup$
    – Kuba
    Nov 30, 2014 at 18:25
  • 2
    $\begingroup$ @LCFactorization I mean you might want to include a description (even better with some code) on what you have tried in solving the problem in Mathematica, so instead of accomplishing your work from scratch, people can see the specific point where you are stuck in, so they might have a better chance giving more specific and effective answers. That would fit more in the spirit of the site, also more polite for people who are reading and trying to answer your questions. :) $\endgroup$
    – Silvia
    Dec 2, 2014 at 4:35

2 Answers 2

9
$\begingroup$
Clear["Global`*"]
f[x_, θ_] = 
  RotationTransform[θ, {1, 0, 1}, {5 Pi, 0, 5 Pi}][{x, 
     0, -((10 Pi)/6) Sin[x] + 5 Pi}][[{1, 3}]];
p1 = ParametricPlot[{x, x}, {x, -10 Pi, 10 Pi}, 
   PlotRange -> {{-10 Pi, 10 Pi}, {-10 Pi, 10 Pi}, {-10 Pi, 10 Pi}}, 
   ImageSize -> 300, Axes -> True];
n = 7;
g[a_] := Evaluate[
   t^(1/n) (5 a π^2)/(1 + 5 a π) + (1 - t^(1/n)) (
       10 a π)/(1 + 5 a π) /. 
     t -> Rescale[a, {0.002, 2 Pi}, {0, 1}] // Simplify];
t = Pi;
Manipulate[
 If[var < Pi + 0.0025, 
  Show[p1, ParametricPlot[f[x, var], {x, -10 Pi, 10 Pi}]], 
  Show[p1, PolarPlot[
     5 Pi + 1/(var - t) - 
      5/3 π Sin[(2 Pi)/(2*g[var - t]/10) θ], {θ, -g[
        var - t], g[var - t]}, 
     PlotRange -> {{-10 Pi, 10 Pi}, {-10 Pi, 10 Pi}}, 
     ImageSize -> 300] /. 
    Line[data___] :> 
     Translate[Line[data], {-(1/(var - t)), 0}]]], {var, 0, 
  2 Pi + Pi}]

enter code here

The best way is take suitable discrete points of var artificially, not let var change uniform.

Update 1 A better solution from other people.

Manipulate[
 ParametricPlot[{1 - 1/y + 
    Cos[θ] (2 + 1/y - Sin[(10 θ)/y]), 
   Sin[θ] (2 + 1/y - 
      Sin[(10 θ)/y])}, {θ, -π y, π y}, 
  PlotRange -> {{-5, 5}, {-5, 5}}], {y, 0.01, 1}]
$\endgroup$
2
7
$\begingroup$

Here's a start, the 2nd transformation is tricky for me.

data = Table[{i, 0.1 Sin[100 i] + 0.7, 0}, {i, 0, 1, 0.01}];
gr = Graphics3D[{Thick, Red, Line@data}, Boxed -> False];
Manipulate[Graphics3D[
  {If[t < 0.1 Pi, {Dashed, Blue, Line[{{0, 0, 0}, {1, 1, 0}}]}, {}],
   Arrow[{{0.5, 0, 0}, {0.5, 1, 0}}],
   Arrow[{{0, 0.5, 0}, {1, 0.5, 0}}], 
   GeometricTransformation[{Thick, Red, Line@data}, 
    RotationTransform[t, {1, 1, 0}]]}, 
  PlotRange -> {{0, 1}, {0, 1}, {-1, 1}}, Boxed -> False, 
  SphericalRegion -> True, ViewPoint -> Top], {t, 0, 0.99 Pi}]

enter image description here

$\endgroup$
2
  • 1
    $\begingroup$ @hhh I cheated and used LiceCAP $\endgroup$ Dec 30, 2014 at 4:09
  • $\begingroup$ And now after getting angry I got the solution also to the other method here -- actually it is super easy also that way. So now two methods, hurray :D $\endgroup$
    – hhh
    Dec 30, 2014 at 4:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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