# How can I make a similiar kind of diagram without solving the dynamical equation?

This is the phase-space diagram of a system that is itself a modified Thomas system for c=5 and b=0.0.

However, I want to plot a similar figure without solving the equation. It does not need to be as accurate as the phase-space diagram above or the animation of the same below.

This is my code for the graphs:

soln = With[{b = 0.0, c = 5, tmax = 200},
NDSolve[{x'[t] == -b x[t] + Sin[y[t]] + c y[t],
y'[t] == -b y[t] + Sin[z[t]] - c x[t],
z'[t] == -b z[t] + Sin[x[t]], x[0] == 1.0, y[0] == 0.0,
z[0] == 1.0}, {x, y, z}, {t, 0, tmax, 0.1},
MaxSteps -> \[Infinity]]];

Animate[ParametricPlot3D[
Evaluate[{x[t], y[t], z[t]} /. soln], {t, 0, tmax},
PlotPoints -> 500,
Axes -> False,
ColorFunction ->
Function[{x, y, z}, ColorData[{"Rainbow", "Reverse"}][z]],
AspectRatio -> 1, PlotRangePadding -> 1, ImageSize -> 800,
PlotTheme -> "Scientific",
PlotStyle -> Directive[Opacity[0.4]],
PlotRange -> {{-5, 5}, {-5, 5}, {0, 5}}], {tmax, 0.1, 200},
AnimationRate -> 5, AnimationRepetitions -> Infinity]


How can I make a conceptual diagram showing this phase-space portrait with magnetic field lines along the axis of the inner helical trajectories?

How can I plot something like the image below?

• What's wrong with what you have (using NDSolve)? Sep 8, 2022 at 21:12
• The original plot makes me hungry. I'll second Chris K: I want to see the Biot Savart law used and field lines plotted so that I can build a donut dynamo.
Sep 8, 2022 at 22:45
• @Chrish Nothing is wrong there using NDSolve. That is the actual phase-space diagram. I don't want to put things into it. So, I needed a model that I can play with to visualize Sep 8, 2022 at 23:25
• What is a "Thomas system"? Related to the Thomas algorithm? After Thomas A. DeFanti? Sep 10, 2022 at 10:52
• @PeterMortensen It's a chaotic system or a strange attractor originally discovered by R. Thomas. Here is the link to the paper doi.org/10.1142/S0218127499001383 and link to the animation rreusser.github.io/strange-attractors/#thomas Sep 10, 2022 at 20:16

Using Arrow and Arrowheads is a nightmare especially in 3D.

n = 30;
ar = Table[
RotationMatrix[
fi, {0, 0, 1}] . {15/8 + 13/8 Cos[2 \[Pi] (t + 1/2)/2], 0,
7/2 Sin[2 \[Pi] (t + 1/2)/2]}, {fi, 0,
2 \[Pi] - \[Pi]/4, \[Pi]/4}];
a = ParametricPlot3D[{{5/4 Cos[2 n \[Pi] t] (3/2 + Cos[2 \[Pi] t]),
5/4 Sin[2 n \[Pi] t] (3/2 + Cos[2 \[Pi] t]),
2 Sin[2 \[Pi] t]}}, {t, 0, 1}, Boxed -> False, Axes -> False,
ColorFunction -> Hue,
PlotRange ->
All]; b = (ParametricPlot3D[ar, {t, 0, 1}, Boxed -> False,
Axes -> False, PlotRange -> All]) /.
Line[x_] :> {Gray,
Arrowheads[{0, -0.03, 0, 0, 0, 0, 0, 0, -0.03, 0}],
Arrow[Tube[x]]};
Show[a, b]
Clear[a, b, n, ar]


n = 30;
ar = Table[
RotationMatrix[
fi, {0, 0, 1}] . {15/8 + 13/8 Cos[2 \[Pi] (t + 1/2)/2], 0,
7/2 Sin[2 \[Pi] (t + 1/2)/2]}, {fi, 0,
2 \[Pi] - \[Pi]/4, \[Pi]/4}];
a = ParametricPlot3D[{{5/4 Cos[2 n \[Pi] t] (3/2 + Cos[2 \[Pi] t]),
5/4 Sin[2 n \[Pi] t] (3/2 + Cos[2 \[Pi] t]),
2 Sin[2 \[Pi] t]}}, {t, 0, 1}, Boxed -> False, Axes -> False,
ColorFunction ->
Function[{x, y, z}, ColorData[{"Rainbow", "Reverse"}][z]],
PlotRange ->
All]; b = (ParametricPlot3D[ar, {t, 0, 1}, Boxed -> False,
Axes -> False, PlotRange -> All]) /.
Line[x_] :>
Join[{Gray, Line[x[[32 ;; -1]]]}, {Red,
Arrowheads[{-0.03, 0, 0, 0, 0, 0, 0, 0, 0}],
Arrow[Tube[{x[[{1, 32}]], x[[-2 ;; -1]]}]]}];
Show[a, b]
Clear[a, b, n, ar]


