Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have the following problem: given a list of polynomials P = {p1, ..., pn} on the variables x[1], ..., x[n], find a list of monic monomials M = q1, ..., qm on x[1], ..., x[n] and a matrix A that does not depend on x[1], ..., x[n] such that A.M = P.

For example, taking P = {x[1] x[2] + x[1]^2 x[2], a x[1]^2 + b x[2], c x[1]^2 x[2] + d x[2]^2} a possible solution is:

M = {x[1] x[2], x[1]^2, x[2], x[2]^2, x[1]^2 x[2]},

A = {{1, 0, 0, 0, 1}, {0, a, b, 0, 0}, {0, 0, 0, c, d}}

I managed to find a long and clumsy solution by using a lot of replacement rules, but I want to know if there is an easy way of doing something like this.

Many thanks in advance.

share|improve this question
add comment

2 Answers

Here is some code that might get you started. Will require some adjustment to get it exactly to what you want.

In[70]:= pP = {x[1] x[2] + x[1]^2 x[2], a x[1]^2 + b x[2], 
  c x[1]^2 x[2] + d x[2]^2}

Out[70]= {x[1] x[2] + x[1]^2 x[2], a x[1]^2 + b x[2], 
 c x[1]^2 x[2] + d x[2]^2}

In[78]:= vars = {x[1], x[2]};

In[84]:= mlist = GroebnerBasis`DistributedTermsList[pP, vars][[1]]

Out[84]= {{{{2, 1}, 1}, {{1, 1}, 1}}, {{{2, 0}, a}, {{0, 1}, 
   b}}, {{{2, 1}, c}, {{0, 2}, d}}}

In[98]:= ml2 = 
 mlist /. {{e1_Integer, e2_Integer}, c_} :> {c, 
    Times @@ (vars^{e1, e2})}

Out[98]= {{{1, x[1]^2 x[2]}, {1, x[1] x[2]}}, {{a, x[1]^2}, {b, 
   x[2]}}, {{c, x[1]^2 x[2]}, {d, x[2]^2}}}

In[99]:= {aa, mm} = {ml2[[All, All, 1]], ml2[[All, All, 2]]}

Out[99]= {{{1, 1}, {a, b}, {c, d}}, {{x[1]^2 x[2], 
   x[1] x[2]}, {x[1]^2, x[2]}, {x[1]^2 x[2], x[2]^2}}}

In[100]:= MapThread[Dot, {aa, mm}]

Out[100]= {x[1] x[2] + x[1]^2 x[2], a x[1]^2 + b x[2], 
 c x[1]^2 x[2] + d x[2]^2}
share|improve this answer
add comment

Approach based on CoefficientRules

P = {x[1] x[2] + x[1]^2 x[2], a x[1]^2 + b x[2], c x[1]^2 x[2] + d x[2]^2};
n = 2;
X = x /@ Range[n]
{x[1], x[2]}
coeff = Thread@(# -> Range@Length[#]) &@ 
    Sort@DeleteDuplicates[Join @@ CoefficientRules[P, X][[All, All, 1]]]
{{0, 1} -> 1, {0, 2} -> 2, {1, 1} -> 3, {2, 0} -> 4, {2, 1} -> 5}
M = Inner[Power, X, Transpose@coeff[[All, 1]], Times]
{x[2], x[2]^2, x[1] x[2], x[1]^2, x[1]^2 x[2]}
A = SparseArray[Join @@ MapIndexed[{#2[[1]], #[[1]]} -> #[[2]] &, 
      CoefficientRules[P, X] /. coeff, {2}]];

A.M == P

True

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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