(* 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[     55659,       1630]
NotebookOptionsPosition[     49902,       1450]
NotebookOutlinePosition[     50733,       1479]
CellTagsIndexPosition[     50690,       1476]
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],
 Cell[BoxData[
  FormBox["Yxx", TraditionalForm]],
  FontSize->14],
 StyleBox["+",
  FontSize->14],
 Cell[BoxData[
  FormBox["bYx", TraditionalForm]],
  FontSize->14],
 StyleBox["+(2b^2/9)Y+cY^3=0. \n\nThis equation is discussed by Adam and \
Mahomed in a paper \"A Nonlocal Symmetry Method for First-order Equations\".  \
that appears in Modern Group Analysis VI, page 315. This notebook illustrates \
the use of Mathematica built-in functions to find the final form of the \
infinitesimals that turn out to contain the exponential.",
  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.4720470053807*^9, 
  3.472047005915535*^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", 
   "\"\<y''[x]+b*y'[x]+(2*b^2/9)*y[x]+c*y[x]^3\>\""}], ";"}]], "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. Enter the rule as a string.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"rulesarray", "=", "\[IndentingNewLine]", 
   RowBox[{"{", "\"\<y''[x]->-b*y'[x]-(2*b^2/9)*y[x]-c*y[x]^3\>\"", "}"}]}], 
  ";"}]], "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[{"{", 
    RowBox[{"\"\<b\>\"", ",", "\"\<c\>\""}], "}"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.4694014561060534`*^9, 3.4694014655987053`*^9}}],

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 = \\!\\(26578040\\), the time used = \
\\!\\(6.8718509999999995`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 26578040, 6.8718509999999995`],
  Editable->False]], "Print",
 CellChangeTimes->{
  3.469401530051936*^9, 3.471554684587878*^9, {3.4715771562941847`*^9, 
   3.471577176272928*^9}, 3.483651170102921*^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.469401530051936*^9, 3.471554684587878*^9, {3.4715771562941847`*^9, 
   3.471577176272928*^9}, 3.483651170159816*^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 = \\!\\(840\\), the memory in use = \
\\!\\(26553720\\), the time used = \\!\\(6.920217999999999`\\)\"\>",
  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, 840, 26553720, 
   6.920217999999999],
  Editable->False]], "Print",
 CellChangeTimes->{
  3.469401530051936*^9, 3.471554684587878*^9, {3.4715771562941847`*^9, 
   3.471577176272928*^9}, 3.483651170162764*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(26554464\\), the time used = \\!\\(6.920421`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 26554464, 6.920421],
  Editable->False]], "Print",
 CellChangeTimes->{
  3.469401530051936*^9, 3.471554684587878*^9, {3.4715771562941847`*^9, 
   3.471577176272928*^9}, 3.483651170165023*^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.469401530051936*^9, 3.471554684587878*^9, {3.4715771562941847`*^9, 
   3.471577176272928*^9}, 3.483651170167124*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.049298000000000286`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{
  3.469401530074337*^9, 3.471554684625142*^9, {3.4715771563318996`*^9, 
   3.471577176344573*^9}, 3.483651170170002*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"y1''[x1]+b*y1'[x1]+(2*b^2/9)*y1[x1]+c*y1[x1]^3\"\>"], \
"Output",
 CellChangeTimes->{
  3.4694015301222982`*^9, 3.471554684661422*^9, {3.471577156368105*^9, 
   3.471577176391*^9}, 3.483651170206005*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0", ",", 
   RowBox[{
    FractionBox[
     RowBox[{"2", " ", 
      SuperscriptBox["b", "2"]}], "9"], "+", 
    RowBox[{"3", " ", "c", " ", 
     SuperscriptBox[
      RowBox[{"y1", "[", "x1", "]"}], "2"]}]}], ",", "b", ",", "1"}], 
  "}"}]], "Output",
 CellChangeTimes->{
  3.469401530154594*^9, 3.4715546847079897`*^9, {3.471577156414195*^9, 
   3.471577176446163*^9}, 3.483651170260549*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{
  3.4694015302099247`*^9, 3.471554684761999*^9, {3.471577156467987*^9, 
   3.471577176492346*^9}, 3.4836511703057127`*^9}],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"x1", "\[Rule]", "z1"}], ",", 
   RowBox[{
    RowBox[{"y1", "[", "x1", "]"}], "\[Rule]", "z2"}]}], "}"}]], "Output",
 CellChangeTimes->{
  3.4694015302558947`*^9, 3.471554684808675*^9, {3.4715771565141897`*^9, 
   3.471577176546372*^9}, 3.4836511703601923`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Here are the determining equations expressed in terms \
of z-variables. 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[{"\<\"-9*Derivative[0, 2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"18*b*Derivative[0, 1][xse1][z1, z2] + 9*Derivative[0, \
2][eta1][z1, z2] - 18*Derivative[1, 1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"2*b^2*eta1[z1, z2] + 27*c*z2^2*eta1[z1, z2] - \
2*b^2*z2*Derivative[0, 1][eta1][z1, z2] - 9*c*z2^3*Derivative[0, 1][eta1][z1, \
z2] + 9*b*Derivative[1, 0][eta1][z1, z2] + 4*b^2*z2*Derivative[1, \
0][xse1][z1, z2] + 18*c*z2^3*Derivative[1, 0][xse1][z1, z2] + 9*Derivative[2, \
0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"6*b^2*z2*Derivative[0, 1][xse1][z1, z2] + \
27*c*z2^3*Derivative[0, 1][xse1][z1, z2] + 9*b*Derivative[1, 0][xse1][z1, z2] \
+ 18*Derivative[1, 1][eta1][z1, z2] - 9*Derivative[2, 0][xse1][z1, z2] == 0\"\
\>"}], "}"}]], "Output",
 CellChangeTimes->{
  3.46940153031026*^9, 3.471554684862343*^9, {3.471577156568769*^9, 
   3.47157717657903*^9}, 3.483651170406292*^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.469401530355691*^9, 3.4715546849085913`*^9, {3.471577156614616*^9, 
   3.471577176624819*^9}, 3.4836511704609013`*^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[{"-", "9"}], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"18", " ", "b", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"9", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"18", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"2", " ", 
        SuperscriptBox["b", "2"], " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"27", " ", "c", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["b", "2"], " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"9", " ", "c", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"9", " ", "b", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"4", " ", 
        SuperscriptBox["b", "2"], " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"18", " ", "c", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"9", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"6", " ", 
        SuperscriptBox["b", "2"], " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"27", " ", "c", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"9", " ", "b", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"18", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"9", " ", 
        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.469401530411628*^9, 3.4715546849666348`*^9, {3.47157715667293*^9, 
   3.4715771766812963`*^9}, 3.4836511705071793`*^9}],

Cell["\<\
Now 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", 
    ",", "zdeterminingequations", ",", 
    RowBox[{"order", "=", "4"}]}], "]"}], "]"}]], "Input"],

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.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.483651170556471*^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.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.4836511705588617`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26660400\\), The time = \\!\
\\(6.9449570000000005`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26660400, 6.9449570000000005`],
  Editable->False]], "Print",
 CellChangeTimes->{
  3.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.483651170560623*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(30\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 30],
  Editable->False]], "Print",
 CellChangeTimes->{
  3.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.483651170562187*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(61\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 61],
  Editable->False]], "Print",
 CellChangeTimes->{
  3.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.4836511705637283`*^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.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.483651170565248*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26683872\\), The time = \\!\
\\(6.948039`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26683872, 6.948039],
  Editable->False]], "Print",
 CellChangeTimes->{
  3.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.483651170566903*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{
  3.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.483651170568388*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{
  3.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.4836511705698557`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26725808\\), The time = \\!\
\\(6.954228`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26725808, 6.954228],
  Editable->False]], "Print",
 CellChangeTimes->{
  3.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.483651170571353*^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.469401530460792*^9, 3.471554685008985*^9, {3.471577156716647*^9, 
   3.471577176729665*^9}, 3.4836511705728493`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.026508999999999894`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{
  3.4694015304645987`*^9, 3.471554685020537*^9, {3.4715771567284517`*^9, 
   3.4715771767411537`*^9}, 3.483651170575162*^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_]=a10\"\>", "}"}]], "Output",
 CellChangeTimes->{
  3.469401530506892*^9, 3.47155468505863*^9, {3.471577156764817*^9, 
   3.471577176796377*^9}, 3.483651170610174*^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_]=0\"\>", "}"}]], "Output",
 CellChangeTimes->{
  3.4694015305613823`*^9, 3.4715546851125097`*^9, {3.471577156819227*^9, 
   3.47157717684198*^9}, 3.483651170656839*^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[BoxData[
 RowBox[{
  RowBox[{"ToExpression", "[", "xsefunctions", "]"}], "/.", 
  "ztableofrules"}]], "Input"],

Cell[BoxData[
 RowBox[{"{", "a10", "}"}]], "Output",
 CellChangeTimes->{
  3.469401530609302*^9, 3.471554685158187*^9, {3.4715771568650103`*^9, 
   3.471577176897393*^9}, 3.483651170711054*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", "0", "}"}]], "Output",
 CellChangeTimes->{
  3.469401530661289*^9, 3.471554685213743*^9, {3.471577156918828*^9, 
   3.471577176943349*^9}, 3.483651170761137*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData["infinitesimalgroups"], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"{", "1", "}"}], ",", 
    RowBox[{"{", "0", "}"}]}], "}"}], "}"}]], "Output",
 CellChangeTimes->{
  3.469401530706633*^9, 3.471554685259706*^9, {3.4715771569656*^9, 
   3.4715771770716476`*^9}, 3.483651170812516*^9}]
}, Open  ]],

Cell[TextData[{
 StyleBox["This process has captured the group (xse,eta)=(1, 0) corresponding \
to the parameter a10. But this equation contains an additional group. The \
determining equations themselves are correct but the ",
  FontWeight->"Plain"],
 "SolveDeterminingEquations",
 StyleBox[" function is incapable of identifying the second group of this \
equation which  contains the exponential.",
  FontWeight->"Plain"]
}], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[StyleBox["Considering the last two determining equations, use \
the following to simplify the system of determining equations.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[BoxData[
 RowBox[{
  RowBox[{"eta1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{"z2", "*", 
   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[
 TagBox[GridBox[{
    {"True"},
    {"True"},
    {
     RowBox[{
      RowBox[{
       RowBox[{"18", " ", "c", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{"g", "[", "z1", "]"}]}], "+", 
       RowBox[{"4", " ", 
        SuperscriptBox["b", "2"], " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["f", "\[Prime]",
          MultilineFunction->None], "[", "z1", "]"}]}], "+", 
       RowBox[{"18", " ", "c", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["f", "\[Prime]",
          MultilineFunction->None], "[", "z1", "]"}]}], "+", 
       RowBox[{"9", " ", "b", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["g", "\[Prime]",
          MultilineFunction->None], "[", "z1", "]"}]}], "+", 
       RowBox[{"9", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["g", "\[Prime]\[Prime]",
          MultilineFunction->None], "[", "z1", "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"9", " ", "b", " ", 
        RowBox[{
         SuperscriptBox["f", "\[Prime]",
          MultilineFunction->None], "[", "z1", "]"}]}], "+", 
       RowBox[{"18", " ", 
        RowBox[{
         SuperscriptBox["g", "\[Prime]",
          MultilineFunction->None], "[", "z1", "]"}]}], "-", 
       RowBox[{"9", " ", 
        RowBox[{
         SuperscriptBox["f", "\[Prime]\[Prime]",
          MultilineFunction->None], "[", "z1", "]"}]}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{
  3.4694015308699007`*^9, 3.4715546854875517`*^9, {3.471577157128522*^9, 
   3.471577177172002*^9}, 3.483651171043645*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The first determining equation splits into two. The \
terms multiplying z2^3 imply f'=-g. Mathematica has the capability of solving \
the equation formed by the terms multiplied by z2.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"DSolve", "[", 
  RowBox[{
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{"g", "''"}], "[", "z1", "]"}], "+", 
     RowBox[{"b", "*", 
      RowBox[{
       RowBox[{"g", "'"}], "[", "z1", "]"}]}], "-", 
     RowBox[{
      RowBox[{"(", 
       RowBox[{"4", "*", 
        RowBox[{
         RowBox[{"b", "^", "2"}], "/", "9"}]}], ")"}], "*", 
      RowBox[{"g", "[", "z1", "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{"g", "[", "z1", "]"}], ",", "z1"}], "]"}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"g", "[", "z1", "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{
      SuperscriptBox["\[ExponentialE]", 
       RowBox[{"-", 
        FractionBox[
         RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]], " ", 
      RowBox[{"C", "[", "1", "]"}]}], "+", 
     RowBox[{
      SuperscriptBox["\[ExponentialE]", 
       FractionBox[
        RowBox[{"b", " ", "z1"}], "3"]], " ", 
      RowBox[{"C", "[", "2", "]"}]}]}]}], "}"}], "}"}]], "Output",
 CellChangeTimes->{
  3.4694015309178963`*^9, 3.471554685544465*^9, {3.4715771572119913`*^9, 
   3.471577177210231*^9}, 3.483651171300124*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{
  RowBox[{"xse1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{"a", "+", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{"3", "/", 
      RowBox[{"(", 
       RowBox[{"4", "*", "b"}], ")"}]}], ")"}], "*", "c1", "*", 
    RowBox[{"Exp", "[", 
     RowBox[{
      RowBox[{"-", "4"}], "*", "b", "*", 
      RowBox[{"z1", "/", "3"}]}], "]"}]}], "-", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{"3", "/", "b"}], ")"}], "*", "c2", "*", 
    RowBox[{"Exp", "[", 
     RowBox[{"b", "*", 
      RowBox[{"z1", "/", "3"}]}], "]"}]}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"eta1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{
   RowBox[{"z2", "*", "c1", "*", 
    RowBox[{"Exp", "[", 
     RowBox[{
      RowBox[{"-", "4"}], "*", "b", "*", 
      RowBox[{"z1", "/", "3"}]}], "]"}]}], "+", 
   RowBox[{"z2", "*", "c2", "*", 
    RowBox[{"Exp", "[", 
     RowBox[{"b", "*", 
      RowBox[{"z1", "/", "3"}]}], "]"}]}]}]}]], "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[
 TagBox[GridBox[{
    {"True"},
    {"True"},
    {
     RowBox[{
      RowBox[{
       RowBox[{"4", " ", 
        SuperscriptBox["b", "2"], " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{
           RowBox[{"-", "c1"}], " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]]}], "-", 
          RowBox[{"c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]]}]}], ")"}], " ", "z2"}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["b", "2"], " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{"c1", " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]]}], "+", 
          RowBox[{"c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]]}]}], ")"}], " ", "z2"}], "+", 
       RowBox[{"18", " ", "c", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{
           RowBox[{"-", "c1"}], " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]]}], "-", 
          RowBox[{"c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]]}]}], ")"}], " ", 
        SuperscriptBox["z2", "3"]}], "-", 
       RowBox[{"9", " ", "c", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{"c1", " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]]}], "+", 
          RowBox[{"c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]]}]}], ")"}], " ", 
        SuperscriptBox["z2", "3"]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["b", "2"], " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{"c1", " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]], " ", "z2"}], "+", 
          RowBox[{"c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]], " ", "z2"}]}], ")"}]}], "+", 
       RowBox[{"27", " ", "c", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{"c1", " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]], " ", "z2"}], "+", 
          RowBox[{"c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]], " ", "z2"}]}], ")"}]}], "+", 
       RowBox[{"9", " ", "b", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{
           RowBox[{"-", 
            FractionBox["4", "3"]}], " ", "b", " ", "c1", " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]], " ", "z2"}], "+", 
          RowBox[{
           FractionBox["1", "3"], " ", "b", " ", "c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]], " ", "z2"}]}], ")"}]}], "+", 
       RowBox[{"9", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{
           FractionBox["16", "9"], " ", 
           SuperscriptBox["b", "2"], " ", "c1", " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]], " ", "z2"}], "+", 
          RowBox[{
           FractionBox["1", "9"], " ", 
           SuperscriptBox["b", "2"], " ", "c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]], " ", "z2"}]}], ")"}]}]}], 
      "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"9", " ", "b", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{
           RowBox[{"-", "c1"}], " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]]}], "-", 
          RowBox[{"c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]]}]}], ")"}]}], "-", 
       RowBox[{"9", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{
           FractionBox["4", "3"], " ", "b", " ", "c1", " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]]}], "-", 
          RowBox[{
           FractionBox["1", "3"], " ", "b", " ", "c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]]}]}], ")"}]}], "+", 
       RowBox[{"18", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{
           RowBox[{"-", 
            FractionBox["4", "3"]}], " ", "b", " ", "c1", " ", 
           SuperscriptBox["\[ExponentialE]", 
            RowBox[{"-", 
             FractionBox[
              RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]]}], "+", 
          RowBox[{
           FractionBox["1", "3"], " ", "b", " ", "c2", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "z1"}], "3"]]}]}], ")"}]}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{
  3.469401531005404*^9, 3.471554685641369*^9, {3.471577157314345*^9, 
   3.47157717732286*^9}, 3.483651171387944*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 TagBox[GridBox[{
    {"True"},
    {"True"},
    {"True"},
    {
     RowBox[{
      RowBox[{"b", " ", "c1", " ", 
       SuperscriptBox["\[ExponentialE]", 
        RowBox[{"-", 
         FractionBox[
          RowBox[{"4", " ", "b", " ", "z1"}], "3"]}]]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{
  3.469401531045866*^9, 3.471554685689431*^9, {3.471577157354127*^9, 
   3.471577177360537*^9}, 3.4836511714523287`*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The second equation can only be satisfied if c1=0. \
Finally,",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"xse1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{"a", "-", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{"3", "/", "b"}], ")"}], "*", "c2", "*", 
    RowBox[{"Exp", "[", 
     RowBox[{"b", "*", 
      RowBox[{"z1", "/", "3"}]}], "]"}]}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"eta1", "[", 
   RowBox[{"z1_", ",", "z2_"}], "]"}], ":=", 
  RowBox[{"z2", "*", "c2", "*", 
   RowBox[{"Exp", "[", 
    RowBox[{"b", "*", 
     RowBox[{"z1", "/", "3"}]}], "]"}]}]}]], "Input"],

