(* ::Package:: *) (* :Name: Graphics`Graphics` *) (* :Title: Additional Graphics Functions *) (* :Author: Wolfram Research, Inc. *) (* :Copyright: Copyright 1990-2007, Wolfram Research, Inc.*) (* :Mathematica Version: 5.0 *) (* :Package Version: 2.0 *) (* :History: Original Version by Wolfram Research, Inc. Revised by Michael Chan and Kevin McIsaac (Wolfram Research), March 1990. Further revisions by Bruce Sawhill (Wolfram Research), September 1990. Further revisions by E.C. Martin (Wolfram Research), December 1990. Removal of 3D graphics functions to the package Graphics3D.m and minor revisions by John M. Novak, March 1991. More extensive revisions by John M. Novak, November 1991. (PieChart, log plots, ScaledPlot, bar charts, etc.) Some significant Log plot bug fixes by John M. Novak, October 1994. More Log plot bug fixes by John M. Novak, May 1995. Rename Scale option to ScaleFunction to avoid name collision with another package, June 1995. Histogram, ECM, October 1997. Revise DisplayTogether, John M. Novak, January 2000. *) (*:Summary: This package provides special functions for plotting in two dimensions. Special formats include bar charts, pie charts, log plots, polar plots, error bar plots, and histograms. *) (* :Context: Graphics`Graphics` *) (*:Keywords: Log, Graphics, ListPlot, Scale, Polar, histogram *) (*:Requirements: None. *) (*:Warnings: Expands the definitions of PlotStyle. *) (*:Sources: *) Message[General::obspkg, "Graphics`Graphics`"] Quiet[ BeginPackage["Graphics`Graphics`", {"Graphics`Common`GraphicsCommon`","Utilities`FilterOptions`", "Statistics`DataManipulation`"}] , {General::obspkg, General::newpkg}] (* Usage messages *) LinearScale::usage = "LinearScale[xmin, xmax] gives a list of \"nice\" values between xmin and xmax \ suitable for use as tick mark positions. LinearScale[xmin, xmax, n] attempts \ to find n such values."; LogScale::usage = "LogScale[xmin, xmax] gives a list of \"nice\" values between xmin and xmax \ suitable for use as tick mark positions on a logarithmic scale. \ LogScale[xmin, xmax, n] attempts to find n such values."; UnitScale::usage = "UnitScale[xmin, xmax, unit] gives a list of \"nice\" values between xmin and \ xmax that are multiples of unit. UnitScale[xmin, xmax, unit, n] attempts to \ find n such values."; PiScale::usage = "PiScale[xmin, xmax] gives a list of \"nice\" values between xmin and xmax that \ are multiples of Pi. PiScale[xmin, xmax, n] attempts to find n such values."; LogGridMinor::usage = "LogGridMinor[xmin, xmax] gives a list of \"nice\" values between xmin and \ xmax suitable for use as grid line positions on a logarithmic scale. The \ positions are the same as those for major and minor tick marks from LogScale. \ LogGridMinor[xmin, xmax, n] attempts to find n such values."; LogGridMajor::usage = "LogGridMajor[xmin, xmax] gives a list of \"nice\" values between xmin and \ xmax suitable for use as grid line positions on a logarithmic scale. The \ positions are the same as those for major tick marks from LogScale. \ LogGridMajor[xmin, xmax, n] attempts to find n such values."; TextListPlot::usage = "TextListPlot[{y1, y2, ...}] plots a list, with each point {i,yi} rendered as \ its index number i. TextListPlot[{{x1,y1},{x2,y2}, ...}] renders the point \ {xi,yi} as its index number i. TextListPlot[{{x1, y1, t1}, {x2, y2, t2}, ...}] \ renders the point {xi,yi} as the text ti."; LabeledListPlot::usage = "LabeledListPlot[{y1, y2, ...}] plots a list, with each point {i,yi} labeled \ with its index number i. LabeledListPlot[{{x1,y1},{x2,y2}, ...}] labels the \ point {xi,yi} with its index number i. LabeledListPlot[{{x1, y1, t1}, \ {x2, y2, t2}, ...}] labels the point {xi,yi} with the text ti."; DisplayTogether::usage = "DisplayTogether[plotcommands, opts] is obsolete. Show can be used \ directly for this purpose." DisplayTogetherArray::usage = "DisplayTogetherArray[plotcommands, opts] is obsolete. GraphicsArray \ can be used directly for this purpose."; ListAndCurvePlot::usage = "ListAndCurvePlot[list1,list2,...,curve1,curve2...,range] puts \ curves in a single variable and lists of data in a single plot. \ Curves are given as in Plot, lists as in ListPlot. The range is \ specified as in Plot, and is used in the same fashion. The \ function accepts standard Graphics options, plus PlotStyle \ (which works as in Plot). Lists and curves can be specified in \ any order, and can be intermixed."; (* LogPlot::usage = "LogPlot[f, {x, xmin, xmax}] generates a plot of Log[f] as a function of x."; *) LogListPlot::usage = "LogListPlot[{y1, y2, ...}] or LogListPlot[{{x1, y1}, {x2, y2}, ...}] plots \ points of the Log[yi] against the xi. LogListPlot[{list1, list2, ...}] plots \ several lists of points."; LinearLogPlot::usage = "LinearLogPlot[f, {x, xmin, xmax}] generates a plot of Log[f] as a function \ of x."; LinearLogListPlot::usage = "LinearLogListPlot[{y1, y2, ...}] or \ LinearLogListPlot[{{x1, y1}, {x2, y2}, ...}] generates \ a plot of Log[yi] against the xi. LinearLogListPlot[{list1, list2, ...}] plots \ several lists of points."; (* LogLinearPlot::usage = "LogLinearPlot[f, {x, xmin, xmax}] generates a plot of f as a function of \ Log[x]." ; *) LogLinearListPlot::usage = "LogLinearListPlot[{y1, y2, ...}] or \ LogLinearListPlot[{{x1, y1}, {x2, y2}, ...}] plots points of yi against \ Log[xi]. LogLinearListPlot[{list1, list2, ...}] plots \ several lists of points."; (* LogLogPlot::usage = "LogLogPlot[f, {x, xmin, xmax}] generates a plot of Log[f] as a function of \ Log[x]." ; *) LogLogListPlot::usage = "LogLogListPlot[{y1, y2, ...}] or LogLogListPlot[{{x1, y1}, {x2, y2}, ...}] \ plots points of Log[yi] against Log[xi]. LogLogListPlot[{list1, list2, ...}] \ plots several lists of points."; (*PolarPlot::usage = "PolarPlot[r, {t, tmin, tmax}] generates a polar plot of r as a function of t. \ PolarPlot[{r1, r2, ...}, {t, tmin, tmax}] plots each of the ri as a function of \ t on the same graph.";*) PolarListPlot::usage = "PolarListPlot[{r1, r2, ...}] plots points in polar coordinates, \ assuming that the ri are equally spaced in angle. \ PolarListPlot[{{r1, t1}, {r2, t2}, ...}] \ plots points with the radii at the specified angles in radians. \ PolarListPlot[{list1, list2, ...}] plots several lists of points."; PolarListLinePlot::usage = "PolarListLinePlot[{r1, r2, ...}] plots a line through the points \ in polar coordinates, assuming that the ri are equally spaced in angle. \ PolarListLinePlot[{{r1, t1}, {r2, t2}, ...}] \ plots lines with the radii at the specified angles in radians. \ PolarListLinePlot[{list1, list2, ...}] plots several lines throughh \ lists of points."; ErrorListPlot::usage = "ErrorListPlot[{{y1, dy1}, {y2, dy2}, ...}] plots a list of data with error \ bars. ErrorListPlot[{{x1, y1, dy1}, ...}] allows x, as well as y, positions to \ be specified."; Histogram::usage = "Histogram[{x1, x2, ...}] generates a bar graph representing a histogram of the \ univariate data {x1, x2, ...}. The width of each bar is proportional to the \ width of the interval defining the respective category, and the area of the bar \ is proportional to the frequency with which the data fall in that category. \ Histogram range and categories may be specified using the options \ HistogramRange and HistogramCategories. Histogram[{f1, f2, ...}, \ FrequencyData -> True] generates a histogram of the univariate frequency data \ {f1, f2, ...}, where fi is the frequency with which the original data fall in \ category i." BarChart::usage = "BarChart[list1, list2, ...] generates a bar chart of the data in the lists."; GeneralizedBarChart::usage = "GeneralizedBarChart[{{pos1, height1, width1}, {pos2, height2, width2},...}] \ generates a bar chart with the bars at the given positions, heights, and \ widths."; StackedBarChart::usage = "StackedBarChart[list1, list2, ...] generates a stacked bar chart of the \ data in the lists."; PercentileBarChart::usage = "PercentileBarChart[list1, list2, ...] generates a stacked bar chart with \ the data scaled so that the sum of the absolute values at a given point is 1."; (* The option BarStyle specifies the default style for the bars. BarSpacing gives the fraction of the bar width to be allowed as separation between the bars. BarEdges specifies whether edges are to be drawn around the bars. BarEdgeStyle gives the style for the edges. BarOrientation can be either Horizontal or Vertical to specify the orientation of the bars. *) BarStyle::usage = "BarStyle is an option for the bar charts that determines the default style \ for the bars. If there is only one data set, the styles are cycled amongst \ the bars; if there are multiple data sets, the styles are cycled amongst \ the sets. If it is a function, the function is applied to the height of \ each of the bars."; BarLabels::usage = "BarLabels is an option for BarChart, StackedBarChart, and PercentileBarChart, \ that allows a label to be placed at the tick mark for each bar (or group of \ bars for multiple data sets). Labels are specified in a list."; BarValues::usage = "BarValues is an option for BarChart and GeneralizedBarChart that allows \ the length of the bar to be displayed above each bar."; BarEdges::usage = "BarEdges is an option for the bar charts that determines whether edges are to be \ drawn around the bars."; BarEdgeStyle::usage = "BarEdgeStyle is an option for the bar charts that determines the style for the \ edges."; BarSpacing::usage = "BarSpacing is an option for BarChart that determines the fraction \ of the bar width to space the bars in a group of bars. As an option for \ StackedBarChart and PercentileBarChart, it determines the space between \ the bars. See also BarGroupSpacing."; BarGroupSpacing::usage = "BarGroupSpacing is an option for BarChart that determines the spacing \ between groups of bars (individual bars when only one data set is used)."; BarOrientation::usage = "BarOrientation is an option for BarChart that determines whether the bars are \ oriented vertically or horizontally."; PieChart::usage = "PieChart[{y1, y2, ...}] generates a pie chart of the values yi. \ The values yi need to be positive. Several options (PieLabels, \ PieStyle, PieLineStyle, PieExploded) are available to modify \ the style of the pie."; PieLabels::usage = "PieLabels is an option for PieChart; it accepts a list of \ expressions to be used as labels on the pie wedges. If None, \ no labels are placed."; PieStyle::usage = "PieStyle is an option for PieChart; it accepts a list of \ styles that are matched with the polygon for each pie wedge. \ Default behavior will give each wedge a different color."; PieLineStyle::usage = "PieLineStyle is an option for PieChart. It accepts a style \ or list of styles that will be applied to all of the lines in \ the pie chart (around the wedges)."; PieExploded::usage = "PieExploded is an option for PieChart. It accepts a list of \ distances or pairs of a wedge number and a matching distance. \ Distances are expressed as a ratio of the distance to the \ radius of the pie; i.e., .1 moves a wedge outward 1/10th the \ radius of the pie. Wedges are numbered counterclockwise from \ theta = 0 (a line extending right from the center of the pie)."; TransformGraphics::usage = "TransformGraphics[expr, f] applies the function f to all \ coordinates of graphics primitives in expr."; SkewGraphics::usage = "SkewGraphics[graphics, m] applies the matrix m to all coordinates in graphics."; PlotStyle::usage = "PlotStyle is an option for Plot and ListPlot that specifies the style of lines \ or points to be plotted. PlotStyle[graphics] will return the PlotStyle for \ a graphic image created by Plot or ListPlot."; (* Attach usage messages to symbols from GraphicsCommon.m. *) If[Head[Vertical::usage] === MessageName, Vertical::usage = "Vertical is a possible value for the option BarOrientation."; Horizontal::usage = "Horizontal is a possible value for the option BarOrientation.", If[StringPosition[Horizontal::usage, "BarOrientation"] === {}, Vertical::usage = Vertical::usage <> " " <> "It is also a possible value for the option BarOrientation."; Horizontal::usage = Horizontal::usage <> " " <> "It is also a possible value for the option BarOrientation." ]]; (* Attach usage messages to symbols from GraphicsCommon.m. *) If[Head[FrequencyData::usage] === MessageName, FrequencyData::usage = "FrequencyData is an option of histogram functions that specifies whether \ the data argument represents the original data (FrequencyData -> False) or \ the frequencies with which the original data fall in the respective \ categories (FrequencyData -> True). The default is FrequencyData -> False."; HistogramCategories::usage = "HistogramCategories is an option of histogram functions that specifies \ the categories in the histogram. When HistogramCategories->Automatic \ (default), the categories are chosen to be intervals of equal width and \ the number of categories is chosen based on the data. The number of \ equally sized categories may be specified using HistogramCategories->n for \ univariate data, or HistogramCategories -> {n, l} for bivariate data, \ although the number will be approximated if ApproximateIntervals -> False. \ Unequally sized categories may be specified using HistogramCategories-> \ {c1, c2, ..., cm, cn} for univariate data, where the cutoffs represent the \ categories {c1 <= x < c2, ..., cm <= x < cn}. For bivariate data, \ unequally sized categories may be specified using HistogramCategories-> \ {{c1, c2, ..., cm, cn}, {d1, d2, ..., dk, dl}}."; HistogramRange::usage = "HistogramRange is an option of histogram functions that specifies the lower \ and upper limits of the points to be included in the histogram. Possible \ values are Automatic (default), HistogramRange -> {min, max}, or for bivariate \ data, HistogramRange -> {{xmin, xmax}, {ymin, ymax}}."; HistogramScale::usage = "HistogramScale is an option of histogram functions that specifies the \ way in which the bar heights are to be scaled. HistogramScale -> \ Automatic (default) implies that, for equally sized intervals, there is no \ scaling (yielding raw frequencies), and for unequally sized intervals, there is \ scaling according to interval size (yielding frequency densities). \ HistogramScale -> True implies that the heights are scaled by the interval sizes \ regardless of whether the interval sizes are equal. HistogramScale -> k \ implies that the heights are scaled so that the bar areas (for univariate \ histograms) or bar volumes (for bivariate histograms) sum to the positive number \ k. In particular, HistogramScale -> 1 gives a probability density plot."; ApproximateIntervals::usage = "ApproximateIntervals is an option of histogram functions that specifies \ whether the HistogramCategories or HistogramRange settings should be adjusted \ so that the interval boundaries are described by simple numbers. The default \ is ApproximateIntervals -> Automatic, which means that intervals are \ adjusted when HistogramCategories is set to Automatic or a positive integer, \ but not adjusted when HistogramCategories is set to a specific list of \ cutoffs. Other possible settings for ApproximateIntervals are True or False."; IntervalCenters::usage = "IntervalCenters is a possible value for the Ticks option of \ histogram functions. For example, Histogram[data, Ticks -> IntervalCenters] \ Automatic}], or Histogram[data, Ticks -> IntervalCenters], places the ticks of \ the category axis at the interval centers, and sets the ticks of the frequency \ axis automatically."; IntervalBoundaries::usage = "IntervalBoundaries is a possible value for the Ticks option of histogram \ functions. For example, Histogram[data, Ticks -> {IntervalBoundaries, \ Automatic}], or Histogram[data, Ticks -> IntervalBoundaries] places the ticks \ of the category axis at the interval boundaries, and sets the ticks of the \ frequency axis automatically."; ]; Begin["`Private`"] issueObsoleteFunMessage[fun_, context_] := Message[General::obspkgfn, fun, context]; (* Define a better NumberQ *) numberQ[x_] := NumberQ[N[x]] (* 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] (* PlotStyle *) Unprotect[PlotStyle]; PlotStyle[HoldPattern[Graphics][g:{{__,_List}..},opts___]] := Map[PlotStyle[Graphics[#,opts]]&, g] PlotStyle[HoldPattern[Graphics][g_List,opts___]] := Module[{q}, If[ Length[ q=Select[Drop[g,-1], MemberQ[{RGBColor,GrayLevel,Thickness,Dashing,PointSize}, Head[#]]& ] ] > 1, {q}, q]] Protect[PlotStyle]; (* Linear Scale *) LinearScale[min_, max_, n_Integer:8] := (issueObsoleteFunMessage[LinearScale,"Graphics`Graphics`"]; Module[{spacing, t, nmin=N[min], nmax=N[max]}, (spacing = TickSpacing[nmax-nmin, n, {1, 2, 2.5, 5, 10}] ; t = N[spacing * Range[Ceiling[nmin/spacing - 0.05], Floor[max/spacing + 0.05]]] ; Map[{#, If[Round[#]==#, Round[#], #]}&, t]) /; nmin < nmax ]) (* NOTE: LinearScale and UnitScale use TickSpacing[dx, n, prefs]. approximateIntervals uses TickSpacing[dx, n, prefs, Nearest]. 10/97: Eliminated check that argument "n" was an integer. *) TickSpacing[dx_, n_, prefs_List, method_:GreaterEqual] := Module[ { dist=N[dx/n], scale, prefsdelta, min, pos } , scale = 10.^Floor[Log[10., dist]] ; dist /= scale ; If[dist < 1, dist *= 10 ; scale /= 10] ; If[dist >= 10, dist /= 10 ; scale *= 10] ; scale * Switch[method, GreaterEqual, (* "nice" tick spacing is greater than or equal to requested tick spacing *) First[Select[prefs, (dist <= #)&]], LessEqual, (* "nice" tick spacing is less than or equal to requested tick spacing *) First[Select[Reverse[prefs], (dist >= #)&]], Nearest, (* "nice" tick spacing is the taken from the element of "prefs" nearest to "dist" *) prefsdelta = Map[Abs[#-dist]&, prefs]; min = Min[prefsdelta]; pos = Position[prefsdelta, min][[1, 1]]; prefs[[pos]] ] ] (* LogScale *) LogScale[min_, max_, n_Integer:6] := (issueObsoleteFunMessage[LogScale,"Graphics`Graphics`"]; Module[{pts} , pts = GenGrid[ min, max, n] ; Join[ Map[ LogTicks, pts ], MinorLogTicks[pts]] ] /; N[min] < N[max]) LogGridMajor[ min_, max_, n_Integer:6] := (issueObsoleteFunMessage[LogGridMajor,"Graphics`Graphics`"]; Module[{pts} , pts = GenGrid[ min, max, n] ; Map[ Log[10, #]& , pts ] ] /; N[min] < N[max]) LogGridMinor[ min_, max_, n_Integer:6] := (issueObsoleteFunMessage[LogGridMinor,"Graphics`Graphics`"]; Module[{pts} , pts = GenGrid[ min, max, n] ; Union[ Map[ Log[10., #]&,pts], Map[ First, MinorLogTicks[pts]]] ] /; N[min] < N[max]) GenGrid[min_, max_, n_Integer:6] := Module[{nmin=N[min], nmax=N[max], imin, imax, nper, t, tl} , imin=Round[nmin] ; imax=Round[nmax] ; If[imin == imax, imax+=1]; nper = Floor[n/(imax - imin)] ; If[nper > 0, t = 10.^Range[imin, imax] ; tl = Take[ $LogPreferances, Min[nper, Length[$LogPreferances]] ] ; t = Flatten[Outer[Times, t, tl]] ; t = Sort[t] , (* else *) nper = Ceiling[(imax - imin)/n] ; t = 10.^Range[imin, imax, nper] ] ; Map[ If[ Log[10., #] < 5 && # == Round[#] , Round[#], #,#]&, t] ] LogTicks[x_] := {Log[10., x], x} (* revised this function slightly on 3 May 95. Did not change the algorithm, per se, but did revise a bit of the code. Fixed in MinorAux1 the technique equivalent to finding the first non-zero digit in the input value; it was being computed mathematically, but ran into problems on machines with different precision (e.g., 040 Macintosh). Cleaned code for MinorLogTicks and MinorAux1; I think this entire function could be cleaned further, but didn't want to fiddle with the algorithm any more at the moment. *) MinorLogTicks[pts_] := Flatten[ Map[ MinorAux2, Transpose[{ Drop[pts, -1], Map[ MinorAux1, Drop[pts, 1] - Drop[pts, -1] ] }] ], 1 ] MinorAux2[{xst_, {del_ , n_}}] := Module[{xfin = xst+del*(n-1),pts,x}, pts = Table[x, {x, xst+del, xfin, del}] ; Map[ {Log[10., #], "", {0.6/160., 0.}, {Thickness[0.001]}}&, pts ] ] MinorAux1[x_] := {x/#, #}&[RealDigits[ N[x] ][[1,1]]] $LogPreferances = {1, 5, 2, 3, 1.5, 7, 4, 6, 1.2, 8, 9, 1.3, 2.5, 1.1, 1.4} {1, 5, 2, 3, 1.5, 7, 4, 6, 1.2, 8, 9, 1.3, 2.5, 1.1, 1.4} (* UnitScale *) UnitScale[min_, max_, unit_, n_Integer:8] := (issueObsoleteFunMessage[UnitScale,"Graphics`Graphics`"]; Module[{spacing, t, imin=Ceiling[N[min/unit]],imax = Floor[N[max/unit]]}, (spacing = TickSpacing[imax-imin, n, {1, 2, 5, 10}] ; t = Range[Ceiling[imin/spacing - 0.05] spacing, imax, spacing] ; t = Union[Round[t]] ; Map[{N[# unit], # unit}&, t]) /; N[min] < N[max] ]) (* PiScale *) PiScale[min_, max_, n_Integer:8] := (issueObsoleteFunMessage[PiScale,"Graphics`Graphics`"]; UnitScale[min, max, Pi/2, n] /; min < max) (* TextListPlot *) Options[TextListPlot] = Developer`GraphicsOptions[]; SetOptions[TextListPlot, Axes -> Automatic, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True]; TextListPlot[data:{_?numberQ ..}, opts___] := TextListPlot[Transpose[{Range[Length[data]], data, Range[Length[data]]}], opts] TextListPlot[data:{{_?numberQ, _}..}, opts___] := TextListPlot[Transpose[Join[Transpose[data], {Range[Length[data]]}]], opts] TextListPlot[data:{{_?numberQ, _?numberQ, _}..}, opts___] := (issueObsoleteFunMessage[TextListPlot,"Graphics`Graphics`"]; Show[Graphics[ Text[Last[#], Take[#, 2]]& /@ data, FilterOptions[Graphics, Flatten[{opts, Options[TextListPlot]}]]]]) (* LabeledListPlot *) Options[LabeledListPlot] = Developer`GraphicsOptions[]; SetOptions[LabeledListPlot, Axes -> Automatic, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True]; LabeledListPlot[data:{_?numberQ ..}, opts___] := LabeledListPlot[Transpose[{Range[Length[data]], data, Range[Length[data]]}], opts] LabeledListPlot[data:{{_?numberQ, _}..}, opts___] := LabeledListPlot[Transpose[Join[Transpose[data], {Range[Length[data]]}]], opts] LabeledListPlot[data:{{_?numberQ, _?numberQ, _}..}, opts___] := (issueObsoleteFunMessage[LabeledListPlot,"Graphics`Graphics`"]; Show[Graphics[ {PointSize[0.015], {Point[Take[#, 2]], Text[Last[#], Scaled[{0.015, 0}, Take[#, 2]], {-1, 0}] } } & /@ data , FilterOptions[Graphics, Flatten[{opts, Options[LabeledListPlot]}]]]]) (* Log Plots *) SetAttributes[{(*LogPlot, LinearLogPlot, LogLinearPlot, LogLogPlot, *) ScaledPlot}, HoldFirst]; (* adopt as default options those of ParametricPlot and ListPlot *) (*Options[LogPlot] = Sort[Join[Developer`GraphicsOptions[], {ColorFunction -> Automatic, ColorFunctionScaling -> True, EvaluationMonitor -> None, MaxRecursion -> Automatic, Mesh -> Automatic, MeshFunctions -> Automatic, MeshShading -> None, MeshStyle -> Automatic, Method -> Automatic, PlotPoints -> Automatic, PlotStyle -> Automatic, WorkingPrecision -> MachinePrecision} ]]; SetOptions[LogPlot, Axes -> Automatic, AspectRatio -> 1/GoldenRatio, PlotRange -> {Full, Automatic}, PlotRangeClipping -> True ]; Options[LogLinearPlot] = Options[LinearLogPlot] = Options[LogLogPlot] = Options[LogPlot]; Options[LogListPlot] = Sort[Join[Developer`GraphicsOptions[], {DataRange -> Automatic, Filling -> None, FillingStyle -> GrayLevel[0.5], PlotMarkers -> None, PlotStyle -> Automatic} ]]; SetOptions[LogListPlot, Axes -> Automatic, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True ]; Options[LogLinearListPlot] = Options[LinearLogListPlot] = Options[LogLogListPlot] = Options[LogListPlot]; Options[LogListLinePlot] = Options[LogLinearListLinePlot] = Options[LinearLogListLinePlot] = Options[LogLogListLinePlot] = Sort[Join[ Options[LogListPlot], {ColorFunction -> Automatic, ColorFunctionScaling -> True, MaxPlotPoints -> Infinity, Mesh -> None, MeshFunctions -> (#3 &), MeshStyle -> Automatic} ]]; *) LinearLogPlot = LogPlot; LinearLogListPlot = ListLogPlot; LogLinearListPlot = ListLogLinearPlot; LogListPlot = ListLogPlot; LogLogListPlot = ListLogLogPlot; (*LinearLogPlot[fun_,range_,opts___] := With[{res = ScaledPlot[LinearLogPlot, fun, range, range, ScaleFunction -> {#&, Log[10,#]&}, tickopts[Automatic, LogScale, LinearLogPlot, {#&, Log[10,#]&}, Flatten[{opts}]], scaleplotrange[LinearLogPlot, Flatten[{opts}]], opts, Options[LinearLogPlot] ]}, res/;Head[res] === Graphics ]*) (*LogLinearPlot[fun_, range_, opts___] := With[{res = ScaledPlot[LogLinearPlot, fun, range, log10[range], ScaleFunction -> {Log[10, #]&, #&}, tickopts[LogScale, Automatic, LogLinearPlot, {Log[10, #]&, #&}, Flatten[{opts}]], scaleplotrange[LogLinearPlot, Flatten[{opts}]], opts, Options[LogLinearPlot] ]}, res/;Head[res] === Graphics ]*) (*LogLogPlot[fun_, range_, opts___] := With[{res = ScaledPlot[LogLogPlot, fun, range, log10[range], ScaleFunction -> {Log[10, #]&, Log[10, #]&}, tickopts[LogScale, LogScale, LogLogPlot, {Log[10, #]&, Log[10, #]&}, Flatten[{opts}]], scaleplotrange[LogLogPlot, Flatten[{opts}]], opts, Options[LogLogPlot] ]}, res/;Head[res] === Graphics ] LinearLogListPlot[all___] := (issueObsoleteFunMessage[LinearLogListPlot,"Graphics`Graphics`"]; With[{res = llpwrapper[LinearLogListPlot, Automatic, LogScale, all, PlotJoined -> False]}, res/;Head[res] === Graphics ]) LinearLogListLinePlot[all___] := (issueObsoleteFunMessage[LinearLogListLinePlot,"Graphics`Graphics`"]; With[{res = llpwrapper[LinearLogListLinePlot, Automatic, LogScale, all, PlotJoined -> True]}, res/;Head[res] === Graphics ]) LogLinearListPlot[all___] := (issueObsoleteFunMessage[LogLinearListPlot,"Graphics`Graphics`"]; With[{res = llpwrapper[LogLinearListPlot, LogScale, Automatic, all, PlotJoined -> False]}, res/;Head[res] === Graphics ]) LogLinearListLinePlot[all___] := (issueObsoleteFunMessage[LogLinearListLinePlot,"Graphics`Graphics`"]; With[{res = llpwrapper[LogLinearListLinePlot, LogScale, Automatic, all, PlotJoined -> True]}, res/;Head[res] === Graphics ]) LogLogListPlot[all___] := (issueObsoleteFunMessage[LogLogListPlot,"Graphics`Graphics`"]; With[{res = llpwrapper[LogLogListPlot, LogScale, LogScale, all, PlotJoined -> False]}, res/;Head[res] === Graphics ]) LogLogListLinePlot[all___] := (issueObsoleteFunMessage[LogLogListLinePlot,"Graphics`Graphics`"]; With[{res = llpwrapper[LogLogListLinePlot, LogScale, LogScale, all, PlotJoined -> True]}, res/;Head[res] === Graphics ]) *) llpwrapper[cf_, xaxis_, yaxis_, data_, opts___] := Module[{scale}, scale = {xaxis, yaxis}/.{LogScale -> (Log[10,#]&), Automatic -> (#&)}; ScaledListPlot[cf, data, ScaleFunction -> scale, tickopts[xaxis, yaxis, cf, scale, Flatten[{opts}]], scaleplotrange[cf, Flatten[{opts}]], opts, Options[cf] ] ] (* this is an internal auxiliary function for the Log Plots (and any other plot that calls ScaledPlot); it allows easy specification of scales to be used for tick marks and grid lines. *) (* This is turning into something of a kludge tower; revisit the design soon... --JMN 17.2.98 *) tickopts[xfun_, yfun_, deffunc_, scalefuns_, opts_] := Module[{tick, frame, grid}, {tick, frame, grid} = {Ticks, FrameTicks, GridLines}/. opts/.Options[deffunc]; {Ticks -> If[tick === Automatic, {xfun,yfun}, transformticks[tick,{xfun, yfun}, scalefuns]], FrameTicks -> If[frame === Automatic, {xfun, yfun, If[xfun === Automatic, Automatic, Composition[striplabels, xfun] ], If[yfun === Automatic, Automatic, Composition[striplabels, yfun] ]}, transformticks[frame, {xfun, yfun, xfun, yfun}, scalefuns]], GridLines -> If[grid === Automatic, {If[xfun === Automatic, xfun, (Map[First, xfun[#1,#2]] &)], If[yfun === Automatic, yfun, (Map[First, yfun[#1,#2]] &)]}, transformticks[##, scalefuns, Grid]& @@ transformgridlinefuncs[grid, xfun, yfun] ]} ] transformticks[{t1_, t2_}, {f1_, f2_}, {s1_, s2_}, flag_:False] := {transformticks[t1, f1, s1, flag], transformticks[t2, f2, s2, flag]} transformticks[{t1_, t2_}, {f1_, f2_, f3_, f4_}, {s1_, s2_}] := transformticks[{t1, t2, t1, t2}, {f1, f2, f3, f4}, {s1, s2}] transformticks[{t1_, t2_, t3_, t4_}, {f1_, f2_, f3_, f4_}, {s1_, s2_}] := {transformticks[t1, f1, s1], transformticks[t2, f2, s2], transformticks[t3, f3, s1, t3 === Automatic], transformticks[t4, f4, s2, t4 === Automatic]} transformticks[list_, Automatic | None, _, flag_:False] := list transformticks[Automatic, fun_, _, flag_:False] := If[TrueQ[flag], Composition[striplabels, fun], fun] transformticks[True, fun_, _, flag_:False] := fun transformticks[None, _, _, flag_:False] := None transformticks[anything_, funs_List, _, flag_:False] := anything transformticks[list_List, _, scale_, flag_:False] := Map[singletick[#,scale, flag]&, list] transformticks[tfun_, f_, scale_, flag_:False] := Composition[transformticks[#, f, scale]&, (tfun @@ (10^{##}))&] singletick[list_List, scale_, _] := Prepend[Rest[list], scale[First[list]]] singletick[item_, scale_, Grid] := scale[item] singletick[item_, scale_, _] := {scale[item], item} striplabels[l_List] := Map[fixtick, l] fixtick[n_?numberQ | {n_?numberQ}] := {n, ""} fixtick[{n_, _, r___}] := {n, "", r} (* GridLines has an undocumented but useful functionality that allows a grid specification to be {Automatic, style}; this requires special handling. *) transformgridlinefuncs[{a_,b_}, xfun_, yfun_] := Transpose[ {transformgridlinefuncs[a, xfun], transformgridlinefuncs[b, yfun]} ] transformgridlinefuncs[any_, xfun_, yfun_] := {any, Map[Last, {transformgridlinefuncs[Null, xfun], transformgridlinefuncs[Null, yfun]}] } transformgridlinefuncs[gf_, Automatic] := {gf, Automatic} transformgridlinefuncs[{Automatic, sty_}, tf_] := {Automatic, (Map[{First[#], Flatten[{sty}]}&, tf[#1, #2]]&)} transformgridlinefuncs[gf_, tf_] := {gf, (Map[First, tf[#1, #2]]&)} (* scaleplotrange is an auxilliary hack to fix the plot range problem; the range should be in scaled coordinates, not in original coordinates. This transforms them, with a separate transformation defined for each function. Not the ideal solution, but sufficient as a kludge... note that this introduces incompatability with any code that uses the old plot ranges... *) scaleplotrange[type:(LogPlot | LinearLogPlot | LogListPlot | LinearLogListPlot | LogListLinePlot | LinearLogListLinePlot), options_] := PlotRange -> Replace[PlotRange/.options/.Options[type], {y_?NumericQ :> {Full, log10[{y/100, y}]}, {x:(_List | _Symbol), y:(_List | _Symbol)} :> {x,log10[y]}, y_List :> log10[y]} ] scaleplotrange[type:(LogLinearPlot), options_] := PlotRange -> Replace[PlotRange/.options/.Options[type], {y_?NumericQ :> {Full, {-y, y}}, {x:(_List | _Symbol), y:(_List | _Symbol)} :> {log10[x], y}} ] scaleplotrange[type:(LogLinearListPlot | LogLinearListLinePlot), options_] := PlotRange -> Replace[PlotRange/.options/.Options[type], {y_?NumericQ :> {Full, {0, y}}, {x:(_List | _Symbol), y:(_List | _Symbol)} :> {log10[x], y}} ] scaleplotrange[type:(LogLogPlot | LogLogListPlot | LogLogListLinePlot), options_] := PlotRange -> Replace[PlotRange/.options/.Options[type], {y_?NumericQ :> {Full, log10[{y/100, y}]}, y_List :> log10[y]} ] SetAttributes[log10, Listable] log10[x_?NumericQ] := Log[10, x] log10[x_] := x (* myhold - this is a holding head that does nothing. It is the first piece of a nice chunk of cleverness (that I hope doesn't turn around and bite me) in ScaledPlot. *) SetAttributes[myhold, HoldAll] (* Scaled Plot *) (* here is the usage info for ScaledPlot, though it's not exported any longer; internal docs. *) (* ScaledPlot[cf, f, {x, xmin, xmax}] generates a plot of the function f \ with each coordinate scaled by a function specified by the ScaleFunction \ option. Error messages are attached to the symbol cf. ScaledListPlot[cf, data] generates a plot with each data point scaled \ by functions specified in the ScaleFunction option. Error messages \ are attached to the symbol cf. ScaleFunction is an option for ScaledPlot and ScaledListPlot. It \ is given as a pure function or a pair of pure functions; the \ first is applied to all x values, the second to all y values. *) Options[ScaledPlot] = {ScaleFunction -> (# &), DisplayFunction :> $DisplayFunction}; ScaledPlot[callfun_, funcs_List, {x_Symbol,xmin_,xmax_}, {_, fmin_, fmax_}, opts___?OptionQ] := Module[{scale, g, r, popts, xs, ys, ao, mapfun, plotfun, scalefun, arg, pr, fullxrangeq}, {scale, ao, pr} = {ScaleFunction, AxesOrigin, PlotRange}/. Flatten[{opts, Options[ScaledPlot]}]; popts = FilterOptions[ParametricPlot, Flatten[{opts}]]; origopts = FilterOptions[{DisplayFunction}, Flatten[{opts, Options[ScaledPlot]}]]; If[Head[scale] =!= List, scale = {scale, scale} ]; If[Length[scale] > 2, scale = Take[scale,2] ]; {xs, ys} = scale; fullxrangeq = (pr === Full || MatchQ[pr, {Full, _List} | {_?NumericQ, _?NumericQ}]); (* OK, here is the real cleverness. We have to carefully partially evaluate certain things, while preventing evaluation of other things until we are ready for them. We start by declaring a bunch of functions as HoldAll. Note that these function are all declared internal to ScaledPlot so they can be defined in terms of some variables local to ScaledPlot. I would not normally recommend this, but the tight control required over evaluation in this case demands it. *) SetAttributes[{mapfun, plotfun, scalefun}, HoldAll]; (* now, a the function that sets up the scaling. This can go wrong if a later substitution of a function to be plotted for arg is wrong after ys evaluates with arg. I expect that case to be uncommon; and doesn't apply to the funs that currently use ScaledPlot. *) scalefun[arg_] = Hold @@ {xs[x], ys[arg]}; (* next a function to perform the mapping while not evaluating anything before its time *) mapfun[arg_] := Map[scalefun, Unevaluated[arg]]; (* now define the plotting function in a single head *) plotfun[arg_] := ParametricPlot[arg, {x, xmin, xmax}, Evaluate[DisplayFunction -> Identity, popts] ]; g = plotfun @@ ((myhold @@ {mapfun[funcs]})/. Hold -> List); If[Head[g] =!= Graphics, Return[$Failed]]; r = PlotRange[g]; If[Head[r] === PlotRange, r = {{-1,1},{-1,1}}]; If[fullxrangeq, If[r[[1,1]] > fmin, r[[1,1]] = fmin]; If[r[[1,2]] < fmax, r[[1,2]] = fmax] ]; If[ao === Automatic, ao = {Automatic, Automatic}]; ao = {If[!NumericQ[First[ao]], r[[1,1]], xs[First[ao]]], If[!NumericQ[Last[ao]], r[[2,1]], ys[Last[ao]]]}; Show[g, origopts, PlotRange -> r, AxesOrigin -> ao ] ] ScaledPlot[cf_, f_, range_List, frange_, opts___?OptionQ]/;Not[ListQ[Unevaluated[f]]] := ScaledPlot[cf, {f}, range, frange, Evaluate[Sequence @@ fixplotstyle[ScaledPlot, opts]]] fixplotstyle[callfunc_, opts___] := Append[DeleteCases[Flatten[{opts}], _[PlotStyle,_]], PlotStyle -> (Which[# === Automatic, Automatic, !ListQ[#] || VectorQ[#], {#}, True, #]&[ (PlotStyle/.Flatten[{opts, Options[callfunc]}])]) ] (* Scaled List Plot *) ScaledListPlot::sptn = "Coordinate `1` is not a pair of numeric values."; Options[ScaledListPlot] = {ScaleFunction -> (# &), DisplayFunction :> $DisplayFunction}; ScaledListPlot[cf_, ipdata_List, opts___?OptionQ] := Module[{scale, g, r, xs, ys, lopts, disp, ao, origopts, pj, pfun, dr, pdata = ipdata}, {scale, ao, pj, dr} = {ScaleFunction, AxesOrigin, PlotJoined, DataRange}/. Flatten[{opts, Options[cf], PlotJoined -> False}]; If[TrueQ[pj], pfun = ListLinePlot, pfun = ListPlot]; lopts = FilterOptions[pfun, Flatten[{opts}]]; lopts = Sequence @@ DeleteCases[{lopts}, _[DataRange, _]]; origopts = FilterOptions[{DisplayFunction}, Flatten[{opts, Options[ScaledListPlot]}]]; pdata = datatopairs[pdata, dr, False]; If[Head[scale] =!= List, scale = {scale, scale} ]; If[Length[scale] > 2, scale = Take[scale,2] ]; {xs, ys} = scale; g = pfun[ Map[{xs[ #[[1]] ], ys[ #[[2]] ]}&, pdata, {2}], DisplayFunction -> Identity, lopts]; If[Head[g] =!= Graphics, Return[$Failed]]; r = PlotRange[g]; If[ao === Automatic, ao = {Automatic, Automatic}]; ao = {If[!NumericQ[First[ao]], r[[1,1]], xs[First[ao]]], If[!NumericQ[Last[ao]], r[[2,1]], ys[Last[ao]]]}; Show[g, origopts, PlotRange -> r, AxesOrigin -> ao ] ] (* fill out data lists given DataRange option *) (* note, following is pretty ugly, needs some refactoring to make it cleaner... possibly swap out the 'pflag' dependencies in a nicer fashion... *) datatopairs[data_, idr_, pflag_] := Module[{len, pdata = data, dr = idr}, If[VectorQ[pdata], pdata = {pdata}]; If[dr =!= All && MatrixQ[pdata] && Length[First[pdata]] == 2, pdata = {pdata} ]; (* ****** a design issue re DataRange is still not clear. The following implements my original understanding of the design; but it doesn't match the implementation elsewhere. So, I'm commenting it out, and following it with the version according to current implement. Note that this affects PolarListPlot behavior, which will map differently depending on the design. *) (* len = Max[Map[If[VectorQ[#], Length[#], 0]&, pdata]]; If[len != 0, If[MatchQ[dr, {_?NumericQ, _?NumericQ}] && dr[[2]] > dr[[1]], dr = Range[dr[[1]], dr[[2]], (dr[[2]] - dr[[1]])/(len - 1)], If[pflag, (* polar data case *) dr = Range[0, len - 1] * (2 Pi)/len, dr = Range[len] ] ]; pdata = Map[If[VectorQ[#], If[pflag, Transpose[{#, Take[dr, Length[#]]}], Transpose[{Take[dr, Length[#]], #}] ], #]&, pdata] ]; *) pdata = Map[If[VectorQ[#], If[pflag, Transpose[{#, Range[0, Length[#] - 1] * (2 Pi)/Length[#]}], Transpose[{Range[Length[#]], #}] ], #]&, pdata]; If[MatchQ[dr, {_?NumericQ, _?NumericQ}] && dr[[2]] > dr[[1]], {min, max} = {Min[#], Max[#]}&[If[pflag, Last, First][Transpose[Flatten[pdata,1]]]]; If[pflag, pdata = Map[{#[[1]], Rescale[#[[2]], {min, max}, dr]}&, pdata, {2}], pdata = Map[{Rescale[#[[1]], {min, max}, dr], #[[2]]}&, pdata, {2}] ] ]; DeleteCases[pdata, Except[{_?NumericQ, _?NumericQ}], {2}] ] (* PolarPlot *) (*SetAttributes[PolarPlot, HoldAll] Options[PolarPlot] = Options[ParametricPlot]; SetOptions[PolarPlot, AspectRatio -> Automatic]; PolarPlot[r_List, {t_, tmin_, tmax_}, opts___] := ParametricPlot[Evaluate[Transpose[{r Cos[t], r Sin[t]}]], {t, tmin, tmax}, Evaluate[FilterOptions[PolarPlot, opts, Options[PolarPlot]]] ] PolarPlot[r_, {t_, tmin_, tmax_}, opts___] := ParametricPlot[{r Cos[t], r Sin[t]}, {t, tmin, tmax}, Evaluate[FilterOptions[PolarPlot, opts, Options[PolarPlot]]] ] *) (* PolarListPlot *) (* ****** note: Filling needs to be radial, which will require additional effort to implement; putting off for now, so not using. *) Options[PolarListPlot] = DeleteCases[Options[ListPlot], _[(Filling | FillingStyle), _] ]; SetOptions[PolarListPlot, AspectRatio -> Automatic]; PolarListPlot[data_List, opts___?OptionQ] := (issueObsoleteFunMessage[PolarListPlot,"Graphics`Graphics`"]; With[{ret = plp[PolarListPlot, data, opts]}, ret/;Head[ret] === Graphics ]) Options[PolarListLinePlot] = DeleteCases[Options[ListLinePlot], _[(Filling | FillingStyle), _] ]; SetOptions[PolarListLinePlot, AspectRatio -> Automatic]; PolarListLinePlot[data_List, opts___?OptionQ] := (issueObsoleteFunMessage[PolarListLinePlot,"Graphics`Graphics`"]; With[{ret = plp[PolarListLinePlot, data, opts]}, ret/;Head[ret] === Graphics ]) plp[cf_, data_List, opts___?OptionQ] := Module[{dr, pdata, pf}, {dr} = {DataRange}/.Flatten[{opts, Options[cf]}]; pdata = datatopairs[data, dr, True]; pf = If[cf === PolarListPlot, ListPlot, ListLinePlot]; pf[ Apply[{#1 Cos[#2], #1 Sin[#2]}&, pdata, {2}], (* note: below would normally filter 'pf' options, not 'cf'; but cf is a subset of pf in this case. *) DeleteCases[Flatten[{FilterOptions[cf, opts, Options[cf]]}], _[DataRange, _]] ] ] (* ErrorListPlot *) Options[ErrorListPlot] = Developer`GraphicsOptions[]; SetOptions[ErrorListPlot, Axes -> Automatic, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True ]; ErrorListPlot[l2:{{_, _}..},opts___] := Module[ {i}, ErrorListPlot[ Table[Prepend[l2[[i]], i], {i, Length[l2]}] ,opts] ] ErrorListPlot[l3:{{_, _, _}..},opts___] := (issueObsoleteFunMessage[ErrorListPlot,"Graphics`Graphics`"]; Show[ Graphics[ { PointSize[0.015], Thickness[0.002], Module[ {i, x, y, dy} , Table[ {x, y, dy} = l3[[i]] ; { Line[ {{x, y-dy}, {x, y+dy}} ], Point[ {x, y} ] } , {i, Length[l3]} ] ] } ], opts,Sequence @@ Options[ErrorListPlot] ]) (* DisplayTogether and DisplayTogetherArray. These take a series of plot commands, and combine the resulting graphics to produce a single graphic, rather than the output of the individual commands. The constraint is that all commands must be able to be shown together via Show, or within a GraphicsArray (for DisplayTogetherArray). This functionality is obsolete in V6. *) $displaytogethermsgflag = False; DisplayTogether::obslt = DisplayTogetherArray::obslt = "The DisplayTogether and DisplayTogetherArray functions are obsolete \ in Version 6. GraphicsArray and Show may be used directly in the \ same role."; Options[DisplayTogether] = {DisplayFunction :> $DisplayFunction}; Attributes[DisplayTogether] = {HoldAll}; DisplayTogether[plots__, opts:(_Rule | _RuleDelayed)...] := (issueObsoleteFunMessage[DisplayTogether,"Graphics`Graphics`"]; (If[!$displaytogethermsgflag, Message[DisplayTogether::obslt]; $displaytogethermsgflag = True ]; Show[suppressdisplay[{plots}], opts, FilterOptions[{DisplayFunction}, Options[DisplayTogether]]])) Options[DisplayTogetherArray] = {DisplayFunction :> $DisplayFunction}; Attributes[DisplayTogetherArray] = {HoldAll}; DisplayTogetherArray[plots__, opts:(_Rule | _RuleDelayed)...] := (issueObsoleteFunMessage[DisplayTogetherArray,"Graphics`Graphics`"]; Module[{res = suppressdisplay[{plots}]}, If[!$displaytogethermsgflag, Message[DisplayTogetherArray::obslt]; $displaytogethermsgflag = True ]; If[Length[res] === 1 && Head[First[res]] === List, res = First[res] ]; Show[GraphicsArray[res], opts, FilterOptions[{DisplayFunction}, Options[DisplayTogether]]] ]) Attributes[suppressdisplay] = {HoldAll}; (* this works by temporarily overriding DisplayFunction and attaching upvalues to it that transform any rule involving DisplayFunction to transform to Identity. It also overrides Display just as a backup. *) suppressdisplay[expr_] := Block[{DisplayFunction, Display = (#2&)}, DisplayFunction /: (DisplayFunction -> any_) := (DisplayFunction -> Identity) /; any =!= Identity; DisplayFunction /: (DisplayFunction :> any_) := (DisplayFunction -> Identity) /; any =!= Identity; expr ] (* List and Curve Plot. This function generates plots combining data and curves. *) Options[ListAndCurvePlot] = {PlotStyle -> Automatic}; ListAndCurvePlot[data__,range:{_Symbol,_,_}, opts___?OptionQ] := (issueObsoleteFunMessage[ListAndCurvePlot,"Graphics`Graphics`"]; Module[{ps, lpopts, popts, gopts, origopts}, {ps} = {PlotStyle}/.{opts}/.Options[ListAndCurvePlot]; origopts = FilterOptions[{DisplayFunction}, Flatten[{Options[ListAndCurvePlot], Developer`GraphicsOptions[]}]]; lpopts = FilterOptions[ListPlot,opts]; popts = FilterOptions[Plot, opts]; gopts = FilterOptions[Graphics, opts]; If[ps === Automatic || ps === {}, ps = {GrayLevel[0]}]; ps = CycleValues[ps, Length[{data}]]; plots = MapThread[If[MatchQ[#1,{__?(NumberQ[N[#]]&)} | {{__?(NumberQ[N[#]]&)}..}], ListPlot[#1, DisplayFunction -> Identity, PlotStyle -> #2, lpopts], Plot[#1, range, DisplayFunction -> Identity, PlotStyle -> {#2}, Evaluate[popts]] ]&, {{data},ps}]; Show[plots, gopts, origopts] ]) (* BarCharts - BarChart, GeneralizedBarChart, StackedBarChart, PercentileBarChart. with the internal RectanglePlot and small utilities *) (* RectanglePlot *) Options[RectanglePlot] = {RectangleStyle -> Automatic, EdgeStyle -> Automatic, ObscuredFront -> False} ~Join~ Developer`GraphicsOptions[]; SetOptions[RectanglePlot, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True ]; RectanglePlot[boxes:{{{_?numberQ,_?numberQ},{_?numberQ,_?numberQ}}..}, opts___?OptionQ] := Module[{ln = Length[boxes], bsytle, estyle, gopts}, (* Handle options and defaults *) {bstyle, estyle,sort} = {RectangleStyle, EdgeStyle, ObscuredFront}/.Flatten[{opts, Options[RectanglePlot]}]; gopts = FilterOptions[Graphics, {opts, Options[RectanglePlot]}]; If[bstyle === Automatic, bstyle = Map[Hue,.6 Range[0, ln - 1]/(ln - 1)]]; If[bstyle === None, bstyle = {}]; If[estyle === Automatic, estyle = {GrayLevel[0]}]; If[estyle === None, estyle = {}]; bstyle = CycleValues[bstyle,ln]; estyle = CycleValues[estyle,ln]; (* generate shapes *) recs = If[bstyle === {}, Table[{},{ln}], Transpose[{bstyle, Apply[Rectangle, boxes,{1}]}]]; lrecs = If[estyle === {}, Table[{},{ln}], Transpose[{estyle, Map[LineRectangle, boxes]}]]; (* sort 'em *) recs = Map[Flatten, If[TrueQ[sort], Sort[Transpose[{recs,lrecs}], coversQ], Transpose[{recs, lrecs}] ], {2} ]; (* show 'em *) Show[Graphics[recs],gopts] ] RectanglePlot[boxes:{{_?numberQ,_?numberQ}..}, opts___] := RectanglePlot[Map[{#, # + 1}&,boxes],opts] LineRectangle[pts:{{x1_,y1_}, {x2_,y2_}}] := Line[{{x1,y1},{x1,y2},{x2,y2},{x2,y1},{x1,y1}}] coversQ[{{___,Rectangle[{x11_,y11_}, {x12_,y12_}]},___}, {{___,Rectangle[{x21_,y21_}, {x22_,y22_}]},___}] := N[And[x11 <= x21 <= x12, x11 <= x22 <= x12, y11 <= y21 <= y12, y11 <= y22 <= y12]] coversQ[___] := True (* Histogram *) (* Histogram does not have the BarChart options BarSpacing, BarGroupSpacing, and BarValues. The option HistogramCategories functions like the option PlotPoints (except that it also allows category boundaries to be specified); HistogramRange functions like PlotRange. *) Histogram::ticks = "`` is not a valid tick specification. Taking Ticks->Automatic."; Histogram::hcat = "`` is not a valid histogram categories specification. Taking \ HistogramCategories->Automatic."; Histogram::rcount = "Frequency count of data in categories failed."; Histogram::realvec="The first argument to Histogram is expected to be a vector of real values."; Histogram::noapprox = "ApproximateIntervals -> `` is a not a valid setting when \ HistogramCategories->{c1, c2, ..., cm}. Taking ApproximateIntervals -> False."; Histogram::ltail1 = "Warning: One point from the left tail of the data, strictly less than `1`, \ is not included in histogram."; Histogram::ltail = "Warning: `1` points from the left tail of the data, strictly less than `2`, \ are not included in histogram."; Histogram::rtail1 = "Warning: One point from the right tail of the data, greater than or equal \ to `1`, is not included in histogram."; Histogram::rtail = "Warning: `1` points from the right tail of the data, greater than or equal \ to `2`, are not included in histogram."; Histogram::range = "Warning: `` is not a valid setting for HistogramRange. \ Taking HistogramRange -> Automatic."; Histogram::fdhc = "Warning: `` is not a valid setting for HistogramCategories when \ FrequencyData -> True. When the data represents frequencies, \ HistogramCategories should specify Automatic or a list of cutoffs. \ Taking HistogramCategories -> Automatic."; Histogram::fdfail = "When FrequencyData -> True and HistogramCategories -> cutoffs, the \ length of the cutoffs vector should be exactly one more than the length \ of the frequency data."; Options[Histogram] = { ApproximateIntervals -> Automatic, BarEdges -> True, (* opt of GeneralizedBarChart *) BarEdgeStyle -> GrayLevel[0], (* opt of GeneralizedBarChart *) BarOrientation -> Vertical, (* opt of GeneralizedBarChart *) BarStyle -> Automatic, (* opt of GeneralizedBarChart *) FrequencyData -> False, HistogramCategories -> Automatic, HistogramRange -> Automatic, HistogramScale -> Automatic } ~Join~ Developer`GraphicsOptions[]; SetOptions[Histogram, Ticks -> Automatic, Axes -> True, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True ]; (* Note: Histogram calls an internal RangeCounts variant to compute frequencies and GeneralizedBarChart for plotting. *) Histogram[list_?VectorQ, opts___?OptionQ] := (* use of numericalization here is somewhat questionable; I don't *think* it will break any practical use, but keep an eye on it. It's necessary for efficient computation later on, though. *) (issueObsoleteFunMessage[Histogram,"Graphics`Graphics`"]; With[{res = histogram[N[list], opts]}, res/; res =!= $Failed ]) histogram[list_, opts___] := Module[{approximate, bedges, bedgestyle, borien, bstyle, fdata, hcat, range, scale, ticks, countdata, numberOfBins, dmin, dmax, datamin, datamax, (* min and max as determined by the data and the option HistogramRange *) cutoffs, fixedbins = False, binmin, binmax, (* min and max as determined by bin boundaries *) totalcount, leftTailCount, rightTailCount, binwidths, bincenters, autoticks, autolength, (* automatic setting for ticks *) caxisticks, (* category axis ticks ... can be x or y axis depending on BarOrientation *) phwdata, (* position-height-width data for GeneralizedBarChart *) orig, rng, (* settings for AxesOrigin, PlotRange *) gropts, groptslist, area (* area of histogram; used for scaling non-category axis so that histogram has unit area *) }, (* Histogram only handles real numeric data, so issue a message and return unevaluated if non-real values are present *) If[Not[TrueQ[Element[list, Reals]]], Message[Histogram::realvec];Return[$Failed]]; {approximate, bedges, bedgestyle, borien, bstyle, fdata, hcat, range, scale, ticks} = {ApproximateIntervals, BarEdges, BarEdgeStyle, BarOrientation, BarStyle, FrequencyData, HistogramCategories, HistogramRange, HistogramScale, Ticks} /. Flatten[{opts,Options[Histogram]}]; (* sanity check: if this is frequency data, and HistogramCategories gives explicit bins, then the number of bins must match the number of data quantities. *) If[TrueQ[fdata] && VectorQ[hcat] && (Length[list] + 1 != Length[hcat]), Message[Histogram::fdfail]; Return[$Failed] ]; (* check value of 'range' *) If[range =!= Automatic && !MatchQ[range, {_?NumberQ | Automatic, _?NumberQ | Automatic}], range = Automatic ]; (* Define countdata, numberOfBins, binmin, binmax, cutoffs. *) If[TrueQ[fdata], (* ===================================================== *) (* PROCESS LIST assuming that it represents FREQUENCIES. *) (* ===================================================== *) countdata = list; numberOfBins = Length[countdata]; (* Error check for HistogramCategories setting. *) If[!(hcat === Automatic || monotoneIncreasingVectorQ[hcat]), Message[Histogram::fdhc, hcat]; hcat = Automatic]; {datamin, datamax} = findRange[range, If[hcat === Automatic, {0, numberOfBins}, {Min[hcat], Max[hcat]}] ]; If[hcat === Automatic, cutoffs = datamin + (datamax-datamin)/numberOfBins * Range[0, numberOfBins], cutoffs = findCutoffs1[hcat, datamin, datamax, countdata]; numberOfBins = Length[cutoffs]-1 ]; {binmin, binmax} = {First[cutoffs], Last[cutoffs]}, (* ===================================================== *) (* PROCESS LIST assuming that it represents RAW DATA. *) (* ===================================================== *) (* Define min and max of range, and count data in range. *) {dmin, dmax} = {Min[list], Max[list]}; {datamin, datamax} = findRange[range, {dmin, dmax}]; If[datamin <= dmin && datamax >= dmax, totalcount = Length[list], totalcount = With[{d1 = datamin, d2 = datamax}, Compile[{{l, _Real, 1}}, Module[{count = 0, n}, Do[If[d1 <= l[[n]] <= d2, count++], {n, Length[l]}]; count ] ][list] ] ]; (* Define category cutoffs for raw data. *) cutoffs = findCutoffs2[hcat, datamin, datamax, totalcount, approximate]; (* Note: the following is a bit of a hack, used in preference to doing a major rewrite of the code. It is useful for some later efficiency hacks to know whether we have evenly-sized bins or not; this could be determined by point changes in findCutoffs2. *) If[Head[cutoffs] === binrange, fixedbins = cutoffs; cutoffs = cutoffs[[1]] + cutoffs[[3]] * Range[0, Round[(cutoffs[[2]] - cutoffs[[1]])/cutoffs[[3]]]] ]; numberOfBins = Length[cutoffs]-1; (* Note that RangeCounts considers intervals of the form {binmin <= x < etc, ..., etc <= x < binmax}. *) {binmin, binmax} = {First[cutoffs], Last[cutoffs]}; (* Compute category counts for raw data. *) countdata = If[Head[fixedbins] === binrange, bincounts[list, fixedbins], RangeCounts[list, cutoffs] ]; If[!ListQ[countdata], Message[Histogram::rcount];Return[$Failed] ]; (* Warning messages for points not plotted, if histogram range was determined automatically. *) If[(range === Automatic || First[range] === Automatic) && First[countdata] > 0, If[First[countdata] === 1, Message[Histogram::ltail1, binmin], Message[Histogram::ltail, First[countdata], binmin] ] ]; If[(range === Automatic || Last[range] === Automatic) && Last[countdata] > 0, If[Last[countdata] === 1, Message[Histogram::rtail1, binmax], Message[Histogram::rtail, Last[countdata], binmax] ] ]; (* Length of data should be numberOfBins+2. Eliminate first and last elements of data corresponding to the ranges x < binmin and x >= binmax. *) countdata = Take[countdata, {2, -2}] ]; (* end If TrueQ[fdata] *) (* ============================================================= *) (* ============================================================= *) (* Use countdata, cutoffs, numberOfBins, binmin, and binmax to *) (* generate histogram. *) (* ============================================================= *) (* ============================================================= *) (* ================= Scale category counts. ================ *) (* Here we choose to normalize so that the height of the tallest *) (* bar is unchanged. To normalize to get unit area, you need to *) (* set HistogramScale -> 1. *) binwidths = Drop[cutoffs, 1] - Drop[cutoffs, -1]; If[TrueQ[scale] || ((scale === Automatic) && !(hcat === Automatic || IntegerQ[hcat] || (0.0001 > Abs[Max[binwidths]/Min[binwidths] - 1]))), (* Make the area of the bar proportional to the frequency associated with the bar. *) countdata = countdata/binwidths ]; bincenters = Drop[FoldList[Plus, binmin, binwidths], -1] + 1/2 binwidths; (* =============================================================== *) (* Define category axis ticks from *) (* bincenters, countdata, and ticks. *) (* =============================================================== *) autoticks = LinearScale[binmin, binmax, 7]; autolength = Length[autoticks]; (* Process the Ticks setting. *) If[MatchQ[ticks, Automatic | IntervalCenters | IntervalBoundaries], ticks = {ticks, Automatic}]; If[ticks === None, ticks = {None, None}]; (* Check the Ticks setting, and reset to Automatic if the setting is illegal. *) If[!(ListQ[ticks] && Length[ticks] == 2 && ticksCheckQ[ticks]), Message[Histogram::ticks, ticks]; ticks = {Automatic, Automatic}]; caxisticks = Switch[ticks[[1]], _?ListQ, (* ticksCheckQ has already checked for monotoneIncreasingVectorQ *) Map[neatTick, ticks[[1]] ], IntervalBoundaries, ( trim[ Map[neatTick, cutoffs], autolength] ), IntervalCenters, ( trim[ Map[neatTick, bincenters], autolength] ), None, (* no category axis ticks *) None, _, (* place category axis ticks automatically *) autoticks ]; ticks = {caxisticks, ticks[[2]]}; (* =============================================================== *) (* ======= Define phwdata (position, height, width). ============= *) (* =============================================================== *) (* Note that BarGroupSpacing is assumed to be 0 here. If you want *) (* to add that option to Histogram, the option should be *) (* processed here. (Some would say that histograms of discrete data *) (* ought to have columns separated from each other, i.e., with *) (* BarGroupSpacing greater than zero.) *) phwdata = Transpose[{bincenters, countdata, binwidths}]; (* =========== Define settings for AxesOrigin & PlotRange. ======== *) (* First category is from bincenters[[1]]-1/2 binwidths[[1]] (= First[cutoffs]) to bincenters[[1]]+1/2 binwidths[[1]]... Adjust origin so that first category lines up with vertical axis. *) orig = {First[cutoffs], 0}; rng = {{First[cutoffs], Last[cutoffs]}, All}; If[borien === Horizontal, ticks = Reverse[ticks]; orig = Reverse[orig]; rng = Reverse[rng]]; (* =========== Extract any other options relevent to Graphics. ==== *) gropts = FilterOptions[Graphics, {opts, Options[Histogram]}]; groptslist = DeleteCases[{gropts}, _[Ticks,_]]; (* ======= Scale bar heights according to HistogramScale -> k ====== *) (* NOTE that phwdata has the form... { {pos1, height1, width1}, {pos2, height2, width2}, ...} *) If[NumberQ[scale] && FreeQ[scale, Complex] && scale > 0, area = Total[phwdata[[All,2]]]; phwdata = Map[{#[[1]], #[[2]]/area * scale/#[[3]], #[[3]]}&, phwdata] ]; (* ================== GeneralizedBarChart call ===================== *) GeneralizedBarChart[phwdata, AxesOrigin -> orig, (* option of Graphics *) BarEdges -> bedges, (* option of GeneralizedBarChart *) BarEdgeStyle -> bedgestyle, (* option of GeneralizedBarChart *) BarOrientation -> borien, (* option of GeneralizedBarChart *) BarStyle -> bstyle, (* option of GeneralizedBarChart *) PlotRange -> rng, (* option of Graphics *) Ticks -> ticks, (* option of Graphics *) (* groptslist includes any other options relevent to Graphics *) Apply[Sequence, groptslist] ] ] (* end Histogram *) (* Interpret the HistogramCategories option when the data is frequency data. *) findCutoffs1[hcat_, datamin_, datamax_, data_] := Module[{countdata = data, cutoffs = hcat, n}, (* If range specifies something more restrictive than the given categories, then trim cutoffs. *) If[datamin >= First[cutoffs], While[!(cutoffs[[1]] <= datamin < cutoffs[[2]]), countdata = Drop[countdata, 1]; cutoffs = Drop[cutoffs, 1]] ]; If[datamax < Last[cutoffs], While[!(n = Length[cutoffs]; cutoffs[[n-1]] <= datamax < cutoffs[[n]]), countdata = Drop[countdata, -1]; cutoffs = Drop[cutoffs, -1]] ]; cutoffs ] (* end findCutoffs1 *) (* Interpret the HistogramCategories option when the data is raw data. *) findCutoffs2[hcat_, datamin_, datamax_, totalcount_, approximate_] := Module[{numberOfBins, cutoffs, binmin, binmax, bindelta}, If[monotoneIncreasingVectorQ[hcat], (* Intervals are NOT approximated when they are specifically requested using HistogramCategories. *) If[!(approximate===Automatic || approximate===False), Message[Histogram::noapprox, approximate]]; cutoffs = hcat; (* If range specifies something more restrictive than the given categories, then trim cutoffs. *) If[datamin >= First[cutoffs], While[!(cutoffs[[1]] <= datamin < cutoffs[[2]]), cutoffs = Drop[cutoffs, 1]] ]; If[datamax < Last[cutoffs], While[!(n = Length[cutoffs]; cutoffs[[n-1]] <= datamax < cutoffs[[n]]), cutoffs = Drop[cutoffs, -1]] ], (* ====================================================== *) (* hcat === Automatic || PositiveIntegerQ[hcat] *) If[PositiveIntegerQ[hcat], numberOfBins = hcat, (* hcat === Automatic *) numberOfBins = Sqrt[totalcount] ]; If[approximate === Automatic || TrueQ[approximate], (* make the intervals approximate and make them neat *) {binmin, binmax, bindelta} = approximateIntervals[datamin, datamax, numberOfBins]; numberOfBins = Round[(binmax-binmin)/bindelta], (* make the cutoffs exact, ignore neatness *) numberOfBins = Round[numberOfBins]; {binmin, binmax, bindelta} = {datamin, datamax, (datamax-datamin)/numberOfBins} ]; (* cutoffs = binmin + bindelta Range[0, numberOfBins] *) cutoffs = binrange[binmin, binmax, bindelta]; ]; (* end If monotoneIncreasingVectorQ[hcat] *) cutoffs ] (* end findCutoffs2 *) neatTick[t_] := If[TrueQ[Round[t]==t], Round[t], If[Head[t] === Rational, N[t], t]] (* interpret the HistogramRange option *) findRange[range_, {imin_, imax_}] := Module[{min = imin, max = imax}, ( max += 10 $MachineEpsilon; (* this is done so that the maximum data point is included in an interval that is closed on the left and open on the right *) Switch[range, Automatic | {Automatic, Automatic}, {min, max}, {l_?NumberQ, u_?NumberQ} /; FreeQ[{l, u}, Complex] && l < u, range, {l_?NumberQ, Automatic} /; FreeQ[l, Complex] && l < max, {range[[1]], max}, {Automatic, u_?NumberQ} /; FreeQ[u, Complex] && min < u, {min, range[[2]]}, _, (Message[Histogram::range, range]; {min, max}) ] ) ] (* Modify a tick list {t1, t2, ...} so that approximately n or fewer ticks have labels attached. This is done so that labels do not overlap in a plot. *) trim[tlist_, n_] := Module[{l = Length[tlist], delta, k, result = {}}, delta = Round[l/n]; If[l <= n || delta == 1, tlist, If[EvenQ[l], (* simply pick ticks starting from leftmost tick *) k = 1; While[k <= l, If[Mod[k-1, delta] == 0, AppendTo[result, tlist[[k]]], AppendTo[result, {tlist[[k]], ""}] ]; k++ ], (* pick ticks such that the center tick of tlist is included *) k = (l+1)/2; While[k <= l, If[Mod[k-(l+1)/2, delta] == 0, AppendTo[result, tlist[[k]]], AppendTo[result, {tlist[[k]], ""}] ]; k++ ]; k = (l+1)/2 - delta; While[k >= 1, If[Mod[k-((l+1)/2-delta), delta] == 0, PrependTo[result, tlist[[k]]], PrependTo[result, {tlist[[k]], ""}] ]; k-=delta ] ]; result ] ] (* end trim *) ticksCheckQ[{x_, y_}] := (x === None || x === Automatic || monotoneIncreasingVectorQ[x] || x === IntervalBoundaries || x === IntervalCenters) && (y === None || y === Automatic || monotoneIncreasingVectorQ[y]) monotoneIncreasingVectorQ[x_] := Module[{positions}, positions = If[VectorQ[x], x, Map[If[ListQ[#], First[#], #]&, x] ]; VectorQ[positions, NumberQ] && FreeQ[positions, Complex] && Apply[Less, positions] ] (* the following does the equivalent of BinCounts, albeit with less error-checking, since that is taken care of in the function call above. Also, this variant returns counts for data less than and greater than the range. A counting function is separated out and compiled for the 'rangecount' equivalent; the whole of the function is compiled for bincounts, except for a redirection which strips out the 'binrange' header that is used above to identify uniformly-sized bins in a range-like syntax. *) countfunc = Compile[{{dat, _Integer, 1}, {bincount, _Integer}}, Module[{bins = Table[0, {bincount}], i}, Do[bins[[dat[[i]]]] += 1, {i, Length[dat]}]; bins ]]; (* note use of Round in nbin computation assumes that range limits are on integer bounds within numerical error. If this function is called generically, then the assumption may not be quite right, and Ceiling would be better. *) bincountfunc = Compile[{{dat, _Real, 1}, {min, _Real}, {max, _Real}, {incr, _Real}}, Module[{nbin = Round[(max - min)/incr], vals = Floor[(dat - min)/incr] + 2, bins, thisval = 0}, bins = Table[0, {nbin + 2}]; Do[thisval = vals[[i]]; Which[thisval < 1, bins[[1]] += 1, thisval > nbin + 1, bins[[nbin + 2]] += 1, True, bins[[thisval]] += 1 ], {i, Length[dat]} ]; bins ] ]; bincounts[dat_, binrange[min_, max_, incr_]] := bincountfunc[dat, min, max, incr] (* approximateIntervals[min, max, numOfInt] defines a set of approximately numOfInt intervals, covering the range {min, max}, and having boundaries expressible in terms of simple numbers. *) approximateIntervals[min_, max_, numOfInt_] := Module[{nmin = N[min], nmax = N[max], spacing, t, nicebins, first, last, delta}, (* start with handling the cases of only one interval desired, or min and max being so close together that having multiple bins doesn't make sense; user can override with specific bins if this exceptional case is actually desired. *) If[numOfInt===1, spacing=If[# == 0., 1, #]&[max-min]; Return[{min - 0.2 spacing, max + 0.2 spacing, 1.5 spacing}] ]; If[Abs[(max - min)/(spacing = If[# == 0., 1, #]&[Max[Abs[{min, max}]]])] < 10^-5, spacing = 0.2 spacing; Return[{min - 1.5 spacing, min + 1.5 spacing, spacing}] ]; (* ======= The following code is similar to LinearScale. ===== *) (* It uses TickSpacing[, Nearest], rather than the default TickSpacing[, GreaterEqual]. *) spacing = TickSpacing[nmax-nmin, numOfInt, {1, 2, 2.5, 5, 10}, Nearest]; t = Range[Ceiling[nmin/spacing - 0.05] spacing, max, spacing] ; (* need at least two bins *) If[Length[t]==1, t=Join[t, t+spacing]]; nicebins = Map[{#, If[Round[#]==#, Round[#], #]}&, t]; (* =========================================================== *) {first, last} = {First[nicebins][[1]], Last[nicebins][[1]]}; delta = nicebins[[2, 1]]-first; (* If x < first, then x will not be counted in an interval {first <= x < first + delta}. If x >= last, then x will not be counted in an interval. {last - delta <= x < last. Keep adding intervals until all points min <= x <= max are counted. *) While[min < first || max >= last, (* Make sure that min and max are included in default categories. *) If[min < first, nicebins = Join[ Map[{#, If[Round[#]==#, Round[#], #]}&, {first-delta}], nicebins] ]; If[max >= last, nicebins = Join[ nicebins, Map[{#, If[Round[#]==#, Round[#], #]}&, {last+delta}]] ]; {first, last} = {First[nicebins][[1]], Last[nicebins][[1]]} ]; {first, last, delta} ] PositiveIntegerQ[n_] := IntegerQ[n] && n > 0 (* Bar Chart *) Clear[BarChart] Options[BarChart] = Sort[ {BarStyle -> Automatic, BarSpacing -> Automatic, BarGroupSpacing -> Automatic, BarLabels -> Automatic, BarValues -> False, BarEdges -> True, BarEdgeStyle -> GrayLevel[0], BarOrientation -> Vertical} ~Join~ Developer`GraphicsOptions[] ]; SetOptions[BarChart, Axes -> True, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True ]; BarChart[idata:{_?numberQ..}.., opts___?OptionQ] := (issueObsoleteFunMessage[BarChart,"Graphics`Graphics`"]; Module[{data, ln = Length[{idata}], ticks, orig,rng, lns = Map[Length,{idata}], bs, bgs, labels, width,gbopts}, {bs,bgs,labels,orient} = {BarSpacing, BarGroupSpacing, BarLabels, BarOrientation}/. Flatten[{opts, Options[BarChart]}]; gbopts = FilterOptions[GeneralizedBarChart, Options[BarChart]]; bs = N[bs]; bgs = N[bgs]; If[bs === Automatic, bs = 0]; If[bgs === Automatic, bgs = .2]; Which[labels === Automatic, labels = Range[Max[lns]], labels === None, Null, labels === {}, labels = None, True, labels = CycleValues[labels,Max[lns]] ]; width = (1 - bgs)/ln; data = MapIndexed[ {#2[[2]] + width (#2[[1]] - 1), #1, width - bs}&, {idata},{2}]; If[labels =!= None, ticks = {Transpose[{ Range[Max[lns]] + (ln - 1)/2 width, labels, Table[0, {Max[lns]}]}], Automatic}, (* else *) ticks = {None, Automatic}; ]; orig = {1 - width/2 - bgs,0}; rng = {{1 - width/2 - bgs, Max[lns] + (ln - 1/2) width + bgs}, All}; If[orient === Horizontal, ticks = Reverse[ticks]; orig = Reverse[orig]; rng = Reverse[rng]]; GeneralizedBarChart[Sequence @@ data, opts, Ticks -> ticks, AxesOrigin -> orig, PlotRange -> rng, FrameTicks -> ticks, gbopts] ]) (* For compatability only... *) BarChart[list:{{_?numberQ, _}..}, opts___?OptionQ] := Module[{lab,dat}, {dat, lab} = Transpose[list]; BarChart[dat, opts, BarLabels -> lab] ] BarChart[list:{{_?numberQ, _, _}..}, opts___?OptionQ] := Module[{lab, sty, dat}, {dat, lab, sty} = Transpose[list]; BarChart[dat, opts, BarLabels -> lab, BarStyle -> sty] ] (* GeneralizedBarChart *) Options[GeneralizedBarChart] = Sort[ {BarStyle -> Automatic, BarValues -> False, BarEdges -> True, BarEdgeStyle -> GrayLevel[0], BarOrientation -> Vertical} ~Join~ Developer`GraphicsOptions[] ]; SetOptions[GeneralizedBarChart, Axes -> True, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True ]; GeneralizedBarChart::badorient = "The value given for BarOrientation is invalid; please use \ Horizontal or Vertical. The chart will be generated with \ Vertical."; GeneralizedBarChart[idata:{{_?numberQ,_?numberQ,_?numberQ}..}.., opts___?OptionQ] := (issueObsoleteFunMessage[GeneralizedBarChart,"Graphics`Graphics`"]; Module[{data = {idata}, bsty, val, vpos, unob, edge, esty, bsf, orient, ln = Length[{idata}], lns = Map[Length,{idata}], bars, disp, pr, origopts}, (* Get options *) {bsty, val, edge, esty, orient, pr} = {BarStyle, BarValues, BarEdges, BarEdgeStyle, BarOrientation, PlotRange}/. Flatten[{opts, Options[GeneralizedBarChart]}]; origopts = FilterOptions[{DisplayFunction}, Flatten[{opts, Options[GeneralizedBarChart]}]]; gopts = FilterOptions[Graphics,{opts, Options[GeneralizedBarChart]}]; (* Handle defaults and error check options *) If[bsty =!= Automatic && Head[bsty] =!= List && !MatchQ[bsty, (Hue | RGBColor | GrayLevel | CMYKColor)[__?NumberQ] ], bsty = Join @@ Map[bsty[#[[2]]]&,data,{2}], bsty = barcoloring[bsty, ln, lns] ]; If[TrueQ[edge], If[ln === 1, esty = CycleValues[esty, Length[First[data]]], esty = Join @@ MapThread[Table[#1,{#2}]&, {CycleValues[esty,ln], lns}] ], esty = None ]; If[!MemberQ[{Horizontal, Vertical},orient], Message[GeneralizedBarChart::badorient,orient]; orient = Vertical ]; val = TrueQ[val]; vpos = .05; (* was an option, position of value label; now hardcoded at swolf recommendation. *) (* generate bars and labels, call RectanglePlot *) data = Flatten[data,1]; bars = Map[barcoords[orient],data]; If[val, Show[RectanglePlot[bars, RectangleStyle -> bsty, EdgeStyle -> esty, DisplayFunction -> Identity], Graphics[Map[varcoords[orient,vpos,(#&)],data]], If[pr === Automatic, PlotRange -> All, PlotRange -> pr ], origopts, gopts ], (* else *) RectanglePlot[bars, RectangleStyle -> bsty, EdgeStyle -> esty, ObscuredFront -> unob, gopts] ] ]) (* fallthrough for empty data set *) GeneralizedBarChart[{}, opts___] := (issueObsoleteFunMessage[GeneralizedBarChart,"Graphics`Graphics`"]; Show[Graphics[{}, FilterOptions[Graphics, {opts, Options[GeneralizedBarChart]}]] ]) barcoords[Horizontal][{pos_,len_,wid_}] := {{0,pos - wid/2},{len,pos + wid/2}} barcoords[Vertical][{pos_,len_,wid_}] := {{pos - wid/2, 0},{pos + wid/2, len}} varcoords[Horizontal,offset_,format_][{pos_,len_,wid_}] := Text[format[len], Scaled[{(Sign[len]/. (0 ->1)) offset, 0}, {len, pos}]] varcoords[Vertical,offset_,format_][{pos_,len_,wid_}] := Text[format[len], Scaled[{0,(Sign[len]/.(0 -> 1)) offset}, {pos,len}]] barcoloring[Automatic, 1, _] := {Hue[0]} barcoloring[Automatic, ln_, lns_] := Join @@ MapThread[Table[#1,{#2}]&, {Map[Hue[.6 #/(ln - 1)]&, Range[0, ln - 1]], lns}] barcoloring[bsty_, 1, lns_] := CycleValues[bsty, First[lns]] barcoloring[bsty_, ln_, lns_] := Join @@ MapThread[Table[#1,{#2}]&, {CycleValues[bsty, ln], lns}] (* StackedBarChart *) Options[StackedBarChart] = Sort[ {BarStyle -> Automatic, BarSpacing -> Automatic, BarLabels -> Automatic, BarEdges -> True, BarEdgeStyle -> GrayLevel[0], BarOrientation -> Vertical} ~Join~ Developer`GraphicsOptions[] ]; SetOptions[StackedBarChart, Axes -> True, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True ]; StackedBarChart::badorient = "The value given for BarOrientation is invalid; please use \ Horizontal or Vertical. The chart will be generated with \ Vertical."; StackedBarChart::badspace = "The value `1` given for the BarSpacing option is invalid; \ please enter a number or Automatic."; StackedBarChart[idata:{_?numberQ..}.., opts___?OptionQ] := (issueObsoleteFunMessage[StackedBarChart,"Graphics`Graphics`"]; Module[{data = {idata}, sty, space, labels, bv, bvp, edge, esty, orient, ln = Length[{idata}], add, tmp, lns = Map[Length, {idata}], ticks, fticks, orig, rng}, (* process options *) {sty, space, labels, edge, esty, orient, orig, rng, ticks, fticks} = {BarStyle, BarSpacing, BarLabels, BarEdges, BarEdgeStyle, BarOrientation, AxesOrigin, PlotRange, Ticks, FrameTicks}/. Flatten[{opts, Options[StackedBarChart]}]; sty = barcoloring[sty, ln, lns]; If[TrueQ[edge], If[ln === 1, esty = CycleValues[esty, First[lns]], esty = Join @@ MapThread[Table[#1,{#2}]&, {CycleValues[esty,ln], lns}] ], esty = None ]; If[!MemberQ[{Horizontal, Vertical},orient], Message[StackedBarChart::badorient,orient]; orient = Vertical ]; Which[labels === Automatic, labels = Range[Max[lns]], labels === None, Null, True, labels = CycleValues[labels,Max[lns]] ]; If[!(numberQ[space] || (space === Automatic)), Message[StackedBarChart::badspace, space]; space = Automatic]; If[space === Automatic, space = .2]; If[ticks === Automatic, If[labels =!= None, ticks = {Transpose[{ Range[Max[lns]], labels, Table[0, {Max[lns]}]} ], Automatic}, (* else *) ticks = {None, Automatic}; ]; If[orient === Horizontal, ticks = Reverse[ticks]]; ]; If[fticks === Automatic, fticks = ticks]; If[!MatchQ[N[orig], {_?NumberQ, _?NumberQ}], If[orient === Horizontal, orig = {0, 1/2}, orig = {1/2, 0} ] ]; If[rng === Automatic, rng = {{1/2,Max[lns] + 1/2}, All}; If[orient === Horizontal, rng = Reverse[rng]] ]; (* data to rectangles *) halfwidth = (1 - space)/2; width = (1 - space); ends = Table[{0,0},{Max[lns]}]; data = Map[ MapIndexed[ (If[Negative[N[#1]], add = {0, #1}; tmp = {First[#2] - halfwidth, Last[ends[[ First[#2] ]] ]}, (* else *) add = {#1, 0}; tmp = {First[#2] - halfwidth, First[ends[[ First[#2] ]] ]} ]; ends[[ First[#2] ]] += add; {tmp, tmp + {width, N[#1]}})&, #]&, data ]; If[orient === Horizontal, data = Map[Reverse,data,{3}]]; (* plot 'em! *) RectanglePlot[Flatten[data,1], RectangleStyle -> sty, EdgeStyle -> esty, AxesOrigin -> orig, PlotRange -> rng, Ticks -> ticks, FrameTicks -> fticks, FilterOptions[RectanglePlot, {opts, Options[StackedBarChart]}]] ]) (* PercentileBarChart *) Options[PercentileBarChart] = Sort[ {BarStyle -> Automatic, BarSpacing -> Automatic, BarLabels -> Automatic, BarEdges -> True, BarEdgeStyle -> GrayLevel[0], BarOrientation -> Vertical} ~Join~ Developer`GraphicsOptions[] ]; SetOptions[PercentileBarChart, Axes -> True, AspectRatio -> 1/GoldenRatio, PlotRangeClipping -> True ]; PercentileBarChart[idata:{_?numberQ..}.., opts___?OptionQ] := (issueObsoleteFunMessage[PercentileBarChart,"Graphics`Graphics`"]; Module[{data = {idata}, labels, orient, ln = Length[{idata}], lns = Map[Length,{idata}],xticks, yticks, ticks}, (* options and default processing *) {labels, orient} = {BarLabels, BarOrientation}/. Flatten[{opts, Options[PercentileBarChart]}]; Which[labels === Automatic, labels = Range[Max[lns]], labels === None, Null, True, labels = CycleValues[labels,Max[lns]] ]; If[labels =!= None, xticks = Transpose[{Range[Max[lns]],labels,Table[0, {Max[lns]}]}], xticks = Automatic ]; If[MemberQ[ Flatten[Sign[N[data]]], -1], yticks = Transpose[{ Range[-1,1,.2], Map[ToString[#] <> "%"&,Range[-100,100,20]]}], yticks = Transpose[{ Range[0,1,.1], Map[ToString[#] <> "%"&, Range[0,100,10]]}] ]; If[orient === Horizontal, ticks = {yticks, xticks}, ticks = {xticks, yticks} ]; (* process data - convert to percentiles *) data = Map[pad[#,Max[lns]]&, data]; maxs = Apply[Plus, Transpose[Abs[data]],{1}]; data = Map[MapThread[If[#2 == 0, 0, #1/#2]&,{#,maxs}]&, data]; (* plot it! *) StackedBarChart[Sequence @@ data, opts, Ticks -> ticks, FrameTicks -> ticks, Sequence @@ Options[PercentileBarChart] ] ]) pad[list_, length_] := list/; Length[list] === length pad[list_,length_] := Join[list, Table[0,{length - Length[list]}]] (* Pie Chart *) Options[PieChart] = Sort[ {PieLabels -> Automatic, PieStyle -> Automatic, PieLineStyle -> Automatic, PieExploded -> None} ~Join~ Developer`GraphicsOptions[] ]; SetOptions[StackedBarChart, PlotRange -> All, PlotRangeClipping -> True ]; PieChart::badexplode = "The PieExploded option was given an invalid value ``. PieExploded takes \ a list of distances or a list of {wedgenumber, distance} pairs."; (* The following line is for compatability purposes only... *) PieChart[list:{{_?((numberQ[#] && NonNegative[N[#]])&), _}..}, opts___?OptionQ] := PieChart[First[Transpose[list]], PieLabels->Last[Transpose[list]],opts] PieChart[list:{_?((numberQ[#] && NonNegative[N[#]])&) ..}, opts___?OptionQ]/; (!(And @@ (# == 0 & /@ list))) := (issueObsoleteFunMessage[PieChart,"Graphics`Graphics`"]; Module[ {labels, styles, linestyle, tlist, thalf, text,offsets,halfpos, len = Length[list],exploded,wedges,angles1,angles2,lines, tmp}, (* Get options *) {labels, styles, linestyle,exploded} = {PieLabels, PieStyle, PieLineStyle,PieExploded}/. Flatten[{opts, Options[PieChart]}]; gopts = FilterOptions[Graphics, {opts, Options[PieChart]}]; (* Error handling on options, set defaults *) If[Head[labels] =!= List || Length[labels] === 0, If[labels =!= None, labels = Range[len]], labels = CycleValues[labels, len] ]; If[Head[styles] =!= List || Length[styles] === 0, If[len > 1, styles = Map[Hue, (Range[len] - 1)/(len - 1) .7], styles = {Hue[0]} ], styles = CycleValues[styles, len] ]; If[linestyle === Automatic, linestyle = GrayLevel[0]]; If[MatchQ[exploded,{_Integer,_Real}],exploded = {exploded}]; If[exploded === None, exploded = {}]; If[exploded === All, exploded = Range[len]]; If[(tmp = DeleteCases[exploded, (_Integer | {_Integer,_?(NumberQ[N[#]]&)})]) =!= {}, Message[PieChart::badexplode,tmp]; exploded = Cases[exploded, (_Integer | {_Integer,_?(NumberQ[N[#]]&)})] ]; exploded = Map[If[IntegerQ[#], {#,.1},#]&,exploded]; offsets = Map[If[(tmp = Cases[exploded,{#,_}]) =!= {}, Last[First[tmp]], 0]&, Range[len] ]; (* Get range of values, set up list of thetas *) tlist = N[ 2 Pi FoldList[Plus,0,list]/(Plus @@ list)]; (* Get pairs of angles *) angles1 = Drop[tlist,-1];angles2 = Drop[tlist,1]; (* bisect pairs (for text placement and offsets) *) thalf = 1/2 (angles1 + angles2); halfpos = Map[{Cos[#],Sin[#]}&,thalf]; (* generate lines, text, and wedges *) text = If[labels =!= None, MapThread[Text[#3,(#1 + .6) #2]&, {offsets,halfpos,labels}], {}]; lines = MapThread[{ Line[{#1 #2,{Cos[#3],Sin[#3]} + #1 #2}], Line[{#1 #2,{Cos[#4],Sin[#4]} + #1 #2}], Circle[#1 #2,1,{#3,#4}]}&, {offsets,halfpos,angles1,angles2}]; wedges = MapThread[ Flatten[{#5, Disk[#1 #2, 1, {#3,#4}]}]&, {offsets,halfpos,angles1,angles2,styles}]; (* show it all... *) Show[Graphics[ {wedges, Flatten[{linestyle, lines}], text}, gopts]] ]) (* TransformGraphics *) TransformGraphics[HoldPattern[Graphics][list_, opts___], f_, p_:0] := (issueObsoleteFunMessage[TransformGraphics,"Graphics`Graphics`"]; Graphics[ TG0[list, f, p], opts ]) TG0[d_List, f_, p_:0] := Map[ TG0[#, f, p]& , d ] TG0[HoldPattern[GraphicsComplex][pts_, prims_, o___], f_, p_:0] := GraphicsComplex[If[VectorQ[pts], pts, Map[f, pts]], TG0[prims, f, Length[pts]]] TG0[Point[d], f_, p_:0]/;(p === 0 || !gcq[d, p]) := Point[f[d]] TG0[Line[d_List], f_, p_:0]/;(p === 0 || !gcq[d, p]) := Line[Map[f, d, {-2}]] TG0[Arrow[d_List, o___], f_, p_:0]/;(p === 0 || !gcq[d, p]) := Arrow[Map[f, d, {-2}], o] TG0[Rectangle[{xmin_, ymin_}, {xmax_, ymax_}], f_, p_:0] := TG0[Polygon[{{xmin,ymin}, {xmin,ymax}, {xmax, ymax}, {xmax, ymin}}], f, p] TG0[Polygon[d_List], f_, p_:0]/;(p === 0 || !gcq[d, p]) := Polygon[Map[f, d, {-2}]] TG0[Circle[d_List, r_?numberQ, t___], f_, p_:0] := Circle[f[{x}], f[{r,r}], t] TG0[Circle[d_List, r_List, t___], f_, p_:0] := Circle[f[d], f[r], t] TG0[Disk[d_List, r_?numberQ, t___], f_, p_:0] := Disk[f[d], f[{r,r}], t] TG0[Disk[d_List, r_List, t___], f_, p_:0] := Disk[f[d], f[r], t] TG0[Raster[array_, range:{{_,_},{_,_}}:{{0,0}, {1,1}}, zrange___], f_, p_:0] := Raster[array, f /@ range, zrange] TG0[RasterArray[array_, range:{{_,_},{_,_}}:{{0,0}, {1,1}}, zrange___], f_, p_:0] := RasterArray[array, f /@ range, zrange] TG0[Text[expr_, d_List, opts___], f_, p_:0] := Text[expr, f[d], opts] TG0[expr_, f_, p_:0] := expr (* gcq tests for compliance with a GraphicsComplex indexed primitive *) gcq[_Integer] := True gcq[pts:{__Integer}, count_]/;(Max[pts] <= count && Min[pts] >= 1) := True gcq[pts:{{_Integer..}..}, count_]/;(Max[pts] <= count && Min[pts] >= 1) := True gcq[any_] := False (* SkewGraphics *) SkewGraphics[g_, m_?MatrixQ] := (issueObsoleteFunMessage[SkewGraphics,"Graphics`Graphics`"]; TransformGraphics[g, (m . #)&]) End[ ] (* Graphics`Graphics`Private` *) EndPackage[ ] (* Graphics`Graphics` *) (*:Limitations: None known. *) (*:Tests: *) (*:Examples: LinearScale[ 1,2] LogScale[1,10] UnitScale[2,10,0.7] PiScale[ 0,10] TextListPlot[{{1.5, 2.5}, {1.6, 2.6}, {1.7, 2.7}, {1.8, 2.8}}] TextListPlot[{ {1.5,2.5,1},{1.6,2.6,2},{1.7,2.7,3},{1.8,2.8,4}}] LabeledListPlot[{ {1.5,2.5,1},{1.6,2.6,2},{1.7,2.7,3},{1.8,2.8,4}}] LogPlot[ Sin[x],{x,0.1,3.1}] LogPlot[ Exp[ 4 x], {x,1,5}, Frame -> True] LogPlot[ Exp[ 4 x], {x,1,5}, Frame -> True, GridLines -> {Automatic, LogGridMajor}] LogPlot[ Exp[ 4 x], {x,1,3}, Frame -> True, GridLines -> {Automatic, LogGridMinor}] LogListPlot[ Table[i,{i,10}] ] LogListPlot[ Table[ {i/2,i^2},{i,20}]] LogLogPlot[ Sin[x],{x,0.1,3.1}] LogLogListPlot[ Table[ i^2,{i,10}]] LogLogListPlot[ Table[ {i^2,i^3},{i,10}]] PolarPlot[ Cos[t], {t,0,2 Pi}] PolarPlot[ {Cos[t], Sin[2 t]},{t,0,2 Pi}] PolarListPlot[ Table[ {t/2,Cos[t]},{t,0,2 Pi, .1}]] ErrorListPlot[Table[ { i,i^2},{i,10}]] ErrorListPlot[ Table[ { Sin[t],Cos[t], t},{t,10}]] data = Table[{n/15,(n/15)^2 + 2 + Random[Real, {-.3,.3}]}, {n,15}]; fit = Fit[data,{1,x,x^2},x]; ListAndCurvePlot[data,fit,{x,0,1}] BarChart[ Table[i,{i,1,10}]] BarChart[ Table[ {Sin[t], SIN[t]},{t,0.6,3,0.6}]] PieChart[ Table[ i,{i,5}]] PieChart[ Table[ {i,A[i]},{i,7}]] Show[GraphicsArray[ {{PieChart[{.2,.3,.1},DisplayFunction->Identity], PieChart[{.2,.3,.1},PieExploded->All, DisplayFunction->Identity], PieChart[{.2,.3,.1},PieExploded->{3,.2}, DisplayFunction->Identity]}}], DisplayFunction->$DisplayFunction] PlotStyle[Plot[Sin[x],{x,0,Pi}]] PlotStyle[Plot[Sin[x],{x,0,Pi}, PlotStyle->{{Dashing[{.02,.02}],Thickness[.007]}}]] g1 = Plot[t,{t,0,Pi}]; Show[ TransformGraphics[ g1, Sin[#]& ] ] g1 = Plot[ Sin[t],{t,0,Pi}]; Show[ SkewGraphics[g1, {{1,2},{0,1}}]] *)