(* Content-type: application/mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 7.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[     72050,       2135]
NotebookOptionsPosition[     65487,       1928]
NotebookOutlinePosition[     66319,       1957]
CellTagsIndexPosition[     66276,       1954]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[{
 StyleBox["In this example we use the package IntroToSymmetry.m to work out \
the invariant groups of the nonlinear second-order ODE \n\n",
  FontSize->14],
 StyleBox["x",
  FontSize->14,
  FontSlant->"Italic"],
 Cell[BoxData[
  FormBox[
   SubscriptBox["Y", "xx"], TraditionalForm]],
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["+",
  FontSize->14,
  FontSlant->"Italic"],
 Cell[BoxData[
  FormBox[
   SubscriptBox["Y", "x"], TraditionalForm]],
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["+",
  FontSize->14],
 StyleBox["xExp[Y]=0. ",
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["\n\nThis notebook illustrates the use of Mathematica built-in \
functions to find the final form of the infinitesimals that turn out to \
contain the logarithm.",
  FontSize->14]
}], "Text",
 TextAlignment->Left,
 ImageRegion->{{0, 1}, {0, 1}},
 FontSize->18,
 FontVariations->{"CompatibilityType"->0}],

Cell["Clear all symbols in the current context.", "Text",
 CellChangeTimes->{{3.4715644485587473`*^9, 3.47156448605101*^9}}],

Cell[BoxData[
 RowBox[{"ClearAll", "[", 
  RowBox[{"Evaluate", "[", 
   RowBox[{
    RowBox[{"Context", "[", "]"}], "<>", "\"\<*\>\""}], "]"}], "]"}]], "Input"],

Cell[TextData[{
 StyleBox["First read in the package which is located in User Home \
Folder/Library/",
  FontWeight->"Plain"],
 StyleBox["Mathematica",
  FontWeight->"Plain",
  FontSlant->"Italic"],
 StyleBox["/Applications/SymmetryAnalysis.",
  FontWeight->"Plain"]
}], "Text",
 CellChangeTimes->{{3.472046215957556*^9, 3.472046255573135*^9}, {
  3.472046289795615*^9, 3.472046308115048*^9}, {3.472046800511661*^9, 
  3.47204680154193*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"Needs", "[", "\"\<SymmetryAnalysis`IntroToSymmetry`\>\"", 
  "]"}]], "Input"],

Cell["Enter the list of independent variables.", "Text"],

Cell[BoxData[
 RowBox[{
  RowBox[{"independentvariables", "=", 
   RowBox[{"{", "\"\<x\>\"", "}"}]}], ";"}]], "Input"],

Cell["Enter the list of dependent variables.", "Text"],

Cell[BoxData[
 RowBox[{
  RowBox[{"dependentvariables", "=", 
   RowBox[{"{", "\"\<y\>\"", "}"}]}], ";"}]], "Input"],

Cell[TextData[StyleBox["Enter the input equation as a string. Don't include \
the ==0 at the end.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{
  "inputequation", "=", "\n", "\"\<x*D[y[x],x,x]+D[y[x],x]+x*Exp[y[x]]\>\""}],
   ";"}]], "Input"],

Cell[TextData[StyleBox["The function y[x] is a solution of the equation and \
this constraint must be applied in the form of a rule to the invariance \
condition. Be sure to check signs. Note that the rule is carefully set up to \
replace one isolated term. Note, for example, the replacement rule,    \
x*D[y[x],x,x]->-D[y[x],x]+x*Exp[y[x]] would not give the correct set of \
determining equations because it would only replace the particular product  \
x*D[y[x],x,x] wherever it appears rather than replacing, say, the second \
derivative everywhere. The rule    D[y[x],x,x]->-(1/x)*D[y[x],x]+Exp[y[x]] \
will give the correct set of determining equations.  Enter the rule as a \
string.",
 FontWeight->"Plain"]], "Text",
 CellChangeTimes->{{3.469396506430859*^9, 3.469396511139727*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"rulesarray", "=", "\[IndentingNewLine]", 
   RowBox[{
   "{", "\"\<D[y[x],x,x]\[Rule]-(1/x)*D[y[x],x]-Exp[y[x]]\>\"", "}"}]}], 
  ";"}]], "Input"],

Cell["\<\
Internally the package uses StringReplace to convert all of the user defined \
variables to generic x1,x2,x3..., y1,y2,y3... variables. When this is done it \
is important that function names and constant names that might appear in the \
equation are not erroneously modified. Enter the array of names that must be \
preserved when the equation is converted to generic (x1,y1) variables.\
\>", "Text"],

Cell[BoxData[
 RowBox[{
  RowBox[{"frozennames", "=", 
   RowBox[{"{", "\"\<Exp\>\"", "}"}]}], ";"}]], "Input"],

Cell[TextData[StyleBox["Enter the maximum derivative order of the equation.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"p", "=", "2"}], ";"}]], "Input"],

Cell[TextData[StyleBox["The maximum derivative order that the infinitesimals \
are assumed to depend on is specified by the input parameter r. This \
parameter is only nonzero when the user is looking for Lie contact groups or \
Lie-Backlund  groups. For the usual case where one is searching for point \
groups one sets r=0.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"r", "=", "0"}], ";"}]], "Input"],

Cell[TextData[StyleBox["When searching for Lie-Backlund groups (r=1 or \
greater) one can, without loss of generality, leave the independent variables \
untransformed. The corresponding infinitesimals (the xse's) are set to zero \
by setting xseon=0. If one is searching for point groups then set xseon=1. \
The choice xseon=1 is also an option when looking for Lie-Backlund groups and \
this can be useful when looking for contact symmetries.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"xseon", "=", "1"}], ";"}]], "Input"],

Cell[TextData[StyleBox["When searching for Lie-Backlund groups, it is \
necessary to differentiate the input equation r times producing derivatives \
of order p+r. These higher order differential consequences are appended to \
the set of rules applied to the invariance condition. This process is carried \
out automatically when internalrules=1. For point groups the equation or \
equation system is the only rule or set of rules needed and one sets \
internalrules=0.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"internalrules", "=", "0"}], ";"}]], "Input"],

Cell[TextData[StyleBox["Now work out the determining equations of the Lie \
point group that leaves the equation  invariant. The output is available as a \
table of strings called zdeterminingequations.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"FindDeterminingEquations", "[", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "frozennames", ",",
     "p", ",", "r", ",", "xseon", ",", "\[IndentingNewLine]", "inputequation",
     ",", "rulesarray", ",", "internalrules"}], "]"}], "]"}]], "Input"],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(25090432\\), the time used = \
\\!\\(2.3397010000000003`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 25090432, 2.3397010000000003`],
  Editable->False]], "Print",
 CellChangeTimes->{3.469396708130995*^9, 3.4693969305140333`*^9, 
  3.47154272420385*^9, 3.47155193304819*^9, 3.471576491731291*^9, 
  3.483545689226343*^9}],

Cell[BoxData["\<\"The function FindDeterminingEquations is nearly complete. \
The invariance condition has been created with all rules applied. The final \
step in the generation of the determining equations is to sum together terms \
in the table of invariance condition terms (called infinitesimaltable) that \
are multiplied by the same combination of products of free y derivatives. The \
result is the table infinitesimaltablesums corresponding to matching \
y-derivative expressions. If the invariance condition is long as it often is \
this process could take a long time since it requires sorting through the \
table infinitesimaltable once for each possible combination of y derivative \
products. This is the rate limiting step in the function \
FindDeterminingEquations.Virtually all other steps are quite fast including \
the generation of the extended derivatives of the infinitesimals.\"\>"], \
"Print",
 CellChangeTimes->{3.469396708130995*^9, 3.4693969305140333`*^9, 
  3.47154272420385*^9, 3.47155193304819*^9, 3.471576491731291*^9, 
  3.483545689312316*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(4\\), the \
byte count of zdeterminingequations = \\!\\(736\\), the memory in use = \
\\!\\(25186672\\), the time used = \\!\\(2.388915`\\)\"\>",
  StringForm[
  "The determining equations have been expressed in terms of z-variables, the \
length of zdeterminingequations = ``, the byte count of zdeterminingequations \
= ``, the memory in use = ``, the time used = ``", 4, 736, 25186672, 2.388915],
  Editable->False]], "Print",
 CellChangeTimes->{3.469396708130995*^9, 3.4693969305140333`*^9, 
  3.47154272420385*^9, 3.47155193304819*^9, 3.471576491731291*^9, 
  3.4835456893158197`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(25187536\\), the time used = \\!\\(2.389151`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 25187536, 2.389151],
  Editable->False]], "Print",
 CellChangeTimes->{3.469396708130995*^9, 3.4693969305140333`*^9, 
  3.47154272420385*^9, 3.47155193304819*^9, 3.471576491731291*^9, 
  3.483545689318534*^9}],

Cell[BoxData["\<\"FindDeterminingEquations has finished executing. You can \
look at the output in the table zdeterminingequations. Each entry in this \
table is a determining equation in string format expressed in terms of \
z-variables. Rules for converting between z-variables and conventional \
variables are contained in the table ztableofrules. To view the determining \
equations in terms of conventional variables use the command \
ToExpression[zdeterminingequations]/.ztableofrules. There are two other items \
the user may wish to look at; the equation converted to generic \
(x1,x2,...,y1,y2,...) variables is designated equationgenericvariables and \
the various derivatives of the equation that appear in the invariance \
condition can be viewed in the table invarconditiontable. Rules for \
converting between z-variables and generic variables are contained in the \
table ztableofrulesxy.\"\>"], "Print",
 CellChangeTimes->{3.469396708130995*^9, 3.4693969305140333`*^9, 
  3.47154272420385*^9, 3.47155193304819*^9, 3.471576491731291*^9, 
  3.4835456893208303`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.050117999999999885`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469396708224701*^9, 3.469396930598319*^9, 
  3.47154272428126*^9, 3.471551933102209*^9, 3.471576491748663*^9, 
  3.4835456893676767`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData["equationgenericvariables"], "Input"],

Cell[BoxData["\<\"x1*D[y1[x1],x1,x1]+D[y1[x1],x1]+x1*Exp[y1[x1]]\"\>"], \
"Output",
 CellChangeTimes->{3.469396708281064*^9, 3.469396930650588*^9, 
  3.471542724319189*^9, 3.47155193316555*^9, 3.471576491791082*^9, 
  3.48354568941387*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData["invarconditiontable"], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    SuperscriptBox["\[ExponentialE]", 
     RowBox[{"y1", "[", "x1", "]"}]], "+", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], ",", 
   RowBox[{
    SuperscriptBox["\[ExponentialE]", 
     RowBox[{"y1", "[", "x1", "]"}]], " ", "x1"}], ",", "1", ",", "x1"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469396708317295*^9, 3.469396930704723*^9, 
  3.471542724378413*^9, 3.471551933209586*^9, 3.4715764918228292`*^9, 
  3.483545689470372*^9}]
}, Open  ]],

Cell[BoxData["ztableofrules"], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469396708371317*^9, 3.469396930787768*^9, 
  3.4715427244082212`*^9, 3.471551933276964*^9, 3.47157649188509*^9, 
  3.483545689513682*^9}],

Cell[CellGroupData[{

Cell[BoxData["ztableofrulesxy"], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"x1", "\[Rule]", "z1"}], ",", 
   RowBox[{
    RowBox[{"y1", "[", "x1", "]"}], "\[Rule]", "z2"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469396708421783*^9, 3.469396930834168*^9, 
  3.471542724462452*^9, 3.471551933339216*^9, 3.47157649194149*^9, 
  3.483545689568336*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Here are the determining equations expressed in terms \
of z-variables. This output may be quite long.  The equations in the table \
can be distinguished by the ==0 at the end of each item.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData["zdeterminingequations"], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"-(z1^2*Derivative[0, 2][xse1][z1, z2]) == 0\"\>", 
   ",", "\<\"2*z1*Derivative[0, 1][xse1][z1, z2] + z1^2*Derivative[0, \
2][eta1][z1, z2] - 2*z1^2*Derivative[1, 1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"E^z2*z1^2*eta1[z1, z2] - E^z2*z1^2*Derivative[0, 1][eta1][z1, \
z2] + z1*Derivative[1, 0][eta1][z1, z2] + 2*E^z2*z1^2*Derivative[1, \
0][xse1][z1, z2] + z1^2*Derivative[2, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"-xse1[z1, z2] + 3*E^z2*z1^2*Derivative[0, 1][xse1][z1, z2] + \
z1*Derivative[1, 0][xse1][z1, z2] + 2*z1^2*Derivative[1, 1][eta1][z1, z2] - \
z1^2*Derivative[2, 0][xse1][z1, z2] == 0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.4693967084717283`*^9, 3.469396930888517*^9, 
  3.471542724488505*^9, 3.4715519333912973`*^9, 3.4715764920038424`*^9, 
  3.483545689616035*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], "/.", 
  "ztableofrules"}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{
     RowBox[{"-", 
      SuperscriptBox["x", "2"]}], " ", 
     RowBox[{
      SuperscriptBox["xse1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"0", ",", "2"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x", ",", 
       RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"2", " ", "x", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox["x", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{"2", " ", 
      SuperscriptBox["x", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      SuperscriptBox["\[ExponentialE]", 
       RowBox[{"y", "[", "x", "]"}]], " ", 
      SuperscriptBox["x", "2"], " ", 
      RowBox[{"eta1", "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox["\[ExponentialE]", 
       RowBox[{"y", "[", "x", "]"}]], " ", 
      SuperscriptBox["x", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{"x", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{"2", " ", 
      SuperscriptBox["\[ExponentialE]", 
       RowBox[{"y", "[", "x", "]"}]], " ", 
      SuperscriptBox["x", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox["x", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"-", 
      RowBox[{"xse1", "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{"3", " ", 
      SuperscriptBox["\[ExponentialE]", 
       RowBox[{"y", "[", "x", "]"}]], " ", 
      SuperscriptBox["x", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{"x", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{"2", " ", 
      SuperscriptBox["x", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox["x", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.4693967085228043`*^9, 3.469396930936802*^9, 
  3.471542724546069*^9, 3.4715519334893503`*^9, 3.4715764920557117`*^9, 
  3.483545689666995*^9}]
}, Open  ]],

Cell["How many determining equations are there?", "Text"],

Cell[CellGroupData[{

Cell["imax=Length[zdeterminingequations]", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData["4"], "Output",
 CellChangeTimes->{3.469396708572287*^9, 3.469396930984941*^9, 
  3.471542724578719*^9, 3.471551933541295*^9, 3.4715764921042347`*^9, 
  3.483545689716186*^9}]
}, Open  ]],

Cell["\<\
Lets look at the determining equations in a slightly more readable form.\
\>", "Text",
 FontWeight->"Plain",
 FontVariations->{"CompatibilityType"->0}],

Cell[BoxData[
 RowBox[{"zdeterminingequationscolumn", "=", 
  TagBox[
   FormBox[
    RowBox[{"Column", "[", 
     RowBox[{
      RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], ",", 
      RowBox[{"{", 
       RowBox[{"Left", ",", "Below"}], "}"}]}], "]"}],
    TraditionalForm],
   TraditionalForm,
   Editable->True]}]], "Input"],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["z1", "2"]}], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"2", " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["\[ExponentialE]", "z2"], " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["\[ExponentialE]", "z2"], " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"z1", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        RowBox[{"xse1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"3", " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"z1", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.4693967086230288`*^9, 3.469396931070218*^9, 
  3.4715427246363173`*^9, 3.471551933613319*^9, 3.471576492156608*^9, 
  3.4835456897934732`*^9}],

Cell[BoxData[
 RowBox[{"zdeterminingequationscolumn", "=", 
  RowBox[{"TraditionalForm", "[", 
   RowBox[{"Column", "[", 
    RowBox[{
     RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"Left", ",", "Below"}], "}"}]}], "]"}], "]"}]}]], "Input",
 CellChangeTimes->{{3.469396787713131*^9, 3.469396827442988*^9}, {
  3.469396982422022*^9, 3.469396982834963*^9}}],

Cell[BoxData[
 FormBox[
  TagBox[GridBox[{
     {
      RowBox[{
       RowBox[{
        RowBox[{"-", 
         SuperscriptBox["z1", "2"]}], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "(", 
         RowBox[{"z1", ",", "z2"}], ")"}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{
         SuperscriptBox["z1", "2"], " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"0", ",", "2"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{"2", " ", 
         SuperscriptBox["z1", "2"], " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{"2", " ", "z1", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"0", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"-", 
         RowBox[{
          SuperscriptBox["z1", "2"], " ", 
          SuperscriptBox["\[ExponentialE]", "z2"], " ", 
          RowBox[{
           SuperscriptBox["eta1", 
            TagBox[
             RowBox[{"(", 
              RowBox[{"0", ",", "1"}], ")"}],
             Derivative],
            MultilineFunction->None], "(", 
           RowBox[{"z1", ",", "z2"}], ")"}]}]}], "+", 
        RowBox[{
         SuperscriptBox["z1", "2"], " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"2", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{"z1", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{
         SuperscriptBox["z1", "2"], " ", 
         SuperscriptBox["\[ExponentialE]", "z2"], " ", 
         RowBox[{"eta1", "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{"2", " ", 
         SuperscriptBox["z1", "2"], " ", 
         SuperscriptBox["\[ExponentialE]", "z2"], " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"2", " ", 
         SuperscriptBox["z1", "2"], " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{"3", " ", 
         SuperscriptBox["z1", "2"], " ", 
         SuperscriptBox["\[ExponentialE]", "z2"], " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"0", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{
         SuperscriptBox["z1", "2"], " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"2", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{"z1", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{"xse1", "(", 
         RowBox[{"z1", ",", "z2"}], ")"}]}], "\[LongEqual]", "0"}]}
    },
    GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
    GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
   "Column"], TraditionalForm]], "Output",
 CellChangeTimes->{3.469396708749428*^9, 3.4693968122441807`*^9, 
  3.469396931126306*^9, 3.469396984053034*^9, 3.471542724689749*^9, 
  3.471551933659617*^9, 3.47157649220439*^9, 3.4835456898346367`*^9}],

Cell["\<\
Now try to solve the determining equations in terms of multivariable \
polynomials of a selected order. The Mathematica function Solve uses Gaussian \
elimination to solve a large number of linear equations for the polynomial \
coefficients.  The time roughly follows

time/timeref=((number of equations)/(number of equationsref))^n

where the exponent is between 2.4 and 2.7. The Mathematica function Timing \
outputs the time required for the SolveDeterminingEquations function to \
execute.\
\>", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"SolveDeterminingEquations", "[", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "r", ",", "xseon", 
    ",", "\[IndentingNewLine]", "zdeterminingequations", ",", 
    RowBox[{"order", "=", "4"}]}], "]"}], "]"}]], "Input",
 CellChangeTimes->{{3.4693968806165524`*^9, 3.469396882270859*^9}}],

Cell[BoxData[
 InterpretationBox["\<\"The variable powertablelength is the number of terms \
required for each multivariate polynomial used for the infinitesimals. This \
number is determined by the choice of polynomial order and the number of \
zvariables. The time needed to solve the determining equations increases as \
powertable increases. powertablelength = \\!\\(15\\)\"\>",
  StringForm[
  "The variable powertablelength is the number of terms required for each \
multivariate polynomial used for the infinitesimals. This number is \
determined by the choice of polynomial order and the number of zvariables. \
The time needed to solve the determining equations increases as powertable \
increases. powertablelength = ``", 15],
  Editable->False]], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.483545689881442*^9}],

Cell[BoxData["\<\"The polynomial expansions have been substituted into the \
determining equations. It is now time to collect the coefficients of various \
powers of zvariables into a table called table of coefficientsall. This step \
uses the function CoefficientList and is a fairly time consuming procedure.\"\
\>"], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.483545689884206*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(25928328\\), The time = \\!\
\\(2.4369080000000003`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 25928328, 2.4369080000000003`],
  Editable->False]], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.483545689886218*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(30\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 30],
  Editable->False]], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.483545689888035*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(50\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 50],
  Editable->False]], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.483545689889799*^9}],

Cell[BoxData["\<\"Now it we are ready to use the function Solve to find the \
nonzero polynomial coefficients corresponding to the symmetries of the input \
equation(s). This can take a while.\"\>"], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.483545689891583*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(25952408\\), The time = \\!\
\\(2.4427470000000002`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 25952408, 2.4427470000000002`],
  Editable->False]], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.4835456898934717`*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.4835456899363413`*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.483545689938493*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26104176\\), The time = \\!\
\\(2.457942`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26104176, 2.457942],
  Editable->False]], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.483545689940365*^9}],

Cell[BoxData["\<\"You can look at the output in the tables xsefunctions and \
etafunctions. Each entry in these tables is an infinitesimal function in \
string format expressed in terms of z-variables and the group parameters. The \
output can also be viewed with the group parameters stripped away by looking \
at the table infinitesimalgroups. In either case you may wish to convert the \
z-variables to conventional variables using the table ztableofrules. \
\\n\\nKeep in mind that this function only finds solutions of the determining \
equations that are of polynomial form. The determining equations may admit \
solutions that involve transcendental functions and/or integrals. Note that \
arbitrary functions may appear in the infinitesimals and that these can be \
detected by running the package function SolveDeterminingEquations for \
several polynomial orders. If terms of ever increasing order appear, then an \
arbitrary function is indicated.\"\>"], "Print",
 CellChangeTimes->{3.469396708853448*^9, 3.469396931189066*^9, 
  3.471542724755714*^9, 3.471551933723637*^9, 3.471576492271269*^9, 
  3.48354568994207*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.03737899999999961`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469396708907843*^9, 3.4693969312390623`*^9, 
  3.471542724816505*^9, 3.471551933738763*^9, 3.471576492282291*^9, 
  3.483545689944913*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Here are the infinitesimals for the independent \
variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData["xsefunctions"], "Input"],

Cell[BoxData[
 RowBox[{"{", "\<\"xse1[z1_, z2_]=(-b10/2 - 4*b15)*z1 - (3*b15*E^z2*z1^3)/8 - \
(b15*z1*z2)/2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.4693967090162086`*^9, 3.4693969313633833`*^9, 
  3.4715427248601427`*^9, 3.471551933771153*^9, 3.471576492321109*^9, 
  3.483545690043297*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["and the infinitesimals for the dependent variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData["etafunctions"], "Input"],

Cell[BoxData[
 RowBox[{"{", "\<\"eta1[z1_, z2_]=b10 + (9*b15*E^z2*z1^2)/4 + b15*z2\"\>", 
  "}"}]], "Output",
 CellChangeTimes->{3.469396709072879*^9, 3.469396931422908*^9, 
  3.471542724912426*^9, 3.4715519338997927`*^9, 3.471576492373623*^9, 
  3.483545690102009*^9}]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Express the xse functions in terms of x,y variables.",
 
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"ToExpression", "[", "xsefunctions", "]"}], "/.", 
  "ztableofrules"}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{"(", 
     RowBox[{
      RowBox[{"-", 
       FractionBox["b10", "2"]}], "-", 
      RowBox[{"4", " ", "b15"}]}], ")"}], " ", "x"}], "-", 
   RowBox[{
    FractionBox["3", "8"], " ", "b15", " ", 
    SuperscriptBox["\[ExponentialE]", 
     RowBox[{"y", "[", "x", "]"}]], " ", 
    SuperscriptBox["x", "3"]}], "-", 
   RowBox[{
    FractionBox["1", "2"], " ", "b15", " ", "x", " ", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469396709101066*^9, 3.4693969314556427`*^9, 
  3.471542724962776*^9, 3.471551933950797*^9, 3.4715764924985123`*^9, 
  3.483545690134737*^9}]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Express the eta function in terms of these variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"ToExpression", "[", "etafunctions", "]"}], "/.", 
  "ztableofrules"}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"b10", "+", 
   RowBox[{
    FractionBox["9", "4"], " ", "b15", " ", 
    SuperscriptBox["\[ExponentialE]", 
     RowBox[{"y", "[", "x", "]"}]], " ", 
    SuperscriptBox["x", "2"]}], "+", 
   RowBox[{"b15", " ", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469396709139463*^9, 3.469396931502686*^9, 
  3.471542725087611*^9, 3.471551933990823*^9, 3.471576492557681*^9, 
  3.48354569018382*^9}]
}, Open  ]]
}, Open  ]],

