(* 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[     38798,       1088]
NotebookOptionsPosition[     34232,        945]
NotebookOutlinePosition[     35009,        972]
CellTagsIndexPosition[     34966,        969]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[StyleBox["In this example we use the package IntroToSymmetry.m \
to work out the groups for the third-order ODE \n\nYxxx-a*Y^(-3)=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.4720466725423717`*^9, 
  3.472046673357225*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[TextData[StyleBox["Enter the input equation as a string. Don't include \
the == 0 at the end. The constant 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]^(-3)\>\""}], 
  ";"}]], "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]^(-3)\>\"", "}"}]}], ";"}]], "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 or constant names that \
must be preserved when the equation is converted to generic (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", "=", "3"}], ";"}]], "Input"],

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

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

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

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

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

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

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

Cell[CellGroupData[{

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

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(26029880\\), the time used = \\!\\(1.495069`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 26029880, 1.495069],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403521752789*^9, 3.469403601011241*^9, 
  3.471555016157957*^9, 3.471577931486508*^9, 3.483655831710745*^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.469403521752789*^9, 3.469403601011241*^9, 
  3.471555016157957*^9, 3.471577931486508*^9, 3.483655831742694*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(9\\), the \
byte count of zdeterminingequations = \\!\\(1160\\), the memory in use = \
\\!\\(26083080\\), the time used = \\!\\(1.540108`\\)\"\>",
  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 = ``", 9, 1160, 26083080, 
   1.540108],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403521752789*^9, 3.469403601011241*^9, 
  3.471555016157957*^9, 3.471577931486508*^9, 3.483655831745264*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(26083824\\), the time used = \\!\\(1.540289`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 26083824, 1.540289],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403521752789*^9, 3.469403601011241*^9, 
  3.471555016157957*^9, 3.471577931486508*^9, 3.483655831746668*^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.469403521752789*^9, 3.469403601011241*^9, 
  3.471555016157957*^9, 3.471577931486508*^9, 3.483655831747881*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.04578400000000005`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469403521922124*^9, 3.469403601147983*^9, 
  3.471555016329797*^9, 3.471577931530538*^9, 3.483655831750149*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1,x1]-a*y1[x1]^(-3)\"\>"], "Output",
 CellChangeTimes->{3.4694035220066633`*^9, 3.469403601216712*^9, 
  3.4715550164177732`*^9, 3.471577931600606*^9, 3.483655831799797*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0", ",", 
   FractionBox[
    RowBox[{"3", " ", "a"}], 
    SuperscriptBox[
     RowBox[{"y1", "[", "x1", "]"}], "4"]], ",", "0", ",", "0", ",", "1"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.4694035220525923`*^9, 3.4694036012792177`*^9, 
  3.471555016473675*^9, 3.471577931648099*^9, 3.483655831849903*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.4694035221021442`*^9, 3.4694036013287487`*^9, 
  3.4715550165539827`*^9, 3.4715779317105837`*^9, 3.483655831899979*^9}],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Here are the determining equations expressed in terms \
