Re: ContourPlot: non-rectangular domains?[2]
- To: mathgroup at smc.vnet.net
- Subject: [mg17009] Re: ContourPlot: non-rectangular domains?[2]
- From: "Allan Hayes" <hay at haystack.demon.co.uk>
- Date: Sat, 10 Apr 1999 02:13:39 -0400
- References: <7ec5b3$cjj@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
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];