Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2006
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2006

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

Search the Archive

Solving the Cubic

  • To: mathgroup at smc.vnet.net
  • Subject: [mg71859] Solving the Cubic
  • From: "dimitris" <dimmechan at yahoo.com>
  • Date: Fri, 1 Dec 2006 06:22:12 -0500 (EST)

The following cell follows the Vieta's method for solving the cubic
equation complete with all the necessary steps and text explanations.
I really appreciate any kind of comments.



Cell[BoxData[{
    RowBox[{
      RowBox[{"$PrePrint", "=", "TraditionalForm"}], ";"}],
"\[IndentingNewLine]",
    RowBox[{"SetOptions", "[",
      RowBox[{
        RowBox[{"SelectedNotebook", "[", "]"}], ",",
        RowBox[{"StyleDefinitions", "->", "\"\<DemoText.nb\>\""}]}],
"]"}], "\[IndentingNewLine]",
    RowBox[{"Clear", "[", "\"\<Global`*\>\"", "]"}],
"\[IndentingNewLine]",
    RowBox[{"Off", "[",
      RowBox[{"N", "::", "meprec"}], "]"}], "\[IndentingNewLine]",
    RowBox[{"Off", "[",
      RowBox[{"General", "::", "spell1"}], "]"}],
"\[IndentingNewLine]",
    RowBox[{"Print", "[",
      RowBox[{"StyleForm", "[",
        RowBox[{"\"\<Author: Dimitris Simou Anagnostou\\nResearcher
Associate\\nNational University of Athens,
Greece\\ndimmechan at yahoo.com\>\"", ",",
          ",",
          RowBox[{"FontColor", "->", "Magenta"}]}], "]"}], "]"}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<creation of a general cubic
equation\>\"", "]"}], ";"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Plus", "@@",
        RowBox[{"Table", "[",
          RowBox[{
            RowBox[{
              SubscriptBox["a", "i"],
              SuperscriptBox["z", "i"]}], ",",
            RowBox[{"{",
              RowBox[{"i", ",", "0", ",", "3"}], "}"}]}], "]"}]}],
"\[Equal]", "0"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<set \!\(a\_3\)\[Congruent]1, a generic
cubic equation\>\"", "]"}], ";",
      RowBox[{"gencub", "=",
        RowBox[{"%", "/.",
          RowBox[{
            SubscriptBox["a", "3"], "\[Rule]", "1"}]}]}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<set z\[Congruent]y-\[Lambda]  \>\"",
"]"}], ";",
      RowBox[{"%", "/.",
        RowBox[{"z", "\[Rule]",
          RowBox[{"y", "-", "\[Lambda]"}]}]}]}], "\[IndentingNewLine]",

    RowBox[{
      RowBox[{"Print", "[", "\"\<expand last equation\>\"", "]"}], ";",

      RowBox[{"Expand", "/@", "%"}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<collect the terms\>\"", "]"}], ";",
      RowBox[{
        RowBox[{
          RowBox[{"Collect", "[",
            RowBox[{"#", ",", "y"}], "]"}], "&"}], "/@", "%"}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<coefficient of the quadratic
term\>\"", "]"}], ";",
      RowBox[{
        RowBox[{
          RowBox[{"Coefficient", "[",
            RowBox[{"#", ",",
              SuperscriptBox["y", "2"]}], "]"}], "&"}], "/@", "%"}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<this value eliminates the  \!\(y\^2\)
term\>\"", "]"}], ";",
      RowBox[{"\[Lambda]val", "=",
        RowBox[{"Solve", "[",
          RowBox[{"%", ",", "\[Lambda]"}], "]"}]}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<substitution in the cubic equation in
y of evaluated \[Lambda]\>\"", "]"}], ";",
      RowBox[{"%%%", "/.",
        RowBox[{"%", "[",
          RowBox[{"[", "1", "]"}], "]"}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<the reduced cubic equation\>\"",
"]"}], ";",
      RowBox[{"redcub", "=",
        RowBox[{"%", "/.",
          RowBox[{
            RowBox[{
              SuperscriptBox["y", "3"], "+",
              RowBox[{"a_", " ", "y"}], "+", "b_"}], "\[Rule]",
            RowBox[{
              SuperscriptBox["y", "3"], "+",
              RowBox[{"p", " ", "y"}], "+", "q"}]}]}]}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<set y\[Congruent]t+w/t\>\"", "]"}],
