(* 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[     58489,       1583]
NotebookOptionsPosition[     52205,       1394]
NotebookOutlinePosition[     52982,       1421]
CellTagsIndexPosition[     52939,       1418]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[StyleBox["In this example we use the package IntroToSymmetry.m \
to work out the groups for the second-order ODE \n\nYxx-(x^a)*Y^2=0 \n\n\
considered in homework excercise 8.6.",
 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.472046920816577*^9, 
  3.472046921439411*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"Needs", "[", "\"\<SymmetryAnalysis`IntroToSymmetry`\>\"", 
  "]"}]], "Input"],

Cell[TextData[StyleBox["Enter the input equation as a string. Don't include \
the ==0 at the end. The exponent a is arbitrary.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"inputequation", "=", "\n", "\"\<D[y[x],x,x]-(x^a)*y[x]^2\>\""}], 
  ";"}]], "Input"],

Cell[TextData[StyleBox["The function y[x] is a solution of the equation and \
this constraint must be applied in the form of a rule to the invariance \
condition.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"rulesarray", "=", "\[IndentingNewLine]", 
   RowBox[{"{", "\"\<D[y[x],x,x]->(x^a)*y[x]^2\>\"", "}"}]}], ";"}]], "Input"],

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

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

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

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

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

Cell[BoxData[
 RowBox[{
  RowBox[{"frozennames", "=", 
   RowBox[{"{", "\"\<a\>\"", "}"}]}], ";"}]], "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-Backlund groups. For the usual case where one is searching for point \
groups set r=0.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

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

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

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

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

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

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"FindDeterminingEquations", "[", "\[IndentingNewLine]", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "frozennames", ",",
     "p", ",", "r", ",", "xseon", ",", "\[IndentingNewLine]", "inputequation",
     ",", "rulesarray", ",", "internalrules"}], "]"}], "]"}]], "Input"],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(26434512\\), the time used = \\!\\(6.827993`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 26434512, 6.827993],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693985017133217`*^9, 3.471552215978442*^9, 
  3.471576855359138*^9, 3.483553798020612*^9, 3.483554478041647*^9, 
  3.4835549053585873`*^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.4693985017133217`*^9, 3.471552215978442*^9, 
  3.471576855359138*^9, 3.483553798020612*^9, 3.483554478041647*^9, 
  3.483554905415181*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(4\\), the \
byte count of zdeterminingequations = \\!\\(656\\), the memory in use = \
\\!\\(26446928\\), the time used = \\!\\(6.861688000000001`\\)\"\>",
  StringForm[
  "The determining equations have been expressed in terms of z-variables, the \
length of zdeterminingequations = ``, the byte count of zdeterminingequations \
= ``, the memory in use = ``, the time used = ``", 4, 656, 26446928, 
   6.861688000000001],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693985017133217`*^9, 3.471552215978442*^9, 
  3.471576855359138*^9, 3.483553798020612*^9, 3.483554478041647*^9, 
  3.483554905418352*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(26447672\\), the time used = \\!\\(6.8619`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 26447672, 6.8619],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693985017133217`*^9, 3.471552215978442*^9, 
  3.471576855359138*^9, 3.483553798020612*^9, 3.483554478041647*^9, 
  3.483554905420704*^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.4693985017133217`*^9, 3.471552215978442*^9, 
  3.471576855359138*^9, 3.483553798020612*^9, 3.483554478041647*^9, 
  3.4835549054230824`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.0346529999999996`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469398501734674*^9, 3.4715522160151663`*^9, 
  3.4715768554058657`*^9, 3.4835537980905743`*^9, 3.483554478079054*^9, 
  3.483554905426087*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1]-(x1^a)*y1[x1]^2\"\>"], "Output",
 CellChangeTimes->{3.46939850176616*^9, 3.471552216046857*^9, 
  3.471576855449099*^9, 3.483553798125024*^9, 3.4835544781111107`*^9, 
  3.483554905460126*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{"-", "a"}], " ", 
    SuperscriptBox["x1", 
     RowBox[{
      RowBox[{"-", "1"}], "+", "a"}]], " ", 
    SuperscriptBox[
     RowBox[{"y1", "[", "x1", "]"}], "2"]}], ",", 
   RowBox[{
    RowBox[{"-", "2"}], " ", 
    SuperscriptBox["x1", "a"], " ", 
    RowBox[{"y1", "[", "x1", "]"}]}], ",", "0", ",", "1"}], "}"}]], "Output",
 CellChangeTimes->{3.469398501796549*^9, 3.471552216102344*^9, 
  3.471576855495276*^9, 3.483553798180746*^9, 3.4835544781683407`*^9, 
  3.4835549055149117`*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469398501832209*^9, 3.471552216147703*^9, 
  3.471576855583412*^9, 3.483553798216268*^9, 3.483554478213849*^9, 
  3.48355490556542*^9}],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Here are the determining equations expressed in terms \
of z-variables. This output may be quite long. The equations in the table can \
be distinguished by the ==0 at the end of each item.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"-(z1*Derivative[0, 2][xse1][z1, z2]) == 0\"\>", 
   ",", "\<\"z1*Derivative[0, 2][eta1][z1, z2] - 2*z1*Derivative[1, \
1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-2*z1^(1 + a)*z2*eta1[z1, z2] - a*z1^a*z2^2*xse1[z1, z2] + z1^(1 \
+ a)*z2^2*Derivative[0, 1][eta1][z1, z2] - 2*z1^(1 + a)*z2^2*Derivative[1, \
0][xse1][z1, z2] + z1*Derivative[2, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"-3*z1^(1 + a)*z2^2*Derivative[0, 1][xse1][z1, z2] + \
2*z1*Derivative[1, 1][eta1][z1, z2] - z1*Derivative[2, 0][xse1][z1, z2] == \
0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.4693985018632927`*^9, 3.471552216202023*^9, 
  3.471576855628653*^9, 3.4835537982619143`*^9, 3.483554478268836*^9, 
  3.4835549056158524`*^9}]
}, Open  ]],

