(* Copyright 1989 Wolfram Research Inc. *) (*:Version: Mathematica 2.0 *) (*:Name: Graphics`MultipleListPlot` *) (*:Title: 2-D Plots of Multiple Lists of Data *) (*:Author: Cameron Smith *) (*:Keywords: ListPlot, Multiple, symbol *) (*:Requirements: none. *) (*:Sources: *) (*:Summary: This package allows you to make list plots of several different lists using different symbols or line styles for points from each list. *) (* :History: The MakeSymbol function was modified by Riccardo Rigon, August 1992 for the use with the symbols.m package to allow new shapes for dots. *) (* :Notes: In the opinion of Riccardo Rigon the features of MultipleListPlot should be implemented directly in the ListPlot built in Mathematica command togheter with a way to manage error bars (on x and y ) and some type of legend. *) BeginPackage["Graphics`MultipleListPlot`"] RegularPolygon::usage= "RegularPolygon[n,rad,ctr,tilt,skip] creates a regular polygon of n sides and radius rad, centered at the point ctr (represented as a list of two real numbers), tilted counterclockwise from vertical by angle theta, and with every skip-th vertex connected. Defaults are rad=1, ctr={0,0}, tilt=0, skip=1." LongTake::usage= "LongTake[ list, n ] does the same thing as Take[ list, n ] if n is <= the length of the list; otherwise the elements of the list are repeated in order to make a long enough list. If the first argument is not a list, LongTake returns a list of n copies of the first argument. LongTake[anything,0] returns {}. Exception: LongTake[{},n] returns {} and an error message if n>0." MakeSymbol::usage= "MakeSymbol[ Line[ { {x1,y1}, {x2,y2}, ... } ] ] returns a pure function which, if applied to {a,b}, returns the a copy of the original line translated by {a,b}. MakeSymbols works also on other graphics objects than line as Circle[..], Disk[ ], Polygon[ ] and list of graphics object like {Circle[...],Line[...]}. This is useful for converting shapes into plotting symbols for use by the DotShapes option of MultipleListPlot." MultipleListPlot::usage= "MultipleListPlot[ l1, l2, ... ] allows many lists of data to be plotted on the same graph. Each list can be either a list of pairs of numbers, in which case the pairs are taken as x,y-coordinates, or else a list of numbers, in which case the numbers are taken as y-coordinates and successive integers starting with 1 are supplied as x-coordinates. The DotShapes option specifies plotting symbols to be used for the lists of data, and (if the option PlotJoined->True is specified) the option LineStyles specifies styles for the lines connecting the points." DotShapes::usage= "DotShapes is an option for MultipleListPlot that specifies the shapes to be drawn around points in successive lists of data. A setting for DotShapes should have the form {symbol, symbol, ...}, where the symbols are those generated by MakeSymbol. If more lists of data are plotted than the number of dot shape symbols specified, symbols are re-used in order. By default DotShapes is vectored through $DotShapes." $DotShapes::usage= "$DotShapes is the list of plotting point shapes that MultipleListPlot uses as the default setting of the DotShapes option." LineStyles::usage= "LineStyles is an option for MultipleListPlot that specifies the styles of the lines joining points in successive lists of data (and so it is meaningful only if PlotJoined->True is specified). A setting for LineStyles should have the form { {spec,spec,...}, ...}, i.e., a list of lists of style specifications such as RGBColor, GrayLevel, Thickness, and Dashing. If more lists of data are plotted than the number of line styles specified, styles are re-used in order. By default LineStyles is vectored through $LineStyles." $LineStyles::usage= "$LineStyles is the list of line styles that MultipleListPlot uses as the default setting of the LineStyles option." (* ======================================================================== *) Begin["`Private`"] (* ======================================================================== *) (* -------------------------------------------------------- Extend the Take operator for lists to repeat elements as necessary to complete the operation. -------------------------------------------------------- *) LongTake[ x_, 0 ] = {} LongTake[{},n_Integer?Positive] := (Message[LongTake::emptylist];{}) LongTake::emptylist = "Cannot take positive-length sublist of empty list." LongTake[x_List,n_Integer?Positive] := Block[ {l=Length[x],y=x}, While[Length[y]1)&), rad_:1, ctr_:{0,0}, tilt_:0, skip_:1] := Line[ Block[ { w = 2Pi/n, w1 = I N[ rad (Cos[tilt] + I Sin[tilt]) ], y = {} }, w = N[ Cos[w] + I Sin[w] ]^skip; Do[ y = Append[ y, ctr + {Re[w1],Im[w1]} ]; w1 = w1 w, {n} ]; Append[ y, y[[1]] ] ] ] (* -------------------------------------------------------- Convert a figure specified by a line into a function that translates the figure to a given point. -------------------------------------------------------- *) symbol[ Line[x_] ] := Block[ {blort,y}, y = Line[Map[ Scaled[#,blort]&, x ]]; y = y /. blort-> #; y ] symbol[ Polygon[x_] ] := Block[ {blort,y}, y = Polygon[Map[ Scaled[#,blort]&, x ]]; y = y /. blort-> #; y ] symbol[Circle[a_,b_]]:=Circle[#1,Scaled[{b,b}]]; symbol[Disk[a_,b_]]:=Disk[#1,Scaled[{b,b}]]; MakeSymbol[ Line[x_] ] := Block[ {blort,y}, y = Line[Map[ Scaled[#,blort]&, x ]]; y = y /. blort-> #; Function[Evaluate[y]] ] MakeSymbol[ Polygon[x_] ] := Block[ {blort,y}, y = Polygon[Map[ Scaled[#,blort]&, x ]]; y = y /. blort-> #; Function[Evaluate[y]] ] MakeSymbol[Circle[a_,b_]]:=Circle[#1,Scaled[{b,b}]]&; MakeSymbol[Disk[a_,b_]]:=Disk[#1,Scaled[{b,b}]]&; MakeSymbol[x_List]:=Function[ Evaluate[ symbol[#]& /@ x]]; (* -------------------------------------------------------- Some patterns and predicates to help check arguments. -------------------------------------------------------- *) numtest = NumberQ[N[#]]& (* numtest is what NumberQ perhaps OUGHT to be *) numtestpat = _?numtest numlistpat = { numtestpat.. } numpairspat = { { numtestpat, numtestpat }.. } listdataQ = Or[ MatchQ[#,numlistpat], MatchQ[#, numpairspat] ]& ruleQ = SameQ[Head[#],Rule]& (* --------------------------------------------------- A helper function to convert arguments. --------------------------------------------------- *) h[x_] := If[ MatchQ[x,numlistpat], Transpose[ {Range[Length[x]],x} ], x ] (* --------------------------------------------------- Default settings of options. --------------------------------------------------- *) $DotShapes = { MakeSymbol[RegularPolygon[4,0.01]], MakeSymbol[RegularPolygon[3,0.01]], MakeSymbol[RegularPolygon[5,0.01,{0,0},0,2]] } $LineStyles = { {}, {Dashing[{0.02,0.01}]}, {Thickness[0.02],GrayLevel[0.5]} } Options[MultipleListPlot] = { DotShapes :> $DotShapes, LineStyles :> $LineStyles, PlotJoined -> False } (* --------------------------------------------------- These save computing time. --------------------------------------------------- *) MLPopts = Map[ First, Options[MultipleListPlot] ] Graphicsopts = Map[ First, Options[Graphics] ] (* -------------------------------------------------------- MultipleListPlot itself simply filters out bad arguments and then hands off to FilteredMultipleListPlot. -------------------------------------------------------- *) MultipleListPlot[ x___ ] := Block[ {y,z,w={x}}, y=Select[ w, listdataQ ]; z=Select[ w, ruleQ ]; FilteredMultipleListPlot[ Map[h,y], Select[ z, MemberQ[MLPopts,First[#]]& ], Select[ z, MemberQ[Graphicsopts,First[#]]& ] ] ] (* -------------------------------------------------------- FilteredMultipleListPlot handles option settings, and calls FMLP2 once for each data list to be plotted. -------------------------------------------------------- *) FilteredMultipleListPlot[lists_,opts_,gropts_] := Block[ { ds = DotShapes /. opts /. Options[MultipleListPlot], ls = LineStyles /. opts /. Options[MultipleListPlot], pj = PlotJoined /. opts /. Options[MultipleListPlot] }, ds = LongTake[ ds, Length[lists] ]; ls = LongTake[ ls, Length[lists] ]; Show[ Graphics[ Map[ FMLP2[ Apply[Sequence,#], pj ]&, Transpose[{lists,ds,ls}] ], Axes->Automatic ], Apply[Sequence,gropts] ] ] (* ------ FMLP2 plots a single list, with a single symbol and line style. --------------------------------------------------------------- *) FMLP2[ pts_, symbol_, ls_, pj_ ] := Block[ {z}, z=Join[Map[symbol,pts],Map[Point,pts]]; If[pj,{z,Sequence@@ls,Line[pts]},z,z] ] End[] (* Graphics`MultipleListPlot`Private` *) Protect[ MultipleListPlot, RegularPolygon, LongTake, MakeSymbol ] EndPackage[] (* Graphics`MultipleListPlot` *) (*:Limitations: *) (*:Examples: Show[ Graphics[ RegularPolygon[ 5,2,{1,1},1.5,2] ] ] ln = MakeSymbol[ Line[ Table[{i,i^2},{i,0,1,0.1}] ] ]; Show[ Graphics[ ln[{0.5,0.5}] ] ] ls1 = Table[Cos[t],{t,10}]; ls2 = Table[ {i/2,Sin[i]},{i,10}]; MultipleListPlot[ls1,ls2] *)