";",
      RowBox[{"%", "/.",
        RowBox[{"y", "\[Rule]",
          RowBox[{"t", "+",
            RowBox[{"w", "/", "t"}]}]}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<expand last equation\>\"", "]"}], ";",

      RowBox[{"Expand", "/@", "%"}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<multiply through by \!\(t\^3\)\>\"",
"]"}], ";",
      RowBox[{
        RowBox[{
          RowBox[{"Expand", "[",
            RowBox[{"#",
              SuperscriptBox["t", "3"]}], "]"}], "&"}], "/@", "%"}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<collect the terms \[Implies] a sectic
equation in t\>\"", "]"}], ";",
      RowBox[{"sect", "=",
        RowBox[{
          RowBox[{
            RowBox[{"Collect", "[",
              RowBox[{"#", ",", "t"}], "]"}], "&"}], "/@", "%"}]}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<the coefficients of t in the sectic
equation in increasing order\>\"", "]"}], ";",
      RowBox[{"CoefficientList", "[",
        RowBox[{
          RowBox[{"%", "[",
            RowBox[{"[", "1", "]"}], "]"}], ",", "t"}], "]"}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<the value w=-p/3 eliminates both the
quadratic and the quartic term\>\"", "]"}], ";",
      RowBox[{
        RowBox[{"MapIndexed", "[",
          RowBox[{
            RowBox[{
              RowBox[{"{",
                RowBox[{
                  RowBox[{
                    RowBox[{"#2", "[",
                      RowBox[{"[", "1", "]"}], "]"}], "-", "1"}], ",",
                  RowBox[{"#1", "\[Equal]", "0"}]}], "}"}], "&"}], ",",
"%"}], "]"}], "//",
        RowBox[{
          RowBox[{"Simplify", "[",
            RowBox[{"#", ",",
              RowBox[{"{",
                RowBox[{
                  RowBox[{"p", ">", "0"}], ",",
                  RowBox[{"q", ">", "0"}], ",",
                  RowBox[{"w", "\[NotEqual]", "0"}]}], "}"}]}], "]"}],
"&"}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Cases", "[",
        RowBox[{"%", ",", "_Equal", ",", "2"}], "]"}], "[",
      RowBox[{"[", "1", "]"}], "]"}], "\[IndentingNewLine]",
    RowBox[{"Solve", "[",
      RowBox[{"%", ",", "w"}], "]"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<substitution of w\[Congruent]-p/3 in
the sextic equation in t\>\"", "]"}], ";",
      RowBox[{"sect", "/.",
        RowBox[{"%", "[",
          RowBox[{"[", "1", "]"}], "]"}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<set \!\(t\^3\)\[Congruent]x \[Implies]
a quadratic equation in x\>\"", "]"}], ";",
      RowBox[{"%", "/.",
        RowBox[{
          SuperscriptBox["t", "n_."], "\[Rule]",
          SuperscriptBox["x",
            RowBox[{"n", "/", "3"}]]}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<the roots by the qudratic
formula\>\"", "]"}], ";",
      RowBox[{"Simplify", "[",
        RowBox[{"Solve", "[",
          RowBox[{"%", ",", "x"}], "]"}], "]"}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<rearrangement of the roots\>\"",
"]"}], ";",
      RowBox[{"%", "/.",
        RowBox[{
          RowBox[{"(",
            RowBox[{"a_", "\[Rule]", "b_"}], ")"}], "\[RuleDelayed]",
          RowBox[{"(",
            RowBox[{"a", "\[Rule]",
              RowBox[{"Expand", "[", "b", "]"}]}], ")"}]}]}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Map", "[",
        RowBox[{
          RowBox[{
            RowBox[{"#", "/",
              SuperscriptBox["18", "2"]}], "&"}], ",", "%", ",",
          RowBox[{"{", "7", "}"}]}], "]"}], ";"}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<roots of the quadratic equation in x