Cell["\<\
Lets look at the determining equations in a slightly more readable form.\
\>", "Text",
 FontWeight->"Plain",
 FontVariations->{"CompatibilityType"->0}],

Cell[BoxData[
 RowBox[{"zdeterminingequationscolumn", "=", 
  TagBox[
   FormBox[
    RowBox[{"Column", "[", 
     RowBox[{
      RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], ",", 
      RowBox[{"{", 
       RowBox[{"Left", ",", "Below"}], "}"}]}], "]"}],
    TraditionalForm],
   TraditionalForm,
   Editable->True]}]], "Input"],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", "z1"}], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"z1", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "2"}], " ", 
        SuperscriptBox["z1", 
         RowBox[{"1", "+", "a"}]], " ", "z2", " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"a", " ", 
        SuperscriptBox["z1", "a"], " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{"xse1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z1", 
         RowBox[{"1", "+", "a"}]], " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", 
         RowBox[{"1", "+", "a"}]], " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"z1", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "3"}], " ", 
        SuperscriptBox["z1", 
         RowBox[{"1", "+", "a"}]], " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"z1", " ", 
        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.46939850190023*^9, 3.471552216250004*^9, 
  3.4715768557161913`*^9, 3.4835537983285*^9, 3.483554478331237*^9, 
  3.483554905662402*^9}],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Now solve the determining equations in terms of \
multivariable polynomials of some selected order.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"SolveDeterminingEquations", "[", "\[IndentingNewLine]", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "r", ",", "xseon", 
    ",", "zdeterminingequations", ",", 
    RowBox[{"order", "=", "3"}]}], "]"}], "]"}]], "Input"],

Cell[BoxData[
 InterpretationBox["\<\"The variable powertablelength is the number of terms \
required for each multivariate polynomial used for the infinitesimals. This \
number is determined by the choice of polynomial order and the number of \
zvariables. The time needed to solve the determining equations increases as \
powertable increases. powertablelength = \\!\\(10\\)\"\>",
  StringForm[
  "The variable powertablelength is the number of terms required for each \
multivariate polynomial used for the infinitesimals. This number is \
determined by the choice of polynomial order and the number of zvariables. \
The time needed to solve the determining equations increases as powertable \
increases. powertablelength = ``", 10],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905716133*^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.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905719146*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26488912\\), The time = \\!\
\\(6.877678`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26488912, 6.877678],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905721223*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(20\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 20],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905723344*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(31\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 31],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.48355490572609*^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.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905728203*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26499872\\), The time = \\!\
\\(6.881478`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26499872, 6.881478],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905730144*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905731921*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905733585*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26507032\\), The time = \\!\
\\(6.889831000000001`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26507032, 6.889831000000001],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905735406*^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.469398501935072*^9, 3.4715522162988787`*^9, 
  3.471576855769762*^9, 3.4835537983958178`*^9, 3.483554478381219*^9, 
  3.483554905737527*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.02199900000000099`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469398501939303*^9, 3.4715522163101788`*^9, 
  3.471576855786721*^9, 3.483553798782316*^9, 3.483554478392099*^9, 
  3.4835549057403107`*^9}]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", "\<\"xse1[z1_, z2_]=a11*z1\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469398501979581*^9, 3.471552216348291*^9, 
  3.4715768558290873`*^9, 3.483553798956937*^9, 3.483554478431016*^9, 
  3.483554905777918*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", "\<\"eta1[z1_, z2_]=-((2 + a)*a11*z2)\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469398502016398*^9, 3.471552216402953*^9, 
  3.471576855882756*^9, 3.483553799040017*^9, 3.4835544784860067`*^9, 
  3.483554905831908*^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[{"a11", " ", "x"}], "}"}]], "Output",
 CellChangeTimes->{3.4693985020674067`*^9, 3.471552216448119*^9, 
  3.471576855928866*^9, 3.48355379909083*^9, 3.483554478547955*^9, 
  3.483554905882566*^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[{
   RowBox[{"-", 
    RowBox[{"(", 
     RowBox[{"2", "+", "a"}], ")"}]}], " ", "a11", " ", 
   RowBox[{"y", "[", "x", "]"}]}], "}"}]], "Output",
 CellChangeTimes->{3.4693985021171417`*^9, 3.471552216502843*^9, 
  3.471576855984064*^9, 3.4835537991401978`*^9, 3.4835544786017838`*^9, 
  3.483554905932517*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The package has correctly found the dilation group \
(xse, eta)=(x,-(2+a)y).  This is a little suprising in that the exponent \
\"a\" could be fractional in which case in which case one would not \
necessarily expect a polynomial solution of the determining equations to \
work.",
 FontWeight->"Plain"]], "Text",
 CellChangeTimes->{{3.4835545885510893`*^9, 3.483554646688918*^9}, {
  3.48355469130912*^9, 3.483554848220829*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["********************************************", "Text"],

Cell["Let's look at the case a=-5.", "Text"],

Cell[BoxData[
 RowBox[{
  RowBox[{"equation", "=", "\n", "\"\<D[y[x],x,x]-x^(-5)*y[x]^2\>\""}], 
  ";"}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"rulesarray", "=", "\[IndentingNewLine]", 
   RowBox[{"{", "\"\<D[y[x],x,x]->x^(-5)*y[x]^2\>\"", "}"}]}], ";"}]], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"FindDeterminingEquations", "[", "\[IndentingNewLine]", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "frozennames", ",",
     "p", ",", "r", ",", "\[IndentingNewLine]", "xseon", ",", "equation", ",",
     "rulesarray", ",", "internalrules"}], "]"}], "]"}]], "Input"],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(26476944\\), the time used = \\!\\(6.894376`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 26476944, 6.894376],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398502230112*^9, 3.4715522166125813`*^9, 
  3.471576856142973*^9, 3.4835537992719517`*^9, 3.48355447872502*^9, 
  3.483554906042625*^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.469398502230112*^9, 3.4715522166125813`*^9, 
  3.471576856142973*^9, 3.4835537992719517`*^9, 3.48355447872502*^9, 
  3.483554906044752*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(4\\), the \
byte count of zdeterminingequations = \\!\\(632\\), the memory in use = \
\\!\\(26484648\\), the time used = \\!\\(6.924196`\\)\"\>",
  StringForm[
  "The determining equations have been expressed in terms of z-variables, the \
length of zdeterminingequations = ``, the byte count of zdeterminingequations \
= ``, the memory in use = ``, the time used = ``", 4, 632, 26484648, 6.924196],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398502230112*^9, 3.4715522166125813`*^9, 
  3.471576856142973*^9, 3.4835537992719517`*^9, 3.48355447872502*^9, 
  3.483554906046721*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(26485392\\), the time used = \\!\\(6.924394`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 26485392, 6.924394],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398502230112*^9, 3.4715522166125813`*^9, 
  3.471576856142973*^9, 3.4835537992719517`*^9, 3.48355447872502*^9, 
  3.4835549060479813`*^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.469398502230112*^9, 3.4715522166125813`*^9, 
  3.471576856142973*^9, 3.4835537992719517`*^9, 3.48355447872502*^9, 
  3.483554906049108*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.03064599999999995`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469398502237236*^9, 3.47155221661895*^9, 
  3.4715768561499557`*^9, 3.483553799278254*^9, 3.483554478731185*^9, 
  3.483554906050908*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469398502267766*^9, 3.471552216652775*^9, 
  3.47157685618361*^9, 3.483553799310034*^9, 3.483554478841415*^9, 
  3.483554906082094*^9}],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"-(z1^6*Derivative[0, 2][xse1][z1, z2]) == 0\"\>", 
   ",", "\<\"z1^6*Derivative[0, 2][eta1][z1, z2] - 2*z1^6*Derivative[1, \
1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-2*z1*z2*eta1[z1, z2] + 5*z2^2*xse1[z1, z2] + \
z1*z2^2*Derivative[0, 1][eta1][z1, z2] - 2*z1*z2^2*Derivative[1, 0][xse1][z1, \
z2] + z1^6*Derivative[2, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"-3*z1*z2^2*Derivative[0, 1][xse1][z1, z2] + 2*z1^6*Derivative[1, \
1][eta1][z1, z2] - z1^6*Derivative[2, 0][xse1][z1, z2] == 0\"\>"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469398502318255*^9, 3.471552216699247*^9, 
  3.471576856230133*^9, 3.483553799344509*^9, 3.483554478886394*^9, 
  3.483554906196321*^9}],

