(* 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[     55957,       1668]
NotebookOptionsPosition[     51306,       1523]
NotebookOutlinePosition[     52083,       1550]
CellTagsIndexPosition[     52040,       1547]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[StyleBox["In this example we use the package IntroToSymmetry.m \
to work out the groups for the third-order ODE considered in Homework \
Exercise 8.11.\n\nYxxx+(Yx/Y)Yxx-(2/Yx)Yxx^2+(Yx/Y^2)=0",
 FontSize->14,
 FontVariations->{"CompatibilityType"->0}]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell["Needs[\"SymmetryAnalysis`IntroToSymmetry`\"]", "Input",
 PageWidth->WindowWidth,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
Enter the input equation as a string. Don't include the ==0 at the end.\
\>", "Text"],

Cell["\<\
inputequation=
\"D[y[x],x,x,x]+(D[y[x],x]/y[x])*D[y[x],x,x]-(2/D[y[x],x])*(D[y[x],x,x])^2+D[\
y[x],x]/(y[x])^2\";\
\>", "Input",
 PageWidth->WindowWidth,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
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. Replace the \
highest derivative term.\
\>", "Text"],

Cell["\<\
rulesarray=
{\"D[y[x],x,x,x]->-((D[y[x],x]/y[x])*D[y[x],x,x]-(2/D[y[x],x])*(D[y[x],x,x])^\
2+D[y[x],x]/(y[x])^2)\"};\
\>", "Input",
 PageWidth->WindowWidth,
 ImageRegion->{{0, 1}, {0, 1}}],

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

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

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

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

Cell[TextData[StyleBox["Enter the list of function and constant names that \
need to be preserved when the variables are changed to generic names, ( \
x1,y1).",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"frozennames", "=", 
   RowBox[{"{", "\"\<\>\"", "}"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.4694009306947403`*^9, 3.4694009308538513`*^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", "=", "3"}], ";"}]], "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 set 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", "[", "\[IndentingNewLine]", 
   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 = \\!\\(26123376\\), the time used = \\!\\(4.590541`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 26123376, 4.590541],
  Editable->False]], "Print",
 CellChangeTimes->{3.469401011514821*^9, 3.4694010923290977`*^9, 
  3.4694012231540613`*^9, 3.471554660148375*^9, 3.471577136784408*^9, 
  3.48365068388713*^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.469401011514821*^9, 3.4694010923290977`*^9, 
  3.4694012231540613`*^9, 3.471554660148375*^9, 3.471577136784408*^9, 
  3.483650683960573*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(11\\), the \
byte count of zdeterminingequations = \\!\\(1632\\), the memory in use = \
\\!\\(26203256\\), the time used = \\!\\(4.684506`\\)\"\>",
  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 = ``", 11, 1632, 26203256, 
   4.684506],
  Editable->False]], "Print",
 CellChangeTimes->{3.469401011514821*^9, 3.4694010923290977`*^9, 
  3.4694012231540613`*^9, 3.471554660148375*^9, 3.471577136784408*^9, 
  3.4836506839905567`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(26204000\\), the time used = \\!\\(4.684706`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 26204000, 4.684706],
  Editable->False]], "Print",
 CellChangeTimes->{3.469401011514821*^9, 3.4694010923290977`*^9, 
  3.4694012231540613`*^9, 3.471554660148375*^9, 3.471577136784408*^9, 
  3.483650683992572*^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.469401011514821*^9, 3.4694010923290977`*^9, 
  3.4694012231540613`*^9, 3.471554660148375*^9, 3.471577136784408*^9, 
  3.483650683994377*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.09487799999999957`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469401011726225*^9, 3.469401092476467*^9, 
  3.469401223355976*^9, 3.47155466025174*^9, 3.4715771368893347`*^9, 
  3.4836506839969187`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1,x1]+(D[y1[x1],x1]/y1[x1])*D[y1[x1],x1,x1]-(2/\
D[y1[x1],x1])*(D[y1[x1],x1,x1])^2+D[y1[x1],x1]/(y1[x1])^2\"\>"], "Output",
 CellChangeTimes->{3.469401011802882*^9, 3.4694010925385637`*^9, 
  3.4694012234253674`*^9, 3.471554660282031*^9, 3.471577136920596*^9, 
  3.483650684028739*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0", ",", 
   RowBox[{
    RowBox[{"-", 
     FractionBox[
      RowBox[{"2", " ", 
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}]}], 
      SuperscriptBox[
       RowBox[{"y1", "[", "x1", "]"}], "3"]]}], "-", 
    FractionBox[
     RowBox[{
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], 
     SuperscriptBox[
      RowBox[{"y1", "[", "x1", "]"}], "2"]]}], ",", 
   RowBox[{
    FractionBox["1", 
     SuperscriptBox[
      RowBox[{"y1", "[", "x1", "]"}], "2"]], "+", 
    FractionBox[
     RowBox[{
      SuperscriptBox["y1", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], 
     RowBox[{"y1", "[", "x1", "]"}]], "+", 
    FractionBox[
     RowBox[{"2", " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["y1", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"]}], 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "2"]]}], ",", 
   RowBox[{
    FractionBox[
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], 
     RowBox[{"y1", "[", "x1", "]"}]], "-", 
    FractionBox[
     RowBox[{"4", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], 
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]]}], ",", "1"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.46940101186504*^9, 3.469401092622291*^9, 
  3.469401223470255*^9, 3.4715546603212433`*^9, 3.471577136977919*^9, 
  3.48365068407472*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"-(z2^3*Derivative[0, 1][xse1][z1, z2]) == 0\"\>", 
   ",", "\<\"-2*z2^3*Derivative[0, 2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-(z2^2*Derivative[0, 2][xse1][z1, z2]) - z2^3*Derivative[0, \
3][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"2*z2^3*Derivative[1, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"-(z2*eta1[z1, z2]) + z2^2*Derivative[0, 1][eta1][z1, z2] - \
z2^3*Derivative[0, 2][eta1][z1, z2] - z2^3*Derivative[1, 1][xse1][z1, z2] == \
0\"\>", ",", "\<\"z2^2*Derivative[0, 2][eta1][z1, z2] + z2^3*Derivative[0, \
3][eta1][z1, z2] - 2*z2^2*Derivative[1, 1][xse1][z1, z2] - \
3*z2^3*Derivative[1, 2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-4*z2^3*Derivative[2, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"z2^2*Derivative[1, 0][eta1][z1, z2] - 5*z2^3*Derivative[1, \
1][eta1][z1, z2] + z2^3*Derivative[2, 0][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"3*z2*Derivative[0, 1][xse1][z1, z2] + 2*z2^2*Derivative[1, \
1][eta1][z1, z2] + 3*z2^3*Derivative[1, 2][eta1][z1, z2] - z2^2*Derivative[2, \
0][xse1][z1, z2] - 3*z2^3*Derivative[2, 1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"z2*Derivative[1, 0][eta1][z1, z2] + z2^3*Derivative[3, \
0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"-2*eta1[z1, z2] + 2*z2*Derivative[1, 0][xse1][z1, z2] + \
z2^2*Derivative[2, 0][eta1][z1, z2] + 3*z2^3*Derivative[2, 1][eta1][z1, z2] - \
z2^3*Derivative[3, 0][xse1][z1, z2] == 0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.469401011930187*^9, 3.4694010927061977`*^9, 
  3.469401223521184*^9, 3.471554660349596*^9, 3.471577137021291*^9, 
  3.4836506841311274`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469401012014769*^9, 3.46940109281446*^9, 
  3.4694012235919847`*^9, 3.471554660382451*^9, 3.471577137076619*^9, 
  3.483650684191231*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{
     RowBox[{"-", 
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"]}], " ", 
     RowBox[{
      SuperscriptBox["xse1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"0", ",", "1"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x", ",", 
       RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"-", "2"}], " ", 
     SuperscriptBox[
      RowBox[{"y", "[", "x", "]"}], "3"], " ", 
     RowBox[{
      SuperscriptBox["xse1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"0", ",", "2"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x", ",", 
       RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{"-", 
       SuperscriptBox[
        RowBox[{"y", "[", "x", "]"}], "2"]}], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "3"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{"2", " ", 
     SuperscriptBox[
      RowBox[{"y", "[", "x", "]"}], "3"], " ", 
     RowBox[{
      SuperscriptBox["eta1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"1", ",", "0"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x", ",", 
       RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{"-", 
       RowBox[{"eta1", "[", 
        RowBox[{"x", ",", 
         RowBox[{"y", "[", "x", "]"}]}], "]"}]}], " ", 
      RowBox[{"y", "[", "x", "]"}]}], "+", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "3"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{"2", " ", 
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{"3", " ", 
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"-", "4"}], " ", 
     SuperscriptBox[
      RowBox[{"y", "[", "x", "]"}], "3"], " ", 
     RowBox[{
      SuperscriptBox["eta1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"2", ",", "0"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"x", ",", 
       RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{"5", " ", 
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"3", " ", 
      RowBox[{"y", "[", "x", "]"}], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{"2", " ", 
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{"3", " ", 
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{"3", " ", 
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{"y", "[", "x", "]"}], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"3", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{"-", "2"}], " ", 
      RowBox[{"eta1", "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{"2", " ", 
      RowBox[{"y", "[", "x", "]"}], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "+", 
     RowBox[{"3", " ", 
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"y", "[", "x", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"3", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"x", ",", 
        RowBox[{"y", "[", "x", "]"}]}], "]"}]}]}], "\[Equal]", "0"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.4694010120845747`*^9, 3.4694010929115877`*^9, 
  3.469401223656096*^9, 3.4715546604258127`*^9, 3.4715771371266003`*^9, 
  3.4836506842493467`*^9}]
}, Open  ]],

Cell["\<\
Here is the correspondence between z-variables and conventional variables.\
\>", "Text"],

Cell[CellGroupData[{

Cell["ztableofrules", "Input",
 PageWidth->WindowWidth,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.4694010121868134`*^9, 3.4694010930184393`*^9, 
  3.469401223724758*^9, 3.471554660468151*^9, 3.471577137171729*^9, 
  3.4836506842913647`*^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",
 CellChangeTimes->{{3.469401200499196*^9, 3.46940120098386*^9}}],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["z2", "3"]}], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", "2"}], " ", 
       SuperscriptBox["z2", "3"], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", 
         SuperscriptBox["z2", "2"]}], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "3"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{"2", " ", 
       SuperscriptBox["z2", "3"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "z2"}], " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "3"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", "4"}], " ", 
       SuperscriptBox["z2", "3"], " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"2", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"5", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"3", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"z2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"3", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "2"}], " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"3", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.4694010123663692`*^9, 3.4694010931123543`*^9, 
  3.469401223793618*^9, 3.4715546605426893`*^9, 3.471577137230755*^9, 
  3.483650684349468*^9}],

Cell["\<\
Now solve the determining equations in terms of multivariable polynomials of \
a selected order. This function can take a long time. 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["\<\
Timing[SolveDeterminingEquations[
independentvariables,dependentvariables,r,
xseon,zdeterminingequations,order=3]]\
\>", "Input",
 PageWidth->WindowWidth,
 CellChangeTimes->{{3.469401086902244*^9, 3.4694010874283*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

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 = \\!\\(10\\)\"\>",
  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 = ``", 10],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.4836506844096413`*^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.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.483650684446061*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26643840\\), The time = \\!\
\\(4.716479`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26643840, 4.716479],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.483650684478153*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(20\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 20],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.483650684510674*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(53\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 53],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.483650684544219*^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.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.483650684581626*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26632872\\), The time = \\!\
\\(4.718465999999999`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26632872, 4.718465999999999],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.483650684611308*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.483650684645302*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.4836506846829967`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26631104\\), The time = \\!\
\\(4.719550999999999`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26631104, 4.719550999999999],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.4836506847116013`*^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.4694010124335337`*^9, 3.4694010933299427`*^9, 
  3.4694012238588657`*^9, 3.471554660583694*^9, 3.471577137273905*^9, 
  3.4836506847460747`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.018513999999999697`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.46940101256667*^9, 3.469401093466835*^9, 
  3.469401223862705*^9, 3.471554660593976*^9, 3.471577137284177*^9, 
  3.483650684777834*^9}]
}, Open  ]],

Cell["\<\
Here are the infinitesimal transformation functions for the independent \
variables.\
\>", "Text"],

Cell[CellGroupData[{

Cell["xsefunctions", "Input",
 PageWidth->WindowWidth,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", "\<\"xse1[z1_, z2_]=a10 + b14*z1\"\>", "}"}]], "Output",
 CellChangeTimes->{3.46940101263758*^9, 3.4694010935686417`*^9, 
  3.469401223904173*^9, 3.471554660616456*^9, 3.471577137321484*^9, 
  3.483650684939465*^9}]
}, Open  ]],

Cell["and for the dependent variables.", "Text"],

Cell[CellGroupData[{

Cell["etafunctions", "Input",
 PageWidth->WindowWidth,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", "\<\"eta1[z1_, z2_]=b14*z2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469401012699883*^9, 3.469401093630204*^9, 
  3.469401224037797*^9, 3.4715546606492653`*^9, 3.4715771373772573`*^9, 
  3.483650685029204*^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[BoxData[
 RowBox[{
  RowBox[{"ToExpression", "[", "xsefunctions", "]"}], "/.", 
  "ztableofrules"}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"a10", "+", 
   RowBox[{"b14", " ", "x"}]}], "}"}]], "Output",
 CellChangeTimes->{3.4694010127671432`*^9, 3.469401093697898*^9, 
  3.469401224092786*^9, 3.471554660684044*^9, 3.4715771374237757`*^9, 
  3.483650685088354*^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[{"{", 
  RowBox[{"b14", " ", 
   RowBox[{"y", "[", "x", "]"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469401012833671*^9, 3.469401093764167*^9, 
  3.469401224125163*^9, 3.471554660721373*^9, 3.471577137471785*^9, 
  3.4836506851381702`*^9}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"infinitesimalgroupsxy", "=", 
  RowBox[{"infinitesimalgroups", "/.", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"z1", "\[Rule]", "x"}], ",", 
     RowBox[{"z2", "\[Rule]", "y"}]}], "}"}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "1", "}"}], ",", 
     RowBox[{"{", "0", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "x", "}"}], ",", 
     RowBox[{"{", "y", "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.4694010129012957`*^9, 3.469401093830701*^9, 
  3.46940122417625*^9, 3.471554660754341*^9, 3.471577137600831*^9, 
  3.483650685188167*^9}]
}, Open  ]],

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

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "1", "}"}], ",", 
       RowBox[{"{", "0", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "x", "}"}], ",", 
       RowBox[{"{", "y", "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469401012972736*^9, 3.4694010938973217`*^9, 
  3.469401224208658*^9, 3.471554660788311*^9, 3.471577137642912*^9, 
  3.4836506852396708`*^9}],

Cell["\<\
Check that these symmetries satisfy the determining equations.\
\>", "Text",
 CellChangeTimes->{{3.471554522867668*^9, 3.4715545458246326`*^9}}],

