(* 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[     36528,       1021]
NotebookOptionsPosition[     32543,        897]
NotebookOutlinePosition[     33321,        924]
CellTagsIndexPosition[     33278,        921]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[{
 StyleBox["In this example we use the package IntroToSymmetry.m to work out \
the determining equations of the nonlinear second-order ODE \n",
  FontSize->14,
  FontVariations->{"CompatibilityType"->0}],
 StyleBox["\n",
  FontSize->14,
  FontSlant->"Italic",
  FontVariations->{"CompatibilityType"->0}],
 Cell[BoxData[
  FormBox[
   SubscriptBox["Y", "xx"], TraditionalForm]],
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["+x",
  FontSize->14,
  FontSlant->"Italic"],
 Cell[BoxData[
  FormBox[
   SubscriptBox["Y", "x"], TraditionalForm]],
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["+x",
  FontSize->14,
  FontSlant->"Italic"],
 Cell[BoxData[
  FormBox[
   SubsuperscriptBox["Y", "x", "3"], TraditionalForm]],
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["-Y-YY",
  FontSize->14,
  FontSlant->"Italic"],
 Cell[BoxData[
  FormBox[
   SubsuperscriptBox["", "x", "2"], TraditionalForm]],
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["=0",
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox[".",
  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.4720468433888683`*^9, 
  3.47204684413947*^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", 
   "\"\<D[y[x],x,x]+x*D[y[x],x]+\nx*D[y[x],x]^3-y[x]-y[x]*D[y[x],x]^2\>\""}], 
  ";"}]], "Input"],

Cell[TextData[{
 StyleBox["The function y is a solution of the equation and this constraint \
must be applied in the form of a rule to the invariance condition. Be sure to \
check signs. Note that the rule is carefully set up to replace one isolated \
term. For example, the following rule would give incorrect results.\n\n",
  FontWeight->"Plain"],
 StyleBox["x*D[y[x],x]->-x*D[y[x],x]^3+y[x]+y[x]*D[y[x],x]^2-D[y[x],x,x]",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 StyleBox["\n\nThe problem is that this would only replace the particular \
product ",
  FontWeight->"Plain"],
 StyleBox["x*D[y[x],x]",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 StyleBox[" wherever it appears. This is not as general as replacing the \
first derivative everywhere. As another example, the rule,\n\n",
  FontWeight->"Plain"],
 StyleBox["y[x]",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 StyleBox["->",
  FontWeight->"Plain"],
 StyleBox["x*D[y[x],x]",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 StyleBox["+",
  FontWeight->"Plain"],
 StyleBox["x*D[y[x],x]^3",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 StyleBox["-",
  FontWeight->"Plain"],
 StyleBox["y[x]*D[y[x],x]^2",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 StyleBox["+",
  FontWeight->"Plain"],
 StyleBox["D[y[x],x,x]\n\nwill cause the FindDeterminingEquations function to \
fail to reach completion. The problem here is that y[x] is one of the \
variables that the infinitesimals are assumed to depend on and the software \
will attempt to replace y[x] with derivatives that are dependent variables in \
this context. Generally speaking the idea is to isolate and replace one of \
the higher derivative terms in the equation",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 StyleBox[". In this case we choose the second derivative term.",
  FontWeight->"Plain"]
}], "Text",
 CellChangeTimes->{{3.4693974526333437`*^9, 3.469397483540341*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"rulesarray", "=", "\[IndentingNewLine]", 
   RowBox[{
   "{", "\"\<D[y[x],x,x]\[Rule]-x*D[y[x],x]-x*D[y[x],x]^3+y[x]+y[x]*D[y[x],x]^\
2\>\"", "}"}]}], ";"}]], "Input"],

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

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

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

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

Cell[TextData[StyleBox["Enter the list of function names or constant names \
that must be preserved when the equation is rewritten in terms of generic \
(x1,y1) variables. In this case there are no constants or function names and \
so a null list is entered.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"frozennames", "=", 
   RowBox[{"{", "\"\<\>\"", "}"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.469397515644663*^9, 3.469397515802902*^9}}],

Cell[TextData[StyleBox["Enter the maximum derivative order of the equation.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"p", "=", "2"}], ";"}]], "Input"],

Cell[TextData[StyleBox["The maximum derivative order that the infinitesimals \
are assumed to depend on is specified by the input parameter r. This \
parameter is only nonzero when the user is looking for Lie contact groups or \
Lie-Backlund groups. For the usual case where one is searching for point \
groups set r=0.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"r", "=", "0"}], ";"}]], "Input"],

Cell[TextData[StyleBox["When searching for Lie-Backlund groups (r=1 or \
greater) one can without loss of generality, leave the independent variables \
untransformed. The corresponding infinitesimals (the xse's) are set to zero \
by setting xseon=0. If one is searching for point groups then set  xseon=1. \
The choice xseon=1 is also an option when looking for Lie-Backlund groups and \
this can be useful when looking for contact symmetries for example.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"xseon", "=", "1"}], ";"}]], "Input"],

Cell[TextData[StyleBox["When searching for Lie-Backlund groups it is \
necessary to differentiate the input equation r times producing derivatives \
of order p+r. These higher order differential consequences are appended to \
the set of rules applied to the invariance condition. This process is carried \
out automatically when internalrules=1. For point groups the equation or \
equation system is the only rule or set of rules needed and one puts \
internalrules=0.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"internalrules", "=", "0"}], ";"}]], "Input"],

Cell[TextData[StyleBox["Now work out the determining equations of the Lie \
point group that leaves the equation invariant. The output is available as a \
table of strings called zdeterminingequations.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"FindDeterminingEquations", "[", "\[IndentingNewLine]", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "frozennames", ",",
     "p", ",", "r", ",", "xseon", ",", "\[IndentingNewLine]", "inputequation",
     ",", "rulesarray", ",", "internalrules"}], "]"}], "]"}]], "Input"],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(26281464\\), the time used = \\!\\(2.708512`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 26281464, 2.708512],
  Editable->False]], "Print",
 CellChangeTimes->{3.469397564507444*^9, 3.471145647568798*^9, 
  3.4715519864683847`*^9, 3.471576655880165*^9, 3.483553240621892*^9, 
  3.483553395202187*^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.469397564507444*^9, 3.471145647568798*^9, 
  3.4715519864683847`*^9, 3.471576655880165*^9, 3.483553240621892*^9, 
  3.483553395234235*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The determining equations have been expressed in \
terms of z-variables, the length of zdeterminingequations = \\!\\(4\\), the \
byte count of zdeterminingequations = \\!\\(928\\), the memory in use = \
\\!\\(26298984\\), the time used = \\!\\(2.757339`\\)\"\>",
  StringForm[
  "The determining equations have been expressed in terms of z-variables, the \
length of zdeterminingequations = ``, the byte count of zdeterminingequations \
= ``, the memory in use = ``, the time used = ``", 4, 928, 26298984, 2.757339],
  Editable->False]], "Print",
 CellChangeTimes->{3.469397564507444*^9, 3.471145647568798*^9, 
  3.4715519864683847`*^9, 3.471576655880165*^9, 3.483553240621892*^9, 
  3.483553395236227*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(26299728\\), the time used = \\!\\(2.7575339999999997`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 26299728, 2.7575339999999997`],
  Editable->False]], "Print",
 CellChangeTimes->{3.469397564507444*^9, 3.471145647568798*^9, 
  3.4715519864683847`*^9, 3.471576655880165*^9, 3.483553240621892*^9, 
  3.483553395237207*^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.469397564507444*^9, 3.471145647568798*^9, 
  3.4715519864683847`*^9, 3.471576655880165*^9, 3.483553240621892*^9, 
  3.483553395238056*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.04969199999999985`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469397564577558*^9, 3.4711456476373253`*^9, 
  3.471551986562324*^9, 3.47157665597584*^9, 3.483553240660635*^9, 
  3.483553395239625*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1]+x1*D[y1[x1],x1]+\\nx1*D[y1[x1],x1]^3-y1[x1]-\
y1[x1]*D[y1[x1],x1]^2\"\>"], "Output",
 CellChangeTimes->{3.469397564632169*^9, 3.471145647672237*^9, 
  3.4715519866048937`*^9, 3.4715766560189047`*^9, 3.483553240709771*^9, 
  3.483553395281662*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{
    RowBox[{
     SuperscriptBox["y1", "\[Prime]",
      MultilineFunction->None], "[", "x1", "]"}], "+", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "3"]}], ",", 
   RowBox[{
    RowBox[{"-", "1"}], "-", 
    SuperscriptBox[
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}], "2"]}], ",", 
   RowBox[{"x1", "-", 
    RowBox[{"2", " ", 
     RowBox[{"y1", "[", "x1", "]"}], " ", 
     RowBox[{
      SuperscriptBox["y1", "\[Prime]",
       MultilineFunction->None], "[", "x1", "]"}]}], "+", 
    RowBox[{"3", " ", "x1", " ", 
     SuperscriptBox[
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}], "2"]}]}], ",", "1"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.469397564681294*^9, 3.471145647729786*^9, 
  3.471551986659971*^9, 3.471576656073805*^9, 3.483553240760346*^9, 
  3.4835533953440733`*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.469397564730917*^9, 3.4711456477919903`*^9, 
  3.471551986705055*^9, 3.471576656135397*^9, 3.483553240810567*^9, 
  3.4835533953927383`*^9}],

Cell[CellGroupData[{

Cell[BoxData["ztableofrulesxy"], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"x1", "\[Rule]", "z1"}], ",", 
   RowBox[{
    RowBox[{"y1", "[", "x1", "]"}], "\[Rule]", "z2"}]}], "}"}]], "Output",
 CellChangeTimes->{3.46939756478633*^9, 3.4711456478451843`*^9, 
  3.471551986759886*^9, 3.4715766562067127`*^9, 3.483553240860984*^9, 
  3.4835533954442177`*^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[{"\<\"xse1[z1, z2] + 2*z1*Derivative[0, 1][eta1][z1, z2] - \
z2*Derivative[0, 1][xse1][z1, z2] - Derivative[0, 2][xse1][z1, z2] - \
z1*Derivative[1, 0][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-eta1[z1, z2] - z2*Derivative[0, 1][eta1][z1, z2] + \
2*z1*Derivative[0, 1][xse1][z1, z2] + Derivative[0, 2][eta1][z1, z2] + \
3*z1*Derivative[1, 0][eta1][z1, z2] - 2*Derivative[1, 1][xse1][z1, z2] == 0\"\
\>", ",", "\<\"-eta1[z1, z2] + z2*Derivative[0, 1][eta1][z1, z2] + \
z1*Derivative[1, 0][eta1][z1, z2] - 2*z2*Derivative[1, 0][xse1][z1, z2] + \
Derivative[2, 0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"xse1[z1, z2] - 3*z2*Derivative[0, 1][xse1][z1, z2] - \
2*z2*Derivative[1, 0][eta1][z1, z2] + z1*Derivative[1, 0][xse1][z1, z2] + \
2*Derivative[1, 1][eta1][z1, z2] - Derivative[2, 0][xse1][z1, z2] == 0\"\>"}],
   "}"}]], "Output",
 CellChangeTimes->{3.46939756484767*^9, 3.4711456479089613`*^9, 
  3.471551986805624*^9, 3.4715766562521143`*^9, 3.4835532409106703`*^9, 
  3.4835533954929943`*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData["4"], "Output",
 CellChangeTimes->{3.469397564903017*^9, 3.4711456479581947`*^9, 
  3.471551986859568*^9, 3.471576656306587*^9, 3.4835532409603777`*^9, 
  3.483553395542931*^9}]
}, Open  ]],

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

Cell[BoxData[
 RowBox[{"zdeterminingequationscolumn", "=", 
  TagBox[
   FormBox[
    RowBox[{"Column", "[", 
     RowBox[{
      RowBox[{"ToExpression", "[", "zdeterminingequations", "]"}], ",", 
      RowBox[{"{", 
       RowBox[{"Left", ",", "Below"}], "}"}]}], "]"}],
    TraditionalForm],
   TraditionalForm,
   Editable->True]}]], "Input"],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{"xse1", "[", 
        RowBox[{"z1", ",", "z2"}], "]"}], "+", 
       RowBox[{"2", " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}], "-", 
       RowBox[{"z1", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"z2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}], "+", 
       RowBox[{"3", " ", "z1", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"z2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"z1", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["eta1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"2", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"xse1", "[", 
        RowBox[{"z1", ",", "z2"}], "]"}], "-", 
       RowBox[{"3", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"z1", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"2", ",", "0"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}, "Rows" -> {{Below}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.469397564966992*^9, 3.471145648014452*^9, 
  3.4715519869087467`*^9, 3.471576656372366*^9, 3.483553241012116*^9, 
  3.483553395595723*^9}],

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

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

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

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Timing", "[", 
  RowBox[{"SolveDeterminingEquations", "[", "\[IndentingNewLine]", 
   RowBox[{
   "independentvariables", ",", "dependentvariables", ",", "r", ",", "xseon", 
    ",", "\[IndentingNewLine]", "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.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.483553395644519*^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.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.483553395645859*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26353496\\), The time = \\!\
\\(2.7774859999999997`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26353496, 2.7774859999999997`],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.483553395646824*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(20\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 20],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.483553395647588*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(40\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 40],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.4835533956483517`*^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.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.483553395649091*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26362000\\), The time = \\!\
\\(2.7792269999999997`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26362000, 2.7792269999999997`],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.483553395649983*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.483553395650724*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.4835533956514263`*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26369960\\), The time = \\!\
\\(2.7801069999999997`\\)\"\>",
  StringForm[
  "The memory in use = ``, The time = ``", 26369960, 2.7801069999999997`],
  Editable->False]], "Print",
 CellChangeTimes->{3.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.483553395652207*^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.4693975650477962`*^9, 3.4711456480924807`*^9, 
  3.471551986962678*^9, 3.471576656421612*^9, 3.4835532410608664`*^9, 
  3.483553395652995*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.014602000000000004`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.469397565051426*^9, 3.4711456481188917`*^9, 
  3.471551986973373*^9, 3.471576656431747*^9, 3.4835532410723953`*^9, 
  3.483553395654581*^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[{
   RowBox[{"-", "b11"}], " ", 
   RowBox[{"y", "[", "x", "]"}]}], "}"}]], "Output",
 CellChangeTimes->{3.469397565096602*^9, 3.4711456481590757`*^9, 
  3.471551987010028*^9, 3.4715766564700336`*^9, 3.483553241105487*^9, 
  3.483553395694378*^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[{"b11", " ", "x"}], "}"}]], "Output",
 CellChangeTimes->{3.469397565241716*^9, 3.471145648213169*^9, 
  3.471551987056048*^9, 3.471576656524261*^9, 3.483553241160328*^9, 
  3.483553395745207*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"Flatten", "[", "infinitesimalgroups", "]"}], "/.", 
  "ztableofrules"}]], "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"-", 
    RowBox[{"y", "[", "x", "]"}]}], ",", "x"}], "}"}]], "Output",
 CellChangeTimes->{3.469397565286696*^9, 3.471145648258953*^9, 
  3.471551987110078*^9, 3.47157665658675*^9, 3.483553241211357*^9, 
  3.4835533957939577`*^9}]
}, Open  ]],

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

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"True", ",", "True", ",", "True", ",", "True"}], "}"}]], "Output",
 CellChangeTimes->{3.471145648313806*^9, 3.471551987156151*^9, 
  3.471576656729319*^9, 3.483553241339876*^9, 3.483553395843584*^9}]
}, Open  ]],

