(* :Mathematica Version: 3.0 *)

(* :Name: Graphics`Graphics` *)

(* :Title: Additional Graphics Functions *)

(* :Author: Wolfram Research, Inc. *)
(* :Copyright: Copyright 1990-1999, Wolfram Research, Inc.*)

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

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

BeginPackage["Graphics`Graphics`", "Graphics`Common`GraphicsCommon`",
	"Utilities`FilterOptions`"];

(* 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.  TextListPlot[{{x1, y1, t1},
{x2, y2, t2}, ...}] labels the point {xi,yi} with the text ti.";

DisplayTogether::usage =
"DisplayTogether[plotcommands, opts] takes a sequence of plot commands (e.g.,
Plot[Sin[x], {x,0, 2 Pi}], etc.) and combines them to produce a single
graphic.  The constraints on this are that the commands must all be able
to accept the option DisplayFunction->Identity as an argument, and must
all produce graphics that can be shown together by use of the Show
command. Options for the type of graphic to be produced can be passed in."

DisplayTogetherArray::usage =
"DisplayTogetherArray[plotcommands, opts] takes a sequence of plot
commands (e.g., Plot[Sin[x], {x,0, 2 Pi}], etc.) and combines them
to produce a GraphicsArray of the plots.  The constraint on this
is that the commands must all be able to accept the option
DisplayFunction->Identity as an argument. Note that the plotcommands
can also be placed in an array which is suitable for arranging the
output GraphicsArray.  Options for GraphicsArray can be given."

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}, ...}] generates
a plot of Log[yi] against the xi.";

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.";

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}, ...}] generates a plot of yi against
Log[xi].";

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}, ...}]
generates a plot of Log[yi] against Log[xi].";

ScaledPlot::usage =
"ScaledPlot[f, {x, xmin, xmax}] generates a plot of the function
with each coordinate scaled by a function specified by the ScaleFunction
option."

ScaledListPlot::usage =
"ScaledListPlot[data] generates a plot with each data point scaled
by functions specified in the ScaleFunction option."

