(* 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[     45214,       1315]
NotebookOptionsPosition[     40934,       1178]
NotebookOutlinePosition[     41562,       1203]
CellTagsIndexPosition[     41519,       1200]
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 sections 8.10.1 and 14.4.2.",
 FontSize->14]], "Text",
 ImageRegion->{{0, 1}, {0, 1}},
 FontVariations->{"CompatibilityType"->0}],

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", "\"\<D[y[x],x,x,x]+y[x]*D[y[x],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. Be careful to check signs.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"rulesarray", "=", "\[IndentingNewLine]", 
   RowBox[{"{", "\"\<D[y[x],x,x,x]\[Rule]-y[x]*D[y[x],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 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", "=", "3"}], ";"}]], "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", "=", "0"}], ";"}]], "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", "=", "1"}], ";"}]], "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 = \\!\\(47515616\\), the time used = \\!\\(84.904771`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 47515616, 84.904771],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694822944149647`*^9, 3.4694824781510763`*^9, 
  3.471572445919709*^9, 3.483788850134404*^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.4694822944149647`*^9, 3.4694824781510763`*^9, 
  3.471572445919709*^9, 3.483788850430427*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(1\\), the \
byte count of zdeterminingequations = \\!\\(6520\\), the memory in use = \
\\!\\(49914808\\), the time used = \\!\\(85.283063`\\)\"\>",
  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 = ``", 1, 6520, 49914808, 
   85.283063],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694822944149647`*^9, 3.4694824781510763`*^9, 
  3.471572445919709*^9, 3.483788850502964*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(49916904\\), the time used = \\!\\(85.28341200000001`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 49916904, 85.28341200000001],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694822944149647`*^9, 3.4694824781510763`*^9, 
  3.471572445919709*^9, 3.4837888505049467`*^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.4694822944149647`*^9, 3.4694824781510763`*^9, 
  3.471572445919709*^9, 3.483788850506621*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.3795290000000051`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469482294843114*^9, 3.4694824785917683`*^9, 
  3.4715724463086843`*^9, 3.483788850509055*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1,x1]+y1[x1]*D[y1[x1],x1,x1]\"\>"], "Output",
 CellChangeTimes->{3.469482294880156*^9, 3.469482478666335*^9, 
  3.471572446343288*^9, 3.483788850536051*^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.469482294912663*^9, 3.469482478723858*^9, 
  3.471572446376369*^9, 3.483788850571014*^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", "]"}]}], ",", 
   RowBox[{"z3", "\[Rule]", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}]}], ",", 
   RowBox[{"z4", "\[Rule]", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x", "]"}]}], ",", 
   RowBox[{"z5", "\[Rule]", 
    RowBox[{
     SuperscriptBox["y", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469482294946356*^9, 3.469482478802285*^9, 
  3.4715724464105377`*^9, 3.483788850625845*^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[CellGroupData[{

Cell[BoxData[
 RowBox[{"Length", "[", "zdeterminingequations", "]"}]], "Input",
 CellChangeTimes->{{3.4694823542785263`*^9, 3.4694823599743223`*^9}}],

Cell[BoxData["1"], "Output",
 CellChangeTimes->{3.469482360953672*^9, 3.469482478853346*^9, 
  3.47157244644348*^9, 3.4837888506709967`*^9}]
}, Open  ]]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{
  RowBox[{"zdeterminingequationscolumn", "=", 
   RowBox[{"TraditionalForm", "[", 
    RowBox[{"Column", "[", 
     RowBox[{
      RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], ",", 
      RowBox[{"{", 
       RowBox[{"Left", ",", "Below"}], "}"}]}], "]"}], "]"}]}], 
  ";"}]], "Input",
 CellChangeTimes->{{3.469482223056328*^9, 3.469482241362411*^9}, {
   3.469482316479376*^9, 3.469482337372076*^9}, 3.471572398110924*^9}],

