RE: Re: 3D plot -Reply
- To: mathgroup at smc.vnet.net
- Subject: [mg36406] RE: [mg36389] Re: [mg36364] 3D plot -Reply
- From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
- Date: Wed, 4 Sep 2002 21:22:23 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
>-----Original Message----- >From: Andrzej Kozlowski [mailto:akoz at mimuw.edu.pl] To: mathgroup at smc.vnet.net >Sent: Wednesday, September 04, 2002 8:57 AM >Subject: [mg36406] [mg36389] Re: [mg36364] 3D plot -Reply > > >The problem is that I do not think there is any bounded 3d body >described by your conditions. Anyway, this is how you can use >Mathematica (in general) to solve this sort of problem. > > >You need two packages: > >In[1]:= ><<Graphics`InequalityGraphics` > >In[2]:= ><<Calculus`Integration` > > >To see your object use: > > >InequalityPlot3D[y > 3x && y < 4 - x^2 && z < x^2 + 4, {x}, {y}, {z}] > >However, you will just get some error messages and a picture >that looks >two dimensional. If you wanted the volume, evaluate: > >In[3]:= >Integrate[Boole[y>3x&&y<4-x^2&&z<x^2+4],{x},{y},{z}] > >Out[3]= >-Infinity > >If you impose some limits on z you will get a finite positive answer, >but one that clearly is unbounded: > >In[20]:= >NIntegrate[Boole[y>3x&&y<4-x^2&&z<x^2+4],{x},{y},{z,-100,100}] > >Out[20]= >2239.58 > >In[21]:= >NIntegrate[Boole[y>3x&&y<4-x^2&&z<x^2+4],{x},{y},{z,-1000,1000}] > >Out[21]= >20989.6 > >Andrzej > > > >On Wednesday, September 4, 2002, at 03:08 am, Shz Shz Oon wrote: > >> Hi Andrzej Kozlowski, >> >> Thanks for trying to help. >> Sorry, I must have something missing in my previous description. >> >> I need to find out the volumn of a 3D object which form by the >> equation : >> z=x^2 +4 (as bottom surface) >> and on the xy plane which bounded by a parabola y=4-x^2 and >y=3x line. >> >> How would I use Mathematica to plot out this 3D object or >find out its >> volumn with only the equation given? >> >> Thank you! >> Shz Shz >> >> >>>>> Andrzej Kozlowski <akoz at mimuw.edu.pl> 3/September/2002 04:33pm >>> >> Mathematica could do this sort of thing if there were a three >> dimensional object described by your equations (as boundaries) but >> there isn't one. More precisely, the pair of equations {z=x^2 +4, >> y=4-x^2} describes a parabola in three space which you can >plot with: >> >> g1=ParametricPlot3D[{x, 4 - x^2, x^2 + 4}, {x, -5, 5}] >> >> The equation y=3x describes the plane: >> >> g2 = ParametricPlot3D[{x, 3x, z}, {x, -5, 5}, {z, -25, 25}] >> >> >> You can see the two together in >> >> >> <<RealTime3D` >> >> >> Show[{g1,g2}] >> >> There are clearly two points of intersection. They can be found with: >> >> >> Solve[{z == x^2 + 4, y == 4 - x^2, y == 3*x}, {x, y, z}] >> >> >> {{z -> 5, y -> 3, x -> 1}, {z -> 20, y -> -12, x -> -4}} >> >> So where is the 3D object whose volume you want to find? >> >> Andrzej Kozlowski >> Toyama International University >> JAPAN >> >> >> >> >> >> On Tuesday, September 3, 2002, at 06:41 am, Shz Shz Oon wrote: >> >>> >>> Can I use Mathematica to find out the volumn of this 3 dimensional >>> object from >>> the equations : >>> >>> z=x^2 +4, y=4-x^2, y=3x >>> >>> >>> Thanks in advance! >>> Shz Shz >>> >>> >>> >> <DISCLAIM.TXT> > > > Shz Shz, as Andrzej having said everything about the calculation of the volume, and as still your specification is incomplete, I'm going to show how you can plot at least all you have (communicated). As you said something obout the "bottom" -- which direction is "up"? -- assuming positive z-direction the I come to the inequalities: y >= 3 x, y <= 4 -x^2, z >= 4 + x^2 and arbitrarily, to make the example complete I'll show only parts with z < 20 but do not complete the shape. To begin building the graphics we draw the boundary surfaces: [1] the bottom {xmin, xmax} = x /. NSolve[4 - x^2 == 3x, {x}] {-4., 1.} Plot[{4 - x^2, 3x}, {x, xmin, xmax}] {ymin, ymax} = {3 xmin, 4} g3 = Graphics3D[Plot3D[x^2 + 4, {x, xmin, xmax}, {y, ymin, ymax}]] [2] the walls g = ParametricPlot3D[{{x, 4 - x^2, z}, {x, 3x, z}}, {x, xmin, xmax}, {z, 0, 20}] One idea now would be to exploit the Mathematica rendering algorithm, to cut off the undesired parts of the boundary surfaces: gg = Show[g3, g, PolygonIntersections -> False] \[Epsilon] = 1. 10^-4 g4 = gg /. Line[_] -> {} /. p : Polygon[pts_] :> If[Or @@ (#2 > 4 - #1^2 + \[Epsilon] || #2 < 3 #1 - \[Epsilon] || #3 < #1^2 + 4 - \[Epsilon] &) @@@ pts, {}, p] Show[g4 /. Line[_] -> {}, BoxRatios -> {1, 1, .5}, ViewPoint -> {1.3, -2.4, 5}] But alas! The edges are rather gnawed off. Increasing epsilon doesn't help, unwanted parts will show up and still some polygons are nibbled away. So we have to do it ourselves: We define tag[inequality_][p_] := Block[{x, y, z}, {x, y, z} = p; If[inequality, {p, inside}, {p, outside}]] ...tags points whether inside ore outside. sol[equality_, {p1_, _}, {p2_, _}] := Block[{p, d, x, y, z}, {x, y, z} = p = p1 (1 - d) + p2 d; First[Cases[Solve[equality, d], s_ /; NonNegative[d /. s] :> (p /. s)]] ] ...computes the cut on the line between to points of opposite sides. sep[equality_][pp1_, pp2_] := If[pp1[[2]] === pp2[[2]], {pp1}, ppx = sol[equality, pp1, pp2]; {pp1, {ppx, pp1[[2]]}, {ppx, pp2[[2]]}}] ...effectively cuts a segment crossing the border into two pieces. cutGraphics3D[g_, inequality_] := Module[{equality = Equal @@ inequality}, g /. Polygon[pts_] :> Block[{tagpts = tag[inequality] /@ pts}, With[{t = sep[equality] @@@ Transpose[{tagpts, RotateLeft[tagpts]}]}, With[{newpts = Cases[t, {p_, label_} /; label == inside :> p, 2]}, If[Length[newpts] > 2, Polygon[newpts], {}]] ]]] ...Polygons crossing a border are cut, only those inside are kept. We first cut the bottom... g3new = Fold[cutGraphics3D, g3, {y >= 3x, y <= 4 - x^2}] ...next the sides... gnew = cutGraphics3D[g, z >= 4 + x^2] ...and display: Show[gnew, g3new, BoxRatios -> {1, 1, .5}, ViewPoint -> {1.3, -2.4, 5}] Show[gnew, g3new, BoxRatios -> {1, 1, .5}, ViewPoint -> {1.3, -2.4, 15}] Show[gnew, g3new, BoxRatios -> {1, 1, .5}, ViewPoint -> {1.3, -2.4, -2}] Show[gnew, g3new, BoxRatios -> {1, 1, .5}, ViewPoint -> {1.3, 2.5, 2}] Here I have brought a method, I had already posted twice, to a more handy form. To make that reminiscence complete, we could also define a coloring function colorGraphics3D[g_, inequality_, colorinside_, coloroutside_] := Module[{equality = Equal @@ inequality}, g /. Polygon[pts_] :> Block[{tagpts = tag[inequality] /@ pts}, With[{t = sep[equality] @@@ Transpose[{tagpts, RotateLeft[tagpts]}]}, {With[{newpts = Cases[t, {p_, label_} /; label == outside :> p, 2]}, If[Length[newpts] > 2, {FaceForm[SurfaceColor[coloroutside]], Polygon[newpts]}, {}]], With[{newpts = Cases[t, {p_, label_} /; label == inside :> p, 2]}, If[Length[newpts] > 2, {FaceForm[SurfaceColor[colorinside]], Polygon[newpts]}, {}]]} ]]] and with... g3D = Graphics3D[Plot3D[E^(-(x^2/2) - y^2/2)/(2*Pi) , {x, -2, 2}, {y, -2, 2}]] Show[colorGraphics3D[g3D, With[{e = Take[{x, y, z}, 2] - {0.8, -0.5}}, e.e] <= 1, Hue[0, 0.3, 1], Hue[0.6, 0.3, 1]]] -- Hartmut Wolf