# Grouping together same exponent terms in a multivariate monomial

This is a rather simple question but for some reason, I am spending too much time on this.

Suppose I have a monomial in 4 variables, each raised to some linear combination of 3 exponent variables: {a1, a2, a3, a4}, and {b1, b2, b3}.

Now I want to collect monomial subexpressions with the same exponent variable together. For eg, if I have the following input:

(-a1)^(b1 + 2b2 + b3) a2^(-b2 + b3) (-a3)^(-2b1 + b2) a4^(3b1 + 4b3)


I should obtain precisely the following expression as output:

(-1)^(-b1 + 3b2 + b3) ((a1 a4^3)/a3^2)^b1 ((a1^2 a3)/a2)^b2 (a1 a2 a4^4)^b3


Note: it would be better if the solution to this query doesn't involve the use of ReplaceRepeated, and that it works for the full general case of $$m$$ monomial variables {a1, a2, ..., am} with $$n$$ exponent variables {b1, b2, ..., bn}.

expr = (-a1)^(b1 + 2 b2 + b3) a2^(-b2 + b3) (-a3)^(-2 b1 + b2) a4^(3 b1 + 4 b3);


You can reorganize the output from a composition of FactorList and PowerExpand into the desired form using GroupBy + KeyValueMap:

FactorList @ PowerExpand @ expr

 {{1, 1}, {(-1)^b3, 1}, {(-1)^b2, 3}, {(-1)^b1, -1},
{a1^b3, 1}, {a1^b2, 2}, {a1^b1, 1},
{a2^b3, 1}, {a2^b2, -1}, {a3^b2, 1}, {a3^b1, -2},
{a4^b3, 4}, {a4^b1, 3}}

ClearAll[kvm, groupByExponents]

kvm = KeyValueMap[If[#,
Times @@ Power @@@ #2,
KeyValueMap[(Times @@ #2)^# &] @
GroupBy[#2, #[[1, 2]] &, Map[#[[1, 1]]^#[] &]]] &];

groupByExponents[exp_] := Module[{fl = FactorList @ PowerExpand @ exp},
Times @@ Prepend[Power @@ First[fl]] @
Flatten[kvm @ GroupBy[Rest @ fl, NumericQ @ #[[1, 1]] &]]]

groupByExponents @ expr 