(* 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[     73376,       2204]
NotebookOptionsPosition[     66657,       1983]
NotebookOutlinePosition[     67286,       2008]
CellTagsIndexPosition[     67243,       2005]
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 equation \n\nYxxx-f[x]*Yx^2=0 ",
 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[{"inputequation", "=", "\n", "\"\<y'''[x]-f[x]*y'[x]^2\>\""}], 
  ";"}]], "Input"],

Cell[TextData[StyleBox["The function y[x] is a solution of the equation and \
this constraint must be applied in the form of a rule to the invariance \
condition. Be careful to check signs.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"rulesarray", "=", "\[IndentingNewLine]", 
   RowBox[{"{", "\"\<y'''[x]\[Rule]f[x]*y'[x]^2\>\"", "}"}]}], ";"}]], "Input"],

Cell[TextData[StyleBox["Enter the list of independent variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[TextData[StyleBox["Enter the list of dependent variables.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

Cell[TextData[StyleBox["Enter the list of function names 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[{"{", "\"\<f\>\"", "}"}]}], ";"}]], "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", ",", "inputequation", ",", "rulesarray", 
    ",", "internalrules"}], "]"}], "]"}]], "Input"],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(26330896\\), the time used = \\!\\(3.911261`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 26330896, 3.911261],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403863247431*^9, 3.471555040128965*^9, 
  3.471577956693604*^9, 3.471578733302782*^9, 3.483656355327135*^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.469403863247431*^9, 3.471555040128965*^9, 
  3.471577956693604*^9, 3.471578733302782*^9, 3.4836563553630943`*^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 = \\!\\(1144\\), the memory in use = \
\\!\\(26353768\\), the time used = \\!\\(3.969279`\\)\"\>",
  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, 1144, 26353768, 
   3.969279],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403863247431*^9, 3.471555040128965*^9, 
  3.471577956693604*^9, 3.471578733302782*^9, 3.483656355366291*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(26354512\\), the time used = \\!\\(3.9694689999999997`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 26354512, 3.9694689999999997`],
  Editable->False]], "Print",
 CellChangeTimes->{3.469403863247431*^9, 3.471555040128965*^9, 
  3.471577956693604*^9, 3.471578733302782*^9, 3.483656355368805*^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.469403863247431*^9, 3.471555040128965*^9, 
  3.471577956693604*^9, 3.471578733302782*^9, 3.4836563553711767`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.0589360000000001`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.4694038634048*^9, 3.471555040368383*^9, 
  3.471577956968252*^9, 3.471578733478046*^9, 3.483656355374354*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"y1'''[x1]-f[x1]*y1'[x1]^2\"\>"], "Output",
 CellChangeTimes->{3.46940386348767*^9, 3.471555040460143*^9, 
  3.471577957057558*^9, 3.47157873356144*^9, 3.483656355414814*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{"-", 
     RowBox[{
      SuperscriptBox["f", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "2"]}], ",", "0", ",", 
   RowBox[{
    RowBox[{"-", "2"}], " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], ",", "0", ",", "1"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469403863559649*^9, 3.4715550405281887`*^9, 
  3.471577957125105*^9, 3.471578733632596*^9, 3.4836563554695168`*^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.469403863645028*^9, 3.4715550405940323`*^9, 
  3.471577957191374*^9, 3.4715787337160482`*^9, 3.4836563555149117`*^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\"\>", 
   ",", "\<\"3*Derivative[0, 2][eta1][z1, z2] - 9*Derivative[1, 1][xse1][z1, \
z2] == 0\"\>", 
   ",", "\<\"-2*f[z1]*Derivative[0, 1][xse1][z1, z2] + Derivative[0, \
3][eta1][z1, z2] - 3*Derivative[1, 2][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"3*Derivative[1, 1][eta1][z1, z2] - 3*Derivative[2, 0][xse1][z1, \
z2] == 0\"\>", 
   ",", "\<\"-(xse1[z1, z2]*Derivative[1][f][z1]) - f[z1]*Derivative[0, \
1][eta1][z1, z2] - f[z1]*Derivative[1, 0][xse1][z1, z2] + 3*Derivative[1, \
2][eta1][z1, z2] - 3*Derivative[2, 1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"Derivative[3, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"-2*f[z1]*Derivative[1, 0][eta1][z1, z2] + 3*Derivative[2, \
1][eta1][z1, z2] - Derivative[3, 0][xse1][z1, z2] == 0\"\>"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469403863728334*^9, 3.4715550406618958`*^9, 
  3.471577957256749*^9, 3.471578733799182*^9, 3.483656355569169*^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.469403772871504*^9, 3.469403789243174*^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[{"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[{"2", " ", 
         RowBox[{"f", "(", "z1", ")"}], " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"0", ",", "1"}], ")"}],
            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[{"3", " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"2", ",", "0"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}]}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"-", 
         RowBox[{
          RowBox[{"f", "(", "z1", ")"}], " ", 
          RowBox[{
           SuperscriptBox["eta1", 
            TagBox[
             RowBox[{"(", 
              RowBox[{"0", ",", "1"}], ")"}],
             Derivative],
            MultilineFunction->None], "(", 
           RowBox[{"z1", ",", "z2"}], ")"}]}]}], "+", 
        RowBox[{"3", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "2"}], ")"}],
            Derivative],
           MultilineFunction->None], "(", 
          RowBox[{"z1", ",", "z2"}], ")"}]}], "+", 
        RowBox[{
         RowBox[{
          SuperscriptBox["f", "\[Prime]",
           MultilineFunction->None], "(", "z1", ")"}], " ", 
         RowBox[{"(", 
          RowBox[{"-", 
           RowBox[{"xse1", "(", 
            RowBox[{"z1", ",", "z2"}], ")"}]}], ")"}]}], "-", 
        RowBox[{
         RowBox[{"f", "(", "z1", ")"}], " ", 
         RowBox[{
          SuperscriptBox["xse1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"1", ",", "0"}], ")"}],
            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[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"3", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "(", 
        RowBox[{"z1", ",", "z2"}], ")"}], "\[LongEqual]", "0"}]},
     {
      RowBox[{
       RowBox[{
        RowBox[{"-", 
         RowBox[{"2", " ", 
          RowBox[{"f", "(", "z1", ")"}], " ", 
          RowBox[{
           SuperscriptBox["eta1", 
            TagBox[
             RowBox[{"(", 
              RowBox[{"1", ",", "0"}], ")"}],
             Derivative],
            MultilineFunction->None], "(", 
           RowBox[{"z1", ",", "z2"}], ")"}]}]}], "+", 
        RowBox[{"3", " ", 
         RowBox[{
          SuperscriptBox["eta1", 
           TagBox[
            RowBox[{"(", 
             RowBox[{"2", ",", "1"}], ")"}],
            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.469403863813258*^9, 3.471555040735469*^9, 
  3.471577957350327*^9, 3.471578733875655*^9, 3.4836563556165943`*^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.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.48365635566509*^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.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.48365635566822*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26436680\\), The time = \\!\
\\(4.00153`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26436680, 4.00153],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.483656355670452*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(20\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 20],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.483656355672564*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(39\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 39],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.483656355674595*^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.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.4836563556765947`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26442800\\), The time = \\!\
\\(4.003557`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26442800, 4.003557],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.483656355678721*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.483656355680682*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.48365635568262*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26453112\\), The time = \\!\
\\(4.007089`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26453112, 4.007089],
  Editable->False]], "Print",
 CellChangeTimes->{3.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.483656355684579*^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.4694038638954268`*^9, 3.471555040818502*^9, 
  3.471577957494026*^9, 3.471578733952105*^9, 3.483656355686508*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.014111000000000207`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.4694038638991127`*^9, 3.4715550408305187`*^9, 
  3.471577957506727*^9, 3.471578733962997*^9, 3.483656355689238*^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_]=-((b14*f[z1])/Derivative[1][f][z1])\"\>", 
  "}"}]], "Output",
 CellChangeTimes->{3.46940386395776*^9, 3.47155504087142*^9, 
  3.471577957547035*^9, 3.471578734086775*^9, 3.483656355731583*^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 + b14*z2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.4694038641139593`*^9, 3.471555040996085*^9, 
  3.471577957600945*^9, 3.471578734147479*^9, 3.483656355785943*^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[{"b14", " ", 
     RowBox[{"f", "[", "x", "]"}]}], 
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x", "]"}]]}], "}"}]], "Output",
 CellChangeTimes->{3.469403864175054*^9, 3.471555041037422*^9, 
  3.471577957652478*^9, 3.471578734194325*^9, 3.483656355832232*^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[{"b10", "+", 
   RowBox[{"b14", " ", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.4694038642378197`*^9, 3.471555041083723*^9, 
  3.471577957696704*^9, 3.471578734243293*^9, 3.4836563558859367`*^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[{"{", "0", "}"}], ",", 
     RowBox[{"{", "1", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"-", 
       FractionBox[
        RowBox[{"f", "[", "x", "]"}], 
        RowBox[{
         SuperscriptBox["f", "\[Prime]",
          MultilineFunction->None], "[", "x", "]"}]]}], "}"}], ",", 
     RowBox[{"{", "y", "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.4694038642914762`*^9, 3.471555041138014*^9, 
  3.471577957752303*^9, 3.471578734280882*^9, 3.483656355932002*^9}]
}, Open  ]],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", "0", "}"}], ",", 
       RowBox[{"{", "1", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"-", 
         FractionBox[
          RowBox[{"f", "[", "x", "]"}], 
          RowBox[{
           SuperscriptBox["f", "\[Prime]",
            MultilineFunction->None], "[", "x", "]"}]]}], "}"}], ",", 
       RowBox[{"{", "y", "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469403864354602*^9, 3.4715550411836233`*^9, 
  3.471577957798649*^9, 3.471578734326888*^9, 3.483656355986952*^9}],