Cell[CellGroupData[{

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

Cell[BoxData["4"], "Output",
 CellChangeTimes->{3.469398502346373*^9, 3.471552216753442*^9, 
  3.471576856280012*^9, 3.48355379937496*^9, 3.48355447891927*^9, 
  3.483554906229308*^9}]
}, Open  ]],

Cell["\<\
Look at the determining equations in a slightly more readable form.\
\>", "Text",
 FontWeight->"Plain",
 FontVariations->{"CompatibilityType"->0}],

Cell[BoxData[
 RowBox[{"zdeterminingequationscolumn", "=", 
  TagBox[
   FormBox[
    RowBox[{"Column", "[", 
     RowBox[{
      RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], ",", 
      RowBox[{"{", 
       RowBox[{"Left", ",", "Below"}], "}"}]}], "]"}],
    TraditionalForm],
   TraditionalForm,
   Editable->True]}]], "Input"],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["z1", "6"]}], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["z1", "6"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "6"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "2"}], " ", "z1", " ", "z2", " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"5", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{"xse1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"z1", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", "z1", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z1", "6"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "3"}], " ", "z1", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "6"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z1", "6"], " ", 
        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.4693985023848867`*^9, 3.4715522168805523`*^9, 
  3.471576856336071*^9, 3.483553799412468*^9, 3.483554478966818*^9, 
  3.483554906295999*^9}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"SolveDeterminingEquations", "[", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "r", ",", 
    "\[IndentingNewLine]", "xseon", ",", "zdeterminingequations", ",", 
    RowBox[{"order", "=", "3"}]}], "]"}], "]"}]], "Input",
 CellChangeTimes->{{3.469398444313428*^9, 3.4693984449923983`*^9}}],

Cell[BoxData[
 InterpretationBox["\<\"The variable powertablelength is the number of terms \
required for each multivariate polynomial used for the infinitesimals. This \
number is determined by the choice of polynomial order and the number of \
zvariables. The time needed to solve the determining equations increases as \
powertable increases. powertablelength = \\!\\(10\\)\"\>",
  StringForm[
  "The variable powertablelength is the number of terms required for each \
multivariate polynomial used for the infinitesimals. This number is \
determined by the choice of polynomial order and the number of zvariables. \
The time needed to solve the determining equations increases as powertable \
increases. powertablelength = ``", 10],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.483554906362406*^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.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.483554906400086*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26510480\\), The time = \\!\
\\(6.939563000000001`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26510480, 6.939563000000001],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.48355490643478*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(20\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 20],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.483554906469158*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(32\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 32],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.483554906502495*^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.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.483554906535172*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26513528\\), The time = \\!\
\\(6.940694000000001`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26513528, 6.940694000000001],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.483554906570044*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.483554906606155*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.4835549066357403`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26520112\\), The time = \\!\
\\(6.941562`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26520112, 6.941562],
  Editable->False]], "Print",
 CellChangeTimes->{3.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.4835549066708107`*^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.469398502413474*^9, 3.4715522169209347`*^9, 
  3.471576856382544*^9, 3.4835537994423656`*^9, 3.483554479015902*^9, 
  3.483554906704246*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.009324999999998695`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469398502417742*^9, 3.47155221693187*^9, 
  3.471576856393608*^9, 3.483553799452756*^9, 3.4835544790296707`*^9, 
  3.483554906734313*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{"{", "\<\"xse1[z1_, z2_]=(b14*z1)/3 + b15*z1^2\"\>", "}"}]], "Output",\

 CellChangeTimes->{3.46939850253053*^9, 3.471552216966571*^9, 
  3.471576856430726*^9, 3.483553799493416*^9, 3.48355447906601*^9, 
  3.483554906829726*^9}],

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

