2
$\begingroup$

I am trying to convert this Python code for Classical map of kicked top to Mathematica.

For a single trajectory, I am able to write the code properly.

Here is the converted code

(*Parameters*)
p = 1.73;
k = 2.0;

(*Defining the mapping function (classical map of a quantum kicked \
top)*)
F[x_, y_, z_] := Module[{z1, x1, y1},
  z1 = z*Cos[p] - x*Sin[p];
  x1 = (x*Cos[p] + z*Sin[p])*Cos[k*z1] - y*Sin[k*z1];
  y1 = (x*Cos[p] + z*Sin[p])*Sin[k*z1] + y*Cos[k*z1];
  {x1, y1, z1}]

(*Parameters*)
n = 500;
(*Number of iterations*)
x0 = 0.5;
z0 = -0.3;
y0 = Sqrt[1 - Round[x0^2 + z0^2, 10^-15]];

(*Data storing space for x,y,and z for 'n' iterations*)

x = Table[0, {n}];
y = Table[0, {n}];
z = Table[0, {n}];

(*Storing initial points*)
x[[1]] = x0;
y[[1]] = y0;
z[[1]] = z0;

(*Iterations*)
For[i = 2, i <= n, 
 i++, {xi, yi, zi} = F[x[[i - 1]], y[[i - 1]], z[[i - 1]]];
 (*Mapping x,y,z*)
 (*Storing the data of new x,y,z*)
 x[[i]] = xi;
 y[[i]] = yi;
 z[[i]] = zi;]

(*Plotting*)
ListPlot[Transpose[{x, z}], PlotStyle -> PointSize[0.01],
  AxesLabel -> {"X", "Z"}, PlotLabel -> "Single trajectory"]

enter image description here

However, some problems arise when I try to convert the second part. Even though there is no error, it keeps on running and no results come.

Here is the code

(*Parameters*)
n = 100;(*number of iterations*)
num = 21;

(*Data storing space of x,y,and z for'n' iterations*)

x = Table[0, {n}];
y = Table[0, {n}];
z = Table[0, {n}];

(*Initial points*)
x0data = Range[-1, 1, (2/num)];
z0data = Range[-1, 1, (2/num)];

(*Create plots*)
{plot1, plot2} = 
  ListLinePlot[{}, PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, 
     ImageSize -> 400, PlotStyle -> PointSize[0.01], 
     AxesLabel -> {"X", "Z"}, PlotLabel -> "Initial points"] & /@ {1, 
    2};

contnopoints = 0;

(*Iteration*)
For[i = 1, i <= Length[x0data], i++,
 For[j = 1, j <= Length[z0data], j++,
  If[Round[x0data[[i]]^2 + z0data[[j]]^2, 0.00000000000001] <= 1, 
   contnopoints++;
   x[[1]] = x0data[[i]];
   z[[1]] = z0data[[j]];
   y[[1]] = 
    Sqrt[1 - 
      Round[x0data[[i]]^2 + z0data[[j]]^2, 0.000000000000001]];
   For[k = 2, k <= n, 
    k++, {xi, yi, zi} = F[x[[k - 1]], y[[k - 1]], z[[k - 1]]];
    (*mapping x,y,z*)
    x[[k]] = Round[xi, 0.0000001];
    y[[k]] = Round[yi, 0.0000001];
    z[[k]] = Round[zi, 0.0000001];
    If[xi^2 + yi^2 + zi^2 > 1.001, 
     Print["At i =", i, " x or y or z in negative. ", 
       xi^2 + yi^2 + zi^2];]];
   plot1 = 
    Show[plot1, 
     ListPlot[{{x0data[[i]], z0data[[j]]}}, 
      PlotStyle -> PointSize[0.01]]];
   plot2 = 
    Show[plot2, 
     ListLinePlot[Transpose[{x, z}], 
      PlotStyle -> PointSize[0.005]]];]]]

(*Display plots*)
Show[{plot1, plot2}, ImageSize -> 200]

(*Plot titles,labels,etc.*)
plot1 = 
 Show[plot1, 
  PlotLabel -> 
   "Initial points, no. of points = " <> ToString[contnopoints]]
plot2 = Show[plot2, 
  PlotLabel -> 
   "Phase Space(Y0>0)  p=k,\n n = " <> ToString[contnopoints]]

(*Export plots if needed*)
(*Export["PhaseSpace_k4.png",{plot1,plot2}]*)

The plots should come as this enter image description here

Please help me resolve this problem. Thank you

$\endgroup$
2
  • $\begingroup$ Well, after a minute or two, I get a result. You may want to decrease the number of points, so that it runs faster. $\endgroup$
    – Domen
    Oct 3, 2023 at 19:12
  • 2
    $\begingroup$ It is not good idea to rewrite the code in "pythonish" style. Write it in the style of Mathematica. For example the first image can be produces in one-line code without any For cycle. $\endgroup$ Oct 3, 2023 at 19:30

1 Answer 1

4
$\begingroup$
p = 1.73;
k = 2.0;
F[x_, y_, z_] := Module[{z1, x1, y1}, z1 = z*Cos[p] - x*Sin[p];
  x1 = (x*Cos[p] + z*Sin[p])*Cos[k*z1] - y*Sin[k*z1];
  y1 = (x*Cos[p] + z*Sin[p])*Sin[k*z1] + y*Cos[k*z1];
  {x1, y1, z1}]
x0 = 0.5;
z0 = -0.3;
y0 = Sqrt[1 - Round[x0^2 + z0^2, 10^-15]] // N;
n = 500;
ListPlot[NestList[F @@ # &, {x0, y0, z0}, n - 1][[All, {1, 3}]], 
 PlotLabel -> "Single trajectory", Axes -> False, Frame -> True, 
 FrameLabel -> {{"Z", ""}, {"X", ""}}]
Clear[x0, y0, z0, n, p, k]

enter image description here

p = 1.73;
k = 2.0;
F[x_, y_, z_] := Module[{z1, x1, y1}, z1 = z*Cos[p] - x*Sin[p];
  x1 = (x*Cos[p] + z*Sin[p])*Cos[k*z1] - y*Sin[k*z1];
  y1 = (x*Cos[p] + z*Sin[p])*Sin[k*z1] + y*Cos[k*z1];
  {x1, y1, z1}]
ta = {#[[1]], 
     Sqrt[1 - Round[#[[1]]^2 + #[[2]]^2, 10^-15]] // N, #[[2]]} & /@ 
   Flatten[Table[
     If[i^2 + j^2 <= 1, {i, j}, Nothing], {i, -1, 1, 0.1}, {j, -1, 1, 
      0.1}], 1];
ListPlot[List /@ ta[[All, {1, 3}]], AspectRatio -> Automatic, 
 PlotLabel -> 
  "Initial points, no. of points = " <> ToString[Length@ta], 
 Axes -> False, Frame -> True, FrameLabel -> {{"Z", ""}, {"X", ""}}]
n = 500;
ListPlot[Table[
  NestList[F @@ # &, ta[[i]], n - 1][[All, {1, 3}]], {i, 1, 
   Length@ta}], 
 PlotLabel -> 
  "Phase Space(Y0>0)  p=" <> ToString[p] <> ", k=" <> ToString[k], 
 Axes -> False, Frame -> True, FrameLabel -> {{"Z", ""}, {"X", ""}}, 
 AspectRatio -> Automatic]
Clear[x0, y0, z0, n, p, k, ta]

enter image description here

enter image description here

$\endgroup$
0

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.