Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2005
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2005

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

Search the Archive

Re: Re: 3D graphics domain

  • To: mathgroup at smc.vnet.net
  • Subject: [mg55826] Re: [mg55800] Re: [mg55731] 3D graphics domain
  • From: DrBob <drbob at bigfoot.com>
  • Date: Thu, 7 Apr 2005 05:10:05 -0400 (EDT)
  • References: <200504060711.DAA13640@smc.vnet.net>
  • Reply-to: drbob at bigfoot.com
  • Sender: owner-wri-mathgroup at wolfram.com

This illustrates what IteratorSubstitution does, I think:

IteratorSubstitution[{y, g[x, y]}, {y, r[x], b[x]}, w]

{{w b[x] + r[x] - w r[x], g[x, w b[x] + r[x] - w r[x]]}, {w, 0, 1}}

As w varies from 0 to 1, w b[x] + r[x] - w r[x] varies from r[x] to b[x], so f[x,w b[x] + r[x] - w r[x]] varies from f[x,r[x]] to f[x,b[x]]. In the problem below, the first chart is

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

and the domains are

domain1 = IteratorSubstitution[{y, f[x, y]}, {y, red, black}, w]

and

domain2 = IteratorSubstitution[{y, f[x, y]}, {y, blue, black}, w]

For each x, varying w allows us to vary y from black to red and black to blue.

x is varied from 0 to 0.5 in the first segment ParametricDraw and 0.5 to 1 in the second, because red and blue intersect at:

Solve[red == blue]
{{x -> 1/2}}

Bobby

On Wed, 6 Apr 2005 03:11:54 -0400 (EDT), David Park <djmp at earthlink.net> wrote:

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



-- 
DrBob at bigfoot.com


  • Prev by Date: Re: Re: Re[2]: Re: Numerical accuracy of Hypergeometric2F1
  • Next by Date: Re: ploting functions slowly
  • Previous by thread: Re: Re: 3D graphics domain
  • Next by thread: Re: 3D graphics domain