Getting only 1 of 3 curves of intersection

[Bill]

Hi:

Consider the following plot:

g1=Plot3D[Sin[x*y],{x,0,Pi},{y,0,Pi},PlotStyle->None,MeshStyle->Red,Axes->True,AxesLabel->{"x","y","z"}];
g2=Plot3D[Cos[x*y],{x,0,Pi},{y,0,Pi},Mesh->None,PlotStyle->{Cyan,Opacity[.8]}];
nsSol=NSolve[{z-Sin[x*y],z-Cos[x*y]},{y,z}];//Quiet
g3=ParametricPlot3D[{x,y,z}/.nsSol[[2]],{x,0,Pi},PlotStyle->{Magenta,Thickness[.007]}];
Show[g1,g2,g3,Background->LightYellow,ImageSize->500]

Using the above Mathematica 8.0.4 code, I can plot one curve of intersection shown in magenta.
Within the plotted area, I can see 2 more places where intersection curves should be.
I've tried using Reduce in place of NSolve, but can't get it to work.

Question: If this can be done, can someone please give me the code?


Thanks,

Bill

[Bob Hanlon]

g1 = Plot3D[Sin[x*y], {x, 0, Pi}, {y, 0, Pi},
PlotStyle -> None,
MeshStyle -> Red,
Axes -> True,
AxesLabel -> {"x", "y", "z"}];

g2 = Plot3D[Cos[x*y], {x, 0, Pi}, {y, 0, Pi},
Mesh -> None,
PlotStyle -> {Cyan, Opacity[.8]}];

rSol = Reduce[{z - Sin[x y] == 0, z - Cos[x y] == 0,
0 <= x <= \[Pi], 0 <= y <= \[Pi]}, {y, z}]

(((2*Pi - 2*ArcTan[1 + Sqrt[2]])/Pi <= x <=
Pi && y == (2*Pi - 2*ArcTan[1 + Sqrt[2]])/
x) || (-((2*ArcTan[1 - Sqrt[2]])/Pi) <=
x <= Pi && y == -((2*ArcTan[1 - Sqrt[2]])/
x)) || ((2*Pi - 2*ArcTan[1 - Sqrt[2]])/
Pi <= x <= Pi &&
y == (2*Pi - 2*ArcTan[1 - Sqrt[2]])/x)) &&
z == Sin[x*y]

rSol // FullSimplify

x <= Pi && (((9*Pi)/x == 4*y && 4*x >= 9) ||
(4*x*y == Pi && 4*x >= 1) ||
((5*Pi)/x == 4*y && 4*x >= 5)) &&
z == Sin[x*y]

param = Cases[rSol,
(y == f_) :> {x, f, Sin[x*f]}, Infinity] //
FullSimplify

{{x, (5*Pi)/(4*x), -(1/Sqrt[2])},
{x, Pi/(4*x), 1/Sqrt[2]}, {x, (9*Pi)/(4*x),
1/Sqrt[2]}}

g3 = ParametricPlot3D[param, {x, 0, Pi},
PlotStyle -> {{Magenta, Thickness[.007]}}];

Show[g1, g2, g3,
Background -> LightYellow,
ImageSize -> 500]


Bob Hanlon

[Andrzej Kozlowski]

Try this:

g1 = Plot3D[Sin[x*y], {x, 0, Pi}, {y, 0, Pi}, PlotStyle -> None,
MeshStyle -> Red, Axes -> True, AxesLabel -> {"x", "y", "z"}];
g2 = Plot3D[Cos[x*y], {x, 0, Pi}, {y, 0, Pi}, Mesh -> None,
PlotStyle -> {Cyan, Opacity[.8]}];

sols1 = w /. Solve[Sin[w] == Cos[w] && 0 < w < Pi^2, w, Reals] // N;
sols2 = Flatten[Solve[{z == Sin[#], x y == #}, {y, z}] & /@ sols1,
1];
g3 = ParametricPlot3D[{x, y, z} /. sols2, {x, 0, Pi},

PlotStyle -> {Magenta, Thickness[.007]}];
Show[g1, g2, g3, Background -> LightYellow, ImageSize -> 500]

Andrzej Kozlowski

[djmpark]

Bill,

Use Reduce:

Reduce[Cos[x y] == Sin[x y] && 0 <= y <= \[Pi], {x, y}, Reals]

Then write ConditionalExpressions for the intersections.

intersection1[k_][x_] =
ConditionalExpression[{x, (-2 ArcTan[1 + Sqrt[2]] + 2 \[Pi] k)/x,
Sin[-2 ArcTan[1 + Sqrt[2]] + 2 \[Pi] k]}, (k <= 0 &&
x <= (-2 ArcTan[1 + Sqrt[2]] + 2 \[Pi] k)/\[Pi]) || (k >= 1 &&
x >= (-2 ArcTan[1 + Sqrt[2]] + 2 \[Pi] k)/\[Pi])];

intersection2[k_][x_] =
ConditionalExpression[{x, (-2 ArcTan[1 - Sqrt[2]] + 2 \[Pi] k)/x,
Sin[-2 ArcTan[1 - Sqrt[2]] + 2 \[Pi] k]}, (k <= -1 &&
x <= (-2 ArcTan[1 - Sqrt[2]] + 2 \[Pi] k)/\[Pi]) || (k >= 0 &&
x >= (-2 ArcTan[1 - Sqrt[2]] + 2 \[Pi] k)/\[Pi])];

The particular intersections you want for your plot are:

intersection2[0][x]
intersection2[1][x]
intersection1[1][x]

In Presentations I would draw this as:

<< Presentations`

Draw3DItems[
{{Opacity[0.6, ColorData["Crayola"]["RedViolet"]],
Draw3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}, Mesh -> None]},
{Opacity[0.6, Cyan],
Draw3D[Cos[x y], {x, 0, Pi}, {y, 0, Pi}, Mesh -> None]},
{Black, Thick,
ParametricDraw3D[intersection2[0][x], {x, 0, \[Pi]}],
ParametricDraw3D[intersection2[1][x], {x, 0, \[Pi]}],
ParametricDraw3D[intersection1[1][x], {x, 0, \[Pi]}]}},
NeutralLighting[0, 0.5, 0.4],
NiceRotation,
Axes -> True, AxesLabel -> {"x", "y", "z"},
BoxRatios -> {1, 1, 0.5},
ImageSize -> 500]


David Park
djm...@comcast.net
http://home.comcast.net/~djmpark/index.html