How to turn an expression $x^a y^b z^c$ to a list $\{x,\cdots,x, y,\cdots, y, z, \cdots, z\}$ with $x$ appearing $a$ times, etc

Question

I will include all parts of the algorithm that I want to be implemented, although it is really part 2 that I need help with (especially in the form discussed in the beginning of part 3).

I have homogeneous polynomials of the form say $x_1^2x_2x_3+ 2x_2^2x_3^2$. I'm looking to do the following to it:

1. Find the monomial list of it, which is easily done with MonomialList[].

2. Choose a monomial say $2x_2^2x_3^2$ which is (like every other monomial) of degree $4$. Transform the monomial into $$ 2x_2^2x_3^2\to 2x_2 x_2 x_3x_3\to 2x_{2,1}x_{2,2}x_{3,3}x_{3,4} $$ where the second transform takes the $i$th variable appearing, say it is $x_k$, and transforms it into $x_{k,i}$. In other words when $x_{k,j}$ appears in the final result, it means in the original monomial at position j, the variable $x_k$ happens. The final result $2x_{2,1}x_{2,2}x_{3,3}x_{3,4}$ is supposed to be an expression NOT just a display.

3. In fact for the intermediate transformation $2x_2^2x_3^2\to 2x_2 x_2 x_3x_3$ it is convenient if it is done as $2x_2^2x_3^2\to \{2, \{x_2, x_2, x_3, x_3\}\}$. This is because later on in the algorithm I will need the average over over all permutations of $\{x_2, x_2, x_3,x_3\}$ in the following sense $$ 2x_2^2x_3^2\to \frac{1}{4!}\sum_{\sigma\in \mathrm{SymGrp}(4)} 2x_{2,\sigma(1)}x_{2,\sigma(2)}x_{3,\sigma(3)}x_{3,\sigma(4)} $$ I know how to do it if I have the list $\{x_2, x_2, x_3, x_3\}$.

4. Finally we fix an integer $n>0$, make a table

Table[Subscript[x, i, j]-> Subscript[R,j]^i Subscript[S,j]^(n - i), {i, 3},{j,4}]

And after flattening it, we make a replacement via the condition defined above, which essentially replaces $x_{i,j}\to (R_j)^i (S_j)^{n-i}$. This is the final thing I'm looking for.

All the steps are straightforward for me, except step 2. I'm asking how to do step 2. However I shared the whole process because someone might have a better idea altogether.

Answer 1

f[expr_] := Block[{m = expr, v, e, t, c},
  v = Variables[m];
  e = Exponent[m, #] & /@ v;
  t = Transpose@{v, e};
  c = m/Times @@ (#[[1]]^#[[2]] & /@ t);
  {c}~Join~{Flatten[ConstantArray[##] & @@@ t]}
  ]

m = 5 x^2 y^3 z^4;

f[m]

gives

{5, {x, x, y, y, y, z, z, z, z}}

Answer 2

ClearAll[f1]
f1 = Block[{Times = List, Power = ConstantArray}, {First@#, Join @@ Rest@#}] &;

f1[5 x^2 y^3 z^4]

f1@(5 Subscript[x, 1]^2 Subscript[x, 2]^3 Subscript[x, 3]^4)

ClearAll[f2]
f2 = With[{lst = Block[{Times = List, Power = ConstantArray}, #]}, 
    Times[First@#, Times @@ MapIndexed[Subscript[#, #2[[1]]] &, Join @@ Rest@lst]] /. 
      Subscript[Subscript[a_, b_], c_] :> Subscript[a, Row[{b, ",", c}]]] &;

Examples

f2[5 x^2 y^3 z^4]

f2[5 Subscript[x, 1]^2 Subscript[x, 2]^3 Subscript[x, 3]^4]

Answer 3

Here is how to do your steps 1 and 2 all at once, using an undocumented function:

poly = x^2 y z + 2 y^2 z^2; vars = Variables[poly];
dtl = Reverse /@ First[GroebnerBasis`DistributedTermsList[poly, vars]];
MapAt[Flatten[MapThread[ConstantArray, {vars, #}]] &, dtl, {All, -1}]
   {{1, {x, x, y, z}}, {2, {y, y, z, z}}}