• THANK YOU SO MUCH @azerbajdzan. It is Perfect. Just one thing, is there a way to colour the arrows in a different colour than the tail? Sep 8, 2022 at 23:11
• I added another example. Sep 9, 2022 at 10:06

One parameterization of a torus is $$((2+\cos v)\cos u,(2+\cos v)\sin u,\sin v)$$ for $$u\in\{0,2\pi\}$$ and $$v\in\{0,2\pi\}$$. Letting $$u=50t$$ and $$v=t$$ yields a curve along the surface like so:

With[{n = 50},
ParametricPlot3D[{Cos[2 n \[Pi] t] (2 + Cos[2 \[Pi] t]),
Sin[2 n \[Pi] t] (2 + Cos[2 \[Pi] t]), Sin[2 \[Pi] t]}, {t, 0, 1},
ColorFunction -> Hue]]


Perhaps this animation is close enough to your goal

Export["~/Desktop/i.gif",
Join[#, Most@Rest@Reverse@#] &@
Table[With[{n = 50},
Rasterize[
Style[ParametricPlot3D[{Cos[2 n \[Pi] t] (2 + Cos[2 \[Pi] t]),
Sin[2 n \[Pi] t] (2 + Cos[2 \[Pi] t]), Sin[2 \[Pi] t]}, {t, 0,
T}, ColorFunction -> ColorData@"DarkRainbow",
ViewPoint -> {0, 3, 1}, PlotTheme -> "Minimal",
PlotStyle -> [email protected],
PlotRange -> {{-2.997721318162146,
2.999999999938333}, {-2.9962254214863,
2.9982495368807554}, {-0.9999998592131705,
0.9999998782112116}}],
RenderingOptions -> {"3DRenderingEngine" -> "OpenGL"}],
RasterSize -> 360]], {T, .02, 1, .02}],
AnimationRepetitions -> \[Infinity], "DisplayDurations" -> 1/30]

• I forgot to set ColorFunctionScaling, so the hue is sort of shifting, but you get the picture
Sep 8, 2022 at 18:54
• Thank you @Adam for your quick response. This a beautiful. However, this graph is not helical, rather these are circles with different radii. In addition to that, I need to have magnetic lines of force passing through the inner helix along its axis. Sep 8, 2022 at 18:59
• It is helical, try with n=10. I'll post a version with arrows, but I think an example sketch or graphic would be useful to emulate.
Sep 8, 2022 at 19:03
• See mathematica.stackexchange.com/questions/99124/… in the meantime, though I don't like the method of replacing instances of Line in this case (we know the equation and that will allow greater control with Show[ParametricPlot3D[...],Graphics3D@{Arrow...}]
Sep 8, 2022 at 19:08
• Thank you @Adam. Yes, for n=10, it's clearly visible. And I think, instead of using Arrow, Arrows with BezierCurve would give a better picture. Sep 8, 2022 at 19:29

I think we can do this all by StreamPlot3D,but I don't know what is the physical meaning of the stream lines in the center and what is its expression and what is the relation between the dynamic system and the sketch.

BTW, the stream lines is not the torus or revolution shape. Science is not art!

Clear[b, c, F, pt];
b = 0.0;
c = 5;
F = {-b*x + Sin[y] + c*y, -b*y + Sin[z] - c*x, -b*z + Sin[x]};
pt = {1, 0, 1};
StreamPlot3D[F, {x, -4, 4}, {y, -4, 4}, {z, -4, 4},
StreamPoints -> {pt}]


Clear[b, c, F, pt];
b = 0;
c = 1.9;
F = {-b*x + Sin[y] + c*y, -b*y + Sin[z] - c*x, -b*z + Sin[x]};
pt = {1, 0, 1};
StreamPlot3D[F, {x, -5, 5}, {y, -5, 5}, {z, -5, 5},
StreamPoints -> {pt}, AspectRatio -> Automatic]