18
$\begingroup$

I want to roll the function f(x)=sqrt(x), x∈[0,1] along the y-axis.

I know how to rotate the graph around a point, but I'm not sure how to rotate along an axis in 2D.

From here To here

Rotating around a point e.g. (0,0) would look like this:

Manipulate[ParametricPlot[{{t, t^(1/2)}, RotationTransform[k, {0, 0}][{t, t^(1/2)}]}, {t, 0, 1}, PlotRange -> {{-2, 2}, {-2, 2}}], {k, 0, 2 \[Pi]}]

Thank you in advance!

$\endgroup$
2
  • $\begingroup$ Rotating the line 3 dimensionally around the axis in 2D? $\endgroup$
    – Teabelly
    Commented Mar 21, 2021 at 0:01
  • $\begingroup$ It's been a while, so this might be a good time to note that if you roll a (piece of a) parabola over a line, the focus will trace a catenary. $\endgroup$ Commented Jun 10, 2022 at 14:17

2 Answers 2

27
$\begingroup$

We calculate the tangent vector of parametric curve {t^2,t} and the ArcLength from 0 to t0 so that we get the point {0,s[t0]} in y-axis.

c[t_] = {t^2, t};
s[t_] = ArcLength[c[τ], {τ, 0, t}];
t0 = .6;
Show[ParametricPlot[c[t], {t, 0, 1}, Mesh -> {{t0}}, 
  MeshStyle -> {PointSize[Large], Red}, MeshFunctions -> (#3 &), 
  MeshShading -> {Red, Automatic}], 
 Graphics[{Arrow[{c[t], c[t] + .3 Normalize[c'[t]]}] /. 
    t -> t0, {Arrow[{{0, s[t0]}, {0, s[t0] + .3}}], Thick, Red, 
    PointSize[Large], Point[{0, s[t0]}], 
    Line[{{0, 0}, {0, s[t0]}}]}}], PlotRange -> All]

enter image description here

After that we translate the curve from c[t0] to {0, s[t0]} and rotate it around {0,s[t0]} so that the tangent vector become the new direction {0,1} which toward to the y-axis;

c[t_] = {t^2, t};
s[t_] = ArcLength[c[τ], {τ, 0, t}];
r[t_, t0_] := 
  RotationTransform[{c'[t0], {0, 1}}, {0, s[t0]}][
   c[t] + {0, s[t0]} - c[t0]];
Manipulate[
 ParametricPlot[r[t, t0], {t, 0, 1}, AspectRatio -> Automatic, 
  PlotRange -> {{0, 1}, {0, 2}}], {t0, 0, 1}]

enter image description here

Edition 1

We generalize the idea from above to deal with two parametric curves. Here we use NDSolve to handle the re-parametric equation of curve $$\begin{cases}\frac{\mathrm{d}s}{\mathrm{d}t}=|r'(t)|\\s(0)=0\end{cases}$$

and thanks @Daniel Huber provide FunctionInterpolation to increase the speed.

r1[t_] = {1.5 + 1.5 Cos[π - t], Sin[π - t]}; t1 = 
 FunctionInterpolation[
   InverseFunction[
     NDSolve[{s1'[t] == Norm[r1'[t]], s1[0] == 0}, 
       s1, {t, 0, 100}][[1, 1, 2]]][x], {x, 0, 50}] // Quiet;
r2[t_] = {t^2, 3 t};
t2 = FunctionInterpolation[
    InverseFunction[
      NDSolve[{s2'[t] == Norm[r2'[t]], s2[0] == 0}, 
        s2, {t, 0, 100}][[1, 1, 2]]][x], {x, 0, 50}] // Quiet;
Animate[Show[ParametricPlot[{r1[t1[s]], r2[t2[s]]}, {s, 0, 20}], 
  Graphics[Arrow[{r1[t1[s]], r1[t1[s]] + D[r1[t1[s]], s]} /. 
     s -> s0]], 
  Graphics[Arrow[{r2[t2[s]], r2[t2[s]] + D[r2[t2[s]], s]} /. 
     s -> s0]]], {s0, 0, 20}, DefaultDuration -> 10]
r1[t_] = {1.5 + 1.5 Cos[π - t], Sin[π - t]}; t1 = 
 FunctionInterpolation[
   InverseFunction[
     NDSolve[{s1'[t] == Norm[r1'[t]], s1[0] == 0}, 
       s1, {t, 0, 100}][[1, 1, 2]]][x], {x, 0, 50}] // Quiet;
r2[t_] = {t^2, 3 t};
t2 = FunctionInterpolation[
    InverseFunction[
      NDSolve[{s2'[t] == Norm[r2'[t]], s2[0] == 0}, 
        s2, {t, 0, 100}][[1, 1, 2]]][x], {x, 0, 50}] // Quiet;
trans[ss_, ss0_] := 
  RotationTransform[{D[r1[t1[s]], s], D[r2[t2[s]], s]} /. s -> ss0, 
    r2[t2[ss0]]][r1[t1[ss]] + r2[t2[ss0]] - r1[t1[ss0]]];
curves = ParametricPlot[{r1[t1[s]], r2[t2[s]]}, {s, 0, 20}];
Animate[Show[curves, 
  ParametricPlot[trans[ss, ss0], {ss, 0, 3 π}]], {ss0, 0, 20}, 
 DefaultDuration -> 10]

Edition 2

I eventually find out that we need not use InverseFunction at all, just use the NDSolve since we can rewrite the equation as

$$\frac{\mathrm{d}t}{\mathrm{d}s}=\frac{1}{|r'(t)|}$$ that is $$\frac{\mathrm{d}t}{\mathrm{d}s}|r'(t)|=1$$ So we consider the equation

t'[s]*Norm[r'[t[s]]] == 1, t[0]==0
r1[t_] = {1.5 + 1.5 Cos[π - t], Sin[π - t]};
r2[t_] = {t^2, 3 t};
L = 20;
t1 = NDSolve[{t1'[s]*Norm[r1'[t1[s]]] == 1, t1[0] == 0}, 
    t1, {s, 0, L}][[1, 1, 2]];
