(* 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[     51148,       1504]
NotebookOptionsPosition[     46415,       1355]
NotebookOutlinePosition[     47191,       1382]
CellTagsIndexPosition[     47148,       1379]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[StyleBox["In this example we use the package IntroToSymmetry.m \
to work out the first order Lie-Backlund symmetries of the axisymmetric wave \
equation,\n\n r*Utt-r*Urr-Ur=0.",
 FontSize->14,
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
This next command turns off spurious spelling error warnings.\
\>", "Text"],

Cell[BoxData[
 RowBox[{"Off", "[", 
  RowBox[{"General", "::", "spell"}], "]"}]], "Input"],

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.4720466725423717`*^9, 
  3.472046673357225*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"Needs", "[", "\"\<SymmetryAnalysis`IntroToSymmetry`\>\"", 
  "]"}]], "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", 
   "\"\<r*D[u[r,t],t,t]-r*D[u[r,t],r,r]-D[u[r,t],r]\>\""}], ";"}]], "Input"],

Cell[TextData[StyleBox["The function u[r,t] is a solution of the equation and \
this constraint must be applied in the form of a rule to the invariance \
condition. Be careful to check signs. Also be careful to set the rule up so \
that a second derivative is replaced and not a first derivative. This is \
necessary because the infinitesimals are now assumed to depend on first \
derivatives and these need to be free independent variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"rulesarray", "=", "\[IndentingNewLine]", 
   RowBox[{
   "{", "\"\<D[u[r,t],r,r]->D[u[r,t],t,t]-(1/r)*D[u[r,t],r]\>\"", "}"}]}], 
  ";"}]], "Input"],

Cell[TextData[StyleBox["Enter the list of independent variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[TextData[StyleBox["Enter the list of dependent variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[TextData[StyleBox["Enter the list of function and/or constant names that \
have to be preserved when the equation is transformed to generic y1[x1,x2] \
variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

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

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

Cell[TextData[StyleBox["The maximum derivative order that the infinitesimals \
are assumed to depend on is specified by the input parameter rorder. 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 set r=0.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[TextData[StyleBox["When searching for Lie-Backlund groups (rorder=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", "=", "0"}], ";"}]], "Input"],

Cell[TextData[StyleBox["When searching for Lie-Backlund groups it is \
necessary to differentiate the input equation with respect to each \
independent variable 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", "=", "1"}], ";"}]], "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", "[", "\[IndentingNewLine]", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "frozennames", ",",
     "porder", ",", "rorder", ",", "xseon", ",", "inputequation", ",", 
    "rulesarray", ",", "internalrules"}], "]"}], "]"}]], "Input"],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(45384288\\), the time used = \\!\\(78.30427`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 45384288, 78.30427],
  Editable->False]], "Print",
 CellChangeTimes->{3.469480051520097*^9, 3.469480147503635*^9, 
  3.4715720658739243`*^9, 3.4837886129213133`*^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.469480051520097*^9, 3.469480147503635*^9, 
  3.4715720658739243`*^9, 3.4837886129991903`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(5\\), the \
byte count of zdeterminingequations = \\!\\(1808\\), the memory in use = \
\\!\\(43949704\\), the time used = \\!\\(78.404724`\\)\"\>",
  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 = ``", 5, 1808, 43949704, 
   78.404724],
  Editable->False]], "Print",
 CellChangeTimes->{3.469480051520097*^9, 3.469480147503635*^9, 
  3.4715720658739243`*^9, 3.483788613028984*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(43952320\\), the time used = \\!\\(78.40508000000001`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 43952320, 78.40508000000001],
  Editable->False]], "Print",
 CellChangeTimes->{3.469480051520097*^9, 3.469480147503635*^9, 
  3.4715720658739243`*^9, 3.483788613030993*^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.469480051520097*^9, 3.469480147503635*^9, 
  3.4715720658739243`*^9, 3.483788613032804*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.10168500000000336`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.4694800516507797`*^9, 3.469480147634944*^9, 
  3.471572065981545*^9, 3.483788613035387*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData["rulesarrayexpanded"], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"2", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"x1", ",", "x2"}], "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{
      SuperscriptBox["y1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"0", ",", "2"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x1", ",", "x2"}], "]"}], "-", 
     FractionBox[
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x1", ",", "x2"}], "]"}], "x1"]}]}], ",", 
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"3", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"x1", ",", "x2"}], "]"}], "\[Rule]", 
    RowBox[{
     FractionBox[
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x1", ",", "x2"}], "]"}], 
      SuperscriptBox["x1", "2"]], "+", 
     RowBox[{
      SuperscriptBox["y1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"1", ",", "2"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x1", ",", "x2"}], "]"}], "-", 
     FractionBox[
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x1", ",", "x2"}], "]"}], "x1"]}]}], ",", 
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"2", ",", "1"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"x1", ",", "x2"}], "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{
      SuperscriptBox["y1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"0", ",", "3"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x1", ",", "x2"}], "]"}], "-", 
     FractionBox[
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x1", ",", "x2"}], "]"}], "x1"]}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.46948005169313*^9, 3.469480147695957*^9, 
  3.4715720660093737`*^9, 3.483788613063139*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"x1*D[y1[x1,x2],x2,x2]-x1*D[y1[x1,x2],x1,x1]-D[y1[x1,x2],x1]\
\"\>"], "Output",
 CellChangeTimes->{3.469480051746355*^9, 3.469480147762562*^9, 
  3.4715720660462847`*^9, 3.483788613108482*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"0", ",", "2"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"x1", ",", "x2"}], "]"}], "-", 
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"2", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"x1", ",", "x2"}], "]"}]}], ",", "0", ",", "0", ",", 
   RowBox[{"-", "1"}], ",", "0", ",", 
   RowBox[{"-", "x1"}], ",", "0", ",", "x1"}], "}"}]], "Output",
 CellChangeTimes->{3.4694800517927322`*^9, 3.469480147829625*^9, 
  3.471572066075738*^9, 3.4837886131423883`*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "r"}], ",", 
   RowBox[{"z2", "\[Rule]", "t"}], ",", 
   RowBox[{"z3", "\[Rule]", 
    RowBox[{"u", "[", 
     RowBox[{"r", ",", "t"}], "]"}]}], ",", 
   RowBox[{"z4", "\[Rule]", 
    RowBox[{
     SuperscriptBox["u", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"1", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"r", ",", "t"}], "]"}]}], ",", 
   RowBox[{"z5", "\[Rule]", 
    RowBox[{
     SuperscriptBox["u", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"0", ",", "1"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"r", ",", "t"}], "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.4694800518465967`*^9, 3.4694801478965178`*^9, 
  3.471572066113529*^9, 3.483788613178626*^9}],

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, 0, 0, 0, 2][eta1][z1, z2, z3, z4, z5] - \
z1^2*Derivative[0, 0, 0, 2, 0][eta1][z1, z2, z3, z4, z5] == 0\"\>", 
   ",", "\<\"-(z1^2*Derivative[0, 0, 0, 0, 2][eta1][z1, z2, z3, z4, z5]) + \
z1^2*Derivative[0, 0, 0, 2, 0][eta1][z1, z2, z3, z4, z5] == 0\"\>", 
   ",", "\<\"2*z1*z4*Derivative[0, 0, 0, 1, 1][eta1][z1, z2, z3, z4, z5] - \
2*z1^2*z4*Derivative[0, 0, 1, 0, 1][eta1][z1, z2, z3, z4, z5] + \
2*z1^2*z5*Derivative[0, 0, 1, 1, 0][eta1][z1, z2, z3, z4, z5] + \
2*z1^2*Derivative[0, 1, 0, 1, 0][eta1][z1, z2, z3, z4, z5] - \
2*z1^2*Derivative[1, 0, 0, 0, 1][eta1][z1, z2, z3, z4, z5] == 0\"\>", 
   ",", "\<\"2*z1*z4*Derivative[0, 0, 0, 2, 0][eta1][z1, z2, z3, z4, z5] + \
2*z1^2*z5*Derivative[0, 0, 1, 0, 1][eta1][z1, z2, z3, z4, z5] - \
2*z1^2*z4*Derivative[0, 0, 1, 1, 0][eta1][z1, z2, z3, z4, z5] + \
2*z1^2*Derivative[0, 1, 0, 0, 1][eta1][z1, z2, z3, z4, z5] - \
2*z1^2*Derivative[1, 0, 0, 1, 0][eta1][z1, z2, z3, z4, z5] == 0\"\>", 
   ",", "\<\"-(z4*Derivative[0, 0, 0, 1, 0][eta1][z1, z2, z3, z4, z5]) - \
z4^2*Derivative[0, 0, 0, 2, 0][eta1][z1, z2, z3, z4, z5] + \
2*z1*z4^2*Derivative[0, 0, 1, 1, 0][eta1][z1, z2, z3, z4, z5] - \
z1^2*z4^2*Derivative[0, 0, 2, 0, 0][eta1][z1, z2, z3, z4, z5] + \
z1^2*z5^2*Derivative[0, 0, 2, 0, 0][eta1][z1, z2, z3, z4, z5] + \
2*z1^2*z5*Derivative[0, 1, 1, 0, 0][eta1][z1, z2, z3, z4, z5] + \
z1^2*Derivative[0, 2, 0, 0, 0][eta1][z1, z2, z3, z4, z5] - z1*Derivative[1, \
0, 0, 0, 0][eta1][z1, z2, z3, z4, z5] + 2*z1*z4*Derivative[1, 0, 0, 1, \
0][eta1][z1, z2, z3, z4, z5] - 2*z1^2*z4*Derivative[1, 0, 1, 0, 0][eta1][z1, \
z2, z3, z4, z5] - z1^2*Derivative[2, 0, 0, 0, 0][eta1][z1, z2, z3, z4, z5] == \
0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.469480051896702*^9, 3.469480147972959*^9, 
  3.471572066143222*^9, 3.483788613227652*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData["5"], "Output",
 CellChangeTimes->{3.469480051942658*^9, 3.469480148057066*^9, 
  3.4715720661799593`*^9, 3.483788613275882*^9}]
}, Open  ]],

