# Collect terms in inverse powers of three variables

I have the following expression

-(((-(L/r1) + L/r2)^2*(L/r1 - L/r3)^2*(-(L/r2) + L/r3)^2)/(1 + 1/r1 + 1/r2 + 1/r3)^2) + (1 + L^2/r1 + ((-(L/r1) + L/r2)*(L/r1 - L/r3))/(1 + 1/r1 + 1/r2 + 1/r3))*
(1 + L^2/r2 + ((-(L/r1) + L/r2)*(-(L/r2) + L/r3))/(1 + 1/r1 + 1/r2 + 1/r3))*(1 + 1/r1 + 1/r2 + 1/r3)*(1 + ((L/r1 - L/r3)*(-(L/r2) + L/r3))/(1 + 1/r1 + 1/r2 + 1/r3) +
L^2/r3)


Which I want to rewrite by collecting according to the inverse powers of r1, r2 and r3. That is, I want to get

1 + (1 + L^2)/r1 + (1 + L^2)/r2 + (1 + L^2)/r3 + (3*L^2 + L^4)/(r1*r2) + (3*L^2 + L^4)/(r1*r3) + (3*L^2 + L^4)/(r2*r3) + (9*L^4 + L^6)/(r1*r2*r3) -
L^6/(r1^2*r2^2) - L^6/(r1^2*r3^2) - L^6/(r2^2*r3^2) + (2*L^6)/(r1*r2*r3^2) + (2*L^6)/(r1*r2^2*r3) + (2*L^6)/(r1^2*r2*r3)


I have done this by hand, but for more complciated expressions I want to use Mathematica. I tried Collect[expression,{r1,r2,r3},Simplify] but it did nothing for me. Also, I do not want to collect in powers of L.

• You can get the coefficients of 1/r1,1/r2,1/r3 using: CoefficientList[expression, {1/r1, 1/r2, 1/r3}] Look it up in the help, for the output format Commented Dec 28, 2020 at 17:58

Total @ Factor @ MonomialList[Simplify @ expr, 1/{r1, r2, r3}]


To have the terms in a specific order, sort the monomials as you like and wrap the resulting list with Apply[Defer @* Plus]:

Apply[Defer @* Plus] @
SortBy[Through @ {Total, Sort} @ Exponent[#, 1/{r1, r2, r3}] &] @
Factor @ MonomialList[Simplify @ expr, 1/{r1, r2, r3}]


Using an alternative ordering of terms:

Apply[Defer @* Plus] @ Factor @
MonomialList[Simplify @ expr, 1/{r1, r2, r3}, "NegativeDegreeReverseLexicographic"]


Here is a pretty manual approach:

Total[
Simplify@*Total /@
GatherBy[
List @@ Expand[FullSimplify@expr],
Denominator
]
]


• This is nice. Do you think it is possible to get the output in the order I have specified above? Commented Dec 28, 2020 at 19:11
• Maybe start with yours: Block[{sepTerms, invSepTerms}, sepTerms = Total[Simplify @* Total /@ GatherBy[List @@ Expand[Simplify[Together[Qf[x, y, z] /. {1/Sqrt[(x - x1)^2 + y^2 + (z - z1)^2] -> 1/r1, 1/Sqrt[(x - x2)^2 + y^2 + (z - z2)^2] -> 1/r2, 1/Sqrt[(x - x3)^2 + y^2 + (z - z3)^2] -> 1/r3}]]], Denominator]]; invSepTerms = CoefficientRules[test /. {r1 -> ir1^(-1), r2 -> ir2^(-1), r3 -> ir3^(-1)}, {ir1, ir2, ir3}]; invSepTerms = SortBy[invSepTerms, Total[#1[[1]]] & ]; Apply[Times, ({r1, r2, r3}^(-#1) & ) /@ invSepTerms[[All,1]], {1}]*invSepTerms[[All,2]]] Commented Dec 28, 2020 at 19:43
• @ThunderBiggi Plus has the attribute Orderless, which means it sorts its arguments into a canonical order. Just try to keep y + x in the order y + x. You have to use something like Hold[y + x] or Defer[y + x] to keep the terms from being sorted. Commented Dec 28, 2020 at 19:59
• @MichaelE2 I always struggle with all the Hold functions, as they either stay there and prevent me from doing anything, or just disappear and do nothing. Where am I supposed to use it here? Commented Dec 28, 2020 at 20:11
• @ThunderBiggi I don't know because it depends. I was hoping you would just learn to live with the standard Plus ordering. Here are a couple of Q&A related to fixing the order of Plus: (15744), (188576). If you need the order just for output-formatting, there is hope. If you need to do further calculation with it, it is best to let Plus do its own thing, imo. Commented Dec 28, 2020 at 20:24