# How to plot an imaginary number, i, power tower as done in the following way?

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?

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

• 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

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

• 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!) Dec 31, 2022 at 9:44

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

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]

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]