home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GRAPHICS.PAK / MULTIPLE.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  9.3 KB  |  293 lines
  1.  
  2.  
  3. (*   Copyright 1989 Wolfram Research Inc. *)
  4.  
  5. (*:Version: Mathematica 2.0 *)
  6.  
  7. (*:Name: Graphics`MultipleListPlot` *)
  8.  
  9. (*:Title: 2-D Plots of Multiple Lists of Data   *)
  10.  
  11. (*:Author:
  12.     Cameron Smith
  13. *)
  14.  
  15. (*:Keywords:
  16.     ListPlot, Multiple, symbol
  17. *)
  18.  
  19. (*:Requirements: none. *)
  20.  
  21. (*:Sources:
  22. *)
  23.  
  24. (*:Summary: This package allows you to make list plots of several
  25. different lists using different symbols or line styles
  26. for points from each list.
  27. *)
  28.  
  29.  
  30.  
  31. BeginPackage["Graphics`MultipleListPlot`"]
  32.  
  33. RegularPolygon::usage=
  34. "RegularPolygon[n,rad,ctr,tilt,skip] creates a regular polygon of n sides
  35. and radius rad, centered at the point ctr (represented as a list of
  36. two real numbers), tilted counterclockwise from vertical by angle
  37. theta, and with every skip-th vertex connected.  Defaults are
  38. rad=1, ctr={0,0}, tilt=0, skip=1."
  39.  
  40. LongTake::usage=
  41. "LongTake[ list, n ] does the same thing as Take[ list, n ] if n is
  42. <= the length of the list; otherwise the elements of the list
  43. are repeated in order to make a long enough list.  If the first
  44. argument is not a list, LongTake returns a list of n copies of
  45. the first argument.  LongTake[anything,0] returns {}.
  46. Exception: LongTake[{},n] returns {} and an error message if n>0."
  47.  
  48. MakeSymbol::usage=
  49. "MakeSymbol[ Line[ { {x1,y1}, {x2,y2}, ... } ] ] returns a pure function
  50. which, if applied to {a,b}, returns the a copy of the original line
  51. translated by {a,b}.  This is useful for converting shapes into
  52. plotting symbols for use by the DotShapes option of MultipleListPlot."
  53.  
  54. MultipleListPlot::usage=
  55. "MultipleListPlot[ l1, l2, ... ] allows many lists of data to be plotted
  56. on the same graph.  Each list can be either a list of pairs of
  57. numbers, in which case the pairs are taken as x,y-coordinates,
  58. or else a list of numbers, in which case the numbers are taken
  59. as y-coordinates and successive integers starting with 1 are
  60. supplied as x-coordinates.  The DotShapes option specifies plotting
  61. symbols to be used for the lists of data, and (if the option
  62. PlotJoined->True is specified) the option LineStyles specifies
  63. styles for the lines connecting the points."
  64.  
  65. DotShapes::usage=
  66. "DotShapes is an option for MultipleListPlot that specifies the shapes
  67. to be drawn around points in successive lists of data.  A setting
  68. for DotShapes should have the form {symbol, symbol, ...}, where
  69. the symbols are those generated by MakeSymbol.  If more lists of
  70. data are plotted than the number of dot shape symbols specified,
  71. symbols are re-used in order.  By default DotShapes is vectored
  72. through $DotShapes."
  73.  
  74. $DotShapes::usage=
  75. "$DotShapes is the list of plotting point shapes that MultipleListPlot
  76. uses as the default setting of the DotShapes option."
  77.  
  78. LineStyles::usage=
  79. "LineStyles is an option for MultipleListPlot that specifies the styles
  80. of the lines joining points in successive lists of data (and so it
  81. is meaningful only if PlotJoined->True is specified).  A setting for
  82. LineStyles should have the form { {spec,spec,...}, ...}, i.e., a list
  83. of lists of style specifications such as RGBColor, GrayLevel,
  84. Thickness, and Dashing.  If more lists of data are plotted than the
  85. number of line styles specified, styles are re-used in order.
  86. By default LineStyles is vectored through $LineStyles."
  87.  
  88. $LineStyles::usage=
  89. "$LineStyles is the list of line styles that MultipleListPlot uses as
  90. the default setting of the LineStyles option."
  91.  
  92. (*
  93.    ========================================================================
  94. *)
  95.                         Begin["`Private`"]
  96. (*
  97.    ========================================================================
  98. *)
  99.  
  100. (*
  101.                 --------------------------------------------------------
  102.                  Extend the Take operator for lists to repeat elements
  103.                  as necessary to complete the operation.
  104.                 --------------------------------------------------------
  105. *)
  106.  
  107. LongTake[ x_, 0 ] = {}
  108.  
  109. LongTake[{},n_Integer?Positive] := (Message[LongTake::emptylist];{})
  110.  
  111. LongTake::emptylist =
  112. "Cannot take positive-length sublist of empty list."
  113.  
  114. LongTake[x_List,n_Integer?Positive] := 
  115.     Block[ {l=Length[x],y=x},
  116.             While[Length[y]<n,y=Join[y,x]];
  117.             Take[y,n]
  118.         ]
  119.  
  120. LongTake[ x_, n_Integer?Positive ] := Table[ x,{n} ]
  121.  
  122. (*
  123.                 --------------------------------------------------------
  124.                  Use complex roots of unity to create a regular polygon.
  125.                  Allow it to be dilated, translated, rotated about its
  126.                  center, or twisted.
  127.                 --------------------------------------------------------
  128. *)
  129.  
  130. RegularPolygon[n_Integer?((#>1)&), rad_:1, ctr_:{0,0}, tilt_:0, skip_:1] :=
  131.      Line[
  132.            Block[
  133.                   { w = 2Pi/n,
  134.                     w1 = I N[ rad (Cos[tilt] + I Sin[tilt]) ],
  135.                     y = {}
  136.                   },
  137.                   w = N[ Cos[w] + I Sin[w] ]^skip;
  138.                   Do[
  139.                       y = Append[ y, ctr + {Re[w1],Im[w1]} ];
  140.                       w1 = w1 w,
  141.                       {n}
  142.                     ];
  143.                   Append[ y, y[[1]] ]
  144.                 ]
  145.          ]
  146.  
  147. (*
  148.                 --------------------------------------------------------
  149.                  Convert a figure specified by a line into a function
  150.                  that translates the figure to a given point.
  151.                 --------------------------------------------------------
  152. *)
  153.  
  154. MakeSymbol[ Line[x_] ] := Block[ {blort,y},
  155.                     y = Line[Map[ Scaled[#,blort]&, x ]];
  156.                     y = y /. blort-> #;
  157.                     Function[Evaluate[y]]
  158.                 ]
  159.  
  160. (*
  161.                 --------------------------------------------------------
  162.                  Some patterns and predicates to help check arguments.
  163.                 --------------------------------------------------------
  164. *)
  165.  
  166. numtest = NumberQ[N[#]]&
  167.             (* numtest is what NumberQ perhaps OUGHT to be *)
  168.  
  169. numtestpat = _?numtest
  170.  
  171. numlistpat = { numtestpat.. }
  172.  
  173. numpairspat = { { numtestpat, numtestpat }.. }
  174.  
  175. listdataQ = Or[ MatchQ[#,numlistpat], MatchQ[#, numpairspat] ]&
  176.  
  177. ruleQ = SameQ[Head[#],Rule]&
  178.  
  179. (*
  180.                 ---------------------------------------------------
  181.                  A helper function to convert arguments.
  182.                 ---------------------------------------------------
  183. *)
  184.  
  185. h[x_] := If[ MatchQ[x,numlistpat], Transpose[ {Range[Length[x]],x} ], x ]
  186.  
  187. (*
  188.                 ---------------------------------------------------
  189.                  Default settings of options.
  190.                 ---------------------------------------------------
  191. *)
  192.  
  193. $DotShapes = {    MakeSymbol[RegularPolygon[4,0.01]],
  194.         MakeSymbol[RegularPolygon[3,0.01]],
  195.         MakeSymbol[RegularPolygon[5,0.01,{0,0},0,2]]
  196.     }
  197.  
  198. $LineStyles = { {}, {Dashing[{0.02,0.01}]}, {Thickness[0.02],GrayLevel[0.5]} }
  199.  
  200. Options[MultipleListPlot] = {    DotShapes :> $DotShapes,
  201.                 LineStyles :> $LineStyles,
  202.                 PlotJoined -> False }
  203.  
  204. (*
  205.                 ---------------------------------------------------
  206.                  These save computing time.
  207.                 ---------------------------------------------------
  208. *)
  209.  
  210. MLPopts = Map[ First,  Options[MultipleListPlot] ]
  211.  
  212. Graphicsopts = Map[ First,  Options[Graphics] ]
  213.  
  214. (*
  215.                 --------------------------------------------------------
  216.                  MultipleListPlot itself simply filters out bad
  217.                  arguments and then hands off to FilteredMultipleListPlot.
  218.                 --------------------------------------------------------
  219. *)
  220.  
  221. MultipleListPlot[ x___ ] := Block[ {y,z,w={x}},
  222.         y=Select[ w, listdataQ  ];
  223.         z=Select[ w, ruleQ ];
  224.     FilteredMultipleListPlot[ Map[h,y],
  225.                   Select[ z, MemberQ[MLPopts,First[#]]& ],
  226.                   Select[ z, MemberQ[Graphicsopts,First[#]]& ]
  227.                 ]
  228. ]
  229.  
  230. (*
  231.                 --------------------------------------------------------
  232.                  FilteredMultipleListPlot handles option settings,
  233.                  and calls FMLP2 once for each data list to be plotted.
  234.                 --------------------------------------------------------
  235. *)
  236.  
  237. FilteredMultipleListPlot[lists_,opts_,gropts_] :=
  238.     Block[
  239.         {
  240.            ds = DotShapes /. opts /. Options[MultipleListPlot],
  241.            ls = LineStyles /. opts /. Options[MultipleListPlot],
  242.            pj = PlotJoined /. opts /. Options[MultipleListPlot]
  243.         },
  244.         ds = LongTake[ ds, Length[lists] ];
  245.         ls = LongTake[ ls, Length[lists] ];
  246.         Show[
  247.             Graphics[
  248.                    Map[
  249.                       FMLP2[ Apply[Sequence,#], pj ]&, 
  250.                       Transpose[{lists,ds,ls}]
  251.                       ],
  252.                    Axes->Automatic
  253.                 ],
  254.              Apply[Sequence,gropts]
  255.             ]
  256.          ]
  257.  
  258. (*
  259.         ---------------------------------------------------------------
  260.         FMLP2 plots a single list, with a single symbol and line style.
  261.         ---------------------------------------------------------------
  262. *)
  263.  
  264. FMLP2[ pts_, symbol_, ls_, pj_ ] := Block[ {z},
  265.         z=Join[Map[symbol,pts],Map[Point,pts]];
  266.         If[pj,{z,Sequence@@ls,Line[pts]},z,z]
  267.     ]
  268.  
  269. End[]   (* Graphics`MultipleListPlot`Private` *)
  270.  
  271. Protect[ MultipleListPlot, RegularPolygon, LongTake, MakeSymbol ]
  272.  
  273. EndPackage[]   (* Graphics`MultipleListPlot` *)
  274.  
  275.  
  276. (*:Limitations:
  277.  
  278. *)
  279.  
  280.  
  281. (*:Examples:
  282.  
  283. Show[ Graphics[ RegularPolygon[ 5,2,{1,1},1.5,2] ] ]
  284.  
  285. ln = MakeSymbol[ Line[ Table[{i,i^2},{i,0,1,0.1}] ] ];
  286. Show[ Graphics[ ln[{0.5,0.5}] ] ]
  287.  
  288. ls1 = Table[Cos[t],{t,10}];
  289. ls2 = Table[ {i/2,Sin[i]},{i,10}];
  290. MultipleListPlot[ls1,ls2]
  291.  
  292. *)
  293.