Cell["\<\
Here are the determining equations in a slightly more readable form as \
expressions rather than strings.\
\>", "Text"],

Cell[CellGroupData[{

Cell["\<\
zdeteqns=TraditionalForm[ToExpression[zdeterminingequations],Left,Below]\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 FormBox[
  RowBox[{"{", 
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "0", ",", "0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "0", ",", "2", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}]}],
      "\[LongEqual]", "0"}], ",", 
    RowBox[{
     RowBox[{
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "0", ",", "2", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "0", ",", "0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}]}],
      "\[LongEqual]", "0"}], ",", 
    RowBox[{
     RowBox[{
      RowBox[{"-", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", "z4", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "0", ",", "1", ",", "0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "(", 
         RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], 
         ")"}]}]}], "+", 
      RowBox[{"2", " ", 
       SuperscriptBox["z1", "2"], " ", "z5", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "1", ",", "1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "+", 
      RowBox[{"2", " ", 
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "1", ",", "0", ",", "1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{"2", " ", 
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0", ",", "0", ",", "0", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "+", 
      RowBox[{"2", " ", "z1", " ", "z4", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "0", ",", "1", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}]}],
      "\[LongEqual]", "0"}], ",", 
    RowBox[{
     RowBox[{
      RowBox[{"2", " ", 
       SuperscriptBox["z1", "2"], " ", "z5", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "1", ",", "0", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{"2", " ", 
       SuperscriptBox["z1", "2"], " ", "z4", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "1", ",", "1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "+", 
      RowBox[{"2", " ", 
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "1", ",", "0", ",", "0", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{"2", " ", 
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0", ",", "0", ",", "1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "+", 
      RowBox[{"2", " ", "z1", " ", "z4", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "0", ",", "2", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}]}],
      "\[LongEqual]", "0"}], ",", 
    RowBox[{
     RowBox[{
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{"(", 
        RowBox[{"-", 
         SuperscriptBox["z4", "2"]}], ")"}], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "2", ",", "0", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "+", 
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       SuperscriptBox["z5", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "2", ",", "0", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "+", 
      RowBox[{"2", " ", 
       SuperscriptBox["z1", "2"], " ", "z5", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "1", ",", "1", ",", "0", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "+", 
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2", ",", "0", ",", "0", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{"2", " ", 
       SuperscriptBox["z1", "2"], " ", "z4", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0", ",", "1", ",", "0", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"2", ",", "0", ",", "0", ",", "0", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "+", 
      RowBox[{"2", " ", "z1", " ", 
       SuperscriptBox["z4", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "1", ",", "1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{
       SuperscriptBox["z4", "2"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "0", ",", "2", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{"z1", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0", ",", "0", ",", "0", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "+", 
      RowBox[{"2", " ", "z1", " ", "z4", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0", ",", "0", ",", "1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}], 
      "-", 
      RowBox[{"z4", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "0", ",", "0", ",", "1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2", ",", "z3", ",", "z4", ",", "z5"}], ")"}]}]}],
      "\[LongEqual]", "0"}]}], "}"}], TraditionalForm]], "Output",
 CellChangeTimes->{3.46948005199998*^9, 3.4694801481509247`*^9, 
  3.471572066220751*^9, 3.483788613344812*^9}]
}, Open  ]],

Cell["\<\
Now solve the determining equations in terms of multivariable polynomials. \
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", "[", "\[IndentingNewLine]", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "rorder", ",", 
    "xseon", ",", "zdeterminingequations", ",", 
    RowBox[{"polyorder", "=", "3"}]}], "]"}], "]"}]], "Input",
 CellChangeTimes->{{3.469480138271742*^9, 3.469480139404479*^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 = \\!\\(56\\)\"\>",
  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 = ``", 56],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.483788613380266*^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.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.483788613382475*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(44535216\\), The time = \\!\
\\(78.473279`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 44535216, 78.473279],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.483788613384162*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(56\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 56],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.483788613385569*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(98\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 98],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.4837886133869343`*^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.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.483788613388268*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(43950672\\), The time = \\!\
\\(78.477806`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 43950672, 78.477806],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.483788613389759*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.483788613391095*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.483788613392363*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(43910240\\), The time = \\!\
\\(78.48166499999999`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 43910240, 78.48166499999999],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.483788613393674*^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.46948005214485*^9, 3.469480148331066*^9, 
  3.471572066257202*^9, 3.4837886133949738`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.031131999999985283`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.4694800522000647`*^9, 3.469480148400025*^9, 
  3.471572066273714*^9, 3.483788613397105*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"xse1[z1_, z2_, z3_, z4_, z5_]=0\"\>", 
   ",", "\<\"xse2[z1_, z2_, z3_, z4_, z5_]=0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.4694800523231287`*^9, 3.4694801484652367`*^9, 
  3.47157206630943*^9, 3.4837886134256277`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", "\<\"eta1[z1_, z2_, z3_, z4_, z5_]=b10 + (b17*z1^2)/2 + b14*z2 \
+ (3*b19*z1^2*z2)/2 + b17*z2^2 + b19*z2^3 + b110*z3 + b140*z2*z3 + b138*z1*z4 \
+ 2*b140*z1*z2*z4 + b135*z5 + b140*z1^2*z5 + b138*z2*z5 + b140*z2^2*z5\"\>", 
  "}"}]], "Output",
 CellChangeTimes->{3.4694800523819847`*^9, 3.469480148531591*^9, 
  3.471572066347056*^9, 3.483788613463153*^9}]
}, 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[{"0", ",", "0"}], "}"}]], "Output",
 CellChangeTimes->{3.4694800524318237`*^9, 3.469480148598309*^9, 
  3.471572066390778*^9, 3.4837886134926023`*^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", "+", 
   FractionBox[
    RowBox[{"b17", " ", 
     SuperscriptBox["r", "2"]}], "2"], "+", 
   RowBox[{"b14", " ", "t"}], "+", 
   RowBox[{
    FractionBox["3", "2"], " ", "b19", " ", 
    SuperscriptBox["r", "2"], " ", "t"}], "+", 
   RowBox[{"b17", " ", 
    SuperscriptBox["t", "2"]}], "+", 
   RowBox[{"b19", " ", 
    SuperscriptBox["t", "3"]}], "+", 
   RowBox[{"b110", " ", 
    RowBox[{"u", "[", 
     RowBox[{"r", ",", "t"}], "]"}]}], "+", 
   RowBox[{"b140", " ", "t", " ", 
    RowBox[{"u", "[", 
     RowBox[{"r", ",", "t"}], "]"}]}], "+", 
   RowBox[{"b135", " ", 
    RowBox[{
     SuperscriptBox["u", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"0", ",", "1"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"r", ",", "t"}], "]"}]}], "+", 
   RowBox[{"b140", " ", 
    SuperscriptBox["r", "2"], " ", 
    RowBox[{
     SuperscriptBox["u", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"0", ",", "1"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"r", ",", "t"}], "]"}]}], "+", 
   RowBox[{"b138", " ", "t", " ", 
    RowBox[{
     SuperscriptBox["u", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"0", ",", "1"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"r", ",", "t"}], "]"}]}], "+", 
   RowBox[{"b140", " ", 
    SuperscriptBox["t", "2"], " ", 
    RowBox[{
     SuperscriptBox["u", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"0", ",", "1"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"r", ",", "t"}], "]"}]}], "+", 
   RowBox[{"b138", " ", "r", " ", 
    RowBox[{
     SuperscriptBox["u", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"1", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"r", ",", "t"}], "]"}]}], "+", 
   RowBox[{"2", " ", "b140", " ", "r", " ", "t", " ", 
    RowBox[{
     SuperscriptBox["u", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"1", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"r", ",", "t"}], "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469480052478114*^9, 3.4694801486664467`*^9, 
  3.471572066440907*^9, 3.483788613549451*^9}]
}, Open  ]]
}, Open  ]],

