0
$\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$
    – Domen
    Aug 18, 2021 at 18:08

1 Answer 1

1
$\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
  • $\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$ 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$
    – cvgmt
    Aug 19, 2021 at 14:45
  • $\begingroup$ Is it also possible to do this with the blue worms? $\endgroup$ 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$
    – cvgmt
    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$ Aug 20, 2021 at 13:23

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.