6

I am trying to plot the function$$W(z^2)W\left(\dfrac{1}{z}\right)$$ in Desmos 3D, where $W(z)$ is the product log function and $z=x+iy$. You can check out my related Math.SE question here.

When I plugged the function into Wolfram Alpha (substituting in $z=x+iy$), I noticed one of the outputs labeled a "complex map", as you can see here:

enter image description here

I managed to plot the graph on the right using:

ComplexContourPlot[
  {Re[ProductLog[z^2] ProductLog[1/z]], Im[ProductLog[z^2] ProductLog[1/z]]},
  {z, 10}
]

enter image description here

How would I recreate the graph on the left? It also looks very interesting.

MarcoB
  • 67,153
  • 18
  • 91
  • 189
CrSb0001
  • 233
  • 1
  • 10
  • 1
    Would you mind rewriting your question more clearly? Is it what you are looking for ComplexContourPlot[{Re[z], Im[z]}, {z, 10}]? Or perhaps would you rather make it more creative like e.g. here? – Artes Dec 22 '23 at 00:54
  • 1
    Since it's a map $z \mapsto W(z^2)W(1/z)$, the grid on the left should be ComplexContourPlot[{Re[z], Im[z]}, {z, 10}]. I'm not sure how the black lines are defined, though. – Goofy Dec 22 '23 at 01:50

1 Answers1

11
  • We use ParametricPlot to plot the mapping x+I*y -> ReIm[f[x+I*y]].
  • We subdivide the original domain to 11x11 parts.
f[z_] := ProductLog[z^2] ProductLog[1/z];
plots = Block[{z = x + I*y}, 
    ParametricPlot[#, {x, -4, 4}, {y, -4, 4}, 
     Mesh -> {Subdivide[-4, 4, 11], Subdivide[-4, 4, 11]}, 
     MeshStyle -> {{Thick, Opacity[1], Blue}, {Thick, Opacity[1], 
        Orange}}, PlotStyle -> None, Exclusions -> All, 
     PlotPoints -> 100, MaxRecursion -> 2, Frame -> False, 
     Axes -> False]] & /@ {ReIm[z], ReIm[f[z]]}
GraphicsRow[plots]

enter image description here

  • To plot the black lines.
{f1, f2, f3, f4} = {BSplineFunction[{{.15, -4}, {.15, -.6}}], 
  BSplineFunction[{{.15, 4}, {.15, .6}}], 
  BSplineFunction[{{-2.8, 0.1}, {-.1, 0.1}, {-.3, .12}, {-.15, .2}}], 
  BSplineFunction[{{-2.8, -0.1}, {-.1, -0.1}, {-.3, -.12}, {-.15, \
-.2}}]}; F = ReIm@*f@*({1, I} . # &);
plot1 = Block[{z = x + I*y}, 
   ParametricPlot[{f1@s, f2@s, f3@s, f4@s}, {s, 0, 1}, 
    PlotPoints -> 100, MaxRecursion -> 2, AspectRatio -> Automatic, 
    PlotRange -> All, PlotStyle -> Directive@{Thick, Black}]];
plot2 = ParametricPlot[{F@*f1@s, F@*f2@s, F@*f3@s, F@*f4@s}, {s, 0, 
    1}, PlotPoints -> 100, MaxRecursion -> 2, 
   AspectRatio -> Automatic, PlotRange -> All, Exclusions -> None, 
   PlotStyle -> Black];
GraphicsRow@{Show[plots[[1]], plot1], Show[plots[[2]], plot2]}

enter image description here

cvgmt
  • 72,231
  • 4
  • 75
  • 133