Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: 3D graphics domain

• To: mathgroup at smc.vnet.net
• Subject: [mg55800] Re: [mg55731] 3D graphics domain
• From: "David Park" <djmp at earthlink.net>
• Date: Wed, 6 Apr 2005 03:11:54 -0400 (EDT)
• Sender: owner-wri-mathgroup at wolfram.com

Here is a solution that those who have DrawGraphics can try out.

Needs["DrawGraphics`DrawingMaster`"]

f[x, y] = -64*x + 320*x^2 - 512*x^3 + 256*x^4 + 20*y - 64*x*y + 64*x^2*y -
4*y^2

The region that Dick wants is the triagular region between the three curves.
(We communicated on this.)

Draw2D[{Black, Draw[4 x (1 - x), {x, 0, 1}],
      Red, Draw[4 x (1 - 2 x), {x, 0, 1}],
      Blue, Draw[4 (x - 1) (1 - 2 x), {x, 0, 1}]},
    Frame -> True,
    ImageSize -> 400];

domain1 = IteratorSubstitution[{y, f[x, y]}, {y, 4x(1 - 2x), 4 x(1 - x)}, w]

domain2 =
  IteratorSubstitution[{y, f[x, y]}, {y, 4 (x - 1) (1 - 2 x), 4 x (1 - x)},
w]

Here I used Sequence to paste in the y and z arguments (instead of cutting
and pasting). I used EdgeForm and ColorMix (from DrawGraphics) to subdue the
'mesh' colors and make them a shade of the surface color. I used two
different surface colors for the two regions. I used the DrawGraphics
options command NeutralLighting to specify a less saturated set of lights so
they don't overwhelm the surface colors.

plot1 =
    Draw3DItems[
      {SurfaceColor[Cadet], EdgeForm[ColorMix[Cadet, Black][0.5]],
        ParametricDraw3D[{x, Sequence @@ First[domain1]} // Evaluate, {x, 0,
            0.5}, {w, 0, 1}, PlotPoints -> {21, 21}],
        SurfaceColor[LightCoral], EdgeForm[ColorMix[LightCoral,
Black][0.5]],
        ParametricDraw3D[{x, Sequence @@ First[domain2]} // Evaluate, {x,
0.5,
             1}, {w, 0, 1}, PlotPoints -> {21, 21}]},
      NeutralLighting[0.3, 0.7, 0.0],
      PlotRange -> {Automatic, Automatic, Automatic},
      Axes -> True,
      AxesLabel -> {x, y, f},
      BoxRatios -> {1, 1, 1},
      BoxStyle -> Gray,
      Background -> Linen,
      ViewPoint -> {1.300, -2.400, 2.000},
      ImageSize -> 600];

SpinShow[plot1]
SelectionMove[EvaluationNotebook[], All, GeneratedCell]
FrontEndTokenExecute["OpenCloseGroup"]; Pause[0.5];
FrontEndExecute[{FrontEnd`SelectionAnimate[200, AnimationDisplayTime -> 0.1,
      AnimationDirection -> Forward]}]

Use the up and down arrow keys to view one frame at a time.

David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/



From: Richard Bedient [mailto:rbedient at hamilton.edu]
To: mathgroup at smc.vnet.net

Thanks to Bob and Dan for helping me get this far. Again, I've exhausted
my Mathematica knowledge along with anything I can find in the Help
files.  I now need to take the function they found for me and graph it
in 3D over a restricted domain. Here's the problem:

Graph the function

f(x,y) = -64*x + 320*(x^2) - 512*(x^3) + 256*(x^4) + 20*y - 64*x*y +
64*(x^2)*y - 4*(y^2)

over the domain:

y <= 4*x*(1-x)
y >= 4*x*(1 - 2x)
y >= 4*(x - 1)*(1 - 2x)

Thanks for any help.

Dick

• Follow-Ups:
  • Re: Re: 3D graphics domain
    • From: DrBob <drbob@bigfoot.com>
  • Re: Re: 3D graphics domain
    • From: DrBob <drbob@bigfoot.com>