Cell["Here is a list of the various infinitesimal groups.", "Text"],

Cell[BoxData[
 RowBox[{
  RowBox[{"infinitesimalgroupsxy", "=", 
   RowBox[{"infinitesimalgroups", "/.", 
    RowBox[{"{", 
     RowBox[{
      RowBox[{"z1", "\[Rule]", "r"}], ",", 
      RowBox[{"z2", "\[Rule]", "t"}], ",", 
      RowBox[{"z3", "\[Rule]", "u"}], ",", 
      RowBox[{"z4", "\[Rule]", "ux"}], ",", 
      RowBox[{"z5", "\[Rule]", "ut"}]}], "}"}]}]}], ";"}]], "Input"],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", "1", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", "t", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         FractionBox[
          SuperscriptBox["r", "2"], "2"], "+", 
         SuperscriptBox["t", "2"]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         FractionBox[
          RowBox[{"3", " ", 
           SuperscriptBox["r", "2"], " ", "t"}], "2"], "+", 
         SuperscriptBox["t", "3"]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", "u", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", "ut", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"t", " ", "ut"}], "+", 
         RowBox[{"r", " ", "ux"}]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"t", " ", "u"}], "+", 
         RowBox[{
          SuperscriptBox["r", "2"], " ", "ut"}], "+", 
         RowBox[{
          SuperscriptBox["t", "2"], " ", "ut"}], "+", 
         RowBox[{"2", " ", "r", " ", "t", " ", "ux"}]}], "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469480052557084*^9, 3.469480148757492*^9, 
  3.471572066551881*^9, 3.483788613623145*^9}],

