(* 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[     38098,       1068]
NotebookOptionsPosition[     33896,        933]
NotebookOutlinePosition[     34471,        956]
CellTagsIndexPosition[     34428,        953]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[TextData[StyleBox["Use the package IntroToSymmetry.m to work out the \
point group of the second order ODE\n\nYxx-Yx/Y^2+1/(xY)=0.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}},
 FontSize->14],

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.472046964566783*^9, 
  3.472046965053491*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["Needs[\"SymmetryAnalysis`IntroToSymmetry`\"]", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["Enter the input equation as a string, ie, in quotes.", "Text"],

Cell["\<\
inputequation=
\"D[y[x],x,x]-D[y[x],x]/y[x]^2+1/(x*y[x])\";\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
The function y[x] is a solution of the equation and this constraint must be \
applied to the invariance condition. Replace the second derivative wherever \
it appears in the invariance condition.\
\>", "Text"],

Cell["\<\

rulesarray=
{\"D[y[x],x,x]->D[y[x],x]/y[x]^2-1/(x*y[x])\"};\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

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 or constant names that \
need to be preserved when the variable names in the equation are changed to \
generic names, (x1,y1).",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"frozennames", "=", 
   RowBox[{"{", "\"\<\>\"", "}"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.4615324565531797`*^9, 3.461532456877264*^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 \
infinitesimalsare 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 one sets r=0.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

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

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

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

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

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

Cell[TextData[StyleBox["Now work out the determining equations of the Lie \
point group that leaves the equation invariant.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell["\<\

Timing[FindDeterminingEquations[
independentvariables,dependentvariables,frozennames,p,r,xseon,
inputequation,rulesarray,internalrules]]\
\>", "Input",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 InterpretationBox["\<\"The function FindDetermining Equations has begun, the \
memory in use = \\!\\(26798096\\), the time used = \\!\\(13.175027`\\)\"\>",
  StringForm[
  "The function FindDetermining Equations has begun, the memory in use = ``, \
the time used = ``", 26798096, 13.175027],
  Editable->False]], "Print",
 CellChangeTimes->{3.461532477776322*^9, 3.469399859383754*^9, 
  3.469399948821576*^9, 3.471554610290145*^9, 3.4715769614788322`*^9, 
  3.471577054583068*^9, 3.483556268617154*^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.461532477776322*^9, 3.469399859383754*^9, 
  3.469399948821576*^9, 3.471554610290145*^9, 3.4715769614788322`*^9, 
  3.471577054583068*^9, 3.483556268676429*^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 = \\!\\(800\\), the memory in use = \
\\!\\(26823984\\), the time used = \\!\\(13.221455`\\)\"\>",
  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, 800, 26823984, 
   13.221455],
  Editable->False]], "Print",
 CellChangeTimes->{3.461532477776322*^9, 3.469399859383754*^9, 
  3.469399948821576*^9, 3.471554610290145*^9, 3.4715769614788322`*^9, 
  3.471577054583068*^9, 3.483556268679343*^9}],

Cell[BoxData[
 InterpretationBox["\<\"FindDeterminingEquations is done. The memory in use = \
\\!\\(26824768\\), the time used = \\!\\(13.221681`\\)\"\>",
  StringForm[
  "FindDeterminingEquations is done. The memory in use = ``, the time used = \
``", 26824768, 13.221681],
  Editable->False]], "Print",
 CellChangeTimes->{3.461532477776322*^9, 3.469399859383754*^9, 
  3.469399948821576*^9, 3.471554610290145*^9, 3.4715769614788322`*^9, 
  3.471577054583068*^9, 3.4835562686813726`*^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.461532477776322*^9, 3.469399859383754*^9, 
  3.469399948821576*^9, 3.471554610290145*^9, 3.4715769614788322`*^9, 
  3.471577054583068*^9, 3.483556268683337*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.047411000000000314`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.461532477840425*^9, 3.4693998595771637`*^9, 
  3.469399949092372*^9, 3.471554610478898*^9, 3.471576961514002*^9, 
  3.4715770546214333`*^9, 3.483556268686118*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData["\<\"D[y1[x1],x1,x1]-D[y1[x1],x1]/y1[x1]^2+1/(x1*y1[x1])\"\>"], \
"Output",
 CellChangeTimes->{3.4615324778921003`*^9, 3.469399859659257*^9, 
  3.469399949173275*^9, 3.471554610571864*^9, 3.4715769615479507`*^9, 
  3.471577054654168*^9, 3.483556268721882*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"-", 
    FractionBox["1", 
     RowBox[{
      SuperscriptBox["x1", "2"], " ", 
      RowBox[{"y1", "[", "x1", "]"}]}]]}], ",", 
   RowBox[{
    RowBox[{"-", 
     FractionBox["1", 
      RowBox[{"x1", " ", 
       SuperscriptBox[
        RowBox[{"y1", "[", "x1", "]"}], "2"]}]]}], "+", 
    FractionBox[
     RowBox[{"2", " ", 
      RowBox[{
       SuperscriptBox["y1", "\[Prime]",
        MultilineFunction->None], "[", "x1", "]"}]}], 
     SuperscriptBox[
      RowBox[{"y1", "[", "x1", "]"}], "3"]]}], ",", 
   RowBox[{"-", 
    FractionBox["1", 
     SuperscriptBox[
      RowBox[{"y1", "[", "x1", "]"}], "2"]]}], ",", "1"}], "}"}]], "Output",
 CellChangeTimes->{3.4615324779423647`*^9, 3.469399859721067*^9, 
  3.469399949234838*^9, 3.47155461063725*^9, 3.4715769616051397`*^9, 
  3.471577054709708*^9, 3.483556268775536*^9}]
}, Open  ]],