Cell[TextData[{
 StyleBox["This process has correctly captured the group (xse,eta)=(-x/2,1) \
corresponding to the parameter b10.  But the expressions multiplying b15 do \
not correspond to any relevant group of the equation. See Example 8.2  in the \
text ",
  FontWeight->"Plain"],
 StyleBox["Introduction to Symmetry Analysis",
  FontWeight->"Plain",
  FontSlant->"Italic"],
 StyleBox[" for the correct solution. The problem here comes from the \
exponential terms that arise in the determining  equations. The determining \
equations themselves are correct and should be compared with Example 8.2 in \
the  text but the ",
  FontWeight->"Plain"],
 "SolveDeterminingEquations",
 StyleBox[" function is incapable of identifying the second group of this \
equation which  contains the logarithm.",
  FontWeight->"Plain"]
}], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[StyleBox["Close examination of the third and fourth determining \
equations suggests that we try the following simplification of the \
infinitesimals.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"xse1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{
   RowBox[{
    RowBox[{"-", "a"}], "*", 
    RowBox[{"(", 
     RowBox[{"z1", "/", "2"}], ")"}]}], "+", 
   RowBox[{"f", "[", "z1", "]"}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"eta1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{"a", "+", 
   RowBox[{"g", "[", "z1", "]"}]}]}]], "Input"],