Cell["\<\
The equation is invariant under the rotation group in the plane. This is used \
in example 8.3 to reduce the equation to first order. The resulting first \
order ODE is then solved using separation of variables.\
\>", "Text"],

Cell[CellGroupData[{

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

Cell[BoxData["26394264"], "Output",
 CellChangeTimes->{3.469397565332965*^9, 3.471145648453108*^9, 
  3.4715519872097483`*^9, 3.471576656773932*^9, 3.483553241394526*^9, 
  3.483553395899045*^9}]
}, Open  ]]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{1191, 1078},
WindowMargins->{{73, Automatic}, {Automatic, 39}},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
MacintoshSystemPageSetup -> \
"01@0001804P000000_82@?okonh34`9B;@85:0?l0@00009H0UP00P0068dB`001\n\
2@00I00100000@004Q800BL?0040000000000000000004<001000`00000@0?oH\n\
ofXIX1=F8040400000400000000000l1",
Magnification->1.25,
FrontEndVersion->"7.0 for Mac OS X x86 (32-bit) (February 18, 2009)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[545, 20, 1133, 45, 83, "Text"],
Cell[1681, 67, 124, 1, 32, "Text"],
Cell[1808, 70, 160, 4, 33, "Input"],
Cell[1971, 76, 475, 13, 32, "Text"],
Cell[2449, 91, 101, 2, 33, "Input"],
Cell[2553, 95, 163, 3, 32, "Text"],
Cell[2719, 100, 163, 5, 72, "Input"],
Cell[2885, 107, 2091, 50, 257, "Text"],
Cell[4979, 159, 202, 5, 53, "Input"],
Cell[5184, 166, 130, 2, 32, "Text"],
Cell[5317, 170, 118, 3, 33, "Input"],
Cell[5438, 175, 128, 2, 32, "Text"],
Cell[5569, 179, 116, 3, 33, "Input"],
Cell[5688, 184, 324, 5, 51, "Text"],
Cell[6015, 191, 174, 4, 33, "Input"],
Cell[6192, 197, 141, 2, 32, "Text"],
Cell[6336, 201, 67, 2, 33, "Input"],
Cell[6406, 205, 385, 6, 51, "Text"],
Cell[6794, 213, 67, 2, 33, "Input"],
Cell[6864, 217, 521, 7, 70, "Text"],
Cell[7388, 226, 71, 2, 33, "Input"],
Cell[7462, 230, 534, 8, 70, "Text"],
Cell[7999, 240, 79, 2, 33, "Input"],
Cell[8081, 244, 267, 4, 32, "Text"],
Cell[CellGroupData[{
Cell[8373, 252, 347, 6, 72, "Input"],
Cell[8723, 260, 494, 9, 25, "Print"],
Cell[9220, 271, 1077, 15, 159, "Print"],
Cell[10300, 288, 744, 12, 45, "Print"],
Cell[11047, 302, 483, 9, 25, "Print"],
Cell[11533, 313, 1079, 15, 159, "Print"],
Cell[12615, 330, 254, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[12906, 340, 50, 0, 33, "Input"],
Cell[12959, 342, 280, 4, 53, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[13276, 351, 45, 0, 33, "Input"],
Cell[13324, 353, 1042, 31, 42, "Output"]
}, Open  ]],
Cell[14381, 387, 39, 0, 33, "Input"],
Cell[14423, 389, 327, 8, 33, "Output"],
Cell[CellGroupData[{
Cell[14775, 401, 41, 0, 33, "Input"],
Cell[14819, 403, 331, 8, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[15187, 416, 278, 4, 51, "Text"],
Cell[15468, 422, 47, 0, 33, "Input"],
Cell[15518, 424, 1031, 17, 167, "Output"]
}, Open  ]],
Cell[16564, 444, 57, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[16646, 448, 78, 1, 33, "Input"],
Cell[16727, 451, 190, 3, 33, "Output"]
}, Open  ]],
Cell[16932, 457, 96, 2, 32, "Text"],
Cell[17031, 461, 345, 11, 33, "Input"],
Cell[17379, 474, 5893, 188, 107, "Output"],
Cell[23275, 664, 546, 12, 145, "Text"],
Cell[CellGroupData[{
Cell[23846, 680, 319, 6, 72, "Input"],
Cell[24168, 688, 930, 15, 64, "Print"],
Cell[25101, 705, 492, 7, 64, "Print"],
Cell[25596, 714, 407, 8, 25, "Print"],
Cell[26006, 724, 371, 7, 25, "Print"],
Cell[26380, 733, 396, 8, 25, "Print"],
Cell[26779, 743, 372, 5, 45, "Print"],
Cell[27154, 750, 407, 8, 25, "Print"],
Cell[27564, 760, 217, 3, 25, "Print"],
Cell[27784, 765, 263, 4, 25, "Print"],
Cell[28050, 771, 407, 8, 25, "Print"],
Cell[28460, 781, 1138, 15, 197, "Print"],
Cell[29601, 798, 258, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[29896, 808, 144, 3, 32, "Text"],
Cell[30043, 813, 115, 3, 33, "Input"],
Cell[30161, 818, 285, 7, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[30483, 830, 143, 2, 32, "Text"],
Cell[30629, 834, 115, 3, 33, "Input"],
Cell[30747, 839, 233, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[31017, 849, 117, 3, 33, "Input"],
Cell[31137, 854, 281, 7, 33, "Output"]
}, Open  ]],
Cell[31433, 864, 136, 1, 32, "Text"],
Cell[CellGroupData[{
Cell[31594, 869, 153, 2, 33, "Input"],
Cell[31750, 873, 238, 4, 33, "Output"]
}, Open  ]],
Cell[32003, 880, 235, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[32263, 888, 66, 1, 33, "Input"],
Cell[32332, 891, 195, 3, 33, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