after rearrangement\>\"", "]"}], ";",
      RowBox[{"solsx", "=",
        RowBox[{"%", "/.",
          RowBox[{
            RowBox[{"(",
              RowBox[{"a_", "\[Rule]",
                RowBox[{"b_", "+", "c_"}]}], ")"}], "\[RuleDelayed]",
            RowBox[{"(",
              RowBox[{"a", "\[Rule]",
                RowBox[{"b", "+",
                  RowBox[{"18", "c"}]}]}], ")"}]}]}]}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<solution of the equation \!\(t\^3\)=x
in t\>\"", "]"}], ";",
      RowBox[{"Solve", "[",
        RowBox[{
          RowBox[{
            SuperscriptBox["t", "3"], "\[Equal]", "x"}], ",", "t"}],
"]"}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[",
        RowBox[{"\"\<substitution of the above determined roots for x
in the last result \[Implies] \>\"", ",", " ",
          RowBox[{"StyleForm", "[",
            RowBox[{"\"\<superficially \>\"", ",",
              RowBox[{"FontSlant", "->", "Italic"}]}], "]"}], ",",
"\"\<six roots for t\>\""}], "]"}], ";", " ",
      RowBox[{"solst", "=",
        RowBox[{"{",
          RowBox[{
            RowBox[{"%", "/.",
              RowBox[{"solsx", "[",
                RowBox[{"[", "1", "]"}], "]"}]}], ",",
            RowBox[{"%", "/.",
              RowBox[{"solsx", "[",
                RowBox[{"[", "2", "]"}], "]"}]}]}], "}"}]}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[",
        RowBox[{"\"\<roots choosing the minus sign in \>\"", ",",
          RowBox[{"TraditionalForm", "[",
            RowBox[{
              RowBox[{"-",
                FractionBox["q", "2"]}], "\[PlusMinus]",
              SqrtBox[
                RowBox[{
                  FractionBox[
                    SuperscriptBox["p", "3"], "27"], "+",
                  FractionBox[
                    SuperscriptBox["q", "2"], "4"]}]]}], "]"}]}],
"]"}], ";",
      RowBox[{"solstminus", "=",
        RowBox[{"solst", "[",
          RowBox[{"[", "1", "]"}], "]"}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[",
        RowBox[{"\"\<roots choosing the minus sign in \>\"", ",",
          RowBox[{"TraditionalForm", "[",
            RowBox[{
              RowBox[{"-",
                FractionBox["q", "2"]}], "\[PlusMinus]",
              SqrtBox[
                RowBox[{
                  FractionBox[
                    SuperscriptBox["p", "3"], "27"], "+",
                  FractionBox[
                    SuperscriptBox["q", "2"], "4"]}]]}], "]"}]}],
"]"}], ";",
      RowBox[{"solstplus", "=",
        RowBox[{"solst", "[",
          RowBox[{"[", "2", "]"}], "]"}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<the roots in the form of the Solve
output (i.e. as rules)\>\"", "]"}], ";"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[",
        RowBox[{"\"\<roots choosing the minus sign in \>\"", ",",
          RowBox[{"TraditionalForm", "[",
            RowBox[{
              RowBox[{"-",
                FractionBox["q", "2"]}], "\[PlusMinus]",
              SqrtBox[
                RowBox[{
                  FractionBox[
                    SuperscriptBox["p", "3"], "27"], "+",
                  FractionBox[
                    SuperscriptBox["q", "2"], "4"]}]]}], "]"}]}],
"]"}], ";",
      RowBox[{"solsyminus", "=",
        RowBox[{
          RowBox[{
            RowBox[{"{",
              RowBox[{"y", "\[Rule]", "#"}], "}"}], "&"}], "/@",
          RowBox[{"(",
            RowBox[{
              RowBox[{"t", "-",
                RowBox[{"p", "/",
                  RowBox[{"(",
                    RowBox[{"3", "t"}], ")"}]}]}], "/.",
"solstminus"}], ")"}]}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[",
        RowBox[{"\"\<roots choosing the plus sign in \>\"", ",",
          RowBox[{"TraditionalForm", "[",
            RowBox[{
              RowBox[{"-",
                FractionBox["q", "2"]}], "\[PlusMinus]",
              SqrtBox[
                RowBox[{
                  FractionBox[
                    SuperscriptBox["p", "3"], "27"], "+",
                  FractionBox[
                    SuperscriptBox["q", "2"], "4"]}]]}], "]"}]}],
"]"}], ";",
      RowBox[{"solsyplus", "=",
        RowBox[{
          RowBox[{
            RowBox[{"{",
              RowBox[{"y", "\[Rule]", "#"}], "}"}], "&"}], "/@",
          RowBox[{"(",
            RowBox[{
              RowBox[{"t", "-",
                RowBox[{"p", "/",
                  RowBox[{"(",
                    RowBox[{"3", "t"}], ")"}]}]}], "/.", "solstplus"}],
")"}]}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<verification for the roots in which we
have choosed the minus sign\>\"", "]"}], ";",
      RowBox[{"verminus", "=",
        RowBox[{"redcub", "/.", "solsyminus"}]}]}],
"\[IndentingNewLine]",
    RowBox[{"Map", "[",
      RowBox[{"Expand", ",", "verminus", ",",
        RowBox[{"{", "2", "}"}]}], "]"}], "\[IndentingNewLine]",
    RowBox[{"Map", "[",
      RowBox[{"Together", ",", "%", ",",
        RowBox[{"{", "2", "}"}]}], "]"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<verification for the roots in which we
have choosed the plus sign\>\"", "]"}], ";",
      RowBox[{"verplus", "=",
        RowBox[{"redcub", "/.", "solsyplus"}]}]}],
"\[IndentingNewLine]",
    RowBox[{"Map", "[",
      RowBox[{"Expand", ",", "verplus", ",",
        RowBox[{"{", "2", "}"}]}], "]"}], "\[IndentingNewLine]",
    RowBox[{"Map", "[",
      RowBox[{"Together", ",", "%", ",",
        RowBox[{"{", "2", "}"}]}], "]"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<an arithmetic example\>\"", "]"}],
";",
      RowBox[{"valpq", "=",
        RowBox[{"{",
          RowBox[{
            RowBox[{"p", "\[Rule]", "3"}], ",",
            RowBox[{"q", "\[Rule]", "2"}]}], "}"}]}]}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<minus sign\>\"", "]"}], ";",
      RowBox[{"solsyminus", "/.", "valpq"}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<substitution and verification\>\"",
"]"}], ";",
      RowBox[{
        RowBox[{"(",
          RowBox[{"redcub", "/.", "valpq"}], ")"}], "/.", "%"}]}],