Cell[TextData[StyleBox["Substitute these functions into the expression form \
of the determining equations.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Simplify", "[", "zdeterminingequationscolumn", "]"}]], "Input"],

Cell[BoxData[
 FormBox[
  TagBox[GridBox[{
     {"True"},
     {"True"},
     {
      RowBox[{
       RowBox[{"z1", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{"2", " ", "z1", " ", 
           SuperscriptBox["\[ExponentialE]", "z2"], " ", 
           RowBox[{
            SuperscriptBox["f", "\[Prime]",
             MultilineFunction->None], "(", "z1", ")"}]}], "+", 
          RowBox[{"z1", " ", 
           RowBox[{
            SuperscriptBox["g", "\[Prime]\[Prime]",
             MultilineFunction->None], "(", "z1", ")"}]}], "+", 
          RowBox[{
           SuperscriptBox["g", "\[Prime]",
            MultilineFunction->None], "(", "z1", ")"}], "+", 
          RowBox[{"z1", " ", 
           SuperscriptBox["\[ExponentialE]", "z2"], " ", 
           RowBox[{"g", "(", "z1", ")"}]}]}], ")"}]}], "\[LongEqual]", 
       "0"}]},
     {
      RowBox[{
       RowBox[{"z1", " ", 
        RowBox[{
         SuperscriptBox["f", "\[Prime]",
          MultilineFunction->None], "(", "z1", ")"}]}], "\[LongEqual]", 
       RowBox[{
        RowBox[{
         SuperscriptBox["z1", "2"], " ", 
         RowBox[{
          SuperscriptBox["f", "\[Prime]\[Prime]",
           MultilineFunction->None], "(", "z1", ")"}]}], "+", 
        RowBox[{"f", "(", "z1", ")"}]}]}]}
    },
    GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
    GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
   "Column"], TraditionalForm]], "Output",
 CellChangeTimes->{3.469396709247459*^9, 3.4693969316657887`*^9, 
  3.471542725194584*^9, 3.471551934135247*^9, 3.471576492636056*^9, 
  3.483545690318636*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The first and second determining equations are \
satisfied. The second determining equation is uncoupled from the first. \
Mathematica has the capability of solving such equations.",
 FontWeight->"Plain"]], "Text",
 CellChangeTimes->{{3.483545618875442*^9, 3.483545628630273*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"DSolve", "[", 
  RowBox[{
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{"z1", "^", "2"}], "*", 
      RowBox[{
       RowBox[{"f", "''"}], "[", "z1", "]"}]}], "-", 
     RowBox[{"z1", "*", 
      RowBox[{
       RowBox[{"f", "'"}], "[", "z1", "]"}]}], "+", 
     RowBox[{"f", "[", "z1", "]"}]}], "\[Equal]", "0"}], ",", 
   RowBox[{"f", "[", "z1", "]"}], ",", "z1"}], "]"}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"f", "[", "z1", "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{"z1", " ", 
      RowBox[{"C", "[", "1", "]"}]}], "+", 
     RowBox[{"z1", " ", 
      RowBox[{"C", "[", "2", "]"}], " ", 
      RowBox[{"Log", "[", "z1", "]"}]}]}]}], "}"}], "}"}]], "Output",
 CellChangeTimes->{3.469396709813922*^9, 3.46939693175898*^9, 
  3.471542725555923*^9, 3.4715519342800627`*^9, 3.471576492686655*^9, 
  3.483545690929635*^9}]
}, Open  ]],

