(*^ ::[paletteColors = 128; fontset = title, "New York", 24, L3, center, bold, nohscroll; fontset = subtitle, "New York", 18, L2, center, bold, nohscroll; fontset = subsubtitle, "New York", 14, L2, center, bold, nohscroll; fontset = section, "New York", 14, L2, bold, nohscroll, grayBox; fontset = subsection, "New York", 12, L2, bold, nohscroll, blackBox; fontset = subsubsection, "New York", 10, L2, bold, nohscroll, whiteBox; fontset = text, "New York", 12, L2, nohscroll; fontset = smalltext, "New York", 10, L2, nohscroll; fontset = input, "Courier", 12, L2, bold, nowordwrap; fontset = output, "Courier", 12, L2, nowordwrap; fontset = message, "Courier", 12, L2, R65535, nowordwrap; fontset = print, "Courier", 12, L2, nowordwrap; fontset = info, "Courier", 12, L2, nowordwrap; fontset = postscript, "Courier", 12, L2, nowordwrap; fontset = name, "Geneva", 10, L2, italic, B65535, nohscroll; fontset = header, "New York", 10, L2, nohscroll; fontset = footer, "New York", 12, L2, center, nohscroll; fontset = help, "Geneva", 10, L2, nohscroll; fontset = clipboard, "New York", 12, L2; fontset = completions, "New York", 12, L2; fontset = network, "Courier", 10, L2, nowordwrap; fontset = graphlabel, "Courier", 12, L2; fontset = special1, "New York", 12, L2; fontset = special2, "New York", 12, L2, center; fontset = special3, "New York", 12, L2, right; fontset = special4, "New York", 12, L2; fontset = special5, "New York", 12, L2;] :[font = title; inactive; startGroup; ] VectorFields by Theodore W. Gray ;[s] 3:0,0;13,1;32,0;33,-1; 3:2,29,21,New York,1,24,0,0,0;1,16,12,New York,2,12,0,0,0;0,16,12,New York,0,12,0,0,0; :[font = text; inactive; ] This Notebook contains definitions of functions which draw fields of vectors in two and three dimensions. It is a very preliminary Notebook, and not intended for general distribution. Most of the functions work fine, but they have not been tested extensively, and may contain bugs. For examples of how to use the VectorField functions, see the Notebooks "VectorField Examples". :[font = section; inactive; initialization; startGroup; ] Implementation :[font = text; inactive; initialization; startGroup; Cclosed; ] Remove any previous definitions for the functions defined in this file: :[font = input; initialization; endGroup; wordwrap; ] *) Remove[vectorLines]; Remove[VectorField]; Remove[VectorFieldAnalytic]; Remove[vectorLines3D]; Remove[VectorField3D]; Remove[VectorFieldAnalytic3D]; Remove[vectorLinesSurface]; Remove[VectorSurface]; Remove[VectorSurfaceAnalytic]; (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define the usage strings for each of the functions: :[font = input; initialization; wordwrap; ] *) VectorField::usage = "VectorField[{dfdx, dfdy}, {x, x0, x1, (xu)}, {y, y0, y1, (yu)}, (options)] produces a vector field plot of the function whose derivatives are given by dfdx and dfdy."; (* :[font = input; initialization; endGroup; wordwrap; ] *) VectorFieldAnalytic::usage = "VectorFieldAnalytic[f, {x, x0, x1, (xu)}, {y, y0, y1, (yu)}, (options)] produces a vector field plot of the function f by calculating its derivatives analytically."; (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Begin the private part of this package, and define a few utilities: :[font = input; initialization; wordwrap; ] *) Needs["Rotations`"] Needs["Colors`"] (* :[font = input; initialization; endGroup; wordwrap; ] *) plotpoints = PlotPoints /. Options[Plot3D]; rot45 = N[RotMatrix2[7Pi/8]]; rotm45 = N[RotMatrix2[-7Pi/8]]; cross3[{a1_, a2_, a3_}, {b1_, b2_, b3_}] := {-(a3 b2) + a2 b3, a3 b1 - a1 b3, -(a2 b1) + a1 b2} mag[a_] := Sqrt[Apply[Plus, a^2]] (* ;[s] 3:0,1;45,0;239,0;240,-1; 6:2,14,10,Courier,1,12,0,0,0;1,14,10,Courier,1,12,0,0,0;0,14,10,Courier,1,12,0,0,0;0,14,10,Courier,1,12,0,0,0;0,14,10,Courier,1,12,0,0,0;0,14,10,Courier,1,12,0,0,0; :[font = text; inactive; initialization; startGroup; Cclosed; ] Define vectorLines: :[font = input; initialization; endGroup; wordwrap; ] *) vectorLines[point:{x_, y_}, grad:{dx_, dy_}] := Block[{direction = N[grad/5], endPoint = point + grad}, {Line[{point, endPoint}], Line[{endPoint + rot45 . direction, endPoint, endPoint + rotm45 . direction}]} ] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define VectorField: :[font = input; initialization; endGroup; wordwrap; ] *) VectorField[{dfdx_, dfdy_}, {u_, u0_, u1_, du_:((u1-u0)/(plotpoints-1))}, {v_, v0_, v1_, dv_:((v1-v0)/(plotpoints-1))}, scaling_, options___] := Show[Graphics[Flatten[ Table[vectorLines[N[{u, v}], N[{dfdx, dfdy} scaling]], {u, u0, u1, du}, {v, v0, v1, dv}]] ], options] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define colorVectorLines: :[font = input; initialization; endGroup; wordwrap; ] *) colorVectorLines[point:{x_, y_}, grad:{dx_, dy_}, du_, dv_] := Block[{direction = N[grad/5], endPoint = point + grad}, {HSBColor[Mod[2 (Abs[dx/du] + Abs[dy/dv]), 1], 1, 1], Line[{point, endPoint}], Line[{endPoint + rot45 . direction, endPoint, endPoint + rotm45 . direction}]} ] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define ColorVectorField: :[font = input; initialization; endGroup; wordwrap; ] *) ColorVectorField[{dfdx_, dfdy_}, {u_, u0_, u1_, du_:((u1-u0)/(plotpoints-1))}, {v_, v0_, v1_, dv_:((v1-v0)/(plotpoints-1))}, scaling_, options___] := Show[Graphics[Flatten[ Table[colorVectorLines[N[{u, v}], N[{dfdx, dfdy} scaling], du, dv], {u, u0, u1, du}, {v, v0, v1, dv}]] ], options] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define VectorFieldAnalytic: :[font = input; initialization; endGroup; wordwrap; ] *) VectorFieldAnalytic[function_, {u_, u0_, u1_, du_:((u1-u0)/(plotpoints-1))}, {v_, v0_, v1_, dv_:((v1-v0)/(plotpoints-1))}, options___] := VectorField[{D[function, u], D[function, v]}, {u, u0, u1, du}, {v, v0, v1, dv}, options] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define vectorLines3D: :[font = input; initialization; wordwrap; ] *) vectorLines3D[point:{x_, y_, z_}, grad:{dx_, dy_, dz_}] := Line[{point, point + grad}] (* :[font = input; initialization; endGroup; wordwrap; ] *) vectorLines3Dh[point:{x_, y_, z_}, grad:{dx_, dy_, dz_}] := Block[{endpoint, perp, perpm, offsetPoint, arrowA, arrowB, arrowC, arrowD}, endpoint = point + grad; perp = cross3[grad, {0,0,1}]; perpm = mag[perp]; If[perpm == 0, perp = cross3[grad, {0,1,0}]; perpm = mag[perp], ]; perp = perp mag[grad]/(7 perpm); offsetPoint = point + 4/5 grad; arrowA = offsetPoint + perp; perp = cross3[grad, perp]; perp = perp mag[grad]/(7 mag[perp]); arrowB = offsetPoint + perp; perp = cross3[grad, perp]; perp = perp mag[grad]/(7 mag[perp]); arrowC = offsetPoint + perp; perp = cross3[grad, perp]; perp = perp mag[grad]/(7 mag[perp]); arrowD = offsetPoint + perp; {Line[{point, endpoint}], Line[{arrowA, endpoint, arrowC}], Line[{arrowB, endpoint, arrowD}], Line[{arrowA, arrowB, arrowC, arrowD, arrowA}]} ] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define VectorField3D: :[font = input; initialization; wordwrap; ] *) Options[VectorField3D] = {Heads->False}; (* :[font = input; initialization; endGroup; wordwrap; ] *) VectorField3D[{dfdx_, dfdy_, dfdz_}, {x_, x0_, x1_, dx_:((x1-x0)/(plotpoints-1))}, {y_, y0_, y1_, dy_:((y1-y0)/(plotpoints-1))}, {z_, z0_, z1_, dz_:((z1-z0)/(plotpoints-1))}, scaling_, options___] := Block[{heads = Heads /. {options} /. Options[VectorField3D]}, Show[Graphics3D[ If[TrueQ[heads], Table[vectorLines3Dh[N[{x, y, z}], N[{dfdx, dfdy, dfdz} scaling]], {x, x0, x1, dx}, {y, y0, y1, dy}, {z, z0, z1, dz}], Table[vectorLines3D[N[{x, y, z}], N[{dfdx, dfdy, dfdz} scaling]], {x, x0, x1, dx}, {y, y0, y1, dy}, {z, z0, z1, dz}] ] ](*, options*)] ] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define VectorFieldAnalytic3D: :[font = input; initialization; endGroup; wordwrap; ] *) VectorFieldAnalytic3D[function_, {x_, x0_, x1_, dx_:((x1-x0)/(plotpoints-1))}, {y_, y0_, y1_, dy_:((y1-y0)/(plotpoints-1))}, {z_, z0_, z1_, dz_:((z1-z0)/(plotpoints-1))}, options___] := VectorField3D[{D[function, x], D[function, y], D[function, z]}, {x, x0, x1, dx}, {y, y0, y1, dy}, {z, z0, z1, dz}, options] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define vectorLinesSurface: :[font = input; initialization; endGroup; wordwrap; ] *) vectorLinesSurface[point:{x_, y_, z_}, grad:{dx_, dy_, dz_}] := Line[{point, point + grad}] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define VectorSurface: :[font = input; initialization; endGroup; wordwrap; ] *) VectorSurface[{function_, dfdx_, dfdy_}, {x_, x0_, x1_, dx_:((x1-x0)/(plotpoints-1))}, {y_, y0_, y1_, dy_:((y1-y0)/(plotpoints-1))}, scaling_, options___] := Show[Graphics3D[ Table[vectorLinesSurface[{x, y, function}, {dx, dy, dx dfdx + dy dfdy} scaling], {x, x0, x1, dx}, {y, y0, y1, dy}] ], options] (* :[font = text; inactive; initialization; startGroup; Cclosed; ] Define VectorSurfaceAnalytic: :[font = input; initialization; endGroup; endGroup; endGroup; wordwrap; ] *) VectorSurfaceAnalytic[function_, {x_, x0_, x1_, dx_:((x1-x0)/(plotpoints-1))}, {y_, y0_, y1_, dy_:((y1-y0)/(plotpoints-1))}, scaling_, options___] := VectorSurface[{function, D[function, x], D[function, y]}, {x, x0, x1, dx}, {y, y0, y1, dy}, scaling, options] (* ^*)