Multivariable Calculus Computer Algebra Project 2015

Math  21a,Fall 2015

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 5th electronically by email. There is a Mathematica workshop on Wednesday, November 18, 2015, from 6-7 PM in Hall A. 

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).

Here is an example using 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 from practice exam 1.

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

S1=Graphics3D[{Yellow,Opacity[0.2],PolyhedronData["Dodecahedron","Faces"]},Boxed->False];
S2=Graphics3D[{Green,Opacity[0.2],PolyhedronData["Icosahedron","Faces"]},Boxed->False];
S3=Graphics3D[{Blue,Opacity[0.2],PolyhedronData["Octahedron","Faces"]},Boxed->False];
S4=Graphics3D[{Orange,Opacity[0.2],PolyhedronData["Tetrahedron","Faces"]},Boxed->False];
S5=Graphics3D[{Pink,Opacity[0.2],PolyhedronData["Hexahedron","Faces"]},Boxed->False];
HarmonicesMundi=Show[{S1,S2,S3,S4,S5}]

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]

s=Table[{Cos[4t-0.3],Cos[3t+0.3],Cos[5t+1]},{t,0,2Pi,2Pi/400}];
S=Graphics3D[{Green,Tube[s,0.04]},Boxed->False]

Spherical plots

Clear[s,t];S=SphericalPlot3D[0.1(1.4+Cos[4t]) (1+Sin[s]),{s,0,Pi},{t,0,2Pi},MeshStyle->Yellow,PlotStyle->Directive[Red],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://www.math.harvard.edu/archive/21a_fall_14/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}]

Area  computation

Area[ImplicitRegion[ x^2+y^2<1,{x,y}]]

Volume  computation

Volume[ImplicitRegion[ x^2+y^2+z^2<1,{x,y,z}]]

u=ExampleData[{"Geometry3D","StanfordBunny"}];
s=DiscretizeGraphics[u];
NIntegrate[1,{x,y,z}∈ s]

V=PolyhedronData["Octahedron"];
W=ConvexHullMesh[V[[1,1]]];
Integrate[1,{x,y,z} ∈W]

Moment of Inertia

V=PolyhedronData["Octahedron"];
W=ConvexHullMesh[V[[1,1]]];
NIntegrate[x^2+y^2,{x,y,z} ∈W]

Assignment

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

1) (1 points) The volume of x^6+y^6+z^6<1.
2) (1 point)  The moment of inertia of the bunny “StanfordBunny”. 
3) (1 point)  A region plot of a new solid of your choice.
4) (1 point)  A new parametrized surface of your choice.
5) (1 point)  A new knot of your choice.
6) (5 points) An object of your choice in one of the categories “Art”,”Technology”,”Sports”,”Science”,”Nature” ,”Popculture” or ”Food”. 

The objects in 3-6 have to be original. State in 6, in which category you place the object. Experiment to make it look good. The best objects will be selected for an exhibit. 
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 9 , 2015, email: knill@math.harvard.edu