7
$\begingroup$

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

Enter image description here

Enter image description here

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]

![Enter image description here

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?

Enter image description here

$\endgroup$
5
  • $\begingroup$ What's wrong with what you have (using NDSolve)? $\endgroup$
    – Chris K
    Sep 8, 2022 at 21:12
  • 1
    $\begingroup$ 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. $\endgroup$
    – Adam
    Sep 8, 2022 at 22:45
  • $\begingroup$ @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 $\endgroup$
    – user84456
    Sep 8, 2022 at 23:25
  • 1
    $\begingroup$ What is a "Thomas system"? Related to the Thomas algorithm? After Thomas A. DeFanti? $\endgroup$ Sep 10, 2022 at 10:52
  • $\begingroup$ @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 $\endgroup$
    – user84456
    Sep 10, 2022 at 20:16

3 Answers 3

12
$\begingroup$

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]

enter image description here

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]

enter image description here

$\endgroup$
2
  • $\begingroup$ 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? $\endgroup$
    – user84456
    Sep 8, 2022 at 23:11
  • 2
    $\begingroup$ I added another example. $\endgroup$ Sep 9, 2022 at 10:06
8
$\begingroup$

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

static plot

Perhaps this animation is close enough to your goal

animated

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 -> Opacity@.5, 
   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]
$\endgroup$
6
  • 1
    $\begingroup$ I forgot to set ColorFunctionScaling, so the hue is sort of shifting, but you get the picture $\endgroup$
    – Adam
    Sep 8, 2022 at 18:54
  • $\begingroup$ 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. $\endgroup$
    – user84456
    Sep 8, 2022 at 18:59
  • 1
    $\begingroup$ 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. $\endgroup$
    – Adam
    Sep 8, 2022 at 19:03
  • 1
    $\begingroup$ 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...}] $\endgroup$
    – Adam
    Sep 8, 2022 at 19:08
  • $\begingroup$ 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. $\endgroup$
    – user84456
    Sep 8, 2022 at 19:29
2
$\begingroup$

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

enter image description here

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]

enter image description here

$\endgroup$

Your Answer

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

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