The polynomial function changed to a set consisting of terms of polynomial function

Question

I have the following polynomial function $$f= x_{1,2} x_{2,4}+x_{1,3} x_{3,2} x_{2,4}+x_{1,2} x_{2,3} x_{3,2} x_{2,4}+x_{1,3} x_{3,4}+x_{1,2} x_{2,3} x_{3,4}$$

I want to convert the polynomial function to set consisting of terms of polynomial function as follows,

$$\{x_{1,2} x_{2,4},x_{1,3} x_{3,2} x_{2,4},x_{1,2} x_{2,3} x_{3,2} x_{2,4},x_{1,3} x_{3,4},x_{1,2} x_{2,3} x_{3,4}\}$$

Then, delete terms that contain another terms in the set.

$$x_{1,2} x_{2,4}\subset x_{1,2} x_{2,3} x_{3,2} x_{2,4}$$

so we delete $x_{1,2} x_{2,3} x_{3,2} x_{2,4}$ and we get,

$$S=\{x_{1,2} x_{2,4},x_{1,3} x_{3,4},x_{1,3} x_{3,2} x_{2,4},x_{1,2} x_{2,3} x_{3,4}\}$$

the mathematica code of the polynomial function $f$

f=Subscript[x, 1, 2] Subscript[x, 2, 4] + 
 Subscript[x, 1, 3] Subscript[x, 2, 4] Subscript[x, 3, 2] + 
 Subscript[x, 1, 2] Subscript[x, 2, 3] Subscript[x, 2, 4] Subscript[x,
   3, 2] + Subscript[x, 1, 3] Subscript[x, 3, 4] + 
 Subscript[x, 1, 2] Subscript[x, 2, 3] Subscript[x, 3, 4]

Thanks for the help.

Answer 1

You could use DeleteDuplicates + SortBy:

baseSet[f_] := DeleteDuplicates[
    SortBy[MonomialList[f], {Head, Length}],
    Denominator[#2/#1]==1&
]

For your example:

baseSet[f] //TeXForm

$\left\{x_{1,2} x_{2,4},x_{1,3} x_{3,4},x_{1,2} x_{2,3} x_{3,4},x_{1,3} x_{2,4} x_{3,2}\right\}$

Answer 2

This method is overkill for the given example but could be useful for larger problems of this type. It uses two steps, both with non-System context functions. The first is to get the monomials as lists of exponent vectors and corresponding coefficients (the latter of which we will ignore). Then we use a function that effectively finds the minimal exponent vectors, discarding the rest.

f = x[1, 2] x[2, 4] + x[1, 3] x[2, 4] x[3, 2] + 
   x[1, 2] x[2, 3] x[2, 4] x[3, 2] + x[1, 3] x[3, 4] + 
   x[1, 2] x[2, 3] x[3, 4];

Here is the list of monomial/coefficient pairs along with the ordering of variables that was used to create it (useful for converting back to monomials but I am omitting that step).

dtl = GroebnerBasis`DistributedTermsList[f, Variables[f]]

(* Out[291]= {{{{1, 1, 0, 1, 1, 0}, 1}, {{1, 1, 0, 0, 0, 0}, 
   1}, {{1, 0, 0, 0, 1, 1}, 1}, {{0, 1, 1, 1, 0, 0}, 
   1}, {{0, 0, 1, 0, 0, 1}, 1}}, {x[1, 2], x[2, 4], x[1, 3],
  x[3, 2], x[2, 3], x[3, 4]}} *)

Here we pick out our exponent vectors.

monoms = dtl[[1, All, 1]]

(* Out[293]= {{1, 1, 0, 1, 1, 0}, {1, 1, 0, 0, 0, 0}, 
{1, 0, 0, 0, 1, 1}, {0, 1, 1, 1, 0, 0}, {0, 0, 1, 0, 0, 1}} *)

And now we get the minimal elements.

Internal`ListMin[monoms]

(* Out[301]= {{1, 1, 0, 0, 0, 0}, {0, 0, 1, 0, 0, 1},
 {1, 0, 0, 0, 1, 1}, {0, 1, 1, 1, 0, 0}} *)

Some day I'll advocate for making that ListMin into a System-context function.