Cell["\<\
Here are the determining equations in terms of z-variables and in the form of \
strings.\
\>", "Text"],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"-(z1^2*z2^3*Derivative[0, 2][xse1][z1, z2]) == 0\"\>", 
   ",", "\<\"-2*z1^2*z2*Derivative[0, 1][xse1][z1, z2] + \
z1^2*z2^3*Derivative[0, 2][eta1][z1, z2] - 2*z1^2*z2^3*Derivative[1, \
1][xse1][z1, z2] == 0\"\>", 
   ",", "\<\"-(z1*z2*eta1[z1, z2]) - z2^2*xse1[z1, z2] - \
z1*z2^2*Derivative[0, 1][eta1][z1, z2] - z1^2*z2*Derivative[1, 0][eta1][z1, \
z2] + 2*z1*z2^2*Derivative[1, 0][xse1][z1, z2] + z1^2*z2^3*Derivative[2, \
0][eta1][z1, z2] == 0\"\>", 
   ",", "\<\"2*z1^2*eta1[z1, z2] + 3*z1*z2^2*Derivative[0, 1][xse1][z1, z2] - \
z1^2*z2*Derivative[1, 0][xse1][z1, z2] + 2*z1^2*z2^3*Derivative[1, \
1][eta1][z1, z2] - z1^2*z2^3*Derivative[2, 0][xse1][z1, z2] == 0\"\>"}], 
  "}"}]], "Output",
 CellChangeTimes->{3.461532477991881*^9, 3.4693998597871933`*^9, 
  3.469399949299114*^9, 3.4715546107040577`*^9, 3.471576961649892*^9, 
  3.471577054757207*^9, 3.483556268808732*^9}]
}, Open  ]],

Cell["\<\
Here are the determining equations in a slightly more readable form as \
expressions rather than strings.\
\>", "Text"],

