# Python Code to Mathematica for Classical Map of Kicked Top

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


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

• Well, after a minute or two, I get a result. You may want to decrease the number of points, so that it runs faster. Oct 3 at 19:12
• 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. Oct 3 at 19:30

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]


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]