(* 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[     53029,       1576]
NotebookOptionsPosition[     47793,       1413]
NotebookOutlinePosition[     48571,       1440]
CellTagsIndexPosition[     48528,       1437]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[StyleBox["Use the package DeterminingEquations.m to work out \
the point group of of the 2rd order ODE\n\nYxx-Exp[y]/(xYx)=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.4720466725423717`*^9, 
  3.472046673357225*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell["Enter the input equation as a string, ie, in quotes.", "Text"],

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

Cell["\<\
The function y[x] is a solution of the equation and this constraint must be \
applied to the invariance condition. Replace the second derivativewherever it \
appears in the invariance condition.\
\>", "Text"],

Cell["\<\
rulesarray=
{\"D[y[x],x,x]->Exp[y[x]]/(x*D[y[x],x])\"};\
\>", "Input",
 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/or constant names that \
must be preserved when the equation is expressed in terms of generic (x1,y1) \
variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

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

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

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

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

Cell[TextData[StyleBox["When searching for Lie-B\[ADoubleDot]cklund 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["\<\
Timing[FindDeterminingEquations[
independentvariables,dependentvariables,frozennames,p,r,xseon,
inputequation,rulesarray,internalrules]]\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(30696392\\), the time used = \\!\\(16.959875`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 30696392, 16.959875],
  Editable->False]], "Print",
 CellChangeTimes->{3.469402235407679*^9, 3.469402367150092*^9, 
  3.471554801065919*^9, 3.47155485565001*^9, 3.471577741947144*^9, 
  3.483651807453596*^9, 3.483653244587508*^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.469402235407679*^9, 3.469402367150092*^9, 
  3.471554801065919*^9, 3.47155485565001*^9, 3.471577741947144*^9, 
  3.483651807453596*^9, 3.483653244642371*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(6\\), the \
byte count of zdeterminingequations = \\!\\(768\\), the memory in use = \
\\!\\(30709488\\), the time used = \\!\\(17.00879`\\)\"\>",
  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 = ``", 6, 768, 30709488, 17.00879],
  Editable->False]], "Print",
 CellChangeTimes->{3.469402235407679*^9, 3.469402367150092*^9, 
  3.471554801065919*^9, 3.47155485565001*^9, 3.471577741947144*^9, 
  3.483651807453596*^9, 3.4836532446453037`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(30710312\\), the time used = \\!\\(17.008979`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 30710312, 17.008979],
  Editable->False]], "Print",
 CellChangeTimes->{3.469402235407679*^9, 3.469402367150092*^9, 
  3.471554801065919*^9, 3.47155485565001*^9, 3.471577741947144*^9, 
  3.483651807453596*^9, 3.483653244647488*^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.469402235407679*^9, 3.469402367150092*^9, 
  3.471554801065919*^9, 3.47155485565001*^9, 3.471577741947144*^9, 
  3.483651807453596*^9, 3.483653244649534*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.04982700000000051`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469402235599202*^9, 3.469402367444277*^9, 
  3.4715548012570353`*^9, 3.47155485569882*^9, 3.471577742123054*^9, 
  3.483651807505226*^9, 3.483653244652364*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1]-Exp[y1[x1]]/(x1*D[y1[x1],x1])\"\>"], \
"Output",
 CellChangeTimes->{3.4694022357050753`*^9, 3.469402367541705*^9, 
  3.47155480136209*^9, 3.471554855739586*^9, 3.471577742229415*^9, 
  3.4836518075427523`*^9, 3.483653244688602*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["invarconditiontable", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   FractionBox[
    SuperscriptBox["\[ExponentialE]", 
     RowBox[{"y1", "[", "x1", "]"}]], 
    RowBox[{
     SuperscriptBox["x1", "2"], " ", 
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]}]], ",", 
   RowBox[{"-", 
    FractionBox[
     SuperscriptBox["\[ExponentialE]", 
      RowBox[{"y1", "[", "x1", "]"}]], 
     RowBox[{"x1", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}]]}], ",", 
   FractionBox[
    SuperscriptBox["\[ExponentialE]", 
     RowBox[{"y1", "[", "x1", "]"}]], 
    RowBox[{"x1", " ", 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "2"]}]], ",", "1"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.4694022357862473`*^9, 3.469402367613913*^9, 
  3.471554801433207*^9, 3.471554855794694*^9, 3.471577742296091*^9, 
  3.4836518075929213`*^9, 3.483653244743353*^9}]
}, Open  ]],

