3
$\begingroup$

Let $h$ and $g$ designate two multivariable polynomials:

$$\!\!h(x,y)=-96\! \left(32 x^2\!+\!8 x (3\!-\!8 y)\!+\!40 y^2-28 y+5\right) \left(10 x^2+x (4 y-2)+\quad\quad\quad\\ \quad\quad+(1-2 y)^2\right) \left(52 x^2+4 x (34 y-35)+352 y^2-244 y+43\right)$$

$$\!g(x,y)=\!320 x^4\!+\!176 x^3\!+\!\left(-512\! x^3\!-\!184 x^2\!-\!84 x\!-\!48\right)\! y\!+\!\left(272 x^2\!+\!160 x\!+\!172\right)\! y^2\!+\!\\+34 x^2+(-96 x-272) y^3+14 x+160 y^4+5 $$

Both functions intersect at $(-1/8,1/4)$ and $(0,1/2)$. Nevertheless, it is of my interest to obtain those points using Mathematica. That is to say, I want to determine the common or the intersection points between $g(x,y)$ and $h(x,y)$.

I have attempted to find those points using ContourPlot, as may see below:

h = -96 (5 + 32x^2 + 8x (3 - 8y) - 28y + 40y^2) ( 10x^2 + (1 - 2 y)^2
    + x (-2 + 4y)) ( 43 + 52x^2 - 244y + 352y^2 + 4x ( -35 + 34y));

g = 5 + 14x + 34x^2 + 176x^3 + 320x^4 + ( -48 - 84x - 184x^2 - 512x^3) y
   + ( 172 + 160x + 272x^2) y^2 + ( -272 - 96x) y^3 + 160y^4;

plot = ContourPlot[ h == g, {h, -2, 2}, {g, -2, 2}, 
         MaxRecursion -> 4, PlotPoints -> 50] // Quiet; 

intersectionpoints = plot[[1]][[1]][[1]]

However, it did not return the intersection points.

Based on the above, how may I properly obtain the common points between $h(x,y)$ and $g(x,y)$ by employing Mathematica?

$\endgroup$
4
  • 1
    $\begingroup$ Does Solve[g == h] do what you need, or do you need something else? What about Solve[g == h, {x, y}, Reals] // FullSimplify for forcing real values? I'm not sure I understand what you are looking for. $\endgroup$
    – Roman
    Commented Mar 20, 2023 at 11:35
  • $\begingroup$ Hi,@Roman. I hope you doing well. Actually, I want the intersection points of $h(x,y)$ and $g(x,y)$. I will try your suggestion. Thanks a lot. $\endgroup$
    – VH84
    Commented Mar 20, 2023 at 11:48
  • 2
    $\begingroup$ Should be {x, -2, 2}, {y, -2, 2} instead of {h, -2, 2}, {g, -2, 2} $\endgroup$
    – cvgmt
    Commented Mar 20, 2023 at 11:49
  • $\begingroup$ Are you in the real or the complex domain? Both domain are reducable; in the complex domain, complex paths result. If you do not tell Mathematica to work in the real domain, then it works in the complex domain. $\endgroup$
    – anon
    Commented Mar 20, 2023 at 22:50

3 Answers 3

6
$\begingroup$

We define:

h[x_, y_] := -96 (5 + 32 x^2 + 8 x (3 - 8 y) - 28 y + 40 y^2) (10 x^2 + (1 - 2 y)^2 
             + x (-2 + 4 y)) (43 + 52 x^2 - 244 y + 352 y^2 + 4 x (-35 + 34 y))
g[x_, y_] :=  5 + 14 x + 34 x^2 + 176 x^3 + 320 x^4 
             + (-48 - 84 x - 184 x^2 - 512 x^3) y + (172 + 160 x + 272 x^2) y^2 
             + (-272 - 96 x) y^3 + 160 y^4

The most powerful function you can use is Reduce

