Shameless Mathematica - Making Pretty Pictures using ParametricPlot3D
Hareem Naveed

February 12, 2016

This project is purely for aesthetic purposes where I will play around with plotting some interesting topological surfaces using the “ParametricPlot3D” function. Most of the parametrizations used here come from Wikipedia.

To start us off, let us consider the Klein bottle.

figure8 = ParametricPlot3D[{
(4+Cos[θ/2]*Sin[v]-Sin[θ/2]*Sin[2v])*Cos[θ],(4+Cos[θ/2]*Sin[v]-Sin[θ/2]*Sin[2v])*Sin[θ],(Sin[θ/2]*Sin[v]+Cos[θ/2]*Sin[2v])},{v,-Pi,Pi},{θ,0,2Pi},Mesh -> None]

Using some of the functionality of the “Param	etricPlot3D” function, let’s modify the image above to look nicer:

figure8pretty = ParametricPlot3D[{
(2.5+Cos[θ/2]*Sin[v]-Sin[θ/2]*Sin[2v])*Cos[θ],(2.5+Cos[θ/2]*Sin[v]-Sin[θ/2]*Sin[2v])*Sin[θ],(Sin[θ/2]*Sin[v]+Cos[θ/2]*Sin[2v])},{v,-Pi,Pi},{θ,0,2Pi},Axes -> None,ColorFunction->(RGBColor[#,1,1-#,2/3]&[1/2+{1,-2}.{#1,#2}/3]&), Mesh -> None,Boxed -> False]

The basic Klein bottle plotted above does not really resemble a “bottle”. Playing around with the options in the plotting functions we get:

kleinbottle=ParametricPlot3D[{
-2/15(Cos[u])(3Cos[v]-30Sin[u]+90(Cos[u])^4Sin[u]-60(Cos[u])^6Sin[u]+5Cos[u]Cos[v]Sin[u]),-1/15(Sin[u] (6 Cos[v]-3 (Cos[u])^2 Cos[v]-48 (Cos[u])^4 Cos[v]+48 (Cos[u])^6 Cos[v]-60 Sin[u]-5 Cos[u] Cos[v] Sin[u]-10 (Cos[u])^3 Cos[v] Sin[u]-80 (Cos[u])^5 Cos[v] Sin[u]+150 (Cos[u])^7 Cos[v] Sin[u])),2/15(3+5 Cos[u] Sin[u]) Sin[v]},{u,-Pi,Pi},{v,0,2 Pi},Mesh-> None,Axes -> None, Mesh -> None,Boxed -> False,PlotPoints->40]

Manipulate[ParametricPlot3D[{
-x/15(Cos[u])(3Cos[v]-30Sin[u]+90(Cos[u])^4Sin[u]-60(Cos[u])^6Sin[u]+5Cos[u]Cos[v]Sin[u]),-y/15(Sin[u] (6 Cos[v]-3 (Cos[u])^2 Cos[v]-48 (Cos[u])^4 Cos[v]+48 (Cos[u])^6 Cos[v]-60 Sin[u]-5 Cos[u] Cos[v] Sin[u]-10 (Cos[u])^3 Cos[v] Sin[u]-80 (Cos[u])^5 Cos[v] Sin[u]+150 (Cos[u])^7 Cos[v] Sin[u])),z/15(3+5 Cos[u] Sin[u]) Sin[v]},{u,-Pi,Pi},{v,0,2 Pi},Mesh-> None,Axes -> None, Mesh -> None,Boxed -> False,PlotPoints->40],{x,-1,100},{y,-2,100},{z,1,100}]

From wrapping everything in a  “Manipulate” function, we note that our plot looks most like the familiar Klein bottle when the parameters are relatively similar. Otherwise, it is unrecognizably flattened in one of the three directions.

Let us plot a Boy Surface now; a nonorientable surface with several elegant parametrizations. We will use the parametrization derived by R. Bryant in our plotting approach. Here, we are working with imaginary numbers, and the curve only makes sense for numbers with modulus less than or equal to 1. Hence, we will use the “Piecewise” option to make smooth curves:

w:=u+v I;
g1:=-(3/2) Im[(w (1-w^4))/(w^6+w^3 Sqrt[5]-1)];
g2:=-(3/2) Re[(w(1+w^4))/(w^6+w^3 Sqrt[5]-1)];
g3:=Im[(1+w^6)/(w^6+w^3 Sqrt[5]-1)]-1/2;
g=g1^2+g2^2+g3^2;
ParametricPlot3D[Piecewise[{{{g1/g,g2/g,g3/g},Abs[w]≤1}},Undefined],{u,-1,1},{v,-1,1},PlotPoints->50]

Lastly let us draw a Breather Surface.

r  := 1- a^2;
p := Sqrt[r];
d := a*((Cosh[a*u])^2 + (a*Sin[p*v])^2);
breath={-u+(2*r*Cosh[a*u]*Sinh[a*u])/d,(2*p*Cosh[a*u]*(-(p*Cos[v]*Cos[p*v])-Sin[v]*Sin[p*v]))/d,(2*p*Cosh[b*u]*(-(p*Sin[v]*Cos[p*v])+Cos[v]*Sin[p*v]))/d}

ParametricPlot3D[Evaluate[breath /. a -> 0.4],{u,-13.2,13.2},{v,-37.4,37.4},PlotRange->All,PlotPoints->{60,150}]

r:=1-a^2;
d:=a*((Sqrt[r]*Cosh[a*u])^2+(a*Sin[Sqrt[r]*v])^2)
ParametricPlot3D[Evaluate[{-u+(2*r*Cosh[a*u]*Sinh[a*u])/d,(2*Sqrt[r]*Cosh[a*u]*(-(w*Cos[v]*Cos[Sqrt[r]*v])-Sin[v]*Sin[Sqrt[r]*v]))/d,(2*Sqrt[r]*Cosh[a*u]*(-(w*Sin[v]*Cos[Sqrt[r]*v])+Cos[v]*Sin[Sqrt[r]*v]))/d}
/.a->0.6],{u,-10,10},{v,-40,40},PlotRange->All,PlotPoints->{50,100},Axes -> False,Boxed -> False, PlotStyle -> RGBColor[1,3,5]]

References:

1. Klein Bottle: https://en.wikipedia.org/wiki/Klein_bottle
2. Boy Surface: http://mathworld.wolfram.com/BoySurface.html
3. Breather Surface: https://en.wikipedia.org/wiki/Breather_surface