       • 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

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

```

• Prev by Date: Re: trouble with pattern matching & manipulating
• Next by Date: Factoring a polynomial