Implicitly defined compact complicated surface

Question

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:

Answer 1

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.