Cell["\<\
Here are the determining equations in terms of z-variables and in string \
format.\
\>", "Text"],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"-(z1^2*Derivative[0, 2][xse1][z1, z2]) == 0\"\>", 
   ",", "\<\"E^z2*z1*Derivative[1, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"-(E^z2*z1*eta1[z1, z2]) + E^z2*xse1[z1, z2] + \
2*E^z2*z1*Derivative[0, 1][eta1][z1, z2] - 3*E^z2*z1*Derivative[1, \
0][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"z1^2*Derivative[0, 2][eta1][z1, z2] - 2*z1^2*Derivative[1, \
1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-4*E^z2*z1*Derivative[0, 1][xse1][z1, z2] + z1^2*Derivative[2, \
0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"2*z1^2*Derivative[1, 1][eta1][z1, z2] - z1^2*Derivative[2, \
0][xse1][z1, z2] == 0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.4694022358768797`*^9, 3.469402367696836*^9, 
  3.471554801508885*^9, 3.471554855857215*^9, 3.471577742376033*^9, 
  3.483651807642823*^9, 3.483653244789165*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

Cell["zdeteqns=ToExpression[zdeterminingequations]", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{
     RowBox[{"-", 
      SuperscriptBox["z1", "2"]}], " ", 
     RowBox[{
      SuperscriptBox["xse1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"0", ",", "2"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
     RowBox[{
      SuperscriptBox["eta1", 
       TagBox[
        RowBox[{"(", 
         RowBox[{"1", ",", "0"}], ")"}],
        Derivative],
       MultilineFunction->None], "[", 
      RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{"-", 
       SuperscriptBox["\[ExponentialE]", "z2"]}], " ", "z1", " ", 
      RowBox[{"eta1", "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox["\[ExponentialE]", "z2"], " ", 
      RowBox[{"xse1", "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"2", " ", 
      SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"3", " ", 
      SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", 
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{"-", "4"}], " ", 
      SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"2", " ", 
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469402235964408*^9, 3.469402367790977*^9, 
  3.471554801602191*^9, 3.471554855907374*^9, 3.4715777424698353`*^9, 
  3.4836518076935596`*^9, 3.4836532448437757`*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.46940223605816*^9, 3.469402367873955*^9, 
  3.471554801678319*^9, 3.471554855956601*^9, 3.471577742553898*^9, 
  3.483651807743636*^9, 3.483653244889079*^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.469402343352152*^9, 3.469402343910302*^9}}],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["z1", "2"]}], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", 
         SuperscriptBox["\[ExponentialE]", "z2"]}], " ", "z1", " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["\[ExponentialE]", "z2"], " ", 
        RowBox[{"xse1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"3", " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "4"}], " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469402236239612*^9, 3.46940236805299*^9, 
  3.471554801760345*^9, 3.471554856012106*^9, 3.4715777426275578`*^9, 
  3.483651807794127*^9, 3.483653244945725*^9}],

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

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

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

Cell[CellGroupData[{

Cell["\<\
Timing[SolveDeterminingEquations[
independentvariables,dependentvariables,r,
xseon,zdeterminingequations,order=4]]\
\>", "Input",
 CellChangeTimes->{{3.4694021757922087`*^9, 3.469402176436493*^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 = \\!\\(15\\)\"\>",
  StringForm[
  "The variable powertablelength is the number of terms required for each \
multivariate polynomial used for the infinitesimals. This number is \
determined by the choice of polynomial order and the number of zvariables. \
The time needed to solve the determining equations increases as powertable \
increases. powertablelength = ``", 15],
  Editable->False]], "Print",
 CellChangeTimes->{3.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.483653244987602*^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.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.483653244989974*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(30771744\\), The time = \\!\
\\(17.035029`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 30771744, 17.035029],
  Editable->False]], "Print",
 CellChangeTimes->{3.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.483653244991737*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(30\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 30],
  Editable->False]], "Print",
 CellChangeTimes->{3.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.483653244993287*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(58\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 58],
  Editable->False]], "Print",
 CellChangeTimes->{3.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.483653244994808*^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.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.4836532449963093`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(30787504\\), The time = \\!\
\\(17.041661`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 30787504, 17.041661],
  Editable->False]], "Print",
 CellChangeTimes->{3.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.48365324499795*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.483653244999482*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.4836532450009317`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(30801968\\), The time = \\!\
\\(17.057113`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 30801968, 17.057113],
  Editable->False]], "Print",
 CellChangeTimes->{3.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.4836532450024223`*^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.469402236323004*^9, 3.469402368124915*^9, 
  3.471554801929744*^9, 3.471554856074422*^9, 3.471577742794221*^9, 
  3.483651807843328*^9, 3.4836532450039043`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.04010900000000106`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.4694022363264313`*^9, 3.469402368180459*^9, 
  3.471554801995199*^9, 3.4715548560890636`*^9, 3.4715777428619347`*^9, 
  3.4836518078585463`*^9, 3.483653245006221*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", "\<\"xse1[z1_, z2_]=-(b10*z1)/2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469402236386896*^9, 3.469402368241015*^9, 
  3.471554802036454*^9, 3.4715548561285686`*^9, 3.471577742904831*^9, 
  3.483651807897768*^9, 3.483653245038846*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", "\<\"eta1[z1_, z2_]=b10\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469402236449149*^9, 3.469402368296914*^9, 
  3.471554802090892*^9, 3.4715548561912394`*^9, 3.471577742963723*^9, 
  3.483651807960288*^9, 3.4836532450932827`*^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[{"-", 
   FractionBox[
    RowBox[{"b10", " ", "x"}], "2"]}], "}"}]], "Output",
 CellChangeTimes->{3.469402236503869*^9, 3.469402368362331*^9, 
  3.47155480213527*^9, 3.471554856244872*^9, 3.4715777430210657`*^9, 
  3.483651808015402*^9, 3.483653245144959*^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[{"{", "b10", "}"}]], "Output",
 CellChangeTimes->{3.4694022365662746`*^9, 3.469402368424706*^9, 
  3.4715548021912613`*^9, 3.471554856330928*^9, 3.471577743071824*^9, 
  3.483651808100225*^9, 3.483653245194079*^9}]
}, Open  ]],

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

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[{"-", 
      FractionBox["x", "2"]}], "}"}], ",", 
    RowBox[{"{", "1", "}"}]}], "}"}], "}"}]], "Output",
 CellChangeTimes->{3.469402236632667*^9, 3.469402368479773*^9, 
  3.471554802241294*^9, 3.4715548564145803`*^9, 3.471577743121772*^9, 
  3.483651808287047*^9, 3.483653245244522*^9}]
}, Open  ]],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"-", 
         FractionBox["x", "2"]}], "}"}], ",", 
       RowBox[{"{", "1", "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469402236676635*^9, 3.469402368541993*^9, 
  3.471554802286701*^9, 3.4715548566019087`*^9, 3.471577743171969*^9, 
  3.4836518083718224`*^9, 3.4836532452942133`*^9}],

