(* 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[     39416,       1089]
NotebookOptionsPosition[     35239,        956]
NotebookOutlinePosition[     35813,        979]
CellTagsIndexPosition[     35770,        976]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[StyleBox["In this example we use the package IntroToSymmetry.m \
to work out the point group of the Blasius equation \n\nYxxx+YYxx=0 \n\n\
discussed in section 8.10.1.",
 FontSize->14,
 FontVariations->{"CompatibilityType"->0}]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["Clear all symbols in the current context.", "Text",
 CellChangeTimes->{{3.4715644485587473`*^9, 3.47156448605101*^9}}],

Cell[BoxData[
 RowBox[{"ClearAll", "[", 
  RowBox[{"Evaluate", "[", 
   RowBox[{
    RowBox[{"Context", "[", "]"}], "<>", "\"\<*\>\""}], "]"}], "]"}]], "Input"],

Cell[TextData[{
 StyleBox["First read in the package which is located in User Home \
Folder/Library/",
  FontWeight->"Plain"],
 StyleBox["Mathematica",
  FontWeight->"Plain",
  FontSlant->"Italic"],
 StyleBox["/Applications/SymmetryAnalysis.",
  FontWeight->"Plain"]
}], "Text",
 CellChangeTimes->{{3.472046215957556*^9, 3.472046255573135*^9}, {
  3.472046289795615*^9, 3.472046308115048*^9}, {3.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.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"blasiusequation", "=", "\n", "\"\<y'''[x]+y[x]*y''[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. Be careful to check signs.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"rulesarray", "=", "\[IndentingNewLine]", 
   RowBox[{"{", "\"\<y'''[x]\[Rule]-y[x]*y''[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 names and constant names \
that need to be preserved when the equation is changed to (x1, y1) variables. \
In this case there are no such quantities and so we enter a null list.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[TextData[StyleBox["Enter the maximum derivative order.",
 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-B\[ADoubleDot]cklund 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-B\
\[ADoubleDot]cklund 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-B\[ADoubleDot]cklund 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", ",", "blasiusequation", ",", "rulesarray", 
    ",", "internalrules"}], "]"}], "]"}]], "Input"],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(30897608\\), the time used = \\!\\(23.252639`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 30897608, 23.252639],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694026193935747`*^9, 3.4715548994486303`*^9, 
  3.471577793244453*^9, 3.47204706315703*^9, 3.483654569487595*^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.4694026193935747`*^9, 3.4715548994486303`*^9, 
  3.471577793244453*^9, 3.47204706315703*^9, 3.4836545695427723`*^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 = \\!\\(1240\\), the memory in use = \
\\!\\(30968784\\), the time used = \\!\\(23.318827000000002`\\)\"\>",
  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, 1240, 30968784, 
   23.318827000000002`],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694026193935747`*^9, 3.4715548994486303`*^9, 
  3.471577793244453*^9, 3.47204706315703*^9, 3.483654569573359*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(30969528\\), the time used = \\!\\(23.319036999999998`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 30969528, 23.319036999999998`],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694026193935747`*^9, 3.4715548994486303`*^9, 
  3.471577793244453*^9, 3.47204706315703*^9, 3.4836545695744553`*^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.4694026193935747`*^9, 3.4715548994486303`*^9, 
  3.471577793244453*^9, 3.47204706315703*^9, 3.483654569575309*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.06709900000000246`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469402619480319*^9, 3.471554899520591*^9, 
  3.471577793339057*^9, 3.472047063362878*^9, 3.483654569577104*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"y1'''[x1]+y1[x1]*y1''[x1]\"\>"], "Output",
 CellChangeTimes->{3.46940261951046*^9, 3.471554899572497*^9, 
  3.471577793381036*^9, 3.472047063392239*^9, 3.4836545696080017`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0", ",", 
   RowBox[{
    SuperscriptBox["y1", "\[Prime]\[Prime]",
     MultilineFunction->None], "[", "x1", "]"}], ",", "0", ",", 
   RowBox[{"y1", "[", "x1", "]"}], ",", "1"}], "}"}]], "Output",
 CellChangeTimes->{3.469402619548044*^9, 3.471554899618389*^9, 
  3.471577793437941*^9, 3.472047063449305*^9, 3.483654569661973*^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.469402619576589*^9, 3.471554899672779*^9, 
  3.471577793481905*^9, 3.472047063481933*^9, 3.483654569694764*^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[{"\<\"-3*Derivative[0, 1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-6*Derivative[0, 2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-Derivative[0, 3][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"z2*Derivative[0, 1][xse1][z1, z2] + 3*Derivative[0, 2][eta1][z1, \
z2] - 9*Derivative[1, 1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-(z2*Derivative[0, 2][xse1][z1, z2]) + Derivative[0, \
3][eta1][z1, z2] - 3*Derivative[1, 2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"eta1[z1, z2] + z2*Derivative[1, 0][xse1][z1, z2] + \
3*Derivative[1, 1][eta1][z1, z2] - 3*Derivative[2, 0][xse1][z1, z2] == 0\"\>",
    ",", "\<\"z2*Derivative[0, 2][eta1][z1, z2] - 2*z2*Derivative[1, \
1][xse1][z1, z2] + 3*Derivative[1, 2][eta1][z1, z2] - 3*Derivative[2, \
1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"z2*Derivative[2, 0][eta1][z1, z2] + Derivative[3, 0][eta1][z1, \
z2] == 0\"\>", 
   ",", "\<\"2*z2*Derivative[1, 1][eta1][z1, z2] - z2*Derivative[2, \
0][xse1][z1, z2] + 3*Derivative[2, 1][eta1][z1, z2] - Derivative[3, \
0][xse1][z1, z2] == 0\"\>"}], "}"}]], "Output",
 CellChangeTimes->{3.4694026196092577`*^9, 3.471554899718443*^9, 
  3.471577793537223*^9, 3.4720470635271473`*^9, 3.4836545697409143`*^9}]
}, Open  ]],

Cell["\<\
Lets look at the determining equations in a slightly more readable form.\
\>", "Text"],

Cell[BoxData[
 RowBox[{"zdeterminingequationscolumn", "=", 
  RowBox[{"TraditionalForm", "[", 
   RowBox[{"Column", "[", 
    RowBox[{
     RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"Left", ",", "Below"}], "}"}]}], "]"}], "]"}]}]], "Input",
 CellChangeTimes->{{3.469402580236899*^9, 3.4694025990522842`*^9}}],