Cell[BoxData[
 RowBox[{"{", "\<\"eta1[z1_, z2_]=b14*z2 + b15*z1*z2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469398502564238*^9, 3.471552217020816*^9, 
  3.471576856484716*^9, 3.4835537995284233`*^9, 3.483554479102707*^9, 
  3.483554906896615*^9}],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   FractionBox[
    RowBox[{"b14", " ", "x"}], "3"], "+", 
   RowBox[{"b15", " ", 
    SuperscriptBox["x", "2"]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469398502600808*^9, 3.471552217066617*^9, 
  3.471576856529902*^9, 3.483553799562704*^9, 3.48355447918327*^9, 
  3.483554906963194*^9}],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"b14", " ", 
    RowBox[{"y", "[", "x", "]"}]}], "+", 
   RowBox[{"b15", " ", "x", " ", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469398502634326*^9, 3.471552217100122*^9, 
  3.4715768565848923`*^9, 3.483553799596499*^9, 3.483554479214395*^9, 
  3.483554907014542*^9}],

Cell["\<\
Here is a list of the various infinitesimal groups for the case a=5.\
\>", "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", "3"], "}"}], ",", 
     RowBox[{"{", "y", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      SuperscriptBox["x", "2"], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"x", " ", "y"}], "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469398502667858*^9, 3.471552217153906*^9, 
  3.4715768566306334`*^9, 3.483553799646929*^9, 3.483554479247477*^9, 
  3.4835549070811453`*^9}]
}, Open  ]],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        FractionBox["x", "3"], "}"}], ",", 
       RowBox[{"{", "y", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        SuperscriptBox["x", "2"], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"x", " ", "y"}], "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469398502701295*^9, 3.4715522172005177`*^9, 
  3.471576856686264*^9, 3.4835537996796618`*^9, 3.4835544792770348`*^9, 
  3.48355490719762*^9}],