Cell[CellGroupData[{

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

Cell[BoxData[
 TagBox[GridBox[{
    {"True"},
    {"True"},
    {"True"},
    {"True"}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{
  3.46940153115307*^9, 3.4715546857703323`*^9, {3.471577157461288*^9, 
   3.471577177471964*^9}, 3.483651171571479*^9}]
}, Open  ]],

Cell[TextData[StyleBox["Finally, the infinitesimals that leave the original \
ODE invariant are\nxse[x,y]=-a-(3/b) c2 Exp[bx/3]\neta[x,y]=c2 y Exp[bx/3]",
 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[{"{", "1", "}"}], ",", 
      RowBox[{"{", "0", "}"}]}], "}"}], ",", 
    RowBox[{"{", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{
        RowBox[{"-", 
         RowBox[{"(", 
          RowBox[{"3", "/", "b"}], ")"}]}], "*", 
        RowBox[{"Exp", "[", 
         RowBox[{"b", "*", 
          RowBox[{"x", "/", "3"}]}], "]"}]}], "}"}], ",", 
      RowBox[{"{", 
       RowBox[{"y", "*", 
        RowBox[{"Exp", "[", 
         RowBox[{"b", "*", 
          RowBox[{"x", "/", "3"}]}], "]"}]}], "}"}]}], "}"}]}], 
   "}"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "1", "}"}], ",", 
     RowBox[{"{", "0", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"-", 
       FractionBox[
        RowBox[{"3", " ", 
         SuperscriptBox["\[ExponentialE]", 
          FractionBox[
           RowBox[{"b", " ", "x"}], "3"]]}], "b"]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       SuperscriptBox["\[ExponentialE]", 
        FractionBox[
         RowBox[{"b", " ", "x"}], "3"]], " ", "y"}], "}"}]}], "}"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{
  3.469401531191744*^9, 3.47155468582804*^9, {3.471577157500371*^9, 
   3.471577177510536*^9}, 3.4836511716375923`*^9}]
}, Open  ]],

Cell[BoxData[
 RowBox[{"Column", "[", "infinitesimalgroupsxy", "]"}]], "Input"],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "1", "}"}], ",", 
       RowBox[{"{", "0", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"-", 
         FractionBox[
          RowBox[{"3", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "x"}], "3"]]}], "b"]}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         SuperscriptBox["\[ExponentialE]", 
          FractionBox[
           RowBox[{"b", " ", "x"}], "3"]], " ", "y"}], "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{
  3.469401531246379*^9, 3.4715546858789473`*^9, {3.4715771575543413`*^9, 
   3.471577177565217*^9}, 3.483651171688325*^9}],

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.4694015312918873`*^9, 3.471554685924321*^9, {3.471577157600664*^9, 
   3.471577177615532*^9}, 3.483651171738221*^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[{"-", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "x"}], "3"]]}]},
         {
          RowBox[{
           FractionBox["1", "3"], " ", "b", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "x"}], "3"]], " ", "y"}]}
        },
        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[{
         {
          SuperscriptBox["\[ExponentialE]", 
           FractionBox[
            RowBox[{"b", " ", "x"}], "3"]]},
         {
          RowBox[{
           RowBox[{"-", 
            FractionBox["1", "3"]}], " ", "b", " ", 
           SuperscriptBox["\[ExponentialE]", 
            FractionBox[
             RowBox[{"b", " ", "x"}], "3"]], " ", "y"}]}
        },
        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.4694015313467503`*^9, 3.4715546859807777`*^9, {3.471577157656534*^9, 
   3.471577177661851*^9}, 3.4836511717885*^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["30388568"], "Output",
 CellChangeTimes->{
  3.4694015313919897`*^9, 3.471554686023013*^9, {3.471577157699725*^9, 
   3.4715771776987143`*^9}, 3.4836511718371677`*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{974, 1050},
WindowMargins->{{60, Automatic}, {49, Automatic}},
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, 848, 22, 180, "Text"],
Cell[1396, 44, 124, 1, 32, "Text"],
Cell[1523, 47, 160, 4, 33, "Input"],
Cell[1686, 53, 472, 13, 32, "Text"],
Cell[2161, 68, 101, 2, 33, "Input"],
Cell[2265, 72, 56, 0, 32, "Text"],
Cell[2324, 74, 118, 3, 33, "Input"],
Cell[2445, 79, 54, 0, 32, "Text"],
Cell[2502, 81, 116, 3, 33, "Input"],
Cell[2621, 86, 163, 3, 32, "Text"],
Cell[2787, 91, 137, 4, 53, "Input"],
Cell[2927, 97, 280, 4, 51, "Text"],
Cell[3210, 103, 173, 4, 53, "Input"],
Cell[3386, 109, 411, 6, 70, "Text"],
Cell[3800, 117, 212, 5, 33, "Input"],
Cell[4015, 124, 141, 2, 32, "Text"],
Cell[4159, 128, 67, 2, 33, "Input"],
Cell[4229, 132, 391, 6, 70, "Text"],
Cell[4623, 140, 67, 2, 33, "Input"],
Cell[4693, 144, 509, 7, 70, "Text"],
Cell[5205, 153, 71, 2, 33, "Input"],
Cell[5279, 157, 535, 8, 89, "Text"],
Cell[5817, 167, 79, 2, 33, "Input"],
Cell[5899, 171, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[6192, 179, 324, 6, 72, "Input"],
Cell[6519, 187, 498, 10, 45, "Print"],
Cell[7020, 199, 1058, 15, 197, "Print"],
Cell[8081, 216, 747, 13, 64, "Print"],
Cell[8831, 231, 443, 9, 25, "Print"],
Cell[9277, 242, 1060, 15, 216, "Print"],
Cell[10340, 259, 237, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10614, 269, 50, 0, 33, "Input"],
Cell[10667, 271, 221, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10925, 280, 45, 0, 33, "Input"],
Cell[10973, 282, 434, 13, 58, "Output"]
}, Open  ]],
Cell[11422, 298, 39, 0, 33, "Input"],
Cell[11464, 300, 308, 8, 33, "Output"],
Cell[CellGroupData[{
Cell[11797, 312, 41, 0, 33, "Input"],
Cell[11841, 314, 313, 8, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[12191, 327, 247, 4, 51, "Text"],
Cell[12441, 333, 47, 0, 33, "Input"],
Cell[12491, 335, 919, 16, 205, "Output"]
}, Open  ]],
Cell[13425, 354, 57, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[13507, 358, 83, 1, 33, "Input"],
Cell[13593, 361, 171, 3, 33, "Output"]
}, Open  ]],
Cell[13779, 367, 161, 4, 32, "Text"],
Cell[13943, 373, 345, 11, 33, "Input"],
Cell[14291, 386, 5395, 169, 155, "Output"],
Cell[19689, 557, 511, 11, 145, "Text"],
Cell[CellGroupData[{
Cell[20225, 572, 273, 6, 53, "Input"],
Cell[20501, 580, 905, 15, 83, "Print"],
Cell[21409, 597, 469, 7, 83, "Print"],
Cell[21881, 606, 382, 8, 25, "Print"],
Cell[22266, 616, 346, 7, 25, "Print"],
Cell[22615, 625, 371, 8, 25, "Print"],
Cell[22989, 635, 347, 5, 45, "Print"],
Cell[23339, 642, 358, 7, 25, "Print"],
Cell[23700, 651, 192, 3, 25, "Print"],
Cell[23895, 656, 238, 4, 25, "Print"],
Cell[24136, 662, 358, 7, 25, "Print"],
Cell[24497, 671, 1115, 15, 235, "Print"],
Cell[25615, 688, 241, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[25893, 698, 150, 3, 32, "Text"],
Cell[26046, 703, 38, 0, 33, "Input"],
Cell[26087, 705, 213, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[26337, 714, 141, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[26503, 720, 38, 0, 33, "Input"],
Cell[26544, 722, 215, 4, 33, "Output"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[26808, 732, 144, 3, 32, "Text"],
Cell[26955, 737, 115, 3, 33, "Input"],
Cell[27073, 742, 193, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[27303, 751, 143, 2, 32, "Text"],
Cell[27449, 755, 115, 3, 33, "Input"],
Cell[27567, 760, 189, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[27793, 769, 45, 0, 33, "Input"],
Cell[27841, 771, 286, 8, 33, "Output"]
}, Open  ]],
Cell[28142, 782, 468, 10, 70, "Text"],
Cell[28613, 794, 206, 3, 32, "Text"],
Cell[28822, 799, 162, 5, 33, "Input"],
Cell[28987, 806, 163, 5, 33, "Input"],
Cell[29153, 813, 173, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[29351, 820, 53, 0, 33, "Input"],
Cell[29407, 822, 1785, 49, 95, "Output"]
}, Open  ]],
Cell[31207, 874, 274, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[31506, 882, 499, 16, 33, "Input"],
Cell[32008, 900, 649, 19, 54, "Output"]
}, Open  ]],
Cell[32672, 922, 131, 2, 32, "Text"],
Cell[32806, 926, 573, 19, 33, "Input"],
Cell[33382, 947, 408, 13, 33, "Input"],
Cell[33793, 962, 173, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[33991, 969, 53, 0, 33, "Input"],
Cell[34047, 971, 6185, 170, 253, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[40269, 1146, 61, 1, 33, "Input"],
Cell[40333, 1149, 605, 18, 105, "Output"]
}, Open  ]],
Cell[40953, 1170, 151, 3, 32, "Text"],
Cell[41107, 1175, 304, 10, 33, "Input"],
Cell[41414, 1187, 227, 7, 33, "Input"],
Cell[CellGroupData[{
Cell[41666, 1198, 53, 0, 33, "Input"],
Cell[41722, 1200, 399, 12, 91, "Output"]
}, Open  ]],
Cell[42136, 1215, 218, 3, 70, "Text"],
Cell[42357, 1220, 177, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[42559, 1227, 665, 23, 33, "Input"],
Cell[43227, 1252, 728, 24, 68, "Output"]
}, Open  ]],
Cell[43970, 1279, 79, 1, 33, "Input"],
Cell[44052, 1282, 895, 28, 81, "Output"],
Cell[44950, 1312, 191, 4, 53, "Input"],
Cell[45144, 1318, 556, 8, 102, "Print"],
Cell[CellGroupData[{
Cell[45725, 1330, 77, 1, 33, "Input"],
Cell[45805, 1333, 3595, 98, 179, "Output"]
}, Open  ]],
Cell[49415, 1434, 197, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[49637, 1441, 66, 1, 33, "Input"],
Cell[49706, 1444, 180, 3, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
