1
$\begingroup$

Can somebody explain what two variables exactly they have plotted against each other to get such graphs, and how one would go about getting this graph in Mathematica?

enter image description here

$\endgroup$

3 Answers 3

14
$\begingroup$
  • Plot the left graph.
pts = RecurrenceTable[{q[n + 1] == I^q[n], q[1] == I}, 
   q[n], {n, 1, 50}];
ComplexListPlot[pts, Joined -> True, Mesh -> All, MeshStyle -> Red, 
 PlotRange -> All]

enter image description here

  • Solved the limit point.
NSolve[Q == I^Q, Q]
Reduce[Q == I^Q, Q] /. C[1] -> 0 // N
sol = NSolve[{θ*Tan[θ] == 
    Log[π/2*Cos[θ]/θ], 0 <= θ <= 2 π}, 
  Reals]
2/π*θ/Cos[θ]*Exp[I*θ] /. sol

enter image description here

  • Partition the points to three groups to view the spiral like.
ComplexListPlot[Transpose@Partition[pts, 3], Joined -> True, 
 PlotStyle -> {Blue, Magenta, Red}, Mesh -> All, PlotRange -> All]

enter image description here

$\endgroup$
1
  • 2
    $\begingroup$ Exact solving works fine: Solve[Q == I^Q, Q] gives 2*I*ProductLog[-I*π/2]/π (even getting the correct branch of the Lambert $W$ function for once!) $\endgroup$
    – Roman
    Dec 31, 2022 at 9:44
8
$\begingroup$

Plotting the real part on the horizontal and the imaginary part on the vertical axis, as is common:

Q = SolveValues[I^q == q, q];
ComplexListPlot[NestList[I^# &, I, 100], Joined -> True, 
                PlotMarkers -> Automatic,
                PlotRange -> All, AspectRatio -> Automatic,
                Frame -> True,
                GridLines -> Transpose[ReIm[Q]]]

enter image description here

Thanks to @cvgmt for pointing out the use of ComplexListPlot!

For the spiral: we note that for a point $q$ close to the asymptotic point $Q=\lim_{n\to\infty}q_n=\frac{2i}{\pi} W\left(-\frac{i\pi}{2}\right)$ the transformation $q\to i^q$ is well approximated by $$ i^q\approx Q+p (q-Q) $$ with $p=-W\left(-\frac{i\pi}{2}\right)$. In Mathematica,

f[q_] = I^q;
p = -ProductLog[-I*π/2];
Q = -2*I*p/π;
Series[f[q] - (Q + p*(q - Q)), {q, Q, 1}]
(*    O[q-Q]^2    *)

In this sense, the numbers $q_n$ for large $n$ are well described by $$ q_n \approx Q + \zeta p^n $$ with the constant $\zeta$ to be determined. I don't have a closed-form expression for $\zeta$, but rather find it experimentally (approximately) with

$MaxExtraPrecision = 10^3;
$RecursionLimit = ∞;
ζ = With[{n = 1000}, N[(Nest[f, 1, n] - Q)/p^n, 10^3]];
N[ζ]
(*    0.638834 - 0.258313 I    *)

With these approximations we can now plot the spirals:

p3 = -(-1)^(1/3) p;
colors = {Blue, Darker@Green, Red};
ParametricPlot[{ReIm[Q + ζ p p3^n],
                ReIm[Q + ζ p^2 p3^n],
                ReIm[Q + ζ p3^n]},
               {n, 1, 100}, PlotRange -> All, 
               PlotStyle -> colors,
               GridLines -> Transpose[ReIm[{Q}]], 
               Epilog -> {PointSize[0.02], 
                 Transpose[{colors, 
                 Point /@ Transpose[Partition[ReIm[NestList[f, I, 99]], 3]]}]},
               Frame -> True, Axes -> False]

enter image description here

$\endgroup$
5
$\begingroup$

I just saw the above answer. But since I already wrote this might as well post it.

The spiral one is tricky. This is for the left side one only

ClearAll["Global`*"]
q[n_ /; n == 1] := I
q[n_ /; n == 2] := Exp[-Pi/2]
q[n_] := I^q[n - 1];
data = Table[{Re[q[n]], Im[q[n]]}, {n, 1, 30}];
ListLinePlot[data,  Mesh -> All, 
 PlotRange -> All, MeshStyle -> {Red, PointSize[.015]}, GridLines -> Automatic, 
 GridLinesStyle -> LightGray]

Mathematica graphics

$\endgroup$

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.