Make Arrows Smaller

Question

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}]

acekizzy · Answer

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

Make Arrows Smaller

One Answer

Add your own answers!

Ask a Question