MathGroup Archive 2002

[Date Index] [Thread Index] [Author Index]

Search the Archive

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/
>






  • Prev by Date: Re: trouble with pattern matching & manipulating
  • Next by Date: Factoring a polynomial
  • Previous by thread: Re: Re: factoring quartic over radicals
  • Next by thread: Re: Re: factoring quartic over radicals