(* 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[     38081,       1056]
NotebookOptionsPosition[     33643,        918]
NotebookOutlinePosition[     34399,        944]
CellTagsIndexPosition[     34356,        941]
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 nonlinear second-order ODE \n\n\
YYxx+Yx^2-a^2*Y^3=0 \n\nconsidered in Homework excercise 8.3.",
 FontSize->18,
 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.4720468860686283`*^9, 
  3.4720468877297087`*^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]-(1/y[x])*D[y[x],x]^2-a^2*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]->\[IndentingNewLine](1/y[x])*D[y[x],x]^2+a^2*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 names or constant names \
that must be protected 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", "=", "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 = \\!\\(25090456\\), the time used = \
\\!\\(0.6370439999999999`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 25090456, 0.6370439999999999],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693978993229427`*^9, 3.469397973887354*^9, 
  3.4711457189958687`*^9, 3.471552097931101*^9, 3.471576788683716*^9, 
  3.483553598825511*^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.4693978993229427`*^9, 3.469397973887354*^9, 
  3.4711457189958687`*^9, 3.471552097931101*^9, 3.471576788683716*^9, 
  3.48355359888276*^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 = \\!\\(736\\), the memory in use = \
\\!\\(25178888\\), the time used = \\!\\(0.679721`\\)\"\>",
  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, 736, 25178888, 0.679721],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693978993229427`*^9, 3.469397973887354*^9, 
  3.4711457189958687`*^9, 3.471552097931101*^9, 3.471576788683716*^9, 
  3.483553598885469*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(25179792\\), the time used = \\!\\(0.679917`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 25179792, 0.679917],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693978993229427`*^9, 3.469397973887354*^9, 
  3.4711457189958687`*^9, 3.471552097931101*^9, 3.471576788683716*^9, 
  3.483553598887494*^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.4693978993229427`*^9, 3.469397973887354*^9, 
  3.4711457189958687`*^9, 3.471552097931101*^9, 3.471576788683716*^9, 
  3.4835535988893843`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.043570999999999915`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469397899500049*^9, 3.4693979741327267`*^9, 
  3.471145719061693*^9, 3.471552098126029*^9, 3.4715767888701267`*^9, 
  3.483553598892222*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1]-(1/y1[x1])*D[y1[x1],x1]^2-a^2*y1[x1]^2\"\>"]\
, "Output",
 CellChangeTimes->{3.469397899578863*^9, 3.469397974237246*^9, 
  3.471145719098632*^9, 3.4715520982048817`*^9, 3.4715767889256783`*^9, 
  3.483553598957821*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0", ",", 
   RowBox[{
    RowBox[{
     RowBox[{"-", "2"}], " ", 
     SuperscriptBox["a", "2"], " ", 
     RowBox[{"y1", "[", "x1", "]"}]}], "+", 
    FractionBox[
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "2"], 
     SuperscriptBox[
      RowBox[{"y1", "[", "x1", "]"}], "2"]]}], ",", 
   RowBox[{"-", 
    FractionBox[
     RowBox[{"2", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], 
     RowBox[{"y1", "[", "x1", "]"}]]}], ",", "1"}], "}"}]], "Output",
 CellChangeTimes->{3.4693978996374197`*^9, 3.469397974303741*^9, 
  3.471145719153029*^9, 3.4715520982785892`*^9, 3.471576789024675*^9, 
  3.483553599018721*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["The program expresses the determining equations in \
terms of z-variables. Here is the correspondence between z-variables and \
conventional variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469397899704605*^9, 3.469397974370524*^9, 
  3.471145719198411*^9, 3.471552098364374*^9, 3.471576789090591*^9, 
  3.483553599066752*^9}]
}, Open  ]],

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[{"\<\"-(z2*Derivative[0, 1][xse1][z1, z2]) - z2^2*Derivative[0, \
2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"eta1[z1, z2] - z2*Derivative[0, 1][eta1][z1, z2] + \
z2^2*Derivative[0, 2][eta1][z1, z2] - 2*z2^2*Derivative[1, 1][xse1][z1, z2] \
== 0\"\>", 
   ",", "\<\"-2*a^2*z2^3*eta1[z1, z2] + a^2*z2^4*Derivative[0, 1][eta1][z1, \
z2] - 2*a^2*z2^4*Derivative[1, 0][xse1][z1, z2] + z2^2*Derivative[2, \
0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"-3*a^2*z2^4*Derivative[0, 1][xse1][z1, z2] - 2*z2*Derivative[1, \
0][eta1][z1, z2] + 2*z2^2*Derivative[1, 1][eta1][z1, z2] - z2^2*Derivative[2, \
0][xse1][z1, z2] == 0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.469397899770578*^9, 3.469397974436267*^9, 
  3.471145719253736*^9, 3.47155209844447*^9, 3.471576789157093*^9, 
  3.4835535991151123`*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData["4"], "Output",
 CellChangeTimes->{3.469397899843108*^9, 3.469397974508708*^9, 
  3.4711457192992687`*^9, 3.471552098519034*^9, 3.471576789229539*^9, 
  3.483553599169442*^9}]
}, Open  ]],

Cell[BoxData[
 RowBox[{"zdeterminingequationscolumn", "=", 
  TagBox[
   FormBox[
    RowBox[{"Column", "[", 
     RowBox[{
      RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], ",", 
      RowBox[{"{", 
       RowBox[{"Left", ",", "Below"}], "}"}]}], "]"}],
    TraditionalForm],
   TraditionalForm,
   Editable->True]}]], "Input",
 CellChangeTimes->{{3.4693979543681097`*^9, 3.4693979548051863`*^9}}],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "z2"}], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"eta1", "[", 
        RowBox[{"z1", ",", "z2"}], "]"}], "-", 
       RowBox[{"z2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "2"}], " ", 
        SuperscriptBox["a", "2"], " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["a", "2"], " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["a", "2"], " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "3"}], " ", 
        SuperscriptBox["a", "2"], " ", 
        SuperscriptBox["z2", "4"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{
  3.4693978999057217`*^9, {3.469397956632895*^9, 3.469397974656196*^9}, 
   3.471145719362763*^9, 3.47155209859685*^9, 3.471576789292739*^9, 
   3.4835535992157927`*^9}],

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

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

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

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"SolveDeterminingEquations", "[", "\[IndentingNewLine]", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "r", ",", "xseon", 
    ",", "zdeterminingequations", ",", 
    RowBox[{"order", "=", "4"}]}], "]"}], "]"}]], "Input",
 CellChangeTimes->{{3.4693978852411737`*^9, 3.46939788593709*^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.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599266391*^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.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599268725*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(25899696\\), The time = \\!\
\\(0.7063379999999999`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 25899696, 0.7063379999999999],
  Editable->False]], "Print",
 CellChangeTimes->{3.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599269967*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(30\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 30],
  Editable->False]], "Print",
 CellChangeTimes->{3.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599271214*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(58\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 58],
  Editable->False]], "Print",
 CellChangeTimes->{3.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599272448*^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.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599273799*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(25918832\\), The time = \\!\
\\(0.708608`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 25918832, 0.708608],
  Editable->False]], "Print",
 CellChangeTimes->{3.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599275075*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599276265*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599277479*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26069352\\), The time = \\!\