Cell[CellGroupData[{

Cell["\<\
zdeteqns=Column[ToExpression[zdeterminingequations],Left,Below]\
\>", "Input",
 CellChangeTimes->{{3.4693999096423473`*^9, 3.469399917224525*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["z1", "2"]}], " ", 
       SuperscriptBox["z2", "3"], " ", 
       RowBox[{
        SuperscriptBox["xse1", 
         TagBox[
          RowBox[{"(", 
           RowBox[{"0", ",", "2"}], ")"}],
          Derivative],
         MultilineFunction->None], "[", 
        RowBox[{"z1", ",", "z2"}], "]"}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "2"}], " ", 
        SuperscriptBox["z1", "2"], " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "2"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{
        RowBox[{"-", "z1"}], " ", "z2", " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{"xse1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{"z1", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", "z1", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]},
    {
     RowBox[{
      RowBox[{
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", 
        RowBox[{"eta1", "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"3", " ", "z1", " ", 
        SuperscriptBox["z2", "2"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"0", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", "z2", " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "+", 
       RowBox[{"2", " ", 
        SuperscriptBox["z1", "2"], " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["eta1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"1", ",", "1"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}], "-", 
       RowBox[{
        SuperscriptBox["z1", "2"], " ", 
        SuperscriptBox["z2", "3"], " ", 
        RowBox[{
         SuperscriptBox["xse1", 
          TagBox[
           RowBox[{"(", 
            RowBox[{"2", ",", "0"}], ")"}],
           Derivative],
          MultilineFunction->None], "[", 
         RowBox[{"z1", ",", "z2"}], "]"}]}]}], "\[Equal]", "0"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}},
   GridBoxSpacings->{"Columns" -> {{Automatic}}, "Rows" -> {{Below}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.461532478064423*^9, 3.469399859874452*^9, 
  3.4693999186523113`*^9, 3.469399949391241*^9, 3.47155461077923*^9, 
  3.471576961707171*^9, 3.471577054808207*^9, 3.483556268855657*^9}]
}, Open  ]],

Cell["\<\
Here is the correspondence between z-variables and conventional variables.\
\>", "Text"],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"z1", "\[Rule]", "x"}], ",", 
   RowBox[{"z2", "\[Rule]", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.461532478257741*^9, 3.469399859949441*^9, 
  3.469399949457605*^9, 3.471554610845203*^9, 3.471576961747994*^9, 
  3.471577054854972*^9, 3.483556268905199*^9}]
}, Open  ]],

Cell["\<\
Now solve the determining equations in terms of multivariable polynomials of \
a selected order.\
\>", "Text"],

Cell[CellGroupData[{

Cell["\<\
Timing[SolveDeterminingEquations[
independentvariables,dependentvariables,r,
xseon,zdeterminingequations,order=3]]\
\>", "Input",
 CellChangeTimes->{{3.469399826422653*^9, 3.469399827444809*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

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.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.483556268960226*^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.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.483556268962369*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26858016\\), The time = \\!\
\\(13.238129`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26858016, 13.238129],
  Editable->False]], "Print",
 CellChangeTimes->{3.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.483556268963891*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of unknown polynomial coefficients = \
\\!\\(20\\)\"\>",
  StringForm["The number of unknown polynomial coefficients = ``", 20],
  Editable->False]], "Print",
 CellChangeTimes->{3.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.483556268965103*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The number of equations for the polynomial \
coefficients = \\!\\(42\\)\"\>",
  StringForm[
  "The number of equations for the polynomial coefficients = ``", 42],
  Editable->False]], "Print",
 CellChangeTimes->{3.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.48355626896638*^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.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.483556268967535*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26867192\\), The time = \\!\
\\(13.239696`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26867192, 13.239696],
  Editable->False]], "Print",
 CellChangeTimes->{3.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.483556268968874*^9}],

Cell[BoxData["\<\"Solve has finished.\"\>"], "Print",
 CellChangeTimes->{3.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.483556268970068*^9}],

Cell[BoxData["\<\"The function SolveDeterminingEquations is finished \
executing.\"\>"], "Print",
 CellChangeTimes->{3.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.483556268971159*^9}],

Cell[BoxData[
 InterpretationBox["\<\"The memory in use = \\!\\(26875032\\), The time = \\!\
\\(13.240663`\\)\"\>",
  StringForm["The memory in use = ``, The time = ``", 26875032, 13.240663],
  Editable->False]], "Print",
 CellChangeTimes->{3.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.483556268972362*^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.4615324783177137`*^9, 3.4693998600211277`*^9, 
  3.469399949517439*^9, 3.4715546109046793`*^9, 3.4715769618058853`*^9, 
  3.471577054910379*^9, 3.4835562689735203`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0.013047000000000253`", ",", "Null"}], "}"}]], "Output",
 CellChangeTimes->{3.46153247832192*^9, 3.4693998601314087`*^9, 
  3.4693999496288157`*^9, 3.4715546112805443`*^9, 3.471576961816143*^9, 
  3.471577054925248*^9, 3.4835562689754477`*^9}]
}, Open  ]],

