Cubic Formula

Author

Eric W. Weisstein
January 6, 2006

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Algebra/CubicFormula.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/CubicFormula.html.

©2006 Wolfram Research, Inc. except for portions noted otherwise

Cubic Formula

CubicFormula1[{a2_,a1_,a0_}]:=Module[{q = (3 a1 - a2^2)/9,r=(9a1 a2-27a0-2 a2^3)/54,dd,s,t},
dd=q^3+r^2;
s=-Abs[(r+Sqrt[dd])^(1/3)];
t=-Abs[(r-Sqrt[dd])^(1/3)];
{
-a2/3+(s+t),
-a2/3-(s+t)/2+I Sqrt[3](s-t)/2,
-a2/3-(s+t)/2-I Sqrt[3](s-t)/2
}
]

CubicFormula2[{a2_,a1_,a0_}]:=Module[{q = (3 a1 - a2^2)/9,r=(9a1 a2-27a0-2 a2^3)/54,dd,s,t},
dd=q^3+r^2;
s=(r+Sqrt[dd])^(1/3);
t=(r-Sqrt[dd])^(1/3);
{
-a2/3+(s+t),
-a2/3-(s+t)/2+I Sqrt[3](s-t)/2,
-a2/3-(s+t)/2-I Sqrt[3](s-t)/2
}
]

Derivation

Collect[(z^3)+(Subscript[a, 2])(z^2)+(Subscript[a, 1])z+(Subscript[a, 0])/.z->x-λ,{1,x,x^2,x^3}]

(x^3)-(λ^3)+(Subscript[a, 0])-λ (Subscript[a, 1])+(λ^2) (Subscript[a, 2])+(x^2) (-3 λ+(Subscript[a, 2]))+x (3 (λ^2)+(Subscript[a, 1])-2 λ (Subscript[a, 2]))/.λ->(Subscript[a, 2])/3

(((x-λ))^3)/.λ->(Subscript[a, 2])/3//Expand

(Subscript[a, 2])(((x-λ))^2)/.λ->(Subscript[a, 2])/3//Expand

(Subscript[a, 1])(x-λ)/.λ->(Subscript[a, 2])/3//Expand

(Together/@CoefficientList[(z^3)+(Subscript[a, 2])(z^2)+(Subscript[a, 1])z+(Subscript[a, 0])/.z->x-(Subscript[a, 2])/3,x])

(%/.{(3 (Subscript[a, 1])-(Subscript[a, 2]^2))/3->p,(1/27) (27 (Subscript[a, 0])-9 (Subscript[a, 1]) (Subscript[a, 2])+2 (Subscript[a, 2]^3))->-q}).{1,x,(x^2),(x^3)}

Simplify[-q+p x+(x^3)/.x->w-(p/(3w))](w^3)//Expand

Tests

{CubicFormula1[{6,8,15}],List@@Last/@Roots[x^3+6x^2+8x+15==0,x]}//N

{CubicFormula2[{6,8,15}],List@@Last/@Roots[x^3+6x^2+8x+15==0,x]}//N

{CubicFormula2[{6,11,6}],List@@Last/@Roots[x^3+6x^2+11x+6==0,x]}//N//Chop

{CubicFormula1[{6,11,6}],List@@Last/@Roots[x^3+6x^2+11x+6==0,x]}//N//Chop

Solution

Plus@@(Subscript[a,#]x^#&/@Range[0,3])==0//TraditionalForm

SetOptions[Roots,Cubics->False];
Solve[Plus@@(Subscript[a,#]x^#&/@Range[0,3])==0,x]

SetOptions[Roots,Cubics->True]

Solve[Plus@@(Subscript[a,#]x^#&/@Range[0,3])==0,x]//TraditionalForm

Real roots of a cubic

CubicRealRoots::nroots="Numeric roots are `1`";
CubicRealRoots::real="Numeric real roots are `1`";

CubicRealRoots[cubic_,z_]:=Module[
  {x,rcubic,c=CoefficientList[cubic,z],cr,p,q,C,i,Np,NC,roots,sc,c0},
  Message[CubicRealRoots::nroots,NRoots[cubic==0,z]];
  c0=-1/3 (c[[3]]/c[[4]]);
  rcubic=cubic/c[[4]] /. z->(x+c0);
  cr=CoefficientList[rcubic,x];
  p=cr[[2]];
  q=-cr[[1]];
  C=1/2 q(3/Abs[p])^(3/2);
  sc=2Sqrt[Abs[p]/3];
  Np=N[p];
  NC=N[C];
  roots=Which[
    Np==0,q^(1/3),
    Np>0,c0+sc Sinh[1/3 ArcSinh[C]],
    Np<0 && NC>=1,c0+sc Cosh[1/3 ArcCosh[C]],
    Np<0 && NC<=-1,c0+-sc Cosh[1/3 ArcCosh[-C]],
    Np<0 && Abs[NC]<1,Table[c0+sc Cos[1/3 ArcCos[C]+i 2Pi/3],{i,0,2}],
    True, $Failed
  ];
  Message[CubicRealRoots::real,N[roots]];
  roots
]

CubicRealRoots[x^3+2x^2+3x+4,x]

CubicRealRoots[x^3-2x^2-3x+4,x]

Factoring of Cubic

Expand[-2Q B+((R+Sqrt[Q^3+R^2])^(1/3)+(R-Sqrt[Q^3+R^2])^(1/3))((R+Sqrt[Q^3+R^2])^(2/3)+(R-Sqrt[Q^3+R^2])^(2/3))]

Resolvents

ω=Exp[2Pi I/3];

FullSimplify[(x-((Subscript[u, 1])+(Subscript[u, 2])))(x-(ω (Subscript[u, 1])+ω^2 (Subscript[u, 2])))(x-(ω^2 (Subscript[u, 1])+ω (Subscript[u, 2])))]

Newton's Relations

RootReduce[Plus@@((x/.{ToRules[Roots[x^3+p x-q==0,x,Cubics->False]]})^2)]

RootReduce[Plus@@((x/.{ToRules[Roots[x^3+p x-q==0,x,Cubics->False]]})^3)]

RootReduce[Plus@@((x/.{ToRules[Roots[x^3+p x-q==0,x,Cubics->False]]})^4)]

RootReduce[Plus@@((x/.{ToRules[Roots[x^3+p x-q==0,x,Cubics->False]]})^5)]

Eliminate q

Eliminate[{z1+z2+z3==0,z1 z2+z2 z3+z1 z3==p,z1 z2 z3==q},{q,z1}]

Eliminate[{z1+z2+z3==0,z1 z2+z2 z3+z1 z3==p,z1 z2 z3==q},{q,z2}]

Eliminate[{z1+z2+z3==0,z1 z2+z2 z3+z1 z3==p,z1 z2 z3==q},{q,z3}]

Eliminate p

Eliminate[{z1+z2+z3==0,z1 z2+z2 z3+z1 z3==p,z1 z2 z3==q},{p,z1}]

Eliminate[{z1+z2+z3==0,z1 z2+z2 z3+z1 z3==p,z1 z2 z3==q},{p,z2}]

Eliminate[{z1+z2+z3==0,z1 z2+z2 z3+z1 z3==p,z1 z2 z3==q},{p,z3}]