Cell[TextData[StyleBox["The final result indicates that the equation is \
invariant under two groups. The parameter b10 corresponds to a translation in \
y. The parameter b14 needs further investigation.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["*********************************************************", "Text",
 Evaluatable->False,
 ImageRegion->{{0, 1}, {0, 1}},
 FontWeight->"Plain"],

Cell[CellGroupData[{

Cell[TextData[{
 StyleBox["First let's check to see if the b14 infinitesimals satisfy the \
invariance condition by forming all the terms that appear in the invariance \
condition. Here we will make use of the function ",
  FontWeight->"Plain"],
 "PthInfinitesimal",
 StyleBox[" that generates the infinitesimal transformation of the pth \
derivative.",
  FontWeight->"Plain"]
}], "Text",
 CellChangeTimes->{{3.48365593899263*^9, 3.483655939997737*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"ToExpression", "[", "xsefunctions", "]"}], "/.", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"z1", "\[Rule]", "x1"}], ",", 
    RowBox[{"z2", "\[Rule]", 
     RowBox[{"y1", "[", "x1", "]"}]}]}], "}"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"-", 
   FractionBox[
    RowBox[{"b14", " ", 
     RowBox[{"f", "[", "x1", "]"}]}], 
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]]}], "}"}]], "Output",
 CellChangeTimes->{3.469403864409013*^9, 3.4715550412378674`*^9, 
  3.471577957851438*^9, 3.471578734381844*^9, 3.4836563561112013`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
ToExpression[etafunctions]/.{z1\[Rule]x1,z2\[Rule]y1[x1]}\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"b10", "+", 
   RowBox[{"b14", " ", 
    RowBox[{"y1", "[", "x1", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469403864471459*^9, 3.471555041283874*^9, 
  3.471577957897488*^9, 3.471578734443413*^9, 3.4836563561714*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"n", "=", 
  RowBox[{"Length", "[", "independentvariables", "]"}]}]], "Input"],

Cell[BoxData["1"], "Output",
 CellChangeTimes->{3.469403864524953*^9, 3.471555041337653*^9, 
  3.471577957936839*^9, 3.471578734498176*^9, 3.483656356217608*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"m", "=", 
  RowBox[{"Length", "[", "dependentvariables", "]"}]}]], "Input"],