Cell[TextData[StyleBox["Now try a a more refined form of the infinitesimals.",
 
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"xse1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{
   RowBox[{
    RowBox[{"-", "a"}], "*", 
    RowBox[{"(", 
     RowBox[{"z1", "/", "2"}], ")"}]}], "+", 
   RowBox[{"b", "*", "z1", "*", 
    RowBox[{"Log", "[", "z1", "]"}]}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"eta1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{"a", "+", 
   RowBox[{"g", "[", "z1", "]"}]}]}]], "Input"],

Cell[TextData[StyleBox["Substitute these functions into the expression form \
of the determining equations.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData["zdeterminingequationscolumn"], "Input"],

Cell[BoxData[
 FormBox[
  TagBox[GridBox[{
     {"True"},
     {"True"},
     {
      RowBox[{
       RowBox[{
        RowBox[{"2", " ", 
         SuperscriptBox["z1", "2"], " ", 
         SuperscriptBox["\[ExponentialE]", "z2"], " ", 
         RowBox[{"(", 
          RowBox[{
           RowBox[{"-", 
            FractionBox["a", "2"]}], "+", 
           RowBox[{"b", " ", 
            RowBox[{"log", "(", "z1", ")"}]}], "+", "b"}], ")"}]}], "+", 
        RowBox[{
         SuperscriptBox["z1", "2"], " ", 
         SuperscriptBox["\[ExponentialE]", "z2"], " ", 
         RowBox[{"(", 
          RowBox[{"a", "+", 
           RowBox[{"g", "(", "z1", ")"}]}], ")"}]}], "+", 
        RowBox[{
         SuperscriptBox["z1", "2"], " ", 
         RowBox[{
          SuperscriptBox["g", "\[Prime]\[Prime]",
           MultilineFunction->None], "(", "z1", ")"}]}], "+", 
        RowBox[{"z1", " ", 
         RowBox[{
          SuperscriptBox["g", "\[Prime]",
           MultilineFunction->None], "(", "z1", ")"}]}]}], "\[LongEqual]", 
       "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"z1", " ", 
         RowBox[{"(", 
          RowBox[{
           RowBox[{"-", 
            FractionBox["a", "2"]}], "+", 
           RowBox[{"b", " ", 
            RowBox[{"log", "(", "z1", ")"}]}], "+", "b"}], ")"}]}], "+", 
        FractionBox[
         RowBox[{"a", " ", "z1"}], "2"], "-", 
        RowBox[{"b", " ", "z1"}], "-", 
        RowBox[{"b", " ", "z1", " ", 
         RowBox[{"log", "(", "z1", ")"}]}]}], "\[LongEqual]", "0"}]}
    },
    GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
    GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
   "Column"], TraditionalForm]], "Output",
 CellChangeTimes->{3.469396709920167*^9, 3.469396931848556*^9, 
  3.471542725639454*^9, 3.471551934366742*^9, 3.471576492823152*^9, 
  3.4835456910959883`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Simplify", "[", "%", "]"}]], "Input"],

Cell[BoxData[
 TagBox[GridBox[{
    {"True"},
    {"True"},
    {
     RowBox[{
      RowBox[{"z1", " ", 
       RowBox[{"(", 
        RowBox[{
         RowBox[{
          SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
          RowBox[{"g", "[", "z1", "]"}]}], "+", 
         RowBox[{
          SuperscriptBox["g", "\[Prime]",
           MultilineFunction->None], "[", "z1", "]"}], "+", 
         RowBox[{"z1", " ", 
          RowBox[{"(", 
           RowBox[{
            RowBox[{"2", " ", "b", " ", 
             SuperscriptBox["\[ExponentialE]", "z2"], " ", 
             RowBox[{"(", 
              RowBox[{"1", "+", 
               RowBox[{"Log", "[", "z1", "]"}]}], ")"}]}], "+", 
            RowBox[{
             SuperscriptBox["g", "\[Prime]\[Prime]",
              MultilineFunction->None], "[", "z1", "]"}]}], ")"}]}]}], 
        ")"}]}], "\[Equal]", "0"}]},
    {"True"}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469396710058921*^9, 3.469396931887092*^9, 
  3.471542725684576*^9, 3.471551934462165*^9, 3.471576492943482*^9, 
  3.4835456911505117`*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The third equation can only be satisfied if the terms \
multiplying Exp[z2] are zero. This requires g[z1]=-2b-2bLog[z1] which also \
satisfies z1g'+z1^2g''=0. So now let's try a third form of the \
infinitesimals.",
 FontWeight->"Plain"]], "Text",
 CellChangeTimes->{{3.483545649709154*^9, 3.483545652964513*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"xse1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{
   RowBox[{
    RowBox[{"-", "a"}], "*", 
    RowBox[{"(", 
     RowBox[{"z1", "/", "2"}], ")"}]}], "+", 
   RowBox[{"b", "*", "z1", "*", 
    RowBox[{"Log", "[", "z1", "]"}]}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"eta1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{"a", "-", 
   RowBox[{"2", "*", "b"}], "-", 
   RowBox[{"2", "*", "b", "*", 
    RowBox[{"Log", "[", "z1", "]"}]}]}]}]], "Input"],

