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