\\(0.714329`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26069352, 0.714329],
  Editable->False]], "Print",
 CellChangeTimes->{3.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599278729*^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.469397899976891*^9, 3.46939797472679*^9, 
  3.471145719431204*^9, 3.471552098669896*^9, 3.4715767894429207`*^9, 
  3.483553599280789*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.022567000000000004`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.4693979000853167`*^9, 3.469397974835691*^9, 
  3.47114572047049*^9, 3.471552099046994*^9, 3.471576789823971*^9, 
  3.483553599281981*^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 - (b15*z1)/2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469397900222357*^9, 3.469397974905863*^9, 
  3.471145720613978*^9, 3.471552099217132*^9, 3.471576789926441*^9, 
  3.48355359932045*^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.469397900288884*^9, 3.469397974972889*^9, 
  3.471145720680387*^9, 3.4715520993046303`*^9, 3.4715767899938507`*^9, 
  3.483553599382434*^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[{"b15", " ", "x"}], "2"]}], "}"}]], "Output",
 CellChangeTimes->{3.4693979003735027`*^9, 3.4693979750382957`*^9, 
  3.471145720747106*^9, 3.471552099367299*^9, 3.471576790060067*^9, 
  3.483553599436515*^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.469397900440082*^9, 3.469397975110278*^9, 
  3.471145720854032*^9, 3.471552099433406*^9, 3.4715767901267*^9, 
  3.483553599482712*^9}]
}, Open  ]],

