Multivariable Calculus Computer Algebra Project 2013

Oliver knill, Harvard Summer School, knill@math.harvard.edu, Maths21a, Summer 2013

In this  Mathematica 9 project, we produce a 3D object to be placed in google earth. I will  provide you with some examples. We will export then in 3DS format, which google earth can import.  The assignment at the very end. The project is due on Friday August 2th electronically by email. Please check the following

   1. Your object can be complicated but don’t push it too much. Importing huge files will crash the google earth importer.
   2. Export the 3DS file, then import again to see that things work. 

Content in a mathematica file is organized as cells. To evaluate, grab the bracket to the right, holding down the shift key and hit return.

General  objects

Here is an example “girl” using parametric and implicit surfaces

S1=ContourPlot3D[x^2+y^2+z^2==1,{x,-3,3},{y,-3,3},{z,-3,3},
Mesh->False,ContourStyle->RGBColor[1,1,1]];
S2=ParametricPlot3D[{0,2 s-2,t},{t,-0.5,0.5},{s,-1.5,1},
Mesh->False,PlotStyle->Green];
S3=ParametricPlot3D[2.3*{s Cos[t],-s,s Sin[t]}+{0,-1.0,0},{t,0,2 Pi},{s,0,1},
Mesh->False,PlotStyle->Red];
S4=ParametricPlot3D[{x,Cos[x*y],y},{x,-2,2},{y,-2,2},
Mesh->False,PlotStyle->Yellow];
S=Show[{S1,S2,S3,S4},Boxed->False,Axes->False,PlotRange->All,
ViewPoint->{3.24,0.071,-0.97},ViewVertical->{0.54,0.81,-0.17}]

Export["1.3ds",S,"3DS"]
Import["1.3ds"]

Here is an example with basic graphics objects called “Kung-Fu”

A1={Yellow,Polygon[{{0,0,0},{0,3,0},{3,3,0},{3,0,0}}]};
A2={Blue,Cylinder[{{2,1,0},{0,3,3}},0.1]};
A3={Red,Sphere[{2,2,2.5},0.6]};
A4={Orange,Cuboid[{1,1,1},{2,2,2}]};
A5={Yellow,Sphere[{0,3,3},0.2]};
A6={Yellow,Sphere[{2,1,0},0.2]};
S=Show[Graphics3D[Scale[{A1,A2,A3,A4,A5,A6},0.2]],ViewPoint->{0.51,3.30,0.494}]

Polytopes

Get["PolyhedronOperations`"];

g=First[Geodesate[PolyhedronData["Dodecahedron"],2]];
v=N[0.5*g[[1]]];f=g[[2,1]];vv=Union[Flatten[f]];w=Table[v[[vv[[k]]]],{k,Length[vv]}];
S1=Graphics3D[Table[{RGBColor[1,1,Random[]],Polygon[{v[[f[[k,1]]]],v[[f[[k,2]]]],v[[f[[k,3]]]]}]},{k,Length[f]}]];
S2=Graphics3D[Table[{Hue[Random[]],Sphere[(1-0.03)w[[k]],0.03]},{k,Length[w]}]];S=Show[{S1,S2},Axes->False,Boxed->False]

Contour plots

S=ContourPlot3D[ x^2+y^2+z^2+Sin[5 x y z]==0.14,{x,-0.4,0.4},{y,-0.4,0.4},{z,-0.4,0.4},
Mesh->{5,5},MeshStyle->{{Yellow,Thickness[0.001]},{Orange,Thickness[0.001]}},ContourStyle->Directive[Orange,Opacity[0.8],Specularity[White,30]],Boxed->False,Axes->False]

Parametrized surfaces

S=ParametricPlot3D[ (1.2+Cos[2t] Sin[3 s]) {Cos[t] Sin[s],Sin[t]Sin[s],Cos[s]}/2,{t,0,2Pi},{s,0,Pi},PlotStyle->Directive[Opacity[0.7],Blue,Specularity[White,10]],MeshStyle->{{Yellow,Thickness[0.001]},{Orange,Thickness[0.001]}},Axes->False,Boxed->False]

Knots

u=KnotData[{7,3},"SpaceCurve"];
s=Table[u[t],{t,0,2Pi,2Pi/400}];
S=Graphics3D[{Yellow,Tube[s,0.3]},Boxed->False]

Spherical plots

S=SphericalPlot3D[0.1(1.4+Cos[4t]) (1+Sin[s]),{s,0,Pi},{t,0,2Pi},MeshStyle->Yellow,PlotStyle->Directive[Red,Opacity[0.7]],Axes->False,Boxed->False,PlotRange->All,PlotPoints->40]

Built in objects

ListSurfacePlot3D[ExampleData[{"Geometry3D","Horse"},"VertexData"],Lighting->"Neutral",MaxPlotPoints->50,Mesh->False,PlotStyle->{Specularity[White,20],Texture[ExampleData[{"ColorTexture","GiraffeFur"}]]},TextureCoordinateFunction->(Normalize[{#1,#2,#3}]&),Boxed->False,Axes->False]

From the web

A=Import["http://www.georgehart.com/rp/sierpinski5-george-hart.stl"];
B=Import["http://www.georgehart.com/rp/Goldberg-8-3-george-hart.stl"];Show[Graphics3D[{Scale[A[[1]],2],Translate[Scale[B[[1]],0.6],{1,1,3}]}],Boxed->False]

Assignment

Be creative. If you use inspiration beyond these templates, give credit. Use the above templates to do the following: 

1) (2 points) A  parametric surface of your choice.
2) (2 points) A  spherical plot of your choice.
3) (2 points) A contour level surface of your choice.
4) (2 points) A  polyhedron of your choice
5) (2 points) An arbitrary object  or combination of your choice. 

Submit your notebook after removing all the graphics in the above menu Cell -> Delete All Output.

Oliver Knill, July 15, 2013, email: knill@math.harvard.edu