Re: ContourPlot: non-rectangular domains?[2]
- To: mathgroup at smc.vnet.net
- Subject: [mg17040] Re: ContourPlot: non-rectangular domains?[2]
- From: "Seth Chandler" <SChandler at uh.edu>
- Date: Wed, 14 Apr 1999 02:11:54 -0400
- Organization: University of Houston
- References: <7ec5b3$cjj@smc.vnet.net> <7es40a$cd7@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Thanks Allan for a terrific implementation. Very useful in economics!
Definitely worth posting to MathSource.
Seth J. Chandler
Associate Professor of Law
University of Houston Law Center
Allan Hayes wrote in message <7es40a$cd7 at smc.vnet.net>...
>The following code is twice as quick as my earlier posting - mainly because
>of changing ReplaceRepeated to a functional form at
>(***----------Improved code for d --------***)
>Also:I have used FilterOptions in place of the ad hoc treatment for options
>used earlier.
>---------------------
>Allan Hayes
>Mathematica Training and Consulting
>Leicester UK
>www.haystack.demon.co.uk
>hay at haystack.demon.co.uk
>Voice: +44 (0)116 271 4198
>Fax: +44 (0)870 164 0565
>
>---------------------------------------------------------------------------
-
>----------------------------------
>
>ParametricContourPlot::usage =
>"ParametricContourPlot[{x, y, e},{s, smin,smax},{t,tmin,tmax}] where x, y,
e
>are expressions in s,t gives the contours of e over the region defined
>parametrically by {x,y} for s in {smin,smax} and t in {tmin,tmax}.
>The output is a Graphics object; the Options for ContourPlot
>and Graphics may be used together with two special options:
>ContourStyleFunction (default value {}&;#)\n
>ContourStyleFunctionScaling (default value True) which determines whether
>the contour style fumction will receive scaled or unscaled values of
>e.\n
>ParametricContourPlot[e, {x,xmin,xmax},{y,ymin,ymax}]
>gives the contours of e over the region defined parametrically by {x,
(1-t)
>ymin + t ymax} for x in {xmin,xmax} and t in {0,1}.";
>
>Options[ParametricContourPlot] =
> Union[Options[ContourPlot], {ContourStyleFunction -> ({} & ),
> ContourStyleFunctionScaling -> True}];
>
>Needs["Utilities`FilterOptions`"];
>
>Off[RuleDelayed::rhs];
>
>ParametricContourPlot[{xst_, yst_, expr_}, {s_, smin_, smax_},
> {t_, tmin_, tmax_}, (opts___)?OptionQ
>] :=
>Module[{csf, csfsc, cp, zmin, zmax, xy, sc, incr, div, d, n, z},
> {csf, csfsc} =
> {ContourStyleFunction, ContourStyleFunctionScaling} /.
> {opts} /.
> Options[ParametricContourPlot];
> cp =
> ContourPlot[expr, {s, smin, smax}, {t, tmin, tmax},
> DisplayFunction -> Identity,
> Evaluate[FilterOptions[ContourPlot, Sequence @@ Flatten[{opts}]]]
> ];
> {zmin, zmax} = PlotRange[cp][[-1]];
> xy[{s_, t_}] = {xst, yst};
> sc[u_] = If[csfsc, (u - zmin)/(zmax - zmin), u];
> incr =
> N[Abs[{smax - smin, tmax - tmin}]/
> (PlotPoints - 1 /. {opts} /. Options[ParametricContourPlot])];
> (***----------Improved code for d --------***)
> d[{a_, b_}/;(n = Max[Abs[(b - a)/incr]]) > 1.01] :=
> (n = Ceiling[n]; Sequence @@ Table[a + (i*(b - a))/n, {i, 1, n}]);
> d[{a_, b_}] := b;
> div[p_] := d /@ Partition[p, 2, 1];
> z[{s_, t_}] = expr;
> Show[Graphics[cp] /.
> {{dr___, Line[pts_]} :>
> {dr, Sequence @@ Flatten[{csf[sc[z[pts[[1]]]]]}], Line[xy /@
pts]},
> Polygon[pts_] :> Polygon[xy /@ div[Append[pts, First[pts]]]]
> },
> DisplayFunction -> $DisplayFunction,
> Evaluate[FilterOptions[Graphics, Sequence @@ Flatten[{opts}]]]
> ]
>]
>
>On[RuleDelayed::rhs];
>
>ParametricContourPlot[expr_, {x_, xmin_, xmax_}, {y_, ymin_, ymax_},
> (opts___)?OptionQ] :=
> Module[{t}, ParametricContourPlot[{x, (1 - t)*ymin + t*ymax,
> Function[{x, y}, expr][x, (1 - t)*ymin + t*ymax]}, {x, xmin, xmax},
> {t, 0, 1}, opts]]
>
>
>EXAMPLES
>
>ParametricContourPlot[{x, y, x*Sin[x] - Cos[y]} /.
> {x -> 3*s*Cos[t], y -> s*Sin[t]}, {s, 0, 1}, {t, 0, 2*Pi},
> AspectRatio -> Automatic, ContourShading -> True,
> ColorFunction -> (Hue[0.7*#1] & ),
> ContourStyleFunction -> (Dashing[{0.005, 0.005}] & ), PlotPoints -> 50];
>
>ParametricContourPlot[{x, y, x*Sin[x] - Cos[y]} /.
> {x -> 3*s*Cos[t], y -> s*Sin[t]}, {s, 0, 1}, {t, 0, 2*Pi},
> AspectRatio -> Automatic, ColorFunction -> (GrayLevel[1] & ),
> ContourStyleFunction -> (Hue[0.7*#1] & ),
> ContourStyleFunctionScaling -> True, ContourShading -> True,
> Background -> GrayLevel[0.8], PlotPoints -> 50];
>
>
>