home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GRAPHICS.PAK / FILLEDPL.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  6.5 KB  |  209 lines
  1.  
  2. (* :Title: Filled Plot *)
  3.  
  4. (* :Context: Graphics`FilledPlot` *)
  5.  
  6. (* :Author: John M. Novak *)
  7.  
  8. (* :Summary: Plots with fills between curves of functions. *)
  9.  
  10. (* :Package Version: 1.0 *)
  11.  
  12. (* :Mathematica Version: 2.0 *)
  13.  
  14. (* :History:
  15.     V1.0 by John M. Novak, May 1991
  16. *)
  17.  
  18. (* :Keywords:
  19.     graphics, Plot
  20. *)
  21.  
  22. (* :Limitations: uses rectangles to place the axes in front
  23.     of the filled area;  this should work in all cases, but
  24.     is not guaranteed.
  25. *)
  26.  
  27. BeginPackage["Graphics`FilledPlot`",
  28.     "Utilities`FilterOptions`"]
  29.  
  30. FilledPlot::usage =
  31.     "FilledPlot[function,{var,varmin,varmax}] generates a plot
  32.     with the area between the curve and the var axis filled.
  33.     FilledPlot[{f1,f2,...},range] generates a plot with the
  34.     areas between curve f1 and f2, f2 and f3, etc. filled.
  35.     The shade of the fill and other specifications can be
  36.     given by the Fills option."
  37.  
  38. Fills::usage =
  39.     "An option to FilledPlot.  There are two forms for this
  40.     option;  a list of color primitives (i.e., Hue[0], etc.),
  41.     or a list of pairs, with the first element being another
  42.     pair that specifies two curves, and the other being a color
  43.     primitive (i.e., {{2,3},Hue[.3]}, etc.).  In this second form,
  44.     each curve is specified by an integer, indicating the
  45.     position of the curve in the list of curves given to
  46.     FilledPlot.  Also, the symbol Axis (meaning the x-axis) 
  47.     can be specified.  If just the list of colors is given,
  48.     this is equivalent to {{{1,2},color1},{{2,3},color2},etc.}.
  49.     If there are more colors than curves, extra colors are
  50.     ignored. If there are as many colors as curves, the last
  51.     color is the fill between the final curve and the Axis.
  52.     If there are fewer colors, then only the fills up through
  53.     the given colors will be done."
  54.  
  55. Curves::usage =
  56.     "An option to FilledPlot.  There are three possible values
  57.     for this;  None, Front, or Back.  None means not to display
  58.     the actual lines used for the curves; Front means to draw all
  59.     the curves in front of the fills.  Back means to draw the
  60.     curves used in a fill in the same layer as that fill; thus,
  61.     some curves may be covered by later fills."
  62.  
  63. Front::usage = Back::usage =
  64.     "A value for the option Curves."
  65.  
  66. Axis::usage =
  67.     "Used in the option Fills to specify that one of the
  68.     curves to be used in a fill is the x-axis."
  69.  
  70. Begin["`Private`"]
  71.  
  72. (* Curves option takes None, Front, or Back. *)
  73.  
  74. Options[FilledPlot] = Join[{
  75.         Fills->Automatic,
  76.         Curves->Back},
  77.     Options[Plot]];
  78.  
  79. FilledPlot::badfill =
  80.     "The Fills option has been given an incorrect form: `1`.";
  81.  
  82. FilledPlot::badcurv =
  83.     "The Curves option has been given bad value `1`; using
  84.     'Back' in its place.";
  85.  
  86. FilledPlot[funcs_List,{x_Symbol,xmin_,xmax_},opts___] :=
  87.     Module[{pl,lines,fills,gopts,disp,rng,asp,curve,
  88.             ln = Length[funcs],n,gr,part},
  89.         {fills,curve,disp} = {Fills,Curves,DisplayFunction}/.
  90.             {opts}/.Options[FilledPlot];
  91.         pl = Plot[funcs,{x,xmin,xmax},
  92.             DisplayFunction->Identity,
  93.             Evaluate[FilterOptions[Plot,opts]]];
  94.         lines = Map[Last,pl[[1]]];
  95.         gopts = Sequence @@ Drop[pl,1];
  96.         (* check form of curve *)
  97.         If[!MatchQ[curve,(Front | Back | None)],
  98.             Message[FilledPlot::badcurv,curve];
  99.             curve = Back];
  100.         (* check form of fills *)
  101.         If[MatchQ[fills,_Hue | _GrayLevel | _RGBColor | _CMYKColor],
  102.             fills = {fills}];
  103.         If[!MatchQ[fills,({{{(_Integer | Axis),(_Integer | Axis)},
  104.                 (_Hue | _GrayLevel | _RGBColor | _CMYKColor)}..} |
  105.                 {(_Hue | _GrayLevel | _RGBColor | _CMYKColor)..} |
  106.                 Automatic)],
  107.             Message[FilledPlot::badfill,fills]; fills = Automatic];
  108.         If[MatchQ[fills,{(_Hue | _GrayLevel | _RGBColor | _CMYKColor)..}],
  109.             If[Length[fills] > ln,
  110.                 fills = Take[fills,ln]];
  111.             part = Partition[Range[1,ln],2,1];
  112.             If[Length[fills] === ln,
  113.                 AppendTo[part,{1,Axis}]];
  114.             fills = Transpose[{part,fills}]
  115.         ];
  116.         If[fills === Automatic,
  117.             If[ln === 1,
  118.                 fills = {{{1,Axis}, GrayLevel[.5]}},
  119.                 fills = Transpose[{
  120.                     Partition[Range[1,ln],2,1],
  121.                     Table[Hue[n/ln],{n,1,ln-1}]}]
  122.             ]
  123.         ];
  124.         polys = Map[dopoly[#,lines,{xmin,xmax}]&,fills];
  125.         gr = Switch[curve,
  126.             Back,MapThread[{#1,
  127.                 Map[If[# =!= Axis && # =!= 0,
  128.                     pl[[1,#]],{}]&,#2[[1]]]}&,{polys,fills}],
  129.             None,polys,
  130.             Front,{polys,pl[[1]]}];
  131.         gr = Graphics[gr,DisplayFunction->disp,
  132.             Prolog->{},
  133.             Epilog->{},
  134.             gopts];
  135.         {rng,asp} = FullOptions[gr,{PlotRange,AspectRatio}];
  136.         Show[Graphics[{Rectangle[{0,0},{1,1},gr],
  137.             Rectangle[{0,0},{1,1},
  138.                 Graphics[{PointSize[0]},
  139.                     DisplayFunction->disp,
  140.                     PlotRange->rng,
  141.                     Epilog->{},
  142.                     Prolog->{},
  143.                     gopts]]}],
  144.             Axes->False,Frame->False,PlotLabel->None,
  145.             AspectRatio->asp,
  146.             DisplayFunction->disp,gopts]
  147.     ]
  148.  
  149. FilledPlot[func_,rng_List,opts___] :=
  150.     FilledPlot[{func},rng,opts]
  151.  
  152. (* Auxiliary Functions *)
  153.  
  154. dopoly[{{first_,second_},style_},lines_,rng_] :=
  155.     Flatten[{style,
  156.         Outer[linestopolygon,getline[first,lines,rng],
  157.         getline[second,lines,rng]]}]
  158.  
  159. getline[0,lines_,rng_] := getline[Axis,lines,rng]
  160.  
  161. getline[Axis,lines_,{min_,max_}] := {Line[N[{{min,0},{max,0}}]]}
  162.  
  163. getline[ln_,lines_,rng_] := lines[[ln]]/;
  164.     ln <= Length[lines] && ln >= 1
  165.  
  166. getline[_,_,{min_,max_}] := {Line[N[{{min,0},{max,0}}]]}
  167.  
  168. (* delete to intersecting point, leading; then, delete
  169.     to intersecting point, trailing; then, create polygon
  170.     (no checking needed.) *)
  171.  
  172. linestopolygon[Line[line1_List],Line[line2_List]] :=
  173.     {}/;First[Last[line1]] <= First[First[line2]] ||
  174.         First[Last[line2]] <= First[First[line1]]
  175.  
  176. linestopolygon[Line[line1_List],Line[line2_List]] :=
  177.     With[{f1 = First[First[line1]],f2 = First[First[line2]]},
  178.         If[f1 > f2,
  179.             linestopolygon[Line[line1],chopline[line2,f1,True]],
  180.             linestopolygon[chopline[line1,f2,True],Line[line2]]]
  181.     ]/;First[First[line1]] != First[First[line2]]
  182.  
  183. linestopolygon[Line[line1_List],Line[line2_List]] :=
  184.     With[{f1 = First[Last[line1]],f2 = First[Last[line2]]},
  185.         If[f1 < f2,
  186.             linestopolygon[Line[line1],chopline[line2,f1,False]],
  187.             linestopolygon[chopline[line1,f2,False],Line[line2]]]
  188.     ]/; First[Last[line1]] != First[Last[line2]]
  189.  
  190. linestopolygon[Line[line1_List],Line[line2_List]] :=
  191.     Polygon[Join[line1,Reverse[line2]]]
  192.  
  193. chopline[line_,pt_,front_:True] :=
  194.     Module[{pl = Partition[line,2,1],x1,y1,x2,y2,pos},
  195.         pos = Position[pl,
  196.             x_?(#[[1,1]] < pt && #[[2,1]] >= pt &),
  197.                 {1},Heads->False][[1,1]];
  198.         {{x1,y1},{x2,y2}} = pl[[pos]];
  199.         If[TrueQ[front],
  200.             Line[Prepend[Drop[line,pos],
  201.                 {pt,(y2 - y1)/(x2 - x1) (pt - x1) + y1}]],
  202.             Line[Append[Drop[line,-(Length[line] - pos)],
  203.                 {pt,(y2 - y1)/(x2 - x1) (pt - x1) + y1}]]]
  204.     ]
  205.  
  206. End[]
  207.  
  208. EndPackage[]
  209.