3
$\begingroup$

I want to animate the curve given by $\alpha(t) = (u(t), v(t))$ being traced out (and also showing the tangent and normal vector at each point), where $u$ and $v $ are the solutions below

Clear[u, v];
{u, v} = {u[t], v[t]} /. 
   NDSolve[{u'[t]^2 + v'[t]^2 == 1, 
      u'[t] v''[t] - u''[t] v'[t] == u[t] v'[t] - v[t] u'[t], 
      u'[0] == Sin[0.18], v'[0] == Cos[0.18]}, {u[t], v[t]}, {t, -7.5,
       7.5}][[1]];

I would like to do something very similar to what's done here (I don't think this is a duplicate), but I tried and couldn't adapt his code to my purpose.

$\endgroup$
5
$\begingroup$

Maybe like this:

Clear[u, v];
{u, v} = NDSolveValue[{
    u'[t]^2 + v'[t]^2 == 1,
    u'[t] v''[t] - u''[t] v'[t] == u[t] v'[t] - v[t] u'[t],
    u'[0] == Sin[0.18], v'[0] == Cos[0.18]
    },
   {u, v}, 
   {t, -7.5, 7.5}
   ];
tangent[t_] = {D[u[t], t], D[v[t], t]}/Sqrt[D[u[t], t]^2 + D[v[t], t]^2];
normal[t_] = {-D[v[t], t], D[u[t], t]}/Sqrt[D[u[t], t]^2 + D[v[t], t]^2];
curvature[t_] = D[tangent[t], t]/Sqrt[D[u[t], t]^2 + D[v[t], t]^2];

Now the plot:

background = ParametricPlot[{u[t], v[t]}, {t, -7.5, 7.5}];
Manipulate[
 Show[
  background,
  Graphics[{Point[{u[t], v[t]}],
    Arrow[{{u[t], v[t]}, {u[t], v[t]} + tangent[t]}],
    Arrow[{{u[t], v[t]}, {u[t], v[t]} + curvature[t]}]
    }]
  ],
 {t, -7.5, 7.5}
 ]

enter image description here

$\endgroup$
  • $\begingroup$ The system already includes a condition that the curve is parameterized by arclength, do we need to normalize it again when defining the tangent an normal vectors? $\endgroup$ – Matheus Andrade Sep 13 '18 at 16:13
  • 1
    $\begingroup$ Good point. Not necessarily. However, this way, the formula for the curvature is correct for any regular, parameterized curve. It is sort of a habit of mine and maybe that might still be interesting for you. An interesting curve by the way. Does it have an analytical parameterization? Looks like the projected of a trefoil knot onto the plane... $\endgroup$ – Henrik Schumacher Sep 13 '18 at 16:18
  • $\begingroup$ I'm pretty sure it doesn't have an analitycal parameterization, which is pretty unfortunate for me (otherwise I think the author who discovered it when writing his PhD thesis would've included it there). Oh, and it's still interesting for me, thanks for your help, it means a lot! $\endgroup$ – Matheus Andrade Sep 13 '18 at 16:20
  • $\begingroup$ You're welcome. Hm. Is the "true" (undiscretized) solution known to be periodic? Long time simulations show some rotation of the perihel, but that might be due to numerical errors. $\endgroup$ – Henrik Schumacher Sep 13 '18 at 16:22
  • $\begingroup$ I don't think so, no. Maybe have a look here (page 26), I'm sure things are better explained there. $\endgroup$ – Matheus Andrade Sep 13 '18 at 16:26
1
$\begingroup$

As the OP notes, the fact that the unit speed condition is already imposed in the ODE can be exploited:

{us, vs} = NDSolveValue[{u'[t]^2 + v'[t]^2 == 1, 
                         u'[t] v''[t] - u''[t] v'[t] == u[t] v'[t] - v[t] u'[t], 
                         u'[0] == Sin[0.18], v'[0] == Cos[0.18]}, {u, v}, {t, -7.5, 7.5}];

Manipulate[ListLinePlot[Transpose[Through[{us, vs}["ValuesOnGrid"]]], 
                        AspectRatio -> Automatic, Frame -> True,
                        Epilog -> With[{p = Through[{us, vs}[t]], 
                                        ta = Through[{us', vs'}[t]]},
                                       {Arrow[{p, p + ta}],
                                        Arrow[{p, p + (us'[t] vs''[t] - vs'[t] us''[t])
                                                  Cross[ta]}], Point[p]}]], {t, -7.5, 7.5}]

curve, tangent, and normal

$\endgroup$
5
$\begingroup$

This is a case for FrennetSerretSystem. You can define

{{curvature[t_]}, {tangent[t_], normal[t_]}} = FrenetSerretSystem[{u[t], v[t]}, t];

Then this will plot it with the unit normal:

background = ParametricPlot[{u[t], v[t]}, {t, -7.5, 7.5}];
Manipulate[
 Show[
  background,
  Graphics[{Point[{u[t], v[t]}],
    Arrow[{{u[t], v[t]}, {u[t], v[t]} + tangent[t]}],
    Arrow[{{u[t], v[t]}, {u[t], v[t]} + normal[t]}]
    }]
  ],
 {t, -7.5, 7.5}
 ]

Then this will plot it with the normal scaled by the curvature:

background = ParametricPlot[{u[t], v[t]}, {t, -7.5, 7.5}];
Manipulate[
 Show[
  background,
  Graphics[{Point[{u[t], v[t]}],
    Arrow[{{u[t], v[t]}, {u[t], v[t]} + tangent[t]}],
    Arrow[{{u[t], v[t]}, {u[t], v[t]} + curvature[t]normal[t]}]
    }]
  ],
 {t, -7.5, 7.5}
 ]
$\endgroup$

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.