Cell["Check the infinitesimals in the determining equations.", "Text",
 CellChangeTimes->{{3.471145395559845*^9, 3.471145429404257*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Simplify", "[", 
  RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], "]"}]], "Input",\

 CellChangeTimes->{{3.471145481019026*^9, 3.4711455173104143`*^9}, 
   3.471146122753789*^9, {3.47154140257237*^9, 3.471541418863482*^9}, {
   3.4715667761993*^9, 3.4715667786858253`*^9}, 3.471567789726531*^9, 
   3.471568099275279*^9, 3.4715715735656223`*^9, 3.471572095183077*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"True", ",", "True", ",", "True", ",", "True", ",", "True"}], 
  "}"}]], "Output",
 CellChangeTimes->{{3.47157206673055*^9, 3.4715720962244253`*^9}, 
   3.4837886137555*^9}]
}, Open  ]],

Cell[TextData[StyleBox[" In view of the linearity of the equation we can \
expect that the eta infinitesimal admits a general function and this is \
evident in the infinitesimals that continue to contain terms of the same \
order as the expansion polynomial. Drop these terms and look at the remaining \
groups.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"infinitesimalgroupsxy1", "=", "\[IndentingNewLine]", 
   RowBox[{"Drop", "[", 
    RowBox[{"infinitesimalgroupsxy", ",", 
     RowBox[{"{", 
      RowBox[{"1", ",", "4"}], "}"}]}], "]"}]}], ";"}]], "Input"],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", "u", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", "ut", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"t", " ", "ut"}], "+", 
         RowBox[{"r", " ", "ux"}]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "0"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"t", " ", "u"}], "+", 
         RowBox[{
          SuperscriptBox["r", "2"], " ", "ut"}], "+", 
         RowBox[{
          SuperscriptBox["t", "2"], " ", "ut"}], "+", 
         RowBox[{"2", " ", "r", " ", "t", " ", "ux"}]}], "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469480052628915*^9, 3.469480148845582*^9, 
  3.471572066841352*^9, 3.4837886138385773`*^9}],

Cell[CellGroupData[{

Cell[BoxData["rulesarrayexpanded"], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"2", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"x1", ",", "x2"}], "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{
      SuperscriptBox["y1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"0", ",", "2"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x1", ",", "x2"}], "]"}], "-", 
     FractionBox[
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x1", ",", "x2"}], "]"}], "x1"]}]}], ",", 
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"3", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"x1", ",", "x2"}], "]"}], "\[Rule]", 
    RowBox[{
     FractionBox[
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x1", ",", "x2"}], "]"}], 
      SuperscriptBox["x1", "2"]], "+", 
     RowBox[{
      SuperscriptBox["y1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"1", ",", "2"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x1", ",", "x2"}], "]"}], "-", 
     FractionBox[
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x1", ",", "x2"}], "]"}], "x1"]}]}], ",", 
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"2", ",", "1"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{"x1", ",", "x2"}], "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{
      SuperscriptBox["y1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"0", ",", "3"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x1", ",", "x2"}], "]"}], "-", 
     FractionBox[
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x1", ",", "x2"}], "]"}], "x1"]}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469480052683076*^9, 3.4694801489165277`*^9, 
  3.471572066882568*^9, 3.483788613877132*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["263036176"], "Output",
 CellChangeTimes->{3.469480052733119*^9, 3.469480148982758*^9, 
  3.471572066933617*^9, 3.4837886139312563`*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{897, 906},
WindowMargins->{{28, Automatic}, {Automatic, 14}},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
MacintoshSystemPageSetup -> \
"01@0001804P000000_82@?okonh34`9B;@85:0?l0@00009H0UP00P0068dB`001\n\
2@00I00100000@004Q800BL?0040000000000000000004<001000`00000@0?oH\n\
ofXIX1=F8040400000400000000000l1",
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, 270, 5, 97, "Text"],
Cell[818, 27, 85, 2, 32, "Text"],
Cell[906, 31, 90, 2, 33, "Input"],
Cell[999, 35, 124, 1, 32, "Text"],
Cell[1126, 38, 160, 4, 33, "Input"],
Cell[1289, 44, 476, 13, 32, "Text"],
Cell[1768, 59, 101, 2, 33, "Input"],
Cell[1872, 63, 165, 3, 32, "Text"],
Cell[2040, 68, 142, 4, 53, "Input"],
Cell[2185, 74, 507, 7, 89, "Text"],
Cell[2695, 83, 183, 5, 53, "Input"],
Cell[2881, 90, 130, 2, 32, "Text"],
Cell[3014, 94, 151, 4, 33, "Input"],
Cell[3168, 100, 128, 2, 32, "Text"],
Cell[3299, 104, 116, 3, 33, "Input"],
Cell[3418, 109, 233, 4, 51, "Text"],
Cell[3654, 115, 96, 3, 33, "Input"],
Cell[3753, 120, 152, 3, 32, "Text"],
Cell[3908, 125, 72, 2, 33, "Input"],
Cell[3983, 129, 390, 6, 70, "Text"],
Cell[4376, 137, 72, 2, 33, "Input"],
Cell[4451, 141, 514, 7, 89, "Text"],
Cell[4968, 150, 71, 2, 33, "Input"],
Cell[5042, 154, 568, 8, 89, "Text"],
Cell[5613, 164, 79, 2, 33, "Input"],
Cell[5695, 168, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5988, 176, 334, 6, 72, "Input"],
Cell[6325, 184, 449, 8, 45, "Print"],
Cell[6777, 194, 1032, 14, 216, "Print"],
Cell[7812, 210, 705, 12, 64, "Print"],
Cell[8520, 224, 433, 8, 45, "Print"],
Cell[8956, 234, 1032, 14, 216, "Print"],
Cell[9991, 250, 208, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10236, 259, 44, 0, 33, "Input"],
Cell[10283, 261, 2666, 95, 153, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[12986, 361, 50, 0, 33, "Input"],
Cell[13039, 363, 209, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[13285, 371, 45, 0, 33, "Input"],
Cell[13333, 373, 728, 23, 42, "Output"]
}, Open  ]],
Cell[14076, 399, 39, 0, 33, "Input"],
Cell[14118, 401, 839, 27, 42, "Output"],
Cell[CellGroupData[{
Cell[14982, 432, 278, 4, 51, "Text"],
Cell[15263, 438, 47, 0, 33, "Input"],
Cell[15313, 440, 1854, 28, 452, "Output"]
}, Open  ]],
Cell[17182, 471, 57, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[17264, 475, 83, 1, 33, "Input"],
Cell[17350, 478, 141, 2, 33, "Output"]
}, Open  ]],
Cell[17506, 483, 129, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[17660, 490, 129, 3, 33, "Input"],
Cell[17792, 495, 9999, 290, 299, "Output"]
}, Open  ]],
Cell[27806, 788, 489, 11, 145, "Text"],
Cell[CellGroupData[{
Cell[28320, 803, 371, 7, 72, "Input"],
Cell[28694, 812, 876, 14, 83, "Print"],
Cell[29573, 828, 438, 6, 83, "Print"],
Cell[30014, 836, 331, 6, 25, "Print"],
Cell[30348, 844, 317, 6, 25, "Print"],
Cell[30668, 852, 342, 7, 25, "Print"],
Cell[31013, 861, 318, 4, 64, "Print"],
Cell[31334, 867, 331, 6, 25, "Print"],
Cell[31668, 875, 163, 2, 25, "Print"],
Cell[31834, 879, 207, 3, 25, "Print"],
Cell[32044, 884, 350, 7, 25, "Print"],
Cell[32397, 893, 1086, 14, 254, "Print"],
Cell[33486, 909, 209, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[33732, 918, 184, 3, 32, "Text"],
Cell[33919, 923, 38, 0, 33, "Input"],
Cell[33960, 925, 269, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[34266, 935, 141, 2, 32, "Text"],
Cell[34410, 939, 38, 0, 33, "Input"],
Cell[34451, 941, 383, 6, 72, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[34871, 952, 144, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[35040, 959, 115, 3, 33, "Input"],
Cell[35158, 964, 188, 4, 33, "Output"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[35395, 974, 143, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[35563, 980, 115, 3, 33, "Input"],
Cell[35681, 985, 2299, 77, 116, "Output"]
}, Open  ]]
}, Open  ]],
Cell[38007, 1066, 67, 0, 32, "Text"],
Cell[38077, 1068, 383, 10, 33, "Input"],
Cell[38463, 1080, 79, 1, 33, "Input"],
Cell[38545, 1083, 2115, 74, 209, "Output"],
Cell[40663, 1159, 136, 1, 32, "Text"],
Cell[CellGroupData[{
Cell[40824, 1164, 405, 7, 33, "Input"],
Cell[41232, 1173, 212, 5, 33, "Output"]
}, Open  ]],
Cell[41459, 1181, 377, 6, 70, "Text"],
Cell[41839, 1189, 241, 6, 53, "Input"],
Cell[42083, 1197, 80, 1, 33, "Input"],
Cell[42166, 1200, 1239, 41, 99, "Output"],
Cell[CellGroupData[{
Cell[43430, 1245, 44, 0, 33, "Input"],
Cell[43477, 1247, 2667, 95, 153, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[46181, 1347, 66, 1, 33, "Input"],
Cell[46250, 1350, 149, 2, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
