0
$\begingroup$

I have the following program that describes a 3D curve in space with an osculating circle and TNB vectors moving with the curve. The arrows indicating the TNB vectors are way too large making it seem as if only the arrowheads are plotted. I can make the shaft visible as well by changing the plot range but this zooms the curve showing just a small portion of it. The curve is a circular helix.

    Module[
    {r, tmin, tmax, Mag, curvature, radius, T, Tprime, NNN, B, thecircle},
    r[t_] = {5*Cos[3 t], 5*Sin[3 t], 3 (t - Pi)};
    Mag[w_] = Sqrt[w.w];
    curvature[t_] = 
      Mag[Cross[D[r[t], t], D[D[r[t], t], t]]]/Mag[D[r[t], t]]^3;
    radius[t_] = If[curvature[t] == 0, 9999, 1/curvature[t]];

    T[t_] = D[r[t], t]/Sqrt[D[r[t], t].D[r[t], t]];
    Tprime[t_] = D[T[t], t];
    NNN[t_] = 
      If[Tprime[m] == {0, 0}, {0, 0}, Tprime[m]/Sqrt[Tprime[m].Tprime[m]]];
    B[t_] = Cross[T[t], NNN[t]];

    thecircle[t0_] := Module[
      {},
      transMat = Transpose[{T[t0], NNN[t0], B[t0]}];
      center1 = radius[t0]*NNN[t0] + r[t0];
      circle1[r_] := {r*Cos[t], r*Sin[t], 0};
      graphthis = 
        transMat.circle1[radius[t0]] + {center1[[1]], center1[[2]], 
          center1[[3]]};
      ParametricPlot3D[graphthis, {t, 0, 2 Pi}, MaxRecursion -> 0, 
        PlotStyle -> Purple]
      ]; (* End Module *)

    Animate[Show[
      ParametricPlot3D[
        r[t], {t, 0, 2 Pi}, PerformanceGoal -> "Quality"
        ],
      thecircle[m],
      (*these are the TNB arrow*)
      Graphics3D[{{Thick, Darker@Red, 
          Arrow[{r[m], r[m] + T[m]}]}, {Thick, Darker@Green, 
          Arrow[{r[m], r[m] + B[m]}]}, {Thick, Darker@Cyan, 
          Arrow[{r[m], r[m] + NNN[m]}]},
        {PointSize[0.02], Point[r[m]]}
        }],
      AspectRatio -> Automatic, ImageSize -> {500, 375}, PlotRange -> 25,
        Boxed -> False, Axes -> False, SphericalRegion -> True, 
      ViewAngle -> .14
      ], {s, -1, 1}](*end show*)
    ](*end module*), 
        {
      {fcn, 1, "curve: "}, {1 -> "circular helix"}, 
    ControlType -> RadioButtonBar
      },
        {
      {m, 0, "position on curve"}, 0, 2 Pi
      },
        TrackedSymbols :> {m, fcn}]
$\endgroup$
  • 1
    $\begingroup$ When I copy and paste your code to run it, I get errors. Can you please check your code? $\endgroup$ – march Feb 13 at 17:35
  • $\begingroup$ Look in the docs for 'Arrowheads' $\endgroup$ – N.J.Evans Feb 13 at 17:43
  • $\begingroup$ @march missing end of Manipulate. Add ']' to end of code. I have modified it for ease $\endgroup$ – Kizito Nwaka Feb 13 at 18:09
  • $\begingroup$ That didn't fix it. It seems like you have an extra square bracket somewhere in the middle of the code. Maybe copy and paste everything over again? $\endgroup$ – march Feb 13 at 18:44
  • $\begingroup$ @march codeshare.io/5gveO0 that's link to code for your convenience $\endgroup$ – Kizito Nwaka Feb 13 at 18:54
0
$\begingroup$

So TPrime should take parameters t, not m. The arrowheads can be made smaller by

Arrowheads[size],Arrow{[r[m],r[m] + 5*T[t]]} 

(for tangent vector, etc. The 5 increases the magnitude making the arrow shaft longet)

full working code below

  Manipulate[
    Module[
      {r, tmin, tmax, Mag, curvature, radius, T, Tprime, NNN, B, 
      thecircle},
      r[t_] = {5*Cos[3 t], 5*Sin[3 t], 3 (t - Pi)};
      Mag[w_] = Sqrt[w.w];
      curvature[t_] = 
      Mag[Cross[D[r[t], t], D[D[r[t], t], t]]]/Mag[D[r[t], t]]^3;
      radius[t_] = If[curvature[t] == 0, 9999, 1/curvature[t]];

      T[t_] = D[r[t], t]/Sqrt[D[r[t], t].D[r[t], t]];
      NNN[t_] = If[T'[t] == {0, 0}, {0, 0}, T'[t]/Sqrt[T'[t].T'[t]]];
      B[t_] = Cross[T[t], NNN[t]];

      thecircle[t0_] := Module[
        {},
        transMat = Transpose[{T[t0], NNN[t0], B[t0]}];
        center1 = radius[t0]*NNN[t0] + r[t0];
        circle1[r_] := {r*Cos[t], r*Sin[t], 0};
        graphthis = 
        transMat.circle1[radius[t0]] + {center1[[1]], center1[[2]], 
          center1[[3]]};
        ParametricPlot3D[graphthis, {t, 0, 2 Pi}, MaxRecursion -> 0, 
        PlotStyle -> Purple]
        ]; (* End Module *)

      Animate[Show[
        ParametricPlot3D[
        r[t], {t, 0, 2 Pi}, PerformanceGoal -> "Quality"
        ],
        thecircle[m],
        Graphics3D[{{Thick, 
          Darker@Red, {Arrowheads[0.02], 
            Arrow[{r[m], r[m] + 5*T[m]}]}}, {Thick, 
          Darker@Green, {Arrowheads[0.02], 
            Arrow[{r[m], r[m] + 5*B[m]}]}}, {Thick, 
          Darker@Cyan, {Arrowheads[0.02], 
            Arrow[{r[m], r[m] + 5*NNN[m]}]}},
          {PointSize[0.02], Point[r[m]]}
          }],
        AspectRatio -> Automatic, ImageSize -> {500, 375}, 
        PlotRange -> 25, Boxed -> False, Axes -> False, 
        SphericalRegion -> True, ViewAngle -> .14
        ], {s, -1, 1}](*end show*)
      ](*end module*), 
        {
        {fcn, 1, "curve: "}, {1 -> "circular helix"}, 
      ControlType -> RadioButtonBar
        },
        {
        {m, 0, "position on curve"}, 0, 2 Pi
        },
          TrackedSymbols :> {m, fcn}
    ](*end manipulate*)

animation link

$\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.