Cell["\<\
Here are the infinitesimal transformation functions for the independent \
variables.\
\>", "Text"],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", "\<\"xse1[z1_, z2_]=2*b14*z1 + b15*z1^2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.461532478363138*^9, 3.469399860255487*^9, 
  3.469399949767871*^9, 3.47155461145647*^9, 3.471576961867598*^9, 
  3.471577054973482*^9, 3.483556269010231*^9}]
}, Open  ]],

Cell["and for the dependent variables.", "Text"],

Cell[CellGroupData[{

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

Cell[BoxData[
 RowBox[{"{", "\<\"eta1[z1_, z2_]=b14*z2 + b15*z1*z2\"\>", "}"}]], "Output",
 CellChangeTimes->{3.461532478417781*^9, 3.4693998603224983`*^9, 
  3.469399949833736*^9, 3.4715546115073147`*^9, 3.471576961921419*^9, 
  3.471577055028385*^9, 3.483556269055687*^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[{"2", " ", "b14", " ", "x"}], "+", 
   RowBox[{"b15", " ", 
    SuperscriptBox["x", "2"]}]}], "}"}]], "Output",
 CellChangeTimes->{3.461532478462954*^9, 3.469399860389374*^9, 
  3.469399949900919*^9, 3.471554611557666*^9, 3.471576961982662*^9, 
  3.471577055088256*^9, 3.4835562691167793`*^9}]
}, Open  ]],

Cell[CellGroupData[{

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

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

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"b14", " ", 
    RowBox[{"y", "[", "x", "]"}]}], "+", 
   RowBox[{"b15", " ", "x", " ", 
    RowBox[{"y", "[", "x", "]"}]}]}], "}"}]], "Output",
 CellChangeTimes->{3.46153247851807*^9, 3.469399860462652*^9, 
  3.4693999499681683`*^9, 3.471554611607163*^9, 3.471576962038611*^9, 
  3.471577055142717*^9, 3.483556269184102*^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[{"{", 
      RowBox[{"2", " ", "x"}], "}"}], ",", 
     RowBox[{"{", "y", "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      SuperscriptBox["x", "2"], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"x", " ", "y"}], "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.4615324786426363`*^9, 3.4693998605519457`*^9, 
  3.469399950034822*^9, 3.471554611657317*^9, 3.4715769620843153`*^9, 
  3.471577055190764*^9, 3.483556269250081*^9}]
}, Open  ]],

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

Cell[BoxData[
 TagBox[GridBox[{
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"2", " ", "x"}], "}"}], ",", 
       RowBox[{"{", "y", "}"}]}], "}"}]},
    {
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        SuperscriptBox["x", "2"], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"x", " ", "y"}], "}"}]}], "}"}]}
   },
   GridBoxAlignment->{"Columns" -> {{Left}}},
   GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
  "Column"]], "Output",
 CellChangeTimes->{3.461532478685095*^9, 3.46939986060314*^9, 
  3.469399950101712*^9, 3.471554611707754*^9, 3.471576962138627*^9, 
  3.471577055245572*^9, 3.483556269401886*^9}],

Cell["\<\
Check that these symmetries satisfy the determining equations.\
\>", "Text",
 CellChangeTimes->{{3.471554522867668*^9, 3.4715545458246326`*^9}}],

