Re: Re: factoring quartic over radicals
- To: mathgroup at smc.vnet.net
- Subject: [mg37086] Re: [mg37069] Re: factoring quartic over radicals
- From: Andrzej Kozlowski <andrzej at platon.c.u-tokyo.ac.jp>
- Date: Wed, 9 Oct 2002 05:25:34 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
There is an equivalent approach that will give the answer without
knowing it in advance. All we need to know is that any quartic can be
factored over the reals as a product of two quadratics, so:
Union[(a + b*x + x^2)*(c + d*x + x^2) /.
Select[SolveAlways[x^4 + x^3 + x^2 + x + 1 ==
(a + b*x + x^2)*(c + d*x + x^2), x], FreeQ[#1, I] & ],
SameTest -> (Expand[#1] == Expand[#2] & )]
{(1 + (1/2)*(1 - Sqrt[5])*x + x^2)*
(1 + (1/2)*(1 + Sqrt[5])*x + x^2)}
Andrzej Kozlowski
Toyama International University
JAPAN
http://sigma.tuins.ac.jp/~andrzej/
On Tuesday, October 8, 2002, at 08:17 PM, Allan Hayes wrote:
> 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/
>>
>
>
>
>
>
>
>
>