# Visualize embedded and immersed Klein bottle

Answers at How to visualize a 4-dimensional parametric surface? give functions for producing images of 3D projections of 4D embeddings of the Klein bottle.

Is there a way to get such a 3D projection from a 4D embedding of the Klein bottle that is the customary "beer-bottle" surface used to help visualize the Klein bottle?

(For a strictly mathematical version of the question, see: https://math.stackexchange.com/questions/2946505/topological-embedding-of-klein-bottle-into-mathbbr4-that-projects-to-usual.)

Prior posts about 3D immersion of the Klein bottle do not help. I already know how to produce an image of that "standard" 3D immersion of the Klein bottle K. But as I said, I want to start with an explicit embedding function into 4D and then an explicit projection down to 3D whose image is that "beer-bottle" immersed surface.

• Possible duplicate of My 3D plot of a Klein bottle doesn't look right Oct 8, 2018 at 22:57
• @VitaliyKaurov: No, that post about 3D immersion of the Klein bottle does not help. I already know how to produce an image of that "standard" 3D immersion of the Klein bottle K. But as I said, I want to start with an explicit embedding function into 4D and then an explicit projection down to 3D whose image is that "beer-bottle" immersed surface. Oct 9, 2018 at 0:44

I built a continuous transformation of a Klein bottle from 4D to 3D

x[u_, v_, r_] := r (Cos[u/2] Cos[v] - Sin[u/2] Sin[2 v])
y[u_, v_, r_] := r (Sin[u/2] Cos[v] + Cos[u/2] Sin[2 v])
z[u_, v_, p_, \[Epsilon]_] := p Cos[u] (1 + \[Epsilon] Sin[v])
t[u_, v_, p_, \[Epsilon]_] := p Sin[u] (1 + \[Epsilon] Sin[v])
klein[u_, v_] :=
Module[{bx = 6 Cos[u] (1 + Sin[u]), by = 16 Sin[u],
rad = 4 (1 - Cos[u]/2), X, Y, Z},
X = If[Pi <= u < 2 Pi, bx + rad Cos[v + Pi], bx + rad Cos[u] Cos[v]];
Y = If[Pi <= u < 2 Pi, by, by + rad Sin[u] Cos[v]];
Z = rad Sin[v];
{X, Y, Z}]
KleinBottle4D3D[p_, r_, \[Epsilon]_, \[Alpha]_, m_] :=
ParametricPlot3D[{(x[u, v, r]), (y[u, v, r]),
Cos[\[Alpha]]*z[u, v, p, \[Epsilon]] +
Sin[\[Alpha]]*t[u, v, p, \[Epsilon]]}*(1 - m) +
m*klein[u, v], {u, 0, 2*Pi}, {v, 0, 2*Pi}, PlotRange -> All,
Mesh -> None, Exclusions -> None, Boxed -> False, Axes -> False,
PlotStyle -> Opacity[2/3], ColorFunction -> Hue,
BoxRatios -> {1, 1, 1}]

L = ListAnimate[
Table[KleinBottle4D3D[15, 7, -1/2, Pi/4, m], {m, 0, 1, .05}]] 