Simplifying/Factoring a polynomial via certain given smaller polynomials

Question

Suppose I have a complicated polynomial with integer coefficients and variables $x_1, \cdots, x_n, y_1, \cdots, y_n$, say $$ -x_2^2 y_1 y_3+x_1 x_2 y_4^2+x_3 x_2 y_1 y_2+x_1 x_2 y_2 y_3-x_4 x_2 y_1 y_4-x_1 x_3 y_2^2+x_4^2 y_1 y_2-x_1 x_4 y_2 y_4 $$ or in code

expr=-Subscript[x, 2]^2*Subscript[y, 1]*Subscript[y, 3] + 
   Subscript[x, 1]*Subscript[x, 2]*Subscript[y, 4]^2 + 
   Subscript[x, 3]*Subscript[x, 2]*Subscript[y, 1]*
     Subscript[y, 2] + Subscript[x, 1]*Subscript[x, 2]*
     Subscript[y, 2]*Subscript[y, 3] - 
   Subscript[x, 4]*Subscript[x, 2]*Subscript[y, 1]*
     Subscript[y, 4] - Subscript[x, 1]*Subscript[x, 3]*
     Subscript[y, 2]^2 + Subscript[x, 4]^2*Subscript[y, 1]*
     Subscript[y, 2] - Subscript[x, 1]*Subscript[x, 4]*
     Subscript[y, 2]*Subscript[y, 4]

And I know that it factors via polynomials $(x_iy_j-x_jy_i)$. For example the above polynomials is $$\left(x_1 y_2-x_2 y_1\right) \left(x_2 y_3-x_3 y_2\right)+\left(x_1 y_4-x_4 y_1\right) \left(x_2 y_4-x_4 y_2\right)$$ or in code:

(Subscript[x, 1]*Subscript[y, 2] - Subscript[x, 2]*Subscript[y, 1])*(Subscript[x, 2]*Subscript[y, 3] - Subscript[x, 3]*Subscript[y, 2]) + 
  (Subscript[x, 1]*Subscript[y, 4] - Subscript[x, 4]*Subscript[y, 1])*(Subscript[x, 2]*Subscript[y, 4] - Subscript[x, 4]*Subscript[y, 2])

In other words my polynomial is known to have a form $\sum_{i=1}^m c_if_i$ with $f_i$ of the form $\prod_{k=1}^\ell(x_{i_k}y_{j_k}-x_{j_k}y_{i_k})$ and $c_i$ an integer.

Is there a way mathematica simplifies my polynomial in a form like above? This is similar to what SymmetricReduction command does, which takes a polynomial and breaks it down into elementary symmetric polynomials. Symmetric reduction also gives the remainder but I don't need that. I might need to mention that the actual polynomials I have are gigantic! (it takes mathematica a second just to show it all).

Edit I thought about constructing a set of rules (in our example n=4)

rules = Flatten[
  Table[Subscript[x, i] Subscript[y, j] - Subscript[x, j] Subscript[y, i] ->
 Subscript[Z, i, j],{i, n}, {j, i + 1, n}]]

But this doesn't work... I think I need to include all of the rules $(x_iy_j-x_iy_j)^p=Z_{ij}^p$ that might appear in the expression together with $-(x_iy_j-x_iy_j)=-Z_{ij}$, because as it is nothing happens when I apply these rules by expr/.rules.

Answer 1

General remark: All this would cut-paste nicer if variables were indexed rather than subscripted e.g. y[1]. I do not have the patience to deal with reformatting all this as I go between Mathematica and MSE.

In general such things can be done using PolynomialReduce, possibly with some preprocessing. In this case it is quite straightforward. We set up the expression.

expr = -Subscript[x, 2]^2*Subscript[y, 1]*Subscript[y, 3] + 
  Subscript[x, 1]*Subscript[x, 2]*Subscript[y, 4]^2 + 
  Subscript[x, 3]*Subscript[x, 2]*Subscript[y, 1]*Subscript[y, 2] + 
  Subscript[x, 1]*Subscript[x, 2]*Subscript[y, 2]*Subscript[y, 3] - 
  Subscript[x, 4]*Subscript[x, 2]*Subscript[y, 1]*Subscript[y, 4] - 
  Subscript[x, 1]*Subscript[x, 3]*Subscript[y, 2]^2 + 
  Subscript[x, 4]^2*Subscript[y, 1]*Subscript[y, 2] - 
  Subscript[x, 1]*Subscript[x, 4]*Subscript[y, 2]*Subscript[y, 4];

Now define the replacements as rules (we use them in a more fundamental way as polynomials, but this makes it easier to convert between rules and expressions). The idea is to recast the desired replacements as new variables. PolynomialReduce can then be used to rewrite the expression, to the extent possible, in terms of these new variables.

replacementrules = {p1 -> (Subscript[x, 1]*Subscript[y, 2] - 
       Subscript[x, 2]*Subscript[y, 1])*(Subscript[x, 2]*
        Subscript[y, 3] - Subscript[x, 3]*Subscript[y, 2]), 
   p2 -> (Subscript[x, 1]*Subscript[y, 4] - 
       Subscript[x, 4]*Subscript[y, 1])*(Subscript[x, 2]*
        Subscript[y, 4] - Subscript[x, 4]*Subscript[y, 2])};
replacementpolys = replacementrules /. Rule :> Subtract

(* Out[31]= {p1 - (-Subscript[4, 2] Subscript[y, 1] + 
     Subscript[4, 1] Subscript[y, 2]) (-Subscript[4, 3] Subscript[y, 
      2] + Subscript[4, 2] Subscript[y, 3]), 
 p2 - (-Subscript[4, 4] Subscript[y, 1] + 
     Subscript[4, 1] Subscript[y, 4]) (-Subscript[4, 4] Subscript[y, 
      2] + Subscript[4, 2] Subscript[y, 4])} *)

Now we use PolynomialReduce as advertised. We specify the variables in the original expression, and any others (in particular the "new" variables) get ordered lower so that the reduced expression will use them in preference to the original variables. When done, do the back-substitution. In effect this uses the replacement rules to go in reverse.

PolynomialReduce[expr, replacementpolys, 
   Variables[expr]][[2]] /. replacementrules

(* Out[32]= (-Subscript[4, 2] Subscript[y, 1] + 
    Subscript[4, 1] Subscript[y, 2]) (-Subscript[4, 3] Subscript[y, 
     2] + Subscript[4, 2] Subscript[y, 
     3]) + (-Subscript[4, 4] Subscript[y, 1] + 
    Subscript[4, 1] Subscript[y, 4]) (-Subscript[4, 4] Subscript[y, 
     2] + Subscript[4, 2] Subscript[y, 4]) *)