Cell[TextData[StyleBox["Substitute these functions into the expression form \
of the determining equations.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData["zdeterminingequationscolumn"], "Input"],

Cell[BoxData[
 FormBox[
  TagBox[GridBox[{
     {"True"},
     {"True"},
     {
      RowBox[{
       RowBox[{
        RowBox[{
         SuperscriptBox["z1", "2"], " ", 
         SuperscriptBox["\[ExponentialE]", "z2"], " ", 
         RowBox[{"(", 
          RowBox[{"a", "-", 
           RowBox[{"2", " ", "b", " ", 
            RowBox[{"log", "(", "z1", ")"}]}], "-", 
           RowBox[{"2", " ", "b"}]}], ")"}]}], "+", 
        RowBox[{"2", " ", 
         SuperscriptBox["z1", "2"], " ", 
         SuperscriptBox["\[ExponentialE]", "z2"], " ", 
         RowBox[{"(", 
          RowBox[{
           RowBox[{"-", 
            FractionBox["a", "2"]}], "+", 
           RowBox[{"b", " ", 
            RowBox[{"log", "(", "z1", ")"}]}], "+", "b"}], ")"}]}]}], 
       "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"z1", " ", 
         RowBox[{"(", 
          RowBox[{
           RowBox[{"-", 
            FractionBox["a", "2"]}], "+", 
           RowBox[{"b", " ", 
            RowBox[{"log", "(", "z1", ")"}]}], "+", "b"}], ")"}]}], "+", 
        FractionBox[
         RowBox[{"a", " ", "z1"}], "2"], "-", 
        RowBox[{"b", " ", "z1"}], "-", 
        RowBox[{"b", " ", "z1", " ", 
         RowBox[{"log", "(", "z1", ")"}]}]}], "\[LongEqual]", "0"}]}
    },
    GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
    GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
   "Column"], TraditionalForm]], "Output",
 CellChangeTimes->{3.469396710137513*^9, 3.469396931999058*^9, 
  3.4715427257731028`*^9, 3.471551934549644*^9, 3.4715764930148478`*^9, 
  3.483545691262638*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Simplify", "[", "%", "]"}]], "Input"],

Cell[BoxData[
 TagBox[GridBox[{
    {"True"},
    {"True"},
    {"True"},
    {"True"}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.46939671017559*^9, 3.4693969320363703`*^9, 
  3.4715427258082733`*^9, 3.471551934585746*^9, 3.471576493051992*^9, 
  3.483545691295948*^9}]
}, Open  ]],

Cell[TextData[StyleBox["Let's check the original determining equations.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], "/.", 
  RowBox[{"{", "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{
     RowBox[{"xse1", "[", 
      RowBox[{"z1_", ",", "z2_"}], "]"}], "->", 
     RowBox[{
      RowBox[{
       RowBox[{"-", "a"}], "*", 
       RowBox[{"(", 
        RowBox[{"z1", "/", "2"}], ")"}]}], "+", 
      RowBox[{"b", "*", "z1", "*", 
       RowBox[{"Log", "[", "z1", "]"}]}]}]}], ",", "\[IndentingNewLine]", 
    RowBox[{
     RowBox[{"eta1", "[", 
      RowBox[{"z1_", ",", "z2_"}], "]"}], "->", 
     RowBox[{"a", "-", 
      RowBox[{"2", "*", "b"}], "-", 
      RowBox[{"2", "*", "b", "*", 
       RowBox[{"Log", "[", "z1", "]"}]}]}]}]}], "}"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"True", ",", "True", ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      SuperscriptBox["\[ExponentialE]", "z2"], " ", 
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{"(", 
       RowBox[{"a", "-", 
        RowBox[{"2", " ", "b"}], "-", 
        RowBox[{"2", " ", "b", " ", 
         RowBox[{"Log", "[", "z1", "]"}]}]}], ")"}]}], "+", 
     RowBox[{"2", " ", 
      SuperscriptBox["\[ExponentialE]", "z2"], " ", 
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{"(", 
       RowBox[{
        RowBox[{"-", 
         FractionBox["a", "2"]}], "+", "b", "+", 
        RowBox[{"b", " ", 
         RowBox[{"Log", "[", "z1", "]"}]}]}], ")"}]}]}], "\[Equal]", "0"}], 
   ",", 
   RowBox[{
    RowBox[{
     FractionBox[
      RowBox[{"a", " ", "z1"}], "2"], "-", 
     RowBox[{"b", " ", "z1"}], "-", 
     RowBox[{"b", " ", "z1", " ", 
      RowBox[{"Log", "[", "z1", "]"}]}], "+", 
     RowBox[{"z1", " ", 
      RowBox[{"(", 
       RowBox[{
        RowBox[{"-", 
         FractionBox["a", "2"]}], "+", "b", "+", 
        RowBox[{"b", " ", 
         RowBox[{"Log", "[", "z1", "]"}]}]}], ")"}]}]}], "\[Equal]", "0"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469396710230118*^9, 3.469396932092128*^9, 
  3.471542725865076*^9, 3.4715519346225233`*^9, 3.471576493086994*^9, 
  3.4835456913508167`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Simplify", "[", "%", "]"}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"True", ",", "True", ",", "True", ",", "True"}], "}"}]], "Output",
 CellChangeTimes->{3.4693967102751617`*^9, 3.469396932136593*^9, 
  3.471542725915557*^9, 3.4715519346731167`*^9, 3.471576493119652*^9, 
  3.4835456914012003`*^9}]
}, Open  ]],

Cell[TextData[StyleBox["Finally, the infinitesimals that leave the original \
ODE invariant are\nxse[x,y]=-ax/2+b(xLog[x])\neta[x,y]=a+b(-2-2Log[x])\nThis \
is the two parameter group described in Example 8.2.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[StyleBox["Let's generate a commutator table for the group. \
First set up an array of the groups.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"infinitesimalgroupsxy", "=", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{
        RowBox[{"-", "x"}], "/", "2"}], "}"}], ",", 
      RowBox[{"{", "1", "}"}]}], "}"}], ",", 
    RowBox[{"{", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{"x", "*", 
        RowBox[{"Log", "[", "x", "]"}]}], "}"}], ",", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"-", "2"}], "-", 
        RowBox[{"2", "*", 
         RowBox[{"Log", "[", "x", "]"}]}]}], "}"}]}], "}"}]}], 
   "}"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"-", 
       FractionBox["x", "2"]}], "}"}], ",", 
     RowBox[{"{", "1", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"x", " ", 
       RowBox[{"Log", "[", "x", "]"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"-", "2"}], "-", 
       RowBox[{"2", " ", 
        RowBox[{"Log", "[", "x", "]"}]}]}], "}"}]}], "}"}]}], "}"}]], "Output",\

 CellChangeTimes->{3.469396710330007*^9, 3.4693969321917257`*^9, 
  3.471542725962706*^9, 3.471551934707264*^9, 3.4715764931533537`*^9, 
  3.48354569145128*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Column", "[", "infinitesimalgroupsxy", "]"}]], "Input",
 CellChangeTimes->{{3.469396345010697*^9, 3.4693963461186733`*^9}}],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"-", 
         FractionBox["x", "2"]}], "}"}], ",", 
       RowBox[{"{", "1", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"x", " ", 
         RowBox[{"Log", "[", "x", "]"}]}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"-", "2"}], "-", 
         RowBox[{"2", " ", 
          RowBox[{"Log", "[", "x", "]"}]}]}], "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469396710376073*^9, 3.469396932237953*^9, 
  3.4715427260155487`*^9, 3.471551934742887*^9, 3.471576493204711*^9, 
  3.483545691501796*^9}]
}, Open  ]],

Cell[BoxData[
 RowBox[{"MakeCommutatorTable", "[", "\[IndentingNewLine]", 
  RowBox[{
  "independentvariables", ",", "dependentvariables", ",", 
   "infinitesimalgroupsxy"}], "]"}]], "Input"],

Cell[BoxData["\<\"MakeCommutatorTable has finished executing. You can look at \
the output in the table commutatortable. To present the output in the most \
readable form you may want view it as a matrix using \
MatrixForm[commutatortable]. Occasionally the entries in the commutatortable \
will have terms that cancel. To get rid of these terms use the function \
Simplify before viewing the table.\"\>"], "Print",
 CellChangeTimes->{3.469396710429845*^9, 3.469396932307349*^9, 
  3.471542726139729*^9, 3.4715519347880373`*^9, 3.471576493236578*^9, 
  3.483545691551824*^9}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"MatrixForm", "[", "commutatortable", "]"}]], "Input"],

