On the solution of systems equations with exact coefficients

Question

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?

Answer 1

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.