(* 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[     51974,       1491]
NotebookOptionsPosition[     47537,       1352]
NotebookOutlinePosition[     48315,       1379]
CellTagsIndexPosition[     48272,       1376]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[StyleBox["Use the package IntroToSymmetry.m to work out the \
point group of of the 2rd order ODE\n\nYxx+(2Yx+2cYx^(3/2)+2Yx^2)/(x-Y)=0.",
 FontSize->14,
 FontWeight->"Plain"]], "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.472047016949135*^9, 
  3.472047017499419*^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, ie, in quotes.", "Text"],

Cell["\<\
inputequation=
\"D[y[x],x,x]+2*(D[y[x],x]/(x-y[x]))+2*c*(D[y[x],x]^(3/2)/(x-y[x]))+2*(D[y[x],\
x]^2/(x-y[x]))\";\
\>", "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 to the invariance condition. Replace the second derivative wherever \
it appears in the invariance condition.\
\>", "Text"],

Cell["\<\
rulesarray=
{\"D[y[x],x,x]->-
(2*(D[y[x],x]/(x-y[x]))+
2*c*(D[y[x],x]^(3/2)/(x-y[x]))+
2*(D[y[x],x]^2/(x-y[x])))\"};\
\>", "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 \
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[{"{", "\"\<c\>\"", "}"}]}], ";"}]], "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 \
infinitesimalsare assumed to depend on is specified by the input parameter r. \
This parameter is only nonzero when the user is looking for Lie contact \
groups or Lie-Backlund groups. For the usual case where one is searching for \
point groups one sets r=0.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

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

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

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

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

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

