6
$\begingroup$

i'm trying to wrap a cylinder in a torus, the best i've done is the following code:

Manipulate[ParametricPlot3D[{(2 + Cos[v]) Cos[u/(6 - gamma)] - 2, (2 + Cos[v]) Sin[u/(6 - gamma)], Sin[v] + 1}, {u, 0, 2 Pi}, {v,0, 2 Pi}, ImageSize -> 500, Mesh -> None, BoxRatios -> {2, 1, 1}, PlotRange -> {{-2 \[Pi], 2 \[Pi]}, {-6, 2 \[Pi]}, {0, 4}}, PlotStyle -> Directive[Opacity[0.5], Blue], BoundaryStyle -> Directive[Black, Opacity[.3]]], {{gamma, 1,"gamma"}, 1, 5}]

but I would like to start with a cylinder and not with a piece of the torus

Improve this question
$\endgroup$
1

6 Answers 6

Reset to default
5
$\begingroup$
  • At first we wrap a line to circle.
With[{L = 30}, Manipulate[ ParametricPlot3D[{0, R, 0} + R {Cos[t], Sin[t], 0}, {t, -π/ 2 - (L/2)/R, -(π/2) + (L/2)/R}, PlotRange -> L/2], {R, 200, L/(2 π)}]]

enter image description here

  • Then we wrap the cylinder.
Clear["Global`*"]; L = 30; r = 1; f[R_, t_] = {0, R, 0} + R {Cos[t], Sin[t], 0}; {n[R_, t_], b[R_, t_]} = FrenetSerretSystem[f[R, t], t][[2]][[2 ;; 3]]; Manipulate[ ParametricPlot3D[{0, R, 0} + R {Cos[t], Sin[t], 0} + r*{Cos[s], Sin[s]} . {n[R, t], b[R, t]}, {t, -(π/2) - (L/2)/ R, -(π/2) + (L/2)/R}, {s, 0, 2 π}, PerformanceGoal -> "Quality", PlotRange -> L/2, Boxed -> False, Axes -> False], {R, 200, L/(2 π)}]

enter image description here

Edit

Since the curvature of the circle is κ=1/R where R is the radio of the circle, we replace all of the 1/R to κ then make the animation smoothly.

With[{L = 30, R = 1/κ}, Manipulate[ ParametricPlot[{0, R} + R {Cos[t], Sin[t]}, {t, -π/2 - (L/2)/R, -(π/2) + (L/2)/R}, PlotRange -> L/2], {κ, 10^-10, 2 π/L}]]

enter image description here

Clear["Global`*"]; L = 30; r = 1; f[R_, t_] = PadRight[{0, R} + R {Cos[t], Sin[t]}, 3]; {n[R_, t_], b[R_, t_]} = FrenetSerretSystem[f[R, t], t][[2, 2 ;; 3]]; Manipulate[ Block[{R = 1/κ}, ParametricPlot3D[ f[R, t] + r*{Cos[θ], Sin[θ]} . {n[R, t], b[R, t]}, {t, -π/ 2 - (L/2)/R, -(π/2) + (L/2)/R}, {θ, 0, 2 π}, PerformanceGoal -> "Quality", PlotRange -> L/2, Boxed -> False, Axes -> False, Lighting -> "ThreePoint"]], {κ, 10^-10, 2 π/L}]

enter image description here

  • Wrap a rectangle to a torus.
Clear["Global`*"]; L = 95; l = 30; list1 = Table[ Block[{R = 1/κ}, ParametricPlot3D[{0, 0, R} + R {0, Cos[t], Sin[t]} + {s, 0, 0}, {t, -π/2 - l/2/R, -π/2 + l/2/R}, {s, -L/2, L/2}, PerformanceGoal -> "Quality", PlotRange -> L/2, Boxed -> False, Axes -> False]], {κ, Subdivide[10^-10, 2 π/l, 10]}]; f[R_, t_] = {0, R, 0} + R {Cos[t], Sin[t], 0}; {n[R_, t_], b[R_, t_]} = FrenetSerretSystem[f[R, t], t][[2, 2 ;; 3]]; list2 = Table[ Block[{R = 1/κ, r = l/2/π}, ParametricPlot3D[ f[R, t] + {0, 0, r} + r*{Cos[θ], Sin[θ]} . {n[R, t], b[R, t]}, {t, -π/2 - (L/2)/R, -(π/2) + (L/2)/ R}, {θ, 0, 2 π}, PerformanceGoal -> "Quality", PlotRange -> L/2, Boxed -> False, Axes -> False]], {κ, Subdivide[10^-10, 2 π/L, 20]}]; ListAnimate[Join[list1, list2]]

enter image description here

Improve this answer
$\endgroup$
4
$\begingroup$

First set up some helper functions then create polygonFunction that can transform a cylinder into a torus via RotationTransform. Also generate some axes for visualization:

