RE: Re: 3D plot of discontinuous function
- To: mathgroup at smc.vnet.net
- Subject: [mg24973] RE: [mg24951] Re: 3D plot of discontinuous function
- From: "David Park" <djmp at earthlink.net>
- Date: Mon, 28 Aug 2000 08:27:30 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Dear Ulrich and Andrzej,
This problem interests me and I would like to present a case where I believe
that Andrzej's method does not work quite as well. The plot below looks nice
with a linear edge but what if you have a boundary defined by a nonlinear
curve? Here is the example:
Plot3DPart :=
DeleteCases[
DeleteCases[Graphics3D[Plot3D[##]], Indeterminate,
Infinity], {_?NumberQ, _?NumberQ}, Infinity] &;
Off[Plot3D::plnc]
f[x_, y_] := If[x^2 <= y, 1, Indeterminate];
g[x_, y_] := If[x^2 > y, 0, Indeterminate];
p1 = Plot3DPart[f[x, y], {x, 0, 1}, {y, 0, 1}, DisplayFunction -> Identity,
PlotPoints -> 26];
p2 = Plot3DPart[g[x, y], {x, 0, 1}, {y, 0, 1}, DisplayFunction -> Identity,
PlotPoints -> 26];
Show[p1, p2, DisplayFunction -> $DisplayFunction];
This definitely produces a plot with ragged edges.
On the other hand, by using a change of variable and transforming the
original plot back to the original variables we can obtain a smooth plot.
My DrawingCube package has routines that make it easy to do this. In any
case, here is the plot done without using DrawingCube. A change of variable
y = w x^2 was used for the first region and y = w + (1-w)x^2 was used for
the second plot. (The IteratorSubstitution routine in DrawingCube generated
these transformations.)
p1 = First[Graphics3D[Plot3D[0, {x, 0, 1}, {w, 0, 1}, DisplayFunction ->
Identity]]] /. {(x_)?NumberQ, (w_)?NumberQ, (z_)?NumberQ} ->
{x, w*x^2, z};
p2 = First[Graphics3D[Plot3D[1, {x, 0, 1}, {w, 0, 1}, DisplayFunction ->
Identity]]] /. {(x_)?NumberQ, (w_)?NumberQ, (z_)?NumberQ} ->
{x, w + x^2 - w*x^2, z};
Show[Graphics3D[{p1, p2}], AspectRatio -> Automatic, PlotRange -> All,
{Axes -> True, ImageSize -> 300, BoxRatios -> {1, 1, 0.5}}];
The boundaries are now smooth. Furthermore this technique will produce a
smooth boundary plot for any region which has a smooth boundary.
I would be interested in seeing your notebook, Ulrich, because perhaps your
application does not really require smooth boundaries, in which case
Andrzej's method which does not require generating the transformation
functions, would be simpler.
David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/
> -----Original Message-----
> From: Ulrich Bodenhofer [mailto:ulrich.bodenhofer at scch.at]
To: mathgroup at smc.vnet.net
>
> Dear Andrzej,
>
> first of all, thank you very much for spending the effort to write
> such a detailed description of how to solve my problem.
> Indeed, it solved the problem perfectly! I succeeded in producing
> magnificent pictures of really exotic functions (some types of
> pathological fuzzy relations, by the way). In order to make it
> a little easier, I defined the following function:
>
> Plot3DPart :=
> DeleteCases[
> DeleteCases[Graphics3D[Plot3D[##]], Indeterminate,
> Infinity], {_?NumberQ, _?NumberQ}, Infinity] &;
>
> Now, I can plot the parts really easy, e.g.
>
> f[x_, y_] := If[x <=y, 1, Indeterminate];
> g[x_, y_] := If[x >y, 0, Indeterminate];
>
> p1=Plot3DPart[f[x, y], {x, 0, 1}, {y, 0, 1}, DisplayFunction
> -> Identity,
> PlotPoints -> 26];
> p2=Plot3DPart[g[x, y], {x, 0, 1}, {y, 0, 1}, DisplayFunction
> -> Identity,
> PlotPoints -> 26];
>
> Show[p1, p2, DisplayFunction -> $DisplayFunction];
>
> For complicated functions, however, this is still tedious work. Actually,
> I had to create up to 22 different graphics objects for visualizing one
> single function. But I suppose there is no way otherwise, since it is not
> realistic that some sophisticated method will ever be able to detect the
> discontinuities automatically. Just another aspect: The method you suggest
> is not only perfect for visualizing discontinuities, but also for lines of
> non-differentiability.
> I do not dare to post attachments to the newsgroup.
> However, if you (or anybody else in this group) are (is)
> interested in nice
> examples of plots of nasty functions, just contact me, and I will
> send some.
>
> Thanks a lot again,
> Ulrich
>
>