6
$\begingroup$

I have $f(x,y,z)=0$ and $g(x,y,z)=0$. I want to exclude parameter $z$ and extract a line $x(y)$.

I tried contourplot3D but then I need to map intersection of two surfaces onto x-y plane.

$\endgroup$
1
  • $\begingroup$ Depending on your functions, this is easy or extremely hard. So it would reduce the possible answers if you specify the form of your functions. Here is an example with linear and quadratic functions: f = x + y + z; g = x^2 - 2 y + 3 z^2; Solve[Eliminate[{f == 0, g == 0}, z], y] $\endgroup$ Nov 1, 2020 at 13:49

2 Answers 2

12
$\begingroup$

Sometimes it is not easy to eliminate z, so we can use some tricks.

Clear[f, g];
f[x_, y_, z_] = x^2 + y^2 + Sin[z] - 1;
g[x_, y_, z_] = x*y*Log[Abs[z]] - 0.1;
ContourPlot3D[g[x, y, z] == 0, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, 
 Mesh -> {{0}}, MeshFunctions -> Function[{x, y, z}, f[x, y, z]], 
 MeshStyle -> {Thick, Cyan}, ContourStyle -> Opacity[0.01], 
 ViewPoint -> {0, 0, ∞}, ViewProjection -> "Orthographic", 
 BoundaryStyle -> None, Axes -> {True, True, False}, 
 AxesLabel -> {x, y, None}]
Export["eliminate-z.png", %]

enter image description here

$\endgroup$
2
  • $\begingroup$ great, thank you! I thought there is some 2d environment to achieve this projection, but this one is also fine. $\endgroup$ Nov 1, 2020 at 16:51
  • 1
    $\begingroup$ The inner arc in the first and third quadrants is spurious, apparently arising from the essential singularity in g at z = 0. This can be seen from c0 = Cases[cp[[1, 1]] // Normal, {_, _, z_} /; Abs[z] < 10^-10, Infinity], where cp is the name assigned to the plot. Then g @@@ c0 shows that g is not at all well satisfied for points near z = 0. Otherwise, great answer (+1). $\endgroup$
    – bbgodfrey
    Nov 2, 2020 at 3:20
4
$\begingroup$

With f and g as defined in the answer by cvgmt,

f[x_, y_, z_] = x^2 + y^2 + Sin[z] - 1;
g[x_, y_, z_] = x*y*Log[Abs[z]] - 1/10;

a general solution solution can be obtained by

Flatten[DeleteCases[Quiet@Table[Check[{x0, 
    FindRoot[{f[x, y, z], g[x, y, z]} /. x -> x0, {{y, y0}, {z, z0}}][[1, 2]]}, 
    Nothing], {x0, -2, 2, .04}, {z0, -5, 5}, {y0, -2, 2, .5}], {}, Infinity], 1];
ListPlot[%, PlotRange -> {{-2, 2}, {-2, 2}}, AspectRatio -> 1, 
    PlotStyle -> Directive[Cyan, PointSize[Medium]], ImageSize -> Large, 
    AxesLabel -> {x, y}, LabelStyle -> {15, Bold, Black}]

enter image description here

Note, however, that more points, outside the circle x^2 + y^2 = 2, can be obtained by using imaginary numbers (e.g., 2 I) as initial guesses for z0. They are clustered near the axes. An analytical solution for this particular set of equations can be obtained from

Reduce[f[x, y, z] == 0, z]
(* C[1] ∈ Integers && (z == Pi - ArcSin[1 - x^2 - y^2] + 2 Pi C[1] || 
   z == ArcSin[1 - x^2 - y^2] + 2 Pi C[1]) *)

which is equivalent to z -> ArcSin[1 - x^2 - y^2] + Pi n, with n an integer. Then

sgt = Table[0 == g[x, y, z] /. z -> ArcSin[1 - x^2 - y^2] + Pi n, {n, -10, 10}];
Show[ContourPlot[Evaluate@sgt, {x, -2, 2}, {y, -2, 2}, ContourStyle -> Cyan, 
         FrameLabel -> {x, y}, LabelStyle -> {15, Bold, Black}], 
     ContourPlot[{x == 0, y == 0}, {x, -2, 2}, {y, -2, 2}, ContourStyle -> Black], 
         ImageSize -> Large]

enter image description here

which agrees with my first plot for real z but extends to larger x and y for complex z. Note that as n becomes ever larger, additional hyperbola-like curves fill the space near the axes (shown in Black) in the first and third quadrants.

The plots here differ from those in the answer by cvgmt in two respects. First, my plots show numerous hyperbolas. The method used by cvgmt also would display hyperbolas, if {z, -2, 2} were replaced by larger limits, say {z, -10, 10}. Second, my plots do not show an inner arc of approximate radius 1 in the first and third quadrants. To explore the discrepancy, I considered the two functions on the line x = y.

f[w, w, z] == 0
(* -1 + 2 w^2 + Sin[z] == 0 *)
g[w, w, z] == 0
(* 1/10 + w^2 Log[Abs[z]] == 0 *)

Plot the intersections of these two expressions for w^2.

Plot[{(1 - Sin[z])/2, 1/(10  Log[Abs[z]])}, {z, -10, 10}, ImageSize -> Large, 
    AxesLabel -> {z, w^2}, LabelStyle -> {15, Bold, Black}]

enter image description here

The largest value of w^2 lies near z = -1.

FindRoot[(10  Log[Abs[z]]) (1 - Sin[z])/2 == 1, {z, -1 + 0 I}]
w -> Sqrt[(1 - Sin[z])/2] /. %
(* {z -> -1.11123} *)
(* w -> 0.973716 *)

which lies on the outer arc, as expected. The next largest value of w^2 lies near z = 2.

FindRoot[(10  Log[Abs[z]]) (1 - Sin[z])/2 == 1, {z, 2 + 0 I}]
w -> Sqrt[(1 - Sin[z])/2] /. %
(* {z -> 2.28198} *)
(* w -> 0.348146 *)

which lies on the outer hyperbola-like curve. Thus, there does not appear to be an inner arc.

Addendum: Extension of answer by cvgmt

The innovative answer by cvgmt can be extended by

ContourPlot3D[g[x, y, z] == 0, {x, -2, 2}, {y, -2, 2}, {z, -8, 11}, 
    Mesh -> {{0}}, MeshFunctions -> Function[{x, y, z}, f[x, y, z]], 
    MeshStyle -> {Cyan, Thickness[.002]}, ContourStyle -> None, 
    ViewPoint -> {0, 0, ∞}, BoundaryStyle -> None, 
    Axes -> {True, True, False}, AxesLabel -> {x, y, None}, ImageSize -> Large]

The principle modification is to increase the range of z to {z, -8, 11} to capture the first five hyperbola-like curves. Interestingly, doing so also eliminates the spurious inner arcs in the first and third quadrants. Other changes are replacing Opacity[0.01] by None to eliminate essentially invisible surfaces, replacing Thick by Thickness[.002]to better distinguish among some of the curves, and eliminating the redundant ViewProjection -> "Orthographic".

enter image description here

$\endgroup$
1
  • $\begingroup$ +1.Deep thought! $\endgroup$
    – user64494
    Nov 2, 2020 at 7:10

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.