\(\(\( (*\ \(:\)\(Title : Arrow\ 3  D\)*) \)\( (*\ \(:\)\(Context : 
          Graphics`Arrow3D`\)*) \)\( (*\ \(:\)\(Author : 
          John\ M . Novak\)*) \)\( (*\ \(:\)\(Summary : 
          crude\ 3  D\ arrow\ primitive\)*) \)\( (*\ \(\(:\)\(Copyright : 
          Copyright\ 1996\ Wolfram\ Research\)\), \(\(Inc\)\(.\)\)*) \)\( (*\ \(:\)\(Package\ \(Version : 
            1.0\)\)*) \)\( (*\ \(:\)\(Mathematica\ \(Version : 
            3.0\)\)*) \)\( (*\ \(:\)\(History : 
          V1 \( .0--\)\ March\ 1996\ by\ John\ M . 
              Novak\)*) \)\( (*\ \(\(:\)\(Keywords : arrow\)\), 
      Graphics3D*) \)\( (*\ \(\(:\)\(Sources : 
          Tom\ Wickham - 
            Jones\)\), "Mathematica Graphics"*) \)\( (*\ \(\(:\)\(Discussion : 
          This\ is\ a\ package\ to\ add\ crude\ 3  D\ arrows\ by\ using\ 3  
            D\ graphics\ primitives . 
              The\ main\ problem\ with\ this\ approach\ is\ that\ arrows\ don' t\ have\ an\ optimal\ appearance\)\), 
      and\ distinction\ between\ \((e . g . )\)\ arrows\ point\ toward\ vs . 
          away\ from\ the\ user\ is\ difficult\ to\ make . 
          On\ the\ other\ hand, it\ is\ readily\ implementable, 
      which\ is\ far\ superior\ to\ any\ other\ approach\ available\ at\ this\ time . \((The\ PostScript\ used\ in\ 2  D\ arrows\ won' 
              t\ layer\ correctly\ in\ 3  D, nor\ would\ 2  D\ primitives; 
            placing\ 3  
              D\ planar\ primitives\ with\ the\ correct\ orientation\ has\ problems\ with\ perspective\ transforms\ as\ well\ as\ design\ problems\ with\ things\ like\ arrows\ with\ a\ small\ angle\ w . r . t . 
                the\ \(\(user\)\(.\)\))\)\ Because\ of\ the\ essentially\ different\ approach\ from\ 2  D\ arrows, 
      the\ package\ is\ being\ made\ independent\ of\ the\ 2  
        D\ package\ for\ the\ time\ \(\(being\)\(.\)\)*) \)\(BeginPackage["Graphics`Arrow3D`"]


    \(Arrow3D::usage = "Arrow3D[start, end] is a 3D graphics primitive representing an arrow in
space. The start point and the end point are given as {x, y, z}
triplets.
Options controlling the length and width of the arrowhead are
available.";\)


    Begin["`Private`"]

 (*The\ following\ routine\ is\ based\ on\ OrthogonalVectors\ from\ Tom\ Wickham - 
        Jones'\ Mathematica\ Graphics\ \(\(book\)\(.\)\)*) 


    anOrthogonalVector[norm : {_, _, _}] := 
      Block[{pos, a, b, v1}, 
        pos = If[VectorQ[norm, NumberQ], Abs[N[norm]], 
            norm]; 
pos = 
          Sort[Transpose[{pos, Range[3]}]]; 
{pos, a, b} = 
          Map[Last, pos]; 
v1 = 
          ReplacePart[{0, 0, 0}, \(-Part[norm, a]\), 
            b]; 
ReplacePart[v1, Part[norm, b], 
          a]]


    normalize[vec_] := 
      vec/Sqrt[vec . vec]

 (*The\ following\ routine' 
        rotationmatrix'\ was\ borrowed\ from\ the\ standard\ package\ \(\(Graphics`SurfaceOfRevolution`\)\(.\)\)*) 


    rotationmatrix[axis_, theta_] := 
      Module[{n1, n2, n3}, {n1, n2, n3} = 
          normalize[axis] // 
            N; 
{{n1^2 + \((1 - n1^2)\)\ Cos[theta], 
              n1\ n2\ \((1 - Cos[theta])\) + n3\ Sin[theta], 
              n1\ n3\ \((1 - Cos[theta])\) - 
                n2\ Sin[theta]}, {n1\ n2\ \((1 - Cos[theta])\) - 
                n3\ Sin[theta], n2^2 + \((1 - n2^2)\)\ Cos[theta], 
              n2\ n3\ \((1 - Cos[theta])\) + 
                n1\ Sin[theta]}, {n1\ n3\ \((1 - Cos[theta])\) + 
                n2\ Sin[theta], 
              n2\ n3\ \((1 - Cos[theta])\) - n1\ Sin[theta], 
              n3^2 + \((1 - n3^2)\)\ Cos[theta]}} // N]


    Arrow3D[base : {_, _, _}, tip : {_, _, _}, polys_:  10, 
        len_:  0.8] := {Line[{base, tip}], 
        mycone[tip - base, base, tip, polys, len]}


    Arrow3D[base : {_, _, _}, tip : {_, _, _}, ___] := 
      Point[base] /; base == tip


    mycone[vec_, base_, tip_, polys_, len_] := 
      Block[{norm = anOrthogonalVector[vec], theta}, 
        Map[Polygon[Append[#, tip]] &, 
          Partition[
            Table[base + 
                  len\ vec + \((1 - len)\)/2\ norm . 
                      rotationmatrix[vec, theta], {theta, 0, 2\ Pi, 
                  2\ Pi/polys}] // N, 2, 1]]]


    End[]


    EndPackage[]



    \("Graphics`Arrow3D`";\)

    \("Arrow3D[start, end] is a 3D graphics primitive representing an arrow in space. The start point and the end point are given as {x, y, z} triplets. Options controlling the length and width of the arrowhead are available.";\)

    \("Graphics`Arrow3D`Private`";\)

    \("Graphics`Arrow3D`Private`";\)

    \)\)\)

\(MATH\ 257\ Calculus\ III				Week\ of\ May\ 12, \ 2003\)
Lab 7 :  Wector Functions
Name 1
Name 2
Section:

Before you begin execute the following command.  Click YES when asked to execute any initialization cells:

<< Graphics`Arrow`

Be sure to read everything and execute all the commands as you go along.

Graphing Space Curves

If you're given a vector function or a parameterized set of 3D equations, use the ParametricPlot3D[] command to graph them.

For example, here's the graph of the "twisted cubic":

cubic = 
      ParametricPlot3D[{t, t^2, t^3},  {t, -2, 2},  
        AspectRatio -> 1]

Question 1: Graph the space curve for the vector function r(t)= < t*cos(t), t*sin(t), t>.  (We saw this in class yesterday.)  If it doesn't look right, try using the PlotPoints option in the plot.

How do we plot vectors along with our space curves?  Vectors need the Arrow3D[] command, and these have to be inside a Graphics3D[] command.  But the plot of the space curve has to be in a ParametricPlot3D[] command!  You can put these things together with the Show[] command.  Here's an example for the vector function <sin(t), 3, Cos(t)>.

Show[
ParametricPlot3D[{Sin[t],  3,  Cos[t],  
          Thickness[ .01]},  {t, 0,  
          2  π},  
PlotRange -> {{-1.5, 
              1.5},  {0, 3},  {-1.5, 
              1.5}}], 
Graphics3D[
        Table[Arrow3D[{0, 0, 0},  {Sin[t],  3,  Cos[t]}], {t,  .2, 
            2  π, 1}]]
]

Question 2: Draw the space curve for the vector function r(t)=<sin(t), sin(2t), sin(3t)> together with some of its veectors in the same graph.  You don't have to draw tons of vectors.  Just do a sample, like make t go from 1.5 to 2.5 with step size of .1.  (I recommend using ViewPoint->{3,2,1})

For what follows, it would be very useful to help Mathematica out a bit.  See, Mathematica does not have a built-in function that gives you the magnitude of a vector.  So let's make one ourselves!  The following should do the trick:

mag[
        v_] := (Sqrt[v[[1]]^2  +  v[[2]]^2  +  v[[3]]^2])

The brackets tell Mathematica to look at that part of the list v.  This will work just fine.  Try it:

mag[{1, 1, 1}]

Question 3a: Now, you know how to take derivatives, and you know how to draw 3D vectors.  So make a graph of the vector function r(t)=<sin(t), sin(2t), sin(3t)> (just like the previous problem), but this time draw with it some of the tangent vectors along the curve.  These tangent vectors should be drawn properly on the curve to look, well, like tangent vectors.

Here's a new definition:  we let a unit tangent vector be a tangent vector that is of unit length.  In other words, if r(t) is our vector function, then the unit tangent vector function is just:
			T(t) = r'(t)/|r'(t)|.

Question 3b: Do the same thing as in question 3a, only this time use unit tangent vectors in your graph.  (This should make the picture look a lot more tame.)

Question 4a: Consider the two space curves given by the vector functions
	r(t)=<t, t^2, t^3>  and  q(t)=<2t+2, t+4,t+8>
Find the point at which these two curves intersect.  (Suggestion: The position vector of this point might be attained by r(t) and q(t) at different values of t.  So look at r(s)=q(t).  The third coordinates give an easy relationship between s and t.)

Question 4b:  For the same curves as in question 4a, find the (acute) angle between these curves at the point where they intersect.

Parameterizing Surface Intersections

Lastly, let's do some problems that we'd NEVER want to do by hand.  Consider the surface equations
			z = 4 - (x^2) - (y^2)  and    z = 2 - (x/5) + (y/2)
Let's plot these surfaces together:

\(\(\(\(f[x_, y_] := 4 - x^2 - y^2;\)

    \(g[x_, y_] := 2 - x/5 + y/2;\)

    \(surf1 = 
        Plot3D[f[x, y], \ {x, \ \(-2\), 2}, \ {y, \(-2\), 2}, \ 
          PlotRange -> {0, 4}, \ 
          DisplayFunction -> Identity];\)\  (*\ 
      That\ last\ command\ just\ suppresses\ drawing\ the\ graph\ *) 

    \(surf2 = 
        Plot3D[g[x, y], \ {x, \(-2\), 2}, \ {y, \(-2\), 2}, \ 
          PlotRange -> {0, 4}, \ \ \ DisplayFunction -> 
            Identity];\)

    Show[surf1, 
      surf2, \ \ ViewPoint -> {3, 1, 1.5}, \ \ BoxRatios -> 
        Automatic, \ DisplayFunction -> $DisplayFunction]\)\(\ \)\( (*\ 
      That\ last\ command\ turns\ "drawing the graph"\ back\ on\ *) \)\)\)

Our Goal is to find a parameterization for the intersection curve between these surfaces.  As you'll soon see, doing this is YUCKY, but Mathematica doesn't care!

Let's first try something that doesn't work very well.  Clearly we should just set f[x,y]=g[x,y] and solve, right? Try it:

Solve[f[x, y] == g[x, y]]

I don't like the look of those radicals.  If they're negative, we won't get a real solution.  Soooo...

Solve[201 - 50 y - 100 (y^2) == 0] // N

Ah!  So we should try graphing this for -1.68962 ≤ y ≤ 1.18962.  We're ready to go!  If we just let y be the parameter, then we should use x = (1/10) (1 - (Sqrt[201 - 50 y - 100 (y^2)])) and can use z=g[x,y] for the z coordinate.  Here we go...

ParametricPlot3D[{(1/10) (1 - (Sqrt[201 - 50 y - 100 (y^2)])),  y,  
        g[(1/10) (1 - (Sqrt[201 - 50 y - 100 (y^2)])),  
          y]},  {y, -1.68, 1.18}]

Hey!  This only gave us part of the intersection curve!  No fair!   

A better way to approach this is to use cylindrical coordinates!  (Betcha didn't think we'd ever use those again, eh?)  That is, set
			x = r*cos(t)	y = r*sin(t) 	and	z = z
How do we use this?  Well, we still need to set f[x,y]=g[x,y] and solve, but let's put our cylindrical coordinates in as well and solve for r:

Solve[
      f[r Cos[θ],  r Sin[θ]] == 
        g[r Cos[θ], r Sin[θ]], r]

Huh!  Let's take the first one and let it be r[θ]:

r[θ_] := ((2 Cos[θ] - 5 Sin[θ] - (Sqrt[804 Cos[θ]^2 - 20 Cos[θ] Sin[θ] + 825 Sin[θ]^2]))/(2 (10 Cos[θ]^2 + 10 Sin[θ]^2)))

Now we're ready to go!  This time we'll let θ be our parameter, and let
	x = r[θ]Cos[θ],	      y = r[θ]Sin[θ],     and    z = g[x,y] = g[r[θ]Cos[θ], r[θ]Sin[θ]]
Let's go:

intcurve1 = 
      ParametricPlot3D[
{r[θ] Cos[θ],  
          r[θ] Sin[θ],  
          g[r[θ] Cos[θ],  r[θ] Sin[θ]],  
          Thickness[ .01]}, 
{θ,  0,  2  π},  
        ViewPoint -> {3, 1, 1.5},  
        PlotRange -> {0, 4}]

That's the ticket!  Of course, we're not done until we test it by graphing it with the surfaces:

Show[surf1,  surf2,  
      intcurve1,   ViewPoint -> {3, 1, 1.5},  
      BoxRatios -> Automatic,  
      DisplayFunction -> $DisplayFunction]

Oh yeah! (said in a very deep, deep voice)

Question 5: Follow the above procedure to find and plot a parameterization of the intersection of the surfaces
			z = 4 - (x^2) - (y^2)   	and   \(TraditionalForm\`\(\(	\)\(z = x\^2 + 2  y\^2 - x\ y\)\)\)

Now that you're done, 
	(1) 	Clean up your work by deleting everything that's not needed.  
		There should only be the title, your names, section number, and the questions and your answers
		(with any needed explanations, graphs, etc.).
	(2) 	Save this to your disk.
	(3)	Go back to Blackboard and upload your final lab report to the Digital Drop Box, located
		in the User Tools area.  Remember that you have to first ADD your file to your digital drop box and 
		then SEND it to me!