6
$\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$
  • $\begingroup$ Maybe this is related? $\endgroup$ – mikuszefski Dec 11 '14 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 '14 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$ – Dr. Wolfgang Hintze Dec 11 '14 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 '14 at 9:53
  • $\begingroup$ @ mikuszefski: thanks for this link where they give an interesting generalization to Extension of the hint of Artes: for example With[{d = 1 + x + x^6}, Apart[1/Factor[d, Extension -> (x /. Solve[d == 0, x])]]] but takes much more time than my Routine. $\endgroup$ – Dr. Wolfgang Hintze Dec 11 '14 at 9:57
4
$\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)}$

$\endgroup$

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.