Re: Re: Intersection of two surfaces in 3D
- To: mathgroup at smc.vnet.net
- Subject: [mg52911] Re: [mg52863] Re: [mg52822] Intersection of two surfaces in 3D
- From: DrBob <drbob at bigfoot.com>
- Date: Thu, 16 Dec 2004 03:41:29 -0500 (EST)
- References: <200412141059.FAA24571@smc.vnet.net> <200412150926.EAA10631@smc.vnet.net>
- Reply-to: drbob at bigfoot.com
- Sender: owner-wri-mathgroup at wolfram.com
>> We simply turn on RealTime graphics with << RealTime3D` >> Now look at Show[g1, pp1] >> you can clearly see the curve g1 lying on the surface pp1 (defined by you). Uh, no, g1 is almost completely invisible -- at my desk, anyway. (WinXP, Mathematica 5.1) At some angles I can see parts of g1, but not clearly at all. To the extent one CAN pick out the lines, these charts are useful (with RealTime3D` loaded): DisplayTogether[ParametricPlot3D[{x1, y1, z1}, {t1, 0, 2 Pi}, {t2, 0, 1}, PolygonIntersections -> False], ParametricPlot3D[{ x2, y2, z2}, {s1, 0, 2 Pi}, {s2, 0, 4}], g1]; DisplayTogether[ParametricPlot3D[{x1, y1, z1}, {t1, 0, 2 Pi}, {t2, 0, 3}, PolygonIntersections -> False], ParametricPlot3D[{ x2, y2, z2}, {s1, 0, 2 Pi}, {s2, 0, 5}], g2]; I can discern bits of g1 and g2 (I think) in the intersections of the surfaces. I found no way to make the lines more visible. Bobby On Wed, 15 Dec 2004 04:26:25 -0500 (EST), Andrzej Kozlowski <akoz at mimuw.edu.pl> wrote: > > > > On 14 Dec 2004, at 19:59, Narasimham wrote: > >> There are threads currently on sci.math on this topic. How do we find >> space intersection curve of two parameterized surfaces? One needs to >> solve for two unknown functions f1(t1,t2)=0 and f2(s1,s2)=0 to print >> out/output coordinates of intersection. I do believe it is within the >> capability of Mathematica, at least when surfaces are algebraically >> generatable. An example/approach considered is: >> >> Clear[x,y,z,t1,t2,s1,s2]; >> x1=4*t2* Cos[t1]; y1=4Sin[t1]; z1=3t2; >> x2=s2 Sin[s1];y2=s2 Cos[s1];z2=(s2^2/4); >> pp1=ParametricPlot3D[{x1,y1,z1},{t1,0,2 Pi},{t2,0,1}]; >> pp2=ParametricPlot3D[{x2,y2,z2},{s1,0,2 Pi},{s2,0,4}]; >> Show[pp1,pp2]; >> S1={x-x1,y-y1,z-z1}; S2={x-x2,y-y2,z-z2}; >> NSolve[Join[S1,S2],{x,y,z},{t1,t2,s1,s2}]; >> >> > > In fact in principle Mathematica can fully solve this problem without > the need for numerical methods. > > f = GroebnerBasis[{x - 4*t*Cos[s], y - 4*Sin[s], z - 3*t, Sin[s]^2 + > Cos[s]^2 - 1}, {x, y, z}, {t, Sin[s], Cos[s]}] > > {9*x^2 - 16*z^2 + y^2*z^2} > > So the space of zeros of the first equation is a subset of the space of > solutions of the Cartesian equation: > > 9*x^2 - 16*z^2 + y^2*z^2==0 > > > (They may actually be the same, I have not tried to check.) > > > g = GroebnerBasis[{x - t*Sin[s], y - t*Cos[s], z - t^2/4, Sin[s]^2 + > Cos[s]^2 - 1}, {x, y, z}, {t, Sin[s], Cos[s]}] > > > {x^2 + y^2 - 4*z} > > So again all points on the surface satisfy > > x^2 + y^2 - 4*z==0 > > > Let's now try to find the solutions of this > > > > sols=Reduce[Join[f, g] == 0, {x, y}, Reals] > > > (0 <= z <= 9/4 && ((x == -Sqrt[(-16*z^2 + 4*z^3)/(-9 + z^2)] && (y == > -Sqrt[-x^2 + 4*z] || y == Sqrt[-x^2 + 4*z])) || > (x == Sqrt[(-16*z^2 + 4*z^3)/(-9 + z^2)] && (y == -Sqrt[-x^2 + 4*z] > || y == Sqrt[-x^2 + 4*z])))) || > (z >= 4 && ((x == -Sqrt[(-16*z^2 + 4*z^3)/(-9 + z^2)] && (y == > -Sqrt[-x^2 + 4*z] || y == Sqrt[-x^2 + 4*z])) || > (x == Sqrt[(-16*z^2 + 4*z^3)/(-9 + z^2)] && (y == -Sqrt[-x^2 + 4*z] > || y == Sqrt[-x^2 + 4*z])))) > > > We can think of these answers as representing several parametric curves > in space. The interesection points of the original surfaces should be > contained among them. Unfortunately it takes a bit of work to get it > all into the right form. We want to express x and y in terms of z and > using z as the parameter (using only the real values of z returned by > Reduce) plot the curves. Note that there seem to be two pieces, for > 0<z<9/4 and for z>4. One can plot them as follows: > > > g1=ParametricPlot3D[Evaluate[{x, y, z} /. Solve[{x == -Sqrt[(-16*z^2 + > 4*z^3)/(-9 + z^2)], y == -Sqrt[-x^2 + 4*z]}, {x, y}]], {z, 0, 9/4}] > > and > > > g2=ParametricPlot3D[Evaluate[{x, y, z} /. Solve[{x == -Sqrt[(-16*z^2 + > 4*z^3)/(-9 + z^2)], y == -Sqrt[-x^2 + 4*z]}, {x, y}]], {z, 4, 8}] > > In general you expect them to be a superset of the intersection curve. > We can try to check this graphically. Doing so is a beautiful > application of Mathematica's interactive graphics. > > We simply turn on RealTime graphics with > > << RealTime3D` > > Now look at > > Show[g1, pp1] > > you can clearly see the curve g1 lying on the surface pp1 (defined by > you). > > Now do the same thing with pp2: > > Show[g1, pp2] > > again by rotating the graphic into a suitable position we can see > clearly that the curve also lies on pp2. > > Replacing g1 by g2 is slightly less convincing. We need to change the > parameters in both surface plots because the curve is actually in a > different region. But by changing the plots of the surfaces to > > pp1 = ParametricPlot3D[{x1, y1, z1}, {t1, 0, 2 Pi}, {t2, 0, 3}]; > pp2 = ParametricPlot3D[{x2, y2, z2}, {s1, 0, 2 Pi}, {s2, 0, 10}]; > > we see that this curve also lies on both surfaces. So the problem seems > to have been solved. > > > > -- DrBob at bigfoot.com www.eclecticdreams.net
- References:
- Intersection of two surfaces in 3D
- From: "Narasimham" <mathma18@hotmail.com>
- Re: Intersection of two surfaces in 3D
- From: Andrzej Kozlowski <akoz@mimuw.edu.pl>
- Intersection of two surfaces in 3D