Klein Bottle

Author

Eric W. Weisstein
October 30, 2020

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Surfaces/KleinBottle.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/KleinBottle.html.

©2020 Wolfram Research, Inc. except for portions noted otherwise

Sechematic embedding

Using If

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

V5

g=ParametricPlot3D[klein[u,v],{u,0,2 Pi},{v,0,2 Pi},PlotPoints->{48,15},Axes->False,Boxed->False,ViewPoint->{1.4,-2.6,-1.7}]

V6

ParametricPlot3D[klein[u,v],{u,0,2 Pi},{v,0,2 Pi},Axes->False,Boxed->False,ViewPoint->{1.4,-2.6,-1.7}]

Colored

ParametricPlot3D[klein[u,v],{u,0,2 Pi},{v,0,2 Pi},
Axes->False,Boxed->False,ViewPoint->{1.4,-2.6,-1.7},ColorFunctionScaling->False,Exclusions->None,ColorFunction->Function[{x,y,z,u,v},Hue[u/(2Pi)]]]

Using Piecewise

KleinBottle[{A_,B_,C_},{s_,t_}]:={Piecewise[{{A Cos[s] (1+Sin[s])+B (1-Cos[s]/2) Cos[s] Cos[t],0≤s≤Pi},{A Cos[s] (1+Sin[s])+B (1-Cos[s]/2) Cos[t+π],Pi≤s≤2 Pi}}],Piecewise[{{C Sin[s]+B (1-Cos[s]/2) Sin[s] Cos[t],0≤s≤Pi},{C Sin[s],Pi≤s≤2 Pi}}],B (1-Cos[s]/2) Sin[t]}