Cell["\<\
Notice that the number of determining equations is now down to one. As the \
order of the Lie-B\[ADoubleDot]cklund transformation sought increases, the \
number of determining equations decreases. In this case we are seeking \
functions that depend on independent derivatives up to third order whereas \
the equation itself is third order, effectively eliminating any derivatives \
of third order or higher. Now solve the one  determining equation in terms of \
multivariable polynomials. 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",
 CellChangeTimes->{3.469482371137014*^9}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"SolveDeterminingEquations", "[", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "r", ",", 
    "\[IndentingNewLine]", "xseon", ",", "zdeterminingequations", ",", 
    RowBox[{"order", "=", "7"}]}], "]"}], "]"}]], "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 = \\!\\(792\\)\"\>",
  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 = ``", 792],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.483788851854217*^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.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.4837888541703777`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(72262864\\), The time = \\!\
\\(88.731564`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 72262864, 88.731564],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.4837888541716537`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(792\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 792],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.48378885436712*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(2281\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 2281],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.4837888543683853`*^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.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.483788854369688*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(74605640\\), The time = \\!\
\\(88.928175`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 74605640, 88.928175],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.483788854370865*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.483788854737206*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.483788854987296*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(75351696\\), The time = \\!\
\\(89.53945300000001`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 75351696, 89.53945300000001],
  Editable->False]], "Print",
 CellChangeTimes->{3.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.483788854988573*^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.46948229806717*^9, 3.46948248210917*^9, 
  3.471572447587908*^9, 3.483788854990706*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"4.26059699999999`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.46948229882672*^9, 3.4694824829036694`*^9, 
  3.471572450789048*^9, 3.483788855038488*^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_, z3_, z4_, z5_]=0\"\>", "}"}]], "Output",
 CellChangeTimes->{3.4694822989270144`*^9, 3.469482483014958*^9, 
  3.471572450913519*^9, 3.483788855162071*^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_, z3_, z4_, z5_]=b137*z2 + b136*z3 + \
b137*z1*z3 + b1359*z2^2*z4 + b1358*z2*z3*z4 + b1359*z1*z2*z3*z4 + \
b1562*z2^3*z4^2 + b1561*z2^2*z3*z4^2 + b1562*z1*z2^2*z3*z4^2 + \
b1681*z2^3*z3*z4^3 + b1359*z2*z5 + b1358*z3*z5 + b1359*z1*z3*z5 + \
2*b1562*z2^2*z4*z5 + 2*b1561*z2*z3*z4*z5 + 2*b1562*z1*z2*z3*z4*z5 + \
3*b1681*z2^2*z3*z4^2*z5 + b1562*z2*z5^2 + b1561*z3*z5^2 + b1562*z1*z3*z5^2 + \
3*b1681*z2*z3*z4*z5^2 + b1681*z3*z5^3\"\>", "}"}]], "Output",
 CellChangeTimes->{3.4694822989662943`*^9, 3.469482483071705*^9, 
  3.471572450954949*^9, 3.483788855221483*^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[{"{", "0", "}"}]], "Output",
 CellChangeTimes->{3.469482298994754*^9, 3.469482483118053*^9, 
  3.471572450985174*^9, 3.4837888552849092`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"b137", " ", 
    RowBox[{"y", "[", "x", "]"}]}], "+", 
   RowBox[{"b136", " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"b137", " ", "x", " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"b1359", " ", 
    SuperscriptBox[
     RowBox[{"y", "[", "x", "]"}], "2"], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"b1358", " ", 
    RowBox[{"y", "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"b1359", " ", "x", " ", 
    RowBox[{"y", "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"b1562", " ", 
    SuperscriptBox[
     RowBox[{"y", "[", "x", "]"}], "3"], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x", "]"}], "2"]}], "+", 
   RowBox[{"b1561", " ", 
    SuperscriptBox[
     RowBox[{"y", "[", "x", "]"}], "2"], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x", "]"}], "2"]}], "+", 
   RowBox[{"b1562", " ", "x", " ", 
    SuperscriptBox[
     RowBox[{"y", "[", "x", "]"}], "2"], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x", "]"}], "2"]}], "+", 
   RowBox[{"b1681", " ", 
    SuperscriptBox[
     RowBox[{"y", "[", "x", "]"}], "3"], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x", "]"}], "3"]}], "+", 
   RowBox[{"b1359", " ", 
    RowBox[{"y", "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"b1358", " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"b1359", " ", "x", " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"2", " ", "b1562", " ", 
    SuperscriptBox[
     RowBox[{"y", "[", "x", "]"}], "2"], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"2", " ", "b1561", " ", 
    RowBox[{"y", "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"2", " ", "b1562", " ", "x", " ", 
    RowBox[{"y", "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"3", " ", "b1681", " ", 
    SuperscriptBox[
     RowBox[{"y", "[", "x", "]"}], "2"], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x", "]"}], "2"], " ", 
    RowBox[{
     SuperscriptBox["y", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x", "]"}]}], "+", 
   RowBox[{"b1562", " ", 
    RowBox[{"y", "[", "x", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", 
       TagBox[
        RowBox[{"(", "3", ")"}],
        Derivative],
       MultilineFunction->None], "[", "x", "]"}], "2"]}], "+", 
   RowBox[{"b1561", " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", 
       TagBox[
        RowBox[{"(", "3", ")"}],
        Derivative],
       MultilineFunction->None], "[", "x", "]"}], "2"]}], "+", 
   RowBox[{"b1562", " ", "x", " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", 
       TagBox[
        RowBox[{"(", "3", ")"}],
        Derivative],
       MultilineFunction->None], "[", "x", "]"}], "2"]}], "+", 
   RowBox[{"3", " ", "b1681", " ", 
    RowBox[{"y", "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", 
       TagBox[
        RowBox[{"(", "3", ")"}],
        Derivative],
       MultilineFunction->None], "[", "x", "]"}], "2"]}], "+", 
   RowBox[{"b1681", " ", 
    RowBox[{
     SuperscriptBox["y", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y", 
       TagBox[
        RowBox[{"(", "3", ")"}],
        Derivative],
       MultilineFunction->None], "[", "x", "]"}], "3"]}]}], "}"}]], "Output",
 CellChangeTimes->{3.4694822990342712`*^9, 3.469482483177147*^9, 
  3.471572451040935*^9, 3.48378885534533*^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"}], ",", 
     RowBox[{"z3", "\[Rule]", "yx"}], ",", 
     RowBox[{"z4", "\[Rule]", "yxx"}], ",", 
     RowBox[{"z5", "\[Rule]", "yxxx"}], ",", 
     RowBox[{"z6", "\[Rule]", "yxxxx"}]}], "}"}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "0", "}"}], ",", 
     RowBox[{"{", "yx", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "0", "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"y", "+", 
       RowBox[{"x", " ", "yx"}]}], "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "0", "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"y", " ", "yx", " ", "yxx"}], "+", 
       RowBox[{"yx", " ", "yxxx"}]}], "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "0", "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{
        SuperscriptBox["y", "2"], " ", "yxx"}], "+", 
       RowBox[{"x", " ", "y", " ", "yx", " ", "yxx"}], "+", 
       RowBox[{"y", " ", "yxxx"}], "+", 
       RowBox[{"x", " ", "yx", " ", "yxxx"}]}], "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "0", "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{
        SuperscriptBox["y", "2"], " ", "yx", " ", 
        SuperscriptBox["yxx", "2"]}], "+", 
       RowBox[{"2", " ", "y", " ", "yx", " ", "yxx", " ", "yxxx"}], "+", 
       RowBox[{"yx", " ", 
        SuperscriptBox["yxxx", "2"]}]}], "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "0", "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{
        SuperscriptBox["y", "3"], " ", 
        SuperscriptBox["yxx", "2"]}], "+", 
       RowBox[{"x", " ", 
        SuperscriptBox["y", "2"], " ", "yx", " ", 
        SuperscriptBox["yxx", "2"]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["y", "2"], " ", "yxx", " ", "yxxx"}], "+", 
       RowBox[{"2", " ", "x", " ", "y", " ", "yx", " ", "yxx", " ", "yxxx"}], 
       "+", 
       RowBox[{"y", " ", 
        SuperscriptBox["yxxx", "2"]}], "+", 
       RowBox[{"x", " ", "yx", " ", 
        SuperscriptBox["yxxx", "2"]}]}], "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", "0", "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{
        SuperscriptBox["y", "3"], " ", "yx", " ", 
        SuperscriptBox["yxx", "3"]}], "+", 
       RowBox[{"3", " ", 
        SuperscriptBox["y", "2"], " ", "yx", " ", 
        SuperscriptBox["yxx", "2"], " ", "yxxx"}], "+", 
       RowBox[{"3", " ", "y", " ", "yx", " ", "yxx", " ", 
        SuperscriptBox["yxxx", "2"]}], "+", 
       RowBox[{"yx", " ", 
        SuperscriptBox["yxxx", "3"]}]}], "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469482299062755*^9, 3.469482483218863*^9, 
  3.471572451073863*^9, 3.48378885541588*^9}]
}, Open  ]],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", "yx", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"y", "+", 
         RowBox[{"x", " ", "yx"}]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"y", " ", "yx", " ", "yxx"}], "+", 
         RowBox[{"yx", " ", "yxxx"}]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{
          SuperscriptBox["y", "2"], " ", "yxx"}], "+", 
         RowBox[{"x", " ", "y", " ", "yx", " ", "yxx"}], "+", 
         RowBox[{"y", " ", "yxxx"}], "+", 
         RowBox[{"x", " ", "yx", " ", "yxxx"}]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{
          SuperscriptBox["y", "2"], " ", "yx", " ", 
          SuperscriptBox["yxx", "2"]}], "+", 
         RowBox[{"2", " ", "y", " ", "yx", " ", "yxx", " ", "yxxx"}], "+", 
         RowBox[{"yx", " ", 
          SuperscriptBox["yxxx", "2"]}]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{
          SuperscriptBox["y", "3"], " ", 
          SuperscriptBox["yxx", "2"]}], "+", 
         RowBox[{"x", " ", 
          SuperscriptBox["y", "2"], " ", "yx", " ", 
          SuperscriptBox["yxx", "2"]}], "+", 
         RowBox[{"2", " ", 
          SuperscriptBox["y", "2"], " ", "yxx", " ", "yxxx"}], "+", 
         RowBox[{
         "2", " ", "x", " ", "y", " ", "yx", " ", "yxx", " ", "yxxx"}], "+", 
         RowBox[{"y", " ", 
          SuperscriptBox["yxxx", "2"]}], "+", 
         RowBox[{"x", " ", "yx", " ", 
          SuperscriptBox["yxxx", "2"]}]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{
          SuperscriptBox["y", "3"], " ", "yx", " ", 
          SuperscriptBox["yxx", "3"]}], "+", 
         RowBox[{"3", " ", 
          SuperscriptBox["y", "2"], " ", "yx", " ", 
          SuperscriptBox["yxx", "2"], " ", "yxxx"}], "+", 
         RowBox[{"3", " ", "y", " ", "yx", " ", "yxx", " ", 
          SuperscriptBox["yxxx", "2"]}], "+", 
         RowBox[{"yx", " ", 
          SuperscriptBox["yxxx", "3"]}]}], "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469482299099846*^9, 3.469482483274893*^9, 
  3.4715724511213493`*^9, 3.483788855484758*^9}],

Cell["\<\
Note that the third, fourth and fifth groups can be factored in terms of the \
first two and the Blasius equation.\
\>", "Text"],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", "yx", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"y", "+", 
         RowBox[{"x", " ", "yx"}]}], "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"yx", " ", 
         RowBox[{"(", 
          RowBox[{
           RowBox[{"y", " ", "yxx"}], "+", "yxxx"}], ")"}]}], "}"}]}], 
      "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"(", 
          RowBox[{"y", "+", 
           RowBox[{"x", " ", "yx"}]}], ")"}], " ", 
         RowBox[{"(", 
          RowBox[{
           RowBox[{"y", " ", "yxx"}], "+", "yxxx"}], ")"}]}], "}"}]}], 
      "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"yx", " ", 
         SuperscriptBox[
          RowBox[{"(", 
           RowBox[{
            RowBox[{"y", " ", "yxx"}], "+", "yxxx"}], ")"}], "2"]}], "}"}]}], 
      "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"(", 
          RowBox[{"y", "+", 
           RowBox[{"x", " ", "yx"}]}], ")"}], " ", 
         SuperscriptBox[
          RowBox[{"(", 
           RowBox[{
            RowBox[{"y", " ", "yxx"}], "+", "yxxx"}], ")"}], "2"]}], "}"}]}], 
      "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"yx", " ", 
         SuperscriptBox[
          RowBox[{"(", 
           RowBox[{
            RowBox[{"y", " ", "yxx"}], "+", "yxxx"}], ")"}], "3"]}], "}"}]}], 
      "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469482299129033*^9, 3.469482483320445*^9, 
  3.471572451157284*^9, 3.4837888555523243`*^9}],

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