ScaleFunction::usage =
"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."

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, ...}] generates a polar plot, assuming that the ri are
equally spaced in angle.";

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[graphics, f] applies the function f to all lists of
coordinates in graphics.";

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 probabity 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`"]

(* 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[Graphics[g:{{__,_List}..},opts___]] :=
  Map[PlotStyle[Graphics[#,opts]]&, g]

PlotStyle[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] :=
	Module[{spacing, t, nmin=N[min], nmax=N[max]},
		(spacing = TickSpacing[nmax-nmin, n, {1, 2, 2.5, 5, 10}] ;
		t = Range[Ceiling[nmin/spacing - 0.05] spacing, max, spacing] ;
		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] :=
        Module[{pts} ,
		pts = GenGrid[ min, max, n] ;
		Join[ Map[ LogTicks, pts ], MinorLogTicks[pts]]
	] /; N[min] < N[max]

LogGridMajor[ min_, max_, n_Integer:6] :=
        Module[{pts} ,
                pts = GenGrid[ min, max, n] ; 
                Map[ Log[10, #]& , pts ]
        ] /; N[min] < N[max]

LogGridMinor[ min_, max_, n_Integer:6] :=
        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],NumberForm[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] :=
	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] :=
	UnitScale[min, max, Pi/2, n] /; min < max

(* TextListPlot *)

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___] :=
        Show[Graphics[ Text[Last[#], Take[#, 2]]& /@ data,
                        opts, Axes->Automatic]]

(* LabeledListPlot *)

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___] :=
	Show[Graphics[ {PointSize[0.015], {Point[Take[#, 2]], 
		Text[Last[#], Scaled[{0.015, 0}, Take[#, 2]], {-1, 0}]
			} } & /@ data ,
		opts, Axes->Automatic]]

(* Log Plots *)

SetAttributes[{LogPlot, LinearLogPlot, LogLinearPlot, LogLogPlot, 
	ScaledPlot}, HoldFirst];

(* adopt as default options those of ParametricPlot and ListPlot *)

Options[LogPlot] = Options[LogLinearPlot] = Options[LinearLogPlot] =
	Options[LogLogPlot] = Options[ParametricPlot];

Options[LogListPlot] = Options[LogLinearListPlot] = Options[LinearLogListPlot] =
	Options[LogLogListPlot] = Options[ListPlot];

LogPlot = LinearLogPlot; LogListPlot = LinearLogListPlot;

LinearLogPlot[fun_,range_,opts___] :=
	ScaledPlot[fun,range,
		ScaleFunction -> {#&, Log[10,#]&},
		tickopts[Automatic, LogScale,
			 LinearLogPlot, {#&, Log[10,#]&}, Flatten[{opts}]],
		scaleplotrange[LinearLogPlot, Flatten[{opts}]],
		opts,
		Options[LinearLogPlot]
	]

LogLinearPlot[fun_, range_, opts___] :=
	ScaledPlot[fun, range,
		ScaleFunction -> {Log[10, #]&, #&},
		tickopts[LogScale, Automatic,
			LogLinearPlot, {Log[10, #]&, #&}, Flatten[{opts}]],
		scaleplotrange[LogLinearPlot, Flatten[{opts}]],
		opts,
		Options[LogLinearPlot]
	]

LogLogPlot[fun_, range_, opts___] :=
	ScaledPlot[fun, range,
		ScaleFunction -> {Log[10, #]&, Log[10, #]&},
		tickopts[LogScale, LogScale,
			LogLogPlot, {Log[10, #]&, Log[10, #]&}, Flatten[{opts}]],
		scaleplotrange[LogLogPlot, Flatten[{opts}]],
		opts,
		Options[LogLogPlot]
	]

LinearLogListPlot[data_, opts___] :=
	ScaledListPlot[data,
		ScaleFunction -> {#&, Log[10,#]&},
		tickopts[Automatic, LogScale,
			 LinearLogListPlot, {#&, Log[10,#]&}, Flatten[{opts}]],
		scaleplotrange[LinearLogListPlot, Flatten[{opts}]],
		opts,
		Options[LinearLogListPlot]
	]

LogLinearListPlot[data_, opts___] :=
	ScaledListPlot[data,
		ScaleFunction -> {Log[10, #]&, #&},
		tickopts[LogScale, Automatic,
			LogLinearListPlot, {Log[10, #]&, #&}, Flatten[{opts}]],
		scaleplotrange[LogLinearListPlot, Flatten[{opts}]],
		opts,
		Options[LogLinearListPlot]
	]

LogLogListPlot[data_, opts___] :=
	ScaledListPlot[data,
		ScaleFunction -> {Log[10, #]&, Log[10, #]&},
		tickopts[LogScale, LogScale,
			LogLogListPlot, {Log[10, #]&, Log[10, #]&},
			Flatten[{opts}]],
		scaleplotrange[LogLogListPlot, Flatten[{opts}]],
		opts,
		Options[LogLogListPlot]
	]

(* 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,
			     None,
			     Composition[striplabels, xfun]
			 ],
			 If[yfun === Automatic,
			     None,
			     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, f1, s1], transformticks[t2, f4, s2]}

transformticks[{t1_, t2_, t3_, t4_}, {f1_, f2_, f3_, f4_}, {s1_, s2_}] :=
	{transformticks[t1, f1, s1], transformticks[t2, f2, s2],
	transformticks[t3, f3, s1, True], transformticks[t4, f4, s2, True]}

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_, Automatic | None, _, flag_:False] := list

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),
		options_] :=
	PlotRange -> Replace[PlotRange/.options/.Options[type],
                    {{x:(_List | _Symbol), y:(_List | _Symbol)} :> {x,log10[y]},
                        y_List :> log10[y]}]


scaleplotrange[type:(LogLinearPlot | LogLinearListPlot),
		options_] :=
	PlotRange -> Replace[PlotRange/.options/.Options[type],
		{x:(_List | _Symbol), y:(_List | _Symbol)} :> {log10[x], y}]

scaleplotrange[type:(LogLogPlot | LogLogListPlot),
		options_] :=
	PlotRange -> Replace[PlotRange/.options/.Options[type],
			y_List :> log10[y]]

SetAttributes[log10, Listable]

log10[x_?NumberQ] := 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 *)

Options[ScaledPlot] =
	{ScaleFunction -> (# &), DisplayFunction :> $DisplayFunction};

ScaledPlot[funcs_List,{x_Symbol,xmin_,xmax_},opts___?OptionQ] :=
	Module[{scale,g,r,popts, xs, ys, disp,ao, mapfun, plotfun, scalefun,
                arg },
		{scale, disp, ao} =
			 {ScaleFunction, DisplayFunction, AxesOrigin}/.
			Flatten[{opts}]/.Options[ScaledPlot];
		popts = FilterOptions[ParametricPlot, ##]& @@ Flatten[{opts}];
		If[Head[scale] =!= List,
			scale = {scale, scale}
		];
		If[Length[scale] > 2,
			scale = Take[scale,2]
		];
		{xs, ys} = scale;
          (* 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);
                r = PlotRange[g];
                If[Head[r] === PlotRange, r = {{-1,1},{-1,1}}];
                If[ao === Automatic,
                        ao = Map[#[[1]]&,r],
                        ao = {xs[First[ao]], ys[Last[ao]]}
                ];
                Show[g, DisplayFunction -> disp,
                        PlotRange -> r,
                        AxesOrigin -> ao
                ]
        ]


ScaledPlot[f_?(Not[ListQ[#]]&), range_List, opts___?OptionQ] :=
	ScaledPlot[{f}, range, opts]

(* Scaled List Plot *)
ScaledListPlot::sptn =
"Coordinate `1` is not a pair of numeric values.";

Options[ScaledListPlot] =
	{ScaleFunction -> (# &), DisplayFunction :> $DisplayFunction};

ScaledListPlot[pdata_List, opts___?OptionQ] :=
	Module[{scale, g, r, xs, ys, lopts, disp, ao},
		{scale, disp, ao} =
			 {ScaleFunction, DisplayFunction, AxesOrigin}/.
			Flatten[{opts}]/.Options[ScaledPlot];
		lopts = FilterOptions[ListPlot, ##]& @@ Flatten[{opts}];
		data = MapIndexed[
			Switch[#1,
				{_?numberQ, _?numberQ}, #,
				_?numberQ, {First[#2], #1},
				_, Message[ScaledListPlot::sptn, #];Null
			]&, pdata];
		data = DeleteCases[data, Null];
		If[Head[scale] =!= List,
			scale = {scale, scale}
		];
		If[Length[scale] > 2,
			scale = Take[scale,2]
		];
		{xs, ys} = scale;
		g = ListPlot[
				Map[{xs[ #[[1]] ], ys[ #[[2]] ]}&,
					data],
			DisplayFunction -> Identity,
			lopts];
		r = PlotRange[g];
		If[ao === Automatic,
			ao = Map[#[[1]]&,r],
			ao = {xs[First[ao]], ys[Last[ao]]}
		];
		Show[g, DisplayFunction -> disp,
			PlotRange -> r,
			AxesOrigin -> ao
		]
	]

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

Options[PolarListPlot] = Options[ListPlot];

SetOptions[PolarListPlot, AspectRatio -> Automatic];

PolarListPlot[rlist_?VectorQ, opts___?OptionQ] :=
        ListPlot[ rlist * Map[{Cos[#], Sin[#]}&,
                        2Pi/Length[rlist] Range[0, Length[rlist]-1]],
            FilterOptions[PolarListPlot,
            opts, Options[PolarListPlot]]
    ]

PolarListPlot[rtlist:{{_,_}...}, opts___?OptionQ] :=
    ListPlot[
        Apply[{#1 Cos[#2], #1 Sin[#2]}&, rtlist, {1}],
        FilterOptions[PolarListPlot,
            opts, Options[PolarListPlot]]
    ]


(* ErrorListPlot *)
Options[ErrorListPlot] = Options[Graphics];
SetOptions[ErrorListPlot, Axes -> Automatic];

ErrorListPlot[l2:{{_, _}..},opts___] :=
        Module[ {i}, 
	ErrorListPlot[ Table[Prepend[l2[[i]], i], {i, Length[l2]}] ,opts] ]

ErrorListPlot[l3:{{_, _, _}..},opts___] :=
        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
	the plot commands must all accept the option DisplayFunction->Identity,
	and all commands must be able to be shown together via Show.  Note
	that this second constraint is not present for DisplayTogetherArray, since
	it produces a GraphicsArray as output.
*)

Attributes[DisplayTogether] = {HoldAll};

DisplayTogether[plots__, opts:(_Rule | _RuleDelayed)...] :=
	Show[insertoption[{plots}, DisplayFunction -> Identity],
		opts, DisplayFunction -> $DisplayFunction]

Attributes[DisplayTogetherArray] = {HoldAll};

DisplayTogetherArray[plotarray_List,opts:(_Rule | _RuleDelayed)...] :=
	Show[GraphicsArray[insertoption[plotarray,
			DisplayFunction -> Identity]],
		opts, DisplayFunction -> $DisplayFunction]

DisplayTogetherArray[plots__,opts:(_Rule | _RuleDelayed)...] :=
	Show[GraphicsArray[insertoption[{plots},
			DisplayFunction -> Identity]],
		opts, DisplayFunction -> $DisplayFunction]

Attributes[insertoption] = {HoldFirst, Listable};

insertoption[thing_,option_] :=
	Module[{gtype, list, rpos},
		gtype = ReleaseHold[HeldPart[Hold[thing],1,0]];
		list = ReleaseHold[ReplaceHeldPart[Hold[thing],
					List, {1, 0}]];
		rpos = Position[list,(_Rule | _RuleDelayed), {1},
					Heads -> False];
		If[rpos === {},
			gtype @@ Append[list,option],
			gtype @@ Insert[list,option,First[rpos]]
		]
	]

(* List and Curve Plot.  This function generates plots combining
data and curves. *)

Options[ListAndCurvePlot] =
	{PlotStyle -> Automatic};

ListAndCurvePlot[data__,range:{_Symbol,_,_},
		opts:((_Rule | _RuleDelayed)...)] :=
	Module[{ps, lpopts, popts, gopts},
		{ps} = {PlotStyle}/.{opts}/.Options[ListAndCurvePlot];
		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, DisplayFunction -> $DisplayFunction]
	]

(* BarCharts -
	BarChart, GeneralizedBarChart, StackedBarChart, PercentileBarChart.
	with the internal RectanglePlot and small utilities *)

(* RectanglePlot *)

Options[RectanglePlot] =
	{RectangleStyle -> Automatic,
	EdgeStyle -> Automatic,
	ObscuredFront -> False};

RectanglePlot[boxes:{{{_?numberQ,_?numberQ},{_?numberQ,_?numberQ}}..},
		opts___] :=
	Module[{ln = Length[boxes], bsytle, estyle, gopts},
	(* Handle options and defaults *)
		{bstyle, estyle,sort} = {RectangleStyle, EdgeStyle,
			ObscuredFront}/.{opts}/.
			Options[RectanglePlot];
		gopts = FilterOptions[Graphics, opts];
		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::noapprox =
"ApproximateIntervals -> `` is a not a valid setting when 
HistogramCategories->{c1, c2, ..., cm}.  Taking ApproximateIntervals -> False."
   Histogram::ltail1 =
"Warning: `1` point from the left tail of the data, strictly less than `2`,
	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: `1` point from the right tail of the data, greater than or equal
	to `2`, 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,
	Ticks -> Automatic 			(* opt of Graphics *)
	};

(* Note: Histogram calls RangeCounts to compute frequencies
	and GeneralizedBarChart for plotting. *)
Histogram[list_?VectorQ, opts___?OptionQ] :=
 Module[{approximate, bedges, bedgestyle, borien, bstyle, fdata, hcat,
	 range, scale, ticks,
	 countdata, numberOfBins, 
	 datamin, datamax, (* min and max as determined by the data and the
				option HistogramRange *)
	 cutoffs,
	 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 *)
	},
  (

	If[TrueQ[fdata],

	   (* ===================================================== *)	
	   (* PROCESS LIST assuming that it represents FREQUENCIES. *)
	   (* Define countdata, numberOfBins, binmin, binmax, cutoffs. *)
	   (* ===================================================== *)	

	   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, Range[0, numberOfBins], 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 countdata, numberOfBins, binmin, binmax, cutoffs. *)
	   (* ===================================================== *)	

	   (* === Define min and max of range, and count data in range. ==== *)
	   {datamin, datamax} = findRange[range, list];
	   totalcount = Count[list, x_ /; datamin <= x <= datamax];

	   (* =========== Define category cutoffs for raw data. =========== *)
	   cutoffs = findCutoffs2[hcat, datamin, datamax, totalcount,
		 approximate];
	   numberOfBins = Length[cutoffs]-1;
	   (* Note that RangeCounts considers intervals of the form
		{binmin <= x < etc, ..., etc <= x < binmax}. *)
	   {binmin, binmax} = {First[cutoffs], Last[cutoffs]};

	   (* ========== Warning messages for points not plotted. ======== *)
	   (* If histogram range is to be determined automatically, *)
	   (* presumably because the user wants all points to be plotted, *)
	   (* warn user if some points will be excluded from histogram. *)
	   If[ (range === Automatic || 
	     (VectorQ[range] && Length[range] == 2 &&
		 range[[1]] === Automatic) ) &&
	    		datamin < binmin,
	     leftTailCount = Count[list, x_ /; x < binmin];
	     If[leftTailCount == 1,
	        Message[Histogram::ltail1, leftTailCount, binmin] ];
	     If[leftTailCount > 1,
	        Message[Histogram::ltail, leftTailCount, binmin] ]
	   ];
	   If[ (range === Automatic || 
             (VectorQ[range] && Length[range] == 2 &&
                 range[[2]] === Automatic) ) &&
	    		datamax >= binmax,
	     rightTailCount = Count[list, x_ /; x >= binmax];
	     If[rightTailCount == 1,
		Message[Histogram::rtail1, rightTailCount, binmax] ];
	     If[rightTailCount > 1,
		Message[Histogram::rtail, rightTailCount, binmax] ];
	   ];

	   (* =========== Compute category counts for raw data. =========== *)
	   countdata = RangeCounts[list, cutoffs];
	   If[Head[countdata] === RangeCounts,
	   	Message[Histogram::rcount];
	   	Return[$Failed] ];
	    (* Length of data should be numberOfBins+2.
	   	Eliminate first and last elements
	     of data corresponding to the ranges x < binmin and x >= binmax. *)
	    countdata = Drop[Drop[countdata, 1], -1]

	]; (* 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 UnitProbability -> True. *)
	binwidths = Drop[cutoffs, 1] - Drop[cutoffs, -1];
	If[TrueQ[scale] || !Apply[Equal, binwidths],
	   (* 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.			   *)
	(* =============================================================== *)
	(* Figure out what Automatic setting of category axis ticks
	   would be for a ListPlot.  Eliminate ticks that don't
	   have labels. *)
	autoticks = Select[
                           FullOptions[ListPlot[
                           Transpose[{bincenters, countdata}],
                                DisplayFunction :> Identity,
				PlotRange -> {{binmin, binmax}, Automatic}
                                ], Ticks][[1]],
                           (#[[2]] =!= "")&];
	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];
    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 = Apply[Plus, Map[(#[[2]]#[[3]])&, phwdata]];
           phwdata = Map[{#[[1]], #[[2]] scale/area, #[[3]]}&, phwdata]
        ];

	(* ===================== GeneralizedBarChart ===================== *)
        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]
	]
  ) /; (
	{approximate, bedges, bedgestyle, borien, bstyle,
	 fdata, hcat, range, scale, ticks} =
	 	{ApproximateIntervals, BarEdges, BarEdgeStyle,
		 BarOrientation, BarStyle, FrequencyData,
		 HistogramCategories, HistogramRange, HistogramScale, Ticks} /.
		 {opts} /. Options[Histogram];
	If[TrueQ[fdata] && VectorQ[list] && VectorQ[hcat] &&
		(Length[list] + 1 != Length[hcat]),
	   Message[Histogram::fdfail];  False,
	   True]
	)

 ] (* 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]
	   ]; (* 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_, list_] :=
  Module[{min, max},
   (
	{min, max} = {Min[list], Max[list]};
	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]
   ]


(* RangeCounts expects cutoffs {c0, c1, c2, ..., cm, cn}, specifying
	intervals {c0 <= x < c1, c1 <= x < c2, ..., cm <= x < cn}.
   Thus the {first, last, delta} returned by approximateIntervals specifies
	{first <= x < first + delta, ..., last - delta <= x < last}.
*)
(* 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},
	(* ======= 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] ;
	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] =
	{BarStyle -> Automatic,
	BarSpacing -> Automatic,
	BarGroupSpacing -> Automatic,
	BarLabels -> Automatic,
	BarValues -> False,
	BarEdges -> True,
	BarEdgeStyle -> GrayLevel[0],
	BarOrientation -> Vertical};

BarChart[idata:{_?numberQ..}..,
		opts:((_Rule | _RuleDelayed)...)] :=
	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}/.
			{opts}/.Options[BarChart];
		gbopts = FilterOptions[GeneralizedBarChart,
			Sequence @@ 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,
			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}],
					Automatic},
		(* else *)
			ticks = {None, Automatic};
		];
		orig = {1 - width/2 - bgs,0};
		rng = {{1 - width/2 - bgs,
					Max[lns] + (ln - 1/2) width + bgs},
				Automatic};
		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:((_Rule | _RuleDelayed)...)] :=
	Module[{lab,dat},
		{dat, lab} = Transpose[list];
		BarChart[dat, opts, BarLabels -> lab]
	]

BarChart[list:{{_?numberQ, _, _}..},
		opts:((_Rule | _RuleDelayed)...)] :=
	Module[{lab, sty, dat},
		{dat, lab, sty} = Transpose[list];
		BarChart[dat, opts, BarLabels -> lab, BarStyle -> sty]
	]

(* GeneralizedBarChart *)

Options[GeneralizedBarChart] =
	{BarStyle -> Automatic,
	BarValues -> False,
	BarEdges -> True,
	BarEdgeStyle -> GrayLevel[0],
	BarOrientation -> Vertical};

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:((_Rule | _RuleDelayed)...)] :=
	Module[{data = {idata}, bsty, val, vpos, unob, edge, esty, bsf,
			orient, ln = Length[{idata}],
			lns = Map[Length,{idata}], bars, disp},
	(* Get options *)
		{bsty, val, edge, esty, orient} =
			{BarStyle, BarValues, BarEdges, BarEdgeStyle,
			BarOrientation}/.{opts}/.Options[GeneralizedBarChart];
		gopts = FilterOptions[Graphics,opts];
		disp = DisplayFunction/.{opts}/.Options[Graphics];
	(* Handle defaults and error check options *)
		If[bsty =!= Automatic && Head[bsty] =!= List,
			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]],
				DisplayFunction -> disp,
				gopts,
				Axes -> True,
				PlotRange -> All
			],
		(* else *)
			RectanglePlot[bars,
				RectangleStyle -> bsty,
					EdgeStyle -> esty,
					ObscuredFront -> unob,
					gopts,
					Axes -> True]
		]
	]

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] offset, 0}, {len, pos}]]

varcoords[Vertical,offset_,format_][{pos_,len_,wid_}] :=
	Text[format[len], Scaled[{0,Sign[len] 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] =
	{BarStyle -> Automatic,
	BarSpacing -> Automatic,
	BarLabels -> Automatic,
	BarEdges -> True,
	BarEdgeStyle -> GrayLevel[0],
	BarOrientation -> Vertical};

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:((_Rule | _RuleDelayed)...)] :=
	Module[{data = {idata}, sty, space, labels, bv, bvp, edge,
			esty, orient, ln = Length[{idata}], add, tmp,
			lns = Map[Length,{idata}],ticks,orig,rng},
	(* process options *)
		{sty, space, labels, edge, esty, orient} =
			{BarStyle, BarSpacing, BarLabels,
			BarEdges, BarEdgeStyle,
			BarOrientation}/.{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[labels =!= None,
			ticks = {Transpose[{
						Range[Max[lns]],
						labels}],
					Automatic},
		(* else *)
			ticks = {None, Automatic};
		];
		orig = {1/2,0};
		rng = {{1/2,Max[lns] + 1/2}, Automatic};
			(* 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,
			ticks = Reverse[ticks]; orig = Reverse[orig];
			rng = Reverse[rng];
			data = Map[Reverse,data,{3}]];
	(* plot 'em! *)
		RectanglePlot[Flatten[data,1],
			RectangleStyle -> sty,
			EdgeStyle -> esty,
			opts,
			Axes -> True,
			AxesOrigin -> orig,
			PlotRange -> rng,
			Ticks -> ticks,
			FrameTicks -> ticks]

	]

(* PercentileBarChart *)

Options[PercentileBarChart] =
	{BarStyle -> Automatic,
	BarSpacing -> Automatic,
	BarLabels -> Automatic,
	BarEdges -> True,
	BarEdgeStyle -> GrayLevel[0],
	BarOrientation -> Vertical};

PercentileBarChart[idata:{_?numberQ..}..,
		opts:((_Rule | _RuleDelayed)...)] :=
	Module[{data = {idata}, labels,
			orient, ln = Length[{idata}],
			lns = Map[Length,{idata}],xticks, yticks, ticks},
	(* options and default processing *)
		{labels, orient} = {BarLabels, BarOrientation}/.
			{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}],
			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] =
	{PieLabels -> Automatic,
	PieStyle -> Automatic,
	PieLineStyle -> Automatic,
	PieExploded -> None};

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___] :=
	PieChart[First[Transpose[list]],
		PieLabels->Last[Transpose[list]],opts]

PieChart[list:{_?((numberQ[#] && NonNegative[N[#]])&) ..}, opts___] :=
	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}/.
			{opts}/.Options[PieChart];
		gopts = FilterOptions[Graphics, opts];
	(* 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,
			styles = Map[Hue, (Range[len] - 1)/(len - 1) .7],
			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,
			AspectRatio->Automatic,
			PlotRange -> All]]
	]

(* TransformGraphics *)

TransformGraphics[Graphics[list_, opts___], f_] :=
	Graphics[ TG0[list, f], opts ]

TG0[d_List, f_] := Map[ TG0[#, f]& , d ]

TG0[Point[d_List], f_] := Point[f[d]]

TG0[Line[d_List], f_] := Line[f /@ d]

TG0[Rectangle[{xmin_, ymin_}, {xmax_, ymax_}], f_] :=
	TG0[Polygon[{{xmin,ymin}, {xmin,ymax}, {xmax, ymax}, {xmax, ymin}}], f]

TG0[Polygon[d_List], f_] := Polygon[f /@ d]

TG0[Circle[d_List, r_?numberQ, t___], f_] :=
	Circle[f[d], f[{r,r}], t]

TG0[Circle[d_List, r_List, t___], f_] :=
        Circle[f[d], f[r], t] 

TG0[Disk[d_List, r_?numberQ, t___], f_] :=
        Disk[f[d], f[{r,r}], t] 

TG0[Disk[d_List, r_List, t___], f_] := 
        Disk[f[d], f[r], t]

TG0[Raster[array_, range_List:{{0,0}, {1,1}}, zrange___], f_] := 
	Raster[array, f /@ range, zrange]

TG0[RasterArray[array_, range_List:{{0,0}, {1,1}}, zrange___], f_] := 
	RasterArray[array, f /@ range, zrange]

TG0[Text[expr_, d_List, opts___], f_] := Text[expr, f[d], opts]

TG0[expr_, f_] := expr

(* SkewGraphics *)

SkewGraphics[g_, m_?MatrixQ] :=
	TransformGraphics[g, (m . #)&]


(* ================================ RangeCounts ============================ *)
(* range intervals are defined by cutoffs c1, c2, ...:
		{x < c1, c1 <= x < c2, ..., x >= cm}
*)
RangeCounts[list:{_?NumberQ...}, clist:{_?NumberQ...}] :=
        Module[  { tree, vals, nbin = Length[clist] + 1, split, counts, i},
                tree = MakeTree[clist] ;
                vals = Map[TreeFind[tree, #]&, list] ;
                split = Split[Sort[vals]];
                counts = Array[0&, nbin];  i = 0;
                Scan[(While[First[#] != i, i++];
                      counts[[i+1]] = Length[#];
                      i++)&, split];
                counts
        ] (* /; FreeQ[clist, Complex] *)

(* ================================ MakeTree =============================== *)

MakeTree[{}] := {}

MakeTree[list_List] :=
   Block[{n, t},
                n = Length[list];
                t = Transpose[{Sort[list], Range[n]}] ;
                MakeTree0[ 1, n ]
   ]

MakeTree0[i_,j_] := Block[{midpoint,diff},
        diff = j-i;
        Which[
           diff==3, {t[[i+1]],{t[[i]],{},{}},{t[[i+2]],{},{t[[i+3]],{},{}}}},
           diff==2, {t[[i+1]],{t[[i]],{},{}},{t[[j]],{},{}}},
           diff==1, {t[[i]],{},{t[[j]],{},{}}},
           diff==0, {t[[i]],{},{}},
           True, (
                        midpoint = i + Quotient[diff,2];
                        {t[[midpoint]],
                                MakeTree0[i,midpoint-1],
                                MakeTree0[midpoint+1,j]}
                 )
           ]]


(* ================================ TreeFind ============================== *)

TreeFind[{}, e_] := 0

TreeFind[tree_List, e_] :=
         Block[{found=0, bar=e},
                TreeFind0[tree];
                found
         ]

TreeFind0[tree_] :=
        Block[{m, k},
        {m, k} = First[tree] ;
        Which[
              bar < m, TreeFind0[tree[[2]]],
              bar > m, found = k ;TreeFind0[tree[[3]]],
              True, found = k; Return[]
        ]]

TreeFind0[{}] = 1



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}}]]

*)