Cell[BoxData[
 TagBox[
  RowBox[{"(", "\[NoBreak]", GridBox[{
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {"0"},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{
           RowBox[{
            FractionBox["1", "2"], " ", "x", " ", 
            RowBox[{"Log", "[", "x", "]"}]}], "-", 
           RowBox[{
            FractionBox["1", "2"], " ", "x", " ", 
            RowBox[{"(", 
             RowBox[{"1", "+", 
              RowBox[{"Log", "[", "x", "]"}]}], ")"}]}]}]},
         {"1"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]},
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{
           RowBox[{
            RowBox[{"-", 
             FractionBox["1", "2"]}], " ", "x", " ", 
            RowBox[{"Log", "[", "x", "]"}]}], "+", 
           RowBox[{
            FractionBox["1", "2"], " ", "x", " ", 
            RowBox[{"(", 
             RowBox[{"1", "+", 
              RowBox[{"Log", "[", "x", "]"}]}], ")"}]}]}]},
         {
          RowBox[{"-", "1"}]}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {"0"},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]}
    },
    GridBoxAlignment->{
     "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, 
      "RowsIndexed" -> {}},
    GridBoxSpacings->{"Columns" -> {
        Offset[0.27999999999999997`], {
         Offset[0.7]}, 
        Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
        Offset[0.2], {
         Offset[0.4]}, 
        Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}],
  Function[BoxForm`e$, 
   MatrixForm[BoxForm`e$]]]], "Output",
 CellChangeTimes->{3.469396710476594*^9, 3.469396932416992*^9, 
  3.471542726200026*^9, 3.4715519349045277`*^9, 3.4715764932733107`*^9, 
  3.483545691602837*^9}]
}, Open  ]],

Cell[TextData[StyleBox["It looks like some terms in this last result should \
cancel.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"MatrixForm", "[", 
  RowBox[{"Simplify", "[", "commutatortable", "]"}], "]"}]], "Input"],

Cell[BoxData[
 TagBox[
  RowBox[{"(", "\[NoBreak]", GridBox[{
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {"0"},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{"-", 
           FractionBox["x", "2"]}]},
         {"1"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]},
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          FractionBox["x", "2"]},
         {
          RowBox[{"-", "1"}]}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {"0"},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]}
    },
    GridBoxAlignment->{
     "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, 
      "RowsIndexed" -> {}},
    GridBoxSpacings->{"Columns" -> {
        Offset[0.27999999999999997`], {
         Offset[0.7]}, 
        Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
        Offset[0.2], {
         Offset[0.4]}, 
        Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}],
  Function[BoxForm`e$, 
   MatrixForm[BoxForm`e$]]]], "Output",
 CellChangeTimes->{3.469396710526039*^9, 3.4693969324744167`*^9, 
  3.471542726247851*^9, 3.471551934944352*^9, 3.4715764933019857`*^9, 
  3.4835456916517277`*^9}]
}, Open  ]],

Cell[TextData[StyleBox["This is a two dimensional solvable Lie algebra that \
can be used to reduce the original ODE to quadrature.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"MaxMemoryUsed", "[", " ", "]"}]], "Input"],

Cell[BoxData["47171032"], "Output",
 CellChangeTimes->{3.469396710579876*^9, 3.469396932520925*^9, 
  3.4715427262973433`*^9, 3.4715519349857616`*^9, 3.471576493336615*^9, 
  3.483545691701331*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{1006, 1069},
WindowMargins->{{55, Automatic}, {Automatic, 28}},
PrintingCopies->1,
PrintingPageRange->{1, Automatic},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
MacintoshSystemPageSetup -> \
"0080009H0UP0000068dB`?oHofXIX1=F;B<5:0?l00;m009H0UP0000068dB`0B`\n\
02d5X5k/02H80@4101P00BL?00400CZflK0000000000P0010000020D00000000\n\
000000?l1BP00000000004T400002004",
Magnification->1.25,
FrontEndVersion->"7.0 for Mac OS X x86 (32-bit) (February 18, 2009)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[545, 20, 918, 33, 138, "Text"],
Cell[1466, 55, 124, 1, 32, "Text"],
Cell[1593, 58, 160, 4, 33, "Input"],
Cell[1756, 64, 473, 13, 32, "Text"],
Cell[2232, 79, 101, 2, 33, "Input"],
Cell[2336, 83, 56, 0, 32, "Text"],
Cell[2395, 85, 118, 3, 33, "Input"],
Cell[2516, 90, 54, 0, 32, "Text"],
Cell[2573, 92, 116, 3, 33, "Input"],
Cell[2692, 97, 163, 3, 32, "Text"],
Cell[2858, 102, 133, 4, 53, "Input"],
Cell[2994, 108, 822, 12, 107, "Text"],
Cell[3819, 122, 181, 5, 53, "Input"],
Cell[4003, 129, 411, 6, 70, "Text"],
Cell[4417, 137, 111, 3, 33, "Input"],
Cell[4531, 142, 141, 2, 32, "Text"],
Cell[4675, 146, 67, 2, 33, "Input"],
Cell[4745, 150, 391, 6, 70, "Text"],
Cell[5139, 158, 67, 2, 33, "Input"],
Cell[5209, 162, 509, 7, 70, "Text"],
Cell[5721, 171, 71, 2, 33, "Input"],
Cell[5795, 175, 535, 8, 70, "Text"],
Cell[6333, 185, 79, 2, 33, "Input"],
Cell[6415, 189, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[6708, 197, 324, 6, 72, "Input"],
Cell[7035, 205, 515, 10, 45, "Print"],
Cell[7553, 217, 1075, 15, 197, "Print"],
Cell[8631, 234, 744, 12, 64, "Print"],
Cell[9378, 248, 460, 9, 25, "Print"],
Cell[9841, 259, 1079, 15, 197, "Print"],
Cell[10923, 276, 255, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[11215, 286, 50, 0, 33, "Input"],
Cell[11268, 288, 239, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[11544, 297, 45, 0, 33, "Input"],
Cell[11592, 299, 557, 15, 42, "Output"]
}, Open  ]],
Cell[12164, 317, 39, 0, 33, "Input"],
Cell[12206, 319, 324, 8, 33, "Output"],
Cell[CellGroupData[{
Cell[12555, 331, 41, 0, 33, "Input"],
Cell[12599, 333, 325, 8, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[12961, 346, 279, 4, 51, "Text"],
Cell[13243, 352, 47, 0, 33, "Input"],
Cell[13293, 354, 834, 13, 167, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[14164, 372, 124, 3, 33, "Input"],
Cell[14291, 377, 4859, 160, 118, "Output"]
}, Open  ]],
Cell[19165, 540, 57, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[19247, 544, 83, 1, 33, "Input"],
Cell[19333, 547, 188, 3, 33, "Output"]
}, Open  ]],
Cell[19536, 553, 161, 4, 32, "Text"],
Cell[19700, 559, 345, 11, 33, "Input"],
Cell[20048, 572, 4720, 148, 155, "Output"],
Cell[24771, 722, 413, 9, 53, "Input"],
Cell[25187, 733, 4959, 149, 124, "Output"],
Cell[30149, 884, 517, 11, 145, "Text"],
Cell[CellGroupData[{
Cell[30691, 899, 364, 7, 53, "Input"],
Cell[31058, 908, 924, 15, 83, "Print"],
Cell[31985, 925, 486, 7, 83, "Print"],
Cell[32474, 934, 401, 8, 25, "Print"],
Cell[32878, 944, 365, 7, 25, "Print"],
Cell[33246, 953, 388, 8, 25, "Print"],
Cell[33637, 963, 366, 5, 45, "Print"],
Cell[34006, 970, 403, 8, 25, "Print"],
Cell[34412, 980, 213, 3, 25, "Print"],
Cell[34628, 985, 255, 4, 25, "Print"],
Cell[34886, 991, 377, 7, 25, "Print"],
Cell[35266, 1000, 1131, 15, 235, "Print"],
Cell[36400, 1017, 255, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[36692, 1027, 150, 3, 32, "Text"],
Cell[36845, 1032, 38, 0, 33, "Input"],
Cell[36886, 1034, 295, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[37218, 1044, 141, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[37384, 1050, 38, 0, 33, "Input"],
Cell[37425, 1052, 269, 5, 33, "Output"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[37743, 1063, 144, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[37912, 1070, 115, 3, 33, "Input"],
Cell[38030, 1075, 664, 19, 54, "Output"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[38743, 1100, 143, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[38911, 1106, 115, 3, 33, "Input"],
Cell[39029, 1111, 464, 12, 53, "Output"]
}, Open  ]]
}, Open  ]],
Cell[39520, 1127, 865, 19, 107, "Text"],
Cell[40388, 1148, 230, 4, 32, "Text"],
Cell[40621, 1154, 258, 9, 33, "Input"],
Cell[40882, 1165, 162, 5, 33, "Input"],
Cell[41047, 1172, 173, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[41245, 1179, 87, 1, 33, "Input"],
Cell[41335, 1182, 1638, 45, 118, "Output"]
}, Open  ]],
Cell[42988, 1230, 336, 5, 51, "Text"],
Cell[CellGroupData[{
Cell[43349, 1239, 415, 13, 33, "Input"],
Cell[43767, 1254, 481, 13, 33, "Output"]
}, Open  ]],
Cell[44263, 1270, 144, 3, 32, "Text"],
Cell[44410, 1275, 296, 10, 33, "Input"],
Cell[44709, 1287, 162, 5, 33, "Input"],
Cell[44874, 1294, 173, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[45072, 1301, 53, 0, 33, "Input"],
Cell[45128, 1303, 1894, 54, 132, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[47059, 1362, 61, 1, 33, "Input"],
Cell[47123, 1365, 1227, 34, 99, "Output"]
}, Open  ]],
Cell[48365, 1402, 369, 6, 51, "Text"],
Cell[48737, 1410, 296, 10, 33, "Input"],
Cell[49036, 1422, 233, 7, 33, "Input"],
Cell[49272, 1431, 173, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[49470, 1438, 53, 0, 33, "Input"],
Cell[49526, 1440, 1642, 47, 132, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[51205, 1492, 61, 1, 33, "Input"],
Cell[51269, 1495, 420, 12, 91, "Output"]
}, Open  ]],
Cell[51704, 1510, 137, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[51866, 1516, 728, 21, 72, "Input"],
Cell[52597, 1539, 1343, 40, 91, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[53977, 1584, 61, 1, 33, "Input"],
Cell[54041, 1587, 269, 5, 33, "Output"]
}, Open  ]],
Cell[54325, 1595, 275, 4, 89, "Text"],
Cell[54603, 1601, 177, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[54805, 1608, 564, 20, 33, "Input"],
Cell[55372, 1630, 662, 22, 50, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[56071, 1657, 147, 2, 33, "Input"],
Cell[56221, 1661, 822, 26, 65, "Output"]
}, Open  ]],
Cell[57058, 1690, 191, 4, 53, "Input"],
Cell[57252, 1696, 575, 8, 102, "Print"],
Cell[CellGroupData[{
Cell[57852, 1708, 77, 1, 33, "Input"],
Cell[57932, 1711, 3662, 100, 131, "Output"]
}, Open  ]],
Cell[61609, 1814, 151, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[61785, 1821, 112, 2, 33, "Input"],
Cell[61900, 1825, 3068, 84, 127, "Output"]
}, Open  ]],
Cell[64983, 1912, 197, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[65205, 1919, 66, 1, 33, "Input"],
Cell[65274, 1922, 197, 3, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