Cell[TextData[StyleBox["Confirm that the solution is correct.",
 FontWeight->"Plain"]], "Text",
 CellChangeTimes->{{3.471552262029286*^9, 3.471552280787138*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}]], "Input",
 CellChangeTimes->{{3.4715522950725393`*^9, 3.471552319315793*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"True", ",", "True", ",", 
   RowBox[{
    RowBox[{
     RowBox[{"z1", " ", 
      RowBox[{"(", 
       RowBox[{"b14", "+", 
        RowBox[{"b15", " ", "z1"}]}], ")"}], " ", 
      SuperscriptBox["z2", "2"]}], "-", 
     RowBox[{"2", " ", "z1", " ", 
      RowBox[{"(", 
       RowBox[{
        FractionBox["b14", "3"], "+", 
        RowBox[{"2", " ", "b15", " ", "z1"}]}], ")"}], " ", 
      SuperscriptBox["z2", "2"]}], "+", 
     RowBox[{"5", " ", 
      RowBox[{"(", 
       RowBox[{
        FractionBox[
         RowBox[{"b14", " ", "z1"}], "3"], "+", 
        RowBox[{"b15", " ", 
         SuperscriptBox["z1", "2"]}]}], ")"}], " ", 
      SuperscriptBox["z2", "2"]}], "-", 
     RowBox[{"2", " ", "z1", " ", "z2", " ", 
      RowBox[{"(", 
       RowBox[{
        RowBox[{"b14", " ", "z2"}], "+", 
        RowBox[{"b15", " ", "z1", " ", "z2"}]}], ")"}]}]}], "\[Equal]", "0"}],
    ",", "True"}], "}"}]], "Output",
 CellChangeTimes->{3.4715523209101143`*^9, 3.47157685673147*^9, 
  3.483553799712741*^9, 3.483554479314184*^9, 3.483554907247188*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Simplify", "[", "%", "]"}]], "Input",
 CellChangeTimes->{{3.4715523239679737`*^9, 3.4715523303623533`*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"True", ",", "True", ",", "True", ",", "True"}], "}"}]], "Output",
 CellChangeTimes->{3.4715523316161203`*^9, 3.471576856784975*^9, 
  3.483553799745605*^9, 3.4835544793433113`*^9, 3.4835549073137493`*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The package finds two groups. Work out the commutator \
table of the Lie algebra.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"MakeCommutatorTable", "[", "\[IndentingNewLine]", 
  RowBox[{
  "independentvariables", ",", "dependentvariables", ",", 
   "infinitesimalgroupsxy"}], "]"}]], "Input"],

Cell[BoxData["\<\"MakeCommutatorTable has finished executing. You can look at \
the output in the table commutatortable. To present the output in the most \
readable form you may want view it as a matrix using \
MatrixForm[commutatortable]. Occasionally the entries in the commutatortable \
will have terms that cancel. To get rid of these terms use the function \
Simplify before viewing the table.\"\>"], "Print",
 CellChangeTimes->{3.4693985027350273`*^9, 3.471552217255068*^9, 
  3.471576856830988*^9, 3.4835537997787237`*^9, 3.4835544793988667`*^9, 
  3.483554907380707*^9}],

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[{
         {
          FractionBox[
           SuperscriptBox["x", "2"], "3"]},
         {
          FractionBox[
           RowBox[{"x", " ", "y"}], "3"]}
        },
        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[{"-", 
           FractionBox[
            SuperscriptBox["x", "2"], "3"]}]},
         {
          RowBox[{"-", 
           FractionBox[
            RowBox[{"x", " ", "y"}], "3"]}]}
        },
        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.46939850276856*^9, 3.471552217338189*^9, 
  3.4715768569024343`*^9, 3.483553799816596*^9, 3.483554479431582*^9, 
  3.48355490743158*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["26548072"], "Output",
 CellChangeTimes->{3.4693985028012867`*^9, 3.471552217379241*^9, 
  3.471576856943996*^9, 3.4835537998586283`*^9, 3.483554479464882*^9, 
  3.483554907480895*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{934, 1035},
WindowMargins->{{49, Automatic}, {Automatic, 47}},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
MacintoshSystemPageSetup -> \
"01@0001804P000000_82@?okonh34`9B;@85:0?l0@00009H0UP00P0068dB`001\n\
2@00I00100000@004Q800BL?0040000000000000000004<001000`00000@0?oH\n\
ofXIX1=F8040400000400000000000l1",
Magnification->1.25,
FrontEndVersion->"7.0 for Mac OS X x86 (32-bit) (February 18, 2009)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[545, 20, 292, 5, 117, "Text"],
Cell[840, 27, 124, 1, 32, "Text"],
Cell[967, 30, 160, 4, 33, "Input"],
Cell[1130, 36, 474, 13, 32, "Text"],
Cell[1607, 51, 101, 2, 33, "Input"],
Cell[1711, 55, 192, 3, 32, "Text"],
Cell[1906, 60, 119, 3, 53, "Input"],
Cell[2028, 65, 228, 4, 32, "Text"],
Cell[2259, 71, 155, 3, 53, "Input"],
Cell[2417, 76, 130, 2, 32, "Text"],
Cell[2550, 80, 118, 3, 33, "Input"],
Cell[2671, 85, 128, 2, 32, "Text"],
Cell[2802, 89, 116, 3, 33, "Input"],
Cell[2921, 94, 202, 3, 32, "Text"],
Cell[3126, 99, 109, 3, 33, "Input"],
Cell[3238, 104, 141, 2, 32, "Text"],
Cell[3382, 108, 67, 2, 33, "Input"],
Cell[3452, 112, 385, 6, 70, "Text"],
Cell[3840, 120, 67, 2, 33, "Input"],
Cell[3910, 124, 509, 7, 89, "Text"],
Cell[4422, 133, 71, 2, 33, "Input"],
Cell[4496, 137, 534, 8, 89, "Text"],
Cell[5033, 147, 79, 2, 33, "Input"],
Cell[5115, 151, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5408, 159, 347, 6, 72, "Input"],
Cell[5758, 167, 496, 9, 45, "Print"],
Cell[6257, 178, 1077, 15, 216, "Print"],
Cell[7337, 195, 766, 13, 64, "Print"],
Cell[8106, 210, 458, 9, 25, "Print"],
Cell[8567, 221, 1081, 15, 216, "Print"],
Cell[9651, 238, 258, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9946, 248, 50, 0, 33, "Input"],
Cell[9999, 250, 225, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10261, 258, 45, 0, 33, "Input"],
Cell[10309, 260, 556, 16, 42, "Output"]
}, Open  ]],
Cell[10880, 279, 39, 0, 33, "Input"],
Cell[10922, 281, 322, 8, 33, "Output"],
Cell[CellGroupData[{
Cell[11269, 293, 278, 4, 51, "Text"],
Cell[11550, 299, 47, 0, 33, "Input"],
Cell[11600, 301, 749, 13, 148, "Output"]
}, Open  ]],
Cell[12364, 317, 161, 4, 32, "Text"],
Cell[12528, 323, 345, 11, 33, "Input"],
Cell[12876, 336, 3859, 122, 131, "Output"],
Cell[CellGroupData[{
Cell[16760, 462, 189, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[16974, 469, 296, 6, 53, "Input"],
Cell[17273, 477, 928, 15, 83, "Print"],
Cell[18204, 494, 490, 7, 83, "Print"],
Cell[18697, 503, 381, 7, 25, "Print"],
Cell[19081, 512, 369, 7, 25, "Print"],
Cell[19453, 521, 391, 8, 25, "Print"],
Cell[19847, 531, 370, 5, 45, "Print"],
Cell[20220, 538, 381, 7, 25, "Print"],
Cell[20604, 547, 215, 3, 25, "Print"],
Cell[20822, 552, 259, 4, 25, "Print"],
Cell[21084, 558, 402, 8, 25, "Print"],
Cell[21489, 568, 1136, 15, 254, "Print"],
Cell[22628, 585, 257, 5, 33, "Output"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[22934, 596, 210, 3, 32, "Text"],
Cell[23147, 601, 38, 0, 33, "Input"],
Cell[23188, 603, 238, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[23463, 612, 141, 2, 32, "Text"],
Cell[23607, 616, 38, 0, 33, "Input"],
Cell[23648, 618, 249, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[23934, 627, 144, 3, 32, "Text"],
Cell[24081, 632, 115, 3, 33, "Input"],
Cell[24199, 637, 234, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[24470, 647, 143, 2, 32, "Text"],
Cell[24616, 651, 115, 3, 33, "Input"],
Cell[24734, 656, 348, 9, 33, "Output"]
}, Open  ]],
Cell[25097, 668, 484, 8, 51, "Text"],
Cell[25584, 678, 60, 0, 32, "Text"],
Cell[25647, 680, 44, 0, 32, "Text"],
Cell[25694, 682, 115, 3, 53, "Input"],
Cell[25812, 687, 156, 3, 53, "Input"],
Cell[CellGroupData[{
Cell[25993, 694, 342, 6, 72, "Input"],
Cell[26338, 702, 495, 9, 45, "Print"],
Cell[26836, 713, 1078, 15, 216, "Print"],
Cell[27917, 730, 745, 12, 64, "Print"],
Cell[28665, 744, 465, 9, 25, "Print"],
Cell[29133, 755, 1080, 15, 216, "Print"],
Cell[30216, 772, 254, 5, 33, "Output"]
}, Open  ]],
Cell[30485, 780, 39, 0, 33, "Input"],
Cell[30527, 782, 322, 8, 33, "Output"],
Cell[30852, 792, 47, 0, 33, "Input"],
Cell[30902, 794, 719, 13, 129, "Output"],
Cell[CellGroupData[{
Cell[31646, 811, 78, 1, 33, "Input"],
Cell[31727, 814, 184, 3, 33, "Output"]
}, Open  ]],
Cell[31926, 820, 156, 4, 32, "Text"],
Cell[32085, 826, 345, 11, 33, "Input"],
Cell[32433, 839, 3763, 119, 131, "Output"],
Cell[CellGroupData[{
Cell[36221, 962, 364, 7, 53, "Input"],
Cell[36588, 971, 928, 15, 83, "Print"],
Cell[37519, 988, 490, 7, 83, "Print"],
Cell[38012, 997, 401, 8, 25, "Print"],
Cell[38416, 1007, 369, 7, 25, "Print"],
Cell[38788, 1016, 392, 8, 25, "Print"],
Cell[39183, 1026, 370, 5, 45, "Print"],
Cell[39556, 1033, 402, 8, 25, "Print"],
Cell[39961, 1043, 215, 3, 25, "Print"],
Cell[40179, 1048, 261, 4, 25, "Print"],
Cell[40443, 1054, 383, 7, 25, "Print"],
Cell[40829, 1063, 1136, 15, 254, "Print"],
Cell[41968, 1080, 255, 5, 33, "Output"]
}, Open  ]],
Cell[42238, 1088, 38, 0, 33, "Input"],
Cell[42279, 1090, 251, 5, 33, "Output"],
Cell[42533, 1097, 38, 0, 33, "Input"],
Cell[42574, 1099, 250, 4, 33, "Output"],
Cell[42827, 1105, 115, 3, 33, "Input"],
Cell[42945, 1110, 331, 9, 54, "Output"],
Cell[43279, 1121, 115, 3, 33, "Input"],
Cell[43397, 1126, 355, 9, 33, "Output"],
Cell[43755, 1137, 92, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[43872, 1143, 226, 6, 33, "Input"],
Cell[44101, 1151, 517, 16, 51, "Output"]
}, Open  ]],
Cell[44633, 1170, 238, 7, 33, "Input"],
Cell[44874, 1179, 671, 21, 75, "Output"],
Cell[45548, 1202, 193, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[45766, 1209, 153, 2, 33, "Input"],
Cell[45922, 1213, 1094, 31, 97, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[47053, 1249, 131, 2, 33, "Input"],
Cell[47187, 1253, 244, 4, 33, "Output"]
}, Open  ]],
Cell[47446, 1260, 171, 3, 32, "Text"],
Cell[47620, 1265, 191, 4, 53, "Input"],
Cell[47814, 1271, 579, 8, 102, "Print"],
Cell[48396, 1281, 132, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[48553, 1287, 77, 1, 33, "Input"],
Cell[48633, 1290, 3253, 90, 167, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[51923, 1385, 66, 1, 33, "Input"],
Cell[51992, 1388, 197, 3, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