Cell[CellGroupData[{

Cell["\<\
Timing[FindDeterminingEquations[
independentvariables,dependentvariables,frozennames,p,r,xseon,inputequation,\
rulesarray,internalrules]]\
\>", "Input",
 PageWidth->WindowWidth,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(30463832\\), the time used = \\!\\(9.18261`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 30463832, 9.18261],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694017410901327`*^9, 3.4694018237572193`*^9, 
  3.469401888820813*^9, 3.4715547539087954`*^9, 3.471577214006572*^9, 
  3.483651437113822*^9, 3.4836516154094*^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.4694017410901327`*^9, 3.4694018237572193`*^9, 
  3.469401888820813*^9, 3.4715547539087954`*^9, 3.471577214006572*^9, 
  3.483651437113822*^9, 3.483651615467987*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(7\\), the \
byte count of zdeterminingequations = \\!\\(1952\\), the memory in use = \
\\!\\(30492968\\), the time used = \\!\\(9.264097`\\)\"\>",
  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 = ``", 7, 1952, 30492968, 
   9.264097],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694017410901327`*^9, 3.4694018237572193`*^9, 
  3.469401888820813*^9, 3.4715547539087954`*^9, 3.471577214006572*^9, 
  3.483651437113822*^9, 3.483651615518701*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(30493712\\), the time used = \\!\\(9.264315`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 30493712, 9.264315],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694017410901327`*^9, 3.4694018237572193`*^9, 
  3.469401888820813*^9, 3.4715547539087954`*^9, 3.471577214006572*^9, 
  3.483651437113822*^9, 3.4836516155211*^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.4694017410901327`*^9, 3.4694018237572193`*^9, 
  3.469401888820813*^9, 3.4715547539087954`*^9, 3.471577214006572*^9, 
  3.483651437113822*^9, 3.4836516155231733`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.08242699999999914`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469401741277927*^9, 3.4694018238517847`*^9, 
  3.469401889027527*^9, 3.47155475409897*^9, 3.471577214102009*^9, 
  3.483651437206736*^9, 3.483651615526278*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1]+2*(D[y1[x1],x1]/(x1-y1[x1]))+2*c*(D[y1[x1],\
x1]^(3/2)/(x1-y1[x1]))+2*(D[y1[x1],x1]^2/(x1-y1[x1]))\"\>"], "Output",
 CellChangeTimes->{3.4694017413627*^9, 3.469401823902725*^9, 
  3.469401889108979*^9, 3.471554754180993*^9, 3.471577214144449*^9, 
  3.483651437248465*^9, 3.4836516155637302`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{"-", 
     FractionBox[
      RowBox[{"2", " ", 
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}]}], 
      SuperscriptBox[
       RowBox[{"(", 
        RowBox[{"x1", "-", 
         RowBox[{"y1", "[", "x1", "]"}]}], ")"}], "2"]]}], "-", 
    FractionBox[
     RowBox[{"2", " ", "c", " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], 
       RowBox[{"3", "/", "2"}]]}], 
     SuperscriptBox[
      RowBox[{"(", 
       RowBox[{"x1", "-", 
        RowBox[{"y1", "[", "x1", "]"}]}], ")"}], "2"]], "-", 
    FractionBox[
     RowBox[{"2", " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"]}], 
     SuperscriptBox[
      RowBox[{"(", 
       RowBox[{"x1", "-", 
        RowBox[{"y1", "[", "x1", "]"}]}], ")"}], "2"]]}], ",", 
   RowBox[{
    FractionBox[
     RowBox[{"2", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], 
     SuperscriptBox[
      RowBox[{"(", 
       RowBox[{"x1", "-", 
        RowBox[{"y1", "[", "x1", "]"}]}], ")"}], "2"]], "+", 
    FractionBox[
     RowBox[{"2", " ", "c", " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], 
       RowBox[{"3", "/", "2"}]]}], 
     SuperscriptBox[
      RowBox[{"(", 
       RowBox[{"x1", "-", 
        RowBox[{"y1", "[", "x1", "]"}]}], ")"}], "2"]], "+", 
    FractionBox[
     RowBox[{"2", " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"]}], 
     SuperscriptBox[
      RowBox[{"(", 
       RowBox[{"x1", "-", 
        RowBox[{"y1", "[", "x1", "]"}]}], ")"}], "2"]]}], ",", 
   RowBox[{
    FractionBox["2", 
     RowBox[{"x1", "-", 
      RowBox[{"y1", "[", "x1", "]"}]}]], "+", 
    FractionBox[
     RowBox[{"3", " ", "c", " ", 
      SqrtBox[
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}]]}], 
     RowBox[{"x1", "-", 
      RowBox[{"y1", "[", "x1", "]"}]}]], "+", 
    FractionBox[
     RowBox[{"4", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], 
     RowBox[{"x1", "-", 
      RowBox[{"y1", "[", "x1", "]"}]}]]}], ",", "1"}], "}"}]], "Output",
 CellChangeTimes->{3.4694017414231*^9, 3.469401823964973*^9, 
  3.469401889167548*^9, 3.471554754241519*^9, 3.47157721420052*^9, 
  3.4836514373039703`*^9, 3.483651615619669*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"3*c*z1*Derivative[0, 1][xse1][z1, z2] - 3*c*z2*Derivative[0, \
1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"2*z1*Derivative[0, 1][xse1][z1, z2] - 2*z2*Derivative[0, \
1][xse1][z1, z2] - z1^2*Derivative[0, 2][xse1][z1, z2] + \
2*z1*z2*Derivative[0, 2][xse1][z1, z2] - z2^2*Derivative[0, 2][xse1][z1, z2] \
== 0\"\>", 
   ",", "\<\"3*c*z1*Derivative[1, 0][eta1][z1, z2] - 3*c*z2*Derivative[1, \
0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"2*c*eta1[z1, z2] - 2*c*xse1[z1, z2] + c*z1*Derivative[0, \
1][eta1][z1, z2] - c*z2*Derivative[0, 1][eta1][z1, z2] + c*z1*Derivative[1, \
0][xse1][z1, z2] - c*z2*Derivative[1, 0][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"2*eta1[z1, z2] - 2*xse1[z1, z2] + 2*z1*Derivative[0, \
1][eta1][z1, z2] - 2*z2*Derivative[0, 1][eta1][z1, z2] + 4*z1*Derivative[0, \
1][xse1][z1, z2] - 4*z2*Derivative[0, 1][xse1][z1, z2] + z1^2*Derivative[0, \
2][eta1][z1, z2] - 2*z1*z2*Derivative[0, 2][eta1][z1, z2] + \
z2^2*Derivative[0, 2][eta1][z1, z2] - 2*z1^2*Derivative[1, 1][xse1][z1, z2] + \
4*z1*z2*Derivative[1, 1][xse1][z1, z2] - 2*z2^2*Derivative[1, 1][xse1][z1, \
z2] == 0\"\>", 
   ",", "\<\"2*z1*Derivative[1, 0][eta1][z1, z2] - 2*z2*Derivative[1, \
0][eta1][z1, z2] + z1^2*Derivative[2, 0][eta1][z1, z2] - \
2*z1*z2*Derivative[2, 0][eta1][z1, z2] + z2^2*Derivative[2, 0][eta1][z1, z2] \
== 0\"\>", 
   ",", "\<\"2*eta1[z1, z2] - 2*xse1[z1, z2] + 4*z1*Derivative[1, \
0][eta1][z1, z2] - 4*z2*Derivative[1, 0][eta1][z1, z2] + 2*z1*Derivative[1, \
0][xse1][z1, z2] - 2*z2*Derivative[1, 0][xse1][z1, z2] + 2*z1^2*Derivative[1, \
1][eta1][z1, z2] - 4*z1*z2*Derivative[1, 1][eta1][z1, z2] + \
2*z2^2*Derivative[1, 1][eta1][z1, z2] - z1^2*Derivative[2, 0][xse1][z1, z2] + \
2*z1*z2*Derivative[2, 0][xse1][z1, z2] - z2^2*Derivative[2, 0][xse1][z1, z2] \
== 0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.469401741490056*^9, 3.469401824014783*^9, 
  3.469401889239788*^9, 3.4715547543115063`*^9, 3.4715772142454453`*^9, 
  3.483651437353856*^9, 3.483651615669866*^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",
 PageWidth->WindowWidth,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{
     RowBox[{"3", " ", "c", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"3", " ", "c", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"2", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"2", " ", "z1", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox["z2", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"3", " ", "c", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"3", " ", "c", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"2", " ", "c", " ", 
      RowBox[{"eta1", "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", "c", " ", 
      RowBox[{"xse1", "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"c", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"c", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"c", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"c", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"2", " ", 
      RowBox[{"eta1", "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", 
      RowBox[{"xse1", "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"2", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"4", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"4", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", "z1", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox["z2", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "2"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", 
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"4", " ", "z1", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         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"}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"2", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", "z1", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "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"}], "]"}]}]}], "\[Equal]", "0"}], ",", 
   RowBox[{
    RowBox[{
     RowBox[{"2", " ", 
      RowBox[{"eta1", "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", 
      RowBox[{"xse1", "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"4", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"4", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"2", " ", "z1", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"2", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"2", " ", 
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{"4", " ", "z1", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"1", ",", "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[{
      SuperscriptBox["z1", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
     RowBox[{"2", " ", "z1", " ", "z2", " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
     RowBox[{
      SuperscriptBox["z2", "2"], " ", 
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.4694017415794783`*^9, 3.469401824066739*^9, 
  3.469401889327344*^9, 3.4715547543999987`*^9, 3.4715772143010483`*^9, 
  3.483651437401779*^9, 3.483651615716078*^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.469401741662088*^9, 3.4694018241143208`*^9, 
  3.469401889404604*^9, 3.471554754498847*^9, 3.4715772143449163`*^9, 
  3.483651437453787*^9, 3.483651615764029*^9}]
}, Open  ]],

