Multivariable Calculus Computer Algebra Project 2014

Math  21a,Fall 2014

In this Mathematica 10 project, we try to be creative.  I will  provide you with some examples. The actual problems at the very end. The project is due on Saturday December 6th electronically by email. There is a Mathematica workshop on November 19, 2014, from 7-8:30 PM in Hall C. 

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 exampleof an object 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}]

This example can be exported as follows (You do not have to submit the exported files).

Export["1.3ds",S,"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}]

And here is the Monkey riding the saddle.

S1=ParametricPlot3D[{u,v,v u^2-v^3-0.4},{u,-1,1},{v,-1,1},PlotStyle->Blue,Mesh->False];
S2=ParametricPlot3D[0.5 {Cos[u] Sin[v],Sin[u] Sin[v],2 Cos[v]}+{0,0,0.6},{u,0,2 Pi},{v,0,Pi},Mesh->False,PlotStyle->Red];
S3=ParametricPlot3D[0.4 {Cos[u] Sin[v],Sin[u] Sin[v],Cos[v]}+{0,0,2},{u,0,2 Pi},{v,0,Pi},Mesh->False];
S4=Graphics3D[{Green,Tube[{{0,0,0},{1,-0.5,-0.2}},0.2]}];
S5=Graphics3D[{Green,Tube[{{0,0,0},{-1,-0.5,-0.2}},0.2]}];
S6=Graphics3D[{Green,Tube[{{0,0,0},{0,1,-0.2}},0.2]}];
S7=Graphics3D[{Blue,Cuboid[{{-0.4,-0.4,2.4},{0.4,0.4,2.5}}]}];
S=Show[{S1,S2,S3,S4,S5,S6,S7},ViewPoint->{-3.13927,-0.431189,1.18703},ViewVertical->{-0.420105,-0.098456,0.962471},PlotRange->All,Axes->False,Boxed->False]

Region Plot

To print things, we have to use closed surfaces or to make a region plot:

S=RegionPlot3D[x^2 y^2+z^2 y^2+x^2 z^2≤1&&x^2≤8.5&&y^2≤8.5&&z^2≤8.5,{x,-3,3},{y,-3,3},{z,-3,3},PlotPoints->50,Mesh->False,ColorFunction->Function[{x,y,z},Hue[z]],Axes->False,Boxed->False]

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]

Using Textures

picture=Import["http://www.math.harvard.edu/archive/21a_fall_11/donald.jpg"];
ParametricPlot3D[(2+Sin[t]) {Cos[t] Sin[s],Sin[t] Sin[s],Cos[s]},{s,0,Pi},{t,0,2Pi},Lighting->"Neutral",Mesh->False,PlotPoints->40,TextureCoordinateFunction->({#5,#4}&),PlotStyle->{Texture[picture]},ViewPoint->{-3.25,-0.9,-0.2},ViewVertical->{-0.64,-0.05,-0.9},Axes->False,Boxed->False,PlotRange->All]

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]

Scanned

If you want an object (or yourself to be scanned and include, see Oliver). Here is an example of a scan

A= Import["http://sites.fas.harvard.edu/~math21a/exhibits/cubify/oliver1.ply"];

Now, we can add stuff to it

V=A[[1,2,1]];M= Sum[V[[k]],{k,Length[V]}]/Length[V];
B1=Graphics3D[Table[{Hue[Random[]],Sphere[M+150{Random[]-1/2,Random[]-1/2,1+Random[]-1/2},10]},{100}]]; 
B2=Graphics3D[{Yellow,Arrow[{M,M+{-200,0,0}},2.2]}];
S=Show[{A,B1,B2},ViewAngle->0.2,ViewPoint->{-3.11,-1.31,-0.180},ViewVertical->{-1.567,-0.049,1.177}]

Assignment

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

1) (3 points) A region plot of a solid of your choice.
2) (3 points) A surface of your choice. (this can also use textures)
3) (4 points) An arbitrary three dimensional object of your choice. Try to make something printable. 

Submit your notebook after removing all the graphics in the above menu Cell -> Delete All Output. If you should use additional resources like textures 
or scanned objects, send them too or provide a link to a download page.

Oliver Knill, November 10 , 2014, email: knill@math.harvard.edu