Cell[BoxData["1"], "Output",
 CellChangeTimes->{3.4694038645885363`*^9, 3.471555041384214*^9, 
  3.471577958014906*^9, 3.471578734543469*^9, 3.4836563562698317`*^9}]
}, Open  ]],

Cell[TextData[StyleBox["plocal is order of the desired derivative.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"xse1noderiv", "=", 
  RowBox[{
   RowBox[{"-", "b14"}], " ", 
   RowBox[{
    RowBox[{"f", "[", "x1", "]"}], "/", 
    RowBox[{"D", "[", 
     RowBox[{
      RowBox[{"f", "[", "x1", "]"}], ",", "x1"}], "]"}]}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{"-", 
  FractionBox[
   RowBox[{"b14", " ", 
    RowBox[{"f", "[", "x1", "]"}]}], 
   RowBox[{
    SuperscriptBox["f", "\[Prime]",
     MultilineFunction->None], "[", "x1", "]"}]]}]], "Output",
 CellChangeTimes->{3.4694038646424007`*^9, 3.471555041438797*^9, 
  3.47157795816498*^9, 3.471578734599256*^9, 3.48365635635216*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
eta1x=PthInfinitesimal[
n,m,yindex=1,plocal=1,r,xseon,j1=1]\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"2", " ", "b14", " ", 
   RowBox[{
    SuperscriptBox["y1", "\[Prime]",
     MultilineFunction->None], "[", "x1", "]"}]}], "-", 
  FractionBox[
   RowBox[{"b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]]}]], "Output",
 CellChangeTimes->{3.469403864742115*^9, 3.471555041551591*^9, 
  3.471577958466761*^9, 3.471578734661447*^9, 3.483656356395689*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
eta1xxx=PthInfinitesimal[
n,m,yindex=1,plocal=3,r,xseon,j1=1,j2=1,j3=1]\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  FractionBox[
   RowBox[{"3", " ", "b14", " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["f", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "2"]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]], "-", 
  FractionBox[
   RowBox[{"6", " ", "b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["f", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "3"]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "4"]], "-", 
  FractionBox[
   RowBox[{"3", " ", "b14", " ", 
    RowBox[{
     SuperscriptBox["f", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], 
   RowBox[{
    SuperscriptBox["f", "\[Prime]",
     MultilineFunction->None], "[", "x1", "]"}]], "+", 
  FractionBox[
   RowBox[{"6", " ", "b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["f", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "3"]], "-", 
  FractionBox[
   RowBox[{"2", " ", "b14", " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}], 
   RowBox[{
    SuperscriptBox["f", "\[Prime]",
     MultilineFunction->None], "[", "x1", "]"}]], "+", 
  FractionBox[
   RowBox[{"6", " ", "b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "3"]], "-", 
  FractionBox[
   RowBox[{"3", " ", "b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]], "+", 
  RowBox[{"4", " ", "b14", " ", 
   RowBox[{
    SuperscriptBox["y1", 
     TagBox[
      RowBox[{"(", "3", ")"}],
      Derivative],
     MultilineFunction->None], "[", "x1", "]"}]}], "-", 
  FractionBox[
   RowBox[{"3", " ", "b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]], "-", 
  FractionBox[
   RowBox[{"b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", "4", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]]}]], "Output",
 CellChangeTimes->{3.4694038647848873`*^9, 3.471555041654677*^9, 
  3.471577958666916*^9, 3.471578734716213*^9, 3.4836563564508142`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["invariancecondcoefficients={xse1noderiv,0,eta1x,0,eta1xxx}", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"-", 
    FractionBox[
     RowBox[{"b14", " ", 
      RowBox[{"f", "[", "x1", "]"}]}], 
     RowBox[{
      SuperscriptBox["f", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]]}], ",", "0", ",", 
   RowBox[{
    RowBox[{"2", " ", "b14", " ", 
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]}], "-", 
    FractionBox[
     RowBox[{"b14", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "2"]]}], ",", "0", ",", 
   RowBox[{
    FractionBox[
     RowBox[{"3", " ", "b14", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"]}], 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "2"]], "-", 
    FractionBox[
     RowBox[{"6", " ", "b14", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "3"]}], 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "4"]], "-", 
    FractionBox[
     RowBox[{"3", " ", "b14", " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], 
     RowBox[{
      SuperscriptBox["f", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]], "+", 
    FractionBox[
     RowBox[{"6", " ", "b14", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "3"]], "-", 
    FractionBox[
     RowBox[{"2", " ", "b14", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], 
     RowBox[{
      SuperscriptBox["f", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]], "+", 
    FractionBox[
     RowBox[{"6", " ", "b14", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "3"]], "-", 
    FractionBox[
     RowBox[{"3", " ", "b14", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "2"]], "+", 
    RowBox[{"4", " ", "b14", " ", 
     RowBox[{
      SuperscriptBox["y1", 
       TagBox[
        RowBox[{"(", "3", ")"}],
        Derivative],
       MultilineFunction->None], "[", "x1", "]"}]}], "-", 
    FractionBox[
     RowBox[{"3", " ", "b14", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "2"]], "-", 
    FractionBox[
     RowBox[{"b14", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", 
        TagBox[
         RowBox[{"(", "4", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "2"]]}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469403864839888*^9, 3.4715550418057203`*^9, 
  3.471577958728622*^9, 3.4715787347624483`*^9, 3.483656356512896*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{"-", 
     RowBox[{
      SuperscriptBox["f", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "2"]}], ",", "0", ",", 
   RowBox[{
    RowBox[{"-", "2"}], " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], ",", "0", ",", "1"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469403864884644*^9, 3.471555041848126*^9, 
  3.471577958795672*^9, 3.471578734816991*^9, 3.483656356579502*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
invarianceconditionsum=
Expand[
invarconditiontable.invariancecondcoefficients]/.
{D[y1[x1],x1,x1,x1]->f[x1]*D[y1[x1],x1]^2}\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"b14", " ", 
   RowBox[{"f", "[", "x1", "]"}], " ", 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]}], "-", 
  FractionBox[
   RowBox[{"b14", " ", 
    SuperscriptBox[
     RowBox[{"f", "[", "x1", "]"}], "2"], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
    RowBox[{
     SuperscriptBox["f", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]], "+", 
  FractionBox[
   RowBox[{"3", " ", "b14", " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["f", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "2"]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]], "-", 
  FractionBox[
   RowBox[{"6", " ", "b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["f", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "3"]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "4"]], "-", 
  FractionBox[
   RowBox[{"3", " ", "b14", " ", 
    RowBox[{
     SuperscriptBox["f", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], 
   RowBox[{
    SuperscriptBox["f", "\[Prime]",
     MultilineFunction->None], "[", "x1", "]"}]], "+", 
  FractionBox[
   RowBox[{"6", " ", "b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["f", "\[Prime]\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "3"]], "-", 
  FractionBox[
   RowBox[{"2", " ", "b14", " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}], 
   RowBox[{
    SuperscriptBox["f", "\[Prime]",
     MultilineFunction->None], "[", "x1", "]"}]], "+", 
  FractionBox[
   RowBox[{"6", " ", "b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "3"]], "-", 
  FractionBox[
   RowBox[{"3", " ", "b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]], "-", 
  FractionBox[
   RowBox[{"b14", " ", 
    RowBox[{"f", "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], " ", 
    RowBox[{
     SuperscriptBox["f", 
      TagBox[
       RowBox[{"(", "4", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}], 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "2"]]}]], "Output",
 CellChangeTimes->{3.4694038649398746`*^9, 3.471555041883402*^9, 
  3.47157795891298*^9, 3.4715787348786983`*^9, 3.483656356646762*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["Simplify[%]", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"-", 
  RowBox[{
   FractionBox["1", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["f", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "4"]], 
   RowBox[{"b14", " ", 
    RowBox[{"(", 
     RowBox[{
      RowBox[{
       SuperscriptBox[
        RowBox[{"f", "[", "x1", "]"}], "2"], " ", 
       SuperscriptBox[
        RowBox[{
         SuperscriptBox["f", "\[Prime]",
          MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
       SuperscriptBox[
        RowBox[{
         SuperscriptBox["y1", "\[Prime]",
          MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
       RowBox[{
        SuperscriptBox["f", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}]}], "+", 
      RowBox[{
       SuperscriptBox[
        RowBox[{
         SuperscriptBox["f", "\[Prime]",
          MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
       RowBox[{"(", 
        RowBox[{
         RowBox[{"3", " ", 
          RowBox[{
           SuperscriptBox["f", "\[Prime]",
            MultilineFunction->None], "[", "x1", "]"}], " ", 
          RowBox[{
           SuperscriptBox["f", "\[Prime]\[Prime]",
            MultilineFunction->None], "[", "x1", "]"}], " ", 
          RowBox[{
           SuperscriptBox["y1", "\[Prime]\[Prime]",
            MultilineFunction->None], "[", "x1", "]"}]}], "+", 
         RowBox[{
          RowBox[{
           SuperscriptBox["y1", "\[Prime]",
            MultilineFunction->None], "[", "x1", "]"}], " ", 
          RowBox[{"(", 
           RowBox[{
            RowBox[{
             RowBox[{"-", "3"}], " ", 
             SuperscriptBox[
              RowBox[{
               SuperscriptBox["f", "\[Prime]\[Prime]",
                MultilineFunction->None], "[", "x1", "]"}], "2"]}], "+", 
            RowBox[{"2", " ", 
             RowBox[{
              SuperscriptBox["f", "\[Prime]",
               MultilineFunction->None], "[", "x1", "]"}], " ", 
             RowBox[{
              SuperscriptBox["f", 
               TagBox[
                RowBox[{"(", "3", ")"}],
                Derivative],
               MultilineFunction->None], "[", "x1", "]"}]}]}], ")"}]}]}], 
        ")"}]}], "+", 
      RowBox[{
       RowBox[{"f", "[", "x1", "]"}], " ", 
       RowBox[{"(", 
        RowBox[{
         RowBox[{
          RowBox[{"-", 
           SuperscriptBox[
            RowBox[{
             SuperscriptBox["f", "\[Prime]",
              MultilineFunction->None], "[", "x1", "]"}], "4"]}], " ", 
          SuperscriptBox[
           RowBox[{
            SuperscriptBox["y1", "\[Prime]",
             MultilineFunction->None], "[", "x1", "]"}], "2"]}], "+", 
         RowBox[{"6", " ", 
          RowBox[{
           SuperscriptBox["y1", "\[Prime]",
            MultilineFunction->None], "[", "x1", "]"}], " ", 
          SuperscriptBox[
           RowBox[{
            SuperscriptBox["f", "\[Prime]\[Prime]",
             MultilineFunction->None], "[", "x1", "]"}], "3"]}], "-", 
         RowBox[{"6", " ", 
          RowBox[{
           SuperscriptBox["f", "\[Prime]",
            MultilineFunction->None], "[", "x1", "]"}], " ", 
          RowBox[{
           SuperscriptBox["f", "\[Prime]\[Prime]",
            MultilineFunction->None], "[", "x1", "]"}], " ", 
          RowBox[{"(", 
           RowBox[{
            RowBox[{
             RowBox[{
              SuperscriptBox["f", "\[Prime]\[Prime]",
               MultilineFunction->None], "[", "x1", "]"}], " ", 
             RowBox[{
              SuperscriptBox["y1", "\[Prime]\[Prime]",
               MultilineFunction->None], "[", "x1", "]"}]}], "+", 
            RowBox[{
             RowBox[{
              SuperscriptBox["y1", "\[Prime]",
               MultilineFunction->None], "[", "x1", "]"}], " ", 
             RowBox[{
              SuperscriptBox["f", 
               TagBox[
                RowBox[{"(", "3", ")"}],
                Derivative],
               MultilineFunction->None], "[", "x1", "]"}]}]}], ")"}]}], "+", 
         RowBox[{
          SuperscriptBox[
           RowBox[{
            SuperscriptBox["f", "\[Prime]",
             MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
          RowBox[{"(", 
           RowBox[{
            RowBox[{"3", " ", 
             RowBox[{
              SuperscriptBox["y1", "\[Prime]\[Prime]",
               MultilineFunction->None], "[", "x1", "]"}], " ", 
             RowBox[{
              SuperscriptBox["f", 
               TagBox[
                RowBox[{"(", "3", ")"}],
                Derivative],
               MultilineFunction->None], "[", "x1", "]"}]}], "+", 
            RowBox[{
             RowBox[{
              SuperscriptBox["y1", "\[Prime]",
               MultilineFunction->None], "[", "x1", "]"}], " ", 
             RowBox[{
              SuperscriptBox["f", 
               TagBox[
                RowBox[{"(", "4", ")"}],
                Derivative],
               MultilineFunction->None], "[", "x1", "]"}]}]}], ")"}]}]}], 
        ")"}]}]}], ")"}]}]}]}]], "Output",
 CellChangeTimes->{3.4694038649902697`*^9, 3.471555042054565*^9, 
  3.471577959037035*^9, 3.471578734927064*^9, 3.4836563567178783`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Factor", "[", "%", "]"}]], "Input"],

Cell[BoxData[
 RowBox[{
  FractionBox["1", 
   SuperscriptBox[
    RowBox[{
     SuperscriptBox["f", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "4"]], 
  RowBox[{"b14", " ", 
   RowBox[{"(", 
    RowBox[{
     RowBox[{
      RowBox[{"f", "[", "x1", "]"}], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "4"], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"]}], "-", 
     RowBox[{
      SuperscriptBox[
       RowBox[{"f", "[", "x1", "]"}], "2"], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["y1", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], "+", 
     RowBox[{"3", " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"]}], "-", 
     RowBox[{"6", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "3"]}], "-", 
     RowBox[{"3", " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], "+", 
     RowBox[{"6", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], "-", 
     RowBox[{"2", " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "3"], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], "+", 
     RowBox[{"6", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], "-", 
     RowBox[{"3", " ", 
      RowBox[{"f", "[", "x1", "]"}], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", 
        TagBox[
         RowBox[{"(", "3", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}], "-", 
     RowBox[{
      RowBox[{"f", "[", "x1", "]"}], " ", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]",
         MultilineFunction->None], "[", "x1", "]"}], "2"], " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], " ", 
      RowBox[{
       SuperscriptBox["f", 
        TagBox[
         RowBox[{"(", "4", ")"}],
         Derivative],
        MultilineFunction->None], "[", "x1", "]"}]}]}], ")"}]}]}]], "Output",
 CellChangeTimes->{3.469403865099916*^9, 3.471555042155387*^9, 
  3.471577959137561*^9, 3.471578734982995*^9, 3.483656356779708*^9}]
}, Open  ]],

Cell[TextData[StyleBox["This final expression is equal to zero if and only if \
f[x] satisfies f[x]f''=(f')^2. Thus invariance of the equation holds if \
f=a*Exp[b*x]. Compare this with the exponential distribution of free stream \
velocity in the boundary layer over a flat plate.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["*********************************************************", "Text",
 Evaluatable->False,
 ImageRegion->{{0, 1}, {0, 1}},
 FontWeight->"Plain"],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Let's check.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"f", "[", "x1_", "]"}], ":=", 
  RowBox[{"a", "*", 
   RowBox[{"Exp", "[", 
    RowBox[{"b", "*", "x1"}], "]"}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"ToExpression", "[", "xsefunctions", "]"}], "/.", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"z1", "\[Rule]", "x1"}], ",", 
    RowBox[{"z2", "\[Rule]", 
     RowBox[{"y1", "[", "x1", "]"}]}]}], "}"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"-", 
   FractionBox["b14", "b"]}], "}"}]], "Output",
 CellChangeTimes->{3.469403865181712*^9, 3.4715550422790947`*^9, 
  3.4715779592624474`*^9, 3.471578735153833*^9, 3.483656356877273*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
ToExpression[etafunctions]/.{z1\[Rule]x1,z2\[Rule]y1[x1]}\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"b10", "+", 
   RowBox[{"b14", " ", 
    RowBox[{"y1", "[", "x1", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469403865239201*^9, 3.4715550423149242`*^9, 
  3.471577959296726*^9, 3.471578735188827*^9, 3.483656356934664*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"n", "=", 
  RowBox[{"Length", "[", "independentvariables", "]"}]}]], "Input"],

Cell[BoxData["1"], "Output",
 CellChangeTimes->{3.469403865273081*^9, 3.471555042369486*^9, 
  3.471577959362862*^9, 3.471578735243997*^9, 3.4836563569863243`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"m", "=", 
  RowBox[{"Length", "[", "dependentvariables", "]"}]}]], "Input"],

Cell[BoxData["1"], "Output",
 CellChangeTimes->{3.469403865323063*^9, 3.471555042419765*^9, 
  3.471577959429862*^9, 3.471578735296479*^9, 3.4836563570368977`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"xse1noderiv", "=", 
  RowBox[{
   RowBox[{"-", "b14"}], " ", 
   RowBox[{
    RowBox[{"f", "[", "x1", "]"}], "/", 
    RowBox[{"D", "[", 
     RowBox[{
      RowBox[{"f", "[", "x1", "]"}], ",", "x1"}], "]"}]}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{"-", 
  FractionBox["b14", "b"]}]], "Output",
 CellChangeTimes->{3.469403865373075*^9, 3.471555042469791*^9, 
  3.471577959551697*^9, 3.4715787353441687`*^9, 3.483656357160672*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
eta1x=PthInfinitesimal[
n,m,yindex=1,plocal=1,r,xseon,j1=1]\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"b14", " ", 
  RowBox[{
   SuperscriptBox["y1", "\[Prime]",
    MultilineFunction->None], "[", "x1", "]"}]}]], "Output",
 CellChangeTimes->{3.46940386542373*^9, 3.4715550425200663`*^9, 
  3.471577959730389*^9, 3.471578735394581*^9, 3.4836563572183857`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
eta1xxx=PthInfinitesimal[
n,m,yindex=1,plocal=3,r,xseon,j1=1,j2=1,j3=1]\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"b14", " ", 
  RowBox[{
   SuperscriptBox["y1", 
    TagBox[
     RowBox[{"(", "3", ")"}],
     Derivative],
    MultilineFunction->None], "[", "x1", "]"}]}]], "Output",
 CellChangeTimes->{3.46940386547297*^9, 3.471555042620791*^9, 
  3.471577959765005*^9, 3.471578735444235*^9, 3.483656357268497*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["invariancecondcoefficients={xse1noderiv,0,eta1x,0,eta1xxx}", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"-", 
    FractionBox["b14", "b"]}], ",", "0", ",", 
   RowBox[{"b14", " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], ",", "0", ",", 
   RowBox[{"b14", " ", 
    RowBox[{
     SuperscriptBox["y1", 
      TagBox[
       RowBox[{"(", "3", ")"}],
       Derivative],
      MultilineFunction->None], "[", "x1", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469403865523863*^9, 3.471555042770235*^9, 
  3.4715779598015537`*^9, 3.4715787354802094`*^9, 3.4836563573181334`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{"-", "a"}], " ", "b", " ", 
    SuperscriptBox["\[ExponentialE]", 
     RowBox[{"b", " ", "x1"}]], " ", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "2"]}], ",", "0", ",", 
   RowBox[{
    RowBox[{"-", "2"}], " ", "a", " ", 
    SuperscriptBox["\[ExponentialE]", 
     RowBox[{"b", " ", "x1"}]], " ", 
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}]}], ",", "0", ",", "1"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.46940386557312*^9, 3.4715550428208857`*^9, 
  3.4715779598520184`*^9, 3.471578735528431*^9, 3.483656357368168*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