myxf[alpha_, phi_] := (R + \[Rho] Cos[alpha]) Cos[phi]; myyf[alpha_, phi_] := (R + \[Rho] Cos[alpha]) Sin[phi]; myzf[alpha_, phi_] := \[Rho] Sin[alpha]; R = 2; \[Rho] = 1 myaeta[\[Eta]_] := 2 ArcTan[Sqrt[3] Tan[(Sqrt[3] \[Eta])/2]]; rhoMax = NIntegrate[1/(2 + Cos[a]), {a, 0, \[Pi]}]; myx = \[Pi]/(0.001 rhoMax) Sin[0.001]; newval = 1/(myx - 1) resol = 0.1; polygonFunction = Outer[Compose, Table[RotationTransform[ a Pi/l2, {0, 0, 1.}, {-l2 + 1, 0, 0}], {a, -1, 1, resol}], Table[ theta2 = (ArcTan[myxf[a, b] - 2, myzf[a, b]]/\[Pi]) /. {a -> myaeta[theValue], b -> 0}; myalpha = ArcSin[(0.0001 myx theValue)/\[Pi]]; mya = myalpha/0.0001; newf4 := ((theta2 - mya)/( \[Pi] - 0.0001) (x - 0.0001) + mya); RotationTransform[(newf4) \[Pi], {0, 1, 0}, {3 - 1/(myx - 1/(newval)), 0, 0}][{3, 0, 0}], {theValue, -1.8, 1.8, resol}], 1]; etaxiAxes = Graphics3D[ Map[Line, {{{3, 4, 0}, {3, -4, 0}}, {{3, 0, 4}, {3, 0, -4}}}]]; vAxis = Graphics3D[ Map[Line, {{{-3, 0, 0}, {3, 0, 0}}, {{0, -3, 0}, {0, 3, 0}}, {{0, 0, -3}, {0, 0, 3}}}]];

Now using the variable t2, continuously bend the cylinder into a torus using Manipulate:

Manipulate[ Show[{Graphics3D@{{EdgeForm[], Polygon[#[[{1, 2, 4, 3}]]]} & /@ Join @@@ (Join @@ Partition[(polygonFunction /. {l2 -> \[Pi]/t2, x -> t2}), {2, 2}, 1])}, etaxiAxes, vAxis}, PlotRange -> 4, Axes -> True], {t2, 0.001, Pi}]

Static picture below of intermediate form at t2=0.58.

enter image description here

Improve this answer
$\endgroup$
4
$\begingroup$ 
func[r_, a_, d_] := If[d <= r a, r {Sin[d/r], -Cos[d/r], 0}, r {Sin[a], -Cos[a], 0} + (d - r a) {Cos[a], Sin[a], 0}]

Making animated gif:

gi = Table[ ParametricPlot3D[func[1, a, t], {t, 0, 2 Pi}, PlotRange -> Table[{-2 Pi, 2 Pi}, 3], Boxed -> False, Background -> Black, Axes -> False] /. Line[x__] :> {Red, Tube[x, 0.4]}, {a, 0, 2 Pi, 0.1}];

enter image description here

Improve this answer
$\endgroup$
3
$\begingroup$

Do you mean wrap a cylinder into a torus?

torus[gamma_][{u_, v_}] := {(1 + gamma Cos[v]) Cos[u], (1 + gamma Cos[v]) Sin[u], gamma Sin[v] } Manipulate[ ParametricPlot3D[torus[gamma][{u, v}], {u, .0, uUB}, {v, 0, vUB}, PlotRange -> 2.5 {{-1, 1}, {-1, 1}, {-1, 1}}], {{gamma, .1}, 0, 1}, {{uUB, 2 Pi}, .01, 2 Pi}, {{vUB, 2 Pi}, .01, 2 Pi} ]

Or, wrap a cylinder onto a torus

curve[s_] := Pi { Cos[ s], Sin[s]} Manipulate[ ParametricPlot3D[torus[gamma][curve[s]], {s, .0, sUB}, PlotRange -> 2.5 {{-1, 1}, {-1, 1}, {-1, 1}}] /. Line[args_] :> Tube[args, .025], {{gamma, .1}, 0, 1}, {{sUB, 2 Pi}, .01, 2 Pi} ]

Or, something else?

Improve this answer
$\endgroup$
3
$\begingroup$

A torus is circle in the 1,2-plane , at each point an orthogonal circle in the r-3 plane with its center on the first circle.

 PolarX[R_, r_, \[Theta]_, \[Phi]_] := {(R + r Sin[\[Theta]]) Cos[\[Phi]], (R + r Sin[\[Theta]]) Sin[\[Phi]], r Cos[\[Theta]]}

Alternatively one may use the separable system of coordinates for the Laplacian at constant R.

CoordinateTransformData[{{"Toroidal", {R}} -> "Cartesian", "Euclidean", 3}, "Mapping"][{r, \[Theta], \[Phi]}] ToroidalX[R_, r_, \[Theta]_, \[Phi]_] = {Cos[\[Phi]] Sinh[r], Sin[\[Phi]] Sinh[r], Sin[\[Theta]]}/ (R/(Cosh[r] - Cos[\[Theta]]) Manipulate[ParametricPlot3D[ map[R, r, \[Theta], \[Phi]], {\[Phi], 0, 2 \[Pi]}, {\[Theta], 0, 2 \[Pi] }, PlotStyle -> {Hue[0.7, 0.3], Opacity[0.2]}, Mesh -> {12, 17}, MeshStyle -> {{Red, Thickness[0.002]}, {Yellow, Thickness[0.005]}}], {{R, 3}, 0, 12}, {{r, 2}, -6, 20}, {{map, ToroidalX}, {PolarX, ToroidalX}}, ControlPlacement -> Top]

S2 X S2 Torus

Improve this answer
$\endgroup$
3
$\begingroup$

enter image description here

tube[t_] := ParametricPlot3D[{Sin[u], 1 - Cos[u], 0}/t, {u, -t Pi, t Pi}, PlotRange -> {{-4, 4}, {-1, 4}, {-1, 1}}, PlotStyle -> {FaceForm[Red, Yellow], Tube[.5]}, Boxed -> False, Axes -> False, SphericalRegion -> True, ImageSize -> 400] Row[{tube[.001], tube[.3], tube[.7]}]

enter image description here

Manipulate[tube[t], {t, 10^-3, 1, .1}]

enter image description here

Animation at the top produced with

Export["tube.gif", Table[tube[t], {t, 10^-3, 1, 10^-2}]]
Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.