Cell[CellGroupData[{

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

 CellChangeTimes->{{3.471554552278927*^9, 3.471554590561404*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"True", ",", "True", ",", "True", ",", "True"}], "}"}]], "Output",
 CellChangeTimes->{3.471554625737982*^9, 3.471576962277915*^9, 
  3.4715770553849487`*^9, 3.483556269467471*^9}]
}, Open  ]],

Cell[TextData[{
 StyleBox["The final result indicates that the equation is invariant under \
two groups. The parameter b15 corresponds to a projective group and the \
parameter b14 represents a dilation in x and y. ",
  FontWeight->"Plain"],
 StyleBox["Now generate the commutator table.",
  FontWeight->"Plain"]
}], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"MakeCommutatorTable", "[", 
  RowBox[{
  "independentvariables", ",", "dependentvariables", ",", 
   "infinitesimalgroupsxy"}], "]"}]], "Input"],

Cell[BoxData["\<\"MakeCommutatorTable has finished executing. You can look at \
the output in the table commutatortable. To present the output in the most \
readable form you may want view it as a matrix using \
MatrixForm[commutatortable]. Occasionally the entries in the commutatortable \
will have terms that cancel. To get rid of these terms use the function \
Simplify before viewing the table.\"\>"], "Print",
 CellChangeTimes->{3.461532478718437*^9, 3.4693998606685038`*^9, 
  3.4693999501680717`*^9, 3.471554611757*^9, 3.471576962323304*^9, 
  3.471577055428879*^9, 3.483556269538851*^9}]
}, Open  ]],

Cell[TextData[StyleBox["Put the commutator table in readable form.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"MatrixForm", "[", "commutatortable", "]"}]], "Input"],

Cell[BoxData[
 TagBox[
  RowBox[{"(", "\[NoBreak]", GridBox[{
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {"0"},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{"2", " ", 
           SuperscriptBox["x", "2"]}]},
         {
          RowBox[{"2", " ", "x", " ", "y"}]}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]},
     {
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {
          RowBox[{
           RowBox[{"-", "2"}], " ", 
           SuperscriptBox["x", "2"]}]},
         {
          RowBox[{
           RowBox[{"-", "2"}], " ", "x", " ", "y"}]}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}], 
      RowBox[{"(", "\[NoBreak]", GridBox[{
         {"0"},
         {"0"}
        },
        GridBoxAlignment->{
         "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
          "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
        GridBoxSpacings->{"Columns" -> {
            Offset[0.27999999999999997`], {
             Offset[0.7]}, 
            Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, 
          "Rows" -> {
            Offset[0.2], {
             Offset[0.4]}, 
            Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}]}
    },
    GridBoxAlignment->{
     "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, 
      "RowsIndexed" -> {}},
    GridBoxSpacings->{"Columns" -> {
        Offset[0.27999999999999997`], {
         Offset[0.7]}, 
        Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
        Offset[0.2], {
         Offset[0.4]}, 
        Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}],
  Function[BoxForm`e$, 
   MatrixForm[BoxForm`e$]]]], "Output",
 CellChangeTimes->{3.461532478937735*^9, 3.469399860719984*^9, 
  3.469399950240494*^9, 3.4715546118077087`*^9, 3.4715769623563147`*^9, 
  3.47157705547569*^9, 3.483556269608405*^9}]
}, Open  ]],

Cell[TextData[StyleBox["This is a solvable Lie algebra that can be used to \
reduce the equation to first order.",
 FontWeight->"Plain"]], "Text",
 ImageRegion->{{0, 1}, {0, 1}}]
},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{1050, 967},
WindowMargins->{{50, Automatic}, {Automatic, 54}},
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, 216, 4, 76, "Text"],
Cell[764, 26, 124, 1, 32, "Text"],
Cell[891, 29, 160, 4, 33, "Input"],
Cell[1054, 35, 474, 13, 32, "Text"],
Cell[1531, 50, 93, 1, 33, "Input"],
Cell[1627, 53, 68, 0, 32, "Text"],
Cell[1698, 55, 116, 4, 50, "Input"],
Cell[1817, 61, 219, 4, 51, "Text"],
Cell[2039, 67, 117, 5, 66, "Input"],
Cell[2159, 74, 130, 2, 32, "Text"],
Cell[2292, 78, 118, 3, 33, "Input"],
Cell[2413, 83, 128, 2, 32, "Text"],
Cell[2544, 87, 116, 3, 33, "Input"],
Cell[2663, 92, 243, 4, 32, "Text"],
Cell[2909, 98, 176, 4, 33, "Input"],
Cell[3088, 104, 141, 2, 32, "Text"],
Cell[3232, 108, 67, 2, 33, "Input"],
Cell[3302, 112, 389, 6, 51, "Text"],
Cell[3694, 120, 67, 2, 33, "Input"],
Cell[3764, 124, 509, 7, 70, "Text"],
Cell[4276, 133, 71, 2, 33, "Input"],
Cell[4350, 137, 535, 8, 70, "Text"],
Cell[4888, 147, 79, 2, 33, "Input"],
Cell[4970, 151, 189, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[5184, 158, 194, 6, 82, "Input"],
Cell[5381, 166, 518, 9, 45, "Print"],
Cell[5902, 177, 1099, 15, 178, "Print"],
Cell[7004, 194, 772, 13, 64, "Print"],
Cell[7779, 209, 488, 9, 25, "Print"],
Cell[8270, 220, 1101, 15, 178, "Print"],
Cell[9374, 237, 280, 5, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9691, 247, 50, 0, 33, "Input"],
Cell[9744, 249, 272, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10053, 258, 45, 0, 33, "Input"],
Cell[10101, 260, 884, 27, 59, "Output"]
}, Open  ]],
Cell[11000, 290, 112, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[11137, 297, 70, 1, 33, "Input"],
Cell[11210, 300, 926, 16, 167, "Output"]
}, Open  ]],
Cell[12151, 319, 129, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[12305, 326, 188, 4, 33, "Input"],
Cell[12496, 332, 5203, 160, 155, "Output"]
}, Open  ]],
Cell[17714, 495, 98, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[17837, 501, 62, 1, 33, "Input"],
Cell[17902, 504, 345, 8, 33, "Output"]
}, Open  ]],
Cell[18262, 515, 120, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[18407, 522, 237, 6, 66, "Input"],
Cell[18647, 530, 954, 15, 83, "Print"],
Cell[19604, 547, 516, 7, 83, "Print"],
Cell[20123, 556, 409, 7, 25, "Print"],
Cell[20535, 565, 395, 7, 25, "Print"],
Cell[20933, 574, 417, 8, 25, "Print"],
Cell[21353, 584, 396, 5, 45, "Print"],
Cell[21752, 591, 409, 7, 25, "Print"],
Cell[22164, 600, 241, 3, 25, "Print"],
Cell[22408, 605, 285, 4, 25, "Print"],
Cell[22696, 611, 409, 7, 25, "Print"],
Cell[23108, 620, 1164, 15, 216, "Print"],
Cell[24275, 637, 283, 5, 33, "Output"]
}, Open  ]],
Cell[24573, 645, 108, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[24706, 652, 61, 1, 33, "Input"],
Cell[24770, 655, 270, 4, 33, "Output"]
}, Open  ]],
Cell[25055, 662, 48, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[25128, 666, 61, 1, 33, "Input"],
Cell[25192, 669, 274, 4, 33, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[25503, 678, 144, 3, 32, "Text"],
Cell[25650, 683, 115, 3, 33, "Input"],
Cell[25768, 688, 343, 8, 42, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[26148, 701, 143, 2, 32, "Text"],
Cell[26294, 705, 115, 3, 33, "Input"],
Cell[26412, 710, 376, 9, 33, "Output"]
}, Open  ]],
Cell[26803, 722, 67, 0, 32, "Text"],
Cell[CellGroupData[{
Cell[26895, 726, 226, 6, 33, "Input"],
Cell[27124, 734, 543, 16, 42, "Output"]
}, Open  ]],
Cell[27682, 753, 79, 1, 33, "Input"],
Cell[27764, 756, 689, 21, 61, "Output"],
Cell[28456, 779, 154, 3, 32, "Text"],
Cell[CellGroupData[{
Cell[28635, 786, 188, 4, 33, "Input"],
Cell[28826, 792, 218, 4, 33, "Output"]
}, Open  ]],
Cell[29059, 799, 356, 8, 51, "Text"],
Cell[CellGroupData[{
Cell[29440, 811, 168, 4, 33, "Input"],
Cell[29611, 817, 596, 8, 83, "Print"]
}, Open  ]],
Cell[30222, 828, 132, 2, 32, "Text"],
Cell[CellGroupData[{
Cell[30379, 834, 77, 1, 33, "Input"],
Cell[30459, 837, 3240, 88, 115, "Output"]
}, Open  ]],
Cell[33714, 928, 178, 3, 32, "Text"]
}
]
*)

(* End of internal cache information *)
