# Implicitly defined compact complicated surface

A Seifert surface for the (3,4) torus knot is defined by the intersection of $S^3 \subset \mathbb{C}^2$ with the set $\arg(z^4-w^3)=0$. The boundary is at $z^4=w^3$ and this is the torus knot. Here is a picture of its stereographic projection into $\mathbb{R}^3$:

If you replace $w\to e^{\frac{2\pi i}{3}}w$, this surface is unchanged. In the picture, the point in the middle gets mapped to the point at the top, the point at the top gets mapped to the point at the bottom, and the point at the bottom gets mapped to the point in the middle.

I want to use Mathematica to make a smooth animation of this happening. I've tried using ContourPlot3D and ParametricPlot3D but both produce surfaces that are joined up in a different way to the picture. I've also tried generating some random points on $S^3$, selecting those that satisfy $|\arg(z^4-w^3)|<\epsilon$ for a small $\epsilon$ and that does produce points looking like the picture. I've put the code for doing that at the bottom. If I use ListSurfacePlot3D instead of ListPointPlot3D, it gives the wrong picture. I can't believe this is the best Mathematica can do.

Explicit Definition of the Surface

The surface is the set of points $(z,w)\in \mathbb{C}^2$ such that

$|z|^2+|w|^2=1$ and $\arg(z^4-(e^{i\theta} w)^3)=0$,

where $\theta$ is a parameter that I want to vary for the animation. This surface is projected into $\mathbb{R}^3$ by stereographic projection

$f(z,w)=\left(\frac{\Re(z)}{1-\Im(w)},\frac{\Im(z)}{1-\Im(w)},\frac{\Re(w)}{1-\Im(w)}\right)$

Mathematica Code

  n = 100; ε = 0.01;

R4pts = RandomVariate[
MultinormalDistribution[ConstantArray[0, 4], IdentityMatrix[4]],
300000];

S3pts = #/Norm[#] & /@ R4pts;

R3proj[a_] = {x/(1 - w), y/(1 - w), z/(1 - w)} /. {x -> a[[1]],
y -> a[[2]], z -> a[[3]], w -> a[[4]]};

complexify[
a_] = {x + I y, z + I w} /. {x -> a[[1]], y -> a[[2]],
z -> a[[3]], w -> a[[4]]};

C2pts = complexify /@ S3pts;

C2ptsSel =
Select[C2pts, (Abs[
Arg[z^4 - Exp[(I π)/2] w^3]] < ε) /. {z -> #[[
1]], w -> #[[2]]} &];

C2colours = Im[#[[2]]] & /@ C2ptsSel;

realify[a_] = {x, y, z, w} /. {x -> Re[a[[1]]], y -> Im[a[[1]]],
z -> Re[a[[2]]], w -> Im[a[[2]]]};

S3ptsSel = realify /@ C2ptsSel;

R3pts = R3proj /@ S3ptsSel;

ListPointPlot3D[{#} & /@ R3pts,
PlotRange -> {{-2, 2}, {-2, 2}, {-2, 2}},
PlotStyle -> ((Hue[(# - Min[C2colours])/(
Max[C2colours] - Min[C2colours])] &) /@ C2colours),
AspectRatio -> 1, ViewPoint -> {2, 1, 0.7}, ImageSize -> 400]


EDIT: The same code with ListSurfacePlot3D gives this picture:

• …i.e., $\Im\left(z^4-(w\exp(i\theta))^3\right)=0$? Jun 30, 2015 at 11:52
• No, $\arg(X)=0$ means X is a positive real, not just a real number (at least in my convention). Jun 30, 2015 at 16:26
• Ah yes, that. Have you tried using e.g. the hyperspherical or Hopf parametrizations of the 3-sphere? Jun 30, 2015 at 16:27
• I have tried something like that and Mathematica gave me a funny looking plot that was not smooth. I've tried lots of way to write the surface as explicitly as I can in coordinates on $\mathbb{R}^3$ and Mathematica doesn't seem to like any of them. I'm a mathematician, not a programmer. Maybe there is something I am missing. Jun 30, 2015 at 16:32
• You can pick values for z=r1*exp(i*theta1) with r1<1 and then use the two equations to solve for w=r2*exp(i*theta2). That might make the point selection process easier at least. Jul 2, 2015 at 16:55

Suppose you have a set of points $S=\{a\in A:f(a)=0\}$ lying in some abstract space $A$. To visualize it, you consider a map $g:A\to\mathbb R^3$, and you wish to draw $g(S)$, the image of your set under $g$. If $g$ is invertible, this is the same as drawing the set $\{x\in\mathbb R^3:f(g^{-1}(x))=0\}$, and ContourPlot3D can do that.

In your case, $A=\mathbb S^3$, $f(a)=\arg(a_1^4-a_2^3)=\arg(\phi(a))$, and $g$ is stereographic projection, which you call R3proj. Let us define $g^{-1}$:

s4proj[{x_, y_, z_}] :=
Evaluate[{a, b, c, d} /.
First@Solve[{R3proj[{a, b, c, d}] == {x, y, z},
a^2 + b^2 + c^2 + d^2 == 1}, {a, b, c, d}]]


This results in the usual formula for the inverse of stereographic projection, $$g^{-1}([x,\ y,\ z])=\frac{[2 x,\ 2 y,\ 2 z,\ x^2+y^2+z^2-1]}{x^2+y^2+z^2+1}.$$

Let us also define $\phi$ explicitly:

ϕ[z_, w_] := z^4 - I w^3 (* what your example code is actually doing *)


Recall that we want to plot $\arg\circ\phi\circ g^{-1}=0$. Unfortunately, $\arg$ has a branch cut along the negative real axis, which will confuse ContourPlot3D. To plot $\arg=0$, it is better to use the conditions $\Im=0,\Re\ge0$ instead.

ϕginv[x_, y_, z_] := ϕ @@ complexify[s4proj[{x, y, z}]]
ContourPlot3D[
Im[ϕginv[x, y, z]] == 0, {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
RegionFunction -> Function[{x, y, z}, Re[ϕginv[x, y, z]] >= 0],
Evaluated -> True, ViewPoint -> {2, 1, 0.7}, PlotPoints -> 10,
MaxRecursion -> 1, ContourStyle -> White, Mesh -> None]


The surface you desire extends beyond the bounds of your chosen PlotRange, it seems.

• Blah, it was the RegionFunction that I missed in my attempts. Nice work! Jul 4, 2015 at 2:05