12
$\begingroup$

Let p[x] be a polynomial in x and consider the partial fraction decomposition of 1/p[x].

The function Apart[] fails in simple cases like this

Apart[1/(1 + x^2)]

(* Out[37]= 1/(1 + x^2) *)

We could define a function

cApart[invp_] := Module[{z, c},
   z = x /. Solve[0 == 1/invp, x];
   c[k_] := 
    Product[If[i != k, 1/(z[[k]] - z[[i]]), 1], {i, 1, Length[z]}];
   Sum[c[i]/(x - z[[i]]), {i, 1, Length[z]}]];

which does the job

cApart[1/(1 + x^2)]

(* Out[36] = -(I/(2 (-I + x))) + I/(2 (I + x)) *)

But my question: is there an option for Apart[] or another standard facility in Mathematica which gives the decomposition in general, i.e. in the complex domain?

EDIT #1.1 Standard solution using Extension

The hints given so far can be codensed in this example

With[{d = 1 + x + x^2}, 
 Apart[1/Factor[d, Extension -> (x /. Solve[d == 0, x])]]]

(* -(1/((-1 + 2 (-1)^(1/3)) (-1 + (-1)^(1/3) - x))) - 1/((-1 + 
    2 (-1)^(1/3)) ((-1)^(1/3) + x)) *)

But it turns out that this procedure is not useful in practical applications as it takes extremely long calculation times (e.g. 1+x+x^4 took to Long to wait for it).

The following form (or something similar) would be nice to have

Apart[1/p[x], Extension -> Complexes] (* proposal, not available *)

EDIT #1.2 Other applications of cApart

It is interesting to apply cApart to a polynomial of higher degree

cApart[1/(1 + x + x^6)]

