# How to plot the Worm domain?

While reading Krantz' "Harmonic and Complex Analysis in several variables" I stumbled upon the Worm domain. It is a counterexample to the long-believed statement that a smoothly bounded pseudoconvex domain will have a Stein neighborhood basis, which was found by Diederich and Fornæss.

I will write the definition of the worm as well of an alternative version. I'd like to visualize them and manipulate parameters.

The definition of the Worm domain might be a little bit longer since I will also quote a small but relevant part of the book. The other version is more comprehensive.

Definition (Worm). Let $$\mathcal W$$ denote the domain $$\mathcal W=\left\{(z_1,z_2)\in\Bbb C^2 : \left\lvert z_1-e^{i\log\lvert z_2\rvert} \right\rvert^2<1-\eta(\log \lvert z_2\rvert^2)\right\},$$ where (i) $$\eta\colon\mathbb R\to\mathbb R,\eta\ge0, \eta$$ is even, $$\eta$$ is convex; (ii) $$\eta^{-1}(0)=I_\mu=[-\mu,\mu]$$; (iii) there exists a number $$a>0$$ such that $$\eta(x)>1$$ if $$\lvert x \rvert>a$$; (iv) $$\eta'(x)\neq0$$ if $$\eta(x)=1$$.

"Notice that the slices of $$\mathcal W$$ for $$z_2$$ fixed are discs centered on the unit circle; the centers of these circles wind centered on the unit circle; the centers of these circles wind $$\mu/\pi$$ times about that circle as $$\lvert z_2\rvert$$ traverses the range of values for which $$\eta(\log\lvert z_2\rvert^2)<1$$. It is worth commenting here on the parameter $$\mu$$ in the definition of $$\mathcal W$$. The number $$\mu$$ in some contexts is selected to be greater than $$\pi/2$$. The number $$\nu=\pi/2\mu$$ is half the reciprocal of the number of times that the centers of the circles that make up the worm traverse their circular path."

An alternative version of the Worm is a simplification of the definition above. We can take $$\eta$$ to be $$1$$ minus the characteristic function of the interval $$[-\mu,\mu]$$, which has the effect of truncating the two caps and destroying in part the smoothness of the boundary.

Definition (Non-smooth version of the worm).

$$\mathcal W'=\left\{(z_1,z_2)\in\Bbb C^2 : \left\lvert z_1-e^{i\log\lvert z_2\rvert} \right\rvert^2<1,\left\lvert\log \lvert z_2\rvert^2\right\rvert<\mu\right\}$$

Conclusion: In order to get a meaningful plot, I certainly want to fix $$\mu$$ and $$\eta$$. I'm not sure what to expect from the plot of the Worm so I should also be able to fix $$z_1$$ or $$z_2$$. Maybe it is also possible to plot both $$z_1$$ and $$z_2$$ at the same time, using coloring and 3-dimensional space.

The only image of a Worm I was able to find is here one page 2. As I said I'd like to interact with the plot and see exactly how it changes when we choose different parameters.

• Just an idea, not worth the answer: If you only want to look at a 3D slice of this 4D space, then we can say: $(z_1, z_2) = (x+i y, z + q i)$ and plot the corresponding region at a fixed $q$: Region@ImplicitRegion[(Abs[x + I y - Exp[I Log[Abs[z + I q]]]]^2 < 1 && Abs[Log[z + I q]^2] < \[Mu]) /. {q -> 1, \[Mu] -> 2}, {x, y, z}] Commented Aug 18, 2021 at 18:08

Firstly we give a simple example of $$\eta$$.

μ = 3;
η[x_] =
Piecewise[{{2 (x - μ), x >= μ}, {-2 (x + μ),
x <= -μ}}];
Plot[η[x], {x, -5, 5}]


Since

reg = With[{z1 = x + I*y, z2 = z + I*w},
ParametricRegion[{{x, y, z},
Abs[z1 - E^(I*Log[Abs[z2]])]^2 <
1 - η[Log[Abs[z2]^2]]}, {{x, -6, 6}, {y, -6, 6}, {z, -6,
6}, {w, -6, 6}}]]
reg // DiscretizeRegion


doesn't work, we have to fix w and then vary it.

Table[With[{z1 = x + I*y, z2 = z + I*w},
ParametricRegion[{{x, y, z},
Abs[z1 - E^(I*Log[Abs[z2]])]^2 <
1 - η[Log[Abs[z2]^2]]}, {{x, -6, 6}, {y, -6, 6}, {z, -6,
6}}]] // DiscretizeRegion, {w, {1/2, 1, 3/2}}]


But DiscretizeRegion or Region is still fragile, so here we use ContourPlot3D to get another surface about w.

Table[With[{z1 = x + I*y, z2 = z + I*w},
ContourPlot3D[
Abs[z1 - E^(
I*Log[Abs[z2]])]^2 - (1 - η[Log[Abs[z2]^2]]), {x, -6,
6}, {y, -6, 6}, {z, -6, 6}, Contours -> {0}, PlotPoints -> 20,
MaxRecursion -> 2, Boxed -> False, Axes -> False,
Mesh -> None]], {w, -3, 3}]


• Thank you for your answer. I'd like to add the fourth dimension using time. Is it possible to implement a "movie" where the left out dimension, in this case, $w$, changes smoothly over time? Commented Aug 19, 2021 at 13:42
• @autopilotmorphism μ = 3; η[x_] = Piecewise[{{2 (x - μ), x >= μ}, {-2 (x + μ), x <= -μ}}]; surf[w_] := Module[{x, y, z, z1, z2}, z1 = x + I*y; z2 = z + I*w; ContourPlot3D[ Abs[z1 - E^(I*Log[Abs[z2]])]^2 - (1 - η[ Log[Abs[z2]^2]]), {x, -6, 6}, {y, -6, 6}, {z, -6, 6}, Contours -> {0}, Boxed -> False, Axes -> False, Mesh -> None, PerformanceGoal -> "Quality"]]; Manipulate[surf[w], {w, -3, 3, .5}] Commented Aug 19, 2021 at 14:45
• Is it also possible to do this with the blue worms? Commented Aug 19, 2021 at 15:44
• @autopilotmorphism μ = 3; η[x_] = Piecewise[{{2 (x - μ), x >= μ}, {-2 (x + μ), x <= -μ}}]; surf[w_] := Module[{x, y, z, z1, z2}, z1 = x + I*y; z2 = z + I*w; Region[ParametricRegion[{{x, y, z}, Abs[z1 - E^(I*Log[Abs[z2]])]^2 < 1 - η[Log[Abs[z2]^2]]}, {{x, -6, 6}, {y, -6, 6}, {z, -6, 6}}]]]; Manipulate[surf[w], {w, -3, 3, .5}] Commented Aug 20, 2021 at 1:07
• Thanks again. I have two more questions. (1) The plot in your comment does not have is cut off at the boundaries while the plot in the answer has a sharper "hat". (2) It works very slowly, do you have any idea how to make the plotting of the blue worms faster? Commented Aug 20, 2021 at 13:23