of z-variables. 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[{"\<\"-3*z2^4*Derivative[0, 1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-6*z2^4*Derivative[0, 2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-(z2^4*Derivative[0, 3][xse1][z1, z2]) == 0\"\>", 
   ",", "\<\"3*z2^4*Derivative[0, 2][eta1][z1, z2] - 9*z2^4*Derivative[1, \
1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"z2^4*Derivative[0, 3][eta1][z1, z2] - 3*z2^4*Derivative[1, \
2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"3*z2^4*Derivative[1, 1][eta1][z1, z2] - 3*z2^4*Derivative[2, \
0][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"3*z2^4*Derivative[1, 2][eta1][z1, z2] - 3*z2^4*Derivative[2, \
1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"3*a*eta1[z1, z2] + a*z2*Derivative[0, 1][eta1][z1, z2] - \
3*a*z2*Derivative[1, 0][xse1][z1, z2] + z2^4*Derivative[3, 0][eta1][z1, z2] \
== 0\"\>", 
   ",", "\<\"-4*a*z2*Derivative[0, 1][xse1][z1, z2] + 3*z2^4*Derivative[2, \
1][eta1][z1, z2] - z2^4*Derivative[3, 0][xse1][z1, z2] == 0\"\>"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469403522152129*^9, 3.469403601395442*^9, 
  3.471555016628282*^9, 3.4715779317567053`*^9, 3.483655831949044*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Length", "[", "zdeterminingequations", "]"}]], "Input"],

Cell[BoxData["9"], "Output",
 CellChangeTimes->{3.4694035222177887`*^9, 3.469403601466975*^9, 
  3.4715550167149897`*^9, 3.471577931808165*^9, 3.483655831982368*^9}]
}, Open  ]],

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

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", "3"}], " ", 
       SuperscriptBox["z2", "4"], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", "6"}], " ", 
       SuperscriptBox["z2", "4"], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["z2", "4"]}], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "3"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"9", " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "3"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"3", " ", "a", " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"a", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"3", " ", "a", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"3", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "4"}], " ", "a", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"3", " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"3", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469403522286777*^9, 3.4694036015302258`*^9, 
  3.4715550167738743`*^9, 3.471577931864067*^9, 3.483655832017579*^9}],

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

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

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

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"SolveDeterminingEquations", "[", "\[IndentingNewLine]", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "r", ",", "xseon", 
    ",", "\[IndentingNewLine]", "zdeterminingequations", ",", 
    RowBox[{"order", "=", "4"}]}], "]"}], "]"}]], "Input",
 CellChangeTimes->{{3.469403569830274*^9, 3.469403570294435*^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 = \\!\\(15\\)\"\>",
  StringForm[
  "The variable powertablelength is the number of terms required for each \
multivariate polynomial used for the infinitesimals. This number is \
determined by the choice of polynomial order and the number of zvariables. \
The time needed to solve the determining equations increases as powertable \
increases. powertablelength = ``", 15],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.483655832045006*^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.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.483655832046373*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26173128\\), The time = \\!\
\\(1.5613579999999998`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26173128, 1.5613579999999998`],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.4836558320473537`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(30\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 30],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.4836558320481367`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(64\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 64],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.483655832048903*^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.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.483655832049662*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26186824\\), The time = \\!\
\\(1.563782`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26186824, 1.563782],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.4836558320505667`*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.483655832051324*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.4836558320520563`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26200000\\), The time = \\!\
\\(1.5658889999999999`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26200000, 1.5658889999999999`],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.48365583205282*^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.4694035224194736`*^9, 3.469403601662449*^9, 
  3.471555016847711*^9, 3.471577931915802*^9, 3.483655832053609*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.018781999999999854`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.4694035224231*^9, 3.4694036016659937`*^9, 
  3.471555016858128*^9, 3.4715779319294767`*^9, 3.4836558320551767`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", "\<\"xse1[z1_, z2_]=a10 + (4*b15*z1)/3\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469403522473599*^9, 3.469403601716717*^9, 
  3.471555016898382*^9, 3.4715779319614*^9, 3.483655832096715*^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_]=b15*z2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469403522602191*^9, 3.469403601767275*^9, 
  3.4715550170416527`*^9, 3.471577932025236*^9, 3.4836558321500874`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Express the xse functions in terms of x,y variables.",
 
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"a10", "+", 
   FractionBox[
    RowBox[{"4", " ", "b15", " ", "x"}], "3"]}], "}"}]], "Output",
 CellChangeTimes->{3.469403522658003*^9, 3.469403601896327*^9, 
  3.471555017102007*^9, 3.471577932073535*^9, 3.4836558321837378`*^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[{"b15", " ", 
   RowBox[{"y", "[", "x", "]"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469403522690452*^9, 3.469403601950419*^9, 
  3.4715550171490803`*^9, 3.471577932129129*^9, 3.4836558322168694`*^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[{"{", "0", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      FractionBox[
       RowBox[{"4", " ", "x"}], "3"], "}"}], ",", 
     RowBox[{"{", "y", "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469403522741431*^9, 3.4694036019841146`*^9, 
  3.471555017203236*^9, 3.47157793219302*^9, 3.483655832250135*^9}]
}, Open  ]],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "1", "}"}], ",", 
       RowBox[{"{", "0", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        FractionBox[
         RowBox[{"4", " ", "x"}], "3"], "}"}], ",", 
       RowBox[{"{", "y", "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.4694035227924623`*^9, 3.4694036020346813`*^9, 
  3.471555017249477*^9, 3.471577932319827*^9, 3.483655832285532*^9}],

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

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
  "True", ",", "True", ",", "True", ",", "True", ",", "True", ",", "True", 
   ",", "True", ",", "True", ",", "True"}], "}"}]], "Output",
 CellChangeTimes->{3.471555029236002*^9, 3.4715779323636093`*^9, 
  3.483655832376676*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The package finds three groups. Work out the \
commutator table of the Lie algebra.",
 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.469403522859634*^9, 3.4694036020845747`*^9, 
  3.4715550173027687`*^9, 3.471577932398218*^9, 3.4836558324168873`*^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[{
         {
          FractionBox["4", "3"]},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]},
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{"-", 
           FractionBox["4", "3"]}]},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {"0"},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]}
    },
    GridBoxAlignment->{
     "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, 
      "RowsIndexed" -> {}},
    GridBoxSpacings->{"Columns" -> {
        Offset[0.27999999999999997`], {
         Offset[0.7]}, 
        Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
        Offset[0.2], {
         Offset[0.4]}, 
        Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}],
  Function[BoxForm`e$, 
   MatrixForm[BoxForm`e$]]]], "Output",
 CellChangeTimes->{3.469403523075241*^9, 3.469403602153706*^9, 
  3.471555017367947*^9, 3.4715779324617023`*^9, 3.4836558324468193`*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The equation admits a two-dimensional solvable Lie \
algebra.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

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

Cell[BoxData["26348616"], "Output",
 CellChangeTimes->{3.46940352315909*^9, 3.469403602200884*^9, 
  3.471555017413731*^9, 3.471577932509654*^9, 3.4836558324839993`*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{967, 1032},
WindowMargins->{{54, Automatic}, {Automatic, 45}},
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, 227, 4, 76, "Text"],
Cell[775, 26, 124, 1, 32, "Text"],
Cell[902, 29, 160, 4, 33, "Input"],
Cell[1065, 35, 476, 13, 32, "Text"],
Cell[1544, 50, 101, 2, 33, "Input"],
Cell[1648, 54, 194, 3, 32, "Text"],
Cell[1845, 59, 120, 3, 53, "Input"],
Cell[1968, 64, 229, 4, 32, "Text"],
Cell[2200, 70, 156, 3, 53, "Input"],
Cell[2359, 75, 130, 2, 32, "Text"],
Cell[2492, 79, 118, 3, 33, "Input"],
Cell[2613, 84, 128, 2, 32, "Text"],
Cell[2744, 88, 116, 3, 33, "Input"],
Cell[2863, 93, 222, 4, 32, "Text"],
Cell[3088, 99, 109, 3, 33, "Input"],
Cell[3200, 104, 141, 2, 32, "Text"],
Cell[3344, 108, 67, 2, 33, "Input"],
Cell[3414, 112, 385, 6, 70, "Text"],
Cell[3802, 120, 67, 2, 33, "Input"],
Cell[3872, 124, 509, 7, 70, "Text"],
Cell[4384, 133, 71, 2, 33, "Input"],
Cell[4458, 137, 534, 8, 89, "Text"],
Cell[4995, 147, 79, 2, 33, "Input"],
Cell[5077, 151, 267, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5369, 159, 347, 6, 72, "Input"],
Cell[5719, 167, 467, 8, 45, "Print"],
Cell[6189, 177, 1050, 14, 197, "Print"],
Cell[7242, 193, 723, 12, 64, "Print"],
Cell[7968, 207, 435, 8, 25, "Print"],
Cell[8406, 217, 1052, 14, 216, "Print"],
Cell[9461, 233, 228, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9726, 242, 50, 0, 33, "Input"],
Cell[9779, 244, 204, 2, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10020, 251, 45, 0, 33, "Input"],
Cell[10068, 253, 349, 9, 58, "Output"]
}, Open  ]],
Cell[10432, 265, 39, 0, 33, "Input"],
Cell[10474, 267, 306, 7, 33, "Output"],
Cell[CellGroupData[{
Cell[10805, 278, 248, 4, 51, "Text"],
Cell[11056, 284, 47, 0, 33, "Input"],
Cell[11106, 286, 1103, 20, 205, "Output"]
}, Open  ]],
Cell[12224, 309, 57, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[12306, 313, 79, 1, 33, "Input"],
Cell[12388, 316, 165, 2, 33, "Output"]
}, Open  ]],
Cell[12568, 321, 129, 3, 32, "Text"],
Cell[12700, 326, 185, 5, 33, "Input"],
Cell[12888, 333, 6255, 205, 221, "Output"],
Cell[19146, 540, 509, 11, 145, "Text"],
Cell[CellGroupData[{
Cell[19680, 555, 385, 7, 72, "Input"],
Cell[20068, 564, 901, 14, 83, "Print"],
Cell[20972, 580, 463, 6, 83, "Print"],
Cell[21438, 588, 380, 7, 25, "Print"],
Cell[21821, 597, 344, 6, 25, "Print"],
Cell[22168, 605, 365, 7, 25, "Print"],
Cell[22536, 614, 343, 4, 45, "Print"],
Cell[22882, 620, 356, 6, 25, "Print"],
Cell[23241, 628, 188, 2, 25, "Print"],
Cell[23432, 632, 234, 3, 25, "Print"],
Cell[23669, 637, 377, 7, 25, "Print"],
Cell[24049, 646, 1109, 14, 235, "Print"],
Cell[25161, 662, 233, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[25431, 671, 184, 3, 32, "Text"],
Cell[25618, 676, 38, 0, 33, "Input"],
Cell[25659, 678, 221, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[25917, 686, 141, 2, 32, "Text"],
Cell[26061, 690, 38, 0, 33, "Input"],
Cell[26102, 692, 215, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[26354, 700, 144, 3, 32, "Text"],
Cell[26501, 705, 115, 3, 33, "Input"],
Cell[26619, 710, 269, 6, 54, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[26925, 721, 143, 2, 32, "Text"],
Cell[27071, 725, 115, 3, 33, "Input"],
Cell[27189, 730, 241, 5, 33, "Output"]
}, Open  ]],
Cell[27445, 738, 67, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[27537, 742, 226, 6, 33, "Input"],
Cell[27766, 750, 462, 14, 54, "Output"]
}, Open  ]],
Cell[28243, 767, 79, 1, 33, "Input"],
Cell[28325, 770, 616, 19, 67, "Output"],
Cell[28944, 791, 154, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[29123, 798, 188, 4, 33, "Input"],
Cell[29314, 804, 268, 6, 33, "Output"]
}, Open  ]],
Cell[29597, 813, 173, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[29795, 820, 168, 4, 33, "Input"],
Cell[29966, 826, 554, 7, 102, "Print"]
}, Open  ]],
Cell[30535, 836, 132, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[30692, 842, 77, 1, 33, "Input"],
Cell[30772, 845, 3015, 82, 133, "Output"]
}, Open  ]],
Cell[33802, 930, 151, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[33978, 937, 66, 1, 33, "Input"],
Cell[34047, 940, 169, 2, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