Cell["\<\
Now solve the determining equations in terms of multivariable polynomials of \
some 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=5]]\
\>", "Input",
 PageWidth->WindowWidth,
 CellChangeTimes->{{3.469401680860421*^9, 3.4694016844496813`*^9}, {
  3.469401815948927*^9, 3.4694018349880953`*^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 = \\!\\(21\\)\"\>",
  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 = ``", 21],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.483651615818782*^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.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.48365161586366*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(30629328\\), The time = \\!\
\\(9.330484`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 30629328, 9.330484],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.4836516158648767`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(42\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 42],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.483651615866047*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(140\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 140],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.483651615867227*^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.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.483651615868559*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(30670464\\), The time = \\!\
\\(9.336911`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 30670464, 9.336911],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.4836516158697433`*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.4836516158708467`*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.483651615871996*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(30702000\\), The time = \\!\
\\(9.346055`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 30702000, 9.346055],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.483651615873146*^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.4694017417271137`*^9, 3.469401824169405*^9, 
  3.469401889517247*^9, 3.471554754559441*^9, 3.471577214402055*^9, 
  3.483651437484767*^9, 3.483651615875093*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.0730580000000014`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469401741784552*^9, 3.469401824174292*^9, 
  3.469401889611619*^9, 3.471554754657599*^9, 3.4715772144303923`*^9, 
  3.483651437560316*^9, 3.483651615876163*^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_]=b10 + b16*z1 + b111*z1^2\"\>", 
  "}"}]], "Output",
 CellChangeTimes->{3.4694017418311977`*^9, 3.469401824231256*^9, 
  3.469401889733816*^9, 3.4715547548088093`*^9, 3.4715772144789467`*^9, 
  3.483651437586956*^9, 3.483651615914349*^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_]=b10 + b16*z2 + b111*z2^2\"\>", 
  "}"}]], "Output",
 CellChangeTimes->{3.469401741957931*^9, 3.4694018242862577`*^9, 
  3.469401889790842*^9, 3.4715547548674726`*^9, 3.471577214511209*^9, 
  3.4836514376374693`*^9, 3.483651615968853*^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[{"b10", "+", 
   RowBox[{"b16", " ", "x"}], "+", 
   RowBox[{"b111", " ", 
    SuperscriptBox["x", "2"]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469401742014*^9, 3.469401824346715*^9, 
  3.469401889841014*^9, 3.471554754917877*^9, 3.471577214566246*^9, 
  3.4836514376668653`*^9, 3.483651616014192*^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[{"b10", "+", 
   RowBox[{"b16", " ", 
    RowBox[{"y", "[", "x", "]"}]}], "+", 
   RowBox[{"b111", " ", 
    SuperscriptBox[
     RowBox[{"y", "[", "x", "]"}], "2"]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469401742064242*^9, 3.469401824402791*^9, 
  3.469401889891621*^9, 3.471554754967894*^9, 3.4715772146289797`*^9, 
  3.4836514377204638`*^9, 3.4836516160809526`*^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[{"{", "1", "}"}], ",", 
     RowBox[{"{", "1", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "x", "}"}], ",", 
     RowBox[{"{", "y", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      SuperscriptBox["x", "2"], "}"}], ",", 
     RowBox[{"{", 
      SuperscriptBox["y", "2"], "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469401742114697*^9, 3.4694018244659367`*^9, 
  3.4694018899411297`*^9, 3.471554755017198*^9, 3.471577214684204*^9, 
  3.483651437747589*^9, 3.483651616242997*^9}]
}, Open  ]],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "1", "}"}], ",", 
       RowBox[{"{", "1", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "x", "}"}], ",", 
       RowBox[{"{", "y", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        SuperscriptBox["x", "2"], "}"}], ",", 
       RowBox[{"{", 
        SuperscriptBox["y", "2"], "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469401742165299*^9, 3.4694018246085463`*^9, 
  3.469401889991672*^9, 3.471554755069004*^9, 3.47157721482409*^9, 
  3.48365143780536*^9, 3.483651616294009*^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"}], "}"}]], "Output",
 CellChangeTimes->{3.4715547668182707`*^9, 3.4715772148837547`*^9, 
  3.4836514379287663`*^9, 3.483651616364996*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The final result indicates that the equation is \
invariant under three groups. The parameter b17 corresponds to a projective \
group, the parameter b14 represents a dilation in x and y and b10 is a \
translation in x and y. Now generate the commutator table.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"MakeCommutatorTable", "[", 
  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.469401742214987*^9, 3.469401824696031*^9, 
  3.469401890042275*^9, 3.4715547551179543`*^9, 3.4715772149308987`*^9, 
  3.4836514379893303`*^9, 3.483651616430944*^9}]
}, Open  ]],

Cell[TextData[StyleBox["Put the commutator table in readable form.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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"},
         {"1"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{"2", " ", "x"}]},
         {
          RowBox[{"2", " ", "y"}]}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]},
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{"-", "1"}]},
         {
          RowBox[{"-", "1"}]}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {"0"},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          SuperscriptBox["x", "2"]},
         {
          SuperscriptBox["y", "2"]}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]},
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{
           RowBox[{"-", "2"}], " ", "x"}]},
         {
          RowBox[{
           RowBox[{"-", "2"}], " ", "y"}]}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{"-", 
           SuperscriptBox["x", "2"]}]},
         {
          RowBox[{"-", 
           SuperscriptBox["y", "2"]}]}
        },
        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.469401742266313*^9, 3.469401824773128*^9, 
  3.469401890096084*^9, 3.4715547551718493`*^9, 3.471577214979909*^9, 
  3.483651438022779*^9, 3.483651616498749*^9}]
}, Open  ]],

Cell[TextData[StyleBox["This is a nonsolvable Lie algebra.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{1002, 1058},
WindowMargins->{{41, Automatic}, {Automatic, 44}},
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, 231, 4, 76, "Text"],
Cell[779, 26, 124, 1, 32, "Text"],
Cell[906, 29, 160, 4, 33, "Input"],
Cell[1069, 35, 474, 13, 32, "Text"],
Cell[1546, 50, 118, 2, 33, "Input"],
Cell[1667, 54, 68, 0, 32, "Text"],
Cell[1738, 56, 194, 6, 50, "Input"],
Cell[1935, 64, 219, 4, 51, "Text"],
Cell[2157, 70, 198, 8, 98, "Input"],
Cell[2358, 80, 130, 2, 32, "Text"],
Cell[2491, 84, 118, 3, 33, "Input"],
Cell[2612, 89, 128, 2, 32, "Text"],
Cell[2743, 93, 116, 3, 33, "Input"],
Cell[2862, 98, 232, 4, 32, "Text"],
Cell[3097, 104, 109, 3, 33, "Input"],
Cell[3209, 109, 141, 2, 32, "Text"],
Cell[3353, 113, 67, 2, 33, "Input"],
Cell[3423, 117, 389, 6, 70, "Text"],
Cell[3815, 125, 67, 2, 33, "Input"],
Cell[3885, 129, 509, 7, 70, "Text"],
Cell[4397, 138, 71, 2, 33, "Input"],
Cell[4471, 142, 535, 8, 70, "Text"],
Cell[5009, 152, 79, 2, 33, "Input"],
Cell[5091, 156, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5384, 164, 219, 6, 66, "Input"],
Cell[5606, 172, 516, 9, 45, "Print"],
Cell[6125, 183, 1103, 15, 197, "Print"],
Cell[7231, 200, 776, 13, 64, "Print"],
Cell[8010, 215, 486, 9, 25, "Print"],
Cell[8499, 226, 1107, 15, 197, "Print"],
Cell[9609, 243, 276, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9922, 253, 50, 0, 33, "Input"],
Cell[9975, 255, 329, 4, 53, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10341, 264, 93, 2, 33, "Input"],
Cell[10437, 268, 2768, 87, 123, "Output"]
}, Open  ]],
Cell[13220, 358, 112, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[13357, 365, 95, 2, 33, "Input"],
Cell[13455, 369, 2022, 33, 414, "Output"]
}, Open  ]],
Cell[15492, 405, 129, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[15646, 412, 118, 2, 33, "Input"],
Cell[15767, 416, 11926, 392, 334, "Output"]
}, Open  ]],
Cell[27708, 811, 98, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[27831, 817, 87, 2, 33, "Input"],
Cell[27921, 821, 349, 8, 33, "Output"]
}, Open  ]],
Cell[28285, 832, 513, 11, 145, "Text"],
Cell[CellGroupData[{
Cell[28823, 847, 315, 8, 66, "Input"],
Cell[29141, 857, 948, 15, 83, "Print"],
Cell[30092, 874, 509, 7, 83, "Print"],
Cell[30604, 883, 403, 7, 25, "Print"],
Cell[31010, 892, 389, 7, 25, "Print"],
Cell[31402, 901, 414, 8, 25, "Print"],
Cell[31819, 911, 390, 5, 45, "Print"],
Cell[32212, 918, 403, 7, 25, "Print"],
Cell[32618, 927, 237, 3, 25, "Print"],
Cell[32858, 932, 279, 4, 25, "Print"],
Cell[33140, 938, 401, 7, 25, "Print"],
Cell[33544, 947, 1156, 15, 235, "Print"],
Cell[34703, 964, 276, 5, 33, "Output"]
}, Open  ]],
Cell[34994, 972, 108, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[35127, 979, 86, 2, 33, "Input"],
Cell[35216, 983, 285, 5, 33, "Output"]
}, Open  ]],
Cell[35516, 991, 48, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[35589, 995, 86, 2, 33, "Input"],
Cell[35678, 999, 285, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[36000, 1009, 144, 3, 32, "Text"],
Cell[36147, 1014, 115, 3, 33, "Input"],
Cell[36265, 1019, 343, 8, 42, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[36645, 1032, 143, 2, 32, "Text"],
Cell[36791, 1036, 115, 3, 33, "Input"],
Cell[36909, 1041, 411, 10, 42, "Output"]
}, Open  ]],
Cell[37335, 1054, 67, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[37427, 1058, 226, 6, 33, "Input"],
Cell[37656, 1066, 626, 19, 42, "Output"]
}, Open  ]],
Cell[38297, 1088, 79, 1, 33, "Input"],
Cell[38379, 1091, 782, 25, 79, "Output"],
Cell[39164, 1118, 154, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[39343, 1125, 188, 4, 33, "Input"],
Cell[39534, 1131, 268, 6, 33, "Output"]
}, Open  ]],
Cell[39817, 1140, 349, 5, 51, "Text"],
Cell[CellGroupData[{
Cell[40191, 1149, 168, 4, 33, "Input"],
Cell[40362, 1155, 601, 8, 102, "Print"]
}, Open  ]],
Cell[40978, 1166, 132, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[41135, 1172, 77, 1, 33, "Input"],
Cell[41215, 1175, 6179, 170, 163, "Output"]
}, Open  ]],
Cell[47409, 1348, 124, 2, 32, "Text"]
}
]
*)

(* End of internal cache information *)
