(* ::Package:: *) (* Vectors package for CalcLabs with Mathematica, an ancillary of Stewart's Calculus, 6th ed. *) (* Author: Selwyn Hollis *) (* June 2007 *) (* This package defines a function Vector that plots 2D and 3D vectors. *) Unprotect[Vector3D]; Remove[Vector3D, Vector, ijk]; Vector::usage :="Vector[{x,y}] plots a 2D vector located at the origin. Vector[{{a,b},{x,y}}] plots the vector (x,y) located at (a,b). Vector[{x,y,z}] plots a 3D vector located at the origin. Vector[{{a,b,c},{x,y,z}}] plots the vector (x,y,z) located at (a,b,c). Vector returns a Graphics or Graphics3D object. A sequence of graphics directives may be supplied after the first argument. Example: Vector[{1,1,1}, Thick, Dashed] plots a vector with a thick, dashed shaft." (* For 2D vectors, Vector uses Arrow. For 3D vectors, Vector calls Vector3D, which builds a conical arrowhead in essentially the same way as John Novak's old Arrow3D package, and which takes a head-scaling function as a third argument. The head-scaling function used by Vector provides a compromise between heads with fixed size and heads with size proportional to vector length. *) (* Vector is defined in the Global context and not protected so that it may be partially defined in 2D by students. *) BeginPackage["Vectors`"]; Vector3D::usage ="Vector3D[{a,b,c},{x,y,z}, headScalingFunction, directives]"; Options[Vector3D] = {HeadScaleFactors->{1,1}}; cross3; rotmat; Begin["`Private`"]; cross3[{a1_,a2_,a3_},{b1_,b2_,b3_}]:= {-(a3 b2)+a2 b3, a3 b1-a1 b3, -(a2 b1)+a1 b2}; rotmat=Compile[{v1,v2,v3}, With[{\[Theta]=\[Pi]/6}, {{v1^2+Cos[\[Theta]] (v2^2+v3^2), ((1-Cos[\[Theta]]) v1 v2 (v1^2+v2^2)+Sin[\[Theta]] v3 (v1^4+v2^2+v1^2 (v2^2+v3^2)))/(v1^2+v2^2), -Sin[\[Theta]] v2+(1-Cos[\[Pi]/6]) v1 v3}, {((1-Cos[\[Theta]]) v1 v2 (v1^2+v2^2)-Sin[\[Theta]] v3 (v1^2 (1+v2^2)+v2^2 (v2^2+v3^2)))/(v1^2+v2^2), v2^2+Cos[\[Theta]] (v1^2+v3^2), Sin[\[Theta]] v1+(1-Cos[\[Theta]]) v2 v3}, {Sin[\[Theta]] v2+(1-Cos[\[Theta]]) v1 v3, -Sin[\[Theta]] v1+(1-Cos[\[Theta]]) v2 v3, Cos[\[Theta]] (v1^2+v2^2)+v3^2}}]]; Vector3D[loc:{x_,y_,z_}, vec:{dx_,dy_,dz_}, headscalefn_, dirs___]:= Module[{tip=loc+vec, perp=cross3[vec,{0.,0.,1.}], perplen, veclen, headedge, rot, theHead, headsc}, headsc = HeadScaleFactors/. Options[Vector3D]; If[Not[MatchQ[headsc,{_?NumericQ,_?NumericQ}]],headsc={1,1}]; perplen=Norm[perp]; veclen=Norm[vec]; If[perplen/veclen>10^-8, rot=rotmat[Sequence@@(vec/veclen)], perp=cross3[vec,{0.,1.,0.}]; perplen=Norm[perp]; rot={{Sqrt[3]/2.,-0.5,0.},{0.5,Sqrt[3]/2.,0.},{0.,0.,1.}}]; perp = .05 First[headsc] headscalefn[veclen] perp/perplen; headedge=(loc+#&)/@ NestList[rot.#1&, vec (1 - .16 Last[headsc]headscalefn[veclen]/veclen ) + perp, 12]; theHead={EdgeForm[{Thickness[.001], Opacity[.5]}], FaceForm[{Opacity[.75]}], Polygon/@Transpose[{Drop[headedge,-1], Table[tip,{12}], Drop[headedge,1]}]}; {{Thickness[Medium], dirs, Line[{loc, loc + vec (1- .15 Last[headsc] headscalefn[veclen] /veclen)}]}, theHead, {EdgeForm[{Thin, Opacity[.5]}], FaceForm[Opacity[.8]], Polygon[headedge]} } ]; Vector3D[vec:{dx_,dy_,dz_}, headscalefn_/;Head[headscalefn]=!=List, dirs___]:= Vector3D[{0,0,0}, vec, headscalefn, dirs]; Vector3D[point:{x_,y_,z_}, vec:{dx_,dy_,dz_}/;vec=={0,0,0}, ___]:= Point[{x,y,z}]; End[]; Protect[Vector3D]; EndPackage[] ; Vector[{ip:{_,_,_},vec:{_,_,_}},dirs___]:= Graphics3D[ Vector3D[ip, vec, #^(.45+.4#^(1/2)/(#^(1/2)+1))&, dirs] ]; Vector[posvec:{_,_,_}, dirs___]:= Vector[{{0,0,0},posvec},dirs]; Vector[{ip:{_,_},vec:{_,_}}, styles___]:= Graphics[{Arrowheads[Medium], Thickness[Medium], styles, Arrow[{ip,ip+vec}]}]; Vector[posvec:{_,_}, styles___]:= Vector[{{0,0}, posvec},styles]; ijk:= Map[Vector[#1, Darker[Blue]]&, IdentityMatrix[3]];