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[5]/2)*x + x^2)*
(1 + (1/2)*(1 + Sqrt[5])*x + x^2),
(1 + (1/2)*(1 - Sqrt[5])*x + x^2)*
(1 + (1/2)*(1 + Sqrt[5])*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[5])*x + x^2)*
(1 + (1/2)*(1 + Sqrt[5])*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[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/
>>>
>>
>>
>>
>>
>>
>>
>>
>>
>
>
Andrzej Kozlowski
Yokohama, Japan
http://www.mimuw.edu.pl/~akoz/
http://platon.c.u-tokyo.ac.jp/andrzej/