Polynomial Roots

Author

Eric W. Weisstein
September 17, 2007

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

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

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

Additional Authors

allRoots by
Michael Trott
The Mathematica GuideBook for Programming, p. 23
New York: Springer-Verlag, 2004.

Examples

<<Utilities`Typesetting`

Table[Root[x^2+x+1,i],{i,2}]

Table[Root[x^3+x+1,i],{i,3}]//N

Root Ordering

r=-22801+432792 (x^2)-2409264 (x^4)+3340224 (x^6)+3898368 (x^8)-746496 (x^10)-2985984 (x^12);

NRoots

NRoots[r==0,x]

Roots

Roots[r==0,x]

Roots[r==0,x]//N

Root

Root[-22801+432792 (x^2)-2409264 (x^4)+3340224 (x^6)+3898368 (x^8)-746496 (x^10)-2985984 (x^12),#]&/@Range[12]//N

Plots

MakeBoxes[label[c_,n_],TraditionalForm]:=RowBox[{RowBox[{SubscriptBox["c","max"],"==",MakeBoxes[c,TraditionalForm]}],","," ",RowBox[{SubscriptBox["n","max"],"==",MakeBoxes[n,TraditionalForm]}]}]

This routine by Michael Trott

allRoots[maxDegree_,maxIntCoeff_]:=Module[{x,xPots,allInts},(* the monomials *)xPots=Table[x^i,{i,0,maxDegree}];
(* the coefficients *)allInts=Join[#,-#]&[Range[maxIntCoeff]];
(* show all roots graphically *)Show[Graphics[{PointSize[0.003],Point[{Re[#],Im[#]}]&/@(* solving all polynomials, taking roots *)Flatten[(Cases[NRoots[#,x],_Real|_Complex,{-1}])&/@Union[DeleteCases[xPots.#==0&/@(* constructing all possible polynomials *)Flatten[Table[Flatten[Permutations/@MapThread[Join,{Partition[Flatten[Outer[List,##]&@@Table[allInts,{i}]],i],Table[Evaluate[Table[0,{maxDegree-i+1}]],{(2 maxIntCoeff)^i}]}],1],{i,1,maxDegree+1}],1],False]]]}],PlotRange->All,Frame->True,AspectRatio->Automatic,PlotLabel->TraditionalForm[label[maxDegree,maxIntCoeff]]]]

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
Map[allRoots@@#&,{
{{2,3},{2,4}},
{{3,3},{3,4}}
},{2}]
],GraphicsSpacing->{-.05,.05}
]]

With[{n=15},ListPlot[Through[{Re,Im}[#]]&/@Flatten[Map[Last,NRoots[Polynomial[#,x]==0,x]&/@Flatten[Outer[List,Sequence@@Table[{-1,1},{n}],1],n-1],{2}]/.Or:>List],PlotStyle->{Red,PointSize[.005]},ImageSize->400]
]//Timing

Roots as Eigenvalues

RootMatrix[p_,x_]:=Module[{l=CoefficientList[p,x],n},
n=Length[l]-1;
SparseArray[
Append[
MapIndexed[{1,#2[[1]]}->#1&,-Rest[l]/First[l]],
{i_,j_}/;i-j==1->1],{n,n}]]

EigenvalueRoots[p_,x_]:=1/Eigenvalues[RootMatrix[p,x]]

Expand[poly=(x-2)(x-1)(x+3)]

CoefficientList[poly,x]

RootMatrix[poly,x]//Normal//MatrixForm

EigenvalueRoots[poly,x]