Cell[CellGroupData[{

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

 CellChangeTimes->{{3.471554552278927*^9, 3.471554590561404*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
  "True", ",", "True", ",", "True", ",", "True", ",", "True", ",", "True", 
   ",", "True", ",", "True", ",", "True", ",", "True", ",", "True"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.471554673277808*^9, 3.471577137672*^9, 
  3.483650685289136*^9}]
}, Open  ]],

Cell[TextData[{
 StyleBox["The package finds two groups, the translation group \
(xse,eta)=(1,0) and the dilation group (xse,eta)=(x,y). ",
  FontWeight->"Plain"],
 "Let's generate the commutator table of the group."
}], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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.469401013055957*^9, 3.469401093963972*^9, 
  3.4694012242593937`*^9, 3.471554660816352*^9, 3.4715771377280684`*^9, 
  3.483650685355638*^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[{
         {"1"},
         {"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[{"-", "1"}]},
         {"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[{
         {"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.4694010132108793`*^9, 3.469401094039236*^9, 
  3.46940122429287*^9, 3.471554660856043*^9, 3.4715771377760963`*^9, 
  3.483650685423514*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["26675016"], "Output",
 CellChangeTimes->{3.469401013367477*^9, 3.469401094097681*^9, 
  3.469401224343505*^9, 3.471554660883555*^9, 3.471577137822987*^9, 
  3.483650685489687*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{1050, 990},
WindowMargins->{{51, Automatic}, {Automatic, 31}},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
MacintoshSystemPageSetup -> \
"0080001804P000000_82@?okonh34`9B;@<5:0?l00;m009H0UP0000068dB`0B`\n\
02d5X5k/02H80@4101P00BL?00400@00000000000000P0010000020D00000000\n\
0000000000000000000004T400002004",
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, 308, 5, 97, "Text"],
Cell[856, 27, 124, 1, 32, "Text"],
Cell[983, 30, 160, 4, 33, "Input"],
Cell[1146, 36, 476, 13, 32, "Text"],
Cell[1625, 51, 118, 2, 33, "Input"],
Cell[1746, 55, 95, 2, 32, "Text"],
Cell[1844, 59, 195, 6, 50, "Input"],
Cell[2042, 67, 199, 4, 51, "Text"],
Cell[2244, 73, 198, 6, 50, "Input"],
Cell[2445, 81, 130, 2, 32, "Text"],
Cell[2578, 85, 118, 3, 33, "Input"],
Cell[2699, 90, 128, 2, 32, "Text"],
Cell[2830, 94, 116, 3, 33, "Input"],
Cell[2949, 99, 224, 4, 32, "Text"],
Cell[3176, 105, 178, 4, 33, "Input"],
Cell[3357, 111, 141, 2, 32, "Text"],
Cell[3501, 115, 67, 2, 33, "Input"],
Cell[3571, 119, 385, 6, 51, "Text"],
Cell[3959, 127, 67, 2, 33, "Input"],
Cell[4029, 131, 509, 7, 70, "Text"],
Cell[4541, 140, 71, 2, 33, "Input"],
Cell[4615, 144, 534, 8, 70, "Text"],
Cell[5152, 154, 79, 2, 33, "Input"],
Cell[5234, 158, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5527, 166, 347, 6, 72, "Input"],
Cell[5877, 174, 495, 9, 45, "Print"],
Cell[6375, 185, 1079, 15, 178, "Print"],
Cell[7457, 202, 756, 13, 64, "Print"],
Cell[8216, 217, 464, 9, 25, "Print"],
Cell[8683, 228, 1081, 15, 178, "Print"],
Cell[9767, 245, 256, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10060, 255, 50, 0, 33, "Input"],
Cell[10113, 257, 316, 4, 53, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10466, 266, 45, 0, 33, "Input"],
Cell[10514, 268, 1895, 58, 62, "Output"]
}, Open  ]],
Cell[12424, 329, 151, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[12600, 336, 47, 0, 33, "Input"],
Cell[12650, 338, 1573, 25, 300, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[14260, 368, 39, 0, 33, "Input"],
Cell[14302, 370, 324, 8, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[14663, 383, 124, 3, 33, "Input"],
Cell[14790, 388, 10674, 360, 262, "Output"]
}, Open  ]],
Cell[25479, 751, 98, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[25602, 757, 87, 2, 33, "Input"],
Cell[25692, 761, 329, 8, 33, "Output"]
}, Open  ]],
Cell[26036, 772, 161, 4, 32, "Text"],
Cell[26200, 778, 410, 12, 33, "Input"],
Cell[26613, 792, 9605, 316, 291, "Output"],
Cell[36221, 1110, 545, 11, 145, "Text"],
Cell[CellGroupData[{
Cell[36791, 1125, 260, 7, 66, "Input"],
Cell[37054, 1134, 932, 15, 83, "Print"],
Cell[37989, 1151, 492, 7, 83, "Print"],
Cell[38484, 1160, 383, 7, 25, "Print"],
Cell[38870, 1169, 371, 7, 25, "Print"],
Cell[39244, 1178, 394, 8, 25, "Print"],
Cell[39641, 1188, 372, 5, 45, "Print"],
Cell[40016, 1195, 404, 8, 25, "Print"],
Cell[40423, 1205, 217, 3, 25, "Print"],
Cell[40643, 1210, 263, 4, 25, "Print"],
Cell[40909, 1216, 406, 8, 25, "Print"],
Cell[41318, 1226, 1140, 15, 216, "Print"],
Cell[42461, 1243, 253, 5, 33, "Output"]
}, Open  ]],
Cell[42729, 1251, 108, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[42862, 1258, 86, 2, 33, "Input"],
Cell[42951, 1262, 243, 4, 33, "Output"]
}, Open  ]],
Cell[43209, 1269, 48, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[43282, 1273, 86, 2, 33, "Input"],
Cell[43371, 1277, 240, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[43648, 1286, 144, 3, 32, "Text"],
Cell[43795, 1291, 115, 3, 33, "Input"],
Cell[43913, 1296, 263, 6, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[44213, 1307, 143, 2, 32, "Text"],
Cell[44359, 1311, 115, 3, 33, "Input"],
Cell[44477, 1316, 264, 6, 33, "Output"],
Cell[CellGroupData[{
Cell[44766, 1326, 226, 6, 33, "Input"],
Cell[44995, 1334, 434, 13, 33, "Output"]
}, Open  ]],
Cell[45444, 1350, 67, 0, 32, "Text"]
}, Open  ]],
Cell[45526, 1353, 79, 1, 33, "Input"],
Cell[45608, 1356, 584, 18, 53, "Output"],
Cell[46195, 1376, 154, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[46374, 1383, 188, 4, 33, "Input"],
Cell[46565, 1389, 292, 7, 33, "Output"]
}, Open  ]],
Cell[46872, 1399, 260, 6, 32, "Text"],
Cell[47135, 1407, 191, 4, 53, "Input"],
Cell[47329, 1413, 577, 8, 83, "Print"],
Cell[CellGroupData[{
Cell[47931, 1425, 77, 1, 33, "Input"],
Cell[48011, 1428, 2980, 81, 107, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[51028, 1514, 66, 1, 33, "Input"],
Cell[51097, 1517, 193, 3, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