Cell[CellGroupData[{

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

 CellChangeTimes->{{3.471145481019026*^9, 3.4711455173104143`*^9}, 
   3.471146122753789*^9, {3.47154140257237*^9, 3.471541418863482*^9}, {
   3.4715667761993*^9, 3.4715667786858253`*^9}, 3.471567789726531*^9, 
   3.471568099275279*^9, 3.4715715735656223`*^9, 3.471572095183077*^9}],

Cell[BoxData[
 RowBox[{"{", "True", "}"}]], "Output",
 CellChangeTimes->{3.4715724512024593`*^9, 3.483788855619769*^9}]
}, Open  ]],

Cell["\<\
In this case, analysis of Lie-Backlund groups leads merely to the two that \
are equivalent to the point groups of the equation.\
\>", "Text"],

Cell[CellGroupData[{

Cell[BoxData["rulesarrayexpanded"], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{"-", 
      RowBox[{"y1", "[", "x1", "]"}]}], " ", 
     RowBox[{
      SuperscriptBox["y1", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]}]}], ",", 
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", "4", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{
      RowBox[{"-", 
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}]}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], "-", 
     RowBox[{
      RowBox[{"y1", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}]}]}], ",", 
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", "5", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{"-", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["y1", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"]}], "-", 
     RowBox[{"2", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], "-", 
     RowBox[{
      RowBox[{"y1", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", "4", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}]}]}], ",", 
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", "6", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}], "\[Rule]", 
    RowBox[{
     RowBox[{
      RowBox[{"-", "4"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], "-", 
     RowBox[{"3", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", "4", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], "-", 
     RowBox[{
      RowBox[{"y1", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", "5", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}]}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469482299162055*^9, 3.469482483375082*^9, 
  3.471572451259512*^9, 3.483788855684219*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["263036176"], "Output",
 CellChangeTimes->{3.469482299195018*^9, 3.46948248341859*^9, 
  3.4715724513033667`*^9, 3.4837888557473793`*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{935, 975},
WindowMargins->{{29, Automatic}, {Automatic, 24}},
PrintingCopies->1,
PrintingPageRange->{1, Automatic},
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, 295, 5, 117, "Text"],
Cell[843, 27, 124, 1, 32, "Text"],
Cell[970, 30, 160, 4, 33, "Input"],
Cell[1133, 36, 476, 13, 32, "Text"],
Cell[1612, 51, 101, 2, 33, "Input"],
Cell[1716, 55, 164, 3, 32, "Text"],
Cell[1883, 60, 130, 4, 53, "Input"],
Cell[2016, 66, 255, 4, 51, "Text"],
Cell[2274, 72, 170, 4, 53, "Input"],
Cell[2447, 78, 130, 2, 32, "Text"],
Cell[2580, 82, 118, 3, 33, "Input"],
Cell[2701, 87, 128, 2, 32, "Text"],
Cell[2832, 91, 116, 3, 33, "Input"],
Cell[2951, 96, 294, 4, 51, "Text"],
Cell[3248, 102, 108, 3, 33, "Input"],
Cell[3359, 107, 125, 2, 32, "Text"],
Cell[3487, 111, 67, 2, 33, "Input"],
Cell[3557, 115, 385, 6, 70, "Text"],
Cell[3945, 123, 67, 2, 33, "Input"],
Cell[4015, 127, 509, 7, 89, "Text"],
Cell[4527, 136, 71, 2, 33, "Input"],
Cell[4601, 140, 534, 8, 89, "Text"],
Cell[5138, 150, 79, 2, 33, "Input"],
Cell[5220, 154, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5513, 162, 326, 6, 72, "Input"],
Cell[5842, 170, 451, 8, 45, "Print"],
Cell[6296, 180, 1032, 14, 216, "Print"],
Cell[7331, 196, 707, 12, 64, "Print"],
Cell[8041, 210, 437, 8, 45, "Print"],
Cell[8481, 220, 1034, 14, 216, "Print"],
Cell[9518, 236, 209, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9764, 245, 50, 0, 33, "Input"],
Cell[9817, 247, 187, 2, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10041, 254, 45, 0, 33, "Input"],
Cell[10089, 256, 347, 8, 40, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10473, 269, 241, 4, 51, "Text"],
Cell[10717, 275, 39, 0, 33, "Input"],
Cell[10759, 277, 749, 22, 42, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[11545, 304, 279, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[11849, 312, 149, 2, 33, "Input"],
Cell[12001, 316, 140, 2, 33, "Output"]
}, Open  ]]
}, Open  ]],
Cell[12168, 322, 96, 2, 32, "Text"],
Cell[12267, 326, 463, 11, 53, "Input"],
Cell[12733, 339, 943, 17, 201, "Text"],
Cell[CellGroupData[{
Cell[13701, 360, 296, 6, 53, "Input"],
Cell[14000, 368, 877, 14, 83, "Print"],
Cell[14880, 384, 439, 6, 83, "Print"],
Cell[15322, 392, 332, 6, 25, "Print"],
Cell[15657, 400, 317, 6, 25, "Print"],
Cell[15977, 408, 345, 7, 25, "Print"],
Cell[16325, 417, 317, 4, 45, "Print"],
Cell[16645, 423, 330, 6, 25, "Print"],
Cell[16978, 431, 162, 2, 25, "Print"],
Cell[17143, 435, 206, 3, 25, "Print"],
Cell[17352, 440, 349, 7, 25, "Print"],
Cell[17704, 449, 1083, 14, 254, "Print"],
Cell[18790, 465, 204, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[19031, 474, 184, 3, 32, "Text"],
Cell[19218, 479, 38, 0, 33, "Input"],
Cell[19259, 481, 201, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[19497, 489, 141, 2, 32, "Text"],
Cell[19641, 493, 38, 0, 33, "Input"],
Cell[19682, 495, 609, 9, 129, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[20328, 509, 144, 3, 32, "Text"],
Cell[20475, 514, 115, 3, 33, "Input"],
Cell[20593, 519, 163, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[20793, 527, 143, 2, 32, "Text"],
Cell[20939, 531, 115, 3, 33, "Input"],
Cell[21057, 536, 6938, 214, 201, "Output"]
}, Open  ]],
Cell[28010, 753, 67, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[28102, 757, 408, 10, 53, "Input"],
Cell[28513, 769, 2586, 76, 121, "Output"]
}, Open  ]],
Cell[31114, 848, 79, 1, 33, "Input"],
Cell[31196, 851, 2869, 86, 179, "Output"],
Cell[34068, 939, 138, 3, 32, "Text"],
Cell[34209, 944, 112, 2, 33, "Input"],
Cell[34324, 948, 2159, 78, 171, "Output"],
Cell[36486, 1028, 136, 1, 32, "Text"],
Cell[CellGroupData[{
Cell[36647, 1033, 405, 7, 33, "Input"],
Cell[37055, 1042, 119, 2, 33, "Output"]
}, Open  ]],
Cell[37189, 1047, 152, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[37366, 1054, 44, 0, 33, "Input"],
Cell[37413, 1056, 3254, 109, 94, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[40704, 1170, 61, 1, 33, "Input"],
Cell[40768, 1173, 150, 2, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