Cell[BoxData[
 FormBox[
  TagBox[GridBox[{
     {
      RowBox[{
       RowBox[{
        RowBox[{"-", "3"}], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "(", 
         RowBox[{"z1", ",", "z2"}], ")"}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"-", "6"}], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "(", 
         RowBox[{"z1", ",", "z2"}], ")"}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{"-", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "3"}], ")"}],
           Derivative],
          MultilineFunction->None], "(", 
         RowBox[{"z1", ",", "z2"}], ")"}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"3", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"0", ",", "2"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{"z2", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"0", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{"9", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "3"}], ")"}],
           Derivative],
          MultilineFunction->None], "(", 
         RowBox[{"z1", ",", "z2"}], ")"}], "-", 
        RowBox[{"z2", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"0", ",", "2"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{"3", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "2"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"3", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{"eta1", "(", 
         RowBox[{"z1", ",", "z2"}], ")"}], "+", 
        RowBox[{"z2", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{"3", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"2", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"z2", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"0", ",", "2"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{"3", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "2"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{"2", " ", "z2", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{"3", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"2", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"z2", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"2", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"3", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "(", 
         RowBox[{"z1", ",", "z2"}], ")"}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"2", " ", "z2", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{"3", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"2", ",", "1"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{"z2", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"2", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "-", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"3", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "(", 
         RowBox[{"z1", ",", "z2"}], ")"}]}], "\[LongEqual]", "0"}]}
    },
    GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
    GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
   "Column"], TraditionalForm]], "Output",
 CellChangeTimes->{3.469402619646142*^9, 3.471554899779459*^9, 
  3.471577793583267*^9, 3.4720470636457253`*^9, 3.4836545697987127`*^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", "[", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "r", ",", "xseon", 
    ",", "zdeterminingequations", ",", 
    RowBox[{"order", "=", "3"}]}], "]"}], "]"}]], "Input"],

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

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(30960896\\), The time = \\!\
\\(23.354195999999998`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 30960896, 23.354195999999998`],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694026196942596`*^9, 3.471554899819737*^9, 
  3.471577793635542*^9, 3.4720470636962976`*^9, 3.4836545698469057`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(20\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 20],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694026196942596`*^9, 3.471554899819737*^9, 
  3.471577793635542*^9, 3.4720470636962976`*^9, 3.483654569847721*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(42\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 42],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694026196942596`*^9, 3.471554899819737*^9, 
  3.471577793635542*^9, 3.4720470636962976`*^9, 3.483654569848545*^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.4694026196942596`*^9, 3.471554899819737*^9, 
  3.471577793635542*^9, 3.4720470636962976`*^9, 3.483654569849382*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(30971128\\), The time = \\!\
\\(23.355723`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 30971128, 23.355723],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694026196942596`*^9, 3.471554899819737*^9, 
  3.471577793635542*^9, 3.4720470636962976`*^9, 3.4836545698512497`*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.4694026196942596`*^9, 3.471554899819737*^9, 
  3.471577793635542*^9, 3.4720470636962976`*^9, 3.483654569852098*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.4694026196942596`*^9, 3.471554899819737*^9, 
  3.471577793635542*^9, 3.4720470636962976`*^9, 3.483654569852995*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(30978688\\), The time = \\!\
\\(23.356576`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 30978688, 23.356576],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694026196942596`*^9, 3.471554899819737*^9, 
  3.471577793635542*^9, 3.4720470636962976`*^9, 3.483654569853813*^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.4694026196942596`*^9, 3.471554899819737*^9, 
  3.471577793635542*^9, 3.4720470636962976`*^9, 3.4836545698546047`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.011386000000001673`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.4694026196978207`*^9, 3.471554899831292*^9, 
  3.471577793648744*^9, 3.472047063780773*^9, 3.4836545698562527`*^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 - b14*z1\"\>", "}"}]], "Output",
 CellChangeTimes->{3.469402619731103*^9, 3.471554899870144*^9, 
  3.471577793682073*^9, 3.472047063832699*^9, 3.483654569891079*^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_]=b14*z2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.4694026197598743`*^9, 3.471554899923971*^9, 
  3.471577793736305*^9, 3.472047063957*^9, 3.483654569945451*^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", "-", 
   RowBox[{"b14", " ", "x"}]}], "}"}]], "Output",
 CellChangeTimes->{3.46940261979805*^9, 3.47155489997012*^9, 
  3.471577793783828*^9, 3.4720470639991913`*^9, 3.483654569991598*^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[{"b14", " ", 
   RowBox[{"y", "[", "x", "]"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469402619826981*^9, 3.471554900024239*^9, 
  3.471577793834421*^9, 3.472047064027177*^9, 3.483654570046502*^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[{"{", 
      RowBox[{"-", "x"}], "}"}], ",", 
     RowBox[{"{", "y", "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469402619864691*^9, 3.471554900071561*^9, 
  3.471577793883718*^9, 3.472047064083366*^9, 3.4836545700920753`*^9}]
}, Open  ]],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "1", "}"}], ",", 
       RowBox[{"{", "0", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"-", "x"}], "}"}], ",", 
       RowBox[{"{", "y", "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.4694026198941803`*^9, 3.471554900103773*^9, 
  3.471577793933497*^9, 3.472047064113201*^9, 3.483654570146288*^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.471554913895875*^9, 3.471577794062152*^9, 
  3.472047064148868*^9, 3.483654570271348*^9}]
}, Open  ]],

Cell[TextData[StyleBox["The final result indicates that the equation is \
invariant under two groups. The parameter a10 corresponds to a translation in \
x and the parameter b14 represents a dilation in x and y. Generate 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.469402619926725*^9, 3.4715549001393414`*^9, 
  3.471577794105044*^9, 3.472047064179057*^9, 3.4836545703083467`*^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[{
         {
          RowBox[{"-", "1"}]},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]},
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {"1"},
         {"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.469402619961158*^9, 3.471554900187828*^9, 
  3.471577794155904*^9, 3.472047064235887*^9, 3.48365457034476*^9}]
}, Open  ]],

Cell[TextData[StyleBox["This is a solvable Lie algebra that can be used to \
reduce the Blasius equation to first order.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{864, 921},
WindowMargins->{{32, Automatic}, {Automatic, 20}},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
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, 283, 5, 138, "Text"],
Cell[831, 27, 124, 1, 32, "Text"],
Cell[958, 30, 160, 4, 33, "Input"],
Cell[1121, 36, 476, 13, 32, "Text"],
Cell[1600, 51, 101, 2, 33, "Input"],
Cell[1704, 55, 163, 3, 32, "Text"],
Cell[1870, 60, 116, 3, 53, "Input"],
Cell[1989, 65, 255, 4, 51, "Text"],
Cell[2247, 71, 156, 3, 53, "Input"],
Cell[2406, 76, 130, 2, 32, "Text"],
Cell[2539, 80, 118, 3, 33, "Input"],
Cell[2660, 85, 128, 2, 32, "Text"],
Cell[2791, 89, 116, 3, 33, "Input"],
Cell[2910, 94, 294, 4, 51, "Text"],
Cell[3207, 100, 108, 3, 33, "Input"],
Cell[3318, 105, 125, 2, 32, "Text"],
Cell[3446, 109, 67, 2, 33, "Input"],
Cell[3516, 113, 385, 6, 70, "Text"],
Cell[3904, 121, 67, 2, 33, "Input"],
Cell[3974, 125, 535, 8, 89, "Text"],
Cell[4512, 135, 71, 2, 33, "Input"],
Cell[4586, 139, 546, 8, 89, "Text"],
Cell[5135, 149, 79, 2, 33, "Input"],
Cell[5217, 153, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5510, 161, 326, 6, 72, "Input"],
Cell[5839, 169, 472, 8, 45, "Print"],
Cell[6314, 179, 1055, 14, 235, "Print"],
Cell[7372, 195, 747, 12, 64, "Print"],
Cell[8122, 209, 461, 8, 45, "Print"],
Cell[8586, 219, 1055, 14, 235, "Print"],
Cell[9644, 235, 228, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9909, 244, 50, 0, 33, "Input"],
Cell[9962, 246, 194, 2, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10193, 253, 45, 0, 33, "Input"],
Cell[10241, 255, 369, 8, 40, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10647, 268, 241, 4, 51, "Text"],
Cell[10891, 274, 39, 0, 33, "Input"],
Cell[10933, 276, 298, 7, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[11268, 288, 278, 4, 51, "Text"],
Cell[11549, 294, 47, 0, 33, "Input"],
Cell[11599, 296, 1206, 20, 262, "Output"]
}, Open  ]],
Cell[12820, 319, 96, 2, 32, "Text"],
Cell[12919, 323, 366, 8, 53, "Input"],
Cell[13288, 333, 7211, 231, 244, "Output"],
Cell[20502, 566, 509, 11, 164, "Text"],
Cell[CellGroupData[{
Cell[21036, 581, 273, 6, 53, "Input"],
Cell[21312, 589, 905, 14, 102, "Print"],
Cell[22220, 605, 467, 6, 83, "Print"],
Cell[22690, 613, 382, 7, 25, "Print"],
Cell[23075, 622, 344, 6, 25, "Print"],
Cell[23422, 630, 367, 7, 25, "Print"],
Cell[23792, 639, 345, 4, 64, "Print"],
Cell[24140, 645, 360, 6, 25, "Print"],
Cell[24503, 653, 190, 2, 25, "Print"],
Cell[24696, 657, 234, 3, 25, "Print"],
Cell[24933, 662, 358, 6, 25, "Print"],
Cell[25294, 670, 1113, 14, 254, "Print"],
Cell[26410, 686, 233, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[26680, 695, 184, 3, 32, "Text"],
Cell[26867, 700, 38, 0, 33, "Input"],
Cell[26908, 702, 217, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[27162, 710, 141, 2, 32, "Text"],
Cell[27306, 714, 38, 0, 33, "Input"],
Cell[27347, 716, 210, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[27594, 724, 144, 3, 32, "Text"],
Cell[27741, 729, 115, 3, 33, "Input"],
Cell[27859, 734, 234, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[28130, 744, 143, 2, 32, "Text"],
Cell[28276, 748, 115, 3, 33, "Input"],
Cell[28394, 753, 237, 5, 33, "Output"]
}, Open  ]],
Cell[28646, 761, 67, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[28738, 765, 226, 6, 33, "Input"],
Cell[28967, 773, 432, 13, 33, "Output"]
}, Open  ]],
Cell[29414, 789, 79, 1, 33, "Input"],
Cell[29496, 792, 581, 18, 53, "Output"],
Cell[30080, 812, 154, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[30259, 819, 188, 4, 33, "Input"],
Cell[30450, 825, 288, 6, 33, "Output"]
}, Open  ]],
Cell[30753, 834, 330, 5, 51, "Text"],
Cell[CellGroupData[{
Cell[31108, 843, 168, 4, 53, "Input"],
Cell[31279, 849, 552, 7, 102, "Print"]
}, Open  ]],
Cell[31846, 859, 132, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[32003, 865, 77, 1, 33, "Input"],
Cell[32083, 868, 2951, 80, 107, "Output"]
}, Open  ]],
Cell[35049, 951, 186, 3, 62, "Text"]
}
]
*)

(* End of internal cache information *)
