       Re: Re: factoring quartic over radicals

• To: mathgroup at smc.vnet.net
• Subject: [mg37087] 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:36 -0400 (EDT)
• Sender: owner-wri-mathgroup at wolfram.com

```In my earlier posting I used Union and SameTest to replace two
equivalent answers (arising form the symmetry of the equation) by a
single one. However, the way I did, while givign the right answer,  it
makes little logical sense since in general applying Expand would make
any factorizations the same leaving us always with just a single one.
WIthout using Union at all we get:

(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] & ]

{(1 + (1/2 - Sqrt/2)*x + x^2)*
(1 + (1/2)*(1 + Sqrt)*x + x^2),
(1 + (1/2)*(1 - Sqrt)*x + x^2)*
(1 + (1/2)*(1 + Sqrt)*x + x^2)}

Since having two identical answers differing only in the way they are
written out is a bit of a nuisance, a way to get rid of one of them
which does not suffer from the illogicality of my first approach is:

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 -> (Simplify[First[#1] == First[#2]] & )]

{(1 + (1/2)*(1 - Sqrt)*x + x^2)*
(1 + (1/2)*(1 + Sqrt)*x + x^2)}

On Tuesday, October 8, 2002, at 11:40 PM, Andrzej Kozlowski wrote:

> 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)*x + x^2)*
>    (1 + (1/2)*(1 + Sqrt)*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
>>
>> fc=FactorR[x^4+x^3+x^2+x+1,x]
>>
>> (1 - (1/2)*(-1 - Sqrt)*x + x^2)*
>>   (1 - (1/2)*(-1 + Sqrt)*x + x^2)
>>
>> Now we need to get rid of Sqrt in terms of GoldenRatio.
>> This is rather messy:
>>
>> Simplify/@(fc/. Sqrt\[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 - 2*x)*(-3 + 2*x)) +
>>   (2*(-1 + 4*x))/((-3 + 2*x)*(-3 + Sqrt + 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 \
>>     \(\(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 \
>>     \(\(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 \
>>     \(\(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 \
>>     \(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[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 - 2*x)*(-3 + 2*x)) +
>>   (2*(-1 + 4*x))/((-3 + 2*x)*(-3 + Sqrt + 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[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/
>>>
>>
>>
>>
>>
>>
>>
>>
>>
>
>
Andrzej Kozlowski
Yokohama, Japan
http://www.mimuw.edu.pl/~akoz/
http://platon.c.u-tokyo.ac.jp/andrzej/

```

• Prev by Date: RE: Re: Re: Accuracy and Precision
• Next by Date: Re: Re: factoring quartic over radicals