home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GRAPHICS.PAK / COMPLEXM.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  5.4 KB  |  176 lines
  1.  
  2. (*********************************************************************
  3.  
  4.     Copyright 1991 by Roman E. Maeder
  5.     
  6.     Adapted from
  7.     Roman E. Maeder: Programming in Mathematica,
  8.     Second Edition, Addison-Wesley, 1991.
  9.  
  10.     Permission is hereby granted to make copies of this file for
  11.     any purpose other than direct profit, or as part of a
  12.     commercial product, provided this copyright notice is left
  13.     intact.  Sale, other than for the cost of media, is prohibited.
  14.     
  15.     Permission is hereby granted to reproduce part or all of
  16.     this file, provided that the source is acknowledged.
  17.  
  18.  *********************************************************************)
  19.  
  20.     (* Enclosed with Mathematica by permission *)
  21.  
  22.  
  23. (*:Version: Mathematica 2.0 *)
  24.  
  25. (*:Name: Graphics`ComplexMap.m` *)
  26.  
  27. (*:Title: CartesianMap and PolarMap *)
  28.  
  29. (*:Author:
  30.     Roman E. Maeder
  31. *)
  32.  
  33. (*:Keywords:
  34.     Cartesian coordinates, polar coordinates, lines, mapping
  35. *)
  36.  
  37. (*:Requirements: none. *)
  38.  
  39. (*:Warnings: none. *)
  40.  
  41. (*:Sources:
  42.     Roman E. Maeder: Programming in Mathematica,
  43.     Second Edition, Addison-Wesley, 1991.
  44. *)
  45.  
  46. (*:Summary:
  47. This package plots the images of Cartesian coordinate lines and
  48. polar coordinate lines under a user-supplied function f.
  49. *)
  50.  
  51. BeginPackage["Graphics`ComplexMap`"]
  52.  
  53. CartesianMap::usage = "CartesianMap[f, {x0, x1, (dx)}, {y0, y1,
  54. (dy)}, options...] plots the image of the Cartesian coordinate
  55. lines under the function f.  The default values of dx and dy are
  56. chosen so that the number of lines is equal to the value of the
  57. option PlotPoints of Plot3D[]."
  58.  
  59. PolarMap::usage = "PolarMap[f, {r0:0, r1, (dr)}, {phi0, phi1,
  60. (dphi)}, options...] plots the image of the polar coordinate lines
  61. under the function f.  The default values of dr and dphi are chosen
  62. so that the number of lines is equal to the value of the option
  63. PlotPoints of Plot3D[].  The default for the phi range is {0, 2Pi}."
  64.  
  65. Begin["`Private`"]
  66.  
  67. huge = 10.0^6
  68.  
  69. SplitLine[vl_] :=
  70.     Module[{vll, pos, linelist = {}, low, high},
  71.         vll = If[NumberQ[#], #, Indeterminate]& /@ vl;
  72.         pos = Flatten[ Position[vll, Indeterminate] ];
  73.         pos = Union[ pos, {0, Length[vll]+1} ];
  74.         Do[ low = pos[[i]]+1;
  75.             high = pos[[i+1]]-1;
  76.             If[ low < high, AppendTo[linelist, Take[vll, {low, high}]] ],
  77.            {i, 1, Length[pos]-1}];
  78.         linelist
  79.     ]
  80.  
  81. MakeLines[points_] :=
  82.     Module[{lines, newpoints},
  83.         newpoints = points /.
  84.             { z_?NumberQ :> huge z/Abs[z] /; Abs[z] > huge,
  85.               z_?NumberQ :> 0.0 /; Abs[z] < 1/huge,
  86.               DirectedInfinity[z_] :> huge z/Abs[z] };
  87.         lines = Join[ newpoints, Transpose[newpoints] ];
  88.         lines = Flatten[ SplitLine /@ lines, 1 ];
  89.         lines = Map[ {Re[#], Im[#]}&, lines, {2} ];
  90.         lines = Map[ Line, lines ];
  91.         Graphics[lines]
  92.     ]
  93.  
  94. FilterOptions[ command_Symbol, opts___ ] :=
  95.     Module[{keywords = First /@ Options[command]},
  96.         Sequence @@ Select[ {opts}, MemberQ[keywords, First[#]]& ]
  97.     ]
  98.  
  99. CartesianMap[ f_, {x0_, x1_, dx_:Automatic}, {y0_, y1_, dy_:Automatic}, opts___ ] :=
  100.     Module[ {x, y, points, plotpoints, ndx=N[dx], ndy=N[dy]},
  101.         plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
  102.         If[ dx === Automatic, ndx = N[(x1-x0)/(plotpoints-1)] ];
  103.         If[ dy === Automatic, ndy = N[(y1-y0)/(plotpoints-1)] ];
  104.         points = Table[ N[f[x + I y]],
  105.             {x, x0, x1, ndx}, {y, y0, y1, ndy} ];
  106.         Show[ MakeLines[points], FilterOptions[Graphics, opts],
  107.             AspectRatio->Automatic, Axes->Automatic ]
  108.     ] /; NumberQ[N[x0]] && NumberQ[N[x1]] && NumberQ[N[y0]] && NumberQ[N[y1]]
  109.          (NumberQ[N[dx]] || dx === Automatic) &&
  110.          (NumberQ[N[dy]] || dy === Automatic)
  111.  
  112. PolarMap[ f_, {r0_:0, r1_, dr_:Automatic}, {phi0_, phi1_, dphi_:Automatic}, opts___ ] :=
  113.     Module[ {r, phi, points, plotpoints, ndr=dr, ndphi=dphi},
  114.         plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
  115.         If[ dr === Automatic, ndr = N[(r1-r0)/(plotpoints-1)] ];
  116.         If[ dphi === Automatic, ndphi = N[(phi1-phi0)/(plotpoints-1)] ];
  117.         points = Table[ N[f[r Exp[I phi]]],
  118.             {r, r0, r1, ndr}, {phi, phi0, phi1, ndphi} ];
  119.         Show[ MakeLines[points], FilterOptions[Graphics, opts],
  120.             AspectRatio->Automatic, Axes->Automatic ]
  121.     ] /; NumberQ[N[r0]] && NumberQ[N[r1]] && NumberQ[N[phi0]] && NumberQ[N[phi1]]
  122.          (NumberQ[N[dr]] || dr === Automatic) &&
  123.          (NumberQ[N[dphi]] || dphi === Automatic)
  124.  
  125. PolarMap[ f_, rRange_List, opts___Rule ] :=
  126.     PolarMap[ f, rRange, {0, 2Pi}, opts ]
  127.  
  128. End[ ]   (* Graphics`ComplexMap`Private` *)
  129.  
  130. Protect[CartesianMap, PolarMap]
  131.  
  132. EndPackage[ ]   (* Graphics`ComplexMap` *)
  133.  
  134. (*:Limitations: none known. *)
  135.  
  136. (*:Tests:
  137.  
  138. *)
  139.  
  140. (*:Examples:
  141.  
  142. CartesianMap[ Cos,{0.2, Pi-0.2 },{-2,2}]
  143.  
  144. CartesianMap[ Cos, {0.2, Pi-0.2, (Pi-0.4)/19}, {-2,2,4/16}]
  145.  
  146. CartesianMap[ Exp, {-1,1,0.2},{-2,2,0.2}]
  147.  
  148. PolarMap[ Log, {0.1,10,0.5},{-3,3,0.15}]
  149.  
  150. PolarMap[ 1/Conjugate[#]&, {0.1,5.1,0.5},{-Pi,Pi,Pi/12}]
  151.  
  152. CartesianMap[ Zeta,{0.1,0.9},{0,20}]
  153.  
  154. SetOptions[ Plot3D, PlotPoints->25]; CartesianMap[ Zeta,{0.1,0.9},{0,20}]
  155.  
  156. PolarMap[ Sqrt,{1},{-Pi-0.0001,Pi}]
  157.  
  158. PolarMap[ Sqrt,{1},{-Pi+0.0001,Pi}]
  159.  
  160. PolarMap[ Identity,{1,2},{-Pi,Pi,Pi/12}]
  161.  
  162. PolarMap[ Identity,{1,2},{-Pi,Pi,Pi/12},
  163.           AspectRatio -> 0.5, Axes -> None, Framed -> True ]
  164.  
  165. CartesianMap[ 1/Conjugate[#]&, {-2,2,4/19},{-2,2,4/19},PlotRange->All]
  166.  
  167. f[z_] := Indeterminate /; Abs[z] < 10.^-3
  168. f[z_] := 10^100 /; Abs[z-2] < 10.^-3
  169. f[z_] := DirectedInfinity[-2-I] /; Abs[z-(-2+I)] < 10.^-3
  170. f[z_] := DirectedInfinity[] /; Abs[z-(2-2I)] < 10.^-3
  171. f[z_] := z
  172. CartesianMap[f,{-2,2,1/3},{-2,2,1/3},Axes->None]
  173. CartesianMap[1/Conjugate[#]&,{-2,2,0.2},{-2,2,0.2}]
  174.  
  175. *)
  176.