(* 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[     31669,        910]
NotebookOptionsPosition[     27628,        785]
NotebookOutlinePosition[     28405,        812]
CellTagsIndexPosition[     28362,        809]
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 \nthe third ODE listed in Table 8.1.",
 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 function f[Y,Yx]is arbitrary.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{
  "inputequation", "=", "\n", "\"\<D[y[x],x,x]-f[a*x+b*y[x],D[y[x],x]]\>\""}],
   ";"}]], "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]->f[a*x+b*y[x],D[y[x],x]]\>\"", "}"}]}], 
  ";"}]], "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 \
must be preserved when the equation is changed to generic (x1,y1) variables.",
 
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"frozennames", "=", 
   RowBox[{"{", 
    RowBox[{"\"\<f\>\"", ",", "\"\<a\>\"", ",", "\"\<b\>\""}], "}"}]}], 
  ";"}]], "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[{"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 = \\!\\(25090696\\), the time used = \\!\\(0.526421`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 25090696, 0.526421],
  Editable->False]], "Print",
 CellChangeTimes->{3.46940313804823*^9, 3.47155497249419*^9, 
  3.4715778839629107`*^9, 3.48365565545292*^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.46940313804823*^9, 3.47155497249419*^9, 
  3.4715778839629107`*^9, 3.483655655506691*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(10\\), the \
byte count of zdeterminingequations = \\!\\(960\\), the memory in use = \
\\!\\(25178408\\), the time used = \\!\\(0.5738359999999999`\\)\"\>",
  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 = ``", 10, 960, 25178408, 
   0.5738359999999999],
  Editable->False]], "Print",
 CellChangeTimes->{3.46940313804823*^9, 3.47155497249419*^9, 
  3.4715778839629107`*^9, 3.4836556555102463`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(25179232\\), the time used = \\!\\(0.574033`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 25179232, 0.574033],
  Editable->False]], "Print",
 CellChangeTimes->{3.46940313804823*^9, 3.47155497249419*^9, 
  3.4715778839629107`*^9, 3.483655655512993*^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.46940313804823*^9, 3.47155497249419*^9, 
  3.4715778839629107`*^9, 3.483655655515498*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1]-f[a*x1+b*y1[x1],D[y1[x1],x1]]\"\>"], \
"Output",
 CellChangeTimes->{3.4694031381216288`*^9, 3.471554972718492*^9, 
  3.471577884186935*^9, 3.483655655555134*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{"-", "a"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"1", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{
      RowBox[{
       RowBox[{"a", " ", "x1"}], "+", 
       RowBox[{"b", " ", 
        RowBox[{"y1", "[", "x1", "]"}]}]}], ",", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], "]"}]}], ",", 
   RowBox[{
    RowBox[{"-", "b"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"1", ",", "0"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{
      RowBox[{
       RowBox[{"a", " ", "x1"}], "+", 
       RowBox[{"b", " ", 
        RowBox[{"y1", "[", "x1", "]"}]}]}], ",", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], "]"}]}], ",", 
   RowBox[{"-", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", 
        RowBox[{"0", ",", "1"}], ")"}],
       Derivative],
      MultilineFunction->None], "[", 
     RowBox[{
      RowBox[{
       RowBox[{"a", " ", "x1"}], "+", 
       RowBox[{"b", " ", 
        RowBox[{"y1", "[", "x1", "]"}]}]}], ",", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], "]"}]}], ",", "1"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.4694031381674423`*^9, 3.471554972791191*^9, 
  3.471577884259259*^9, 3.483655655590373*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.4694031382038*^9, 3.4715549728734283`*^9, 
  3.471577884342731*^9, 3.4836556556228657`*^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[{"\<\"-(b*eta1[z1, z2]) - a*xse1[z1, z2] == 0\"\>", 
   ",", "\<\"-3*Derivative[0, 1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"Derivative[0, 1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-Derivative[0, 2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-Derivative[1, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"Derivative[0, 1][eta1][z1, z2] - 2*Derivative[1, 0][xse1][z1, \
z2] == 0\"\>", 
   ",", "\<\"-Derivative[0, 1][eta1][z1, z2] + Derivative[1, 0][xse1][z1, z2] \
== 0\"\>", 
   ",", "\<\"Derivative[0, 2][eta1][z1, z2] - 2*Derivative[1, 1][xse1][z1, \
z2] == 0\"\>", ",", "\<\"Derivative[2, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"2*Derivative[1, 1][eta1][z1, z2] - Derivative[2, 0][xse1][z1, \
z2] == 0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.46940313825458*^9, 3.4715549729565277`*^9, 
  3.471577884425343*^9, 3.483655655674197*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData["10"], "Output",
 CellChangeTimes->{3.469403138318737*^9, 3.471554973042492*^9, 
  3.4715778845113173`*^9, 3.483655655719342*^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[{
        RowBox[{"-", "b"}], " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"a", " ", 
        RowBox[{"xse1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", "3"}], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       SuperscriptBox["xse1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"0", ",", "1"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{"-", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{"-", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "1"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}], "-", 
       RowBox[{"2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"1", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}], "-", 
       RowBox[{"2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       SuperscriptBox["eta1", 
        TagBox[
         RowBox[{"(", 
          RowBox[{"2", ",", "0"}], ")"}],
         Derivative],
        MultilineFunction->None], "[", 
       RowBox[{"z1", ",", "z2"}], "]"}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       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.4694031383818483`*^9, 3.471554973124423*^9, 
  3.471577884593176*^9, 3.4836556557634563`*^9}],

Cell[TextData[StyleBox["Note that a number of the determining equations are \
redundant.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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", "[", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "r", ",", "xseon", 
    ",", "zdeterminingequations", ",", 
    RowBox[{"order", "=", "2"}]}], "]"}], "]"}]], "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 = \\!\\(6\\)\"\>",
  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 = ``", 6],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.483655655826036*^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.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.483655655828023*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(25833848\\), The time = \\!\
\\(0.590845`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 25833848, 0.590845],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.483655655829369*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(12\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 12],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.483655655830505*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(24\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 24],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.483655655831663*^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.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.4836556558328047`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(25841456\\), The time = \\!\
\\(0.591837`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 25841456, 0.591837],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.483655655834084*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.483655655835207*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.483655655836321*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(25970208\\), The time = \\!\
\\(0.595845`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 25970208, 0.595845],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.48365565583746*^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.469403138453018*^9, 3.4715549732188587`*^9, 
  3.4715778847350483`*^9, 3.483655655838615*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.010299999999999976`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469403138456431*^9, 3.471554973233334*^9, 
  3.471577884745385*^9, 3.483655655840465*^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_]=-((b*b10)/a)\"\>", "}"}]], "Output",
 CellChangeTimes->{3.4694031385051537`*^9, 3.471554973271659*^9, 
  3.4715778847869453`*^9, 3.483655655870949*^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_]=b10\"\>", "}"}]], "Output",
 CellChangeTimes->{3.46940313855582*^9, 3.471554973465416*^9, 
  3.471577884822712*^9, 3.48365565592584*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"-", 
   FractionBox[
    RowBox[{"b", " ", "b10"}], "a"]}], "}"}]], "Output",
 CellChangeTimes->{3.469403138601267*^9, 3.471554973518004*^9, 
  3.471577884890915*^9, 3.48365565595601*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Express the eta function in terms of these variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[BoxData[
 RowBox[{"{", "b10", "}"}]], "Output",
 CellChangeTimes->{3.469403138655233*^9, 3.471554973567227*^9, 
  3.471577884968994*^9, 3.4836556560027637`*^9}]
}, Open  ]],

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

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"-", 
         FractionBox["b", "a"]}], "}"}], ",", 
       RowBox[{"{", "1", "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469403138705461*^9, 3.471554973619183*^9, 
  3.4715778850205793`*^9, 3.4836556560528708`*^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", ",", "True"}], "}"}]], "Output",
 CellChangeTimes->{3.47155498471983*^9, 3.471577885066519*^9, 
  3.483655656103222*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The package finds the invariance under translation in \
x and y depending on a and b.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{939, 1071},
WindowMargins->{{76, Automatic}, {Automatic, 19}},
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, 223, 4, 55, "Text"],
Cell[771, 26, 124, 1, 32, "Text"],
Cell[898, 29, 160, 4, 33, "Input"],
Cell[1061, 35, 476, 13, 32, "Text"],
Cell[1540, 50, 101, 2, 33, "Input"],
Cell[1644, 54, 198, 3, 32, "Text"],
Cell[1845, 59, 133, 4, 53, "Input"],
Cell[1981, 65, 229, 4, 32, "Text"],
Cell[2213, 71, 169, 4, 53, "Input"],
Cell[2385, 77, 130, 2, 32, "Text"],
Cell[2518, 81, 118, 3, 33, "Input"],
Cell[2639, 86, 128, 2, 32, "Text"],
Cell[2770, 90, 116, 3, 33, "Input"],
Cell[2889, 95, 221, 4, 32, "Text"],
Cell[3113, 101, 163, 5, 33, "Input"],
Cell[3279, 108, 141, 2, 32, "Text"],
Cell[3423, 112, 67, 2, 33, "Input"],
Cell[3493, 116, 385, 6, 70, "Text"],
Cell[3881, 124, 67, 2, 33, "Input"],
Cell[3951, 128, 509, 7, 89, "Text"],
Cell[4463, 137, 71, 2, 33, "Input"],
Cell[4537, 141, 534, 8, 89, "Text"],
Cell[5074, 151, 79, 2, 33, "Input"],
Cell[5156, 155, 267, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5448, 163, 310, 5, 72, "Input"],
Cell[5761, 170, 444, 8, 45, "Print"],
Cell[6208, 180, 1028, 14, 216, "Print"],
Cell[7239, 196, 723, 12, 64, "Print"],
Cell[7965, 210, 413, 8, 25, "Print"],
Cell[8381, 220, 1030, 14, 216, "Print"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9448, 239, 50, 0, 33, "Input"],
Cell[9501, 241, 195, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9733, 249, 45, 0, 33, "Input"],
Cell[9781, 251, 1600, 55, 69, "Output"]
}, Open  ]],
Cell[11396, 309, 39, 0, 33, "Input"],
Cell[11438, 311, 278, 7, 33, "Output"],
Cell[CellGroupData[{
Cell[11741, 322, 247, 4, 51, "Text"],
Cell[11991, 328, 47, 0, 33, "Input"],
Cell[12041, 330, 873, 16, 167, "Output"]
}, Open  ]],
Cell[12929, 349, 57, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[13011, 353, 78, 1, 33, "Input"],
Cell[13092, 356, 142, 2, 33, "Output"]
}, Open  ]],
Cell[13249, 361, 161, 4, 32, "Text"],
Cell[13413, 367, 345, 11, 33, "Input"],
Cell[13761, 380, 4370, 151, 241, "Output"],
Cell[18134, 533, 154, 3, 32, "Text"],
Cell[18291, 538, 509, 11, 145, "Text"],
Cell[CellGroupData[{
Cell[18825, 553, 273, 6, 53, "Input"],
Cell[19101, 561, 879, 14, 83, "Print"],
Cell[19983, 577, 443, 6, 83, "Print"],
Cell[20429, 585, 334, 6, 25, "Print"],
Cell[20766, 593, 322, 6, 25, "Print"],
Cell[21091, 601, 345, 7, 25, "Print"],
Cell[21439, 610, 325, 4, 45, "Print"],
Cell[21767, 616, 334, 6, 25, "Print"],
Cell[22104, 624, 168, 2, 25, "Print"],
Cell[22275, 628, 212, 3, 25, "Print"],
Cell[22490, 633, 333, 6, 25, "Print"],
Cell[22826, 641, 1089, 14, 254, "Print"],
Cell[23918, 657, 207, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[24162, 666, 184, 3, 32, "Text"],
Cell[24349, 671, 38, 0, 33, "Input"],
Cell[24390, 673, 199, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[24626, 681, 141, 2, 32, "Text"],
Cell[24770, 685, 38, 0, 33, "Input"],
Cell[24811, 687, 184, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[25032, 695, 144, 3, 32, "Text"],
Cell[25179, 700, 115, 3, 33, "Input"],
Cell[25297, 705, 227, 6, 54, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[25561, 716, 143, 2, 32, "Text"],
Cell[25707, 720, 115, 3, 33, "Input"],
Cell[25825, 725, 165, 3, 33, "Output"]
}, Open  ]],
Cell[26005, 731, 67, 0, 32, "Text"],
Cell[26075, 733, 236, 7, 33, "Input"],
Cell[26314, 742, 469, 14, 47, "Output"],
Cell[26786, 758, 154, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[26965, 765, 188, 4, 33, "Input"],
Cell[27156, 771, 278, 6, 33, "Output"]
}, Open  ]],
Cell[27449, 780, 175, 3, 32, "Text"]
}
]
*)

(* End of internal cache information *)