"\[IndentingNewLine]",
    RowBox[{"Map", "[",
      RowBox[{"Expand", ",", "%", ",",
        RowBox[{"{", "2", "}"}]}], "]"}], "\[IndentingNewLine]",
    RowBox[{"Simplify", "[", "%", "]"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<numerical value with 40 digits
precision\>\"", "]"}], ";",
      RowBox[{
        RowBox[{"N", "[",
          RowBox[{
            RowBox[{"solsyminus", "/.", "valpq"}], ",", "20"}], "]"}],
"//", "Chop"}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<sorting\>\"", "]"}], ";",
      RowBox[{"Sort", "[", "%", "]"}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<plus sign\>\"", "]"}], ";",
      RowBox[{"solsyplus", "/.", "valpq"}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<substitution and verification\>\"",
"]"}], ";",
      RowBox[{
        RowBox[{"(",
          RowBox[{"redcub", "/.", "valpq"}], ")"}], "/.", "%"}]}],
"\[IndentingNewLine]",
    RowBox[{"Map", "[",
      RowBox[{"Expand", ",", "%", ",",
        RowBox[{"{", "2", "}"}]}], "]"}], "\[IndentingNewLine]",
    RowBox[{"Simplify", "[", "%", "]"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<numerical value with 40 digits
precision\>\"", "]"}], ";",
      RowBox[{
        RowBox[{"N", "[",
          RowBox[{
            RowBox[{"solsyplus", "/.", "valpq"}], ",", "20"}], "]"}],
"//", "Chop"}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<so we get the same set of roots
regardless which sign we choose; let choose the minus sign\>\"", "]"}],
";",
      "solsyminus"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<Mathematica's Solve solution\>\"",
"]"}], ";",
      RowBox[{"Solve", "[",
        RowBox[{"redcub", ",", "y"}], "]"}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<comparison of LeafCount values\>\"",
"]"}], ";",
      RowBox[{"LeafCount", "/@",
        RowBox[{"{",
          RowBox[{"%%", ",", "%"}], "}"}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<so leafcount[solution
procedure]<leafcount[solution procedure]\>\"", "]"}], ";"}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<let obtain the roots for the initial
varible z\>\"", "]"}], ";"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{
        RowBox[{"(",
          RowBox[{"y", "-", "\[Lambda]"}], ")"}], "/.",
        RowBox[{"\[Lambda]val", "[",
          RowBox[{"[", "1", "]"}], "]"}]}], "/.", "solsyminus"}],
"\[IndentingNewLine]",
    RowBox[{
      RowBox[{"Print", "[", "\"\<the roots for z in rule format\>\"",
"]"}], ";",
      RowBox[{"solsz", "=",
        RowBox[{
          RowBox[{
            RowBox[{"{",
              RowBox[{"z", "\[Rule]", "#"}], "}"}], "&"}], "/@",
"%"}]}]}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"$PrePrint", "=", "StandardForm"}], ";"}]}], "Input",
  CellLabel->"In[1636]:=",
  CellMargins->{{Inherited, 14}, {Inherited, Inherited}},
  TextAlignment->Left,
  TextJustification->1]


  • Prev by Date: RE: RE: Functional decomposition (solving f[f[x]] = g[x] for given g)
  • Next by Date: Bug in Algebra`Horner` Mathematica 5.2 (Win) Package
  • Previous by thread: Re: RE: Re: RE: RE: Functional decomposition (solving f[f[x]] = g[x] for given g)
  • Next by thread: RE: Solving the Cubic