(* ::Package:: *) (* :Title: Multiple List Plot *) (* :Context: Graphics`MultipleListPlot`*) (* :Author: John M. Novak, based on a package by Cameron Smith *) (* :Summary: This package contains a function for plotting multiple sets of data in a graph and related utilities. *) (* :Copyright: Copyright 1989-2007, Wolfram Research, Inc. *) (* :Package Version: 2.2 *) (* :Mathematica Version: 4.0 *) (* :History: V2.0 April 1993 by John M. Novak (unreleased) V2.1 March 1994 by John M. Novak. Adds many new features, such as error bars, labeled points, and legends. V2.2 September 2002 by John M. Novak. Add ZeroOffsets option. *) (* :Keywords: data plots, plot symbols *) (* :Sources: *) (* :Discussion: *) Message[General::obspkg, "Graphics`MultipleListPlot`"] Quiet[ BeginPackage["Graphics`MultipleListPlot`", {"Utilities`FilterOptions`", "Graphics`Legend`", "Graphics`Common`GraphicsCommon`"}] , {General::obspkg, General::newpkg}] MultipleListPlot::usage = "MultipleListPlot[data, (opts)] plots the data, using symbols \ determined by the options. MultipleListPlot[data1, data2,...] \ plots multiple sets of data. Data are either a list of numbers \ (whose x coordinates are implicitly the positions in the list), \ or a list of {x, y} coordinate pairs. Each data point can be accompanied \ by an error, indicated by an ErrorBar object giving the error \ as positive and negative offsets (see ErrorBar for more information). "; ZeroOffsets::usage = "ZeroOffsets is an option for MultipleListPlot that allows a \ coordinate offset to be applied to the points being plotted. This \ is particularly useful when plotting a data set against another data \ set that needs to be shifted by some amount. ZeroOffsets takes \ a list of numbers indicating a horizontal shift, or {x, y} pairs \ indicating a horizontal and vertical shift. The default is None, \ indicating no shift."; ErrorBarFunction::usage = "ErrorBarFunction is an option for MultipleListPlot that allows the \ user to specify the shape of an error bar. ErrorBarFunction -> Automatic \ generates default error bars. ErrorBarFunction may also be set to a function \ of two arguments, where the first is the point around which the error bars are \ drawn, and the second is an ErrorBar object indicating the x and y error. \ (See ErrorBar for more information)."; SymbolLabel::usage = "SymbolLabel is an option for MultipleListPlot, specifying a textual label \ for each dot in MultipleListPlot. SymbolLabel -> None implies that no \ label is drawn. If SymbolLabel -> Automatic, each point is labelled \ (n,m), where n is the data set and m is the point in the data set. \ Otherwise, the label is wrapped in a Text primitive and drawn at the point. \ A label can be specified for each point. Labels are cycled if not \ specified for every point."; SymbolShape::usage = "SymbolShape is an option for MultipleListPlot that specifies a list \ of functions that determine the shapes of the symbols representing \ each of the sets of data given to MultipleListPlot. Each function should \ accept one argument, the position of the symbol to be drawn. \ As a special case, SymbolShape -> None indicates that no symbol should be \ drawn, or SymbolShape -> Label indicates that the text label should be drawn \ instead of the symbol."; SymbolStyle::usage = "SymbolStyle is an option for MultipleListPlot. It is a list of \ styles for the symbols drawn for each data set. SymbolStyle -> Automatic \ specifies that each symbol will be black with thin lines."; Label::usage = "Label is a value for the SymbolShape option for MultipleListPlot. It \ specifies that a label given by the SymbolLabel option should be used \ in place of a dot shape."; ErrorBar::usage = "ErrorBar[{negerror, poserror}] is used in a data argument for \ MultipleListPlot to represent error in a data point. The syntax is \ generally {pt, ErrorBar[err]}. The error is expressed as a change in \ the value at the point. Error in both independent and dependent variable \ can be given, as in ErrorBar[xerr, yerr], where xerr and yerr each is \ expressed as {negerror, poserror}."; Stem::usage = "Stem[size] is a function that can be used with the SymbolShape option \ of MultipleListPlot. It represents the graphic element of a stem plot. \ It can be called without the size specifier, for a default size point \ at the end of the stem; otherwise size represents the size of the \ point. Stem[size][{x, y}] returns the graphics primitives for a stem \ at a particular point."; PlotSymbol::usage = "PlotSymbol[type] evaluates to a function that generates a graphic \ symbol of the particular type for use as a plot symbol in MultipleListPlot. \ Valid types include Star, Diamond, and Box. PlotSymbol[type, radius] \ resizes the shape to approximately the given radius. PlotSymbol can \ also take an option Filled -> False, which will only outline the \ symbol in question."; Filled::usage = "Filled is an option for PlotSymbol indicating whether the symbol should \ be drawn as a polygon (if True) or a line (if False)."; MakeSymbol::usage = "MakeSymbol[gprims] takes the shape expressed by the graphic \ primitives and turns it into a function that creates a shape \ in Offset coordinates about a user specified point. This can be \ used for generating plot symbols in MultipleListPlot."; Star::usage = "Star is a kind of PlotSymbol for use with MultipleListPlot. It \ represents a five-pointed star."; Diamond::usage = "Diamond is a kind of PlotSymbol for use with MultipleListPlot. It \ represents a narrow upright diamond shape."; Box::usage = "Box is a kind of PlotSymbol for use with MultipleListPlot. It \ represents a square box shape."; Triangle::usage = "Triangle is a kind of PlotSymbol for use with MultipleListPlot. It \ represents an equilateral triangle shape."; If[Head[Dashing::usage] === String, Dashing::usage = Dashing::usage <> " Dashing[{shape1, shape2, ...}] represents a dashing pattern \ of dots and dashes. Valid shapes include Dot, Dash, and LongDash. \ The shapes are automatically spaced." ]; If[Head[AbsoluteDashing::usage] === String, AbsoluteDashing::usage = AbsoluteDashing::usage <> " AbsoluteDashing[{shape1, shape2, ...}] represents a dashing pattern \ of dots and dashes. Valid shapes include Dot, Dash, and LongDash. \ The shapes are automatically spaced." ]; If[Head[Dot::usage] === String, Dot::usage = Dot::usage <> " Dot can also be used as a tag for a dot in a Dashing or \ AbsoluteDashing specification." ]; Dash::usage = "Dash is a tag for a dash in a Dashing or AbsoluteDashing specification."; LongDash::usage = "LongDash is a tag for a long dash in a Dashing or AbsoluteDashing \ specification."; (* This version of RegularPolygon is by Cameron Smith *) 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." (* Backwards compatibility *) DotShapes::usage = "DotShapes is obsolete. Use SymbolShape instead."; LineStyles::usage = "LineStyles is obsolete. Use PlotStyle instead."; $DotShapes::usage = "$DotShapes is obsolete. Use \ SetOptions[MultipleListPlot, SymbolShape -> shapes] instead." $LineStyles::usage = "$LineStyles is obsolete. Use \ SetOptions[MultipleListPlot, PlotStyle -> styles] instead." Begin["`Private`"] issueObsoleteFunMessage[fun_, context_] := Message[General::obspkgfn, fun, context]; (* internal globals -- a default style *) $$defaultstyle = {GrayLevel[0], Dashing[{}], Thickness[.0001], PointSize[.01]}; $$defaultshapes := {PlotSymbol[Diamond], PlotSymbol[Star], PlotSymbol[Box], PlotSymbol[Triangle], Point}; $$defaultlinestyles := {GrayLevel[0], AbsoluteDashing[Dot], AbsoluteDashing[Sequence[Dot, Dash]], AbsoluteDashing[Dash], AbsoluteDashing[Sequence[Dot, Dash, Dot]]}; (* another NumberQ -- should eventually migrate to NumericQ *) numberQ[n_] := NumberQ[N[n]] (* The following is a useful internal utility function to be used when you have a list of values that need to be cycled to some length (as PlotStyle works in assigning styles to lines in a plot). The list is the list of values to be cycled, the integer is the number of elements you want in the final list. *) cycleValues[{},_] := {} cycleValues[list_List, n_Integer] := Module[{hold = list}, While[Length[hold] < n,hold = Join[hold,hold]]; Take[hold,n] ] cycleValues[item_,n_] := cycleValues[{item},n] (* default error bar function *) ebarfun[pt:{x_, y_}, ErrorBar[{xmin_, xmax_}, {ymin_, ymax_}] ] := Module[{xline, yline}, If[xmin === 0 && xmax === 0, xline = {}, xline = {Line[{{x + xmax, y}, {x + xmin, y}}], Line[{Offset[{0,1.5}, {x + xmax, y}], Offset[{0,-1.5}, {x + xmax, y}]}], Line[{Offset[{0,1.5}, {x + xmin, y}], Offset[{0,-1.5}, {x + xmin, y}]}]} ]; If[ymin === 0 && ymax === 0, yline = {}, yline = {Line[{{x, y + ymax}, {x, y + ymin}}], Line[{Offset[{1.5,0}, {x, y + ymax}], Offset[{-1.5,0}, {x, y + ymax}]}], Line[{Offset[{1.5,0}, {x, y + ymin}], Offset[{-1.5,0}, {x, y + ymin}]}]} ]; Join[xline, yline] ] (* data enters in normalized format: data in list of x-y pairs *) handleset[data_, iebfun_, shape_, symsty_, join_, style_, labels_] := Module[{len = Length[data], ebf, pts, barprims, symbolprims, lineprims}, If[data === {}, pts = {}, pts = First[Transpose[data]] ]; (* set up error bar function and error bars *) If[iebfun === Automatic, ebf = ebarfun, ebf = iebfun ]; If[ebf === None, barprims = {}, barprims = Apply[ebf, data, {1}] ]; (* build line and shapes, combine with bars in proper order *) {doline[join, style, pts], barprims, doshape[symsty, shape, labels, pts]} ] (* build the line based on data and options *) doline[True, Automatic, data_] := doline[True, {}, data] doline[True, sty_, data_] := Flatten[{sty, Line[data]}] doline[___] := {} (* build the shapes based on data and options *) doshape[_, None, _, _] := {} doshape[Automatic | None, shp_, lbl_, dat_] := doshape[{}, shp, lbl, dat] doshape[sty_, shp_, None, dat_] := Join[Flatten[{$$defaultstyle, sty}], Map[shp, dat]] doshape[sty_, shp_, lbl_, dat_] := Join[Flatten[{$$defaultstyle, sty}], MapThread[dopoint[#1, shp, #2]&, {dat, lbl}] ] (* build individual points when labels are specified per point *) dopoint[pt_, Label, None] := {} dopoint[pt_, Label, label_] := Text[label, pt] dopoint[pt_, fun_, None] := fun[pt] dopoint[pt_, fun_, label_] := {fun[pt], Text[label, pt, {-1.5,-1.7}]} (* normalize the labels *) normalizelabels[None, _, _] := None normalizelabels[Automatic, num_, tot_] := Map[ToString[#[[1]]]<>"-"<>ToString[#[[2]]] &, Map[{num, #}&, Range[tot]] ] normalizelabels[labs:(_List | _String), _, tot_] := cycleValues[labs, tot] normalizelabels[fun_, num_, tot_] := Apply[fun, Map[{num, #}&, Range[tot]], {1}] (* validErrorQ - test that the error bar is valid *) validErrorQ[ ErrorBar[{ymin_?numberQ, ymax_?numberQ}/;ymin <= 0 <= ymax] ] := True validErrorQ[ ErrorBar[{xmin_?numberQ, xmax_?numberQ}/;xmin <= 0 <= xmax, {ymin_?numberQ, ymax_?numberQ}/;ymin <= 0 <= ymax] ] := True validErrorQ[_] := False (* fixpoints - put all the points into a canonical form *) MultipleListPlot::badpt = "`1` is not a valid specification for a point in MultipleListPlot. It \ should be a number, a pair of numbers, or the same with an error \ specification given as an Interval around zero."; fixpoints[n_?numberQ, pos_, off_] := { {pos, n} + off, ErrorBar[{0,0}, {0,0}] } fixpoints[{n_?numberQ, err_ErrorBar}, pos_, off_] := fixpoints[{{pos, n} + off, err}] fixpoints[pt:{_?numberQ, _?numberQ}, _, off_] := {pt + off, ErrorBar[{0,0}, {0,0}] } fixpoints[{pt:{_?numberQ, _?numberQ}}, _, off_] := {pt + off, ErrorBar[{0,0}, {0,0}] } fixpoints[{pt:{_?numberQ, _?numberQ}, err_ErrorBar}, pos_, off_] := fixpoints[{pt + off, err}] fixpoints[ErrorBar[{ymin_?numberQ, ymax_?numberQ}/;ymin <= ymax], pos_, off_] := Block[{middle = (ymax - ymin)/2}, { {pos, ymin + middle} + off, ErrorBar[{0,0}, {-middle, middle}] } ] fixpoints[ErrorBar[{xmin_?numberQ, xmax_?numberQ}/;xmin <= xmax, {ymin_?numberQ, ymax_?numberQ}/;ymin <= ymax], _, off_] := Block[{xmid = (xmax - xmin)/2, ymid = (ymax - ymin)/2}, { {xmin + xmid, ymin + ymid} + off, ErrorBar[{-xmid, xmid}, {-ymid, ymid}] } ] fixpoints[{ept_ErrorBar, _}, pos_, off_] := fixpoints[ept, pos, off] fixpoints[{pt_, ErrorBar[yerr_]?validErrorQ}] := {pt, ErrorBar[{0,0}, yerr]} fixpoints[{pt_, err:ErrorBar[_, _]?validErrorQ}] := {pt, err} fixpoints[pt_, _, _] := Message[MultipleListPlot::badpt, pt] fixpoints[pt_] := Message[MultipleListPlot::badpt, pt] (* ErrorBar single value expansion - a cheesy way to deal with the possibility of the user entering a single value instead of a range for an error bar. *) ErrorBar[yerr_?numberQ] := ErrorBar[{-yerr, yerr}] ErrorBar[xerr_?numberQ, yerr_] := ErrorBar[{-xerr, xerr}, yerr] ErrorBar[xerr_, yerr_?numberQ] := ErrorBar[xerr, {-yerr, yerr}] (* MultipleListPlot: main routine *) MultipleListPlot::badargs = "MultipleListPlot has been given bad arguments. Input should be data sets \ consisting of points or points with ErrorBar specifications."; Options[MultipleListPlot] := Sort[Join[Options[ListPlot], {ErrorBarFunction -> Automatic, SymbolLabel -> None, SymbolShape -> Automatic, SymbolStyle -> Automatic, PlotLegend -> Automatic, PlotJoined -> False, ZeroOffsets -> None}, Options[Legend] ]]; SetOptions[MultipleListPlot, LegendShadow -> {0,0}, LegendPosition -> Automatic]; MultipleListPlot[{data__List?(Length[#] > 3 &)}, opts___?OptionQ] := MultipleListPlot[data, opts] MultipleListPlot[idata__List, opts___?OptionQ] := (issueObsoleteFunMessage[MultipleListPlot,"Graphics`MultipleListPlot`"]; Module[{data, ebfuns, labels, shapes, symstys, joins, style, numsets = Length[{idata}], pl, lsize, lpos, dispfun, lorient, scalefact, origopts, zoff}, (* get the option values *) {ebfuns, labels, shapes, symstys, joins, style, pl, lsize, lpos, lorient, zoff} = {ErrorBarFunction, SymbolLabel, SymbolShape, SymbolStyle, PlotJoined, PlotStyle, PlotLegend, LegendSize, LegendPosition, LegendOrientation, ZeroOffsets}/. Flatten[{opts, Options[MultipleListPlot]}]; origopts = FilterOptions[{DisplayFunction}, Flatten[{opts, Options[MultipleListPlot]}]]; (* grab some defaults *) If[shapes === Automatic, shapes = $$defaultshapes]; If[style === Automatic, style = $$defaultlinestyles]; (* options that are one per data set need to be normalized to the right number *) {ebfuns, shapes, symstys, joins, style, labels, zoff} = Map[cycleValues[#, numsets]&, {ebfuns, shapes, symstys, joins, style, labels, zoff}]; (* fix offsets *) zoff = Map[Which[numberQ[#], {#, 0}, MatchQ[#, {_?numberQ, _?numberQ}], #, True, {0,0}]&, zoff]; (* normalize the form of the data. The normalizing function returns Null for bad points, so pull the Nulls. *) data = MapIndexed[fixpoints[#1, Last[#2], zoff[[First[#2]]] ]&, {idata}, {2}]; data = DeleteCases[data, Null, {2}]; (* when labels are not None, they can be one per data point; set them as such *) labels = MapThread[normalizelabels, {labels, Range[numsets], Map[Length, data]} ]; (* the graphic *) gr = Graphics[{Thickness[.001], MapThread[handleset, {data, ebfuns, shapes, symstys, joins, style, labels} ] }, FilterOptions[Graphics, ##]& @@ Flatten[{opts, Options[MultipleListPlot]}] ]; (* set up for legends *) If[Head[pl] =!= List, Show[gr], (* else *) (* first determine size of legend; default of .8 matches V2.2 behavior *) If[!MatchQ[lsize, {_?numberQ, _?numberQ} | _?numberQ], lsize = .8]; If[Head[lsize] === List, If[lorient === Horizontal, lsize = Last[lsize], lsize = First[lsize] ] ]; (* determine the scaling factor for scaled coordinates in a legend box; this is a magic number *) scalefact = (numsets/lsize) * 1.87; (* generate the legend and display with the graphic *) ShowLegend[gr, {Transpose[{ MapThread[legendbox[scalefact, ##]&, {symstys, shapes, labels, joins, style}], PadRight[pl, numsets, ""] }], FilterOptions[Legend, ##] & @@ Flatten[{ If[lpos === Automatic, LegendPosition -> If[lorient === Horizontal, {-lsize/2, -1.0}, {1.1, -lsize/2} ], LegendPosition -> lpos ], opts, Options[MultipleListPlot]}]}, origopts ] ] ]) MultipleListPlot[___] := badinput/;Message[MultipleListPlot::badargs] legendbox[scalefact_, symsty_, shape_, label_, join_, sty_] := Graphics[{Thickness[.001],doline[join, sty, {{-1, 0}, {1, 0}}], doshape[symsty, shape, If[Head[label] === List, {First[label]}, label ], {{0,0}}]}, PlotRange -> {{-1,1},{-1,1}}, AspectRatio -> 1]/. {Thickness[x_] :> Thickness[scalefact x], PointSize[x_] :> PointSize[scalefact x], Dashing[x_] :> Dashing[scalefact x], Scaled[off_, pt_] :> Scaled[scalefact off, pt]} (* Stem (plot symbol function for stem plots) *) Stem[pt:{_?NumericQ, _?NumericQ}] := Stem[0.02][pt] Stem[s_?NumericQ][pt:{x_?NumericQ, _?NumericQ}] := {PointSize[s], Point[pt], Line[{pt, {x, 0}}]} Stem[] := Stem[0.02] (* Plot Symbols *) PlotSymbol::unknown = "`` is an unknown type for PlotSymbol." Options[PlotSymbol] = {Filled -> True}; PlotSymbol[type_Symbol, size:(_Integer | _Real):2.5, opts___?OptionQ] := (issueObsoleteFunMessage[PlotSymbol,"Graphics`MultipleListPlot`"]; If[TrueQ[Filled/.Flatten[{opts}]/.Options[PlotSymbol]], MakeSymbol[symb[type, size]/.Line -> Polygon], MakeSymbol[symb[type, size]] ]) symb[Diamond, size_] := Line[size {{-.75, 0}, {0,1}, {.75, 0}, {0,-1}, {-.75, 0}}] symb[Box, size_] := Line[size {{-1, 1}, {1, 1}, {1, -1}, {-1, -1}, {-1, 1}}] symb[Star, size_] := Line[size {{0, 1.}, {-0.226071, 0.31116}, {-0.951057, 0.309017}, {-0.365791, -0.118853}, {-0.587785, -0.809017}, {0, -0.384615}, {0.587785, -0.809017}, {0.365791, -0.118853}, {0.951057, 0.309017}, {0.226071, 0.31116}, {0, 1.}}] symb[Triangle, size_] := Line[size {{0, 1}, {-.866, -.5}, {.866, -.5}, {0,1}}] symb[type_, _] := (Message[PlotSymbol::unknown, type]; {}) (* MakeSymbol *) Attributes[MakeSymbol] = {HoldAll}; MakeSymbol::badpt = "The expression `` is not a valid specification for a graphics \ coordinate."; MakeSymbol[expr_] := (issueObsoleteFunMessage[MakeSymbol,"Graphics`MultipleListPlot`"]; With[{fexpr = tofun[expr]}, Function[fexpr]/.{fixpt[p_List] :> Offset[p, #], fixpt[Offset[o_, p_]] :> Offset[o, p + #], fixpt[Scaled[s_, p_]] :> Scaled[s, p + #], fixpt[any_]/;(Message[MakeSymbol::badpt, any]; True) :> #} ]) tofun[e_List] := Map[tofun, e] tofun[Line[e_List]] := Line[Map[fixpt, e]] tofun[Polygon[e_List]] := Polygon[Map[fixpt, e]] tofun[Text[t_, pt_, rest___]] := Text[t, fixpt[pt], rest] tofun[Circle[pt_, rest___]] := Circle[fixpt[pt], rest] tofun[Disk[pt_, rest___]] := Disk[fixpt[pt], rest] tofun[Point[pt_]] := Point[fixpt[pt]] tofun[Rectangle[minpt_, maxpt_]] := Rectangle[fixpt[minpt], fixpt[maxpt]] tofun[e_] := e (* brief form for Dashing specification *) Unprotect[Dashing, AbsoluteDashing]; Dashing[seq:((Dot | Dash | LongDash)..)] := Dashing[{seq}] Dashing[dashlist:{(Dot | Dash | LongDash)..}] := Dashing[filloutdashes[dashlist, 0.015, 0.02, 0.03]/. {Dot -> 0.003, Dash -> 0.04, LongDash -> 0.09} ] AbsoluteDashing[seq:((Dot | Dash | LongDash)..)] := AbsoluteDashing[{seq}] AbsoluteDashing[dashlist:{(Dot | Dash | LongDash)..}] := AbsoluteDashing[filloutdashes[dashlist, 2, 3, 4]/. {Dot -> 0.5, Dash -> 5, LongDash -> 10} ] Protect[Dashing, AbsoluteDashing]; filloutdashes[l_List, sspace_, mspace_, lspace_] := l//.{{a___, Dot,Dot, b___} :> {a, Dot, mspace, Dot, b}, {a___, Dot, d:(Dash | LongDash), b___} :> {a, Dot, lspace, d, b}, {a___, d:(Dash | LongDash), Dot, b___} :> {a, d, lspace, Dot, b}, {a___, d1:(Dash | LongDash), d2:(Dash | LongDash), b___} :> {a, d1, sspace, d2, b}, {Dot, a___, Dot} :> {Dot, a, Dot, mspace}, {d:(Dash | LongDash), a___, Dot} :> {d, a, Dot, lspace}, {Dot, a___, d:(Dash | LongDash)} :> {Dot, a, d, lspace}, {d1:(Dash | LongDash), a___, d2:(Dash | LongDash)} :> {d1, a, d2, sspace}, {Dot} -> {Dot, mspace}, {d:(Dash | LongDash)} :> {d, sspace}} (* RegularPolygon - drawn directly from the V2.2 package. Attributed to Cameron Smith. *) RegularPolygon[n_Integer?((#>1)&), rad_:1, ctr_:{0,0}, tilt_:0, skip_:1] := (issueObsoleteFunMessage[RegularPolygon,"Graphics`MultipleListPlot`"]; 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]] ] ] ]) (* Backwards compatibility code *) LineStyles = PlotStyle; DotStyles = SymbolShape; $LineStyles/: Set[$LineStyles, setto_] := (SetOptions[MultipleListPlot, PlotStyle -> setto]; setto) $DotStyles/: Set[$DotStyles, setto_] := (SetOptions[MultipleListPlot, SymbolShape -> setto]; setto) End[] EndPackage[]