Cell[TextData[StyleBox["This process has correctly captured the group \
(xse,eta)=(-x/2,1).",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"-", 
         FractionBox["x", "2"]}], "}"}], ",", 
       RowBox[{"{", "1", "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469402236731016*^9, 3.469402368604485*^9, 
  3.471554802342708*^9, 3.4715548566826*^9, 3.4715777432222147`*^9, 
  3.483651808451251*^9, 3.483653245421473*^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"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.4715548567654123`*^9, 3.471577743267693*^9, 
  3.483651808534587*^9, 3.483653245478698*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The presence of Exp[y] in the determining equations \
suggests that we search for trancendental solutions of the determining \
equations. To make further progress let's use the following form of the \
infinitesimals to try to simplify the determining equations.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

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

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

Cell[CellGroupData[{

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["z1", "2"]}], " ", 
       RowBox[{
        SuperscriptBox["f", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
       RowBox[{
        SuperscriptBox["g", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["\[ExponentialE]", "z2"], " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{"-", 
           FractionBox[
            RowBox[{"b10", " ", "z1"}], "2"]}], "+", 
          RowBox[{"f", "[", 
           RowBox[{"z1", ",", "z2"}], "]"}]}], ")"}]}], "-", 
       RowBox[{
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{"(", 
         RowBox[{"b10", "+", 
          RowBox[{"g", "[", 
           RowBox[{"z1", ",", "z2"}], "]"}]}], ")"}]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["g", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"3", " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{"-", 
           FractionBox["b10", "2"]}], "+", 
          RowBox[{
           SuperscriptBox["f", 
            TagBox[
             RowBox[{"(", 
              RowBox[{"1", ",", "0"}], ")"}],
             Derivative],
            MultilineFunction->None], "[", 
           RowBox[{"z1", ",", "z2"}], "]"}]}], ")"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["g", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["f", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "4"}], " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["f", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["g", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["g", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{
         SuperscriptBox["f", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469402236842441*^9, 3.469402368769903*^9, 
  3.471554802498254*^9, 3.471554856919168*^9, 3.4715777433838053`*^9, 
  3.483651808688232*^9, 3.4836532455876493`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{"z1", " ", 
       RowBox[{
        SuperscriptBox["f", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
       RowBox[{
        SuperscriptBox["g", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       SuperscriptBox["\[ExponentialE]", "z2"], " ", 
       RowBox[{"(", 
        RowBox[{
         RowBox[{"f", "[", 
          RowBox[{"z1", ",", "z2"}], "]"}], "-", 
         RowBox[{"z1", " ", 
          RowBox[{"(", 
           RowBox[{
            RowBox[{"g", "[", 
             RowBox[{"z1", ",", "z2"}], "]"}], "-", 
            RowBox[{"2", " ", 
             RowBox[{
              SuperscriptBox["g", 
               TagBox[
                RowBox[{"(", 
                 RowBox[{"0", ",", "1"}], ")"}],
                Derivative],
               MultilineFunction->None], "[", 
              RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
            RowBox[{"3", " ", 
             RowBox[{
              SuperscriptBox["f", 
               TagBox[
                RowBox[{"(", 
                 RowBox[{"1", ",", "0"}], ")"}],
                Derivative],
               MultilineFunction->None], "[", 
              RowBox[{"z1", ",", "z2"}], "]"}]}]}], ")"}]}]}], ")"}]}], 
      "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{"z1", " ", 
       RowBox[{
        SuperscriptBox["g", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", 
      RowBox[{"2", " ", "z1", " ", 
       RowBox[{
        SuperscriptBox["f", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}]}]},
    {
     RowBox[{
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["g", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"2", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", 
      RowBox[{"4", " ", 
       SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
       RowBox[{
        SuperscriptBox["f", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}]}]},
    {
     RowBox[{
      RowBox[{"2", " ", "z1", " ", 
       RowBox[{
        SuperscriptBox["g", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", 
      RowBox[{"z1", " ", 
       RowBox[{
        SuperscriptBox["f", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"2", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}]}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.4694022368937063`*^9, 3.4694023688279467`*^9, 
  3.4715548025552053`*^9, 3.471554856959895*^9, 3.471577743443087*^9, 
  3.483651808727372*^9, 3.483653245644079*^9}]
}, Open  ]],

Cell[TextData[StyleBox["Encouraged by the 4th and 5th equations in the last \
step, we now try the ansatz,",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

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

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

Cell[CellGroupData[{

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

Cell[BoxData[
 TagBox[GridBox[{
    {"True"},
    {"True"},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["\[ExponentialE]", "z2"], " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{"-", 
           FractionBox[
            RowBox[{"b10", " ", "z1"}], "2"]}], "+", 
          RowBox[{"f", "[", "z1", "]"}]}], ")"}]}], "-", 
       RowBox[{
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{"(", 
         RowBox[{"b10", "+", 
          RowBox[{"g", "[", "z2", "]"}]}], ")"}]}], "-", 
       RowBox[{"3", " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{"(", 
         RowBox[{
          RowBox[{"-", 
           FractionBox["b10", "2"]}], "+", 
          RowBox[{
           SuperscriptBox["f", "\[Prime]",
            MultilineFunction->None], "[", "z1", "]"}]}], ")"}]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["\[ExponentialE]", "z2"], " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["g", "\[Prime]",
          MultilineFunction->None], "[", "z2", "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       SuperscriptBox["z1", "2"], " ", 
       RowBox[{
        SuperscriptBox["g", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "z2", "]"}]}], "\[Equal]", "0"}]},
    {"True"},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["z1", "2"]}], " ", 
       RowBox[{
        SuperscriptBox["f", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "z1", "]"}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469402237008252*^9, 3.469402368934091*^9, 
  3.471554802664291*^9, 3.471554857068326*^9, 3.4715777435312443`*^9, 
  3.483651808838172*^9, 3.483653245772932*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 TagBox[GridBox[{
    {"True"},
    {"True"},
    {
     RowBox[{
      RowBox[{
       SuperscriptBox["\[ExponentialE]", "z2"], " ", 
       RowBox[{"(", 
        RowBox[{
         RowBox[{"f", "[", "z1", "]"}], "-", 
         RowBox[{"z1", " ", 
          RowBox[{"(", 
           RowBox[{
            RowBox[{"g", "[", "z2", "]"}], "+", 
            RowBox[{"3", " ", 
             RowBox[{
              SuperscriptBox["f", "\[Prime]",
               MultilineFunction->None], "[", "z1", "]"}]}], "-", 
            RowBox[{"2", " ", 
             RowBox[{
              SuperscriptBox["g", "\[Prime]",
               MultilineFunction->None], "[", "z2", "]"}]}]}], ")"}]}]}], 
        ")"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{"z1", " ", 
       RowBox[{
        SuperscriptBox["g", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "z2", "]"}]}], "\[Equal]", "0"}]},
    {"True"},
    {
     RowBox[{
      RowBox[{"z1", " ", 
       RowBox[{
        SuperscriptBox["f", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "z1", "]"}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469402237048373*^9, 3.4694023690509977`*^9, 
  3.4715548027048073`*^9, 3.471554857109524*^9, 3.47157774356924*^9, 
  3.483651808877939*^9, 3.48365324581145*^9}]
}, Open  ]],

Cell[TextData[StyleBox["More effort is required here but so far it looks like \
the the only solution is the result given by the package.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

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

Cell[BoxData["30853496"], "Output",
 CellChangeTimes->{3.469402237099174*^9, 3.469402369109941*^9, 
  3.4715548027526417`*^9, 3.471554857163823*^9, 3.471577743622307*^9, 
  3.483651808933195*^9, 3.483653245861683*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{1148, 1023},
WindowMargins->{{10, Automatic}, {Automatic, 24}},
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, 241, 4, 76, "Text"],
Cell[789, 26, 124, 1, 32, "Text"],
Cell[916, 29, 160, 4, 33, "Input"],
Cell[1079, 35, 476, 13, 32, "Text"],
Cell[1558, 50, 93, 1, 33, "Input"],
Cell[1654, 53, 68, 0, 32, "Text"],
Cell[1725, 55, 112, 4, 50, "Input"],
Cell[1840, 61, 218, 4, 51, "Text"],
Cell[2061, 67, 112, 4, 50, "Input"],
Cell[2176, 73, 130, 2, 32, "Text"],
Cell[2309, 77, 118, 3, 33, "Input"],
Cell[2430, 82, 128, 2, 32, "Text"],
Cell[2561, 86, 116, 3, 33, "Input"],
Cell[2680, 91, 235, 4, 32, "Text"],
Cell[2918, 97, 111, 3, 33, "Input"],
Cell[3032, 102, 141, 2, 32, "Text"],
Cell[3176, 106, 67, 2, 33, "Input"],
Cell[3246, 110, 402, 6, 51, "Text"],
Cell[3651, 118, 67, 2, 33, "Input"],
Cell[3721, 122, 521, 7, 70, "Text"],
Cell[4245, 131, 71, 2, 33, "Input"],
Cell[4319, 135, 535, 8, 70, "Text"],
Cell[4857, 145, 79, 2, 33, "Input"],
Cell[4939, 149, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5232, 157, 193, 5, 66, "Input"],
Cell[5428, 164, 515, 9, 25, "Print"],
Cell[5946, 175, 1096, 15, 159, "Print"],
Cell[7045, 192, 765, 12, 45, "Print"],
Cell[7813, 206, 483, 9, 25, "Print"],
Cell[8299, 217, 1098, 15, 178, "Print"],
Cell[9400, 234, 276, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9713, 244, 50, 0, 33, "Input"],
Cell[9766, 246, 265, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10068, 255, 68, 1, 33, "Input"],
Cell[10139, 258, 1026, 30, 62, "Output"]
}, Open  ]],
Cell[11180, 291, 106, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[11311, 298, 70, 1, 33, "Input"],
Cell[11384, 301, 831, 15, 129, "Output"]
}, Open  ]],
Cell[12230, 319, 130, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[12385, 327, 93, 1, 33, "Input"],
Cell[12481, 330, 3894, 127, 118, "Output"]
}, Open  ]],
Cell[16390, 460, 98, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[16513, 466, 62, 1, 33, "Input"],
Cell[16578, 469, 344, 8, 33, "Output"]
}, Open  ]],
Cell[16937, 480, 161, 4, 32, "Text"],
Cell[17101, 486, 411, 12, 33, "Input"],
Cell[17515, 500, 4284, 135, 153, "Output"],
Cell[21802, 637, 509, 11, 126, "Text"],
Cell[CellGroupData[{
Cell[22336, 652, 239, 6, 66, "Input"],
Cell[22578, 660, 946, 15, 64, "Print"],
Cell[23527, 677, 508, 7, 64, "Print"],
Cell[24038, 686, 401, 7, 25, "Print"],
Cell[24442, 695, 387, 7, 25, "Print"],
Cell[24832, 704, 410, 8, 25, "Print"],
Cell[25245, 714, 390, 5, 45, "Print"],
Cell[25638, 721, 400, 7, 25, "Print"],
Cell[26041, 730, 233, 3, 25, "Print"],
Cell[26277, 735, 279, 4, 25, "Print"],
Cell[26559, 741, 403, 7, 25, "Print"],
Cell[26965, 750, 1156, 15, 197, "Print"],
Cell[28124, 767, 283, 5, 33, "Output"]
}, Open  ]],
Cell[28422, 775, 108, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[28555, 782, 61, 1, 33, "Input"],
Cell[28619, 785, 265, 4, 33, "Output"]
}, Open  ]],
Cell[28899, 792, 48, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[28972, 796, 61, 1, 33, "Input"],
Cell[29036, 799, 259, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[29332, 808, 144, 3, 32, "Text"],
Cell[29479, 813, 115, 3, 33, "Input"],
Cell[29597, 818, 298, 7, 53, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[29932, 830, 143, 2, 32, "Text"],
Cell[30078, 834, 115, 3, 33, "Input"],
Cell[30196, 839, 236, 4, 33, "Output"]
}, Open  ]],
Cell[30447, 846, 67, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[30539, 850, 226, 6, 33, "Input"],
Cell[30768, 858, 375, 10, 50, "Output"]
}, Open  ]],
Cell[31158, 871, 79, 1, 33, "Input"],
Cell[31240, 874, 540, 15, 47, "Output"],
Cell[31783, 891, 157, 3, 32, "Text"],
Cell[31943, 896, 79, 1, 33, "Input"],
Cell[32025, 899, 534, 15, 47, "Output"],
Cell[32562, 916, 154, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[32741, 923, 188, 4, 33, "Input"],
Cell[32932, 929, 250, 6, 33, "Output"]
}, Open  ]],
Cell[33197, 938, 351, 5, 51, "Text"],
Cell[33551, 945, 286, 10, 33, "Input"],
Cell[33840, 957, 190, 6, 33, "Input"],
Cell[34033, 965, 173, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[34231, 972, 53, 0, 33, "Input"],
Cell[34287, 974, 4579, 145, 161, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[38903, 1124, 61, 1, 33, "Input"],
Cell[38967, 1127, 3897, 125, 157, "Output"]
}, Open  ]],
Cell[42879, 1255, 172, 3, 32, "Text"],
Cell[43054, 1260, 260, 9, 33, "Input"],
Cell[43317, 1271, 164, 5, 33, "Input"],
Cell[43484, 1278, 173, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[43682, 1285, 53, 0, 33, "Input"],
Cell[43738, 1287, 1940, 56, 149, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[45715, 1348, 61, 1, 33, "Input"],
Cell[45779, 1351, 1469, 43, 135, "Output"]
}, Open  ]],
Cell[47263, 1397, 203, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[47491, 1404, 66, 1, 33, "Input"],
Cell[47560, 1407, 217, 3, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
