home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GRAPHICS.PAK / GRAPHICS.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  41.3 KB  |  1,354 lines
  1. (*:Version: Mathematica 2.0 *)
  2.  
  3. (*:Name: Graphics`Graphics` *)
  4.  
  5. (*:Title: Additional Graphics Functions *)
  6.  
  7. (*:Author: Wolfram Research, Inc. *)
  8.  
  9. (*:History:
  10.     Original Version by Wolfram Research, Inc.
  11.     Revised by Michael Chan and Kevin McIsaac (Wolfram Research), 
  12.     March, 1990.  Further revisions by Bruce Sawhill (Wolfram
  13.     Research), Sept., 1990.
  14.     Further revisions by ECM (Wolfram Research), Dec., 1990.
  15.     Removal of 3D graphics functions to the package Graphics3D.m and
  16.     minor revisions by John M. Novak, March, 1991.
  17.     More extensive revisions by John M. Novak, Nov. 1991.
  18.         (PieChart, log plots, ScaledPlot, bar charts, etc.)
  19. *)
  20.  
  21. (*:Summary:
  22.      Defines some functions to extend Mathematica's graphing capabilities.
  23. *)
  24.  
  25. (*:Keywords:
  26.     Log, Graphics, ListPlot, Scale, Polar
  27. *)
  28.  
  29. (*:Requirements: None *)
  30.  
  31. (*:Warnings:
  32.     Expands the definitions of PlotStyle.
  33. *)
  34.  
  35. (*:Sources: *)
  36.  
  37. BeginPackage["Graphics`Graphics`",
  38.     "Utilities`FilterOptions`"];
  39.  
  40. (* Usage messages *)
  41.  
  42. LinearScale::usage =
  43. "LinearScale[xmin, xmax] gives a list of \"nice\" values between xmin and xmax
  44. suitable for use as tick mark positions.  LinearScale[xmin, xmax, n] attempts
  45. to find n such values.";
  46.  
  47. LogScale::usage =
  48. "LogScale[xmin, xmax] gives a list of \"nice\" values between xmin and xmax
  49. suitable for use as tick mark positions on a logarithmic scale.
  50. LogScale[xmin, xmax, n] attempts to find n such values.";
  51.  
  52. UnitScale::usage =
  53. "UnitScale[xmin, xmax, unit] gives a list of \"nice\" values between xmin and
  54. xmax that are multiples of unit.  UnitScale[xmin, xmax, unit, n] attempts to
  55. find n such values.";
  56.  
  57. PiScale::usage =
  58. "PiScale[xmin, xmax] gives a list of \"nice\" values between xmin and xmax that
  59. are multiples of Pi.  PiScale[xmin, xmax, n] attempts to find n such values.";
  60.  
  61. LogGridMinor::usage =
  62. "LogGridMinor[xmin, xmax] gives a list of \"nice\" values between xmin and
  63. xmax suitable for use as grid line positions on a logarithmic scale. The
  64. positions are the same as those for major and minor tick marks from LogScale.
  65. LogGridMinor[xmin, xmax, n] attempts to find n such values.";
  66.  
  67. LogGridMajor::usage =
  68. "LogGridMajor[xmin, xmax] gives a list of \"nice\" values between xmin and
  69. xmax suitable for use as grid line positions on a logarithmic scale. The
  70. positions are the same as those for major tick marks from LogScale.
  71. LogGridMajor[xmin, xmax, n] attempts to find n such values.";
  72.  
  73. TextListPlot::usage =
  74. "TextListPlot[{y1, y2, ...}] plots a list, with each point {i,yi} rendered as
  75. its index number i.  TextListPlot[{{x1,y1},{x2,y2}, ...}] renders the point
  76. {xi,yi} as its index number i.  TextListPlot[{{x1, y1, t1}, {x2, y2, t2}, ...}]
  77. renders the point {xi,yi} as the text ti.";
  78.  
  79. LabeledListPlot::usage =
  80. "LabeledListPlot[{y1, y2, ...}] plots a list, with each point {i,yi} labeled
  81. with its index number i.  LabeledListPlot[{{x1,y1},{x2,y2}, ...}] labels the
  82. point {xi,yi} with its index number i.  TextListPlot[{{x1, y1, t1},
  83. {x2, y2, t2}, ...}] labels the point {xi,yi} with the text ti.";
  84.  
  85. DisplayTogether::usage =
  86. "DisplayTogether[plotcommands, opts] takes a sequence of plot commands (e.g.,
  87. Plot[Sin[x], {x,0, 2 Pi}], etc.) and combines them to produce a single
  88. graphic.  The constraints on this are that the commands must all be able
  89. to accept the option DisplayFunction->Identity as an argument, and must
  90. all produce graphics that can be shown together by use of the Show
  91. command. Options for the type of graphic to be produced can be passed in."
  92.  
  93. DisplayTogetherArray::usage =
  94. "DisplayTogether[plotcommands, opts] takes a sequence of plot commands (e.g.,
  95. Plot[Sin[x], {x,0, 2 Pi}], etc.) and combines them to produce a GraphicsArray
  96. of the plots.  The constraint on this is that the commands must all be able
  97. to accept the option DisplayFunction->Identity as an argument. Note that the
  98. plotcommands can also be placed in an array, suitable for arranging the
  99. output GraphicsArray.  Options for GraphicsArray can be passed in."
  100.  
  101. ListAndCurvePlot::usage =
  102. "ListAndCurvePlot[list1,list2,...,curve1,curve2...,range] puts
  103. curves in a single variable and lists of data in a single plot.
  104. Curves are given as in Plot, lists as in ListPlot.  The range is
  105. specified as in Plot, and is used in the same fashion.  The
  106. function accepts standard Graphics options, plus PlotStyle
  107. (which works as in Plot).  Lists and curves can be specified in
  108. any order, and can be intermixed.";
  109.  
  110. LogPlot::usage =
  111. "LogPlot[f, {x, xmin, xmax}] generates a plot of Log[f] as a function of x.";
  112.  
  113. LogListPlot::usage =
  114. "LogListPlot[{y1, y2, ...}] or LogListPlot[{{x1, y1}, {x2, y2}, ...}] generates
  115. a plot of Log[yi] against the xi.";
  116.  
  117. LinearLogPlot::usage =
  118. "LinearLogPlot[f, {x, xmin, xmax}] generates a plot of Log[f] as a function
  119. of x.";
  120.  
  121. LinearLogListPlot::usage =
  122. "LinearLogListPlot[{y1, y2, ...}] or
  123. LinearLogListPlot[{{x1, y1}, {x2, y2}, ...}] generates
  124. a plot of Log[yi] against the xi.";
  125.  
  126. LogLinearPlot::usage = 
  127. "LogLinearPlot[f, {x, xmin, xmax}] generates a plot of f as a function of
  128. Log[x]." ;
  129.  
  130. LogLinearListPlot::usage = 
  131. "LogLinearListPlot[{y1, y2, ...}] or
  132. LogLinearListPlot[{{x1, y1}, {x2, y2}, ...}] generates a plot of yi against
  133. Log[xi].";
  134.  
  135. LogLogPlot::usage = 
  136. "LogLogPlot[f, {x, xmin, xmax}] generates a plot of Log[f] as a function of
  137. Log[x]." ;
  138.  
  139. LogLogListPlot::usage = 
  140. "LogLogListPlot[{y1, y2, ...}] or LogLogListPlot[{{x1, y1}, {x2, y2}, ...}]
  141. generates a plot of Log[yi] against Log[xi].";
  142.  
  143. ScaledPlot::usage =
  144. "ScaledPlot[f, {x, xmin, xmax}] generates a plot of the function
  145. with each coordinate scaled by a function specified by the Scale
  146. option."
  147.  
  148. ScaledListPlot::usage =
  149. "ScaledListPlot[data] generates a plot with each data point scaled
  150. by functions specified in the Scale option."
  151.  
  152. Scale::usage =
  153. "Scale is an option for ScaledPlot and ScaledListPlot.  It
  154. is given as a pure function or a pair of pure functions; the
  155. first is applied to all x values, the second to all y values."
  156.  
  157. PolarPlot::usage =
  158. "PolarPlot[r, {t, tmin, tmax}] generates a polar plot of r as a function of t.
  159. PolarPlot[{r1, r2, ...}, {t, tmin, tmax}] plots each of the ri as a function of
  160. t on the same graph.";
  161.  
  162. PolarListPlot::usage =
  163. "PolarListPlot[{r1, r2, ...}] generates a polar plot, assuming that the ri are
  164. equally spaced in angle.";
  165.  
  166. ErrorListPlot::usage =
  167. "ErrorListPlot[{{y1, dy1}, {y2, dy2}, ...}] plots a list of data with error
  168. bars. ErrorListPlot[{{x1, y1, dy1}, ...}] allows x, as well as y, positions to
  169. be specified.";
  170.  
  171. BarChart::usage =
  172. "BarChart[list1, list2, ...] generates a bar chart of the data in the lists.";
  173.  
  174. GeneralizedBarChart::usage =
  175. "GeneralizedBarChart[{{pos1, height1, width1}, {pos2, height2, width2},...}]
  176. generates a bar chart with the bars at the given positions, heights, and
  177. widths.";
  178.  
  179. StackedBarChart::usage =
  180. "StackedBarChart[list1, list2, ...] generates a stacked bar chart of the
  181. data in the lists.";
  182.  
  183. PercentileBarChart::usage =
  184. "PercentileBarChart[list1, list2, ...] generates a stacked bar chart with
  185. the data scaled so that the sum of the absolute values at a given point is 1.";
  186.  
  187. (* The option BarStyle specifies the default style for the bars.  BarSpacing
  188. gives the fraction of the bar width to be allowed as separation between the 
  189. bars.  BarEdges specifies whether edges are to be drawn around the bars.
  190. BarEdgeStyle gives the style for the edges. BarOrientation can be either
  191. Horizontal or Vertical to specify the orientation of the bars. *)
  192.  
  193. BarStyle::usage =
  194. "BarStyle is an option for the bar charts that determines the default style
  195. for the bars.  If there is only one data set, the styles are cycled amongst
  196. the bars; if there are multiple data sets, the styles are cycled amongst
  197. the sets.  If it is a function, the function is applied to the heights of
  198. each of the bars.";
  199.  
  200. BarLabels::usage =
  201. "BarLabels is an option for BarChart, StackedBarChart, and PercentileBarChart,
  202. that allows a label to be placed at the tick mark for each bar (or group of
  203. bars for multiple data sets).  Labels are specified in a list.";
  204.  
  205. BarValues::usage =
  206. "BarValues is an option for BarChart and GeneralizedBarChart that allows
  207. the length of the bar to be displayed above each bar.  See also
  208. BarValuePosition.";
  209.  
  210. BarEdges::usage =
  211. "BarEdges is an option for the bar charts that determines whether edges are to be
  212. drawn around the bars.";
  213.  
  214. BarEdgeStyle::usage =
  215. "BarEdgeStyle is an option for the bar charts that determines the style for the
  216. edges.";
  217.  
  218. BarSpacing::usage =
  219. "BarSpacing is an option for BarChart that determines the fraction of the
  220. bar width of a bar to space the bars in a group of bars; or, in 
  221. StackedBarChart and PercentileBarChart, the space between the bars.  See
  222. also BarGroupSpacing.";
  223.  
  224. BarGroupSpacing::usage =
  225. "BarGroupSpacing is an option for BarChart that determines the spacing
  226. between groups of bars (individual bars when only one data set is used).";
  227.  
  228. BarOrientation::usage =
  229. "BarOrientation is an option for BarChart that determines whether the bars are
  230. oriented vertically or horizontally.";
  231.  
  232. Vertical::usage = Horizontal::usage =
  233. "Vertical and Horizontal are possible values for BarOrientation, an option of
  234. BarChart.";
  235.  
  236. PieChart::usage =
  237. "PieChart[{y1, y2, ...}] generates a pie chart of the values yi.
  238. The values yi need to be positive. Several options (PieLabels,
  239. PieStyle, PieLineStyle, PieExploded) are available to modify
  240. the style of the pie.";
  241.  
  242. PieLabels::usage =
  243. "PieLabels is an option for PieChart; it accepts a list of
  244. expressions to be used as labels on the pie wedges. If None,
  245. no labels are placed.";
  246.  
  247. PieStyle::usage =
  248. "PieStyle is an option for PieChart; it accepts a list of
  249. styles that are matched with the polygon for each pie wedge.
  250. Default behavior will give each wedge a different color.";
  251.  
  252. PieLineStyle::usage =
  253. "PieLineStyle is an option for PieChart.  It accepts a style
  254. or list of styles that will be applied to all of the lines in
  255. the pie chart (around the wedges).";
  256.  
  257. PieExploded::usage =
  258. "PieExploded is an option for PieChart.  It accepts a list of
  259. distances or pairs of a wedge number and a matching distance.
  260. Distances are expressed as a ratio of the distance to the
  261. radius of the pie; ie, .1 moves a wedge outward 1/10th the
  262. radius of the pie.  Wedges are numbered counterclockwise from
  263. theta = 0 (a line extending right from the center of the pie).";
  264.  
  265. TransformGraphics::usage =
  266. "TransformGraphics[graphics, f] applies the function f to all lists of
  267. coordinates in graphics.";
  268.  
  269. SkewGraphics::usage =
  270. "SkewGraphics[graphics, m] applies the matrix m to all coordinates in graphics.";
  271.  
  272. PlotStyle::usage =
  273. "PlotStyle is an option for Plot and ListPlot that specifies the style of lines
  274. or points to be plotted.  PlotStyle[graphics] will return the PlotStyle for
  275. a graphic image created by Plot or ListPlot.";
  276.  
  277. Begin["`Private`"]
  278.  
  279. (* Define a better NumberQ *)
  280.  
  281. numberQ[x_] := NumberQ[N[x]]
  282.  
  283. (* The following is a useful internal utility function to be
  284. used when you have a list of values that need to be cycled to
  285. some length (as PlotStyle works in assigning styles to lines
  286. in a plot).  The list is the list of values to be cycled, the
  287. integer is the number of elements you want in the final list. *)
  288.  
  289. CycleValues[{},_] := {}
  290.  
  291. CycleValues[list_List, n_Integer] :=
  292.     Module[{hold = list},
  293.         While[Length[hold] < n,hold = Join[hold,hold]];
  294.         Take[hold,n]
  295.     ]
  296.  
  297. CycleValues[item_,n_] := CycleValues[{item},n]
  298.  
  299. (* PlotStyle *)
  300.  
  301. Unprotect[PlotStyle];
  302.  
  303. PlotStyle[Graphics[g:{{__,_List}..},opts___]] :=
  304.   Map[PlotStyle[Graphics[#,opts]]&, g]
  305.  
  306. PlotStyle[Graphics[g_List,opts___]] := 
  307.     Module[{q},
  308.      If[
  309.       Length[
  310.        q=Select[Drop[g,-1],
  311.                  MemberQ[{RGBColor,GrayLevel,Thickness,Dashing,PointSize},
  312.                  Head[#]]&
  313.            ]
  314.         ] > 1,
  315.        {q}, q]]
  316.  
  317. Protect[PlotStyle];
  318.  
  319. (* Linear Scale *)
  320.  
  321. LinearScale[min_, max_, n_Integer:8] :=
  322.     Module[{spacing, t, nmin=N[min], nmax=N[max]},
  323.         (spacing = TickSpacing[nmax-nmin, n, {1, 2, 2.5, 5, 10}] ;
  324.         t = Range[Ceiling[nmin/spacing - 0.05] spacing, max, spacing] ;
  325.         Map[{#, If[Round[#]==#, Round[#], #]}&, t])
  326.     /; nmin < nmax
  327.     ]
  328.  
  329. TickSpacing[dx_, n_Integer, prefs_List] :=
  330.     Module[ { dist=N[dx/n], scale } ,
  331.         scale = 10.^Floor[Log[10., dist]] ;
  332.         dist /= scale ;
  333.         If[dist < 1, dist *= 10 ; scale /= 10] ;
  334.         If[dist >= 10, dist /= 10 ; scale *= 10] ;
  335.         scale * First[Select[prefs, (dist <= #)&]]
  336.     ]
  337.  
  338. (* LogScale *)
  339.  
  340. LogScale[min_, max_, n_Integer:6] :=
  341.         Module[{pts} ,
  342.         pts = GenGrid[ min, max, n] ;
  343.         Join[ Map[ LogTicks, pts ], MinorLogTicks[pts]]
  344.     ] /; N[min] < N[max]
  345.  
  346. LogGridMajor[ min_, max_, n_Integer:6] :=
  347.         Module[{pts} ,
  348.                 pts = GenGrid[ min, max, n] ; 
  349.                 Map[ Log[10, #]& , pts ]
  350.         ] /; N[min] < N[max]
  351.  
  352. LogGridMinor[ min_, max_, n_Integer:6] :=
  353.         Module[{pts} ,
  354.                 pts = GenGrid[ min, max, n] ; 
  355.         Union[ Map[ Log[10., #]&,pts],
  356.                        Map[ First, MinorLogTicks[pts]]]
  357.         ] /; N[min] < N[max]
  358.  
  359. GenGrid[min_, max_, n_Integer:6] :=
  360.         Module[{nmin=N[min], nmax=N[max], imin, imax, nper, t, tl} ,
  361.                 imin=Round[nmin] ;
  362.                 imax=Round[nmax] ;
  363.                 If[imin == imax, imax+=1];
  364.                 nper = Floor[n/(imax - imin)] ;
  365.                 If[nper > 0,
  366.                         t = 10.^Range[imin, imax] ;
  367.                         tl = Take[ $LogPreferances,
  368.                                 Min[nper, Length[$LogPreferances]] ] ;
  369.                         t = Flatten[Outer[Times, t, tl]] ;
  370.                         t = Sort[t] ,
  371.                         (* else *)
  372.                         nper = Ceiling[(imax - imin)/n] ;
  373.                         t = 10.^Range[imin, imax, nper]
  374.                 ] ;
  375.     t
  376.         ]
  377.  
  378. LogTicks[x_] :=
  379.     {Log[10., x],NumberForm[x]}
  380.  
  381. MinorLogTicks[pts_] :=
  382.         Module[ {cd1=pts, cd2 },
  383.                 cd2 = Transpose[{ Drop[cd1, {1}],
  384.                                      Drop[Map[ Minus, cd1], {-1}]}] ;
  385.                 cd2 = Apply[ Plus, cd2, 1] ;
  386.                 cd2 = Map[ MinorAux1, cd2] ;
  387.                 cd1 = Transpose[ { Drop[cd1, {-1}], cd2}] ;
  388.                 Flatten[ Map[ MinorAux2, cd1], 1]
  389.         ]       
  390.  
  391.  
  392. MinorAux2[{xst_, {del_ , n_}}] :=
  393.         Module[{xfin = xst+del*(n-1),pts,x},
  394.                 pts = Table[x, {x, xst+del, xfin, del}] ;
  395.                 Map[ {Log[10., #], "", {0.6/160., 0.},
  396.                                 {Thickness[0.001]}}&, pts ]
  397.         ]
  398.  
  399.  
  400. MinorAux1[x_] :=
  401.         Module[{n=Floor[ x/10^Floor[ Log[10., x]]]},
  402.                 If[ n < 1, {1,1}, {x/n, n}]
  403.         ]
  404.  
  405. $LogPreferances = {1, 5, 2, 3, 1.5, 7, 4, 6, 1.2, 8, 9, 1.3, 2.5, 1.1, 1.4}
  406. {1, 5, 2, 3, 1.5, 7, 4, 6, 1.2, 8, 9, 1.3, 2.5, 1.1, 1.4}
  407.  
  408. (* UnitScale *)
  409.  
  410. UnitScale[min_, max_, unit_, n_Integer:8] :=
  411.     Module[{spacing, t,
  412.         imin=Ceiling[N[min/unit]],imax = Floor[N[max/unit]]},
  413.         (spacing = TickSpacing[imax-imin, n, {1, 2, 5, 10}] ;
  414.         t = Range[Ceiling[imin/spacing - 0.05] spacing, imax,
  415.                 spacing] ;
  416.         t = Union[Round[t]] ;
  417.         Map[{N[# unit], # unit}&, t])
  418.     /; N[min] < N[max]
  419.     ]
  420.  
  421. (* PiScale *)
  422.  
  423. PiScale[min_, max_, n_Integer:8] :=
  424.     UnitScale[min, max, Pi/2, n] /; min < max
  425.  
  426. (* TextListPlot *)
  427.  
  428. TextListPlot[data:{_?numberQ ..}, opts___] :=
  429.         TextListPlot[Transpose[{Range[Length[data]], 
  430.                     data, Range[Length[data]]}]]
  431.  
  432. TextListPlot[data:{{_?numberQ, _}..}, opts___] :=
  433.         TextListPlot[Transpose[Join[Transpose[data], {Range[Length[data]]}]]]
  434.  
  435. TextListPlot[data:{{_?numberQ, _?numberQ, _}..}, opts___] :=
  436.         Show[Graphics[ Text[Last[#], Take[#, 2]]& /@ data,
  437.                         opts, Axes->Automatic]]
  438.  
  439. (* LabeledListPlot *)
  440.  
  441. LabeledListPlot[data:{_?numberQ ..}, opts___] :=
  442.         LabeledListPlot[Transpose[{Range[Length[data]],
  443.                                         data, Range[Length[data]]}]]
  444.  
  445. LabeledListPlot[data:{{_?numberQ, _}..}, opts___] :=
  446.         LabeledListPlot[Transpose[Join[Transpose[data], {Range[Length[data]]}]]]
  447.  
  448. LabeledListPlot[data:{{_?numberQ, _?numberQ, _}..}, opts___] :=
  449.     Show[Graphics[ {PointSize[0.015], {Point[Take[#, 2]], 
  450.         Text[Last[#], Scaled[{0.015, 0}, Take[#, 2]], {-1, 0}]
  451.             } } & /@ data ,
  452.         opts, Axes->Automatic]]
  453.  
  454. (* Log Plots *)
  455.  
  456. SetAttributes[{LogPlot, LinearLogPlot, LogLinearPlot, LogLogPlot, 
  457.     ScaledPlot}, HoldFirst];
  458.  
  459. (* adopt as default options those of ParametricPlot and ListPlot *)
  460.  
  461. Options[LogPlot] = Options[LogLinearPlot] = Options[LinearLogPlot] =
  462.     Options[LogLogPlot] = Options[ParametricPlot];
  463.  
  464. Options[LogListPlot] = Options[LogLinearListPlot] = Options[LinearLogListPlot] =
  465.     Options[LogLogListPlot] = Options[ListPlot];
  466.  
  467. LogPlot = LinearLogPlot; LogListPlot = LinearLogListPlot;
  468.  
  469. LinearLogPlot[fun_,range_,opts___] :=
  470.     ScaledPlot[fun,range,
  471.         Scale -> {#&, Log[10,#]&},
  472.         Sequence @@ tickopts[Automatic, LogScale,
  473.              LinearLogPlot, {opts}],
  474.         scaleplotrange[LinearLogPlot, {opts}],
  475.         opts,
  476.         Sequence @@ Options[LinearLogPlot]
  477.     ]
  478.  
  479. LogLinearPlot[fun_, range_, opts___] :=
  480.     ScaledPlot[fun, range,
  481.         Scale -> {Log[10, #]&, #&},
  482.         Sequence @@ tickopts[LogScale, Automatic,
  483.             LogLinearPlot, {opts}],
  484.         scaleplotrange[LogLinearPlot, {opts}],
  485.         opts,
  486.         Sequence @@ Options[LogLinearPlot]
  487.     ]
  488.  
  489. LogLogPlot[fun_, range_, opts___] :=
  490.     ScaledPlot[fun, range,
  491.         Scale -> {Log[10, #]&, Log[10, #]&},
  492.         Sequence @@ tickopts[LogScale, LogScale,
  493.             LogLogPlot, {opts}],
  494.         scaleplotrange[LogLogPlot, {opts}],
  495.         opts,
  496.         Sequence @@ Options[LogLogPlot]
  497.     ]
  498.  
  499. LinearLogListPlot[data_, opts___] :=
  500.     ScaledListPlot[data,
  501.         Scale -> {#&, Log[10,#]&},
  502.         Sequence @@ tickopts[Automatic, LogScale,
  503.              LinearLogListPlot, {opts}],
  504.         scaleplotrange[LinearLogListPlot, {opts}],
  505.         opts,
  506.         Sequence @@ Options[LinearLogListPlot]
  507.     ]
  508.  
  509. LogLinearListPlot[data_, opts___] :=
  510.     ScaledListPlot[data,
  511.         Scale -> {Log[10, #]&, #&},
  512.         Sequence @@ tickopts[LogScale, Automatic,
  513.             LogLinearListPlot, {opts}],
  514.         scaleplotrange[LogLinearListPlot, {opts}],
  515.         opts,
  516.         Sequence @@ Options[LogLinearListPlot]
  517.     ]
  518.  
  519. LogLogListPlot[data_, opts___] :=
  520.     ScaledListPlot[data,
  521.         Scale -> {Log[10, #]&, Log[10, #]&},
  522.         Sequence @@ tickopts[LogScale, LogScale,
  523.             LogLogListPlot, {opts}],
  524.         scaleplotrange[LogLogListPlot, {opts}],
  525.         opts,
  526.         Sequence @@ Options[LogLogListPlot]
  527.     ]
  528.  
  529. (* this is an internal auxiliary function for the Log Plots
  530.     (and any other plot that calls ScaledPlot); it allows easy
  531.     specification of scales to be used for tick marks and
  532.     grid lines.
  533. *)
  534.  
  535. tickopts[xfun_, yfun_, deffunc_, opts_] :=
  536.     Module[{tick, frame, grid},
  537.         {tick, frame, grid} = {Ticks, FrameTicks, GridLines}/.
  538.             opts/.Options[deffunc];
  539.         {Ticks -> If[tick === Automatic,
  540.             {xfun,yfun},
  541.             tick],
  542.         FrameTicks -> If[frame === Automatic,
  543.             {xfun, yfun, xfun, yfun},
  544.             frame],
  545.         GridLines -> If[grid === Automatic,
  546.             {If[xfun === Automatic,
  547.                 xfun,
  548.                 (Map[First, xfun[#1,#2]] &)],
  549.             If[yfun === Automatic,
  550.                 yfun,
  551.                 (Map[First, yfun[#1,#2]] &)]},
  552.             grid]}
  553.     ]
  554.  
  555. (* scaleplotrange is an auxilliary hack to fix the plot range problem;
  556.     the range should be in scaled coordinates, not in original coordinates.
  557.     This transforms them, with a separate transformation defined for each
  558.     function.  Not the ideal solution, but sufficient as a kludge... note
  559.     that this introduces incompatability with any code that uses the old
  560.     plot ranges...
  561. *)
  562.  
  563. scaleplotrange[type:(LogPlot | LinearLogPlot | LogListPlot | LinearLogListPlot),
  564.         options_] :=
  565.     PlotRange -> Replace[PlotRange/.options/.Options[type],
  566.             {{x_List, y_List} -> {x,Log[10,y]},
  567.             y_List -> Log[10,y]}]
  568.  
  569. scaleplotrange[type:(LogLinearPlot | LogLinearListPlot),
  570.         options_] :=
  571.     PlotRange -> Replace[PlotRange/.options/.Options[type],
  572.             {x_List, y_List} -> {Log[10,x],y}]
  573.  
  574. scaleplotrange[type:(LogLogPlot | LogLogListPlot),
  575.         options_] :=
  576.     PlotRange -> Replace[PlotRange/.options/.Options[type],
  577.             y_List -> Log[10,y]]
  578.  
  579. (* Scaled Plot *)
  580.  
  581. Options[ScaledPlot] =
  582.     {Scale -> (# &), DisplayFunction :> $DisplayFunction};
  583.  
  584. ScaledPlot[funcs_List,{x_Symbol,xmin_,xmax_},opts___] :=
  585.     Module[{scale,g,r,popts, xs, ys, disp,ao},
  586.         {scale, disp,ao} = {Scale, DisplayFunction, AxesOrigin}/.
  587.             {opts}/.Options[ScaledPlot];
  588.         popts = FilterOptions[ParametricPlot, opts];
  589.         If[Head[scale] =!= List,
  590.             scale = {scale, scale}
  591.         ];
  592.         If[Length[scale] > 2,
  593.             scale = Take[scale,2]
  594.         ];
  595.         {xs, ys} = scale;
  596.         g = ParametricPlot[
  597.             Evaluate[
  598.                 Map[{xs[x], ys[#]}&,
  599.                     funcs],
  600.                 {x, xmin, xmax},
  601.             DisplayFunction -> Identity,
  602.             popts]];
  603.         r = PlotRange[g];
  604.         If[ao === Automatic,
  605.             ao = Map[#[[1]]&,r],
  606.             ao = {xs[First[ao]], ys[Last[ao]]}
  607.         ];
  608.         Show[g, DisplayFunction -> disp,
  609.             PlotRange -> r,
  610.             AxesOrigin -> ao
  611.         ]
  612.     ]
  613.  
  614. ScaledPlot[f_, range_, opts___] :=
  615.     ScaledPlot[{f}, range, opts]
  616.  
  617. (* Scaled List Plot *)
  618.  
  619. Options[ScaledListPlot] =
  620.     {Scale -> (# &), DisplayFunction :> $DisplayFunction};
  621.  
  622. ScaledListPlot[data:{{_?numberQ,_?numberQ}..}, opts___] :=
  623.     Module[{scale, g, r, xs, ys, lopts, disp, ao},
  624.         {scale, disp, ao} = {Scale, DisplayFunction, AxesOrigin}/.
  625.             {opts}/.Options[ScaledPlot];
  626.         lopts = FilterOptions[ListPlot, opts];
  627.         If[Head[scale] =!= List,
  628.             scale = {scale, scale}
  629.         ];
  630.         If[Length[scale] > 2,
  631.             scale = Take[scale,2]
  632.         ];
  633.         {xs, ys} = scale;
  634.         g = ListPlot[
  635.                 Map[{xs[ #[[1]] ], ys[ #[[2]] ]}&,
  636.                     data],
  637.             DisplayFunction -> Identity,
  638.             lopts];
  639.         r = PlotRange[g];
  640.         If[ao === Automatic,
  641.             ao = Map[#[[1]]&,r],
  642.             ao = {xs[First[ao]], ys[Last[ao]]}
  643.         ];
  644.         Show[g, DisplayFunction -> disp,
  645.             PlotRange -> r,
  646.             AxesOrigin -> ao
  647.         ]
  648.     ]
  649.  
  650. ScaledListPlot[data:{_?numberQ..}, opts___] :=
  651.     ScaledListPlot[Transpose[{Range[Length[data]],data}], opts]
  652.  
  653. (* PolarPlot  *)
  654.  
  655. SetAttributes[PolarPlot, HoldAll]
  656.  
  657. PolarPlot[r_List, {t_, tmin_, tmax_}, opts___] :=
  658.     ParametricPlot[Evaluate[Transpose[{r Cos[t], r Sin[t]}]],
  659.         {t, tmin, tmax}, opts, AspectRatio->Automatic]
  660.  
  661. PolarPlot[r_, {t_, tmin_, tmax_}, opts___] :=
  662.     ParametricPlot[{r Cos[t], r Sin[t]}, {t, tmin, tmax}, opts,
  663.         AspectRatio->Automatic]
  664.  
  665. (* PolarListPlot *)
  666.  
  667. PolarListPlot[rlist_List, opts___] :=
  668.     ListPlot[ rlist * Map[{Cos[#], Sin[#]}&, 
  669.             2Pi/Length[rlist] Range[0, Length[rlist]-1]], 
  670.     opts, AspectRatio->Automatic ]
  671.  
  672. (* ErrorListPlot *)
  673.  
  674. ErrorListPlot[l2:{{_, _}..}] :=
  675.         Module[ {i}, 
  676.     ErrorListPlot[ Table[Prepend[l2[[i]], i], {i, Length[l2]}] ] ]
  677.  
  678. ErrorListPlot[l3:{{_, _, _}..}] :=
  679.         Show[ Graphics[ { PointSize[0.015], Thickness[0.002],
  680.                 Module[ {i, x, y, dy} , 
  681.                 Table[ 
  682.                         {x, y, dy} = l3[[i]] ;
  683.                         { Line[ {{x, y-dy}, {x, y+dy}} ],
  684.                         Point[ {x, y} ] } ,
  685.                         {i, Length[l3]}
  686.                 ] ] } ], Axes -> Automatic ]
  687.  
  688. (* DisplayTogether and DisplayTogetherArray.  These take a series of plot commands,
  689.     and combine the resulting graphics to produce a single graphic, rather
  690.     than the output of the individual commands.  The constraint is that
  691.     the plot commands must all accept the option DisplayFunction->Identity,
  692.     and all commands must be able to be shown together via Show.  Note
  693.     that this second constraint is not present for DisplayTogetherArray, since
  694.     it produces a GraphicsArray as output.
  695. *)
  696.  
  697. Attributes[DisplayTogether] = {HoldAll};
  698.  
  699. DisplayTogether[plots__, opts:(_Rule | _RuleDelayed)...] :=
  700.     Show[insertoption[{plots}, DisplayFunction -> Identity],
  701.         opts, DisplayFunction -> $DisplayFunction]
  702.  
  703. Attributes[DisplayTogetherArray] = {HoldAll};
  704.  
  705. DisplayTogetherArray[plotarray_List,opts:(_Rule | _RuleDelayed)...] :=
  706.     Show[GraphicsArray[insertoption[plotarray,
  707.             DisplayFunction -> Identity]],
  708.         opts, DisplayFunction -> $DisplayFunction]
  709.  
  710. DisplayTogetherArray[plots__,opts:(_Rule | _RuleDelayed)...] :=
  711.     Show[GraphicsArray[insertoption[{plots},
  712.             DisplayFunction -> Identity]],
  713.         opts, DisplayFunction -> $DisplayFunction]
  714.  
  715. Attributes[insertoption] = {HoldFirst, Listable};
  716.  
  717. insertoption[thing_,option_] :=
  718.     Module[{gtype, list, rpos},
  719.         gtype = ReleaseHold[HeldPart[Hold[thing],1,0]];
  720.         list = ReleaseHold[ReplaceHeldPart[Hold[thing],
  721.                     List, {1, 0}]];
  722.         rpos = Position[list,(_Rule | _RuleDelayed), {1},
  723.                     Heads -> False];
  724.         If[rpos === {},
  725.             gtype @@ Append[list,option],
  726.             gtype @@ Insert[list,option,First[rpos]]
  727.         ]
  728.     ]
  729.  
  730. (* List and Curve Plot.  This function generates plots combining
  731. data and curves. *)
  732.  
  733. Options[ListAndCurvePlot] =
  734.     {PlotStyle -> Automatic};
  735.  
  736. ListAndCurvePlot[data__,range:{_Symbol,_,_},
  737.         opts:((_Rule | _RuleDelayed)...)] :=
  738.     Module[{ps, lpopts, popts, gopts},
  739.         {ps} = {PlotStyle}/.{opts}/.Options[ListAndCurvePlot];
  740.         lpopts = FilterOptions[ListPlot,opts];
  741.         popts = FilterOptions[Plot, opts];
  742.         gopts = FilterOptions[Graphics, opts];
  743.         If[ps === Automatic || ps === {},
  744.             ps = {GrayLevel[0]}];
  745.         ps = CycleValues[ps, Length[{data}]];
  746.         plots = MapThread[If[MatchQ[#1,{__?(NumberQ[N[#]]&)} |
  747.                     {{__?(NumberQ[N[#]]&)}..}],
  748.                 ListPlot[#1, DisplayFunction -> Identity,
  749.                         PlotStyle -> #2, lpopts],
  750.                 Plot[#1, range, DisplayFunction -> Identity,
  751.                         PlotStyle -> {#2}, Evaluate[popts]]
  752.                 ]&,
  753.             {{data},ps}];
  754.         Show[plots, gopts, DisplayFunction -> $DisplayFunction]
  755.     ]
  756.  
  757. (* BarCharts -
  758.     BarChart, GeneralizedBarChart, StackedBarChart, PercentileBarChart.
  759.     with the internal RectanglePlot and small utilities *)
  760.  
  761. (* RectanglePlot *)
  762.  
  763. Options[RectanglePlot] =
  764.     {RectangleStyle -> Automatic,
  765.     EdgeStyle -> Automatic,
  766.     ObscuredFront -> False};
  767.  
  768. RectanglePlot[boxes:{{{_?numberQ,_?numberQ},{_?numberQ,_?numberQ}}..},
  769.         opts___] :=
  770.     Module[{ln = Length[boxes], bsytle, estyle, gopts},
  771.     (* Handle options and defaults *)
  772.         {bstyle, estyle,sort} = {RectangleStyle, EdgeStyle,
  773.             ObscuredFront}/.{opts}/.
  774.             Options[RectanglePlot];
  775.         gopts = FilterOptions[Graphics, opts];
  776.         If[bstyle === Automatic,
  777.             bstyle = Map[Hue,.6 Range[0, ln - 1]/(ln - 1)]];
  778.         If[bstyle === None, bstyle = {}];
  779.         If[estyle === Automatic, estyle = {GrayLevel[0]}];
  780.         If[estyle === None, estyle = {}];
  781.         bstyle = CycleValues[bstyle,ln];
  782.         estyle = CycleValues[estyle,ln];
  783.     (* generate shapes *)
  784.         recs = If[bstyle === {},
  785.             Table[{},{ln}],
  786.             Transpose[{bstyle, Apply[Rectangle, boxes,{1}]}]];
  787.         lrecs = If[estyle === {},
  788.             Table[{},{ln}],
  789.             Transpose[{estyle, Map[LineRectangle, boxes]}]];
  790.     (* sort 'em *)
  791.         recs = Map[Flatten,
  792.             If[TrueQ[sort],
  793.                 Sort[Transpose[{recs,lrecs}], coversQ],
  794.                 Transpose[{recs, lrecs}]
  795.             ],
  796.             {2}
  797.         ];
  798.     (* show 'em *)
  799.         Show[Graphics[recs],gopts]
  800.     ]
  801.  
  802. RectanglePlot[boxes:{{_?numberQ,_?numberQ}..}, opts___] :=
  803.     RectanglePlot[Map[{#, # + 1}&,boxes],opts]
  804.  
  805. LineRectangle[pts:{{x1_,y1_}, {x2_,y2_}}] :=
  806.     Line[{{x1,y1},{x1,y2},{x2,y2},{x2,y1},{x1,y1}}]
  807.  
  808. coversQ[{{___,Rectangle[{x11_,y11_}, {x12_,y12_}]},___},
  809.         {{___,Rectangle[{x21_,y21_}, {x22_,y22_}]},___}] :=
  810.     N[And[x11 <= x21 <= x12,
  811.         x11 <= x22 <= x12,
  812.         y11 <= y21 <= y12,
  813.         y11 <= y22 <= y12]]
  814.  
  815. coversQ[___] := True
  816.  
  817. (* Bar Chart *)
  818.  
  819. Clear[BarChart]
  820.  
  821. Options[BarChart] =
  822.     {BarStyle -> Automatic,
  823.     BarSpacing -> Automatic,
  824.     BarGroupSpacing -> Automatic,
  825.     BarLabels -> Automatic,
  826.     BarValues -> False,
  827.     BarEdges -> True,
  828.     BarEdgeStyle -> GrayLevel[0],
  829.     BarOrientation -> Vertical};
  830.  
  831. BarChart[idata:{_?numberQ..}..,
  832.         opts:((_Rule | _RuleDelayed)...)] :=
  833.     Module[{data, ln = Length[{idata}], ticks, orig,rng,
  834.             lns = Map[Length,{idata}], bs, bgs, labels, width,gbopts},
  835.         {bs,bgs,labels,orient} = {BarSpacing, BarGroupSpacing,
  836.             BarLabels, BarOrientation}/.
  837.             {opts}/.Options[BarChart];
  838.         gbopts = FilterOptions[GeneralizedBarChart,
  839.             Sequence @@ Options[BarChart]];
  840.         bs = N[bs]; bgs = N[bgs];
  841.         If[bs === Automatic, bs = 0];
  842.         If[bgs === Automatic, bgs = .2];
  843.         Which[labels === Automatic,
  844.                 labels = Range[Max[lns]],
  845.             labels === None,
  846.                 Null,
  847.             True,
  848.                 labels = CycleValues[labels,Max[lns]]
  849.         ];
  850.         width = (1 - bgs)/ln;
  851.         data = MapIndexed[
  852.             {#2[[2]] + width (#2[[1]] - 1), #1, width - bs}&,
  853.             {idata},{2}];
  854.         If[labels =!= None,
  855.             ticks = {Transpose[{
  856.                         Range[Max[lns]] + (ln - 1)/2 width,
  857.                         labels}],
  858.                     Automatic},
  859.         (* else *)
  860.             ticks = {None, Automatic};
  861.         ];
  862.         orig = {1 - width/2 - bgs,0};
  863.         rng = {{1 - width/2 - bgs,
  864.                     Max[lns] + (ln - 1/2) width + bgs},
  865.                 Automatic};
  866.         If[orient === Horizontal,
  867.             ticks = Reverse[ticks]; orig = Reverse[orig];
  868.             rng = Reverse[rng]];
  869.         GeneralizedBarChart[Sequence @@ data, opts,
  870.             Ticks -> ticks,
  871.             AxesOrigin -> orig,
  872.             PlotRange -> rng,
  873.             FrameTicks -> ticks,
  874.             gbopts]
  875.     ]
  876.  
  877. (* For compatability only... *)
  878.  
  879. BarChart[list:{{_?numberQ, _}..},
  880.         opts:((_Rule | _RuleDelayed)...)] :=
  881.     Module[{lab,dat},
  882.         {dat, lab} = Transpose[list];
  883.         BarChart[dat, opts, BarLabels -> lab]
  884.     ]
  885.  
  886. BarChart[list:{{_?numberQ, _, _}..},
  887.         opts:((_Rule | _RuleDelayed)...)] :=
  888.     Module[{lab, sty, dat},
  889.         {dat, lab, sty} = Transpose[list];
  890.         BarChart[dat, opts, BarLabels -> lab, BarStyle -> sty]
  891.     ]
  892.  
  893. (* GeneralizedBarChart *)
  894.  
  895. Options[GeneralizedBarChart] =
  896.     {BarStyle -> Automatic,
  897.     BarValues -> False,
  898.     BarEdges -> True,
  899.     BarEdgeStyle -> GrayLevel[0],
  900.     BarOrientation -> Vertical};
  901.  
  902. GeneralizedBarChart::badorient =
  903. "The value given for BarOrientation is invalid; please use
  904. Horizontal or Vertical. The chart will be generated with
  905. Vertical.";
  906.  
  907. GeneralizedBarChart[idata:{{_?numberQ,_?numberQ,_?numberQ}..}..,
  908.         opts:((_Rule | _RuleDelayed)...)] :=
  909.     Module[{data = {idata}, bsty, val, vpos, unob, edge, esty, bsf,
  910.             orient, ln = Length[{idata}],
  911.             lns = Map[Length,{idata}], bars, disp},
  912.     (* Get options *)
  913.         {bsty, val, edge, esty, orient} =
  914.             {BarStyle, BarValues, BarEdges, BarEdgeStyle,
  915.             BarOrientation}/.{opts}/.Options[GeneralizedBarChart];
  916.         gopts = FilterOptions[Graphics,opts];
  917.         disp = DisplayFunction/.{opts}/.Options[Graphics];
  918.     (* Handle defaults and error check options *)
  919.         If[bsty =!= Automatic && Head[bsty] =!= List,
  920.             bsty = Join @@ Map[bsty[#[[2]]]&,data,{2}],
  921.             bsty = barcoloring[bsty, ln, lns]
  922.         ];
  923.         If[TrueQ[edge],
  924.             If[ln === 1,
  925.                 esty = CycleValues[esty, Length[First[data]]],
  926.                 esty = Join @@ MapThread[Table[#1,{#2}]&,
  927.                     {CycleValues[esty,ln], lns}]
  928.             ],
  929.             esty = None
  930.         ];
  931.         If[!MemberQ[{Horizontal, Vertical},orient],
  932.             Message[GeneralizedBarChart::badorient,orient];
  933.                 orient = Vertical
  934.         ];
  935.         val = TrueQ[val];
  936.         vpos = .05;   (* was an option, position of value label; now hardcoded at
  937.                         swolf recommendation. *)
  938.     (* generate bars and labels, call RectanglePlot *)
  939.         data = Flatten[data,1];
  940.         bars = Map[barcoords[orient],data];
  941.         If[val,
  942.             Show[RectanglePlot[bars,
  943.                     RectangleStyle -> bsty,
  944.                     EdgeStyle -> esty,
  945.                     DisplayFunction -> Identity],
  946.                 Graphics[Map[varcoords[orient,vpos,(#&)],data]],
  947.                 Axes -> True,
  948.                 DisplayFunction -> disp,
  949.                 gopts,
  950.                 PlotRange -> All
  951.             ],
  952.         (* else *)
  953.             RectanglePlot[bars,
  954.                 RectangleStyle -> bsty,
  955.                     EdgeStyle -> esty,
  956.                     ObscuredFront -> unob,
  957.                     gopts,
  958.                     Axes -> True]
  959.         ]
  960.     ]
  961.  
  962. barcoords[Horizontal][{pos_,len_,wid_}] :=
  963.     {{0,pos - wid/2},{len,pos + wid/2}}
  964.  
  965. barcoords[Vertical][{pos_,len_,wid_}] :=
  966.     {{pos - wid/2, 0},{pos + wid/2, len}}
  967.  
  968. varcoords[Horizontal,offset_,format_][{pos_,len_,wid_}] :=
  969.     Text[format[len], Scaled[{Sign[len] offset, 0}, {len, pos}]]
  970.  
  971. varcoords[Vertical,offset_,format_][{pos_,len_,wid_}] :=
  972.     Text[format[len], Scaled[{0,Sign[len] offset}, {pos,len}]]
  973.  
  974. barcoloring[Automatic, 1, _] := {Hue[0]}
  975.  
  976. barcoloring[Automatic, ln_, lns_] :=
  977.     Join @@ MapThread[Table[#1,{#2}]&,
  978.         {Map[Hue[.6 #/(ln - 1)]&, Range[0, ln - 1]], lns}]
  979.  
  980. barcoloring[bsty_, 1, lns_] :=
  981.     CycleValues[bsty, First[lns]]
  982.  
  983. barcoloring[bsty_, ln_, lns_] :=
  984.     Join @@ MapThread[Table[#1,{#2}]&,
  985.                 {CycleValues[bsty, ln], lns}]
  986.  
  987. (* StackedBarChart *)
  988.  
  989. Options[StackedBarChart] =
  990.     {BarStyle -> Automatic,
  991.     BarSpacing -> Automatic,
  992.     BarLabels -> Automatic,
  993.     BarEdges -> True,
  994.     BarEdgeStyle -> GrayLevel[0],
  995.     BarOrientation -> Vertical};
  996.  
  997. StackedBarChart::badorient =
  998. "The value given for BarOrientation is invalid; please use
  999. Horizontal or Vertical. The chart will be generated with
  1000. Vertical.";
  1001.  
  1002. StackedBarChart::badspace =
  1003. "The value `1` given for the BarSpacing option is invalid;
  1004. please enter a number or Automatic.";
  1005.  
  1006. StackedBarChart[idata:{_?numberQ..}..,
  1007.         opts:((_Rule | _RuleDelayed)...)] :=
  1008.     Module[{data = {idata}, sty, space, labels, bv, bvp, edge,
  1009.             esty, orient, ln = Length[{idata}], add, tmp,
  1010.             lns = Map[Length,{idata}],ticks,orig,rng},
  1011.     (* process options *)
  1012.         {sty, space, labels, edge, esty, orient} =
  1013.             {BarStyle, BarSpacing, BarLabels,
  1014.             BarEdges, BarEdgeStyle,
  1015.             BarOrientation}/.{opts}/.Options[StackedBarChart];
  1016.         sty = barcoloring[sty, ln, lns];
  1017.         If[TrueQ[edge],
  1018.             If[ln === 1,
  1019.                 esty = CycleValues[esty, First[lns]],
  1020.                 esty = Join @@ MapThread[Table[#1,{#2}]&,
  1021.                     {CycleValues[esty,ln], lns}]
  1022.             ],
  1023.             esty = None
  1024.         ];
  1025.         If[!MemberQ[{Horizontal, Vertical},orient],
  1026.             Message[StackedBarChart::badorient,orient];
  1027.                 orient = Vertical
  1028.         ];
  1029.         Which[labels === Automatic,
  1030.                 labels = Range[Max[lns]],
  1031.             labels === None,
  1032.                 Null,
  1033.             True,
  1034.                 labels = CycleValues[labels,Max[lns]]
  1035.         ];
  1036.         If[!(numberQ[space] || (space === Automatic)),
  1037.             Message[StackedBarChart::badspace, space];
  1038.             space = Automatic];
  1039.         If[space === Automatic, space = .2];
  1040.         If[labels =!= None,
  1041.             ticks = {Transpose[{
  1042.                         Range[Max[lns]],
  1043.                         labels}],
  1044.                     Automatic},
  1045.         (* else *)
  1046.             ticks = {None, Automatic};
  1047.         ];
  1048.         orig = {1/2,0};
  1049.         rng = {{1/2,Max[lns] + 1/2}, Automatic};
  1050.             (* data to rectangles *)
  1051.         halfwidth = (1 - space)/2; width = (1 - space);
  1052.         ends = Table[{0,0},{Max[lns]}];
  1053.         data = Map[
  1054.             MapIndexed[
  1055.                 (If[Negative[N[#1]],
  1056.                     add = {0, #1};
  1057.                     tmp = {First[#2] - halfwidth,
  1058.                         Last[ends[[ First[#2] ]] ]},
  1059.                     (* else *)
  1060.                     add = {#1, 0};
  1061.                     tmp = {First[#2] - halfwidth,
  1062.                         First[ends[[ First[#2] ]] ]}
  1063.                 ];
  1064.                 ends[[ First[#2] ]] += add;
  1065.                 {tmp, tmp + {width, N[#1]}})&,
  1066.             #]&,
  1067.             data
  1068.         ];
  1069.         If[orient === Horizontal,
  1070.             ticks = Reverse[ticks]; orig = Reverse[orig];
  1071.             rng = Reverse[rng];
  1072.             data = Map[Reverse,data,{3}]];
  1073.     (* plot 'em! *)
  1074.         RectanglePlot[Flatten[data,1],
  1075.             RectangleStyle -> sty,
  1076.             EdgeStyle -> esty,
  1077.             opts,
  1078.             Axes -> True,
  1079.             AxesOrigin -> orig,
  1080.             PlotRange -> rng,
  1081.             Ticks -> ticks,
  1082.             FrameTicks -> ticks]
  1083.  
  1084.     ]
  1085.  
  1086. (* PercentileBarChart *)
  1087.  
  1088. Options[PercentileBarChart] =
  1089.     {BarStyle -> Automatic,
  1090.     BarSpacing -> Automatic,
  1091.     BarLabels -> Automatic,
  1092.     BarEdges -> True,
  1093.     BarEdgeStyle -> GrayLevel[0],
  1094.     BarOrientation -> Vertical};
  1095.  
  1096. PercentileBarChart[idata:{_?numberQ..}..,
  1097.         opts:((_Rule | _RuleDelayed)...)] :=
  1098.     Module[{data = {idata}, labels,
  1099.             orient, ln = Length[{idata}],
  1100.             lns = Map[Length,{idata}],xticks, yticks, ticks},
  1101.     (* options and default processing *)
  1102.         {labels, orient} = {BarLabels, BarOrientation}/.
  1103.             {opts}/.Options[PercentileBarChart];
  1104.         Which[labels === Automatic,
  1105.                 labels = Range[Max[lns]],
  1106.             labels === None,
  1107.                 Null,
  1108.             True,
  1109.                 labels = CycleValues[labels,Max[lns]]
  1110.         ];
  1111.         If[labels =!= None,
  1112.             xticks = Transpose[{Range[Max[lns]],labels}],
  1113.             xticks = Automatic
  1114.         ];
  1115.         If[MemberQ[ Flatten[Sign[N[data]]], -1],
  1116.             yticks = Transpose[{
  1117.                 Range[-1,1,.2],
  1118.                 Map[ToString[#] <> "%"&,Range[-100,100,20]]}],
  1119.             yticks = Transpose[{
  1120.                 Range[0,1,.1],
  1121.                 Map[ToString[#] <> "%"&, Range[0,100,10]]}]
  1122.         ];
  1123.         If[orient === Horizontal,
  1124.             ticks = {yticks, xticks},
  1125.             ticks = {xticks, yticks}
  1126.         ];
  1127.     (* process data - convert to percentiles *)
  1128.         data = Map[pad[#,Max[lns]]&, data];
  1129.         maxs = Apply[Plus, Transpose[Abs[data]],{1}];
  1130.         data = Map[MapThread[If[#2 == 0, 0, #1/#2]&,{#,maxs}]&,
  1131.             data];
  1132.     (* plot it! *)
  1133.         StackedBarChart[Sequence @@ data,
  1134.             opts,
  1135.             Ticks -> ticks,
  1136.             FrameTicks -> ticks,
  1137.             Sequence @@ Options[PercentileBarChart]
  1138.         ]
  1139.     ]
  1140.  
  1141. pad[list_, length_] := list/; Length[list] === length
  1142.  
  1143. pad[list_,length_] :=
  1144.     Join[list, Table[0,{length - Length[list]}]]
  1145.  
  1146. (* Pie Chart *)
  1147.  
  1148. Options[PieChart] =
  1149.     {PieLabels -> Automatic,
  1150.     PieStyle -> Automatic,
  1151.     PieLineStyle -> Automatic,
  1152.     PieExploded -> None};
  1153.  
  1154. (* The following line is for compatability purposes only... *)
  1155.  
  1156. PieChart[list:{{_?((numberQ[#] && NonNegative[N[#]])&), _}..}, opts___] :=
  1157.     PieChart[First[Transpose[list]],
  1158.         PieLabels->Last[Transpose[list]],opts]
  1159.  
  1160. PieChart[list:{_?((numberQ[#] && NonNegative[N[#]])&) ..}, opts___] :=
  1161.     Module[ {labels, styles, linestyle, tlist, thalf, text,offsets,halfpos,
  1162.                 len = Length[list],exploded,wedges,angles1,angles2,lines,
  1163.                 tmp},
  1164.     (* Get options *)
  1165.         {labels, styles, linestyle,exploded} =
  1166.             {PieLabels, PieStyle, PieLineStyle,PieExploded}/.
  1167.             {opts}/.Options[PieChart];
  1168.         gopts = FilterOptions[Graphics, opts];
  1169.     (* Error handling on options, set defaults *)
  1170.         If[Head[labels] =!= List || Length[labels] === 0,
  1171.             If[labels =!= None, labels = Range[len]],
  1172.             labels = CycleValues[labels, len]
  1173.         ];
  1174.         If[Head[styles] =!= List || Length[styles] === 0,
  1175.             styles = Map[Hue, (Range[len] - 1)/(len - 1) .7],
  1176.             styles = CycleValues[styles, len]
  1177.         ];
  1178.         If[linestyle === Automatic, linestyle = GrayLevel[0]];
  1179.         If[MatchQ[exploded,{_Integer,_Real}],exploded = {exploded}];
  1180.         If[exploded === None, exploded = {}];
  1181.         If[exploded === All,
  1182.             exploded = Range[len]];
  1183.         If[(tmp = DeleteCases[exploded,
  1184.                 (_Integer | {_Integer,_?(NumberQ[N[#]]&)})]) =!= {},
  1185.             Message[PieChart::badexplode,tmp];
  1186.             exploded = Cases[exploded,
  1187.                 (_Integer | {_Integer,_?(NumberQ[N[#]]&)})]
  1188.         ];
  1189.         exploded = Map[If[IntegerQ[#], {#,.1},#]&,exploded];
  1190.         offsets = Map[If[(tmp = Cases[exploded,{#,_}]) =!= {},
  1191.                 Last[First[tmp]],
  1192.                 0]&,
  1193.             Range[len]
  1194.         ];
  1195.     (* Get range of values, set up list of thetas *)
  1196.         tlist = N[ 2 Pi FoldList[Plus,0,list]/(Plus @@ list)];
  1197.     (* Get pairs of angles *)
  1198.         angles1 = Drop[tlist,-1];angles2 = Drop[tlist,1];
  1199.     (* bisect pairs (for text placement and offsets) *)
  1200.         thalf = 1/2 (angles1 + angles2);
  1201.         halfpos = Map[{Cos[#],Sin[#]}&,thalf];
  1202.     (* generate lines, text, and wedges *)
  1203.         text = If[labels =!= None,
  1204.             MapThread[Text[#3,(#1 + .6) #2]&,
  1205.                     {offsets,halfpos,labels}],
  1206.                 {}];
  1207.         lines = MapThread[{
  1208.                 Line[{#1 #2,{Cos[#3],Sin[#3]} + #1 #2}],
  1209.                 Line[{#1 #2,{Cos[#4],Sin[#4]} + #1 #2}],
  1210.                 Circle[#1 #2,1,{#3,#4}]}&,
  1211.             {offsets,halfpos,angles1,angles2}];
  1212.         wedges = MapThread[
  1213.                 Flatten[{#5, Disk[#1 #2, 1, {#3,#4}]}]&,
  1214.             {offsets,halfpos,angles1,angles2,styles}];
  1215.     (* show it all... *)
  1216.         Show[Graphics[
  1217.             {wedges,
  1218.             Flatten[{linestyle, lines}],
  1219.             text},
  1220.             AspectRatio->Automatic, gopts]]
  1221.     ]
  1222.  
  1223. (* TransformGraphics *)
  1224.  
  1225. TransformGraphics[Graphics[list_, opts___], f_] :=
  1226.     Graphics[ TG0[list, f], opts ]
  1227.  
  1228. TG0[d_List, f_] := Map[ TG0[#, f]& , d ]
  1229.  
  1230. TG0[Point[d_List], f_] := Point[f[d]]
  1231.  
  1232. TG0[Line[d_List], f_] := Line[f /@ d]
  1233.  
  1234. TG0[Rectangle[{xmin_, ymin_}, {xmax_, ymax_}], f_] :=
  1235.     TG0[Polygon[{{xmin,ymin}, {xmin,ymax}, {xmax, ymax}, {xmax, ymin}}], f]
  1236.  
  1237. TG0[Polygon[d_List], f_] := Polygon[f /@ d]
  1238.  
  1239. TG0[Circle[d_List, r_?numberQ, t___], f_] :=
  1240.     Circle[f[d], f[{r,r}], t]
  1241.  
  1242. TG0[Circle[d_List, r_List, t___], f_] :=
  1243.         Circle[f[d], f[r], t] 
  1244.  
  1245. TG0[Disk[d_List, r_?numberQ, t___], f_] :=
  1246.         Disk[f[d], f[{r,r}], t] 
  1247.  
  1248. TG0[Disk[d_List, r_List, t___], f_] := 
  1249.         Disk[f[d], f[r], t]
  1250.  
  1251. TG0[Raster[array_, range_List:{{0,0}, {1,1}}, zrange___], f_] := 
  1252.     Raster[array, f /@ range, zrange]
  1253.  
  1254. TG0[RasterArray[array_, range_List:{{0,0}, {1,1}}, zrange___], f_] := 
  1255.     RasterArray[array, f /@ range, zrange]
  1256.  
  1257. TG0[Text[expr_, d_List, opts___], f_] := Text[expr, f[d], opts]
  1258.  
  1259. TG0[expr_, f_] := expr
  1260.  
  1261. (* SkewGraphics *)
  1262.  
  1263. SkewGraphics[g_, m_?MatrixQ] :=
  1264.     TransformGraphics[g, (m . #)&]
  1265.  
  1266. End[ ]   (* Graphics`Graphics`Private` *)
  1267.  
  1268. EndPackage[ ]   (* Graphics`Graphics` *)
  1269.  
  1270.  
  1271. (*:Limitations: none known. *)
  1272.  
  1273. (*:Tests:
  1274.  
  1275. *)
  1276.  
  1277. (*:Examples:
  1278.  
  1279. LinearScale[ 1,2]
  1280.  
  1281. LogScale[1,10]
  1282.  
  1283. UnitScale[2,10,0.7]
  1284.  
  1285. PiScale[ 0,10]
  1286.  
  1287. TextListPlot[{{1.5, 2.5}, {1.6, 2.6}, {1.7, 2.7}, {1.8, 2.8}}]
  1288.  
  1289. TextListPlot[{ {1.5,2.5,1},{1.6,2.6,2},{1.7,2.7,3},{1.8,2.8,4}}]
  1290.  
  1291. LabeledListPlot[{ {1.5,2.5,1},{1.6,2.6,2},{1.7,2.7,3},{1.8,2.8,4}}]
  1292.  
  1293. LogPlot[ Sin[x],{x,0.1,3.1}]
  1294.  
  1295. LogPlot[ Exp[ 4 x], {x,1,5}, Frame -> True]
  1296.  
  1297. LogPlot[ Exp[ 4 x], {x,1,5}, Frame -> True,
  1298.     GridLines -> {Automatic, LogGridMajor}]
  1299.  
  1300. LogPlot[ Exp[ 4 x], {x,1,3}, Frame -> True,
  1301.     GridLines -> {Automatic, LogGridMinor}]
  1302.  
  1303. LogListPlot[ Table[i,{i,10}] ]
  1304.  
  1305. LogListPlot[ Table[ {i/2,i^2},{i,20}]]
  1306.  
  1307. LogLogPlot[ Sin[x],{x,0.1,3.1}]
  1308.  
  1309. LogLogListPlot[ Table[ i^2,{i,10}]]
  1310.  
  1311. LogLogListPlot[ Table[ {i^2,i^3},{i,10}]]
  1312.  
  1313. PolarPlot[ Cos[t], {t,0,2 Pi}]
  1314.  
  1315. PolarPlot[ {Cos[t], Sin[2 t]},{t,0,2 Pi}]
  1316.  
  1317. PolarListPlot[ Table[ {t/2,Cos[t]},{t,0,2 Pi, .1}]]
  1318.  
  1319. ErrorListPlot[Table[ { i,i^2},{i,10}]]
  1320.  
  1321. ErrorListPlot[ Table[ { Sin[t],Cos[t], t},{t,10}]]
  1322.  
  1323. data = Table[{n/15,(n/15)^2 = 2 + Random[Real, {-.3,.3}]},
  1324.         {n,15}]; fit = Fit[data,{1,x,x^2},x];
  1325. ListAndCurvePlot[data,fit,{x,0,1}]
  1326.  
  1327. BarChart[ Table[i,{i,1,10}]]
  1328.  
  1329. BarChart[ Table[ {Sin[t], SIN[t]},{t,0.6,3,0.6}]]
  1330.  
  1331. PieChart[ Table[ i,{i,5}]]
  1332.  
  1333. PieChart[ Table[ {i,A[i]},{i,7}]]
  1334.  
  1335. Show[GraphicsArray[
  1336.     {{PieChart[{.2,.3,.1},DisplayFunction->Identity],
  1337.     PieChart[{.2,.3,.1},PieExploded->All,
  1338.         DisplayFunction->Identity],
  1339.     PieChart[{.2,.3,.1},PieExploded->{3,.2},
  1340.         DisplayFunction->Identity]}}],
  1341.     DisplayFunction->$DisplayFunction]
  1342.  
  1343. PlotStyle[Plot[Sin[x],{x,0,Pi}]]
  1344.  
  1345. PlotStyle[Plot[Sin[x],{x,0,Pi},
  1346.     PlotStyle->{{Dashing[{.02,.02}],Thickness[.007]}}]]
  1347.  
  1348. g1 = Plot[t,{t,0,Pi}]; Show[ TransformGraphics[ g1, Sin[#]& ] ]
  1349.  
  1350. g1 = Plot[ Sin[t],{t,0,Pi}]; Show[ SkewGraphics[g1, {{1,2},{0,1}}]]
  1351.  
  1352. *)
  1353.  
  1354.