3
$\begingroup$

It all starts with the following system of equations that I can't solve by hand:

w[x_, y_] := (a x^2 + b x y + c y^2 + d x + e y + f) / (g x + h y + i)
z[x_, y_] := w[x - 2 j, y - 2 j] + w[2 k - x, 2 k - y]
{zx, zy} = Grad[z[x, y], {x, y}];
sol = Solve[{zx == 0, zy == 0}, {x, y}]
Simplify[{zx == 0, zy == 0} /. sol]

{{x -> j + k, y -> j + k}}
{{True, True}}

But will that solution be unique? So trying to follow the same steps I would do by hand:

{nzx, dzx} = NumeratorDenominator[Factor[zx]];
{nzy, dzy} = NumeratorDenominator[Factor[zy]];

{pzx, pzy} = Factor[Resultant[nzx, nzy, {y, x}]];
sol = Solve[{pzx[[6;;8]] == 0, pzy[[6;;8]] == 0}, {x, y}];

par = {a -> 1, b -> 2, c -> 3, d -> 4, e -> 5, f -> 6,
       g -> 7, h -> 8, i -> 9, j -> 10, k -> 11};

Do[If[({nzx, nzy} /. sol[[l]] /. par) == {0, 0} &&
      (dzx dzy /. sol[[l]] /. par) != 0,
      Print[{sol[[l]]}]], {l, Length[sol]}];

{{x -> j + k, y -> j + k}}

where it's evident that at the end of the code I cheated by replacing numerical values.

Any ideas how I could do such checks without substituting numeric values?

$\endgroup$
1
  • $\begingroup$ What exact do you need to do? I'm not sure what your question is. $\endgroup$
    – MarcoB
    Mar 19, 2023 at 17:51

1 Answer 1

7
$\begingroup$

If you are excluding solutions where denominators become zero then this is the full set.

w[x_, y_] := (a x^2 + b x y + c y^2 + d x + e y + f)/(g x + h y + i)
z[x_, y_] := w[x - 2 j, y - 2 j] + w[2 k - x, 2 k - y]
{zx, zy} = Together[Grad[z[x, y], {x, y}]];

To enforce that denominators not vanish we "quotient out" that set by using new variables to add "reciprocal" relations of the form denon*recip=1.

polys = Join[Numerator[{zx, zy}],
  {rec1, rec2}*Denominator[{zx, zy}] - 1];

Now compute a Groebner basis, eliminating the reciprocal variables. It will give polynomials with the same solution set, and one will see there is only the unique solution.

Timing[
 gb = GroebnerBasis[polys, {x, y}, {rec1, rec2}, 
   CoefficientDomain -> RationalFunctions]]

(* Out[602]= {136., {-j - k + y, -j - k + x}} *)

Obviously this is not fast. But it is definitive.

$\endgroup$
0

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.