Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: ContourPlot: non-rectangular domains?

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

David P. Johnson <johnson at ae.msstate.edu> wrote in message
news:7ec5b3$cjj at smc.vnet.net...
> I used Maple some before settling on Mathematica. Although, Maple is
> not as well suited to my needs, it did have one extremely nifty
> feature. You could make 3D and contour plots with non-rectangular
> domains. This was accomplished by allowing the second range to be a
> function of the first variable. For instance, in Mathematica syntax,
> this would translate into something like the following:
>
>  In[1]:= ContourPlot[x Sin[x] - Cos[y],
>    {x,-2,2},{y,x,2 x}]
>
> which would result in a triangluar domain, or:
>
>  In[2]:= Plot3D[x Sin[x] - Cos[y],
>    {x,-2,2},{y,0,Sqrt[2^2-x^2]}]
>
> which would result in a semi-circular domain. More complex domains
> could be constructed by viewing results from several sub-domains.
>
> This was very useful when, for instance, I taught Elasticity. I could
> plot the stresses in a body inside a domain shaped like the body. For
> instance, a circular torsion bar with a semi-circular keyway cutout.
> The resulting plots were very powerful vusualization tools.
>
> I have not been able to get Mathematica to duplicate this capability.
> Is there a simple way?
>
> --
> David
> ->(Signature continues here)
>

David,
Below  is one way of dealing with the ContourPlot problem - the Plot3D can
be dealt with by converting to ParametricPlot3D in the way done below for
ParametricContourPlot[e, {x, xmin, xmax}, {y, ymin, ymax}].

I can also send you a package for plotting cotours on a surface.

Allan

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


ClearAll["`*"]

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}.\n
    The output is a Graphics object; the Options for ContourPlot and
Graphics \
may be used together with two special options:\n
     ContourStyleFunction (default value {}&;#)\n
     ContourStyleFunctionScaling (default value True) which determines \
whether the cotour 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}];

Off[RuleDelayed::rhs];

ParametricContourPlot[{xst_, yst_, expr_}, {s_, smin_, smax_}, {t_, tmin_,
tmax_}, (opts___)?OptionQ] :=
Module[{sc, csf, pdf, cp, mp, inc, n, csfsc},
   {csf, csfsc} =
   {ContourStyleFunction, ContourStyleFunctionScaling} /.
     {opts} /. Options[ParametricContourPlot];
    cpopts =
    DeleteCases[Flatten[{opts}],
     _[ContourStyleFunction | ContourStyleFunctionScaling, _]
    ];
 cp =
    ContourPlot[expr, {s, smin, smax}, {t, tmin, tmax},
   DisplayFunction -> Identity,
       Evaluate[cpopts]
    ];
    {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])];
    div[{p__}, incr_] :=
     {p} //.
     {a___, b:{_?NumericQ, ___}, c_, d___} /;
     ((n = Max[Abs[(b - c)/incr]]) > 1.01) :>
        {a, b, Sequence @@ Table[b + i(c - b), {i, 0, 1, 1/n}], c, d};
     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]], incr]]
        },
      DisplayFunction -> $DisplayFunction
    ]
]

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

On[RuleDelayed::rhs];



EXAMPLES

ParametricContourPlot[
 {x, y, x Sin[x] - Cos[y]} /. {x -> 3s Cos[t], y ->  s Sin[t]},
 {s, 0, 1}, {t, 0, 2Pi},
AspectRatio -> Automatic,
 ContourShading -> True,
    ColorFunction -> (Hue[.7#] &),
    ContourStyleFunction -> (Dashing[{.005, .005}] &),
PlotPoints -> 50];

ParametricContourPlot[
 {x, y, x Sin[x] - Cos[y]} /. {x -> 3s Cos[t], y ->  s Sin[t]},
 {s, 0, 1}, {t, 0, 2Pi},
AspectRatio -> Automatic,
    ColorFunction -> (GrayLevel[1] &),
 ContourStyleFunction -> (Hue[.7#] &),
    ContourStyleFunctionScaling -> True,
 ContourShading -> True,
 Background -> GrayLevel[.8],
PlotPoints -> 50];

ParametricContourPlot[x Sin[x] - Cos[y],
{x, -2, 2}, {y, x, 2 x}, ColorFunction -> ( Hue[.7#] &),
  ContourStyleFunction -> ({GrayLevel[.8], Thickness[.01Abs[#]]} &),
  PlotPoints -> 40]