Cell["\<\
Here is a list of the various infinitesimal groups. Note that the \
dependencies have been stripped away. This table will be used to construct \
the commutator table.\
\>", "Text"],

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

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "1", "}"}], ",", 
       RowBox[{"{", "0", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"-", 
         FractionBox["x", "2"]}], "}"}], ",", 
       RowBox[{"{", "y", "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469397900539809*^9, 3.469397975205967*^9, 
  3.471145720947165*^9, 3.471552099534276*^9, 3.47157679022651*^9, 
  3.4835535996612377`*^9}],

Cell["Check the infinitesimals in the determining equations.", "Text",
 CellChangeTimes->{{3.471145395559845*^9, 3.471145429404257*^9}}],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"True", ",", "True", ",", "True", ",", "True"}], "}"}]], "Output",
 CellChangeTimes->{3.471145721015003*^9, 3.47155209960179*^9, 
  3.471576790311159*^9, 3.4835535997397842`*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The package finds a translation group (xse,eta)=(1,0) \
and a dilation group (xse,eta)=(-x/2,y). Now generate 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.469397900606534*^9, 3.469397975272367*^9, 
  3.471145721081873*^9, 3.471552099667665*^9, 3.471576790377016*^9, 
  3.4835535998230762`*^9}],

Cell[TextData[StyleBox["Put the commutator table in matrix 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[{
         {
          RowBox[{"-", 
           FractionBox["1", "2"]}]},
         {"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["1", "2"]},
         {"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.469397900673897*^9, 3.469397975379861*^9, 
  3.471145721148889*^9, 3.4715520997349653`*^9, 3.4715767905118427`*^9, 
  3.483553599907072*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["26185712"], "Output",
 CellChangeTimes->{3.4693979007401657`*^9, 3.4693979754395742`*^9, 
  3.471145721214979*^9, 3.4715520997844267`*^9, 3.47157679057777*^9, 
  3.483553599989874*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{947, 1062},
WindowMargins->{{35, Automatic}, {Automatic, 17}},
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",
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, 306, 5, 116, "Text"],
Cell[854, 27, 124, 1, 26, "Text"],
Cell[981, 30, 160, 4, 27, "Input"],
Cell[1144, 36, 478, 13, 26, "Text"],
Cell[1625, 51, 101, 2, 27, "Input"],
Cell[1729, 55, 192, 3, 26, "Text"],
Cell[1924, 60, 142, 4, 43, "Input"],
Cell[2069, 66, 229, 4, 26, "Text"],
Cell[2301, 72, 199, 5, 58, "Input"],
Cell[2503, 79, 130, 2, 26, "Text"],
Cell[2636, 83, 118, 3, 27, "Input"],
Cell[2757, 88, 128, 2, 26, "Text"],
Cell[2888, 92, 116, 3, 27, "Input"],
Cell[3007, 97, 228, 4, 26, "Text"],
Cell[3238, 103, 109, 3, 27, "Input"],
Cell[3350, 108, 141, 2, 26, "Text"],
Cell[3494, 112, 67, 2, 27, "Input"],
Cell[3564, 116, 385, 6, 41, "Text"],
Cell[3952, 124, 67, 2, 27, "Input"],
Cell[4022, 128, 508, 7, 56, "Text"],
Cell[4533, 137, 71, 2, 27, "Input"],
Cell[4607, 141, 535, 8, 56, "Text"],
Cell[5145, 151, 79, 2, 27, "Input"],
Cell[5227, 155, 268, 4, 26, "Text"],
Cell[CellGroupData[{
Cell[5520, 163, 347, 6, 58, "Input"],
Cell[5870, 171, 518, 10, 20, "Print"],
Cell[6391, 183, 1078, 15, 126, "Print"],
Cell[7472, 200, 746, 12, 36, "Print"],
Cell[8221, 214, 464, 9, 20, "Print"],
Cell[8688, 225, 1083, 15, 141, "Print"],
Cell[9774, 242, 258, 5, 27, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10069, 252, 50, 0, 27, "Input"],
Cell[10122, 254, 253, 4, 27, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10412, 263, 45, 0, 27, "Input"],
Cell[10460, 265, 813, 24, 53, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[11310, 294, 241, 4, 26, "Text"],
Cell[11554, 300, 39, 0, 27, "Input"],
Cell[11596, 302, 323, 8, 27, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[11956, 315, 278, 4, 41, "Text"],
Cell[12237, 321, 47, 0, 27, "Input"],
Cell[12287, 323, 832, 15, 118, "Output"]
}, Open  ]],
Cell[13134, 341, 57, 0, 26, "Text"],
Cell[CellGroupData[{
Cell[13216, 345, 78, 1, 27, "Input"],
Cell[13297, 348, 188, 3, 27, "Output"]
}, Open  ]],
Cell[13500, 354, 415, 12, 27, "Input"],
Cell[13918, 368, 4746, 151, 89, "Output"],
Cell[18667, 521, 545, 11, 101, "Text"],
Cell[CellGroupData[{
Cell[19237, 536, 363, 7, 43, "Input"],
Cell[19603, 545, 925, 15, 51, "Print"],
Cell[20531, 562, 487, 7, 51, "Print"],
Cell[21021, 571, 401, 8, 20, "Print"],
Cell[21425, 581, 366, 7, 20, "Print"],
Cell[21794, 590, 389, 8, 20, "Print"],
Cell[22186, 600, 367, 5, 36, "Print"],
Cell[22556, 607, 378, 7, 20, "Print"],
Cell[22937, 616, 212, 3, 20, "Print"],
Cell[23152, 621, 256, 4, 20, "Print"],
Cell[23411, 627, 378, 7, 20, "Print"],
Cell[23792, 636, 1133, 15, 156, "Print"],
Cell[24928, 653, 255, 5, 27, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[25220, 663, 184, 3, 26, "Text"],
Cell[25407, 668, 38, 0, 27, "Input"],
Cell[25448, 670, 245, 4, 27, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[25730, 679, 141, 2, 26, "Text"],
Cell[25874, 683, 38, 0, 27, "Input"],
Cell[25915, 685, 240, 4, 27, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[26192, 694, 144, 3, 26, "Text"],
Cell[26339, 699, 115, 3, 27, "Input"],
Cell[26457, 704, 286, 7, 46, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[26780, 716, 143, 2, 26, "Text"],
Cell[26926, 720, 115, 3, 27, "Input"],
Cell[27044, 725, 260, 6, 27, "Output"]
}, Open  ]],
Cell[27319, 734, 190, 4, 26, "Text"],
Cell[27512, 740, 249, 7, 27, "Input"],
Cell[27764, 749, 79, 1, 27, "Input"],
Cell[27846, 752, 633, 20, 55, "Output"],
Cell[28482, 774, 136, 1, 26, "Text"],
Cell[CellGroupData[{
Cell[28643, 779, 153, 2, 27, "Input"],
Cell[28799, 783, 217, 4, 27, "Output"]
}, Open  ]],
Cell[29031, 790, 242, 4, 26, "Text"],
Cell[29276, 796, 191, 4, 43, "Input"],
Cell[29470, 802, 575, 8, 66, "Print"],
Cell[30048, 812, 130, 2, 26, "Text"],
Cell[CellGroupData[{
Cell[30203, 818, 77, 1, 27, "Input"],
Cell[30283, 821, 3040, 83, 109, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[33360, 909, 66, 1, 27, "Input"],
Cell[33429, 912, 198, 3, 27, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