(* 
Out[64]= 
 1/((x - Root[1 + #1 + #1^6 &, 1]) (Root[1 + #1 + #1^6 &, 1] -
       Root[1 + #1 + #1^6 &, 2]) (Root[1 + #1 + #1^6 &, 1] - 
      Root[1 + #1 + #1^6 &, 3]) (Root[1 + #1 + #1^6 &, 1] - 
      Root[1 + #1 + #1^6 &, 4]) (Root[1 + #1 + #1^6 &, 1] - 
      Root[1 + #1 + #1^6 &, 5]) (Root[1 + #1 + #1^6 &, 1] - 
      Root[1 + #1 + #1^6 &, 6])) + 
 1/((x - Root[1 + #1 + #1^6 &, 2]) (-Root[1 + #1 + #1^6 &, 1] + 
      Root[1 + #1 + #1^6 &, 2]) (Root[1 + #1 + #1^6 &, 2] - 
      Root[1 + #1 + #1^6 &, 3]) (Root[1 + #1 + #1^6 &, 2] - 
      Root[1 + #1 + #1^6 &, 4]) (Root[1 + #1 + #1^6 &, 2] - 
      Root[1 + #1 + #1^6 &, 5]) (Root[1 + #1 + #1^6 &, 2] - 
      Root[1 + #1 + #1^6 &, 6])) + 
 1/((x - Root[1 + #1 + #1^6 &, 3]) (-Root[1 + #1 + #1^6 &, 1] + 
      Root[1 + #1 + #1^6 &, 3]) (-Root[1 + #1 + #1^6 &, 2] + 
      Root[1 + #1 + #1^6 &, 3]) (Root[1 + #1 + #1^6 &, 3] - 
      Root[1 + #1 + #1^6 &, 4]) (Root[1 + #1 + #1^6 &, 3] - 
      Root[1 + #1 + #1^6 &, 5]) (Root[1 + #1 + #1^6 &, 3] - 
      Root[1 + #1 + #1^6 &, 6])) + 
 1/((x - Root[1 + #1 + #1^6 &, 4]) (-Root[1 + #1 + #1^6 &, 1] + 
      Root[1 + #1 + #1^6 &, 4]) (-Root[1 + #1 + #1^6 &, 2] + 
      Root[1 + #1 + #1^6 &, 4]) (-Root[1 + #1 + #1^6 &, 3] + 
      Root[1 + #1 + #1^6 &, 4]) (Root[1 + #1 + #1^6 &, 4] - 
      Root[1 + #1 + #1^6 &, 5]) (Root[1 + #1 + #1^6 &, 4] - 
      Root[1 + #1 + #1^6 &, 6])) + 
 1/((x - Root[1 + #1 + #1^6 &, 5]) (-Root[1 + #1 + #1^6 &, 1] + 
      Root[1 + #1 + #1^6 &, 5]) (-Root[1 + #1 + #1^6 &, 2] + 
      Root[1 + #1 + #1^6 &, 5]) (-Root[1 + #1 + #1^6 &, 3] + 
      Root[1 + #1 + #1^6 &, 5]) (-Root[1 + #1 + #1^6 &, 4] + 
      Root[1 + #1 + #1^6 &, 5]) (Root[1 + #1 + #1^6 &, 5] - 
      Root[1 + #1 + #1^6 &, 6])) + 
 1/((x - Root[1 + #1 + #1^6 &, 6]) (-Root[1 + #1 + #1^6 &, 1] + 
      Root[1 + #1 + #1^6 &, 6]) (-Root[1 + #1 + #1^6 &, 2] + 
      Root[1 + #1 + #1^6 &, 6]) (-Root[1 + #1 + #1^6 &, 3] + 
      Root[1 + #1 + #1^6 &, 6]) (-Root[1 + #1 + #1^6 &, 4] + 
      Root[1 + #1 + #1^6 &, 6]) (-Root[1 + #1 + #1^6 &, 5] + 
      Root[1 + #1 + #1^6 &, 6]))
*)

Which gives the solution in a very regular pattern involving the function Root[]. The numeric evaluation gives

% // N

(*
Out[65]= -((
  0.0965468 + 0.0295033 I)/((-0.945402 - 0.611837 I) + x)) - (
 0.0965468 - 0.0295033 I)/((-0.945402 + 0.611837 I) + x) - (
 0.084438 + 0.114801 I)/((0.154735 - 1.03838 I) + x) - (
 0.084438 - 0.114801 I)/((0.154735 + 1.03838 I) + x) + (
 0.180985 - 0.279696 I)/((0.790667 - 0.300507 I) + x) + (
 0.180985 + 0.279696 I)/((0.790667 + 0.300507 I) + x)
*)

We can even continue to use these symbolic Root[] expressions in more complicated environments such as

g[a_] = Integrate[
  Exp[-a x]/(x - Root[1 + #1 + #1^6 &, 1]), {x, 0, \[Infinity]}, 
  Assumptions -> a > 0]

(* Out[69]= E^(-a Root[1 + #1 + #1^6 &, 1]) (-I \[Pi] - 
   CoshIntegral[a Root[1 + #1 + #1^6 &, 1]] - 
   SinhIntegral[a Root[1 + #1 + #1^6 &, 1]]) *)

It is gratifying that the integral is evaluated symbolically. We can now easily calculate numerical values, e.g.

g[1.]

(* Out[70]= 0.653737 - 0.158332 I *)

Regards,
Wolfgang

$\endgroup$
9
  • $\begingroup$ Maybe this is related? $\endgroup$ Dec 11, 2014 at 9:20
  • $\begingroup$ You can do this: Apart@Factor[1/(x^2 + 1), Extension -> I]. This answer is closely related Factoring polynomials to factors involving complex coefficients. Apart $\endgroup$
    – Artes
    Dec 11, 2014 at 9:20
  • $\begingroup$ @Artes: Thanks. It looks good but it fails for 1/(1+x^3) which is not completely decomposed or 1/(1+x+x^2) which is not decomposed at all (Version 8). $\endgroup$ Dec 11, 2014 at 9:45
  • $\begingroup$ @Dr.WolfgangHintze Extension depends on a case by case basis of course. Here this works: Apart@Factor[1/(1 + x^3), Extension -> {(-1)^(1/3)}] or even better FullSimplify /@ Apart@Factor[1/(1 + x^3), Extension -> {(-1)^(1/3), I}] $\endgroup$
    – Artes
    Dec 11, 2014 at 9:53
  • 1
    $\begingroup$ There are both ExtendedApart and ApartAll in the Wolfram Function Repository. $\endgroup$ May 5, 2022 at 15:18

1 Answer 1

14
$\begingroup$

Re: "But my question: is there an option for Apart[] or another standard facility in Mathematica which gives the decomposition in general, i.e. in the complex domain?"

There's Integrate`ComplexApart[p[x], x]:

Integrate`ComplexApart[1/(x^2 + 1), x]

$$\frac{i}{2 (x+i)}-\frac{i}{2 (x-i)}$$

Integrate`ComplexApart[1/(1 + x + x^6), x]

$\frac{-7776 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,6\right]+6480 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,6\right]^2-5400 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,6\right]^3+4500 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,6\right]^4-3750 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,6\right]^5-3125}{43531 \left(x-\text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,6\right]\right)}+\frac{-7776 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,5\right]+6480 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,5\right]^2-5400 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,5\right]^3+4500 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,5\right]^4-3750 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,5\right]^5-3125}{43531 \left(x-\text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,5\right]\right)}+\frac{-7776 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,4\right]+6480 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,4\right]^2-5400 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,4\right]^3+4500 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,4\right]^4-3750 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,4\right]^5-3125}{43531 \left(x-\text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,4\right]\right)}+\frac{-7776 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,3\right]+6480 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,3\right]^2-5400 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,3\right]^3+4500 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,3\right]^4-3750 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,3\right]^5-3125}{43531 \left(x-\text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,3\right]\right)}+\frac{-7776 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,2\right]+6480 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,2\right]^2-5400 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,2\right]^3+4500 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,2\right]^4-3750 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,2\right]^5-3125}{43531 \left(x-\text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,2\right]\right)}+\frac{-7776 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,1\right]+6480 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,1\right]^2-5400 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,1\right]^3+4500 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,1\right]^4-3750 \text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,1\right]^5-3125}{43531 \left(x-\text{Root}\left[\text{$\#$1}^6+\text{$\#$1}+1\&,1\right]\right)}$


I (re?)discovered Factor[..., Extension -> All] today in V13, which may or may not have worked since year 1. It gives the complete factorization of a polynomial, which is needed for the partial fractions decomposition. However, Apart does not always seem to succeed.

(* SUCCESS *)
Apart[Factor[1/(1 + x^6), Extension -> All]] // Map@Simplify
(*
I/(6 I - 6 x) + I/(6 I + 6 x) +
 1/(6 - 3 (-I + Sqrt[3]) x) + 1/(6 + 3 (-I + Sqrt[3]) x) +
 1/(6 - 3 (I + Sqrt[3]) x) + 1/(6 + 3 (I + Sqrt[3]) x)
*)

(* FAILURE *)
Apart[Factor[1/(1 + x + x^6), Extension -> All]]
(*
-(1/((x - Root[1 + #1 + #1^6 &, 1]) *
     (x - Root[1 + #1 + #1^6 &, 2]) *
     (x - Root[1 + #1 + #1^6 &, 3]) *
     (x - Root[1 + #1 + #1^6 &, 4]) *
     (x - Root[1 + #1 + #1^6 &, 5]) *
     (-x + Root[1 + #1 + #1^6 &, 6])))
*)

Applying the x /. Solve[..] method in Edit #1 of the OP ran for minutes before I killed it:

With[{d = (1 + x + x^6)},
 Apart[1/Factor[d, Extension -> (x /. Solve[d == 0, x])]]]

Update 2023.03.24

There are (since 2020) resource functions that accomplish partial fractions decompositions over extensions of the rationals:

$\endgroup$
1
  • $\begingroup$ It does not appear to be Root[] per se for it fails when we replace them by a compound numeric expression: Apart[Factor[1/(1 + x + x^6), Extension -> All] /. Verbatim[Root][_, n_, ___] :> Sin[n]]. But Apart works if the Root[] objects are replaced by symbols. $\endgroup$
    – Michael E2
    May 5, 2022 at 14:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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