Reduce[g[x, y] == h[x, y] && -1 < x < 3 && -2 < y < 2, {x, y}]
 (x == -(1/8) && y == 1/4) || (x == 0 && y == 1/2) || 
 (x == (4086 - Sqrt[16476801])/3420 && y == 1/176 (61 
        - (17 (4086 - Sqrt[16476801]))/1710) - 1/352 Sqrt[
           1/3 (-767 + 2724/95 (4086 - Sqrt[16476801]) - 
            1/285 (4086 - Sqrt[16476801])^2)]) || 
 ((4086 - Sqrt[16476801])/3420 < x < (4086 + Sqrt[16476801])/3420 && 
   ( y == 1/176 (61 - 34 x) - Sqrt[-767 + 98064 x - 41040 x^2]/(352 Sqrt[3]) ||
    y == 1/176 (61 - 34 x) + Sqrt[-767 + 98064 x - 41040 x^2]/(
      352 Sqrt[3]))) || (x == (4086 + Sqrt[16476801])/3420 && 
    y == 1/176 (61 - (17 (4086 + Sqrt[16476801]))/1710) 
          - 1/352 Sqrt[1/3 (-767 + 2724/95 (4086 + Sqrt[16476801]) 
          - 1/285 (4086 + Sqrt[16476801])^2)])
   Reduce[g[#, y] == h[#, y] && -2 < y < 2, {y}] & /@ {-1/8, 0}}]
  {y == 1/4, y == 1/2}

If we take a closer look at contours of functions it appears that the both points $(-\frac{1}{8},\frac{1}{4})$ and $(0,\frac{1}{2})$ are global minima of $g$

Minimize[{g[x, y], #}, {x, y}] & /@ {x < 0, x >= 0}
{{0, {x -> -(1/8), y -> 1/4}}, {0, {x -> 0, y -> 1/2}}}
RegionPlot[{g[x, y] < 1/50, g[x, y] < 1/117, g[x, y] < 1/150},
  {x, -1/5, 1/10}, {y, 1/10, 3/5}, 
  Epilog -> {Red, PointSize[0.02], Point[{{-1/8, 1/4}, {0, 1/2}}]},
  Axes -> True]

enter image description here

ContourPlot[
  Evaluate@Table[h[x, y] == c, {c, {0, -1, -4, -5, -10}}],
  {x, -1/6, 1/14}, {y, 1/5, 11/20}, ContourStyle -> Thick,
  PlotPoints -> 100, MaxRecursion -> 5, Axes -> True, 
  Epilog -> {Red, PointSize[0.02], Point[{{-1/8, 1/4}, {0, 1/2}}]}, 
  PlotLegends -> Placed[{h == 0, h == -1, h == -4, h == -5, h == -10},
                         {Left, Top}]]

enter image description here

$\endgroup$
5
$\begingroup$
h = -96 (5 + 32 x^2 + 8 x (3 - 8 y) - 28 y + 
    40 y^2) (10 x^2 + (1 - 2 y)^2 + x (-2 + 4 y)) (43 + 52 x^2 - 
    244 y + 352 y^2 + 4 x (-35 + 34 y));
g = 5 + 14 x + 34 x^2 + 176 x^3 + 
    320 x^4 + (-48 - 84 x - 184 x^2 - 512 x^3) y + (172 + 160 x + 
    272 x^2) y^2 + (-272 - 96 x) y^3 + 160 y^4;

Solve[g == h, {x, y}, Reals] // FullSimplify

During evaluation of In[27]:= Solve::svars: Equations may not give solutions for all "solve" variables.

(*    {{y -> ConditionalExpression[(366 - 204 x - Sqrt[3] Sqrt[-767 + 432 (227 - 95 x) x])/1056,
               Sqrt[16476801] + 3420 x > 4086 && 3420 x < 4086 + Sqrt[16476801]]},
       {y -> ConditionalExpression[(366 - 204 x + Sqrt[3] Sqrt[-767 + 432 (227 - 95 x) x])/1056,
               Sqrt[16476801] + 3420 x > 4086 && 3420 x < 4086 + Sqrt[16476801]]},
       {x -> -1/8, y -> 1/4},
       {x -> 0, y -> 1/2},
       {x -> (4086 - Sqrt[16476801])/3420, y -> 11/95 + (17 Sqrt[499297/33])/9120},
       {x -> (4086 + Sqrt[16476801])/3420, y -> 11/95 - (17 Sqrt[499297/33])/9120}}    *)

Note that

Factor[g - h]
(*    (1 - 2 x + 10 x^2 - 4 y + 4 x y + 4 y^2) *
      (5 + 24 x + 32 x^2 - 28 y - 64 x y + 40 y^2) *
      (4129 - 13440 x + 4992 x^2 - 23424 y + 13056 x y + 33792 y^2)    *)

$g-h$ can be factorized and the factors can be analyzed separately:

e1 = {x, y - 1/2} . {{10, 2}, {2, 4}} . {x, y - 1/2};
e2 = {x + 1/8, y - 1/4} . {{32, -32}, {-32, 40}} . {x + 1/8, y - 1/4};
e3 = {x - 227/190, y - 11/95} . {{474240/499297, 620160/499297}, {620160/499297, 3210240/499297}} . {x - 227/190, y - 11/95};

g - h == 499297/95 * e1 * e2 * (e3 - 1) // Expand
(*    True    *)
  • The first factor, e1 == 0, is zero at the point $\left(0,\frac12\right)$
  • The second factor, e2 == 0, is zero at the point $\left(-\frac18,\frac14\right)$
  • The third factor, e3 == 1, is zero on an ellipse

Graphically,

DensityPlot[g - h, {x, -1, 3}, {y, -1, 1},
            MeshFunctions -> {#3 &}, Mesh -> {{0, 10}}, 
            Epilog -> {Red, Point /@ {{0, 1/2}, {-(1/8), 1/4}}},
            AspectRatio -> Automatic, PlotPoints -> 100]

enter image description here

Zoom in a bit:

DensityPlot[g - h, {x, -0.2, 0.2}, {y, 0.2, 0.6}, 
            MeshFunctions -> {#3 &}, Mesh -> {Range[0, 10]}, 
            Epilog -> {Red, Point /@ {{0, 1/2}, {-(1/8), 1/4}}}, 
            AspectRatio -> Automatic, PlotPoints -> 100]

enter image description here

$\endgroup$
4
  • 1
    $\begingroup$ Could you check if points lie on the solution set ContourPlot[h[x, y] == g[x, y], {x, -1/2, 5/2}, {y, -3/4, 3/4}, ContourStyle -> Thick, PlotPoints -> 100, MaxRecursion -> 5, Axes -> True, Epilog -> {Red, PointSize[0.02], Point[{{-1/8, 1/4}, {0, 1/2}}]}]. On my system they don't (ver. 13.0.1). I can't find a mistake. h and g are definded as in my answer. I mean there must be a bug in ContourPlot since contour lies only for $x>=0$ while there is a solution {-1/8,1/4}. $\endgroup$
    – Artes
    Commented Mar 20, 2023 at 12:37
  • 1
    $\begingroup$ ContourPlot won't find single points reliably. It only finds contours properly. $\endgroup$
    – Roman
    Commented Mar 20, 2023 at 13:10
  • 1
    $\begingroup$ I know, I've added points $(-1/8,1/4)$ and $(0,1/2)$ with Epilog to ContourPlot. They are outside of contour $g(x,y)=h(x,y)$. $\endgroup$
    – Artes
    Commented Mar 20, 2023 at 13:13
  • 1
    $\begingroup$ I've added some contour plots that show what's going on. $\endgroup$
    – Roman
    Commented Mar 20, 2023 at 13:14
2
$\begingroup$

Factoring shows they contain common factors.

Factor[g]

(* Out[626]= (1 - 2 x + 10 x^2 - 4 y + 4 x y + 4 y^2) (5 + 24 x + 
   32 x^2 - 28 y - 64 x y + 40 y^2) *)

Factor[h]

(* Out[627]= -96 (1 - 2 x + 10 x^2 - 4 y + 4 x y + 4 y^2) (5 + 24 x + 
   32 x^2 - 28 y - 64 x y + 40 y^2) (43 - 140 x + 52 x^2 - 244 y + 
   136 x y + 352 y^2) *)

So it suffices to find where the quotient is unity.

ss = 
 Simplify[
  Solve[(43 - 140 x + 52 x^2 - 244 y + 136 x y + 352 y^2) == -1/96, x]]

(* Out[630]= {{x -> 
   1/624 (840 - 816 y - 
      Sqrt[6] Sqrt[63923 + 76032 y - 328320 y^2])}, {x -> 
   1/624 (840 - 816 y + Sqrt[6] Sqrt[63923 + 76032 y - 328320 y^2])}} *)

Check that they are equal on this set.

In[633]:= h/g /. ss // Simplify

(* Out[633]= {1, 1} *)

Other solutions can be obtained by solving for where each of the remaining two factors vanishes.

$\endgroup$

Your Answer

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

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