

(*   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.
*)



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}.  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]<n,y=Join[y,x]];
			Take[y,n]
	    ]

LongTake[ x_, n_Integer?Positive ] := Table[ x,{n} ]

(*
                --------------------------------------------------------
                 Use complex roots of unity to create a regular polygon.
                 Allow it to be dilated, translated, rotated about its
                 center, or twisted.
                --------------------------------------------------------
*)

RegularPolygon[n_Integer?((#>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.
                --------------------------------------------------------
*)

MakeSymbol[ Line[x_] ] := Block[ {blort,y},
					y = Line[Map[ Scaled[#,blort]&, x ]];
					y = y /. blort-> #;
					Function[Evaluate[y]]
				]

(*
                --------------------------------------------------------
                 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]

*)
