(* :Title: Unitary Normal Vectorial Field *) (* :Author: Robert Ipanaque Chero Peruvian Applied & Computational Mathematical Society (Member), PERU E-mail: robertchero@hotmail.com *) (* :Summary: This package incorporates some commands that allow to calculate certain elements of differential geometry. *) (* :Context: DifferentialGeometry` UnitaryNormalVectorialField` *) (* :Copyright: © 2003, Robert Ipanaque *) (* :Package Version: 1.0 *) (* :History: V1.0 by Robert Ipanaque Chero, january 2003. *) (* :Keywords: unitary, norm, Vector3D, UNVF *) (* :Mathematica Version: 4.0 *) (* :Limitations: not known *) (* :Sources: Barret O'Neill. Elementos de Geometria Diferencial. 1972. *) (* ================== Beginning of the package ================= *) BeginPackage[ "DifferentialGeometry`","Graphics`ContourPlot3D`","Utilities`FilterOptions`" ] (* ------------------- Incorporate commands ------------------- *) TangentVector3D::usage= "TangentVector3D[p, v, ] gnerate a vector 3d from coordinat 'p' to 'v'" UNVF::usage= "UNVF[f, {x, xmin, xmax}, {y, ymin, ymax}, {z, zmin, zmax}, ] plot a unitary normal vectorial field of 'f' as a implicit function of 'x', 'y' and 'z'." UNVF::usage= "UNVF2[f, {u, umin, umax}, {v, vmin, vmax}, ] plot a unitary normal vectorial field of 'f' as a parametric function of 'u' and 'v'." (* ------------------- Options definition------------------- *) Options[Vector3D] = {VectorHead -> Line, HeadLength -> 0.2, HeadWidth -> 0.06, n -> 4} Options[UNVF] = Join[{{VectorColor -> GrayLevel[0], Surface -> False, SurfaceDom -> {{0, 0}, {0, 0}, {0, 0}}, PlotPointsSurface -> {3, 5}, PlotPointsNormalField -> {3, 5}}, Options[ContourPlot3D], Options[TangentVector3D]}]; Options[UNVF2] = Join[{{VectorColor -> GrayLevel[0], Surface -> False, SurfaceDom -> {{0, 0}, {0, 0}}}, Options[ParametricPlot3D], Options[TangentVector3D]}]; (* ============= Beginning of the private context ============= *) Begin["`Private`"] norm[v_] := Sqrt[v.v] unit[v_] := v/norm[v] Vector3D[p : {_, _, _}, v : {_, _, _}, Ops___Rule] := Point[p] /; (v == {0, 0, 0} || v == N[{0, 0, 0}]) Vector3D[p1 : {_, _, _}, v1 : {_, _, _}, Ops___Rule] := Module[{p = N[p1], v = N[v1], vh, hw, hl, inc, ref, aux}, {vh, hw, hl, inc} = {VectorHead, HeadWidth, HeadLength, n} /. Flatten[{Ops}] /. Options[Vector3D]; If[inc < 2 || inc > 20, inc = 2]; pPlusv = Plus[p, v]; aux = Cross[v, {0, 0, 1}]; If[aux == {0, 0, 0}, aux = Cross[v, {0, 1, 0}]]; ref = {unit[Cross[v, aux]], unit[Cross[v, Cross[v, aux]]]}; pPlusCtv = Plus[pPlusv, -hl*unit[v]]; f = Function[t, pPlusCtv + hw*Cos[t]*ref[[1]] + hw*Sin[t]*ref[[2]]]; head1 = Table[f[i], {i, 0, 2*Pi, 2*Pi/inc}]; Which[ vh === Line, head2 = Insert[head1, pPlusv, Table[{i}, {i, Length[head1]}]]; {Line[{p, pPlusv}], Line[head1], Line /@ Partition[head2, 2]}, vh === Polygon, head2 = Insert[Flatten[Partition[head1, 2, 1], 1], pPlusv, Table[{2*i + 1}, {i, Length[head1] - 1}]]; {Line[{p, pPlusCtv}], Polygon[head1], Polygon /@ Partition[head2, 3]}, True, Line[{p, pPlusv}] ] ] UNVF[g_, {x_, xmin_, xmax_}, {y_, ymin_, ymax_}, {z_, zmin_, zmax_}, Ops___Rule] := Module[{L, pp, F, NN, sf, sd, pps, ppnf, op1 = FilterOptions[Graphics3D, Ops]}, {vc, sf, sd, pps, ppnf} = {VectorColor, Surface, SurfaceDom, PlotPointsSurface, PlotPointsNormalField} /. Flatten[{Ops}] /. Options[UNVF]; L = ContourPlot3D[g, {x, xmin, xmax}, {y, ymin, ymax}, {z, zmin, zmax}, PlotPoints -> ppnf, DisplayFunction -> Identity][[1]]; pp = Flatten[Apply[List, L, {1}], 2]; pp = N[Union[pp, pp]]; F[{xx_, yy_, zz_}] := (MapAll[PowerExpand, MapAll[PowerExpand, {D[g, x], D[g, y], D[g, z]} /. x -> (xx /. {0. -> 0})] /. y -> (yy /. {0. -> 0})] /. z -> (zz /. {0. -> 0})) // unit; NN = Table[Vector3D[pp[[i]], F[pp[[i]]], Ops], {i, Length[pp]}]; If[sd === {{0, 0}, {0, 0}, {0, 0}}, l = 1, l = 0]; Which[sf, surf = ContourPlot3D[ g, {x, l*xmin + sd[[1, 1]], l*xmax + sd[[1, 2]]}, {y, l*ymin + sd[[2, 1]], l*ymax + sd[[2, 2]]}, {z, l*zmin + sd[[3, 1]], l*zmax + sd[[3, 2]]}, PlotPoints -> pps, Ops, DisplayFunction -> Identity]; Show[surf, Graphics3D[{vc, NN}], DisplayFunction -> $DisplayFunction], True, Show[Graphics3D[{vc, NN}]]] ] UNVF2[x : {_, _, _}, {u_, u1_, u2_, paso1_:0.5}, {v_, v1_, v2_, paso2_:0.5}, Ops___Rule] := Module[{uu1, uu2, vv1, vv2, op1 = FilterOptions[Graphics3D, Ops], op2 = FilterOptions[ParametricPlot3D, Ops]}, {vc, sf, sd} = {VectorColor, Surface, SurfaceDom} /. Flatten[{Ops}] /. Options[UNVF2]; NN = Table[ Vector3D[x /. {u -> i, v -> j}, unit[Cross[D[x, u], D[x, v]]] /. {u -> i, v -> j}, Ops], {i, u1, u2, paso1}, {j, v1, v2, paso2} ]; If[sd === {{0, 0}, {0, 0}}, l = 1, l = 0]; Which[ sf, surf = ParametricPlot3D[x, {u, l*u1 + sd[[1, 1]], l*u2 + sd[[1, 2]]}, {v, l*v1 + sd[[2, 1]], l*v2 + sd[[2, 2]]}, Evaluate[op2], DisplayFunction -> Identity]; Show[ surf, Graphics3D[{vc, NN}], Evaluate[op1], DisplayFunction -> $DisplayFunction ], True, Show[ Graphics3D[{vc, NN}], Evaluate[op1] ] ] ] End[] (* ================= End of the private context ================ *) EndPackage[] (* ===================== End of the package ==================== *)