2
$\begingroup$

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.

$\endgroup$
1
  • $\begingroup$ 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}] $\endgroup$ Commented Aug 18, 2021 at 18:08

1 Answer 1

4
$\begingroup$

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

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

enter image description here

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

enter image description here

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

enter image description here

$\endgroup$
5
  • 1
    $\begingroup$ 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? $\endgroup$ Commented Aug 19, 2021 at 13:42
  • $\begingroup$ @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}] $\endgroup$ Commented Aug 19, 2021 at 14:45
  • $\begingroup$ Is it also possible to do this with the blue worms? $\endgroup$ Commented Aug 19, 2021 at 15:44
  • $\begingroup$ @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}] $\endgroup$ Commented Aug 20, 2021 at 1:07
  • $\begingroup$ 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? $\endgroup$ Commented Aug 20, 2021 at 13:23

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.