MathGroup Archive 1999

[Date Index] [Thread Index] [Author Index]

Search the Archive

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




  • Prev by Date: Re: ContourPlot: non-rectangular domains?
  • Next by Date: Race Condition
  • Previous by thread: Re: BesselJZeros problem/bug?
  • Next by thread: Re: ContourPlot: non-rectangular domains?[2]