1
$\begingroup$

I have the following expression

enter image description here

-(((-(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

enter image description here

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.

$\endgroup$
1
  • $\begingroup$ 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 $\endgroup$ Dec 28 '20 at 17:58
1
$\begingroup$
Total @ Factor @ MonomialList[Simplify @ expr, 1/{r1, r2, r3}]

![enter image description here

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

enter image description here

Using an alternative ordering of terms:

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

enter image description here

$\endgroup$
3
$\begingroup$

Here is a pretty manual approach:

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

collected

$\endgroup$
5
  • $\begingroup$ This is nice. Do you think it is possible to get the output in the order I have specified above? $\endgroup$ Dec 28 '20 at 19:11
  • $\begingroup$ 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]]] $\endgroup$ Dec 28 '20 at 19:43
  • $\begingroup$ @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. $\endgroup$
    – Michael E2
    Dec 28 '20 at 19:59
  • $\begingroup$ @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? $\endgroup$ Dec 28 '20 at 20:11
  • 2
    $\begingroup$ @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. $\endgroup$
    – Michael E2
    Dec 28 '20 at 20:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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