invarianceconditionsum=
Expand[
invarconditiontable.invariancecondcoefficients]/.
{D[y1[x1],x1,x1,x1]->f[x1]*D[y1[x1],x1]^2}\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData["0"], "Output",
 CellChangeTimes->{3.4694038656241493`*^9, 3.4715550428532057`*^9, 
  3.471577959884458*^9, 3.471578735579809*^9, 3.4836563574180927`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["26622880"], "Output",
 CellChangeTimes->{3.46940386567415*^9, 3.471555042904807*^9, 
  3.471577959934945*^9, 3.471578735628398*^9, 3.483656357468423*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{991, 1086},
WindowMargins->{{34, Automatic}, {Automatic, 22}},
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, 246, 4, 76, "Text"],
Cell[794, 26, 124, 1, 32, "Text"],
Cell[921, 29, 160, 4, 33, "Input"],
Cell[1084, 35, 476, 13, 32, "Text"],
Cell[1563, 50, 101, 2, 33, "Input"],
Cell[1667, 54, 163, 3, 32, "Text"],
Cell[1833, 59, 115, 3, 53, "Input"],
Cell[1951, 64, 255, 4, 51, "Text"],
Cell[2209, 70, 156, 3, 53, "Input"],
Cell[2368, 75, 130, 2, 32, "Text"],
Cell[2501, 79, 118, 3, 33, "Input"],
Cell[2622, 84, 128, 2, 32, "Text"],
Cell[2753, 88, 116, 3, 33, "Input"],
Cell[2872, 93, 294, 4, 51, "Text"],
Cell[3169, 99, 109, 3, 33, "Input"],
Cell[3281, 104, 125, 2, 32, "Text"],
Cell[3409, 108, 67, 2, 33, "Input"],
Cell[3479, 112, 385, 6, 70, "Text"],
Cell[3867, 120, 67, 2, 33, "Input"],
Cell[3937, 124, 535, 8, 70, "Text"],
Cell[4475, 134, 71, 2, 33, "Input"],
Cell[4549, 138, 546, 8, 89, "Text"],
Cell[5098, 148, 79, 2, 33, "Input"],
Cell[5180, 152, 268, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[5473, 160, 324, 6, 72, "Input"],
Cell[5800, 168, 467, 8, 45, "Print"],
Cell[6270, 178, 1052, 14, 197, "Print"],
Cell[7325, 194, 723, 12, 64, "Print"],
Cell[8051, 208, 456, 8, 45, "Print"],
Cell[8510, 218, 1054, 14, 197, "Print"],
Cell[9567, 234, 225, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9829, 243, 50, 0, 33, "Input"],
Cell[9882, 245, 191, 2, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10110, 252, 45, 0, 33, "Input"],
Cell[10158, 254, 694, 20, 42, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10889, 279, 241, 4, 51, "Text"],
Cell[11133, 285, 39, 0, 33, "Input"],
Cell[11175, 287, 304, 7, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[11516, 299, 278, 4, 51, "Text"],
Cell[11797, 305, 47, 0, 33, "Input"],
Cell[11847, 307, 1092, 19, 224, "Output"]
}, Open  ]],
Cell[12954, 329, 96, 2, 32, "Text"],
Cell[13053, 333, 364, 8, 53, "Input"],
Cell[13420, 343, 6433, 206, 244, "Output"],
Cell[19856, 551, 509, 11, 145, "Text"],
Cell[CellGroupData[{
Cell[20390, 566, 273, 6, 53, "Input"],
Cell[20666, 574, 900, 14, 83, "Print"],
Cell[21569, 590, 462, 6, 83, "Print"],
Cell[22034, 598, 352, 6, 25, "Print"],
Cell[22389, 606, 342, 6, 25, "Print"],
Cell[22734, 614, 365, 7, 25, "Print"],
Cell[23102, 623, 345, 4, 45, "Print"],
Cell[23450, 629, 354, 6, 25, "Print"],
Cell[23807, 637, 188, 2, 25, "Print"],
Cell[23998, 641, 231, 3, 25, "Print"],
Cell[24232, 646, 354, 6, 25, "Print"],
Cell[24589, 654, 1109, 14, 235, "Print"],
Cell[25701, 670, 233, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[25971, 679, 184, 3, 32, "Text"],
Cell[26158, 684, 38, 0, 33, "Input"],
Cell[26199, 686, 241, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[26477, 695, 141, 2, 32, "Text"],
Cell[26621, 699, 38, 0, 33, "Input"],
Cell[26662, 701, 219, 3, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[26918, 709, 144, 3, 32, "Text"],
Cell[27065, 714, 115, 3, 33, "Input"],
Cell[27183, 719, 376, 10, 57, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[27596, 734, 143, 2, 32, "Text"],
Cell[27742, 738, 115, 3, 33, "Input"],
Cell[27860, 743, 268, 6, 33, "Output"]
}, Open  ]],
Cell[28143, 752, 67, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[28235, 756, 226, 6, 33, "Input"],
Cell[28464, 764, 599, 18, 57, "Output"]
}, Open  ]],
Cell[29078, 785, 79, 1, 33, "Input"],
Cell[29160, 788, 758, 23, 67, "Output"],
Cell[29921, 813, 269, 4, 51, "Text"],
Cell[30193, 819, 148, 3, 32, "Text",
 Evaluatable->False],
Cell[CellGroupData[{
Cell[30366, 826, 485, 11, 51, "Text"],
Cell[30854, 839, 245, 7, 33, "Input"],
Cell[31102, 848, 382, 10, 57, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[31521, 863, 114, 3, 33, "Input"],
Cell[31638, 868, 264, 6, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[31939, 879, 101, 2, 33, "Input"],
Cell[32043, 883, 161, 2, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[32241, 890, 99, 2, 33, "Input"],
Cell[32343, 894, 165, 2, 33, "Output"]
}, Open  ]],
Cell[32523, 899, 132, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[32680, 905, 248, 8, 33, "Input"],
Cell[32931, 915, 349, 9, 57, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[33317, 929, 116, 4, 50, "Input"],
Cell[33436, 935, 732, 20, 59, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[34205, 960, 128, 4, 50, "Input"],
Cell[34336, 966, 4597, 143, 221, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[38970, 1114, 107, 1, 33, "Input"],
Cell[39080, 1117, 5766, 171, 221, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[44883, 1293, 45, 0, 33, "Input"],
Cell[44931, 1295, 690, 20, 42, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[45658, 1320, 181, 6, 82, "Input"],
Cell[45842, 1328, 4593, 141, 168, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[50472, 1474, 60, 1, 33, "Input"],
Cell[50535, 1477, 5191, 142, 141, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[55763, 1624, 59, 1, 33, "Input"],
Cell[55825, 1627, 4880, 140, 136, "Output"]
}, Open  ]],
Cell[60720, 1770, 347, 5, 51, "Text"],
Cell[61070, 1777, 148, 3, 32, "Text",
 Evaluatable->False],
Cell[CellGroupData[{
Cell[61243, 1784, 102, 2, 32, "Text"],
Cell[61348, 1788, 160, 5, 33, "Input"],
Cell[61511, 1795, 245, 7, 33, "Input"],
Cell[61759, 1804, 229, 5, 54, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[62025, 1814, 114, 3, 33, "Input"],
Cell[62142, 1819, 268, 6, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[62447, 1830, 101, 2, 33, "Input"],
Cell[62551, 1834, 163, 2, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[62751, 1841, 99, 2, 33, "Input"],
Cell[62853, 1845, 163, 2, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[63053, 1852, 248, 8, 33, "Input"],
Cell[63304, 1862, 203, 4, 54, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[63544, 1871, 116, 4, 50, "Input"],
Cell[63663, 1877, 279, 6, 35, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[63979, 1888, 128, 4, 50, "Input"],
Cell[64110, 1894, 324, 9, 38, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[64471, 1908, 107, 1, 33, "Input"],
Cell[64581, 1911, 587, 17, 54, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[65205, 1933, 45, 0, 33, "Input"],
Cell[65253, 1935, 727, 20, 42, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[66017, 1960, 181, 6, 82, "Input"],
Cell[66201, 1968, 167, 2, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[66405, 1975, 66, 1, 33, "Input"],
Cell[66474, 1978, 167, 2, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