t2 = NDSolve[{t2'[s]*Norm[r2'[t2[s]]] == 1, t2[0] == 0}, 
    t2, {s, 0, L}][[1, 1, 2]];
trans[s_, s0_] := 
  RotationTransform[{(r1@*t1)'@s0, (r2@*t2)'@s0}, r2@t2@s0][
   r1@t1@s + r2@t2@s0 - r1@t1@s0];
curves = ParametricPlot[{r1@t1@s, r2@t2@s}, {s, 0, L}];
Animate[Show[curves, 
  Graphics[Arrow[{r1@t1@s0, r1@t1@s0 + (r1@*t1)'@s0}]], 
  Graphics[Arrow[{r2@t2@s0, r2@t2@s0 + (r2@*t2)'[s0]}]], 
  ParametricPlot[trans[s, s0], {s, 0, L}], 
  PlotRange -> {{-1, 18}, {-2, 15}}], {s0, 0, L}, 
 DefaultDuration -> 10]

enter image description here

Edition 3

For several curves.

L = 32;
r1[t_] = {1.5 + 1.5 Cos[π - t], Sin[π - t]};
r2[t_] = RotationTransform[{{5, 4}, {0, 1}}]@{5 t, 4 Sin[t]};
r3[t_] = {-t^2, 2 t};
r4[t_] = {5 + 5 Cos[π - t], 4 Sin[π - t]};
{t1, t2, t3, t4} = 
  Module[{t, s}, 
    Function[r, 
     NDSolve[{t'[s]*Norm[r'[t[s]]] == 1, t[0] == 0}, t, {s, 0, L}][[1,
        1, 2]]]] /@ {r1, r2, r3, r4};
{c1, c2, c3, c4} = {r1@*t1, r2@*t2, r3@*t3, r4@*t4};
trans[c2_, c1_][s_, s0_] := 
  RotationTransform[{c1'@s0, c2'@s0}, c2@s0]@
   TranslationTransform[c2@s0 - c1@s0]@c1@s;
Animate[Show[
  ParametricPlot[
   Table[c@s, {c, {c1, c2, c3, c4}}] // Evaluate, {s, 0, L}, 
   PlotStyle -> {Red, Orange, Green, Cyan}], 
  Graphics[{Arrowheads[Medium], 
    Table[Arrow[{c@s0, c@s0 + c'@s0}], {c, {c1, c2, c3, c4}}]}], 
  ParametricPlot[
   Table[trans[c, c1][s, s0], {c, {c2, c3, c4}}] // Evaluate, {s, 0, 
    L}, PlotStyle -> {Orange, Green, Cyan}], 
  PlotRange -> {{-25, 25}, {-8, 20}}, ImageSize -> Large], {s0, 0, L},
  DefaultDuration -> 10]

enter image description here

$\endgroup$
2
  • 2
    $\begingroup$ c[t_] = {3 + 3 Cos[π - t], 2 Sin[π - t]}; tangent[t_] = FrenetSerretSystem[c[t], t][[2, 1]]; s[t_] := NIntegrate[c'[τ] . c'[τ] // Sqrt, {τ, 0, t}]; r[t_, t0_] := RotationTransform[{tangent[t0], {0, 1}}, {0, s[t0]}][ c[t] + {0, s[t0]} - c[t0]]; Animate[ ParametricPlot[r[t, t0], {t, 0, 2 π}, PlotRange -> {{0, 8}, {-4, 18}}], {t0, 0, 2 π}, DefaultDuration -> 20] for another curve. $\endgroup$
    – cvgmt
    Commented Mar 21, 2021 at 14:37
  • $\begingroup$ thats really well made! $\endgroup$
    – alex
    Commented Mar 23, 2021 at 16:31
14
$\begingroup$

Assuming you mean roll as in the way a circle rolls across the floor, you need a unit speed arc-length parameterization of the curve $(t^2,t)$. Why? Becuase the key behavior of rolling is no slippage. If a point $(t_0^2,t_0)$ is tangent to the $y$-axis at $(0,l(t_0))$, then the arc length from $(0,0)$ to $(t_0^2,t_0)$ along the curve should be equal to $l(t_0)$.

There's no closed form* for the curve $(\gamma(t)^2,\gamma(t))$ such that $\big(\frac{d\gamma(t)^2}{dt}\big)^2+\big(\frac{d\gamma(t)}{dt}\big)^2=1$ (unit speed). We can still write it symbolically though

DSolve[{1==D[\[Gamma][t]^2,t]^2+D[\[Gamma][t],t]^2,0==\[Gamma][0]},\[Gamma][t],t][[2,1]]

We get $\gamma$ is the inverse function of $\frac14\sinh^{-1}(2t)+\frac t2\sqrt{1+4t^2}$. The angle of $(\gamma(t)^2,\gamma(t))$ is

ArcTan[D[\[Gamma][t]^2/.%,t]/D[\[Gamma][t]/.%,t]]/.(\[Gamma][t]/.%)->\[Gamma][t]

We get $\tan^{-1}(2\gamma(t))$. All Manipulate needs to do is translate and rotate the curve $(\gamma(t)^2,\gamma(t))$ so that $(\gamma(t_0)^2,\gamma(t_0))$ is tangent to $(0,t_0)$.

\[Gamma][t_]=(*thanks to Daniel Huber for FunctionInterpolation, a huge speedup*)
  FunctionInterpolation[InverseFunction[1/4ArcSinh[2#1]+1/2#1Sqrt[1+4#1^2]&][x],{x,0,10}][t];
Manipulate[ParametricPlot[
  {Cos[#2]#[[1]]-Sin[#2]#[[2]],Cos[#2]#[[2]]+Sin[#2]#[[1]]}&
  [{\[Gamma][t]^2,\[Gamma][t]}-{\[Gamma][T]^2,\[Gamma][T]},ArcTan[2\[Gamma][T]]]
  +{0,T},{t,0,10},PlotRange->{{0,10},{0,10}}],{T,0,10}]

The fourth line does rotation, the fifth line translates $\gamma$ w.r.t. $(0,0)$, and the last line translates along the $y$-axis.

rolling root

*closed form meaning 'finite composition of elementary functions'

$\endgroup$
2
  • 3
    $\begingroup$ To speed it up, try:` [Gamma][t_] = FunctionInterpolation[ InverseFunction[1/4 ArcSinh[2 #1] + 1/2 #1 Sqrt[1 + 4 #1^2] &][ x], {x, 0, 10}][t];` $\endgroup$ Commented Mar 21, 2021 at 10:12
  • 1
    $\begingroup$ This is what I was looking for! $\endgroup$
    – Adam
    Commented Mar 21, 2021 at 10:53

Your Answer

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

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