Grouping together same exponent terms in a multivariate monomial

Question

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}.

Answer 1

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]]^#[[2]] &]]] &];

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

groupByExponents @ expr