Multivariable Calculus Computer Algebra Project 2015

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

In this  Mathematica 10 project, we produce an object.  I will  provide you with some examples. The assignment at the very end. The project is due on Saturday August 1th electronically by email. 

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]];
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];
S2=Graphics3D[{Yellow,Cylinder[{{0,-5,0},{0,1,0}},0.4]}];
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 could be exported as follows:

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

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[{RGBColor[Random[],1,0],Sphere[(1-0.03)w[[k]],0.07]},{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]

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]

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,2 Pi},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

Clear[s,t];
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]

Area  computation

R=ConvexHullMesh[RandomReal[1,{10,2}]]
NIntegrate[x^2+y^2,{x,y} ∈ R]

R=ConvexHullMesh[RandomReal[1,{10,2}]]
NIntegrate[x^2+y^2,{x,y} ∈ R]

Area[ImplicitRegion[ x^4+y^6≤1,{x,y}]]

Volume

R=MeshRegion[{{0,0,0},{1,0,0},{0,2,0},{0,0,1},{1,1,1}},{Simplex[{1,2,3,4}],Simplex[{1,2,3,5}]}]
NIntegrate[x,{x,y,z} ∈ R]

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

R=MeshRegion[{{0,0,0},{1,0,0},{0,2,0},{0,0,1},{1,1,1}},{Simplex[{1,2,3,4}],Simplex[{1,2,3,5}]}]
NIntegrate[x,{x,y,z} ∈ R]

A=RegionUnion[Ball[{0,0,0},2.0],Ball[{1.,1.,1.},2.]];
B=RegionIntersection[Ball[{0,0,0},2.0],Ball[{1.,1.,1.},2.]];
U=ImplicitRegion[x^4+y^4+z^4<=1,{x,y,z}];
{RegionPlot3D[A,PlotPoints->30,PlotStyle->Red],
RegionPlot3D[B,PlotPoints->30,PlotStyle->Green]
RegionPlot3D[U,PlotPoints->30,PlotStyle->Yellow]}
Volume[U]

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

Moment of Inertia

R=ConvexHullMesh[RandomReal[1,{100,3}]];
NIntegrate[x^2+y^2,{x,y,z} ∈ R]

R=ConvexHullMesh[RandomReal[1,{10,2}]];
NIntegrate[x^2+y^2,{x,y} ∈ R]

R=MeshRegion[{{0,0,0},{1,0,0},{0,2,0},{0,0,1},{1,1,1}},{Simplex[{1,2,3,4}],Simplex[{1,2,3,5}]}];
NIntegrate[x,{x,y,z} ∈ R]

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) (2 points) Find the moment of Inertia of the “Horse” object  (Similarly defined like the Cow object)
2) (2 points) Integrate the function x^2+y^2+z^2 over the Icosahedron.
3) (2 points) Build your own parametrized surface with or without texture.
4) (4 points) Build an arbitrary object  or combination of your choice. You can use Graphics3D objects, parametrized surfaces, Region plots, Mesh regions

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

Oliver Knill, July 23, 2015, email: knill@math.harvard.edu