Re: factoring quartic over radicals
- To: mathgroup at smc.vnet.net
- Subject: [mg37069] Re: factoring quartic over radicals
- From: "Allan Hayes" <hay at haystack.demon.co.uk>
- Date: Tue, 8 Oct 2002 07:17:27 -0400 (EDT)
- References: <anp0bs$qu0$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Steve
The notebook given after NOTEBOOK below contains functions for factoring and
partial fractioning.
Here is an application to your problem: the first stage avoids our needing
to know anything about the answer.
fc=FactorR[x^4+x^3+x^2+x+1,x]
(1 - (1/2)*(-1 - Sqrt[5])*x + x^2)*
(1 - (1/2)*(-1 + Sqrt[5])*x + x^2)
Now we need to get rid of Sqrt[5] in terms of GoldenRatio.
This is rather messy:
Simplify/@(fc/. Sqrt[5]\[Rule]2 GoldenRatio-1)
(1 + x - GoldenRatio*x + x^2)*(1 + GoldenRatio*x + x^2)
Simplify/@(%/.-GoldenRatio\[Rule] 1/GoldenRatio -1)
(1 + x/GoldenRatio + x^2)*(1 + GoldenRatio*x + x^2)
Another example
PartialFractionsR[(1 + x)x/(1 - 3*x + x^2), x]
1 - (2*(-1 + 4*x))/((3 + Sqrt[5] - 2*x)*(-3 + 2*x)) +
(2*(-1 + 4*x))/((-3 + 2*x)*(-3 + Sqrt[5] + 2*x))
Simplify[%]
(x*(1 + x))/(1 - 3*x + x^2)
NOTEBOOK: to make a notebook from the following, copy from the next line to
the line preceding XXX and paste into a new Mathematica notebook.
Notebook[{
Cell[CellGroupData[{
Cell["Factors and PartialFractions", "Subtitle"],
Cell["Allan Hayes, 16 August 2001", "Text"],
Cell["\<\
Here are some functions for factoring and expressing in partial \
fractions over the reals and over the complex numbers.\
\>", "Text"],
Cell[BoxData[
\(Quit\)], "Input"],
Cell[BoxData[{
\(Off[General::spell1, \ General::spell]\), "\n",
\(\(FactorC::usage\ = "\<FactorC[poly,x], where poly is a \
polynomial in x with complex coefficients, gives its factorization \
over the complex numbers.\n
The output may include Root objects which may be evaluated with \
ToRadicals or N.\>";\)\n\), "\n",
\(\(FactorR::usage\ = "\<FactorC[poly,x], where poly is a \
polynomial in x with real coefficients, gives its factorization over \
the reals.\n
The output may include Root objects which may be evaluated with \
ToRadicals or N.\>";\)\n\), "\n",
\(\(PartialFractionsC::usage\ = "\<PartialFractionsC[ratl,x], \
where ratl is a rational in x with complex coefficients, gives its \
factorization over the complex numbers.\n
The output may include Root objects which may be evaluated with \
ToRadicals or N.\>";\)\n\), "\n",
\(\(PartialFractionsR::usage\ = "\<PartialFractionsR[ratl,x], \
where ratl is a rational in x with real coefficients, gives its \
factorization over the real numbers.\n
The output may include Root objects which may be evaluated with \
ToRadicals or N.\>";\)\), "\n",
\(On[General::spell1, \ General::spell]\)}], "Input",
InitializationCell->True],
Cell[TextData[{
"FactorC[p_, x_] := ",
StyleBox["(*over complex numbers*)",
FontFamily->"Arial",
FontWeight->"Plain"],
"\nTimes @@ Cases[Roots[p == 0, x, \n Cubics -> False], u_ == \
v_ -> x - v]\n \nFactorR[p_, x_] := ",
StyleBox["(*over reals, coefficients must be real*)",
FontFamily->"Arial",
FontWeight->"Plain"],
"\n (Times @@ Join[Cases[#1, u_ == v_ /; Im[v] == 0 :> \n x \
- v], Cases[#1, u_ == v_ /; Im[v] > 0 :> \n x^2 - x*2*Re[v] + \
Abs[v]^2]] & )[\n Roots[p == 0, x, Cubics -> False]]"
}], "Input",
InitializationCell->True],
Cell[TextData[{
"PartialFractionsC[p_, x_] := ",
StyleBox["(*over complex numbers*)",
FontFamily->"Arial",
FontWeight->"Plain"],
"\n(#+Apart[#2/FactorC[#3,x]])&@@Flatten[{PolynomialReduce[#,#2], \
#2}]&[Numerator[#],Denominator[#]]&[Together[p]]\n \n\
PartialFractionsR[p_, x_] := ",
StyleBox["(*over reals, coefficients must be real*)",
FontFamily->"Arial",
FontWeight->"Plain"],
"\n(#+Apart[#2/FactorR[#3,x]])&@@Flatten[{PolynomialReduce[#,#2], \
#2}]&[Numerator[#],Denominator[#]]&[Together[p]]"
}], "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell["PROGRAMMING NOTES", "Subsubsection"],
Cell[TextData[{
"The option ",
StyleBox["Cubics->False",
FontFamily->"Courier"],
" is used to keep the roots of cubics in ",
StyleBox["Root[....]",
FontFamily->"Courier"],
" form. This is better for computation.\n",
StyleBox["Re[v]",
FontFamily->"Courier"],
" and ",
StyleBox["Abs[v]^2",
FontFamily->"Courier"],
" are used rather than ",
StyleBox["v+Conjugate[v] ",
FontFamily->"Courier"],
"and ",
StyleBox["v*Conjugate[v]",
FontFamily->"Courier"],
" to prevent ",
StyleBox["Apart",
FontFamily->"Courier"],
" from factorising ",
StyleBox["x^2 - x*2*Re[v] + Abs[v]^2]",
FontFamily->"Courier"],
" back to complex form."
}], "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell["EXAMPLES", "Subsubsection"],
Cell["pol = Expand[(x - 1)*(x + 1)^2*(x^2 + x + 1)^2*(x^2 + 4)]; ", \
"Input"],
Cell[CellGroupData[{
Cell["f1 = FactorC[pol, x]", "Input"],
Cell[BoxData[
\(\((\(-1\) + x)\)\ \((\(-2\)\ \[ImaginaryI] +
x)\)\ \((2\ \[ImaginaryI] +
x)\)\ \((1 + x)\)\^2\ \((\((\(-1\))\)\^\(1/3\) + x)\)\^2\ \
\((\(-\((\(-1\))\)\^\(2/3\)\) + x)\)\^2\)], "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell["f2 = FactorR[pol, x]", "Input"],
Cell[BoxData[
\(\((\(-1\) + x)\)\ \((1 + x)\)\^2\ \((4 +
x\^2)\)\ \((1 + x + x\^2)\)\^2\)], "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell["f3 = FactorR[x^3 + x + 1, x]", "Input"],
Cell[BoxData[
\(\((x - Root[1 + #1 + #1\^3 &, 1])\)\ \((x\^2 -
2\ x\ Root[\(-1\) + 2\ #1 + 8\ #1\^3 &, 1] +
Root[\(-1\) - #1\^4 + #1\^6 &, 2]\^2)\)\)], "Output"]
}, Open ]],
Cell["\<\
Root objects appear because of the option Cubics->False in Roots.
We can sometimes get radical forms, but notice the complication.\
\>", "Text"],
Cell[CellGroupData[{
Cell["ToRadicals[f3]", "Input"],
Cell[BoxData[
\(\((\((2\/\(3\ \((\(-9\) + \@93)\)\))\)\^\(1/3\) - \((1\/2\ \
\((\(-9\) + \@93)\))\)\^\(1/3\)\/3\^\(2/3\) + x)\)\ \((1\/3 +
1\/3\ \((29\/2 - \(3\ \@93\)\/2)\)\^\(1/3\) +
1\/3\ \((1\/2\ \((29 + 3\ \@93)\))\)\^\(1/3\) -
2\ \((\((1\/2\ \((9 + \@93)\))\)\^\(1/3\)\/\(2\ \
3\^\(2/3\)\) -
1\/\(2\^\(2/3\)\ \((3\ \((9 + \
\@93)\))\)\^\(1/3\)\))\)\ x + x\^2)\)\)], "Output"]
}, Open ]],
Cell["Inexact forms can be found, from f3 :", "Text"],
Cell[CellGroupData[{
Cell["N[f3]", "Input"],
Cell[BoxData[
\(\((\(\(0.6823278038280193`\)\(\[InvisibleSpace]\)\) +
x)\)\ \((\(\(1.4655712318767682`\)\(\[InvisibleSpace]\)\) -
0.6823278038280193`\ x + x\^2)\)\)], "Output"]
}, Open ]],
Cell["or directly", "Text"],
Cell[CellGroupData[{
Cell["f3 = FactorR[x^3 + x + 1//N, x]", "Input"],
Cell[BoxData[
\(\((\(\(0.6823278038280193`\)\(\[InvisibleSpace]\)\) +
x)\)\ \((\(\(1.4655712318767682`\)\(\[InvisibleSpace]\)\) -
0.6823278038280193`\ x + x\^2)\)\)], "Output"]
}, Open ]],
Cell["Partial fractions", "Text"],
Cell[CellGroupData[{
Cell["pf1 = PartialFractionsR[(2 + x)/pol, x]", "Input"],
Cell[BoxData[
\(1\/\(60\ \((\(-1\) + x)\)\) - 1\/\(10\ \((1 + x)\)\^2\) -
39\/\(100\ \((1 + x)\)\) + \(\(-54\) - 31\ x\)\/\(4225\ \((4 + \
x\^2)\)\) + \(\(-1\) + 3\ x\)\/\(13\ \((1 + x + x\^2)\)\^2\) + \(44 + \
193\ x\)\/\(507\ \((1 + x + x\^2)\)\)\)], "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell["pf2 = PartialFractionsR[(1 + x)x/(1 - 3*x + x^2), x]", \
"Input"],
Cell["\<\
1 - (2*(-1 + 4*x))/((3 + Sqrt[5] - 2*x)*(-3 + 2*x)) +
(2*(-1 + 4*x))/((-3 + 2*x)*(-3 + Sqrt[5] + 2*x))\
\>", "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell[BoxData[
\(Simplify[%]\)], "Input"],
Cell["(x*(1 + x))/(1 - 3*x + x^2)", "Output"]
}, Open ]],
Cell["Partial fractions will often involve Root objects ", "Text"],
Cell[CellGroupData[{
Cell["pf3 = PartialFractionsR[(1 + x)/(x^3 - x + 1), x]", "Input"],
Cell[BoxData[
\(\((1 +
Root[1 - #1 + #1\^3 &,
1])\)/\((\((x -
Root[1 - #1 + #1\^3 &,
1])\)\ \((Root[1 - #1 + #1\^3 &, 1]\^2 -
2\ Root[1 - #1 + #1\^3 &,
1]\ Root[\(-1\) - 2\ #1 + 8\ #1\^3 &, 1] +
Root[\(-1\) + #1\^4 + #1\^6 &, 2]\^2)\))\) + \((x +
Root[1 - #1 + #1\^3 &, 1] +
x\ Root[1 - #1 + #1\^3 &, 1] -
2\ Root[\(-1\) - 2\ #1 + 8\ #1\^3 &, 1] -
Root[\(-1\) + #1\^4 + #1\^6 &, 2]\^2)\)/\((\((\(-x\^2\) +
2\ x\ Root[\(-1\) - 2\ #1 + 8\ #1\^3 &, 1] -
Root[\(-1\) + #1\^4 + #1\^6 &, 2]\^2)\)\ \((Root[1 - \
#1 + #1\^3 &, 1]\^2 -
2\ Root[1 - #1 + #1\^3 &,
1]\ Root[\(-1\) - 2\ #1 + 8\ #1\^3 &, 1] +
Root[\(-1\) + #1\^4 + #1\^6 &, 2]\^2)\))\)\)], \
"Output"]
}, Open ]],
Cell["This can in fact be put in radical form:", "Text"],
Cell[CellGroupData[{
Cell["ToRadicals[pf3]", "Input"],
Cell[BoxData[
\(\((1 - \((2\/\(3\ \((9 - \@69)\)\))\)\^\(1/3\) - \((1\/2\ \((9 \
- \@69)\))\)\^\(1/3\)\/3\^\(2/3\))\)/\((\((\(-\(1\/3\)\) +
1\/3\ \((25\/2 - \(3\ \@69\)\/2)\)\^\(1/3\) +
1\/3\ \((1\/2\ \((25 + 3\ \@69)\))\)\^\(1/3\) + \
\((\(-\((2\/\(3\ \((9 - \@69)\)\))\)\^\(1/3\)\) - \((1\/2\ \((9 - \
\@69)\))\)\^\(1/3\)\/3\^\(2/3\))\)\^2 -
2\ \((\(-\((2\/\(3\ \((9 - \@69)\)\))\)\^\(1/3\)\) - \
\((1\/2\ \((9 - \@69)\))\)\^\(1/3\)\/3\^\(2/3\))\)\ \((1\/24\ \((864 \
- 96\ \@69)\)\^\(1/3\) + \((1\/2\ \((9 + \@69)\))\)\^\(1/3\)\/\(2\ \
3\^\(2/3\)\))\))\)\ \((\((2\/\(3\ \((9 - \@69)\)\))\)\^\(1/3\) + \((1\
\/2\ \((9 - \@69)\))\)\^\(1/3\)\/3\^\(2/3\) + x)\))\) + \((1\/3 -
1\/3\ \((25\/2 - \(3\ \@69\)\/2)\)\^\(1/3\) - \((2\/\(3\ \
\((9 - \@69)\)\))\)\^\(1/3\) - \((1\/2\ \((9 - \@69)\))\)\^\(1/3\)\/3\
\^\(2/3\) - 1\/3\ \((1\/2\ \((25 + 3\ \@69)\))\)\^\(1/3\) -
2\ \((1\/24\ \((864 - 96\ \@69)\)\^\(1/3\) + \((1\/2\ \
\((9 + \@69)\))\)\^\(1/3\)\/\(2\ 3\^\(2/3\)\))\) +
x + \((\(-\((2\/\(3\ \((9 - \@69)\)\))\)\^\(1/3\)\) - \
\((1\/2\ \((9 - \@69)\))\)\^\(1/3\)\/3\^\(2/3\))\)\ x)\)/\((\((\(-\(1\
\/3\)\) + 1\/3\ \((25\/2 - \(3\ \@69\)\/2)\)\^\(1/3\) +
1\/3\ \((1\/2\ \((25 + 3\ \@69)\))\)\^\(1/3\) + \
\((\(-\((2\/\(3\ \((9 - \@69)\)\))\)\^\(1/3\)\) - \((1\/2\ \((9 - \
\@69)\))\)\^\(1/3\)\/3\^\(2/3\))\)\^2 -
2\ \((\(-\((2\/\(3\ \((9 - \@69)\)\))\)\^\(1/3\)\) - \
\((1\/2\ \((9 - \@69)\))\)\^\(1/3\)\/3\^\(2/3\))\)\ \((1\/24\ \((864 \
- 96\ \@69)\)\^\(1/3\) + \((1\/2\ \((9 + \@69)\))\)\^\(1/3\)\/\(2\ \
3\^\(2/3\)\))\))\)\ \((1\/3 -
1\/3\ \((25\/2 - \(3\ \@69\)\/2)\)\^\(1/3\) -
1\/3\ \((1\/2\ \((25 + 3\ \@69)\))\)\^\(1/3\) +
2\ \((1\/24\ \((864 - 96\ \@69)\)\^\(1/3\) + \((1\/2\ \
\((9 + \@69)\))\)\^\(1/3\)\/\(2\ 3\^\(2/3\)\))\)\ x -
x\^2)\))\)\)], "Output"]
}, Closed]],
Cell["We could have found the inexact form directly.", "Text"],
Cell[CellGroupData[{
Cell[BoxData[
\(PartialFractionsR[\((1 + x)\)/\((x^3 - x + 1)\) // N,
x]\)], "Input"],
Cell[BoxData[
\(\(-\(0.07614206365252976`\/\(\(\(1.324717957244746`\)\(\
\[InvisibleSpace]\)\) +
1.`\ x\)\)\) + \(\(\(0.7982664819556426`\)\(\
\[InvisibleSpace]\)\) + 0.07614206365252976`\ \
x\)\/\(\(\(0.754877666246693`\)\(\[InvisibleSpace]\)\) - \
1.324717957244746`\ x + 1.`\ x\^2\)\)], "Output"]
}, Open ]]
}, Closed]]
}, Open ]]
},
FrontEndVersion->"4.2 for Microsoft Windows",
ScreenRectangle->{{0, 1024}, {0, 709}},
AutoGeneratedPackage->None,
WindowSize->{534, 628},
WindowMargins->{{199, Automatic}, {0, Automatic}},
ShowCellLabel->False,
StyleDefinitions -> "Default.nb"
]
XXX
--
Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
hay at haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565
"Steve Earth" <SteveE at harker.org> wrote in message
news:anp0bs$qu0$1 at smc.vnet.net...
> Greetings MathGroup,
>
> My name is Steve Earth, and I am a new subscriber to this list and also a
> new user of Mathematica; so please forgive this rather simple question...
>
> I would like to enter the quartic x^4 + x^3 + x^2 + x + 1 into Mathematica
> and have it be able to tell me that it factors into
>
> (x^2 + GoldenRatio x + 1) ( x^2 - 1/GoldenRatio x + 1)
>
> What instructions do I need to execute to achieve this output?
>
> -Steve Earth
> Harker School
> http://www.harker.org/
>