5
$\begingroup$

I am trying to plot something like the Frenet-Serret Formulas using a parametric plot, like this:

    r[t_] := {t, t^2, 2 t^3/3}
    t[t_] := r'[t]/Norm[r'[t]]
    Manipulate[ParametricPlot3D[{r[t]}, {t, 0, p} 
      PlotRange -> {{-0.1, 1.1}, {-0.1, 1.1}, {-0.1, 1.1}}], {p, 10^-10, 1}]

Now I would like to have the function t[x] also plotted, but as a single vector at the coordinates of the current point r[p].

This probably helps to visualize what I am trying to do, as it is exactly the same thing: Frenet-Serret Frame moving along a parametric helix

The helix would be my function r and t is the first of those three vectors that I would like to see moving around.

I tried two things, first using

Manipulate[ParametricPlot3D[{r[t]}, {t, 0, p} 
      PlotRange -> {{-0.1, 1.1}, {-0.1, 1.1}, {-0.1, 1.1}},
 Epilog -> {Arrow[{r[p], t[p]}]}], {p, 10^-10, 1}]

But the Arrow is shown as an overlay in 2D above the plot, and then

Manipulate[ParametricPlot3D[{r[t]}, {t, 0, p} 
      PlotRange -> {{-0.1, 1.1}, {-0.1, 1.1}, {-0.1, 1.1}},
 Epilog -> {ParametricPlot3D[t[p]*u, {u, 0, 1}] /. Line -> Arrow}], {p, 10^-10, 1}]

which I cannot get to work because ParametricPlot3D is not a primitive that can be shown in Epilog

So, any ideas? I'm sure, because I'm just a noob.

Thanks in advance guys and have a nice day :)

$\endgroup$
7
$\begingroup$

The problem is that Epilog creates a 2D graphic that is overlayed on top of the main image. From the Details section of the documentation

In three-dimensional graphics, two-dimensional graphics primitives can be specified by the Epilog option.

Thus we have to create a seperate 3D object and "overlay"/superimpose it onto the parametric plot with Show. And to make sure we can always see all or the arrows (i.e. make it so the arrows don't go outside of the bounding box), we need to find the right plot range.

Finding the right plot range

Summary: We need to find the minimum of the minima and the maximum of the maxima of each coordinate of each vector over the parametric domain.

Given the curves

r[t_] := {t, t^2, 2 t^3/3}
v[t_] := Normalize[r'[t]] /. Abs[x_] :> x

the probably-not-best-way to find the right plot range is to find the minimum and maximum values of each coordinate of each vector over the whole time.

(
  {NMinValue[{#, 0 < t < 1}, t], NMaxValue[{#, 0 < t < 1}, t]} & /@ (
    r[t] + 0.5 Normalize@#
  )
) & /@ {v[t], v'[t], Cross[v[t], v'[t]]}
{
  (*Min and Max for each x,y,z for v[t]*)
  {{0.5, 1.16667}, {0., 1.33333}, {1.42102*10^-19, 1.}}, 
  (*v'[t]*)              {{7.95036*10^-15, 0.666667}, {0.414214, 0.833333}, {0., 1.}}, 
  (*Cross[v[t], v'[t]]*) {{0., 1.33333}, {-0.164252, 0.666667}, {0.415978, 0.833333}}
}

Then group them by coordinate

Transpose[%, {3, 2, 1}]
{
  {
    (*Minimum x for v[t], v'[t], Cross[v[t], v'[t]]*) 
    {0.5, 7.95036*10^-15, 0.}, 
    (*y*) {0., 0.414214, -0.164252}, 
    (*z*) {1.42102*10^-19, 0., 0.415978}
  }, 
  (*Maxima*) {
    {1.16667, 0.666667, 1.33333},
    {1.33333, 0.833333, 0.666667},
    {1., 1., 0.833333}}
}

Then find the minimal minimum and maximal maximum of each coordinate so that each vector is always within the formed box.

infimumbox = Transpose@{Min /@ %[[1]], Max /@ %[[2]]}
{
 (*Min, Max x for all vectors over time*) {0., 1.33333}, 
 (*y*) {-0.164252, 1.33333}, 
 (*z*) {0., 1.}
}

And those edges form the smallest cuboid that holds all three vectors over the whole parametric domain.

Making the animation

Now that we have a plot range infimumbox, we can animate the problem.

Since we need to plot from zero to something positive, we can't include p = 0 in our time/parametric domain. So instead we choose the closest thing, $MinMachineNumber.

Manipulate[
 Show[
  ParametricPlot3D[
   r[t],
   {t, 0, p}, 
   PlotRange -> infimumbox
  ],
  Graphics3D[
   {Thickness[.006],
    {Red, Arrow[{r[p], r[p] + 0.5 Normalize@t[p]}]},
    {Blue, Arrow[{r[p], r[p] + 0.5 Normalize[t'[p]]}]},
    {Darker[Green, 3/5], Arrow[{r[p], r[p] + 0.5 Normalize@Cross[t[p], t'[p]]}]}
   }
  ],
  PlotRange -> infimumbox
 ],
 {p, $MinMachineNumber, 1, Animator}
]

enter image description here

Another example (a simple helix i.e. r[t_] := {Cos[2 π t], Sin[2 π t], 0.5 t} which yields infimumbox = {{-1.11733, 1.11733}, {-1.11733, 1.11733}, {0., 2.06922}} over the domain of $MinMachineNumber <= t <= π) that clearly shows the relationship between the vectors.

enter image description here

$\endgroup$
  • $\begingroup$ Thanks, this is exactly what I wanted! Accepted! But two more questions: 1) Is there any way to specify an open interval so you dont have that nasty 0.001 in {p, 0.001, 1, Animator} ? And 2), whats the best way to keep them arrows from disappearing to the outside of the bounding box without making them smaller or the box bigger? $\endgroup$ – JustAGuy Nov 11 at 19:13
  • $\begingroup$ Wow thank you very much, this is way more than I could have hoped for! If I could upvote again I definitely would, this has helped me a lot to understand how the Mathematica Language and Phiilosophy works! $\endgroup$ – JustAGuy Nov 12 at 21:49
4
$\begingroup$

Try Show:

Manipulate[Show[
  ParametricPlot3D[{r[t]}, {t, 0, p}, 
   PlotRange -> {{-0.1, 1.1}, {-0.1, 1.1}, {-0.1, 1.1}}],
  Graphics3D@Arrow[{r[p], t[p]}]
  ], {p, 10^-10, 1}]

enter image description here

$\endgroup$
  • $\begingroup$ Thanks, would have accepted this as well, but @That Gravity Guy 's answer is slightly more detailed. Thanks in any case! $\endgroup$ – JustAGuy Nov 11 at 19:15
  • $\begingroup$ @JustAGuy You're welcome! $\endgroup$ – MelaGo Nov 11 at 22:58

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.