Manipulate[ParametricPlot3D[KleinBottle[{A,B,C},{s,t}],{s,0,2 Pi},{t,0,2 Pi},Exclusions->None,PlotStyle->Opacity[0.8`],PerformanceGoal->"Quality",Mesh->None],{{A,6},2,12,Appearance->"Labeled"},{{B,6},2,8,Appearance->"Labeled"},{{C,19},8,32,Appearance->"Labeled"}]

With hole

From Michael Trott, Nov. 4, 2020:
We could even make a 'real' Klein Bottle that one could fill with a liquid.  The intersection of the narrow part with the bulky part is approximately an ellipse, so with a RegionFunction one could cut a hole:

With[{S=3.415,ρs=0.258`,ρt=0.338`},ParametricPlot3D[KleinBottle[{6,6,19},{s,t}],{s,0,2 π},{t,0,2 π},Exclusions->None,PlotStyle->Opacity[0.8`],PerformanceGoal->"Quality",Mesh->None,RegionFunction->(!(#4-S)^2/ρs^2+(#5-Pi)^2/ρt^2<1&)]]

Properties

KleinBottle[{A_,B_,C_},{s_,t_}]:={Piecewise[{{A Cos[s] (1+Sin[s])+B (1-Cos[s]/2) Cos[s] Cos[t],0≤s≤Pi},{A Cos[s] (1+Sin[s])+B (1-Cos[s]/2) Cos[t+π],Pi≤s≤2 Pi}}],Piecewise[{{C Sin[s]+B (1-Cos[s]/2) Sin[s] Cos[t],0≤s≤Pi},{C Sin[s],Pi≤s≤2 Pi}}],B (1-Cos[s]/2) Sin[t]}

AreaElement

AreaElement[KleinBottle[{a,b,c},{u,v}],{u,v}]

(dA=FullSimplify[AreaElement[KleinBottle[{a,b,c},{u,v}],{u,v}],0<u<2π&&0<v<2π&&a>0&&b>0&&c>0]0

FirstFundamentalForm

FullSimplify[FirstFundamentalForm[KleinBottle[{a,b,c},{u,v}],{u,v}],0<u<2π&&0<v<2π]

efg1[u_,v_]:={(((({{\[Piecewise], ({{a ((Cos[u])^2)-(1/2) Sin[u] (b Cos[v]+2 a (1+Sin[u])), u≥π}, {a ((Cos[u])^2)+b Cos[u] Cos[v] Sin[u]-Sin[u] (a+b Cos[v]+a Sin[u]), True}})}})))^2)+(((({{\[Piecewise], ({{c Cos[u], u>π}, {-(1/2) b ((Cos[u])^2) Cos[v]+Cos[u] (c+b Cos[v])+(1/2) b Cos[v] ((Sin[u])^2), u<π}, {Indeterminate, True}})}})))^2)+(1/4) (b^2) ((Sin[u])^2) ((Sin[v])^2),({{\[Piecewise], ({{(1/2) a b (1+Sin[u]) (2-Cos[u]-4 Sin[u]+Sin[2 u]) Sin[v], u>π}, {(1/4) b (1-4 Cos[u]+Cos[2 u]) (a Cos[2 u]+(-a+c) Sin[u]) Sin[v], u<π}, {Indeterminate, True}})}}),(1/4) (b^2) (((-2+Cos[u]))^2)}

FullSimplify[FirstFundamentalForm[KleinBottle[{a,b,c},{u,v}],{u,v}],0<=u<=2π&&0<=v<=2π]

efg2[u_,v_]:={(((({{\[Piecewise], ({{c Cos[u], π<u<2 π}, {-(1/2) b ((Cos[u])^2) Cos[v]+Cos[u] (c+b Cos[v])+(1/2) b Cos[v] ((Sin[u])^2), 0<u<π}, {Indeterminate, True}})}})))^2)+(((({{\[Piecewise], ({{a ((Cos[u])^2)-(1/2) Sin[u] (b Cos[v]+2 a (1+Sin[u])), π≤u<2 π}, {a ((Cos[u])^2)+b Cos[u] Cos[v] Sin[u]-Sin[u] (a+b Cos[v]+a Sin[u]), 0<u<π}, {Indeterminate, True}})}})))^2)+(1/4) (b^2) ((Sin[u])^2) ((Sin[v])^2),({{\[Piecewise], ({{(1/2) a b (1+Sin[u]) (2-Cos[u]-4 Sin[u]+Sin[2 u]) Sin[v], π<u<2 π}, {(1/4) b (1-4 Cos[u]+Cos[2 u]) (a Cos[2 u]+(-a+c) Sin[u]) Sin[v], 0<u<π}, {Indeterminate, True}})}}),(1/4) (b^2) (((-2+Cos[u]))^2)}

TextGrid[Flatten[Table[{u,v,efg1[u,v],efg2[u,v],efg1[u,v]-efg2[u,v]},{u,{0,π,2π}},{v,{0,π,2π}}],1],Dividers->All]

SecondFundamentalForm

FullSimplify[SecondFundamentalForm[KleinBottle[{a,b,c},{u,v}],{u,v}],0<u<2π&&0<v<2π]

SurfaceArea

?SurfaceArea

<<MathWorld`Surfaces`

?*SurfaceArea*

MetricTensor[KleinBottle[{a,b,c},{u,v}],{u,v}],]

bottle=With[{a=6,b=6,c=19},ParametricRegion[KleinBottle[{a,b,c},{u,v}],{{u,0,2π},{v,0,2π}}]]

bug(400506): Region[KleinBottle] is slow

(reg=Region[bottle])//AbsoluteTiming

$Version

SurfaceArea[bottle]//Timing//AbsoluteTiming

Square

Graphics[{
{GrayLevel[.9],Rectangle[{0,0},{1,1}]},
Arrowheads[.1],
Arrow[{{0,0},{0,1}}],Arrow[{{0,1},{1,1}}],Arrow[{{1,1},{1,0}}],Arrow[{{0,0},{1,0}}],
Text[Style["Klein bottle",Directive[18,Italic]],{.5,-.1}]
},PlotRange->{{-.05,1.05},{-.2,1.05}}]

Nordstrand

Is this even correct?

V5

ParametricPlot3D[{
Cos[u](Cos[u/2](Sqrt[2]+Cos[v])+Sin[u/2]Sin[v]Cos[v]),
Sin[u](Cos[u/2](Sqrt[2]+Cos[v])+Sin[u/2]Sin[v]Cos[v]),
-Sin[u/2](Sqrt[2]+Cos[v])+Cos[u/2]Sin[v]Cos[v]
},{u,0,2π},{v,0,2π},Boxed->False,Axes->False]

ParametricPlot3D[{
Cos[u](Cos[u/2](Sqrt[2]+Cos[v])+Sin[u/2]Sin[v]Cos[v]),
Sin[u](Cos[u/2](Sqrt[2]+Cos[v])+Sin[u/2]Sin[v]Cos[v]),
-Sin[u/2](Sqrt[2]+Cos[v])+Cos[u/2]Sin[v]Cos[v]
},{u,0,2π},{v,0,π},Boxed->False,Axes->False]

V6

ParametricPlot3D[{
Cos[u](Cos[u/2](Sqrt[2]+Cos[v])+Sin[u/2]Sin[v]Cos[v]),
Sin[u](Cos[u/2](Sqrt[2]+Cos[v])+Sin[u/2]Sin[v]Cos[v]),
-Sin[u/2](Sqrt[2]+Cos[v])+Cos[u/2]Sin[v]Cos[v]
},{u,0,2π},{v,0,2π},Boxed->False,Axes->False]

ParametricPlot3D[{
Cos[u](Cos[u/2](Sqrt[2]+Cos[v])+Sin[u/2]Sin[v]Cos[v]),
Sin[u](Cos[u/2](Sqrt[2]+Cos[v])+Sin[u/2]Sin[v]Cos[v]),
-Sin[u/2](Sqrt[2]+Cos[v])+Cos[u/2]Sin[v]Cos[v]
},{u,0,2π},{v,0,π},Boxed->False,Axes->False]

Figure-8 Parametrization

surf[u_,v_]:={(3+Cos[u/2]Sin[v]-Sin[u/2]Sin[2v])Cos[u],(3+Cos[u/2]Sin[v]-Sin[u/2]Sin[2v])Sin[u],Sin[u/2]Sin[v]+Cos[u/2]Sin[2v]}

Plot

V5

g=ParametricPlot3D[surf[u,v],{u,0,2Pi},{v,0,2Pi},Boxed->False,Axes->False,PlotPoints->{30,30}]

V6

ParametricPlot3D[surf[u,v],{u,0,2Pi},{v,0,2Pi},Boxed->False,Axes->False]

LiveGraphcis3D

<<Utilities`LiveGraphics3D`

WriteLiveForm["klein8.m",g]

Equation

Factor/@GroebnerBasis[Join[Thread[{x,y,z}==TrigExpand[surf[u,v]/.{u->2uu,v->2vv}]],(Sin[#]^2+Cos[#]^2==1)&/@{uu,vv}],{x,y,z},{Cos[uu],Sin[uu],Cos[vv],Sin[vv]},MonomialOrder->EliminationOrder]

eqn=10368 (x^4)-7776 (x^5)-1008 (x^6)+1728 (x^7)-160 (x^8)-96 (x^9)+16 (x^10)+2349 (x^2) (y^2)-5832 (x^3) (y^2)-1206 (x^4) (y^2)+3024 (x^5) (y^2)-363 (x^6) (y^2)-264 (x^7) (y^2)+52 (x^8) (y^2)+18225 (y^4)+1944 x (y^4)-11052 (x^2) (y^4)+864 (x^3) (y^4)+1815 (x^4) (y^4)-216 (x^5) (y^4)-96 (x^6) (y^4)+4 (x^8) (y^4)-10854 (y^6)-432 x (y^6)+4079 (x^2) (y^6)-24 (x^3) (y^6)-440 (x^4) (y^6)+16 (x^6) (y^6)+2061 (y^8)+24 x (y^8)-464 (x^2) (y^8)+24 (x^4) (y^8)-156 (y^10)+16 (x^2) (y^10)+4 (y^12)-24516 (x^3) y z+21492 (x^4) y z-2892 (x^5) y z-1956 (x^6) y z+624 (x^7) y z-48 (x^8) y z+45468 x (y^3) z+3456 (x^2) (y^3) z-29112 (x^3) (y^3) z+4068 (x^4) (y^3) z+4464 (x^5) (y^3) z-1096 (x^6) (y^3) z-96 (x^7) (y^3) z+32 (x^8) (y^3) z-18036 (y^5) z-26220 x (y^5) z+14004 (x^2) (y^5) z+7056 (x^3) (y^5) z-3000 (x^4) (y^5) z-288 (x^5) (y^5) z+128 (x^6) (y^5) z+7980 (y^7) z+3216 x (y^7) z-2904 (x^2) (y^7) z-288 (x^3) (y^7) z+192 (x^4) (y^7) z-952 (y^9) z-96 x (y^9) z+128 (x^2) (y^9) z+32 (y^11) z-4572 (x^4) (z^2)+6552 (x^5) (z^2)-3388 (x^6) (z^2)+768 (x^7) (z^2)-64 (x^8) (z^2)+70830 (x^2) (y^2) (z^2)-44352 (x^3) (y^2) (z^2)-13786 (x^4) (y^2) (z^2)+13392 (x^5) (y^2) (z^2)-1300 (x^6) (y^2) (z^2)-576 (x^7) (y^2) (z^2)+96 (x^8) (y^2) (z^2)-6246 (y^4) (z^2)-50904 x (y^4) (z^2)+2032 (x^2) (y^4) (z^2)+24480 (x^3) (y^4) (z^2)-4812 (x^4) (y^4) (z^2)-1728 (x^5) (y^4) (z^2)+400 (x^6) (y^4) (z^2)+12430 (y^6) (z^2)+11856 x (y^6) (z^2)-5980 (x^2) (y^6) (z^2)-1728 (x^3) (y^6) (z^2)+624 (x^4) (y^6) (z^2)-2404 (y^8) (z^2)-576 x (y^8) (z^2)+432 (x^2) (y^8) (z^2)+112 (y^10) (z^2)+30804 (x^3) y (z^3)-33348 (x^4) y (z^3)+8448 (x^5) y (z^3)+2048 (x^6) y (z^3)-1152 (x^7) y (z^3)+128 (x^8) y (z^3)-23628 x (y^3) (z^3)-24216 (x^2) (y^3) (z^3)+25536 (x^3) (y^3) (z^3)+880 (x^4) (y^3) (z^3)-3744 (x^5) (y^3) (z^3)+608 (x^6) (y^3) (z^3)+9132 (y^5) (z^3)+17088 x (y^5) (z^3)-4384 (x^2) (y^5) (z^3)-4032 (x^3) (y^5) (z^3)+1056 (x^4) (y^5) (z^3)-3216 (y^7) (z^3)-1440 x (y^7) (z^3)+800 (x^2) (y^7) (z^3)+224 (y^9) (z^3)+4592 (x^4) (z^4)-6528 (x^5) (z^4)+3392 (x^6) (z^4)-768 (x^7) (z^4)+64 (x^8) (z^4)-15451 (x^2) (y^2) (z^4)+4824 (x^3) (y^2) (z^4)+6540 (x^4) (y^2) (z^4)-3456 (x^5) (y^2) (z^4)+448 (x^6) (y^2) (z^4)+2637 (y^4) (z^4)+11352 x (y^4) (z^4)+744 (x^2) (y^4) (z^4)-4608 (x^3) (y^4) (z^4)+984 (x^4) (y^4) (z^4)-2404 (y^6) (z^4)-1920 x (y^6) (z^4)+880 (x^2) (y^6) (z^4)+280 (y^8) (z^4)-3120 (x^3) y (z^5)+3408 (x^4) y (z^5)-1152 (x^5) y (z^5)+128 (x^6) y (z^5)+2928 x (y^3) (z^5)+2456 (x^2) (y^3) (z^5)-2592 (x^3) (y^3) (z^5)+480 (x^4) (y^3) (z^5)-952 (y^5) (z^5)-1440 x (y^5) (z^5)+576 (x^2) (y^5) (z^5)+224 (y^7) (z^5)+16 (x^4) (z^6)+868 (x^2) (y^2) (z^6)-576 (x^3) (y^2) (z^6)+96 (x^4) (y^2) (z^6)-156 (y^4) (z^6)-576 x (y^4) (z^6)+208 (x^2) (y^4) (z^6)+112 (y^6) (z^6)-96 x (y^3) (z^7)+32 (x^2) (y^3) (z^7)+32 (y^5) (z^7)+4 (y^4) (z^8);

AlgebraicDegree[eqn,{x,y,z}]

Curvatures

Curvatures[a surf[u,v],{u,v},Refine[FullSimplify[#,a>0],a>0]&]

Principal Curvatures

Simplify[PrincipalCurvatures[a surf[u,v],{u,v}],a>0&&(u|v)∈Reals]

Area

√(-(a^4) ((Sin[v])^6)-(1/16) (a^4) (5+Cos[2 v]+4 Cos[4 v]) (-78+3 Cos[4 v]+4 Sin[v] (-12 Cos[(u/2)]+(Cos[u]+4 Cos[v] Sin[u]) Sin[v])+Cos[2 v] (3+8 Cos[u] ((Sin[v])^2))+48 Sin[(u/2)] Sin[2 v]))/.a->1

NIntegrate[√(-((Sin[v])^6)-(1/16) (5+Cos[2 v]+4 Cos[4 v]) (-78+3 Cos[4 v]+4 Sin[v] (-12 Cos[(u/2)]+(Cos[u]+4 Cos[v] Sin[u]) Sin[v])+Cos[2 v] (3+8 Cos[u] ((Sin[v])^2))+48 Sin[(u/2)] Sin[2 v])),{u,0,2π},{v,0,2π}]

Metric Properties

klein=a {(3+Cos[u/2] Sin[v]-Sin[u/2] Sin[2 v]) Cos[u],(3+Cos[u/2] Sin[v]-Sin[u/2] Sin[2 v]) Sin[u],Sin[u/2] Sin[v]+Cos[u/2] Sin[2 v]};

Metric Tensor

MetricTensor[klein,{u,v}]//FullSimplify

Christoffel Symbol of the Second Kind

FullSimplify[ChristoffelSymbols[klein,{u,v}],a>0]

Vector Properties

eqn=a {(3+Cos[u/2] Sin[v]-Sin[u/2] Sin[2 v]) Cos[u],(3+Cos[u/2] Sin[v]-Sin[u/2] Sin[2 v]) Sin[u],Sin[u/2] Sin[v]+Cos[u/2] Sin[2 v]};
rules={Abs[x_]^(n_/;Mod[n,2]==0):>x^n};
assum=a>0&&0<u<2π&&0<v<π;

Vector Length

Assuming[assum,FullSimplify[Norm[eqn]/.rules]]

Normal Vector

Assuming[assum,FullSimplify[NormalVector[eqn,{u,v}]/.rules]]