(* Content-type: application/mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 6.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[    250571,       5140]
NotebookOptionsPosition[    247957,       5058]
NotebookOutlinePosition[    248598,       5083]
CellTagsIndexPosition[    248555,       5080]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell["(* :Title:  IntroToSymmetry.m *)", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(* :Author: Brian J. Cantwell (February, 1998),\nDepartment of Aeronautics \
and Astronautics\nStanford University, Stanford, CA 94305. Questions,\n\
comments and corrections should be directed to \ncantwell@stanford.edu. \
Version 1.0 of the package \nwas originally developed in Mathematica version \
2.2.2\nin Jan-Feb 1998. Several improvements were made in \nSeptember of \
1998. In August 2000 additional features \nwere added and the package was \
adapted to \nMathematica 4.0. In May of 2001 an improved user interface \nwas \
added to the package.This ",
 StyleBox["was",
  FontColor->RGBColor[0, 0, 1]],
 " Version 2.0 of the package and was included on a CD with my book \
\"Introduction to Symmetry Analysis\" published in 2002 as part of the series \
\"Cambridge Texts in Applied Mathematics\". Updated versions of the package \
are available on my website at www.stanford.edu/~cantwell/.\n\n",
 StyleBox["Over the years the package has worked quite well except \nfor \
cases involving Lie-Backlund transformations which, when forming the \
determining equations, often ran very slowly even for a seemingly modest \
calculation. The results were correct but the time needed to form the \
determining equations seemed overly long. I finally got around to addresssing \
this problem in December 2006. The culprit is in a potentially large number \
of calls to the Mathematica function \"Position\" near the end of the call to \
my function FindDeterminingEquations. At this point the program is sorting \
through an array containing the left-hand-sides of the determining equations \
plus a number \nof duplicates. The function \"Position\" is used to find the \
\nindices of the duplicates and in a couple of steps remove the duplicates. \
The problem is that the function \"Position\" is called a number of times \
equal to the number of items in the table containing the determining \
equations plus duplicates. This can be a very large number equal to a \
thousand or more. Now the duplicates are removed in a single step using the \
Mathematica set function \"Union\" one line ahead of the step that \
calls\"Position\" and that step is now comented out with beginning (* and \
ending*) along with a number of following steps that manipulated the list of \
indices that resulted from the multiple calls to \"Position\". \
FindDeterminingEquations now runs much faster. The changes (colored blue) \
were made final on December 22, 2006.\n\nAnother issue that I encountered in \
the process of making this correction has to do with the application of \
extended rules in the case of Lie-Backlund transformations. To begin with it \
is important to be aware that the package is designed to insert these rules \
into the array InvarianceConditionNoRules without inserting them into the \
infinitesimals themselves (ie. into the positions where the independent \
variables appear in the infinitesimals). \nSo there is no possibility of an \
infinitely recursive loop. Therefore there is no need to use a differentiated \
form of the input equation when searching for Lie-Backlund groups. However it \
is important to set up the rules so that the highest derivative in the \
equation is on the left hand side. Otherwise when the rule is substituted \
into the invariance condition one of the independent derivatives might be \
replaced by a dependent derivative typically leading to too many determining \
equations and fewer groups. For example for the heat equation with r=1 the \
required rule is rulesarray={\"D[u[x,t],x,x]\[Rule]D[u[x,t],t]\"} not \
rulesarray={\"D[u[x,t],t]\[Rule]D[u[x,t],x,x]\"}. If the latter is \
substituted into the invariance condition then places where D[u[x,t],t](an \
independent variable) appears will be replaced by D[u[x,t],x,x] (a dependent \
variable). As a result the determining equations will be too restricive, \
there will be too many of them and fewer symmetries will be found.\n\nIn \
addition I have included a number of diagnostics that can be printed during \
the run to show the current status of the function FindDeterminingEquations. \
The printed line usually gives a byte count and time so the user can monitor \
the run if desired. At the moment most of these are commented out. The user \
may wish to un-comment these lines so that the status of \
FindDeterminingEquations can be tracked in some detail. This is particularly \
useful if the equations being analyzed are long and complicated or if one is \
searching for Lie-Backlund equations of order greater than one where the \
invariance condition can be quite long and the number of variables that the \
infinitesimals depend on is large. These diagnostic lines are in ",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["red",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox[" so the user can easily find them in the text below and un-comment \
them if so desired.  \n\nThis is version 3.0 of the package dated December \
24, 2006.\n\n",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["On December 9, 2009 this comment was added here and also in the \
call to InvarianceConditionRulesApplied below. On December 5, 2009 I got an \
e-mail pointing out that the package fails to find the symmetries of the \
equation\nUt+k*x^2*Uxx*Ux^2/(Ux-c*x*Uxx)^2=0. After examining this case it \
quickly became clear that package is not finding the proper set of \
determining equations when the rule(s) applied to the invariance condition \
contain derivatives in the denominator. When the rule \
Ut->-k*x^2*Uxx*Ux^2/(Ux-c*x*Uxx)^2 is inserted into the invariance condition \
there will of course be quite a few terms that will be in the form of \
fractions with various powers of (Ux-c*x*Uxx)^2 in the denominator. In order \
to generate the proper invariance condition is is necessary to put the entire \
invariance condition with rules applied over a common denominator and then \
remove the denominator. This is now done as follows.\nTwo lines after the \
Call to the function InvarianceConditionRulesApplied I do the following.\n\
step 1 - note that the variable termsoftheInvarianceConditionRulesApplied is \
a list containing all the various terms of the invariance condition with \
rules applied and if the rules involve any denominators some or all of these \
terms will have denominators that have to be removed\nstep 2 - Use the \
function Apply[Plus,termsoftheInvarianceConditionRulesApplied1] to form the \
sum of these terms\nstep 3 - Use the function \
Together[Apply[Plus,termsoftheInvarianceConditionRulesApplied1]] to put the \
whole sum over a common denominator\nstep 4 - Use the function \
Numerator[Together[Apply[Plus,termsoftheInvarianceConditionRulesApplied1]]] \
to remove the denominator. The result has a 2 out in front of everything and \
this needs to be brought inside.\nstep 5 - Use the function \
Expand[Numerator[Together[Apply[Plus,\
termsoftheInvarianceConditionRulesApplied1]]]] to bring the 2 inside. This \
gets rid of the braces around the invariance condition.\nstep 6 - Use the \
function Apply[List,Expand[Numerator[Together[Apply[Plus,\
termsoftheInvarianceConditionRulesApplied1]]]]] to convert the sum to a list \
of individual terms. Call this list \
termsoftheInvarianceConditionRulesApplied1nodenominator. In reality all these \
steps are done using the single command given in step 6. \n\nFinally, it \
should be noted that if the original invariance condition with rules applied, \
termsoftheInvarianceConditionRulesApplied1, has no denominators it is already \
correct and this process will correctly leave the invariance condition \
unchanged.\n\nOn December 29, 2009 I made several changes to speed up the \
function SolveDeterminingEquations and reduce the amount of memory used. This \
function searches for a multivariate polynomial solution to the determining \
equations. The variables on which the infinitesimals are assumed to depend \
include all independent and dependent variables and, in the case of \
Lie-Backlund transformations, all derivatives of the dependent variables up \
to order r specified by the user. The order of the trial polynomial (the \
variable \"order\" in the package) is selected by the user. The current \
procedure for creating the list of powers of zvariables that appear in the \
polynomials does a search over all powers up to \
z1^order*z2^order*z3^order*...*zn^order where n is the number of variables in \
the list of zvariables, ie, a search that includes powers up to n*order. But \
only powers up to order are actually needed and items in the list that \
involve powers exceeding order are set to Null and then deleted. For \
calculations of point symmetries where the number of variables is not too \
large this does not present much of a problem but for Lie-Backlund symmetries \
where the number of variables can easily be considerably greater than ten, \
and where higher order polynomials are required, this intermediate step \
unnecessarily uses vastly more memory and time than is required. The new \
procedure sorts through powers of z variables only up to the required order \
and deletes any redundancies. This saves a considerable amount of time and \
memory for Lie-Backlund calculations. \n\nWith the change described above in \
magenta this becomes version 4.1 of the package now Dated December 29, 2009.\n\
\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["In May 2010 I encountered a rather unusual problem when I was \
using the package to work out the Maxwell equations with currents and \
charges. When I used the dependent variable names j1, j2, j3 to denote the \
currents the package at first seemed to run OK but with some odd \
replacements. On the first run the array ztableofrules had the string j1 \
replaced by the string 1. When run a second time the equation in generic \
variables had 1 where it should have had z8 and ran incorrectly. The problem \
was that in the function GenerateInvarianceConditionRulesApplied indices j1, \
j2, j3,\[Ellipsis]  are used, and j1 ends up with the value 1 which later \
gets inserted into ztableofrules . When the package is run a second time j1 \
is still 1 and gets inserted into the input equation when it is expressed in \
generic variables. To prevent this the command \
Clear[\[OpenCurlyDoubleQuote]j*\[CloseCurlyDoubleQuote]] is used at the end \
of GenerateInvarianceConditionRulesApplied and at the end of \
FindDeterminingEquations.  \n\nFinally in May 2010 I added the commands \
Unprotect[\"`*\"]; and ClearAll[\"`*\"]; at the beginning of the package so \
it can be loaded more than once during a given session.\n\nWith the May 2010 \
changes, the package is designated version 4.2 dated May 20, 2010.",
  FontColor->RGBColor[1, 0.5, 0]],
 StyleBox["*)",
  FontColor->RGBColor[1, 0.5, 0]]
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->CompressedData["
1:eJwdxU0oQwEAB/BtrSazJ8ZW85EdfC1prdFoK1NE5GMp5aKIyWFvLraUIaYm
H4kwIXt2Wa2sHCaHHWyt7GAlEVajJBtt0WzFat5/h18/8QipGWMxGAwRDU/3
jnb2P0TUMe7FEpYnWlhGepfTQGDdjbIILyv3RNgUuBbjP0NXNa5npurwVmam
A+/zfdRxKKImAjunWDqXE8QyrSKEizfYz9gfH3/BByWvcXylXfvCg1FrEm/q
rUwbfVRrInDMwOZj17tCiO/aeSL8liqtwJdenRwPHdma8O29pw0nJYIBPHFG
abFe6ifxozuwgAvIjBnXeGcPcY9l+Amnvxs/sMKj+cHbVVwWRe8LOjg4HG7O
x+UeinNCX5j25WJHt4XAk9RudtW8qgzLat2VeNVulOC8888GvJJa1Nvp1wXS
KdznFJK8RERt/m3N/g/fmewv
  "],
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
(* :Copyright \[Copyright] 1998 Brian J. Cantwell.

    This program is free software; you can redistribute it and/or modify it \
under the terms of the GNU General Public License version 2 June 1991 as \
published by the Free Software Foundation.

    This program is distributed in the hope that it will be useful, but \
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or \
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for \
more details.

    You should have received a copy of the GNU General Public License along \
with this program; if not, write to the Free Software Foundation, Inc., 59 \
Temple Place, Suite 330, Boston, MA  02111-1307  USA.*)\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->{{3.471123371247574*^9, 3.4711234403197603`*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "\n (* :Summary:\nThis application program is used to solve for the \n\
determining equations of the Lie-Backlund group which \nleaves the equation \n\
             \[Psi]=\[CapitalPsi][x,y,y{1},y{2},...,y{p}] \ninvariant. The \
equation is a differential function which \ndepends on the independent \
variables,\n                 x={x1,x2,....,xn},\nthe dependent variables,\n   \
          y={y1[x],y2[x],...,ym[x]},\nfirst derivatives, \n            y{1}={\
\[PartialD]y1/\[PartialD]x1,...,\[PartialD]ym/\[PartialD]xn},\nsecond \
derivatives,      \n       y{2}={\[PartialD](\[PartialD]y1/\[PartialD]x1)/\
\[PartialD]x1,...,\[PartialD](\[PartialD]ym/\[PartialD]xn)/\[PartialD]xn},\n\
and so on up to derivatives of order p. Note that the\nequation could be one \
member of a system of equations.\nThe infinitesimal form of the transforming \
group is\n xj'=xj+s\[Xi]j[x,y,y{1},y{2}...,y{r}]\n \
yi'=yi+s\[Eta]i[x,y,y{1},y{2}...,y{r}]\n \[PartialD]yi'/\[PartialD]xj'=\
\[PartialD]yi/\[PartialD]xj+s\[Eta]ij[x,y,y{1}...,y{r+1}]\n \[PartialD](\
\[PartialD]yi'/\[PartialD]xj1')/\[PartialD]xj2'=\[PartialD](\[PartialD]yi/\
\[PartialD]xj1)/\[PartialD]xj2+s\[Eta]ij1j2[x,y,...]\n \
......................................................\n \[PartialD](...\
\[PartialD](\[PartialD](pyi'/\[PartialD]xj1')/\[PartialD]xj2'...)/\[PartialD]\
xjp'=\n \[PartialD](...\[PartialD](\[PartialD](pyi/\[PartialD]xj1)/\[PartialD]\
xj2...)/\[PartialD]xjp+\n             \
s\[Eta]ij1j2..jp[x,y,y{1},y{2},..,y{r+p}]\nwhere s is the group parameter \
(assumed small) and r is \nthe maximum derivative order upon which the \
infinitesimals \nare assumed to depend. The infinitesimals\nof the point \
transformation (x,y)->(x',y') are \[Xi]j and \[Eta]i.\nThe infinitesimals of \
the extended transformation are\ngiven by the formulae,\n        \[Eta]ij=D\
\[Eta]i/Dxj-(\[PartialD]yi/\[PartialD]xk)D\[Xi]k/Dxj\n     \
\[Eta]ij1j2=D\[Eta]ij1/Dxj-(\[PartialD](\[PartialD]yi/\[PartialD]xj1)/\
\[PartialD]xk)D\[Xi]k/Dxj2\n\[Eta]ij1j2...jp=D\[Eta]ij1...j(p-1)/Dxjp-\n      \
  (\[PartialD]...(\[PartialD]yi/\[PartialD]xj1)/\[PartialD]xj2...\[PartialD]\
xj(p-1)\[PartialD]xjk)D\[Xi]k/Dxjp      \nwhere D( )/Dxj is the operator of \
total differentiation \nwith respect to xj. The invariance condition is\n     \
                 X\[CapitalPsi]=0\nwhere the p-th order extended operator X \
is given by\n  X=\[Xi]j\[PartialD]/\[PartialD]xj+\[Eta]i\[PartialD]/\
\[PartialD]yi+\[Eta]ij1\[PartialD]/\[PartialD]yij1+...+\[Eta]ij1j2..jp\
\[PartialD]/\[PartialD]yij1...jp.\nThe invariance condition, \
X\[CapitalPsi]=0, is satisfied subject to the \ncondition that the y's and \
their derivatives that appear\nin the invariance condition must satisfy the \
original\nequation and its higher order differential consequences.\nThis \
leads to a series of transformation rules which must\nbe applied to the \
y-derivatives appearing in the invariance \ncondition.\n\nIf the sought after \
group is of Lie-Backlund type with the\ninfinitesimals depending on x, y and \
at least y{1} then \nthe \[Xi]'s can be set to zero without loss of \
generality. For\npoint groups the \[Xi]'s must be included in the \
computation.\n\nAlso included is a function called solvdeterminingequations\n\
which attempts to solve the determining equations for the \nunknown \
infinitesimals in the form of multivariate polynomials.\n\n  \
\[Xi]j[z1,z2,z3,...,zq]=\n      aj1+aj2*z1+aj3*z2+aj4*z3+...+aj(q+1)*zq+\n    \
      aj(q+2)*z1^2+aj(q+3)*z1*z2+aj(q+4)*z1*z3+...\n\n  \
\[Eta]i[z1,z2,z3,...,zq]=\n      bi1+bi2*z1+bi3*z2+bi4*z3+...+bi(q+1)*zq+\n   \
       bi(q+2)*z1^2+bi(q+3)*z1*z2+bi(q+4)*z1*z3+...\n      \n\nwhere \
[x,y,y{1},y{2},...,y{p}]->[z1,z2,z3,...,zq] and the\naj's and bi's are \
constants to be solved for using the\ndetermining equations. The variable \
count is \n\n     q=n+m*Sum[(n+k-1)!/(k!*(n-1)!), {k,0,r}]\n\nNote that I \
have chosen to use 'xse' as the spelling of the\ngreek symbol \[Xi] rather \
than the usual 'xi'. The reason is\nthat 'xi' is too close to 'xj' which \
refers to the jth \nindependent variable. To avoid any possible conflict, I\n\
decided to play it safe and use 'xse'instead. The rationale \nfor using a \
multinomial expansion is that the infinitesimals \nare the solutions of a, \
usually, highly overdetermined \nsystem of linear partial differential \
equations called \nthe determining equations of the group. As a result, the \n\
infinitesimals usually turn out to be relatively simple\npower multinomials. \
However the infinitesimals can contain \narbitrary functions. The program can \
be used to identify \nsuch functions by searching over several orders of the \
trial \nmultinomial. The ability to identify those groups which\nare \
expressed as truncated multinomials or arbitrary functions\nis extremely \
useful and a major first step toward the complete \nsolution of the \
determining equations. But the user must be \naware that quite often it is \
just a first step and there are \nmany examples where the infinitesimals \
contain transcendental \nfunctions. These must be determined interactively by \
using \nknown groups to simplify the determining equations and \nMathematica \
built-in functions or adhoc methods to solve \nthe remaining set.\n\n",
 StyleBox["HOW TO USE THE PACKAGE",
  FontVariations->{"Underline"->True}],
 "\nThe equation is entered as a string called 'inputequation' with the\n\
derivatives written as Mathematica input expressions. The user is free\nto \
pick whatever symbols are desired for the various independent and\ndependent \
variables that appear in the equation. In addition, the \nequation or system \
of equations are entered by the user as a list of \nrules in string format \
called 'rulesarray'. The rules are constraints \non the invariance condition \
and are used to replace selected derivatives \nof the dependent variable(s) \
that appear in the invariance condition.\n\nThe function \
FindDeterminingEquations first takes the input equation and \nre-expresses it \
in terms of generic variable names; (x1,x2,x3,...) for \nthe independent \
variables and (y1,y2,y3,...) for the dependentvariables. \nThen the long list \
of terms in the invariance condition is generated. \nThe rules in 'rulesarray \
are then applied to the various relevant derivatives of \nthe dependent \
variables appearing in the invariance condition.The terms \nin the invariance \
condition are then parsed to form the determining \nequations of the group. \
These are available as a list of strings called\nzdeterminingequations. The \
unknown infinitesimals are designated 'xsej' \nand 'etai'and are expressed as \
functions of z variables where\n\n\
(z1,z2,z3,z4,....z(n+m))=(x1,x2,x3,...,xn,y1,y2,y3,...,ym).\n\nFor example \
the Blasius equation would be entered as:\n  \
inputequation=\"D[f[x],x,x,x]+f[x]*D[f[x],x,x]\"\nThe heat equation would be \
entered as\n     inputequation=\"D[u[x,t],t]-kappa*D[u[x,t],x,x]\"\nIn \
addition to the equation, there are six other inputs.\n\n       \
independentvariables - the list of independent variable names, for \n       \
example, independentvariables={\"x\",\"y\",\"t\"}\n         \n       \
dependentvariables - the list of dependent variable names, for\n       \
example, dependentvariables={\"u\",\"v\"}\n       \n       frozenstrings - \
the list of strings that must remain unchanged\n       when the input \
equation is changed to generic (xj,yi) variables. \n       These are usually \
function names and constant names that might appear \n       in the equation. \
For the heat equation this would be entered as\n          \
frozennames={\"kappa\"}\n       If no such names appear a null list is \
entered, frozennames={}. The\n       reason this is required is that when the \
equation is converted to\n       generic variables where, say, x is replaced \
by x1, a name like the\n       Mathematica built-in function Exp will be \
mistakenly changed to Ex1p.\n       The list frozennames prevents this.\n     \
    \n       porder - the order of the highest derivative in the input \
equation\n       or in the system of equations being considered.\n            \
 \n       rorder - the order of the highest y-derivative that the \
infinitesimals \n       'xse' and 'eta' can depend on.\n         \n       \
xseon - This parameter is zero if the xse's are set to zero, and \n       one \
if the xse's are not zero. If the search is for Lie point groups \n       \
then 'rorder=0' and 'xseon' must be set to one. In the case of \n       \
Lie-Backlund groups with 'rorder=1'or higher, then one can, without \n       \
loss of generality, transform only the independent variables.In this \n       \
case 'xseon' can be set to zero or one. If zero is used then only \n       \
the dependent variables are transformed.\n         \n       rulesarray - This \
is an array of replacement rules in string format \n       used to apply the \
equation to the invariance condition as a constraint.\n       If this is not \
done then the invariance condition is too restrictive \n       and symmetries \
may be lost.\n       \n       internalrules - This parameter is set to zero \
if no further rules \n       need to be constructed. This is the case if one \
is searching for point\n       groups. But if the package is being used to \
search for Lie-Backlund\n       groups with rorder=1 or more then \
internalrules needs to be set to \n       one so that the differential \
consequences of the equation in question are generated \n       internally \
and appended to 'rulesarray'. The enlarged set of rules is\n       contained \
in a table called 'rulesarrayexpanded'.\n         \nOnce the data has been \
entered, the user calls the function\n   FindDeterminingEquations[\n       \
independentvariables,dependentvarables,frozenstrings,porder,rorder,\n       \
xseon,inputequation,rulesarray,internalrules].\n\nSeveral tables are \
generated as output. The first is called\n\n                 \
invarconditiontable\n                 \nand contains the various derivatives \
of the input equation.\nThe entries in this table are expressed in terms of \
generic\nx1,z2,x3,... independent variables and generic y1,y2,y3,...\n\
dependent variables.The second table is called\n\n            \
termsoftheInvarianceConditionNoRules\n            \nwhich, as the name \
implies, contains all the terms in the \ninvariance condition before the \
application of transformation \nrules. These rules are contained in the table \
'rulesarray' \ninput by the user. The program can also generate a table of \n\
rules corresponding to the higher order differential\nconsequences of the \
original equation, ie, derivatives of the \nequation with respect to all \
possible combinations of \nindependent variables up to the order \
'rorder'selected by the user. \nThe expanded set of rules, which includes the \
original set\ninput by the user, is generated by the routine \n\
'MakeRulesArray'. The expanded set of rules is contained \nin the table \
'rulesarrayexpanded'. If the parameter 'internalrules=1' \nthe internally \
generated rules are used. If 'internalrules=0' then \nonly the rules in \
'rulesarray' are used. Thus the user has \nmaximum flexibility in choosing \
the rules used to restrict \nthe invariance condition. The invariance \
condition \nafter the application of the rules is available in the table\n\n  \
       termsoftheInvarianceConditionRulesApplied\n         \nThe y-derivative \
terms are separated from the infinitesimal\nderivative terms to produce two \
final tables. The y-derivative \nproducts are contained in the table\n\n      \
             yderivfactortable\n                   \nand the determining \
equations are contained in the table.\n\n                  \
determiningequations\n                  \nFor convenience, the variables upon \
which the infinitesimals\ndepend are converted to a set of dummy variables, \
ie,\nx1->z1, x2->z2, y1->z3, etc. The result is contained in\n\n              \
    zdeterminingequations\n                  \nand the correspondence between \
variables is contained in\n\n                     ztableofrules\n             \
        \nThese tables are the main output of the package.\n\n",
 StyleBox["OTHER USES",
  FontVariations->{"Underline"->True}],
 "\nThe package can also be used simply to generate a \ntable of variables \
including derivatives up to order porder. \nThis is done simply by calling \
the function\n\n              GenerateVariableTable[n_,m_,porder_].\n         \
     \nwhere n is the number of independent variables and m is the\nnumber of \
dependentvariables. Similarly, one can generate \nthe terms of any \
infinitesimal by calling the function\n\n     \
PthInfinitesimal[n_,m_,yindex_,p_,r_,xseon_,\n     \
j1_,j2_:0,j3_:0,j4_:0,j5_:0,j6_:0,j7_:0,j8_:0,\n     \
j9_:0,j10_:0,j11_:0,j12_:0,j13_:0,j14_:0]\n     \nThe input yindex is the \
index of the particular\ndependent variable in question. The indices 'j1' \
through\n'j14' are the lower indices of the infinitesimal \ncorresponding to \
the derivative being transformed. These\nindices are optional and any missing \
ones are simply set to \nzero. The limit of 14 seems to be a limitation of \
the \napplication Mathematica which only allows up to 13 optional arguements \
\nin a defined function. The fact is, almost any computer will \nbe brought \
to its knees if the user tries to compute Lie-Backlund \ntransformations that \
depend on derivatives above 4th or 5th order.\n\n",
 StyleBox["SOLVING THE DETERMINING EQUATIONS",
  FontVariations->{"Underline"->True}],
 "\nA multivariable polynomial solution for the infinitesimals can \nbe \
attempted by calling the function\n\n     SolveDeterminingEquations[\n        \
  independentvariables,dependentvariables,rorder,xseon,\n          \
zdeterminingequations,polyorder]\n          \nThe parameter 'polyorder' is \
used to select the order of the \npolynomial used in the expansion. One \
approach is to call the \nfunction succesively with increasing orders, \
stopping when the \ncomputed infinitesimals stop changing. The results are \
presented \nas two tables of strings, xsefunctions and etafunctions ordered \n\
in the usual way. These strings can be converted to expressions \nusing the \
built-in function 'ToExpression'. \n\n",
 StyleBox["SAMPLE RUN",
  FontVariations->{"Underline"->True}],
 "\nA typical session for calculating the point group of the heat \nequation \
would be as follows.\n",
 StyleBox["Inputs",
  FontVariations->{"Underline"->True}],
 "\nindependentvariables={\"x\",\"t\"}\ndependentvariables={\"u\"}\n\
frozenstrings={\"kappa\"}\nporder=2\nrorder=0\nxseon=1\ninternalrules=0\n\
inputequation=\"D[u[x,t],t]-kappa*D[u[x,t],x,x]\"\n\
rulesarray={\"D[u[x,t],x,x]->(1/kappa)*D[u[x,t],t]\"}\n\n",
 StyleBox["Call the function",
  FontVariations->{"Underline"->True}],
 "\nFindDeterminingEquations[\n\
independentvariables,dependentvariables,frozenstrings,porder,rorder,xseon,\n\
inputequation,rulesarray,internalrules]\n\n",
 StyleBox["Main Output",
  FontVariations->{"Underline"->True}],
 "\ndeterminingequations\nzdeterminingequations\nztableofrules\n\n",
 StyleBox["Try to solve for xse1, xse2 and eta1",
  FontVariations->{"Underline"->True}],
 "\npolyorder=3\nSolveDeterminingEquations[\n\
independentvariables,dependentvariables,rorder,\n\
xseon,zdeterminingequations,polyorder]\n\n",
 StyleBox["Output",
  FontVariations->{"Underline"->True}],
 "\nxsefunctions\netafunctions\ninfinitesimalgroups\n\n",
 StyleBox["Express the table infinitesimal groups in terms of user variables",
  
  FontVariations->{"Underline"->True}],
 "\ninfinitesimalgroups1=infinitesimalgroups/.{z1->x,z2->y,z3->u}\n\n",
 StyleBox["Construct the commutator table of the group",
  FontVariations->{"Underline"->True}],
 "\nMakeCommutatorTable[\n\
independentvariables,dependentvariables,infinitesimalgroups1]\n\n",
 StyleBox["Output",
  FontVariations->{"Underline"->True}],
 "\ncommutatortable\n*)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["(*Prepend the context SymmetryAnalysis` to $ContextPath*)", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["BeginPackage[\"SymmetryAnalysis`IntroToSymmetry`\"]", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
GenerateVariableTable::usage=
\"GenerateVariableTable[numberindependentvars,numberdependentvars,\
porderoftheequation] This function generates a 
table of all the various variables in x,y,y{1},y{2},...,y{porderoftheequation}.
The output is a table of strings contained in 
variablestringtable.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
SecondTerm::usage=
\"SecondTerm[numberindependentvars,numberdependentvars,yindex,plocal,\
rorderofinfinitesimals,
j1,j2,j3,j4,j5,j6,j7,j8,j9,j10,j11,j12,j13,j14] This function 
generates the second term in the p-th order infinitesimal.
Note that derivatives up to 14th order are permitted by
program.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
PthInfinitesimal::usage=
\"PthInfinitesimal[numberindependentvars,numberdependentvars,yindex,\
porderoftheequation,rorderofinfinitesimals,xseon,
j1,j2,j3,j4,j5,j6,j7,j8,j9,j10,j11,j12,j13,j14] This nested
function generates the first term in the p-th order 
infinitesimal. In the process it calls the function
'SecondTerm'.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
GenerateInfinitesimalTable::usage=
\"GenerateInfinitesimalTable[numberindependentvars,numberdependentvars,\
porderoftheequation,rorderofinfinitesimals,xseon] 
This function generates a table of strings with the same 
indices as 'GenerateVariableTable'. Each element in  the 
table is a call to 'PthInfinitesimal' which will be 
evaluated once it is determined which infinitesimals will be 
needed.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
InvarianceConditionNoRules::usage=
\"InvarianceConditionNoRules[numberindependentvars,numberdependentvars,\
porderoftheequation,rorderofinfinitesimals,xseon,inputequation] 
This function generates a table of expressions for the terms 
in the invariance condition before the transformation rules 
have been applied. The result is contained in 
'termsoftheInvarianceConditionNoRules'.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
InvarianceConditionRulesApplied::usage=
\"InvarianceConditionRulesApplied[
numberindependentvars,numberdependentvars,porderoftheequation,\
rorderofinfinitesimals,xseon,inputequation,rulesarray,internalrules]
This function generates a table of expressions for the terms in 
the invariance condition after the transformation rules have 
been applied. The result is contained in 
'termsoftheInvarianceConditionRulesApplied1'
and 'termsoftheInvarianceConditionRulesApplied'.In the first table
each factor is multiplied by two to insure that every term has at
least two factors to insure the proper operation of the function 
'Cases' which is used in the next step. In the second table the
factor of two has been removed.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
MakeRulesArray::usage=
\"MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98,\
rorderofinfinitesimals,rulesarray] This function
generates the array of rules which are applied to the invariance
condition in the case of a Lie-Backlund transformation. The rules
are standard in the sense they are simply all the possible
derivatives of the input equation up to the order of the
Lie-Backlund variables. The results are contained in the
table rulesarrayout.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
FindDeterminingEquations::usage=
\"FindDeterminingEquations[
independentvariables,dependentvariables,frozenstrings,porderoftheequation,\
rorderofinfinitesimals,xseon,
inputequationuservariables,rulesarrayuservariables,internalrules]
This is the main function of the program. The results are 
presented as strings in the table 'determiningequations' 
which contains the determining equations of the group. The table 
'yderivfactortable' contains expressions for the corresponding 
products of free variables. For convenience, the variables 
upon which the infinitesimals depend are converted to a set of 
dummy variables,ie, x1->z1, x2->z2, y1->z3, etc. The result is 
a table of strings contained in 'zdeterminingequations'. 
The correspondence between variables is contained in 
'ztableofrules'. These tables are the main output of the 
package.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
SolveDeterminingEquations::usage=
\"SolveDeterminingEquations[
independentvariables,dependentvariables,rorderofinfinitesimals,xseon,
zdeterminingequationstable,order] This
function can be used to try to solve the determining equations
contained in the array 'zdeterminingequations'. The solution
is sought in the form of a polynomial expansion in powers of the 
z-variables. This function should be thought of as a taking a 
first cut at the general solution of the determining equations 
which can admit functions that are beyond the reach of a truncated 
power series expansion. The results are contained in the tables
'xsefunctions' and 'etafunctions'. The expressions in 
these tables are ordered according to the usual ordering of
independent and dependent variables.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell["\<\
MakeCommutatorTable::usage=
\"MakeCommutatorTable[
independentvariables,dependentvariables,infinitesimalgroupsxy] This
function is used to generate the commutator table of the Lie 
algebra of the groups contained in 'infinitesimalgroupsxy'.
The symbols used for 'independentvariables' and
'dependentvariables' must correspond to the symbols in
'infinitesimalgroupsxy'. The output is contained in the table
'commutatortable'. This is the last function in the package.\";\
\>", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 StyleBox["(*Note that this is not an initialization cell.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nBegin[\"`Private`\"]",
 StyleBox[";",
  FontColor->RGBColor[1, 0, 0]]
}], "Input",
 PageWidth->PaperWidth,
 CellChangeTimes->{{3.4833625535682287`*^9, 3.483362594351852*^9}}],

Cell[BoxData[
 RowBox[{
  StyleBox[
   RowBox[{"(*", 
    RowBox[{
     RowBox[{
     "These", " ", "commands", " ", "were", " ", "added", " ", "May", " ", 
      "20"}], ",", " ", 
     RowBox[{
     "2010", " ", "to", " ", "permit", " ", "the", " ", "package", " ", "to", 
      " ", "be", " ", "read", " ", "in", " ", "twice", " ", "if", " ", 
      RowBox[{"needed", "."}]}]}], "*)"}],
   FontWeight->"Plain",
   FontVariations->{"CompatibilityType"->0}], 
  StyleBox["\[IndentingNewLine]",
   FontColor->RGBColor[1, 0, 0]], 
  RowBox[{
   StyleBox[
    RowBox[{
     RowBox[{"Unprotect", "[", "\"\<`*\>\"", "]"}], ";"}],
    FontColor->RGBColor[1, 0, 0]], 
   StyleBox[" ",
    FontColor->RGBColor[1, 0, 0]], "\[IndentingNewLine]", 
   StyleBox[
    RowBox[{
     RowBox[{"ClearAll", "[", "\"\<`*\>\"", "]"}], ";"}],
    FontColor->RGBColor[1, 0, 0]]}]}]], "Input",
 CellChangeTimes->{{3.4833691317031803`*^9, 3.483369178752589*^9}}],

Cell[TextData[{
 StyleBox["(*Many of the names used are similar to one another.\nThe function \
'Off' prevents the application from \ngenerating a bunch of annoying \
warnings.*)",
  FontWeight->"Plain"],
 "\nOff[General::spell1];"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(******BEGINNING*OF*FUNCTION*GenerateVariableTable*******)\n",
 StyleBox["(*This is the name of the function that generates the\ntable of \
variables beginning with independent variables,\nfollowed by dependent \
variables, then by derivatives up\nto order p. The result is generated in the \
table\n\"variabletable\".*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars_,numberdependentvars_,\
porderoftheequation_]:=\n\n",
 StyleBox["(*The function \"Module\" hides the variable names in \nbrackets \
from the rest of the program*)",
  FontWeight->"Plain"],
 " \n(Module[{indepvariablestring,indepvariablestring1,\n\
dependvariablestring,makederivtablestring,derivindtable,\n\
derivindsumtable,postbl,postbllength,\nyderivtableofstrings1,\n\
yderivtableofstrings2,yderivtableofstrings3,\n\
yderivtableofstrings4,yderivtableofstrings,i,j,",
 StyleBox["j1,",
  FontColor->RGBColor[1, 0, 0]],
 "jindex,\nppndx,indtbl,indtbl2,indtbl3,indexm},\n\n",
 StyleBox["(*Generate a table of independent variables.*)",
  FontWeight->"Plain"],
 "\nindepvariablestring=\n\
Table[\"x\"<>ToString[j],{j,1,numberindependentvars}];\n\n",
 StyleBox["(*Generate an unbracketed string of independent variables.*)",
  FontWeight->"Plain"],
 "\nindepvariablestring1=\nStringReplace[\nStringReplace[\nStringReplace[\n\
ToString[Table[\"x\"<>ToString[j],{j,1,numberindependentvars}]],\n\
\"{\"->\"\"],\"}\"->\"\"],\" \"->\"\"];\n\n",
 StyleBox["(*Generate a table of dependent variables.*)",
  FontWeight->"Plain"],
 "\ndependvariablestring=\n\
Table[\"y\"<>ToString[i],{i,1,numberdependentvars}];\n\n",
 StyleBox["(*Generate a table of dependent variables each with the \n\
bracketed string of independent variables attached to \nindicate the \
dependence on the xj's.*)",
  FontWeight->"Plain"],
 "\ndependvariablestring1=\nTable[\"y\"<>ToString[i]<>\"[\"<>\n\
indepvariablestring1<>\"]\",{i,1,numberdependentvars}];\n\n",
 StyleBox["(*This step prepares a string which in the next line is\nconverted \
to a function.*)",
  FontWeight->"Plain"],
 "\nmakederivtablestring=\"Table[\"<>\nToString[Table[\"j\"<>ToString[\n\
jindex],{jindex,1,numberindependentvars}]]<>\", \"<>\nStringReplace[\n\
StringReplace[\nToString[\n\
Table[{\"j\"<>ToString[numberindependentvars+1-jindex]<>\",0,\"<>ToString[\
porderoftheequation]},\n\
{jindex,1,numberindependentvars}]],\"{{\"->\"{\"],\"}}\"->\"}\"]<>\"]\";\n\n\
",
 StyleBox["(*This step generates a table of lists of derivative\nindices.*)",
  FontWeight->"Plain"],
 "\nderivindtable=\nFlatten[\n\
ToExpression[makederivtablestring],numberindependentvars-1];\n\n",
 StyleBox["(*It is necessary to identify those combinations of\nindices which \
add up to the derivative order, p.\nFirst add together the indices in each \
term. The\nlist is flattened to remove extra brackets and\ncreate a \
one-dimensional list.*)",
  FontWeight->"Plain"],
 "\nderivindsumtable=\nFlatten[\nToExpression[\n\"Table[\"<>\nToString[\n\
Apply[Plus,Table[\"j\"<>ToString[jindex],{jindex,1,numberindependentvars}]]]<>\
\n\", \"<>\nStringReplace[\nStringReplace[\nToString[\n\
Table[{\"j\"<>ToString[jindex]<>\",0,\"<>ToString[porderoftheequation]},\n\
{jindex,1,numberindependentvars}]],\"{{\"->\"{\"],\"}}\"->\"}\"]<>\"]\"],\
numberindependentvars-1];\n\n",
 StyleBox["(*This step identifies the positions of those terms\nwhere the \
indices add up to 1,2,3...,p. These are\nthe terms corresponding to the \
various order\nderivatives. This list is also flattened to make the\nlist \
one-dimensional.*)",
  FontWeight->"Plain"],
 "\npostbl=Flatten[\nTable[\nFlatten[\n\
Position[derivindsumtable,ppndx],1],{ppndx,1,porderoftheequation}],1];\n\n",
 StyleBox["(*The number of terms with the right combinations\nof \
derivatives.*)",
  FontWeight->"Plain"],
 "\npostbllength=Length[postbl];\n\n",
 StyleBox["(*This picks off the needed terms from the rather long\ntable \
produced above. The table 'derivativeindextable' \nis available as an output \
of this function, ie, it is\nnot protected by 'Module'.*)",
  FontWeight->"Plain"],
 "\nderivativeindextable=\nTable[derivindtable[[postbl[[i]]]],\n\
{i,1,postbllength}];\n\n",
 StyleBox["(*At this point the name structure of the variables\nis created by \
inserting yi before each list.*)",
  FontWeight->"Plain"],
 "\nyderivtableofstrings1=Flatten[Table[\nTable[\n\
ToString[derivativeindextable[[indtbl]]]<>\n\"[y\"<>ToString[indexm]<>\"]\",\n\
{indtbl,1,postbllength}],{indexm,1,numberdependentvars}],1];\n\n",
 StyleBox["(*Now exchange the braces surrounding the lists of indices\nfor \
brackets and remove blanks between numbers.*)",
  FontWeight->"Plain"],
 "\nyderivtableofstrings2=Table[\nStringReplace[\nStringReplace[\n\
StringReplace[\nyderivtableofstrings1[[indtbl2]],\n\"{\"->\"[\"],\n\
\"}[\"->\"][\"],\n\" \"->\"\"],\n{indtbl2,1,Length[yderivtableofstrings1]}];\n\
\n",
 StyleBox["(*Each variable needs to be put into the form of an \ninput \
expression which the application can recognize.\nTo accomplish this, add the \
word 'Derivative' in\nfront of the brackets and the string of bracketed\n\
independent variables after the name of the \nindependent variable.*)",
  FontWeight->"Plain"],
 "\nyderivtableofstrings3=Table[\nStringReplace[\n\
yderivtableofstrings2[[indtbl3]],\n\
\"]\"->\"][\"<>indepvariablestring1<>\"]\"],\n\
{indtbl3,1,Length[yderivtableofstrings2]}];\n\n",
 StyleBox["(*Get rid of the extra list of independent variables.*)",
  FontWeight->"Plain"],
 "\nyderivtableofstrings4=Table[\nStringReplace[\n\
yderivtableofstrings3[[indtbl3]],\n\"][\"<>indepvariablestring1<>\"][\"->\"][\
\"],\n{indtbl3,1,Length[yderivtableofstrings2]}];\n\n",
 StyleBox["(*Now add the word 'Derivative' at the front of each \nelement of \
the table.*)",
  FontWeight->"Plain"],
 "\nyderivtableofstrings=Table[\n\
\"Derivative\"<>yderivtableofstrings4[[indtbl3]],\n\
{indtbl3,1,Length[yderivtableofstrings2]}];\n\n",
 StyleBox["(*Join the tables of independent variables, dependent\nvariables \
and derivatives together.*)",
  FontWeight->"Plain"],
 "\nvariablestringtable=Join[\nindepvariablestring,\ndependvariablestring1,\n\
yderivtableofstrings];\n\n",
 StyleBox["(*Produce a version of the table without the independent\n\
variables.*)",
  FontWeight->"Plain"],
 "\nwithoutindvarstringtable=Join[\ndependvariablestring1,\n\
yderivtableofstrings];])\n\
(**********END*OF*FUNCTION*GenerateVariableTable*******)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->{{3.4833078786469927`*^9, 3.483307879347568*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(************BEGINNING*OF*FUNCTION*SecondTerm**********)\n",
 StyleBox["(*This function creates the plocal-th order second \nterm in the \
extended infinitesimal*)",
  FontWeight->"Plain"],
 "\nSecondTerm[numberindependentvars_,numberdependentvars_,yindex_,plocal_,\
rorderofinfinitesimals_,j1_,j2_:0,j3_:0,j4_:0,j5_:0,j6_:0,j7_:0,j8_:0,j9_:0,\
j10_:0,j11_:0,j12_:0,j13_:0,j14_:0]:=\n\n",
 StyleBox["(*The function 'Module' hides the variable names in \nbrackets \
from the rest of the program.*)",
  FontWeight->"Plain"],
 "\n(Module[{indepvariables,dependvariables,derivaar,\nbeta,jindex,ind,j,i},\n\
\n\n",
 StyleBox["(*This generates a string corresponding to the \nindependent \
variables.*)",
  FontWeight->"Plain"],
 "\nindepvariables=StringReplace[\nStringReplace[\nToString[\n\
Table[\"x\"<>ToString[j],{j,1,numberindependentvars}]],\"{\"->\"\"],\"}\"->\"\
\"];\n\n",
 StyleBox["(*Now use '",
  FontWeight->"Plain"],
 "GenerateVariableTable",
 StyleBox["' to create a \ntable of dependent variables with brackets \
containing\nthe independent variables to indicate the \nfunctional dependence \
of the dependent variables.*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars,numberdependentvars,\
rorderofinfinitesimals];\n\n",
 StyleBox["(*This is the table.*)",
  FontWeight->"Plain"],
 "\nwithoutindvarstringtable;\n\n",
 StyleBox["(*Now convert the table to a string.*)",
  FontWeight->"Plain"],
 "\ndependvariables=\" \"<>\nStringReplace[\nStringReplace[\n\
ToString[withoutindvarstringtable],\n\"{\"->\"\"],\"}\"->\"\"];\n\n",
 StyleBox["(*This generates a table of indices corresponding\nto the \
independent variables with respect to which\nthe p-th extension is \
generated.*)",
  FontWeight->"Plain"],
 "\nderivaar=Table[\nToExpression[\"j\"<>ToString[ind]],{ind,1,plocal}];\n\n\
",
 StyleBox["(*Now generate the sum of y's times xse's in the\nsecond term of \
the plocal-th infinitesimal.*)",
  FontWeight->"Plain"],
 "\nApply[\nPlus,\nTable[\nD[ToExpression[\"xse\"<>ToString[beta]<>\n\
\"[\"<>indepvariables<>\",\"<>dependvariables<>\"]\"],\n\
ToExpression[\"x\"<>ToString[derivaar[[plocal]]]]]*\nD[ToExpression[\n\
\"D[y\"<>ToString[yindex]<>\"[\"<>indepvariables<>\"]\"<>\nStringJoin[\n\
Table[\n\", x\"<>ToString[derivaar[[jindex]]],\n\
{jindex,1,plocal-1}]]<>\"]\"],\nToExpression[\"x\"<>ToString[beta]]],\n\
{beta,1,numberindependentvars}]]])\n\
(*****************END*OF*FUNCTION*SecondTerm*********)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->{{3.483363441785419*^9, 3.483363442982726*^9}, {
   3.483363912634837*^9, 3.483363912952457*^9}, {3.4833652194680157`*^9, 
   3.483365251178897*^9}, 3.483365782624271*^9},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(*******BEGINNING*OF*FUNCTION*PthInfinitesimal*******)\n",
 StyleBox["(*This function creates the p-th order extended \ninfinitesimal \
corresponding to the transformation\nof some derivative of the dependent \
variable 'yindex'.*)",
  FontWeight->"Plain"],
 "\nPthInfinitesimal[numberindependentvars_,numberdependentvars_,yindex_,\
porderoftheequation_,rorderofinfinitesimals_,xseon_,j1_,j2_:0,j3_:0,j4_:0,j5_:\
0,j6_:0,j7_:0,j8_:0,j9_:0,j10_:0,j11_:0,j12_:0,j13_:0,j14_:0]:=\n\n",
 StyleBox["(*The function 'Module' hides the variable names in \nbrackets \
from the rest of the program.*)",
  FontWeight->"Plain"],
 "\n(Module[{indepvariables,dependvariables,\n\
firstpthorderterm,pthextendedinfinitesimal,\n\
j,i,pind,plocalind,indepvarindex},\n\n",
 StyleBox["(*This generates a string corresponding to the \nindependent \
variables.*)",
  FontWeight->"Plain"],
 "\nindepvariables=StringReplace[\nStringReplace[\nToString[\n\
Table[\"x\"<>ToString[j],{j,1,numberindependentvars}]],\"{\"->\"\"],\"}\"->\"\
\"];\n\n",
 StyleBox["(*Now use '",
  FontWeight->"Plain"],
 "GenerateVariableTable",
 StyleBox["' to create a \ntable of dependent variables with brackets \
containing\nthe independent variables to indicate the \nfunctional dependence \
of the dependent variables.*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars,numberdependentvars,\
rorderofinfinitesimals];\n\n",
 StyleBox["(*This is the table.*)",
  FontWeight->"Plain"],
 "\nwithoutindvarstringtable;\n\n",
 StyleBox["(*Now convert the table to a string.*)",
  FontWeight->"Plain"],
 "\ndependvariables=\" \"<>\nStringReplace[\nStringReplace[\n\
ToString[withoutindvarstringtable],\n\"{\"->\"\"],\"}\"->\"\"];\n\n",
 StyleBox["(*This nested function is generated by concatenating\na series of \
strings. The function generates the first \nterm in the p-th order \
infinitesimal. The 'If' statement,\ndepending on the value of the parameter \
'xseon', determines \nwhether the infinitesimal transformations of the \n\
independent variables (the xse's) are to be included in \nthe computation.*)",
  
  FontWeight->"Plain"],
 "\nIf[xseon>0,\nfirstpthorderterm=\n\
ToExpression[Table[\"D[\",{pind,1,porderoftheequation}]<>\n\
\"eta\"<>ToString[yindex]<>\n\"[\"<>indepvariables<>\",\"<>\n\
dependvariables<>\"]\"<>\", x\"<>\nToString[j1]<>\"]\"<>\nStringJoin[\nTable[\
\n\"-SecondTerm[\"<>ToString[numberindependentvars]<>\",\"<>ToString[\
numberdependentvars]<>\",\"<>\nToString[yindex]<>\",\"<>ToString[plocalind]<>\
\",\"<>\nToString[rorderofinfinitesimals]<>\",\"<>\n\
StringReplace[StringReplace[\nToString[Table[\"j\"<>ToString[indepvarindex]<>\
\"=\"<>\nToString[ToExpression[\"j\"<>ToString[indepvarindex]]],\n\
{indepvarindex,1,plocalind}]],\n\"{\"->\" \"],\"}\"->\"\"]<>\"], x\"<>\n\
ToString[ToExpression[\"j\"<>ToString[plocalind+1]]]<>\"]\",\n\
{plocalind,1,porderoftheequation-1}]]],\nfirstpthorderterm=\n\
ToExpression[Table[\"D[\",{pind,1,porderoftheequation}]<>\n\
\"eta\"<>ToString[yindex]<>\n\"[\"<>indepvariables<>\",\"<>\n\
dependvariables<>\"]\"<>\", x\"<>\nToString[j1]<>\"]\"<>\nStringJoin[\nTable[\
\", x\"<>ToString[ToExpression[\n\"j\"<>ToString[plocalind+1]]]<>\"]\",\n\
{plocalind,1,porderoftheequation-1}]]]];\n\n",
 StyleBox["(*The expression in the previous step is now added to\nthe second \
expression in the p-th order infinitesimal.\nIf xseon is zero then there is \
no second term.*)",
  FontWeight->"Plain"],
 "\nIf[xseon>0,\npthextendedinfinitesimal=\nExpandAll[firstpthorderterm-\n\
SecondTerm[numberindependentvars,numberdependentvars,yindex,\
porderoftheequation,rorderofinfinitesimals,\nj1,j2,j3,j4,j5,j6,j7,j8,\n\
j9,j10,j11,j12,j13,j14]],\npthextendedinfinitesimal=\n\
ExpandAll[firstpthorderterm]]])\n\
(**********END*OF*FUNCTION*PthInfinitesimal************)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->{{3.4833635179045143`*^9, 3.4833635183044167`*^9}, {
   3.4833639409297123`*^9, 3.483363941321772*^9}, {3.483365299131412*^9, 
   3.483365301977913*^9}, 3.483365793629662*^9, {3.4833667880910597`*^9, 
   3.483366793744459*^9}, {3.4833692242257757`*^9, 3.4833692294230003`*^9}, {
   3.4833695344609547`*^9, 3.4833695599080353`*^9}, {3.4833913703160477`*^9, 
   3.483391398298284*^9}, 3.4833914940126963`*^9},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(**BEGINNING*OF*FUNCTION*GenerateInfinitesimalTable****)\n",
 StyleBox["(*This function generates a table of strings \ncorresponding to \
unevaluated calls to the function\n'",
  FontWeight->"Plain"],
 "PthInfinitesimal",
 StyleBox["'. The indices of derivatives are the\nsame as the indices \
produced by '",
  FontWeight->"Plain"],
 "GenerateVariableTable",
 StyleBox["'.\nThe result is contained in the table \n\
'infinitesimaltableofstringsally'.*)",
  FontWeight->"Plain"],
 "\nGenerateInfinitesimalTable[numberindependentvars_,numberdependentvars_,\
porderoftheequation_,rorderofinfinitesimals_,xseon_]:=\n\n",
 StyleBox["(*The function \"Module\" hides the variable names in \nbrackets \
from the rest of the program.*) ",
  FontWeight->"Plain"],
 "\n(Module[{indepvariablestring,indepvariablestring1,\n\
dependvariablestring,dependvariablestring1,\n\
variabletableofstrings,stringofvariables,\n\
tableofxses,tableofetas,makederivtablestring,\n\
derivindtable,derivindsumtable,postbl,postbllength,\n\
derivativeindextable,pindextable1,pindextable,\n\
pindextableoflengths,pindextableofstrings,\ninfinitesimaltableofstrings,\n\
infinitesimaltableofstringsally,\ni,j,k,jindex,ppndx,pconstruct},\n\n",
 StyleBox["(*Generate a table of independent variables.*)",
  FontWeight->"Plain"],
 "\nindepvariablestring=\n\
Table[\"x\"<>ToString[j],{j,1,numberindependentvars}];\n\n",
 StyleBox["(*Generate a string of independent variables.*)",
  FontWeight->"Plain"],
 "\nindepvariablestring1=\nStringReplace[\nStringReplace[\nToString[Table[\"x\
\"<>ToString[j],{j,1,numberindependentvars}]],\n\"{\"->\"\"],\"}\"->\"\"];\n\n\
",
 StyleBox["(*Now use '",
  FontWeight->"Plain"],
 "GenerateVariableTable",
 StyleBox["' to create a \ntable of dependent variables with brackets \
containing\nthe independent variables to indicate the \nfunctional dependence \
of the dependent variables.*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars,numberdependentvars,\
rorderofinfinitesimals];\n\n",
 StyleBox["(*This is the table.*)",
  FontWeight->"Plain"],
 "\nwithoutindvarstringtable;\n\n",
 StyleBox["(*Equate this table to the table with the name \nused in the next \
command.*)",
  FontWeight->"Plain"],
 "\ndependvariablestring1=withoutindvarstringtable;\n\n",
 StyleBox["(*Generate a string with independent variables\nand dependent \
variables with brackets enclosing \nthe independent variables.*)",
  FontWeight->"Plain"],
 "\nvariabletableofstrings=Join[indepvariablestring,\ndependvariablestring1];\
\n\n",
 StyleBox["(*Generate a string of bracketed independent and\ndependent \
variables.*)",
  FontWeight->"Plain"],
 "\nstringofvariables=StringReplace[StringReplace[\n\
ToString[variabletableofstrings],\n\"{\"->\"[\"],\"}\"->\"]\"];\n\n",
 StyleBox["(*Generate a table of xse's. If 'xseon' is zero \nthen the xse's \
are all set to zero.*)",
  FontWeight->"Plain"],
 "\nIf[xseon>0,\ntableofxses=Table[\"xse\"<>ToString[j]<>stringofvariables,\n\
{j,1,numberindependentvars}],\n\
tableofxses=Table[\"0\",{j,1,numberindependentvars}]];\n\n",
 StyleBox["(*Generate a table of eta's.*)",
  FontWeight->"Plain"],
 "\ntableofetas=Table[\"eta\"<>ToString[i]<>stringofvariables,\n\
{i,1,numberdependentvars}];\n\n",
 StyleBox["(*This step prepares a string which in the next line is\nconverted \
to a function.*)",
  FontWeight->"Plain"],
 "\nmakederivtablestring=\"Table[\"<>\nToString[Table[\"j\"<>ToString[\n\
jindex],{jindex,1,numberindependentvars}]]<>\", \"<>\nStringReplace[\n\
StringReplace[\nToString[\n\
Table[{\"j\"<>ToString[numberindependentvars+1-jindex]<>\",0,\"<>ToString[\
porderoftheequation]},\n\
{jindex,1,numberindependentvars}]],\"{{\"->\"{\"],\"}}\"->\"}\"]<>\"]\";\n\n\
",
 StyleBox["(*This step generates a table of lists of derivative\nindices*)",
  FontWeight->"Plain"],
 "\nderivindtable=\nFlatten[\n\
ToExpression[makederivtablestring],numberindependentvars-1];\n\n",
 StyleBox["(*It is necessary to identify those combinations of\nindices which \
add up to the derivative order, p.\nFirst add together the indices in each \
term. The\nlist is flattened to remove extra brackets and\ncreate a \
one-dimensional list.*)",
  FontWeight->"Plain"],
 "\nderivindsumtable=\nFlatten[\nToExpression[\n\"Table[\"<>\nToString[\n\
Apply[Plus,Table[\"j\"<>ToString[jindex],{jindex,1,numberindependentvars}]]]<>\
\n\", \"<>\nStringReplace[\nStringReplace[\nToString[\n\
Table[{\"j\"<>ToString[jindex]<>\",0,\"<>ToString[porderoftheequation]},\n\
{jindex,1,numberindependentvars}]],\"{{\"->\"{\"],\"}}\"->\"}\"]<>\"]\"],\
numberindependentvars-1];\n\n",
 StyleBox["(*This step identifies the positions of those terms\nwhere the \
indices add up to 1,2,3...,p. These are\nthe terms corresponding to the \
various order\nderivatives. This list is also flattened to make the\nlist \
one-dimensional.*)",
  FontWeight->"Plain"],
 "\npostbl=Flatten[\nTable[\nFlatten[\n\
Position[derivindsumtable,ppndx],1],{ppndx,1,porderoftheequation}],1];\n\n",
 StyleBox["(*The number of terms with the right combinations\nof \
derivatives.*)",
  FontWeight->"Plain"],
 "\npostbllength=Length[postbl];\n\n",
 StyleBox["(*This picks off the needed terms from the rather long\ntable \
produced above.*)",
  FontWeight->"Plain"],
 "\nderivativeindextable=\nTable[derivindtable[[postbl[[i]]]],\n\
{i,1,postbllength}];\n\n",
 StyleBox["(*Each element of the table just generated is itself a\ntable with \
'n' positions with the numbers in each element\nadding up to \
'porderoftheequation'. Now we need to rearrange each element\ninto a table \
with 'porderoftheequation' positions corresponding to the\nindices of the \
independent variables with respect to \nwhich the derivative is being \
taken.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\npindextable1=Table[Table[Table[j,\n\
{i,1,derivativeindextable[[k,j]]}],{j,1,numberindependentvars}],\n\
{k,1,postbllength}];\n\n",
 StyleBox["(*The next step gets rid of empty brackets and \nconsolidates \
terms of the same order in '",
  FontWeight->"Plain"],
 "porderoftheequation",
 StyleBox["'. This\nis the sought after set of derivative indices.*)",
  FontWeight->"Plain"],
 "\npindextable=Table[Flatten[pindextable1[[k]],1],\n{k,1,postbllength}];\n\n",
 StyleBox["(*Make a table with all the lengths at each order '",
  FontWeight->"Plain"],
 "porderoftheequation",
 StyleBox["'.*)",
  FontWeight->"Plain"],
 "\npindextableoflengths=Table[\nLength[pindextable[[k]]],\n\
{k,1,postbllength}];\n\n",
 StyleBox["(*Make a table of strings containing all the derivative\nindex \
assignments.*)",
  FontWeight->"Plain"],
 "\npindextableofstrings=Table[\",\"<>\"j\"<>ToString[\njindex]<>\n\
\"=\"<>ToString[pindextable[[k,jindex]]],\n{k,1,postbllength},\n\
{jindex,1,pindextableoflengths[[k]]}];\n\n",
 StyleBox["(*Now make up a table of calls to the function\n'",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "PthInfinitesimal",
 StyleBox["' with the various parameters set\nexcept for yindex. The use of \
the variable pconstruct prevents the parameter porderoftheequation from being \
changed when the calls to ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "PthInfinitesimal",
 StyleBox["\nare executed later.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninfinitesimaltableofstrings=Table[\n\"PthInfinitesimal\"<>\n\
\"[\"<>\"numberindependentvars=\"<>ToString[numberindependentvars]<>\",\"<>\"\
numberdependentvars=\"<>ToString[numberdependentvars]<>\",\"<>\n\"yindex=\"<>\
\",\"<>\"pconstruct=\"<>ToString[\npindextableoflengths[[k]]]<>\",\"<>\n\
\"rorderofinfinitesimals=\"<>ToString[rorderofinfinitesimals]<>\",\"<>\n\
\"xseon=\"<>ToString[xseon]<>\npindextableofstrings[[k]]<>\"]\",\n\
{k,1,postbllength}];\n\n",
 StyleBox["(*Now repeat the table for various 'yi'.*)",
  FontWeight->"Plain"],
 "\ninfinitesimaltableofstringsally=Flatten[\nTable[\nStringReplace[\n\
infinitesimaltableofstrings[[k]],\n\"yindex=\"->\"yindex=\"<>ToString[i]],\n\
{i,1,numberdependentvars},{k,1,postbllength}],1];\n\n",
 StyleBox["(*Join the tables of xse's, eta's and \n",
  FontWeight->"Plain"],
 "porderoftheequation",
 StyleBox["-th order infinitesimals together.*)",
  FontWeight->"Plain"],
 "\nallpinfinitesimaltableofstrings=Join[\ntableofxses,\ntableofetas,\n\
infinitesimaltableofstringsally];])\n\
(****END*OF*FUNCTION*GenerateInfinitesimalTable****)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->{{3.469460197281373*^9, 3.469460198127453*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(**BEGINNING*OF*FUNCTION*InvarianceConditionNoRules**)\n",
 StyleBox["(*This function generates a table of expressions\ncorresponding to \
the various terms in the raw \ninvariance condition, ie, before rules are \
applied which\nimpose the original equation and its higher order \n\
consequences on the y-derivatives which appear in \nthe invariance \
condition.*)",
  FontWeight->"Plain"],
 "\nInvarianceConditionNoRules[\n\
numberindependentvars_,numberdependentvars_,porderoftheequation_,\
rorderofinfinitesimals_,xseon_,inputequation_]:=\n\n",
 StyleBox["(*The function \"Module\" hides the variable names in \nbrackets \
from the rest of the program.*)",
  FontWeight->"Plain"],
 "\n(Module[{inputequationexpression,allvariablestable,\n\
allvariablestablelength,replacementvariabletable,\n\
tableofrulesstrings,tableofrules,\n\
replacementinputequation,replacementderivativestable,\n\
reversetableofrulesstrings,reversetableofrules,idx,\n\
invarconditiontablelength,masktable,\nfinalinfinitesimaltableofstrings1,\n\
finalinfinitesimaltableofstrings,\nfinalinfinitesimaltable,\n\
finalinvarianceconditiontable,numberofterms,\ninx,ifinally},\n\n",
 StyleBox["(*Convert the string 'inputequation' put in by the user\nto an \
expression.*)",
  FontWeight->"Plain"],
 "\ninputequationexpression=ToExpression[inputequation];\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Start the function \
InvarianceConditionNoRules.\nFirst call the function GenerateVariableTable to \
produce the output \ntable variablestringtable which contains all of the \
possible \nvariables up to derivatives of order porderoftheequation which \n\
could appear in the input equation. The memory in use = ``, The time used = \
``\",MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Call the function '",
  FontWeight->"Plain"],
 "GenerateVariableTable",
 StyleBox["' to produce\nthe output table 'variablestringtable' which \
contains all \nof the possible variables up to derivatives of order '",
  FontWeight->"Plain"],
 "porderoftheequation",
 StyleBox["' \nwhich could appear in the input equation.*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars,numberdependentvars,\
porderoftheequation];\n\n",
 StyleBox["(*Convert the terms in this table to expressions.*)",
  FontWeight->"Plain"],
 "\nallvariablestable=ToExpression[variablestringtable];\n\n",
 StyleBox["(*Find the number of terms in the table.*)",
  FontWeight->"Plain"],
 "\nallvariablestablelength=Length[allvariablestable];\n\n",
 StyleBox["(*In order to produce the invariance condition it is\nnecessary to \
differentiate the input equation with\nrespect to the various variables in \
the problem\nincluding derivatives. But a problem comes up when \n\
differentiating the equation with respect to the\nindependent variables which \
might appear explicitely\nin the equation. The problem is that the operator \
'D'\nis a total differentiation operator and therefore \ndifferentiates with \
respect to 'x' wherever it might \nappear including in the expressions \
indicating the \ndependence of the 'y' variables. To prevent this a \n\
correspondence is made between the variables in the \nproblem and a set of \
replacement variables which \ncan readily be treated as independent. Here a \
table of \nreplacement variables of the required length is\ngenerated.*)",
  FontWeight->"Plain"],
 "\nreplacementvariabletable=Table[\n\
ToExpression[\"replacementvariable\"<>ToString[idx]],\n\
{idx,1,allvariablestablelength}];\n\n",
 StyleBox["(*Using string functions, a table of replacement rules \nfor the \
variables is created.*)",
  FontWeight->"Plain"],
 "\ntableofrulesstrings=Table[\n\
ToString[InputForm[allvariablestable[[idx]]]]<>\n\
\"->\"<>ToString[replacementvariabletable[[idx]]],\n\
{idx,1,allvariablestablelength}];\n\n",
 StyleBox["(*Convert the replacement rules to expressions.*)",
  FontWeight->"Plain"],
 "\ntableofrules=ToExpression[tableofrulesstrings];\n\n",
 StyleBox["(*Use the rules just generated to express the input\nequation in \
terms of the replacement variables.*)",
  FontWeight->"Plain"],
 "\nreplacementinputequation=inputequationexpression/.tableofrules;\n\n",
 StyleBox["(*Create a table of derivatives of the input equation.*)",
  FontWeight->"Plain"],
 "\nreplacementderivativestable=Table[D[replacementinputequation,\n\
ToExpression[\"replacementvariable\"<>ToString[idx]]],\n\
{idx,1,allvariablestablelength}];\n\n",
 StyleBox["(*Now generate a table of rules that reverse the \nassignment of \
variables so that the table of \nderivatives can be expressed in terms of \
conventional\nvariables.*)",
  FontWeight->"Plain"],
 "\nreversetableofrulesstrings=Table[\n\
ToString[replacementvariabletable[[idx]]]<>\n\
\"->\"<>ToString[InputForm[allvariablestable[[idx]]]],\n\
{idx,1,allvariablestablelength}];\n\n",
 StyleBox["(*Convert these reverse replacement rules to expressions.*)",
  FontWeight->"Plain"],
 "\nreversetableofrules=\nToExpression[reversetableofrulesstrings];\n\n",
 StyleBox["(*Now express the table of derivatives of the input \nequation in \
terms of conventional variables.*)",
  FontWeight->"Plain"],
 "\ninvarconditiontable=\nreplacementderivativestable/.reversetableofrules;\n\
\n",
 StyleBox["(*Determine the length of the 'invarconditiontable'.*)",
  FontWeight->"Plain"],
 "\ninvarconditiontablelength=Length[invarconditiontable];\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Call the function GenerateInfinitesimalTable \
to produce\na table of strings called allpinfinitesimaltableofstrings \n\
corresponding to the infinitesimals and extensions. The memory in use = ``, \
The time used = ``\",MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Produce a table of strings corresponding to the\ninfinitesimals \
and extensions. This has the same \nlength as the 'invarconditiontable'.*)",
  FontWeight->"Plain"],
 "\nGenerateInfinitesimalTable[numberindependentvars,numberdependentvars,\
porderoftheequation,rorderofinfinitesimals,xseon];\n\n",
 StyleBox["(*This is the table of infinitesimals and extensions.*)",
  FontWeight->"Plain"],
 "\nallpinfinitesimaltableofstrings;\n\n",
 StyleBox["(*So far the infinitesimals and extensions are in \nthe form of a \
table of strings which need to be converted\nto evaluated functions. But we \
dont want to evaluate all\nthe expressions in the table, only those which \
correspond\nto nonzero terms in the invariance condition. To begin\nthe \
process we create a mask in the form of a table of\nzeros and one's with the \
one's corresponding to the nonzero\nterms in the invariance condition. Note \
the use of\nthe triple equals sign to test equality symbolically.*)",
  FontWeight->"Plain"],
 "\nmasktable=Table[If[invarconditiontable[[inx]]===0,\n\
0,1],{inx,1,invarconditiontablelength}];\n\n",
 StyleBox["(*Now produce a reduced list of infinitesimals \ncorresponding to \
the nonzero terms in the invariance \ncondition.*)",
  FontWeight->"Plain"],
 "\nfinalinfinitesimaltableofstrings1=masktable*\n\
allpinfinitesimaltableofstrings;\n\n",
 StyleBox["(*Convert all terms including the zeros to strings.*)",
  FontWeight->"Plain"],
 "\nfinalinfinitesimaltableofstrings=Table[\n\
ToString[finalinfinitesimaltableofstrings1[[inx]]],\n\
{inx,1,invarconditiontablelength}];\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Convert the required infinitesimal strings to \
expressions. The memory in use = ``, The time used = \
``\",MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Now evaluate the terms in this table.*)",
  FontWeight->"Plain"],
 "\nfinalinfinitesimaltable=Table[ToExpression[\n\
finalinfinitesimaltableofstrings[[inx]]],\n\
{inx,1,invarconditiontablelength}];\n\n",
 StyleBox["(*Here at last is the fully worked out invariance condition\nin \
the form of a table where each term is a fully worked \nout term in the \
invariance condition.*)",
  FontWeight->"Plain"],
 "\nfinalinvarianceconditiontable=finalinfinitesimaltable*\n\
invarconditiontable;\n\n(*",
 StyleBox["(***Print out the status.***)\nPrint[StringForm[\n\"The table \
finalinvarianceconditiontable contains the invariance condition\nin the form \
of a table where each term is a fully worked \nout term in the invariance \
condition. ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["The memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["The time used = ``\",",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Now create a single sum of all these terms.*)",
  FontWeight->"Plain"],
 "\nfinalinvarianceconditionsumnorules=ExpandAll[Apply[Plus,\n\
finalinvarianceconditiontable]];\n\n",
 StyleBox["(*Determine the number of terms in the fully expanded\ninvariance \
condition sum.*)",
  FontWeight->"Plain"],
 "\nnumberofterms=Length[finalinvarianceconditionsumnorules];\n\n",
 StyleBox["(*Finally the sum is sorted into a table of individual\nterms.*)",
  FontWeight->"Plain"],
 "\ntermsoftheInvarianceConditionNoRules=Table[\n\
finalinvarianceconditionsumnorules[[ifinally]],\n\
{ifinally,1,numberofterms}];])\n\
(******END*OF*FUNCTION*InvarianceConditionNoRules*****)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(*********BEGINNING*OF*FUNCTION*MakeRulesArray********)\n",
 StyleBox["(*This function takes one of the equations in 'rulesarray'\ninput \
by the user and generates all the various\nhigher order derivatives of the \
input equation up to\norder ",
  FontWeight->"Plain"],
 StyleBox["'rorder'.",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 StyleBox[" These derivatives are used to \nform an expanded set of rules \
which are appended to the\nset put in by the user. The output of this \
function\nis a table of rules called 'rulesarrayexpanded'.*)",
  FontWeight->"Plain"],
 "\nMakeRulesArray[\n\
numberindependentvars_,numberdependentvars_,mequindexsep98_,\
rorderofinfinitesimals_,rulesarray_]:=\n\n",
 StyleBox["(*The function 'Module' protects certain names from\nthe outside \
world.*)",
  FontWeight->"Plain"],
 "\n(Module[{rulesarraystring,rulesarraystringlength,\n\
arrowposition,righthandterm,lefthandterm,\n\
derivativeindicessofar,derivativeindsstrings,\nlefthandtermderivativetable,\n\
righthandtermderivativetable1,\nrighthandtermderivativetable,\n\
rulesarrayexpandedtableofstrings,\nrulesarrayexpandedtable1,\n\
mequationindexsep98},\n\n",
 StyleBox["(*Generate higher order differential consequences\nfor the mth \
equation*)",
  FontWeight->"Plain"],
 "\nmequationindexsep98=mequindexsep98;\n\n",
 StyleBox["(*Turn the mequindexsep98 rule in 'rulesarray' into a string.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nrulesarraystring=ToString[\n\
InputForm[rulesarray[[mequationindexsep98]]]];\n\n",
 StyleBox["(*Find the number of characters in this string.*)",
  FontWeight->"Plain"],
 "\nrulesarraystringlength=StringLength[rulesarraystring];\n\n",
 StyleBox["(*Locate the positions of the two characters which make up \nthe \
arrow in the rule.*)",
  FontWeight->"Plain"],
 "\narrowposition=Flatten[StringPosition[\nrulesarraystring,\"->\"]];\n\n",
 StyleBox["(*Pick off the right hand term and convert it to an \n\
expression.*)",
  FontWeight->"Plain"],
 "\nrighthandterm=ToExpression[StringTake[\nrulesarraystring,\n\
{arrowposition[[2]]+1,rulesarraystringlength}]];\n\n",
 StyleBox["(*Pick off the left hand term and convert it to an\nexpression.*)",
  
  FontWeight->"Plain"],
 "\nlefthandterm=ToExpression[StringTake[\n\
rulesarraystring,{1,arrowposition[[1]]-1}]];\n\n",
 StyleBox["(*Call this function to generate a table of\nderivative indices up \
to order 'rorderofinfinitesimals'.*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars,numberdependentvars,\
rorderofinfinitesimals];\n\n",
 StyleBox["(*This is the table of derivative indices.*)",
  FontWeight->"Plain"],
 "\nderivativeindextable;\n\n",
 StyleBox["(*This is the number of derivatives of the input \nequation \
required for the selected order, 'rorder', \nof the Lie-Backlund \
transformation being considered.*)",
  FontWeight->"Plain"],
 "\nlengthofderivativeindextable=\nLength[derivativeindextable];\n\n",
 StyleBox["(*Make a table of the independent variables\ncorresponding to the \
derivative indices. In a \nmoment these will be used to construct the\n\
derivative expressions used to differentiate the\nleft and right hand sides \
of the original rule.*)",
  FontWeight->"Plain"],
 "\nderivativeindicessofar=Table[\"x\"<>ToString[jnd],\n\
{ind,1,lengthofderivativeindextable},\n{jnd,1,numberindependentvars},\n\
{k,1,derivativeindextable[[ind,jnd]]}];\n\n",
 StyleBox["(*Convert each outer item in the table to a string.*)",
  FontWeight->"Plain"],
 "\nderivativeindsstrings=Table[ToString[Flatten[\n\
derivativeindicessofar[[ind]]]],\n{ind,1,lengthofderivativeindextable}];\n\n\
",
 StyleBox["(*Now form the derivative expressions operating\non the left hand \
term in the original rule. Note\nthat the derivatives are executed.*)",
  FontWeight->"Plain"],
 "\nlefthandtermderivativetable=Table[ToExpression[\n\
\"D[\"<>ToString[InputForm[lefthandterm]]<>\",\"<>\nStringReplace[\n\
StringReplace[derivativeindsstrings[[ind]],\"{\"->\"\"],\n\
\"}\"->\"\"]<>\"]\"],\n{ind,1,lengthofderivativeindextable}];\n\n",
 StyleBox["(*Now form the derivative expressions operating\non the right hand \
term in the original rule. Note\nthat the derivatives are executed.*)",
  FontWeight->"Plain"],
 "\nrighthandtermderivativetable1=Table[ToExpression[\n\
\"D[\"<>ToString[InputForm[righthandterm]]<>\",\"<>\nStringReplace[\n\
StringReplace[derivativeindsstrings[[ind]],\"{\"->\"\"],\n\
\"}\"->\"\"]<>\"]\"],\n{ind,1,lengthofderivativeindextable}];\n\n",
 StyleBox["(*Make sure the right hand sides are fully expanded.*)",
  FontWeight->"Plain"],
 "\nrighthandtermderivativetable=ExpandAll[\nrighthandtermderivativetable1];\n\
\n",
 StyleBox["(*Now convert the left and right sides to strings\nand combine \
using -> to form the table of rules\nin the form of strings.*)",
  FontWeight->"Plain"],
 "\nrulesarrayexpandedtableofstrings=Table[\nToString[InputForm[\n\
lefthandtermderivativetable[[ind]]]]<>\"->\"<>\n\
ToString[InputForm[righthandtermderivativetable[[ind]]]],\n\
{ind,1,lengthofderivativeindextable}];\n\n",
 StyleBox["(*Convert the strings to expressions.*)",
  FontWeight->"Plain"],
 "\nrulesarrayexpandedtable1=ToExpression[\n\
rulesarrayexpandedtableofstrings];\n\n",
 StyleBox["(*Rules for the differential consequences of the ith equation.\n\
The user can view the additional rules by looking at \n\
rulesarrayexpandedtable1sep98.*)",
  FontWeight->"Plain"],
 "\nrulesarrayexpandedtable1sep98=rulesarrayexpandedtable1;\n\n",
 StyleBox["rulesarrayexpandedtable1sep98check=rulesarrayexpandedtable1sep98;",
  
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Now combine with the original set of rules to make\nthe expanded \
set of rules.*)",
  FontWeight->"Plain"],
 "\nrulesarrayexpanded=\nJoin[rulesarray,rulesarrayexpandedtable1];])\n\
(************END*OF*FUNCTION*MakeRulesArray***********)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(**BEGINNING*OF*FUNCTION*InvarianceConditionRulesApplied**)\n",
 StyleBox["(*This function generates a table of expressions\ncorresponding to \
the terms in the invariance condition\nwith rules applied, ie, after the \
original equation\nand its differential consequences have been applied\nto \
the invariance condition.*)",
  FontWeight->"Plain"],
 "\nInvarianceConditionRulesApplied[\n\
numberindependentvars_,numberdependentvars_,porderoftheequation_,\n\
rorderofinfinitesimals_,xseon_,inputequation_,rulesarray_,internalrules_]:=\n\
\n",
 StyleBox["(*The function \"Module\" hides the variable names in \nbrackets \
from the rest of the program.*)",
  FontWeight->"Plain"],
 "\n(Module[{termsoftheinvarianceconditiontimestwo,\n\
termsoftheinvarianceconditiontimestwolength,\n\
termsoftheinvarianceconditionsplittable,\n\
termsoftheinvarianceconditionsplittablelength,\n\
termsoftheinvarianceconditionsplittablelengths,\n\
termsoftheinvarianceconditionsplittablestrings,\n\
termsoftheinvarianceconditionsplittablestringetaxsegone,\n\
termsetaxsegoneexpressions,\ntermsetaxsegoneexpressionswithrules,\n\
termsetaxsegoneexpressionswithrulesstrings,\n\
termsoftheinvarianceconditionsplittablestringetaxsebackin,\n\
termsoftheinvarianceconditionsplittableexpressetaxsebackin,\n\
invarianceconditiontablerulesapplied,\n\
invarianceconditiontablerulesappliedsum1,\nnumberoftermsinvarsum},\n\n",
 StyleBox["(*Call the function '",
  FontWeight->"Plain"],
 "InvarianceConditionNoRules",
 StyleBox["' to\ngenerate the raw invariance condition.*) ",
  FontWeight->"Plain"],
 "\nInvarianceConditionNoRules[\n\
numberindependentvars,numberdependentvars,porderoftheequation,\
rorderofinfinitesimals,xseon,inputequation];\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"The call to InvarianceConditionNoRules to \
produce a table of the terms that appear in the raw invariance condition is \
complete, the length of termsoftheInvarianceConditionNoRules is = ``, the \
byte count of termsoftheInvarianceConditionNoRules is = ``, the memory in use \
= ``, the time used is = \
``\",Length[termsoftheInvarianceConditionNoRules],ByteCount[\
termsoftheInvarianceConditionNoRules],MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*This is the raw invariance condition in the form\nof a table of \
terms each of which is a product of\ny-derivatives and a derivative of one of \
the unknown\ninfinitesimals. In a few cases the infinitesimal\nderivative \
appears by itself.*)",
  FontWeight->"Plain"],
 "\ntermsoftheInvarianceConditionNoRules;\n\n",
 StyleBox["(*Each term in the invariance condition is a product of \n\
derivatives of the dependent variables multiplied by\na derivative of one of \
the unknown infinitesimals. \nEventually we want to isolate the \
infinitesimals to \nproduce the set of determining conditions. This \
separation\nis accomplished using string matching functions.*)",
  FontWeight->"Plain"],
 "\ntermsoftheinvarianceconditiontimestwo=\n\
2*termsoftheInvarianceConditionNoRules;\n\n",
 StyleBox["(*Find the length of this table.*)",
  FontWeight->"Plain"],
 "\ntermsoftheinvarianceconditiontimestwolength=\n\
Length[termsoftheinvarianceconditiontimestwo];\n\n",
 StyleBox["(*Separate each factor in each expression.*)",
  FontWeight->"Plain"],
 "\ntermsoftheinvarianceconditionsplittable=\n\
Table[Cases[termsoftheinvarianceconditiontimestwo[[\nindx]],x_],\n\
{indx,1,Length[termsoftheinvarianceconditiontimestwo]}];\n\n",
 StyleBox["(*This table should be the same length as\n\
'termsoftheinvarianceconditiontimestwolength'.*)",
  FontWeight->"Plain"],
 "\ntermsoftheinvarianceconditionsplittablelength=Length[\n\
termsoftheinvarianceconditionsplittable];\n\n",
 StyleBox["(*Now make a table of lengths of each individual\nterm in the \
split up invariance condition, ie, the\nnumber of factors in each term.*)",
  FontWeight->"Plain"],
 "\ntermsoftheinvarianceconditionsplittablelengths=Table[\n\
Length[termsoftheinvarianceconditionsplittable[[ind]]],\n\
{ind,1,termsoftheinvarianceconditionsplittablelength}];\n\n",
 StyleBox["(*Create a table of strings corresponding to the terms \nin the \
split table.*)",
  FontWeight->"Plain"],
 "\ntermsoftheinvarianceconditionsplittablestrings=Table[ToString[\n\
InputForm[termsoftheinvarianceconditionsplittable[[ind,jnd]]]],\n\
{ind,1,termsoftheinvarianceconditionsplittablelength},\n\
{jnd,1,termsoftheinvarianceconditionsplittablelengths[[\nind]]}];\n\n",
 StyleBox["(*Create a two-dimensional table where, if an item in the \nsplit \
table matches the strings 'xse' or 'eta' set that \nposition to one.*)",
  FontWeight->"Plain"],
 "\ntermsoftheinvarianceconditionsplittablestringetaxsegone=\n\
Table[If[StringMatchQ[\n\
termsoftheinvarianceconditionsplittablestrings[[ind,jnd]],\n\"*eta*\"]||\n\
StringMatchQ[\ntermsoftheinvarianceconditionsplittablestrings[[ind,jnd]],\n\
\"*xse*\"],\"1\",\n\
termsoftheinvarianceconditionsplittablestrings[[ind,jnd]]],\n\
{ind,1,termsoftheinvarianceconditionsplittablelength},\n{jnd,1,\n\
termsoftheinvarianceconditionsplittablelengths[[ind]]}];\n\n",
 StyleBox["(*Convert the previous table to a table of expressions.*)",
  FontWeight->"Plain"],
 "\ntermsetaxsegoneexpressions=ToExpression[\n\
termsoftheinvarianceconditionsplittablestringetaxsegone];\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Call MakeRulesArray to produce an extended \
table of rules to be applied to the invariance condition for cases with r>0, \
the memory in use = ``, the time used is = ``\",MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\nrulesarraylengthmmax=Length[rulesarray];\n\nIf[rulesarraylengthmmax>=1,\
\nMakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=1,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=1,\n\
rulesarrayvector1=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=1,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1]];\n\n\nIf[rulesarraylengthmmax>=2,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=2,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=2,\n\
rulesarrayvector2=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=2,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2]];\n\n\nIf[rulesarraylengthmmax>=3,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=3,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=3,\n\
rulesarrayvector3=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=3,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3]];\n\n\n\
If[rulesarraylengthmmax>=4,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=4,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=4,\n\
rulesarrayvector4=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=4,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4]];\n\
\n\nIf[rulesarraylengthmmax>=5,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=5,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=5,\n\
rulesarrayvector5=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=5,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5]];\n\n\nIf[rulesarraylengthmmax>=6,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=6,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=6,\n\
rulesarrayvector6=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=6,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6]];\n\n\nIf[rulesarraylengthmmax>=7,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=7,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=7,\n\
rulesarrayvector7=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=7,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7]];\n\n\n\
If[rulesarraylengthmmax>=8,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=8,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=8,\n\
rulesarrayvector8=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=8,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8]];\n\
\n\nIf[rulesarraylengthmmax>=9,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=9,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=9,\n\
rulesarrayvector9=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=9,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9]];\n\n\nIf[rulesarraylengthmmax>=10,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=10,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=10,\n\
rulesarrayvector10=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=10,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9,rulesarrayvector10]];\n\n\nIf[rulesarraylengthmmax>=11,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=11,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=11,\n\
rulesarrayvector11=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=11,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9,rulesarrayvector10,\nrulesarrayvector11]];\n\n\n\
If[rulesarraylengthmmax>=12,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=12,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=12,\n\
rulesarrayvector12=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=12,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9,rulesarrayvector10,\n\
rulesarrayvector11,rulesarrayvector12]];\n\nIf[rulesarraylengthmmax>=13,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=13,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=13,\n\
rulesarrayvector13=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=13,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9,rulesarrayvector10,\nrulesarrayvector11,rulesarrayvector12,\
\nrulesarrayvector13]];\n\nIf[rulesarraylengthmmax>=14,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=14,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=14,\n\
rulesarrayvector14=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=14,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9,rulesarrayvector10,\nrulesarrayvector11,rulesarrayvector12,\
\nrulesarrayvector13,rulesarrayvector14]];\n\nIf[rulesarraylengthmmax>=15,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=15,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=15,\n\
rulesarrayvector15=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=15,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9,rulesarrayvector10,\nrulesarrayvector11,rulesarrayvector12,\
\nrulesarrayvector13,rulesarrayvector14,\nrulesarrayvector15]];\n\n\
If[rulesarraylengthmmax>=16,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=16,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=16,\n\
rulesarrayvector16=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=16,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9,rulesarrayvector10,\nrulesarrayvector11,rulesarrayvector12,\
\nrulesarrayvector13,rulesarrayvector14,\n\
rulesarrayvector15,rulesarrayvector16]];\n\nIf[rulesarraylengthmmax>=17,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=17,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=17,\n\
rulesarrayvector17=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=17,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9,rulesarrayvector10,\nrulesarrayvector11,rulesarrayvector12,\
\nrulesarrayvector13,rulesarrayvector14,\n\
rulesarrayvector15,rulesarrayvector16,\nrulesarrayvector17]];\n\n\
If[rulesarraylengthmmax>=18,\n\
MakeRulesArray[numberindependentvars,numberdependentvars,mequindexsep98=18,\
rorderofinfinitesimals,rulesarray]];\n\nIf[rulesarraylengthmmax>=18,\n\
rulesarrayvector18=\nrulesarrayexpandedtable1sep98];\n\n\
If[rulesarraylengthmmax>=18,\nrulesarraysep98expanded1=Join[\nrulesarray,\n\
rulesarrayvector1,rulesarrayvector2,\nrulesarrayvector3,rulesarrayvector4,\n\
rulesarrayvector5,rulesarrayvector6,\nrulesarrayvector7,rulesarrayvector8,\n\
rulesarrayvector9,rulesarrayvector10,\nrulesarrayvector11,rulesarrayvector12,\
\nrulesarrayvector13,rulesarrayvector14,\n\
rulesarrayvector15,rulesarrayvector16,\n\
rulesarrayvector17,rulesarrayvector18]];\n\n\
rulesarrayexpanded=rulesarraysep98expanded1;\n\n",
 StyleBox["rulesarrayexpandedcheck=rulesarrayexpanded;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"The generation of an extended array of rules \
is complete. \nApply the rules in 'rulesarrayout' to each expression in the \
modified invariance \ncondition. The condition has been modified to avoid \
applying the rules to the \nindependent variables which the infinitesimals \
depend on. The memory in use = ``, The time used is = \
``\",MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Apply the rules in 'rulesarrayout' to each expression in\nthe \
modified invariance condition. The condition has been \nmodified to avoid \
applying the rules to the independent \nvariables which the infinitesimals \
depend on.*)",
  FontWeight->"Plain"],
 "\nIf[internalrules==1,\ntermsetaxsegoneexpressionswithrules=\n\
termsetaxsegoneexpressions//.rulesarrayexpanded,\n\
termsetaxsegoneexpressionswithrules=\n\
termsetaxsegoneexpressions//.rulesarray];\n\n",
 StyleBox["(*Produce a corresponding table of strings.*)",
  FontWeight->"Plain"],
 "\ntermsetaxsegoneexpressionswithrulesstrings=Table[\n\
ToString[InputForm[termsetaxsegoneexpressionswithrules[[\nind,jnd]]]],\n\
{ind,1,termsoftheinvarianceconditionsplittablelength},\n{jnd,1,\n\
termsoftheinvarianceconditionsplittablelengths[[ind]]}];\n\n",
 StyleBox["(*Put xse's and eta's back in.*)",
  FontWeight->"Plain"],
 "\ntermsoftheinvarianceconditionsplittablestringetaxsebackin=\n\
Table[If[StringMatchQ[\n\
termsoftheinvarianceconditionsplittablestrings[[ind,jnd]],\n\"*eta*\"]||\n\
StringMatchQ[\ntermsoftheinvarianceconditionsplittablestrings[[ind,jnd]],\n\
\"*xse*\"],\ntermsoftheinvarianceconditionsplittablestrings[[ind,jnd]],\n\
termsetaxsegoneexpressionswithrulesstrings[[ind,jnd]]],\n\
{ind,1,termsoftheinvarianceconditionsplittablelength},\n{jnd,1,\n\
termsoftheinvarianceconditionsplittablelengths[[ind]]}];\n\n",
 StyleBox["(*Now recreate the invariance condition with rules applied.*)",
  FontWeight->"Plain"],
 "\ntermsoftheinvarianceconditionsplittableexpressetaxsebackin=\n\
ToExpression[\ntermsoftheinvarianceconditionsplittablestringetaxsebackin];\n\n\
",
 StyleBox["(*Multiply the factors in each term back together.*)",
  FontWeight->"Plain"],
 "\ninvarianceconditiontablerulesapplied=Table[\nApply[Times,\n\
termsoftheinvarianceconditionsplittableexpressetaxsebackin[[\nind]]],\n\
{ind,1,termsoftheinvarianceconditionsplittablelength}];\n\n",
 StyleBox["(*Here is the invariance condition with rules applied in \nthe \
form of a fully expanded sum.Note the factor of 2\nmultiplying each term.*)",
  FontWeight->"Plain"],
 "\ninvarianceconditiontablerulesappliedsum1=\nExpandAll[Apply[Plus,\n\
invarianceconditiontablerulesapplied]];\n\n",
 StyleBox["(*The actual invariance condition sum \nwithout the factor of \
two.*)",
  FontWeight->"Plain"],
 "\ninvarianceconditiontablerulesappliedsum=\n\
(1/2)*invarianceconditiontablerulesappliedsum1;\n\n",
 StyleBox["(*The number of terms in the sum.*)",
  FontWeight->"Plain"],
 "\nnumberoftermsinvarsum=Length[\ninvarianceconditiontablerulesappliedsum1];\
\n\n",
 StyleBox["(*Here is the invariance condition with rules applied \nsorted \
into a table of terms.*)",
  FontWeight->"Plain"],
 "\ntermsoftheInvarianceConditionRulesApplied1=Table[\n\
invarianceconditiontablerulesappliedsum1[[ind]],\n\
{ind,1,numberoftermsinvarsum}];\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Here is the invariance condition with rules \
applied sorted into a table of terms \ncalled \
termsoftheInvarianceConditionRulesApplied1.The length of \
termsoftheInvarianceConditionRulesApplied1 = ``, The byte count of \
termsoftheInvarianceConditionRulesApplied1 = ``, the memory in use = ``, the \
time used = \
``\",Length[termsoftheInvarianceConditionRulesApplied1],ByteCount[\
termsoftheInvarianceConditionRulesApplied1],MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*The actual invariance condition table, \nwithout the factor of \
two.*)",
  FontWeight->"Plain"],
 "\ntermsoftheInvarianceConditionRulesApplied=\n\
(1/2)*termsoftheInvarianceConditionRulesApplied1;\n\n",
 StyleBox["(*This command was added on May 20, 2010. I ran into an odd \
situation looking for the symmetries of Maxwell's equations with currents and \
charges where the choice of j1 for a user variable name caused problems. The \
problem is that by the end of this function j1 has been assigned the value 1. \
This caused the j1 to be replaced by 1 in several places in particular the \
list ztableofrules. Clearing all j's at this point prevents the problem.*)",
  FontWeight->"Plain"],
 "\n",
 StyleBox["Clear[\"j*\"];",
  FontColor->RGBColor[1, 0, 0]],
 "])\n(*****END*OF*FUNCTION*InvarianceConditionRulesApplied********)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->{{3.4833916281720543`*^9, 3.483391645876363*^9}, {
  3.483392306566474*^9, 3.483392577698874*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(****BEGINNING*OF*FUNCTION*FindDeterminingEquations*******)\n",
 StyleBox["(*This function generates a table of expressions\ncorresponding to \
the determining equations of the group.*)",
  FontWeight->"Plain"],
 "\nFindDeterminingEquations[\n\
independentvariablesstrings_,dependentvariablesstrings_,frozenstrings_,\
porderoftheequation_,\n\
rorderofinfinitesimals_,xseon_,inputequationuservariables_,\
rulesarrayuservariables_,internalrules_]:=\n\n",
 StyleBox["(*The function \"Module\" hides the variable names in \nbrackets \
from the rest of the program.*)",
  FontWeight->"Plain"],
 "\n(Module[{termsoftheInvarianceConditionRulesApplied1length,\n\
termsoftheInvarianceConditionRulesApplied1splittable,\n\
variablestringtable1,infinitesimalindependentvariables,\n\
variablestringtable2,allvariables,freeyderivativevariables,\n\
freeyderivativevariableslength,freeyderivativevariablesstrings,\n\
lengthterms1table,ind,\n\
termsoftheInvarianceConditionRulesApplied1splittablestrings,\n\
truthtablefreevariables,truthtablenumbers,\n\
freevariablelocations,freeyderivativetable,\n\
infinitesimaltermtable1,infinitesimalproducttable,\n\
ytermstablngth,ytermsmatchtable,ytermsmatchtableoflengths,\n\
infinitesimaltablesums,",
 StyleBox["infinitesimaltablesumsunion",
  FontColor->RGBColor[0, 0, 1]],
 ",infinitesimaltablesumsmatchtbl,\n\
infinitesimaltablesumsmatchtblfirstindices,\nfinalinfinitesimalsumindices,\n\
determiningequationstable1,",
 StyleBox["arethetwosetsofdetermningequationsthesame",
  FontColor->RGBColor[0, 0, 1]],
 ",\ninfinitesimalindepvariabletable,\ninfinitesimalindepvariabletablelength,\
\ndummyvariabletable,\ndummyvariabletableofrulesstrings,\n\
xseclearstring1,xseclearstring,\n\
etaclearstring1,etaclearstring,determiningequations,\n\
zdeterminingequationstable,\nzdeterminingequationstablelengthof,\n\
determiningequationstable,\ndeterminingequationstablelengthof,\n\
zdeterminingequationstableofstrings,\n\
determiningequationstableofstrings,numberindependentvars,numberdependentvars,\
\nfrozenstringslength,inputequationindependentvariablerules,\n\
inputequationdependentvariablerules,inputequationvariablerules,\n\
frozenstringsnewsymbols,frozenstringrules,\n\
inputequationbeforefrozenstrings,inputequation,\n\
rulesarraybeforefrozenstrings,\n\
rulesarraystrings,rulesarray,ztableofrulesxytoz,\n\
independentvariables,dependentvariables,\n\
dummyvariabletableofrulesstringsztoxy,\n\
dummyvariabletableofrulesstringsxytoinput,\n\
inputequationdependentvariablerulesytoinput,\n\
inputequationindependentvariablerulesxtoinput,\n\
inputequationvariablerulesxytoinput,\n\
inputequationvariablerulesxytoinputreverse},\n\n",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"The function FindDetermining Equations has \
begun, the memory in use = ``, the time used = \
``\",MemoryInUse[],TimeUsed[]]];",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["Print[StringForm[\"The list of independent variables = \
``\",independentvariablesstrings]];*)\n\n(*Print[StringForm[\"The list of \
dependent variables = ``\",dependentvariablesstrings]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Convert the list of independent variables to an expression*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nindependentvariables=ToExpression[independentvariablesstrings];",
 StyleBox["\n\n(*Print[StringForm[\"The list of independent variables = \
``\",independentvariables]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Convert the list of dependent variables to an expression*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ndependentvariables=ToExpression[dependentvariablesstrings];\n\n(*",
 StyleBox["Print[StringForm[\"The list of dependent variables = \
``\",dependentvariables]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*How many independentvariables are there?*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nnumberindependentvars=Length[independentvariables];\n\n",
 StyleBox["(*How many dependentvariables are there?*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nnumberdependentvars=Length[dependentvariables];\n\n(*",
 StyleBox["Print[StringForm[\"The list of frozen variables = \
``\",frozenstrings]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*How many frozenstrings (function and/or constant names) appear \
in the equations?*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nfrozenstringslength=Length[frozenstrings];\n\n(*",
 StyleBox["Print[StringForm[\"The number of frozen strings = \
``\",frozenstringslength]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Construct a set of rules for converting the input independent \
variables\nto generic variables, x1, x2, x3,...,xn.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninputequationindependentvariablerules=\nTable[ToString[\n\
independentvariables[[jjnd]]]->\"x\"<>ToString[jjnd],{jjnd,1,\
numberindependentvars}];\n\n(*",
 StyleBox["Print[StringForm[\"The rules for converting input independent \
variables = ``\",inputequationindependentvariablerules]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Construct a set of rules for converting the input dependent \
variables\nto generic variables, y1, y2, y3,...,ym.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninputequationdependentvariablerules=\nTable[ToString[\n\
dependentvariables[[iind]]]->\"y\"<>ToString[iind],{iind,1,\
numberdependentvars}];\n\n(*",
 StyleBox["Print[StringForm[\"The rules for converting input dependent \
variables = ``\",inputequationdependentvariablerules]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Join these two sets of rules.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninputequationvariablerules=\nJoin[inputequationindependentvariablerules,\n\
inputequationdependentvariablerules];\n\n(*",
 StyleBox["Print[StringForm[\"The joined rules for converting input variables \
= ``\",inputequationvariablerules]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Convert the input frozenstrings to strings in case the user \
fails to \nenter these as strings. The reason the table of frozenstrings is \
required \nis that when the user defined variables are converted to generic \
variables, \npieces of function or constant names may also be converted \nif \
the characters happen to be common to the two names. Here a table of \
incorrect parameter names is actually created.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nfrozenstringsnewsymbols=\n\
StringReplace[frozenstrings,inputequationvariablerules];\n\n\n(*",
 StyleBox["Print[StringForm[\"The table of incorrect parameter names = \
``\",frozenstringsnewsymbols]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*This command sets up a table of rules converting incorrect \n\
parameter names to correct ones.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nfrozenstringrules=\n\
Table[frozenstringsnewsymbols[[kknd]]->ToString[frozenstrings[[kknd]]],{kknd,\
1,frozenstringslength}];\n\n(*",
 StyleBox["Print[StringForm[\"The table of correct parameter names = \
``\",frozenstringrules]];*)\n\n(*Print[StringForm[\"Input equation in user \
variable names, inputequationuservariables = \
``\",inputequationuservariables]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Now change input user variable names to generic names.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninputequationbeforefrozenstrings=\n\
StringReplace[inputequationuservariables,inputequationvariablerules];\n\n(*",
 StyleBox["Print[StringForm[\"Variable names converted to generic names, \
inputequationbeforefrozenstrings = ``\",inputequationbeforefrozenstrings]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Correct any errors that may have been created in the parameter \
names. \nThis is the input equation in string form and in terms of generic \
variable \nnames that is now used throughout the program.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninputequation=\n\
StringReplace[inputequationbeforefrozenstrings,frozenstringrules];\n\n(*",
 StyleBox["Print[StringForm[\"Variable names converted to generic names, \
final input equation in generic variables = ``\",inputequation]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Be able to look at the equation in generic variables*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nequationgenericvariables=inputequation;\n\n(*",
 StyleBox["Print[StringForm[\"The input equation in generic variables = \
``\",equationgenericvariables]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*The same replacement of user defined names needs to be carried \n\
out in the table of rules input by the user.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nrulesarraybeforefrozenstrings=\n\
StringReplace[rulesarrayuservariables,inputequationvariablerules];\n\n",
 StyleBox["(*Similarly errors produced in the parameter names by the \
replacement\nprocess need to be corrected.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nrulesarraystrings=\n\
StringReplace[rulesarraybeforefrozenstrings,frozenstringrules];\n\n",
 StyleBox["(*Convert the rules put in by the user as strings to expressions\n\
that will be used by the program.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nrulesarray=ToExpression[rulesarraystrings];\n\n",
 StyleBox["(*Clear the variable names for the 'xse' infinitesimals.First \
construct\na table of strings with the infinitesimal names.*)",
  FontWeight->"Plain"],
 "\nxseclearstring1=Table[\"xse\"<>ToString[j],{j,1,numberindependentvars}];\n\
\n",
 StyleBox["(*Remove the curly brackets.*)",
  FontWeight->"Plain"],
 "\nxseclearstring=StringReplace[StringReplace[\n\
ToString[xseclearstring1],\"{\"->\"\"],\"}\"->\"\"];\n\n",
 StyleBox["(*Now clear the 'xse' variable names.*)",
  FontWeight->"Plain"],
 "\nToExpression[\"ClearAll[\"<>xseclearstring<>\"]\"];\n\n",
 StyleBox["(*Clear the variable names for the 'eta' infinitesimals.First \
construct\na table of strings with the infinitesimal names.*)",
  FontWeight->"Plain"],
 "\netaclearstring1=Table[\"eta\"<>ToString[i],{i,1,numberdependentvars}];\n\n\
",
 StyleBox["(*Remove the curly brackets.*)",
  FontWeight->"Plain"],
 "\netaclearstring=StringReplace[StringReplace[\n\
ToString[etaclearstring1],\"{\"->\"\"],\"}\"->\"\"];\n\n",
 StyleBox["(*Now clear the 'eta' variable names.*)",
  FontWeight->"Plain"],
 "\nToExpression[\"ClearAll[\"<>etaclearstring<>\"]\"];\n\n(*",
 StyleBox["Print[StringForm[\"firstj1 = ``\",j1]];*)",
  FontColor->RGBColor[0, 1, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Now call the the function \
InvarianceConditionRulesApplied, the memory in use = ``, the time used = \
``\",MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Call the function '",
  FontWeight->"Plain"],
 "InvarianceConditionRulesApplied",
 StyleBox["' to\nproduce a table of terms of the invariance condition. Note\n\
that each term has a factor of 2 out in front. This is so\nthat the function \
'Cases' will properly split each term\ninto a table of factors. Otherwise \
terms that happen not\nto have a multiplying factor out in front get \
separated at\ntoo low a level. For example y1[x1,x2] would be split into\n\
{y1,[x1,x2]}. Whereas 2*y1[x1,x2] would be split up as\n{2,y1[x1,x2]} which \
is what is wanted.*)",
  FontWeight->"Plain"],
 "\nInvarianceConditionRulesApplied[\n\
numberindependentvars,numberdependentvars,porderoftheequation,\
rorderofinfinitesimals,xseon,inputequation,rulesarray,internalrules];\n\n(*",
 StyleBox["Print[StringForm[\"firstAj1 = ``\",j1]];*)",
  FontColor->RGBColor[0, 1, 0]],
 "\n\n",
 StyleBox["(*The invariance condition with rules applied \nsorted into a \
table of terms, with the factor of two.*)",
  FontWeight->"Plain"],
 "\ntermsoftheInvarianceConditionRulesApplied1;\n\n",
 StyleBox["termsoftheInvarianceConditionRulesApplied1check=\
termsoftheInvarianceConditionRulesApplied1;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*This comment was added Dec 9, 2009.*)",
  FontWeight->"Plain"],
 "\n",
 StyleBox["(**On December 5, 2009 I got an e-mail pointing out that the \
package fails to find the symmetries of the equation\n\
Ut+k*x^2*Uxx*Ux^2/(Ux-c*x*Uxx)^2=0. After examining this case it quickly \
became clear that package is not finding the proper set of determining \
equations when the rule(s) applied to the invariance condition contain \
derivatives in the denominator. When the rule \
Ut->-k*x^2*Uxx*Ux^2/(Ux-c*x*Uxx)^2 is inserted into the invariance condition \
there will of course be quite a few terms that will be in the form of \
fractions with various powers of (Ux-c*x*Uxx)^2 in the denominator. In order \
to generate the proper invariance condition is is necessary to put the entire \
invariance condition with rules applied over a common denominator and then \
remove the denominator. This is now done as follows.\nTwo lines after the \
Call to the function InvarianceConditionRulesApplied I do the following.\n\
step 1 - note that the variable termsoftheInvarianceConditionRulesApplied is \
a list containing all the various terms of the invariance condition with \
rules applied and if the rules involve any denominators some or all of these \
terms will have denominators that have to be removed\nstep 2 - Use \
Apply[Plus,termsoftheInvarianceConditionRulesApplied1] to form the sum of \
these terms\nstep 3 - Use \
Together[Apply[Plus,termsoftheInvarianceConditionRulesApplied1]] to put the \
whole sum over a common denominator\nstep 4 - Use \
Numerator[Together[Apply[Plus,termsoftheInvarianceConditionRulesApplied1]]] \
to remove the denominator. The result has a 2 out in front of everything and \
this needs to be brought inside.\nstep 5 - Use \
Expand[Numerator[Together[Apply[Plus,\
termsoftheInvarianceConditionRulesApplied1]]]] to bring the 2 inside. This \
gets rid if the braces around the invariance condition.\nstep 6 - Use \
Apply[List,Expand[Numerator[Together[Apply[Plus,\
termsoftheInvarianceConditionRulesApplied1]]]]] to convert the sum to a list \
of individual terms. Call this list \
termsoftheInvarianceConditionRulesApplied1nodenominator. Allthis is done \
using the single command given in step 6. Finally if the original invariance \
condition with rules applied, termsoftheInvarianceConditionRulesApplied1, has \
no denominators it is already correct and this process will leave the \
invariance conditioned unchanged.**)\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*This line was added Dec 9, 2009.*)",
  FontWeight->"Plain"],
 StyleBox["\n",
  FontColor->RGBColor[1, 0, 1]],
 "termsoftheInvarianceConditionRulesApplied1",
 StyleBox["nodenominator",
  FontColor->RGBColor[1, 0, 1]],
 " = Apply[List, Expand[Numerator[Together[Apply[Plus, \
termsoftheInvarianceConditionRulesApplied1]]]]];\n\n",
 StyleBox["(*Number of terms in this table. This line was modified Dec 9, \
2009.*)",
  FontWeight->"Plain"],
 "\ntermsoftheInvarianceConditionRulesApplied1length=Length[\n\
termsoftheInvarianceConditionRulesApplied1",
 StyleBox["nodenominator",
  FontColor->RGBColor[1, 0, 1]],
 "];\n\n(*",
 StyleBox["(***Print out the status. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["This line was modified Dec 9, 2009.",
  FontWeight->"Plain"],
 StyleBox["***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"The call to InvarianceConditionRulesApplied \
to produce a table of the terms that appear in the invariance condition is \
complete, the length of termsoftheInvarianceConditionRulesApplied1",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["nodenominator",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox[" = ``, the bytecount of termsoftheInvarianceConditionRulesApplied1",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["nodenominator",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox[" = ``, the memory in use = ``, the time used = \
``\",Length[termsoftheInvarianceConditionRulesApplied1",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["nodenominator",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["],ByteCount[termsoftheInvarianceConditionRulesApplied1",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["nodenominator",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["],MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Split each term into a table of factors. This line was modified \
Dec 9, 2009.*)",
  FontWeight->"Plain"],
 "\ntermsoftheInvarianceConditionRulesApplied1splittable=\nTable[Cases[\n\
termsoftheInvarianceConditionRulesApplied1",
 StyleBox["nodenominator",
  FontColor->RGBColor[1, 0, 1]],
 "[[indx]],x_],\n{indx,1,\n\
termsoftheInvarianceConditionRulesApplied1length}];\n\n",
 StyleBox["termsoftheInvarianceConditionRulesApplied1splittablecheck=\
termsoftheInvarianceConditionRulesApplied1splittable;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Now generate a table of the independent\nvariables upon which \
the infinitesimals are\nassumed to depend.*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars,numberdependentvars,\
rorderofinfinitesimals];\n\n",
 StyleBox["(*This is the result in the form of a table of strings.*)",
  FontWeight->"Plain"],
 "\nvariablestringtable1=variablestringtable;\n\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"The call to GenerateVariableTable to \
regenerate a table of the variables upon which the infinitesimals are assumed \
to depend is complete, the length of variablestringtable1 is = ``, the byte \
count of variablestringtable1 is = ``, the memory in use = ``, the time used \
= ``\",Length[variablestringtable1],ByteCount[variablestringtable1],\
MemoryInUse[],TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Convert each item to an expression.*)",
  FontWeight->"Plain"],
 "\ninfinitesimalindependentvariables=ToExpression[\nvariablestringtable1];\n\
\n",
 StyleBox["(*Now generate a table of all the y-derivatives \nthat can appear \
in the problem.*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars,numberdependentvars,\
rorderofinfinitesimals+porderoftheequation];\n\n",
 StyleBox["(*This is the resulting table.*)",
  FontWeight->"Plain"],
 "\nvariablestringtable2=variablestringtable;\n\n",
 StyleBox["variablestringtable2check=variablestringtable2;\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"The call to GenerateVariableTable to \
regenerate a table of y-derivatives that can appear in the problem is \
complete, the length of variablestringtable2 is = ``, the byte count of \
variablestringtable2 is = ``, the memory in use = ``, the time used = \
``\",Length[variablestringtable2],ByteCount[variablestringtable2],MemoryInUse[\
],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Convert to a table of expressions.*)",
  FontWeight->"Plain"],
 "\nallvariables=ToExpression[\nvariablestringtable2];\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 1, the length of allvariables = ``, the \
byte count of allvariables = ``, the memory in use = ``, the time used = \
``\",Length[allvariables],ByteCount[allvariables],MemoryInUse[],TimeUsed[]]];*\
)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Make a table of the y-derivatives which are free \n\
variables.These are the y-derivatives which the \ninfinitesimals don't depend \
on.*)",
  FontWeight->"Plain"],
 "\nfreeyderivativevariables=Complement[\n\
allvariables,infinitesimalindependentvariables];\n\n",
 StyleBox["freeyderivativevariablescheck=freeyderivativevariables;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["\nPrint[StringForm[\n\"Check 2, the length of \
freeyderivativevariables is = ``, the bytecount of freeyderivativevariables \
is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[freeyderivativevariables],ByteCount[freeyderivativevariables],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)\n",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*The number of items in this table.*)",
  FontWeight->"Plain"],
 "\nfreeyderivativevariableslength=\nLength[freeyderivativevariables];\n\n",
 StyleBox["(*Convert the list of free variables to a list of strings.*)",
  FontWeight->"Plain"],
 "\nfreeyderivativevariablesstrings=\n\
Table[ToString[InputForm[freeyderivativevariables[[knd]]]],\n\
{knd,1,freeyderivativevariableslength}];\n\n(*",
 StyleBox["(***Print out the status.***)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["\n",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 3, the length of \
freeyderivativevariablesstrings is = ``, the byte count of \
freeyderivativevariablesstrings is = ``, the memory in use = ``, the time \
used = ``\",Length[freeyderivativevariablesstrings],ByteCount[\
freeyderivativevariablesstrings],MemoryInUse[],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Make a table of the number of factors in each term of\nthe \
invariance condition with rules applied.*)",
  FontWeight->"Plain"],
 "\nlengthterms1table=Table[Length[\n\
termsoftheInvarianceConditionRulesApplied1splittable[[ind]]],\n{ind,1,\n\
termsoftheInvarianceConditionRulesApplied1length}];\n\n",
 StyleBox["lengthterms1tablecheck=lengthterms1table;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 4, the length of lengthterms1table is = \
``, the byte count of lengthterms1table is = ``, the memory in use = ``, the \
time used = \
``\",Length[lengthterms1table],ByteCount[lengthterms1table],MemoryInUse[],\
TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Convert the table of invariance condition term factors to\na \
table of strings.*)",
  FontWeight->"Plain"],
 "\ntermsoftheInvarianceConditionRulesApplied1splittablestrings=\n\
Table[ToString[InputForm[\n\
termsoftheInvarianceConditionRulesApplied1splittable[[\nind,jnd]]]],\n{ind,1,\
\ntermsoftheInvarianceConditionRulesApplied1length},\n\
{jnd,1,lengthterms1table[[ind]]}];\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 5, the length of \
termsoftheInvarianceConditionRulesApplied1splittablestrings is = ``, the byte \
count of termsoftheInvarianceConditionRulesApplied1splittablestrings is = ``, \
",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[termsoftheInvarianceConditionRulesApplied1splittablestrings],\
ByteCount[termsoftheInvarianceConditionRulesApplied1splittablestrings],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Now create a three dimensional true-false table matching each\n\
term in the table of invariance condition factors with each term\nin the \
table of free y-derivative variables.*)",
  FontWeight->"Plain"],
 "\ntruthtablefreevariables=Table[StringMatchQ[\n\
termsoftheInvarianceConditionRulesApplied1splittablestrings[[\nind,jnd]],\n\
\"*\"<>freeyderivativevariablesstrings[[knd]]<>\"*\"],\n{ind,1,\n\
termsoftheInvarianceConditionRulesApplied1length},\n\
{jnd,1,lengthterms1table[[ind]]},\n{knd,1,freeyderivativevariableslength}];\n\
\n",
 StyleBox["truthtablefreevariablescheck=truthtablefreevariables;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 6, the length of \
truthtablefreevariables is = ``, the length of truthtablefreevariables is = \
``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[truthtablefreevariables],ByteCount[truthtablefreevariables],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)\n",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Convert this table to one's and zero's with one\ncorresponding \
to 'True'.*)",
  FontWeight->"Plain"],
 "\ntruthtablenumbers=Table[\nIf[truthtablefreevariables[[ind,jnd,knd]],1,0],\
\n{ind,1,\ntermsoftheInvarianceConditionRulesApplied1length},\n\
{jnd,1,lengthterms1table[[ind]]},\n{knd,1,freeyderivativevariableslength}];\n\
\n",
 StyleBox["truthtablenumberscheck=truthtablenumbers;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 7, the length of truthtablenumbers is = \
``, the byte count of truthtablenumbers is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[truthtablenumbers],ByteCount[truthtablenumbers],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Now sum this three-dimensional table over the depth \nof the \
number of free derivative terms. This puts a\none at each position of the \
invariance condition \ncorresponding to any of the free derivative terms.*)",
  FontWeight->"Plain"],
 "\nfreevariablelocations=\nTable[Apply[Plus,truthtablenumbers[[ind,jnd]]],\n\
{ind,1,\ntermsoftheInvarianceConditionRulesApplied1length},\n\
{jnd,1,lengthterms1table[[ind]]}];\n\n",
 StyleBox["freevariablelocationscheck=freevariablelocations;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 8, the length of freevariablelocations \
is = ``, the byte count of freevariablelocations is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[freevariablelocations],ByteCount[freevariablelocations],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Now split the table of invariance condition terms into \ntwo \
tables. First the table of free y-derivative terms.*)",
  FontWeight->"Plain"],
 "\nfreeyderivativetable=Table[\nIf[freevariablelocations[[ind,jnd]]==1,\n\
termsoftheInvarianceConditionRulesApplied1splittable[[\nind,jnd]],\n\
1],{ind,1,\ntermsoftheInvarianceConditionRulesApplied1length},\n\
{jnd,1,lengthterms1table[[ind]]}];\n\n",
 StyleBox["freeyderivativetablecheck=freeyderivativetable;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 9, the length of freeyderivativetable \
is = ``, the byte count of freeyderivativetable is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[freeyderivativetable],ByteCount[freeyderivativetable],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Second the table of infinitesimal terms.*)",
  FontWeight->"Plain"],
 "\ninfinitesimaltermtable1=Table[\nIf[freevariablelocations[[ind,jnd]]==0,\n\
termsoftheInvarianceConditionRulesApplied1splittable[[\nind,jnd]],\n\
1],{ind,1,\ntermsoftheInvarianceConditionRulesApplied1length},\n\
{jnd,1,lengthterms1table[[ind]]}];\n\n",
 StyleBox["infinitesimaltermtable1check=infinitesimaltermtable1;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 10, the length of \
infinitesimaltermtable1 is = ``, the byte count of infinitesimaltermtable1 is \
= ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[infinitesimaltermtable1],ByteCount[infinitesimaltermtable1],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Create a one-dimensional table of y-derivative terms\nmultiplied \
together.*)",
  FontWeight->"Plain"],
 "\nytermstable=Table[Apply[Times,\nfreeyderivativetable[[ind]]],\n{ind,1,\n\
termsoftheInvarianceConditionRulesApplied1length}];\n\n",
 StyleBox["ytermstablecheck=ytermstable;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 11, the length of ytermstable is = ``, \
the byte count of ytermstable is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = ``\",Length[ytermstable],ByteCount[ytermstable],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Create a one-dimensional table of infinitesimal\nterms \
multiplied together.*)",
  FontWeight->"Plain"],
 "\ninfinitesimalproducttable=Table[Apply[Times,\n\
infinitesimaltermtable1[[ind]]],\n{ind,1,\n\
termsoftheInvarianceConditionRulesApplied1length}];\n\n",
 StyleBox["infinitesimalproducttablecheck=infinitesimalproducttable;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 12, the length of \
infinitesimalproducttable is = ``, the byte count of \
infinitesimalproducttable is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[infinitesimalproducttable],ByteCount[infinitesimalproducttable],",
  
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Remove the factor of two inserted earlier. Let the \ntables \
'ytermstable' and 'infinitesimaltable' be \navailable as output, ie, don't \
include them within\nthe set of names protected by 'Module'.*)",
  FontWeight->"Plain"],
 "\ninfinitesimaltable=(1/2)*infinitesimalproducttable;\n\n",
 StyleBox["infinitesimaltablecheck=infinitesimaltable;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 13, the length of infinitesimaltable is \
= ``, the byte count of infinitesimaltable is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[infinitesimaltable],ByteCount[infinitesimaltable],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Check the number of terms in the table.*)",
  FontWeight->"Plain"],
 "\nytermstablngth=Length[ytermstable];\n\n",
 StyleBox["ytermstablngthcheck=ytermstablngth;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 14, the length of ytermstablngth is = \
``, the byte count of ytermstablngth is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[ytermstablngth],ByteCount[ytermstablngth],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)\n",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Identify the positions of yderivative terms in \nthe table that \
match.*)",
  FontWeight->"Plain"],
 "\nytermsmatchtable=Table[\nPosition[\nytermstable,ytermstable[[ind]],{1}],\n\
{ind,1,ytermstablngth}];\n\n",
 StyleBox["ytermsmatchtablecheck=ytermsmatchtable;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 15, the length of ytermsmatchtable is = \
``, the byte count of ytermsmatchtable is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[ytermsmatchtable],ByteCount[ytermsmatchtable],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Make a table giving the number of times a given\ny-derivative \
expression occurs.*)",
  FontWeight->"Plain"],
 "\nytermsmatchtableoflengths=Table[\nLength[ytermsmatchtable[[ind]]],\n\
{ind,1,ytermstablngth}];\n\n",
 StyleBox["ytermsmatchtableoflengthscheck=ytermsmatchtableoflengths;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 16, the length of \
ytermsmatchtableoflengths is = ``, the byte count of \
ytermsmatchtableoflengths is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[ytermsmatchtableoflengths],ByteCount[ytermsmatchtableoflengths],",
  
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["Print[\"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.\"];",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*Now sum the infinitesimal terms corresponding \nto matching \
y-derivative expressions.*)",
  FontWeight->"Plain"],
 "\ninfinitesimaltablesums=Flatten[\nTable[\n\
Sum[infinitesimaltable[[ytermsmatchtable[[ind,jnd]]]],\n\
{jnd,1,ytermsmatchtableoflengths[[ind]]}],\n{ind,1,ytermstablngth}]];\n\n",
 StyleBox["infinitesimaltablesumscheck=infinitesimaltablesums;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 17, the length of \
infinitesimaltablesums is = ``, the byte count of infinitesimaltablesums is = \
``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[infinitesimaltablesums],ByteCount[infinitesimaltablesums],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(***Change made December 22, 2006. I am going to look at another \
way of generating the determining equations so I do not have to perform the \
ytermstablngth calls to the function Position. This potentially large number \
of calls can slow the generation of the determining equations hugely.***)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 "\n",
 StyleBox["infinitesimaltablesumsunion=Union[infinitesimaltablesums];",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["infinitesimaltablesumsunioncheck=infinitesimaltablesumsunion;",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Print[StringForm[\n\"The length of ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["infinitesimaltablesums",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox[" is = ``, the byte count of ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["infinitesimaltablesums",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox[" is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["the time used = ``\",Length[",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["infinitesimaltablesumsunioncheck",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["],ByteCount[",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["infinitesimaltablesumsunioncheck",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change (removal of this step) made December 22, 2006.This is the \
call that slows down the function FindDeterminingEquations so badly. Instead \
I just make one call to the Mathematica function \"Union\" one step above. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["(*Produce a table containing indices of matching \ninfinitesimal \
sums.*)",
  FontWeight->"Plain"],
 "\ninfinitesimaltablesumsmatchtbl=Table[\nPosition[\n\
infinitesimaltablesums,infinitesimaltablesums[[ind]],{1}],\n\
{ind,1,ytermstablngth}];",
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["infinitesimaltablesumsmatchtblcheck=infinitesimaltablesumsmatchtbl;\
",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 17 looks like a bottleneck. T",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["he memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = ``\",",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 18, the length of \
infinitesimaltablesumsmatchtbl is = ``, the byte count of \
infinitesimaltablesumsmatchtbl is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[infinitesimaltablesumsmatchtbl],ByteCount[\
infinitesimaltablesumsmatchtbl],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["(*Pick off the first index.*)",
  FontWeight->"Plain"],
 "\ninfinitesimaltablesumsmatchtblfirstindices=Table[\n\
infinitesimaltablesumsmatchtbl[[ind,1]],\n{ind,1,ytermstablngth}];",
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["infinitesimaltablesumsmatchtblfirstindicescheck=\
infinitesimaltablesumsmatchtblfirstindices;",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 19, the length of \
infinitesimaltablesumsmatchtblfirstindices is = ``, the byte count of \
infinitesimaltablesumsmatchtblfirstindices is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[infinitesimaltablesumsmatchtblfirstindices],ByteCount[\
infinitesimaltablesumsmatchtblfirstindices],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["(*Now use the function 'Union' to create a table of\nindices where \
no two indices are the same.*)",
  FontWeight->"Plain"],
 "\nfinalinfinitesimalsumindices=Union[\n\
infinitesimaltablesumsmatchtblfirstindices];\n\
finalinfinitesimalsumindiceslength=Length[\nfinalinfinitesimalsumindices];",
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["finalinfinitesimalsumindicescheck=finalinfinitesimalsumindices;",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 20, the length of \
finalinfinitesimalsumindices is = ``, the byte count of \
finalinfinitesimalsumindices is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[finalinfinitesimalsumindices],ByteCount[\
finalinfinitesimalsumindices],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["(*Now use the indices identified in the previous\nstep to pick off \
the unique terms in the table of\ninfinitesimal sums. These are the left-hand \
sides \nof the sought after determining equations of the \ngroup. The table \
'determiningequationstable' is \npresented as output and therefore is not \
included \nwith the names protected by 'Module'.*)",
  FontWeight->"Plain"],
 "\ndeterminingequationstable1=\nFlatten[\nTable[\ninfinitesimaltablesums[[\n\
finalinfinitesimalsumindices[[ind]]]],\n\
{ind,1,finalinfinitesimalsumindiceslength}]];",
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["determiningequationstable1=infinitesimaltablesumsunion;",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 21, the length of \
determiningequationstable1 is = ``, the byte count of \
determiningequationstable1 is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[determiningequationstable1],ByteCount[determiningequationstable1],\
",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["determiningequationstable1check=determiningequationstable1;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*The number of determining equations.*)",
  FontWeight->"Plain"],
 "\ndeterminingequationstable1length=\nLength[determiningequationstable1];\n\n\
(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 22, the length of \
determiningequationstable1length is = ``, the byte count of \
determiningequationstable1length is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[determiningequationstable1length],ByteCount[\
determiningequationstable1length],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Convert each determining equation to a string and\nappend '==0' \
to each string.*)",
  FontWeight->"Plain"],
 "\ndeterminingequationstable2=\nTable[ToString[InputForm[\n\
determiningequationstable1[[ind]]]]<>\"==0\",\n\
{ind,1,determiningequationstable1length}];\n\n",
 StyleBox["determiningequationstable2check=determiningequationstable2;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 23, the length of \
determiningequationstable2 is = ``, the byte count of \
determiningequationstable2 is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[determiningequationstable2],ByteCount[determiningequationstable2],\
",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*",
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["Change made December 22, 2006. ",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[0, 0, 1]],
 StyleBox["(*Use the same set of indices to pick off the \ncorresponding \
y-derivative factors. The product\nof these two tables summed is the final \
form\nof the invariance condition.The table\n'yderivfactortable' is presented \
as\noutput and therefore is not included with the\nnames protected by \
'Module'.*)",
  FontWeight->"Plain"],
 "\nyderivfactortable=Flatten[\nTable[\nytermstable[[\n\
finalinfinitesimalsumindices[[ind]]]],\n\
{ind,1,finalinfinitesimalsumindiceslength}]];",
 StyleBox["*)",
  FontColor->RGBColor[0, 0, 1]],
 "\n\n",
 StyleBox["yderivfactortablecheck=yderivfactortable;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 24, the length of yderivfactortable is \
= ``, the byte count of yderivfactortable is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[yderivfactortable],ByteCount[yderivfactortable],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)\n",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Convert each term in the determining equations table \nback to \
an expression.*)",
  FontWeight->"Plain"],
 "\ndeterminingequationstable=\n\
Table[ToExpression[determiningequationstable2[[ind]]],\n\
{ind,1,determiningequationstable1length}];\n\n",
 StyleBox["determiningequationstablecheck=determiningequationstable;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 25, the length of \
determiningequationstable is = ``, the byte count of \
determiningequationstable is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[determiningequationstable],ByteCount[determiningequationstable],",
  
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*The number of determining equations - again.*)",
  FontWeight->"Plain"],
 "\ndeterminingequationstablelengthof=\nLength[determiningequationstable];\n\n\
(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 26, the length of \
determiningequationstablelengthof is = ``, the byte count of \
determiningequationstablelengthof is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[determiningequationstablelengthof],ByteCount[\
determiningequationstablelengthof],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)\n",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Convert the determining equations table to a table of strings \
and\npresent the primary output of the function in that form.*)",
  FontWeight->"Plain"],
 "\ndeterminingequationstableofstrings=\n\
Table[ToString[InputForm[determiningequationstable[[ind]]]],\n\
{ind,1,determiningequationstablelengthof}];\n\n",
 StyleBox["determiningequationstableofstringscheck=\
determiningequationstableofstrings;",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"Check 27, the length of \
determiningequationstableofstrings is = ``, the byte count of \
determiningequationstableofstrings is = ``, ",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the memory in use = ``, ",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["the time used = \
``\",Length[determiningequationstableofstrings],ByteCount[\
determiningequationstableofstrings],",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["MemoryInUse[],",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["TimeUsed[]]];*)",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*The variable name in the last step is just too long\nand \
unwieldy to expect the user to get used to. Here is\na shorter name.This is \
the main output of the program.*)",
  FontWeight->"Plain"],
 "\ndeterminingequations=determiningequationstableofstrings;\n\n(*",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"The determining equations have been prepared, \
the length of determiningequations = ``, the byte count of \
determiningequations = ``, the memory in use = ``, the time used = \
``\",Length[determiningequations],ByteCount[determiningequations],MemoryInUse[\
],TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*For convenience express the determining equations \nin terms of \
a set of dummy variables.*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars,numberdependentvars,\
rorderofinfinitesimals];\n\n",
 StyleBox["(*Convert these strings to expressions.*)",
  FontWeight->"Plain"],
 "\ninfinitesimalindepvariabletable=\nToExpression[variablestringtable];\n\n\
",
 StyleBox["(*The number of dummy variables that need to be \ngenerated.*)",
  FontWeight->"Plain"],
 "\ninfinitesimalindepvariabletablelength=\n\
Length[infinitesimalindepvariabletable];\n\n",
 StyleBox["(*Now generate the required number of dummy \nvariables.*)",
  FontWeight->"Plain"],
 "\ndummyvariabletable=\nTable[ToExpression[\"z\"<>ToString[indx]],\n\
{indx,1,infinitesimalindepvariabletablelength}];\n\n",
 StyleBox["(*Generate the needed table of transformation rules,\nfirst as \
strings.*)",
  FontWeight->"Plain"],
 "\ndummyvariabletableofrulesstrings=\nTable[ToString[\nInputForm[\n\
infinitesimalindepvariabletable[[indx]]]]<>\n\
\"->\"<>ToString[dummyvariabletable[[indx]]],\n\
{indx,1,infinitesimalindepvariabletablelength}];\n\n",
 StyleBox["(*Convert the strings to expressions.*)",
  FontWeight->"Plain"],
 "\nztableofrulesxytoz=\nToExpression[dummyvariabletableofrulesstrings];\n\n\
",
 StyleBox["(*Be able to view this table*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nztableofrulesxy=ztableofrulesxytoz;\n\n",
 StyleBox["(*Now make the change to dummy variables.\nThis is the final \
output of the program.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequationstable=\n\
determiningequationstable/.ztableofrulesxytoz;\n\n",
 StyleBox["(*The number of determining equations - yet again.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequationstablelengthof=\nLength[zdeterminingequationstable];\n\
\n",
 StyleBox["(*Convert the above table to a table of strings and\npresent the \
primary output of the function in that form.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequationstableofstrings=\n\
Table[ToString[InputForm[zdeterminingequationstable[[ind]]]],\n\
{ind,1,zdeterminingequationstablelengthof}];\n\n",
 StyleBox["(*The variable name in the last step is just too long\nand \
unwieldy to expect the user to get used to. Here is\na shorter z-name.This is \
a convenient form of the main output\nof the program.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequations=zdeterminingequationstableofstrings;\n\n",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"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 = \
``\",Length[zdeterminingequations],ByteCount[zdeterminingequations],\
MemoryInUse[],TimeUsed[]]];",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Produce a table of rules that takes z variables to xy \
variables*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ndummyvariabletableofrulesstringsztoxy=\n\
Table[ToString[dummyvariabletable[[indx]]]<>\n\"->\"<>ToString[\nInputForm[\n\
infinitesimalindepvariabletable[[indx]]]],\n\
{indx,1,infinitesimalindepvariabletablelength}];\n\n(*",
 StyleBox["Print[StringForm[\"dummyvariabletableofrulesstringsztoxy = \
``\",dummyvariabletableofrulesstringsztoxy]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Construct a set of rules for converting generic independent \
variables, x1, x2, x3,...,xn to input independent variables.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninputequationindependentvariablerulesxtoinput=\n\
Table[\"x\"<>ToString[jjnd]->ToString[\n\
independentvariables[[jjnd]]],{jjnd,1,numberindependentvars}];\n\n(*",
 StyleBox["Print[StringForm[\"inputequationindependentvariablerulesxtoinput = \
``\",inputequationindependentvariablerulesxtoinput]];*)\n\n\
(*Print[StringForm[\"dependentvariables = ``\",dependentvariables]];*)\n\n\
(*Print[StringForm[\"",
  FontColor->RGBColor[1, 0, 0]],
 "dependentvariablesstrings",
 StyleBox[" = ``\",",
  FontColor->RGBColor[1, 0, 0]],
 "dependentvariablesstrings",
 StyleBox["]];*)\n\n",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["(*Convert the list of dependent variables to an expression - \
again! This refreshes the table of expressions dependentvariables. Change \
added May 20, 2010.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ndependentvariables=ToExpression[dependentvariablesstrings];",
 StyleBox["\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Construct a set of rules for converting generic dependent \
variables, y1, y2, y3,...,ym to input dependent variables.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninputequationdependentvariablerulesytoinput=\n\
Table[\"y\"<>ToString[iind]->ToString[\n\
dependentvariables[[iind]]],{iind,1,numberdependentvars}];\n\n(*",
 StyleBox["Print[StringForm[\"inputequationdependentvariablerulesytoinput = \
``\",inputequationdependentvariablerulesytoinput]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Join these two sets of rules.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninputequationvariablerulesxytoinput=\n\
Join[inputequationindependentvariablerulesxtoinput,\n\
inputequationdependentvariablerulesytoinput];\n\n",
 StyleBox["(*If the number of independent or dependent variables is ten or \
more\nthe replacement will change the left two characters in y10, y11, etc \n\
with the user variable corresponding to y1. This happens because the\n\
replacement begins with the first element in the replacement rules for \neach \
entry in the list dummyvariabletableofrulesstringsztoxy. To avoid \nthis \
problem we reverse the order of the replacement rules in \n\
inputequationvariablerulesxytoinput so that y10, y11, etc are replaced \n\
before the y1 is replaced. The problem was encountered when analyzing \nthe \
second order form of the restricted Euler equation which has 11 \ndependent \
variables including Q and R. This has no effect on the operation \nof the \
package except that the list ztableofrules would have had incorrect \nentries \
for variables beyond the ninth. This change was made September 8, 2001.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ninputequationvariablerulesxytoinputreverse=\n\
Reverse[inputequationvariablerulesxytoinput];\n\n",
 StyleBox["(*Create a table of rules that take xy variables to input \
variables.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ndummyvariabletableofrulesstringsxytoinput=\nStringReplace[\n\
dummyvariabletableofrulesstringsztoxy,\n\
inputequationvariablerulesxytoinputreverse];\n\n",
 StyleBox["(*Convert the strings to expressions.*)",
  FontWeight->"Plain"],
 "\nztableofrules=\nToExpression[dummyvariabletableofrulesstringsxytoinput];\n\
\n",
 StyleBox["(***Print out the status.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\n\"FindDeterminingEquations is done. The memory \
in use = ``, the time used = ``\",MemoryInUse[],TimeUsed[]]];\n\n",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["(*This command was also (same as at the end of \
GenerateInvarianceConditionRulesApplied) added on May 20, 2010. I ran into an \
odd situation, looking for the symmetries of Maxwell's equations with \
currents and charges, where the choice of j1 for a user variable name caused \
problems. The problem at this point (at the end of FindDeterminingEquations) \
is that j1 has been assigned the value 1. If the notebook is run again the j1 \
will be replaced by 1 in several places in particular in the input equation \
in generic variables. Clearing all j's at this point prevents the problem.*)",
  
  FontWeight->"Plain"],
 StyleBox["\nClear[\"j*\"];",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Inform the user that the output is ready.*)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "Print[\"FindDeterminingEquations has finished executing. You can look at \
the output in the table ",
 StyleBox["zdeterminingequations",
  FontVariations->{"CompatibilityType"->0}],
 ". 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.\"];])\n\
(******END*OF*FUNCTION*FindDeterminingEquations*******)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->{{3.469376885357332*^9, 3.469376902076983*^9}, {
   3.469376933976013*^9, 3.469376978311532*^9}, {3.469377594656692*^9, 
   3.469377712868824*^9}, 3.469377755310285*^9, {3.469377793287321*^9, 
   3.469378387345718*^9}, {3.469378426299634*^9, 3.4693785035028133`*^9}, {
   3.469378539632228*^9, 3.469379118870228*^9}, {3.46937915325867*^9, 
   3.469379225210438*^9}, {3.46937925732371*^9, 3.469379391142149*^9}, {
   3.469379519776642*^9, 3.4693795247351418`*^9}, {3.469379991017036*^9, 
   3.4693800496914062`*^9}, {3.469460496243095*^9, 3.469460498529297*^9}, {
   3.483306404449094*^9, 3.483306407287031*^9}, {3.483358632236183*^9, 
   3.483358757647588*^9}, {3.483359214466958*^9, 3.483359530626278*^9}, {
   3.483359578791863*^9, 3.483359829358108*^9}, {3.483366131730969*^9, 
   3.4833661526625853`*^9}, {3.483369407722464*^9, 3.483369410618952*^9}, {
   3.4833737800478163`*^9, 3.483373809136778*^9}, {3.483374339645061*^9, 
   3.483374365343193*^9}, {3.4833744311973333`*^9, 3.483374459392591*^9}, {
   3.483374491897152*^9, 3.483374497253334*^9}, {3.4833752974621487`*^9, 
   3.483375318860414*^9}, 3.483375349627507*^9, {3.483375406770595*^9, 
   3.483375449323966*^9}, {3.483377005501441*^9, 3.4833770199555273`*^9}, {
   3.4833772179659233`*^9, 3.483377221196857*^9}, {3.483378236602139*^9, 
   3.483378240437747*^9}, {3.483378276575677*^9, 3.483378362386672*^9}, {
   3.483378404028399*^9, 3.483378444265101*^9}, 3.483378657154155*^9, {
   3.4833790731021852`*^9, 3.4833791520986223`*^9}, {3.483387972635078*^9, 
   3.4833880086930017`*^9}, {3.483389096474695*^9, 3.483389154471156*^9}, {
   3.483389419584036*^9, 3.4833894449382477`*^9}, {3.4833899144925213`*^9, 
   3.483389932502871*^9}, {3.4833900001521893`*^9, 3.483390138735055*^9}, {
   3.483390366161495*^9, 3.483390407050379*^9}, {3.483390466843693*^9, 
   3.483390557560203*^9}, {3.4833926055499697`*^9, 3.4833926412137547`*^9}, {
   3.4833926768555717`*^9, 3.483393122976851*^9}, {3.483393174443096*^9, 
   3.483393181087143*^9}, {3.483393240605276*^9, 3.483393428294441*^9}, {
   3.48339346545604*^9, 3.483393494408843*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(****** *BEGINNING*OF*FUNCTION*SolveDeterminingEquations****)\n",
 StyleBox["(*This function takes the determining equations contained in \nthe \
table 'zdeterminingequationstable' and attempts to \nfind a solution in the \
form of a power series. This will usually\ncapture many but not all of the \
solutions of the determining \nequations which can contain arbitrary \
functions. The presence\nof such functions is usually indicated when the \
series solution \ndoesn't truncate.The output of the function is presented in \
two\ntables 'xseinfinitesimals' and 'etainfinitesimals'containing\nalgebraic \
expressions for the infinitesimals ordered according to\nthe conventional \
ordering of independent variables and dependent\nvariables respectively.*)",
  FontWeight->"Plain"],
 "\nSolveDeterminingEquations[\n\
independentvariablesstrings_,dependentvariablesstrings_,\
rorderofinfinitesimals_,xseon_,\n\
zdeterminingequationstableofstrings_,polyorder_]:=\n\n",
 StyleBox["(*The function 'Module' protects variable names from the \noutside \
world.*)",
  FontWeight->"Plain"],
 "\n(Module[{numberofvariables,zvariables,kindices,\n\
kindicessumstring,powersofzs1,powersproductstring,\n\
indicestablestring1,indicestablestring,powerofzs1string,\n\
powertable1,powertablenull1,powertablenull,\n\
lengthpowertable,zvariablesundefinedstring,\n\
powertable,xsecoefficienttable,etacoefficienttable,\n\
xseproductstep1,xsefunctionsumtable,\ntableofxxsefunctionsstrings,\n\
tableofxxsefunctions1,tableofxxsefunctions,\n\
etaproductstep1,etafunctionsumtable,\ntableofeetafunctionsstrings,\n\
tableofeetafunctions,\nzdeterminingequationstablelength,\n\
zdeterminingequationstablestrings,\n\
zdeterminingequationstablexxseeetastrings,\n\
zdeterminingequationstablexxseeetastringsnoequals,\n\
zdeterminingequationstablexxseeetaexpressions,\n\
expandedzdeterminingequationstable,tableofcoefficients,\n\
tableofcoefficientsall,\n\
tableofcoefficientslength,tableofcoefficientsstrings,\n\
unknowns1,unknowns,rulestable1,rulestable,i,j,ind,\n\
xseinfinitesimals1,etainfinitesimals1,\nzdeterminingequationstable,\n\
xseclearstring1,xseclearstring,\netaclearstring1,etaclearstring,\n\
xseinfinitesimalstrings,\netainfinitesimalstrings,\n\
allunknowns1a,allunknowns1,groupparametersonesandzeros,\n\
groupparameterswithzeros,groupparameters1,\n\
parameterlength,infinitesimalgroups1,numberindependentvars,\
numberdependentvars,order,\nindependentvariables,dependentvariables},\n\n",
 StyleBox["(*Print[StringForm[\"Step1 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Convert the list of independent variables to an expression*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nindependentvariables=ToExpression[independentvariablesstrings];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step2 = ``\",TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Convert the list of dependent variables to an expression*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ndependentvariables=ToExpression[dependentvariablesstrings];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step3 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*order is a protected name for the trial polynomial order.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\norder=polyorder;\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step4 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*The number of independent variables*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nnumberindependentvars=Length[independentvariables];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step5 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*The number of dependent variables*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nnumberdependentvars=Length[dependentvariables];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step6 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 "\n\n",
 StyleBox["(*Clear the variable names for the 'xse' infinitesimals. First \
construct\na table of strings with the infinitesimal names.*)",
  FontWeight->"Plain"],
 "\nxseclearstring1=Table[\"xse\"<>ToString[j],{j,1,numberindependentvars}];\n\
",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step7 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Remove the curly brackets.*)",
  FontWeight->"Plain"],
 "\nxseclearstring=StringReplace[StringReplace[\n\
ToString[xseclearstring1],\"{\"->\"\"],\"}\"->\"\"];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step8 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Now clear the 'xse' variable names.*)",
  FontWeight->"Plain"],
 "\nToExpression[\"ClearAll[\"<>xseclearstring<>\"]\"];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step9 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Clear the variable names for the 'eta' infinitesimals. First \
construct\na table of strings with the infinitesimal names.*)",
  FontWeight->"Plain"],
 "\netaclearstring1=Table[\"eta\"<>ToString[i],{i,1,numberdependentvars}];\n\
",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step10 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Remove the curly brackets.*)",
  FontWeight->"Plain"],
 "\netaclearstring=StringReplace[StringReplace[\n\
ToString[etaclearstring1],\"{\"->\"\"],\"}\"->\"\"];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step11 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Now clear the 'eta' variable names.*)",
  FontWeight->"Plain"],
 "\nToExpression[\"ClearAll[\"<>etaclearstring<>\"]\"];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step12 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*First, convert the determining equation strings \nto \
expressions.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequationstable=\n\
ToExpression[zdeterminingequationstableofstrings];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step13 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Call this function to generate a list of the\nindependent \
variables, dependent variables and\nderivatives of dependent variables. The \
only\npurpose is to determine the number of z variables.*)",
  FontWeight->"Plain"],
 "\nGenerateVariableTable[numberindependentvars,numberdependentvars,\
rorderofinfinitesimals];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step14 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*This is the output list of variables.*)",
  FontWeight->"Plain"],
 "\nvariablestringtable;\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step15 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Be able to view the output list of variables. Keep this, Dec 29, \
2009.*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\nvariablestringtableforviewing=variablestringtable;",
  FontColor->RGBColor[1, 0, 1]],
 "\n\n",
 StyleBox["(*This is the number of z-variables.*)",
  FontWeight->"Plain"],
 "\nnumberofvariables=Length[variablestringtable];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step16 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Generate the list of z-variables.*)",
  FontWeight->"Plain"],
 "\nzvariables=Table[ToExpression[\"z\"<>ToString[ind]],\n\
{ind,1,numberofvariables}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step17 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Be able to view the list of zvariables. Keep this, Dec 29, 2009. \
*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\nzvariablesforviewing=zvariables;",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\n",
  FontColor->RGBColor[0.6, 0.4, 0.2]],
 StyleBox["(***Comment out the*OLD Construction of powers of z*****)\n\
(***************December 27, 2009***********************)\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Generate a list of k-indices to be associated with\na polynomial \
expansion of the infinitesimals in z-variables.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\n(**kindices=Table[ToExpression[\"k\"<>ToString[ind]],\n\
{ind,1,numberofvariables}];\n\nPrint[StringForm[\"Step18 = ``\",TimeUsed[]]];\
\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Be able to view the list of kindices. Keep this*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\nkindicesforviewing=kindices;\n\nPrint[StringForm[\"Step19 = \
``\",TimeUsed[]]];\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Create a sum of the k-indices to be used a couple of lines\ndown \
as a test sum needed to create the polynomial expansions \nof the \
infinitesimals.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\nkindicessumstring=ToString[Apply[Plus,kindices]];\n\n\
Print[StringForm[\"Step20 = ``\",TimeUsed[]]];\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Now create a table of powers of the z-variables.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowersofzs1=Table[\"(\"<>\nToString[zvariables[[ind]]]<>\"^\"<>\n\
ToString[kindices[[ind]]]<>\")\",{ind,1,numberofvariables}];\n\n\
Print[StringForm[\"Step21 = ``\",TimeUsed[]]];\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Multiply the various powers together.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowersproductstring=ToString[Apply[Times,powersofzs1]];\n\n\
Print[StringForm[\"Step22 = ``\",TimeUsed[]]];\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Be able to view the powersproductstring.  Keep this.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowersproductstringforviewing=powersproductstring;\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Create the table of index ranges needed in the polynomial \
expansion.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\nindicestablestring1=ToString[Table[\"{\"<>\n\
ToString[kindices[[numberofvariables+1-ind]]]<>\",\"<>\n\
\"0\"<>\",\"<>ToString[order]<>\"}\",{ind,1,numberofvariables}]];\n\n\
Print[StringForm[\"Step23 = ``\",TimeUsed[]]];\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Convert the above table of index ranges to a string.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\nindicestablestring=StringReplace[\n\
StringReplace[indicestablestring1,\"{{\"->\"{\"],\"}}\"->\"}\"];\n\n\
Print[StringForm[\"Step24 = ``\",TimeUsed[]]];\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Create a string which, when converted to an expression, will \n\
create powers of z and where the sum of powers exceeds 'order'\ngenerate a \
'Null'. This was a huge waste of time and memory, Dec 29, 2009.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowerofzs1string=\n\"Table[\"<>\n\"If[\"<>\n\
kindicessumstring<>\"<=\"<>ToString[order]<>\",\"<>\n\
powersproductstring<>\"],\"<>\nindicestablestring<>\"]\";\n\n\
Print[StringForm[\"Step25 = ``\",TimeUsed[]]];\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Flatten the above table.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowertable1=Flatten[ToExpression[powerofzs1string]];\n\n\
Print[StringForm[\"Step26 = ``\",TimeUsed[]]];\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Create a table of 'Nulls'.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowertablenull1=\"Table[\"<>\n\"If[\"<>\n\
kindicessumstring<>\"<=-1\"<>\",\"<>\npowersproductstring<>\"],\"<>\n\
indicestablestring<>\"]\";\n\nPrint[StringForm[\"Step27 = ``\",TimeUsed[]]];\n\
\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Flatten this table of 'Null's.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowertablenull=Flatten[ToExpression[powertablenull1]];\n\n\
Print[StringForm[\"Step28 = ``\",TimeUsed[]]];\n\n\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*Form a table of powers of z's by taking the Complement of the \
above\ntwo tables.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowertable=Complement[powertable1,powertablenull];**)\n\n(*End \
Comment out of the OLD construction of powers of z*)\n\
(****************December 27, 2009***********************)\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["\n(*",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[\"We are ready to construct the powers of zvariables that \
appear in the multivariate polynomial expansions.\"];*)\n\n\
(*Print[StringForm[\"Time = ``\",TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 1]],
 "\n",
 StyleBox["orderforviewing=order;\n\n\
numberofvariablesforviewing=numberofvariables;\n\n\
zvariablesforviewing=zvariables;\n\n(*Print[StringForm[\"Polynomial \
order=``\",orderforviewing]];*)\n\n(*Print[StringForm[\"List of zvariables=``\
\",zvariablesforviewing]];*)\n\n(*Print[StringForm[\"Number of zvariables =``\
\",numberofvariablesforviewing]];*)",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n",
  FontColor->RGBColor[1, 0.5, 0]],
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*********Insert NEW construction of powers of z*******)\n\
(***************December 27, 2009**********************)\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*This step constructs a string that is in the right form to \
create and join tables of z variables of order one up to \"order\". This did \
not work until I used the names zvariablesforviewing instead of zvariables \
and the index name alpha instead of j. I am not sure what the problem was but \
it would not use the string zvariables which is a protected name. Dec 30, \
2009.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowertablenewdec2709a = Table[StringJoin[\"Table[\" , \
StringJoin[Table[StringReplace[\"zvariablesforviewing[[kalpha1]]*\", \"alpha1\
\" \[Rule] ToString[alpha1]], {alpha1, 1, orderindex - 1}], \
StringReplace[\"zvariablesforviewing[[kpolyorderindex]]\", \"polyorderindex\" \
\[Rule] ToString[orderindex]]] , \
Table[StringReplace[\",{kalpha2,1,numberofvariablesforviewing}\", \"alpha2\" \
\[Rule] ToString[alpha2]], {alpha2, 1, orderindex}] , \"]\"], {orderindex, 1, \
order}];\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*Print[StringForm[\"powertablenewdec2709a=``\",\
powertablenewdec2709a]];*)\n\n",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["(*Convert the previous string to an expression. The expression \
gets evaluated and creates a table of all the powers of zvariables that are \
needed for the multivariate trial polynomials.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowertablenewdec2709b = ToExpression[powertablenewdec2709a];\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*Print[StringForm[\"powertablenewdec2709b=``\",\
powertablenewdec2709b]];*)",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*This inserts a one in the first position of the table of \
zvariable powers.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowertablenewdec2709withone={1,powertablenewdec2709b};\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*Print[StringForm[\"powertablenewdec2709withone=``\",\
powertablenewdec2709withone]];*)",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*This removes all brackets within the table of zvariable powers \
and removes redundancies.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\npowertable = Union[Flatten[powertablenewdec2709withone]];\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*Print[StringForm[\"powertable=``\",powertable]];*)",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["\n\nPrint[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 = \
``\",Length[powertable]]];\n\n(*Print[\"The terms required for the \
infinitesimal polynomials have been constructed.\"];*)\n\n(*Print[StringForm[\
\"Time = ``\",TimeUsed[]]];*)\n\n\n(********End of NEW construction of powers \
of z*********)\n(**************December 27, 2009************************)\n",
  FontColor->RGBColor[1, 0, 1]],
 "\n",
 StyleBox["(*Be able to view the ",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["powertable",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox[". Keep this.*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\npowertableforviewing=powertable;\n",
  FontColor->RGBColor[1, 0, 1]],
 "\n",
 StyleBox["(*Find the length of this table of powers. This is the number\nof \
terms in the polynomial expansions to be generated below.*)",
  FontWeight->"Plain"],
 "\nlengthpowertable=Length[powertable];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step30 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Create a table of coefficients for the 'xse' infinitesimals. If\n\
xseon==0 set the xsecoefficients to zero.*)",
  FontWeight->"Plain"],
 "\nxsecoefficienttable=\n\
Table[If[xseon==1,ToExpression[\"a\"<>ToString[j]<>ToString[ind-1]],0],\n\
{j,1,numberindependentvars},{ind,1,lengthpowertable}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step31 = ``\",TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Produce a table of expressions of products of the 'xse' \
coefficients\nmultiplied by the powers of z.*)",
  FontWeight->"Plain"],
 "\nxseproductstep1=Table[xsecoefficienttable[[j,ind]]*\npowertable[[ind]],\n\
{j,1,numberindependentvars},{ind,1,lengthpowertable}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step32 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Sum the terms in the above tables to produce the \nright hand \
sides for the 'xse' functions.*)",
  FontWeight->"Plain"],
 "\nxsefunctionsumtable=\nTable[Apply[Plus,xseproductstep1[[j]]],\n\
{j,1,numberindependentvars}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step33 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Create the string to be used as undefined z-variables\nin the \
infinitesimal polynomial functions to be generated \nbelow.*)",
  FontWeight->"Plain"],
 "\nzvariablesundefinedstring=\nStringReplace[\nStringReplace[\n\
ToString[Table[\"z\"<>ToString[ind]<>\"_\",\n{ind,1,numberofvariables}]],\n\
\"{\"->\"\"],\"}\"->\"\"];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step34 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Now create a table of string function definitions for the 'xse' \
\ninfinitesimals expressed as polynomials with powers up \nto 'order'.*)",
  FontWeight->"Plain"],
 "\ntableofxxsefunctionsstrings=Table[\"xxse\"<>ToString[j]<>\"[\"<>\n\
zvariablesundefinedstring<>\"]\"<>\"=\"<>\n\
ToString[InputForm[xsefunctionsumtable[[j]]]],{j,1,numberindependentvars}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step35 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Be able to view the ",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["tableofxxsefunctionsstrings",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox[". Keep this. Dec 29, 2009*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\
(*tableofxxsefunctionsstringsforviewing=tableofxxsefunctionsstrings;*)",
  FontColor->RGBColor[1, 0, 1]],
 "\n\n",
 StyleBox["(*Convert the 'xse' strings to expressions.*)",
  FontWeight->"Plain"],
 "\ntableofxxsefunctions1=ToExpression[tableofxxsefunctionsstrings];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step36 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Set these functions to zero if xseon is not equal to one.*)",
  FontWeight->"Plain"],
 "\ntableofxxsefunctions=\n\
Table[If[xseon==1,tableofxxsefunctions1[[j]],0],{j,1,numberindependentvars}];\
\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step37 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Now create a table of coefficients for the 'eta' \
infinitesimals.*)",
  FontWeight->"Plain"],
 "\netacoefficienttable=\n\
Table[ToExpression[\"b\"<>ToString[i]<>ToString[ind-1]],\n\
{i,1,numberdependentvars},{ind,1,lengthpowertable}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step38 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Produce a table of expressions of products of the 'eta' \
coefficients\nmultiplied by the powers of z.*)",
  FontWeight->"Plain"],
 "\netaproductstep1=Table[etacoefficienttable[[i,ind]]*\npowertable[[ind]],\n\
{i,1,numberdependentvars},{ind,1,lengthpowertable}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step39 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Sum the terms in the above tables to produce the \nright hand \
sides for the 'eta' functions.*)",
  FontWeight->"Plain"],
 "\netafunctionsumtable=\nTable[Apply[Plus,etaproductstep1[[i]]],\n\
{i,1,numberdependentvars}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step40 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Now create a table of string function definitions for the 'eta' \
\ninfinitesimals expressed as polynomials with powers up \nto 'order'.*)",
  FontWeight->"Plain"],
 "\ntableofeetafunctionsstrings=Table[\"eeta\"<>ToString[i]<>\"[\"<>\n\
zvariablesundefinedstring<>\"]\"<>\"=\"<>\n\
ToString[InputForm[etafunctionsumtable[[i]]]],{i,1,numberdependentvars}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step41 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Be able to view the ",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["tableofeetafunctionsstrings",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox[". Keep this.  Dec 29, 2009.*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\
(*tableofeetafunctionsstringsforviewing=tableofeetafunctionsstrings;*)",
  FontColor->RGBColor[1, 0, 1]],
 "\n\n",
 StyleBox["(*Convert the 'eta' strings to expressions.*)",
  FontWeight->"Plain"],
 "\ntableofeetafunctions=ToExpression[tableofeetafunctionsstrings];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step42 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*The number of determining equations.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequationstablelength=\nLength[zdeterminingequationstable];\n\
",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step43 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Convert the determining equations to strings.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequationstablestrings=\nTable[ToString[InputForm[\n\
zdeterminingequationstable[[ind]]]],\n\
{ind,1,zdeterminingequationstablelength}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step44 = ``\",TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Change 'xse' to 'xxse' and 'eta' to 'eeta'. The \nreason for \
this is that the polynomial expansions\nare defined so as to be immediately \
evaluated. \nChanging names slightly prevents the original table\nof \
determining equations from being modified.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequationstablexxseeetastrings=\nStringReplace[StringReplace[\n\
zdeterminingequationstablestrings,\"xse\"->\"xxse\"],\n\"eta\"->\"eeta\"];\n\
",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step45 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Remove the double equals from each of the determining \
equations.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequationstablexxseeetastringsnoequals=\nStringReplace[\n\
zdeterminingequationstablexxseeetastrings,\"== 0\"->\"\"];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step46 = ``\",TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Now convert the determining equations strings to \nexpressions. \
It is important that this step come after\nthe polynomial expressions for the \
'xse' and 'eta' \nfunctions. This is because the 'xse' and 'eta' functions\n\
are defined so as to be evaluated immediately. Therefore\nthe substitution of \
these functions into the determining\nequations will occur immediately.*)",
  FontWeight->"Plain"],
 "\nzdeterminingequationstablexxseeetaexpressions=\nTable[ToExpression[\n\
zdeterminingequationstablexxseeetastringsnoequals[[ind]]],\n\
{ind,1,zdeterminingequationstablelength}];\n\n",
 StyleBox["(*Be able to look at ",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["zdeterminingequationstablexxseeetaexpressions",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox[". Dec 29, 2009*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\
(*zdeterminingequationstablexxseeetaexpressionsforviewing=\
zdeterminingequationstablexxseeetaexpressions;*)",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\n",
  FontColor->RGBColor[1, 0.5, 0]],
 StyleBox["(*Print[\"Look at expandedzdeterminingequationstableforviewing \
before Union is applied.\"];*)\n\n\
(*Print[StringForm[\"zdeterminingequationstablexxseeetaexpressionslength = ``\
\",Length[zdeterminingequationstablexxseeetaexpressions]]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["\n(*Print[StringForm[\"Step47 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[0.5, 0, 0.5]],
 "\n\n\n",
 StyleBox["(*Now substitute the expansions into the table of \ndetermining \
equations with the ==0 removed.*)",
  FontWeight->"Plain"],
 "\nexpandedzdeterminingequationstable=\nExpandAll[\n\
zdeterminingequationstablexxseeetaexpressions];\n\n\n",
 StyleBox["(*Be able to look at all the expansions of determining equations \
before Union is applied. Dec 29, 2009*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\
(*expandedzdeterminingequationstableforviewing=\
expandedzdeterminingequationstable;*)",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\n",
  FontColor->RGBColor[1, 0.5, 0]],
 StyleBox["(*Print[\"Look at expandedzdeterminingequationstableforviewing \
before Union is applied.\"];*)\n\n\
(*Print[StringForm[\"expandedzdeterminingequationstablelength = \
``\",Length[expandedzdeterminingequationstable]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["\n",
  FontColor->RGBColor[1, 0.5, 0]],
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["Print[\"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.\"];\n\n(*Print[StringForm[\"Time = ``\",TimeUsed[]]];*)\n\n\
Print[StringForm[\"",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["The memory in use = ``, The time = ``\",MemoryInUse[],TimeUsed[]",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["]];\n",
  FontColor->RGBColor[1, 0, 1]],
 "\n\n",
 StyleBox["(*Now pick off the coefficients of the z-variables \nin the \
determining equations.*)",
  FontWeight->"Plain"],
 "\ntableofcoefficientsall=\nFlatten[CoefficientList[\n\
expandedzdeterminingequationstable,zvariables]];\n\n",
 StyleBox["(*Be able to look at all the coefficients before Union is applied. \
Dec 29, 2009*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n(*tableofcoefficientsallforviewing=tableofcoefficientsall;*)",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\n",
  FontColor->RGBColor[1, 0.5, 0]],
 StyleBox["(*Print[\"Look at tableofcoefficientsallforviewing before Union is \
applied.\"];*)\n\n(*",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["Print[StringForm[\"The table of coefficients collected from the \
determining equations has been constructed. Because many of the powers of \
zvariables end up with zero as the coefficient this table will contain a \
large number of zeros. In the case of Lie-Backlund transformations of high \
order, the number can be in the many millions. So it is useful to check the \
length of this table. The length of the list tableofcoefficientsall is = \
``\",Length[tableofcoefficientsall]]];*)\n\n(*Print[StringForm[\"Time = \
``\",TimeUsed[]]];*)\n\n(*Print[\"The next step is to remove all the zeros in \
this table using the function DeleteCases. This can take a long time.\"];*)\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*The tableofcoefficientsall includes a huge number of zeros \
(millions if this is a high \norder Lie-Backlund calculation with r=3 or \
more). Before manipulating the table it is \nextremely important to remove \
all the zeros to reduce the size of the calculation. The \nprevious version \
of the software did this with the function Union which was slow and \nleft a \
single zero in the first slot of the table. In this step added December 23, \
2009 we \nremove ALL zeros using the function DeleteCases. Union is used a \
little further down to \nremove any remaining redundancies.*)\n",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\
tableofcoefficientsnozeros=DeleteCases[tableofcoefficientsall,_0];\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*Be able to look at ",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["tableofcoefficientsnozeros",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox[" after DeleteCases removing all zeros is applied.*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n(*tableofcoefficientsnozeros=tableofcoefficientsnozeros;*)\n\n\
(*Print[\"Look at tableofcoefficientsnozeros before Union is applied.\"];*)",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n\n(*",
  FontColor->RGBColor[1, 0.5, 0]],
 StyleBox["Print[StringForm[\"The number of coefficients with all the zeros \
removed is = ``\",Length[tableofcoefficientsnozeros]]];*)\n\n\
(*Print[StringForm[\"Time = ``\",TimeUsed[]]];*)\n\n(*Print[\"The next step \
is to use the function Union to remove any remaining redundancies in the \
table of coefficients.\"];*)\n",
  FontColor->RGBColor[1, 0, 1]],
 "\n",
 StyleBox["(*The next step is the one replaced by the process just completed \
as of Dec 29, 2009..*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\n",
  FontColor->GrayLevel[0.5]],
 StyleBox["(*The list of coefficients typically involves a large\nnumber of \
items that are simply zero. The function Union\nremoves redundant members \
from the list this step takes an incredibly long time and requires a lot of \
virtual memeory which slows things down immensely.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0},
  FontColor->GrayLevel[0.5]],
 StyleBox["\n(*tableofcoefficients=Union[tableofcoefficientsall];*)",
  FontColor->GrayLevel[0.5]],
 "\n\n",
 StyleBox["(*Now with all the zeros removed, the function Union will work on \
the remaining coefficients to remove any further redundancies. This takes \
quite a bit of time, Dec 29, 2009.*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\ntableofcoefficients=Union[tableofcoefficientsnozeros];\n\n",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["(*Be able to look at ",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["tableofcoefficients",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox[" after Union is applied.*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n(*tableofcoefficientsforviewing=tableofcoefficients;*)\n\n\
(*Print[\"Look at tableofcoefficients after Union is applied.\"];*)\n\n\
(*Print[StringForm[\"The length of the table of coefficients with remaining \
redundancies removed = ``\",Length[tableofcoefficients]]];*)\n\n\
(*Print[StringForm[\"Time = ``\",TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 1]],
 "\n\n",
 StyleBox["(*Dec 19, 2009. I still have to define tableofcoefficient. \nFor \
Burgers eqn with r=3 and order =3 I end up with 94583296 \nequations to \
solve. Turn back on the Union function \nbut test order 2 first.  The Union \
function reduces the\nnumber of equations from 94353296 down to only 1973 - \
an\nincredibly effective reduction.*)",
  FontWeight->"Plain",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["\n(*tableofcoefficients=tableofcoefficientsall;*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step50 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*The number of remaining coefficients after all the reductions.*)",
  FontWeight->"Plain"],
 "\ntableofcoefficientslength=Length[tableofcoefficients];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step51 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Convert each coefficient to a string.*)",
  FontWeight->"Plain"],
 "\ntableofcoefficientsstrings=\n\
Table[ToString[InputForm[tableofcoefficients[[ind]]]],\n\
{ind,1,tableofcoefficientslength}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step52 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n(*",
 StyleBox["Print[\"At this point the coefficients are converted to \
expressions. This is the set of equations that will be solved for the nonzero \
polynomial coefficients that will define the symmetries of the original \
equation(s).\"];*)\n\n(*Print[StringForm[\"Time = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 1]],
 "\n\n\n",
 StyleBox["(*Set each coefficient to zero and convert to an expression.*)",
  FontWeight->"Plain"],
 "\nrulestable1=\nTable[ToExpression[tableofcoefficientsstrings[[ind]]<>\"==0\
\"],\n{ind,1,tableofcoefficientslength}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step53 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*Create a single table of all of the unknown polynomial\n\
coefficients.*)",
  FontWeight->"Plain"],
 "\nunknowns1=Join[xsecoefficienttable,etacoefficienttable];\n\n\n",
 StyleBox["(*Flatten this table so that internal brackets are removed.*)",
  FontWeight->"Plain"],
 "\nunknowns2=Flatten[unknowns1];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step54 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\nunknowns=DeleteCases[unknowns2,0];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step55 = ``\",TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(***Be able to look at a table of the Solve equations.***)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nsolveequations=Table[tableofcoefficientsstrings[[ind]]<>\"==0\",\n\
{ind,1,tableofcoefficientslength}];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step56 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(***Be able to look at the whole set of polynomial \
coefficients.***)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nallunknowns=unknowns;\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step57 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\nallunknownslength=Length[allunknowns];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step58 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\nallunknownsexpressions=ToExpression[allunknowns];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step59 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(***Print out the number of unknowns being solved for.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "Print[StringForm[\n\"The number of unknown polynomial coefficients = \
``\",Length[allunknowns]]];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step60 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(***Print out the number of equations being solved.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "Print[StringForm[\n\"The number of equations for the polynomial \
coefficients = ``\",Length[rulestable1]]];\n",
 StyleBox["\n",
  FontColor->RGBColor[0.5, 0, 0.5]],
 StyleBox["(*Print[StringForm[\"Step61 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n\n",
 StyleBox["(*The expansion polynomials have been substituted into\nthe \
determining equations and the coefficients isolated\nto form a set of \
algebraic equations for the polynomial\ncoefficients. Not every polynomial \
coefficient appears \nin this system of equations and so the Solve function \
will\nusually return an error message that \"Equations may not give\n\
solutions for all \"solve\" variables.\" The Off function turns\nthis error \
message. There is no error here, the missing\ncoefficients simply remain free \
parameters in the infinitesimal.*)",
  FontWeight->"Plain"],
 "\nOff[Solve::svars];\n\n",
 StyleBox["(*Print[StringForm[\"Step62 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(***December 20, 2009. I looked at using the commands below in \
brown to reduce the determining equations by picking out those that involved \
setting one of the polynomial coefficients to zero and using these as rules \
to apply to the rest of the equations for the unknown coefficients. Seven \
levels of reduction were tried. In the end this made no improvement over the \
single step of just using the mathematica command Solve on the whole system. \
But note that the reduction with the mathematica commands DeleteCases and \
Union that are used above to get rid of redundant equations are extremely \
effective at reducing the number of equations to be solved. Even though this \
idea seemed to produce no improvement I am going to simply comment out the \
commands rather than remove them. One never knows when the approach might \
come in handy.***)\n",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\n",
 StyleBox["(****Comment out the seven reductions below************)\n\
(*solveequations1=solveequations;\n\n\n\
solveequations1length=Length[solveequations1];\n\n\n\
(************FirstReduction*******************************)\n\
solveequationsnoequalszero1=StringReplace[solveequations1,{\"==0\"->\"\"}];\n\
\n\nsolveequationsnoequalszeroexpressions1=ToExpression[\
solveequationsnoequalszero1];\n\n\n\
solveequationsnoequalszeroexpressionsoneterm1=Cases[\
solveequationsnoequalszeroexpressions1,x_*y_];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse1=Table[MemberQ[\
solveequationsnoequalszeroexpressionsoneterm1,allunknownsexpressions[[i]],\
Infinity],{i,1,allunknownslength}];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse1length=Length[\
solveequationsnoequalszeroexpressionsonetermtruefalse1];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero1=\
solveequationsnoequalszeroexpressionsonetermtruefalse1/.{False\[Rule]0,True\
\[Rule]1};\n\n\n\
coefficientsthatarezero1=Table[\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero1[[i]]*\
allunknownsexpressions[[i]],{i,1,allunknownslength}];\n\n\n\
coefficientsthatarezeroonly1=DeleteCases[coefficientsthatarezero1,0];\n\n\n\
coefficientsthatarezeroonly1length=Length[coefficientsthatarezeroonly1];\n\n\n\
coefficientsthatarezeroonlystrings1=Table[ToString[\
coefficientsthatarezeroonly1[[i]]]<>\"==0\",{i,1,\
coefficientsthatarezeroonly1length}];\n\n\n\
coefficientsthatarezeroonlystringsrules1=Table[ToString[\
coefficientsthatarezeroonly1[[i]]]<>\"->0\",{i,1,\
coefficientsthatarezeroonly1length}];\n\n\n\
coefficientsthatarezeroonlystringsrulesexpressions1=Table[ToExpression[\
coefficientsthatarezeroonlystringsrules1[[i]]],{i,1,\
coefficientsthatarezeroonly1length}];\n\n\n\
(******************************************************)\n\
solveequations2expressions=DeleteCases[Table[ToExpression[solveequations1[[i]]\
],{i,1,solveequations1length}]/.\
coefficientsthatarezeroonlystringsrulesexpressions1,True];\n\n\n\
solveequations2length=Length[solveequations2expressions];\n\n\n\
solveequations2=Table[ToString[solveequations2expressions[[i]]],{i,1,\
solveequations2length}];\n\n\n\
(********************************************************)\n\
(*************************SecondReduction****************)\n\
solveequationsnoequalszero2=StringReplace[solveequations2,{\"==0\"->\"\"}];\n\
\n\nsolveequationsnoequalszeroexpressions2=ToExpression[\
solveequationsnoequalszero2];\n\n\n\
solveequationsnoequalszeroexpressionsoneterm2=Cases[\
solveequationsnoequalszeroexpressions2,x_*y_];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse2=Table[MemberQ[\
solveequationsnoequalszeroexpressionsoneterm2,allunknownsexpressions[[i]],\
Infinity],{i,1,allunknownslength}];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse2length=Length[\
solveequationsnoequalszeroexpressionsonetermtruefalse2];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero2=\
solveequationsnoequalszeroexpressionsonetermtruefalse2/.{False\[Rule]0,True\
\[Rule]1};\n\n\n\
coefficientsthatarezero2=Table[\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero2[[i]]*\
allunknownsexpressions[[i]],{i,1,allunknownslength}];\n\n\n\
coefficientsthatarezeroonly2=DeleteCases[coefficientsthatarezero2,0];\n\n\n\
coefficientsthatarezeroonly2length=Length[coefficientsthatarezeroonly2];\n\n\n\
coefficientsthatarezeroonlystrings2=Table[ToString[\
coefficientsthatarezeroonly2[[i]]]<>\"==0\",{i,1,\
coefficientsthatarezeroonly2length}];\n\n\n\
coefficientsthatarezeroonlystringsrules2=Table[ToString[\
coefficientsthatarezeroonly2[[i]]]<>\"->0\",{i,1,\
coefficientsthatarezeroonly2length}];\n\n\n\
coefficientsthatarezeroonlystringsrulesexpressions2=Table[ToExpression[\
coefficientsthatarezeroonlystringsrules2[[i]]],{i,1,\
coefficientsthatarezeroonly2length}];\n\n\n\
(********************************************************)\n\
(********************************************************)\n\
solveequations3expressions=DeleteCases[Table[ToExpression[solveequations2[[i]]\
],{i,1,solveequations2length}]/.\
coefficientsthatarezeroonlystringsrulesexpressions2,True];\n\n\n\
solveequations3length=Length[solveequations3expressions];\n\n\n\
solveequations3=Table[ToString[solveequations3expressions[[i]]],{i,1,\
solveequations3length}];\n\n\n\
(*********************************************************)\n\
(*******************ThirdReduction************************)\n\
solveequationsnoequalszero3=StringReplace[solveequations3,{\"==0\"->\"\"}];\n\
\n\nsolveequationsnoequalszeroexpressions3=ToExpression[\
solveequationsnoequalszero3];\n\n\n\
solveequationsnoequalszeroexpressionsoneterm3=Cases[\
solveequationsnoequalszeroexpressions3,x_*y_];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse3=Table[MemberQ[\
solveequationsnoequalszeroexpressionsoneterm3,allunknownsexpressions[[i]],\
Infinity],{i,1,allunknownslength}];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse3length=Length[\
solveequationsnoequalszeroexpressionsonetermtruefalse3];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero3=\
solveequationsnoequalszeroexpressionsonetermtruefalse3/.{False\[Rule]0,True\
\[Rule]1};\n\n\n\
coefficientsthatarezero3=Table[\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero3[[i]]*\
allunknownsexpressions[[i]],{i,1,allunknownslength}];\n\n\n\
coefficientsthatarezeroonly3=DeleteCases[coefficientsthatarezero3,0];\n\n\n\
coefficientsthatarezeroonly3length=Length[coefficientsthatarezeroonly3];\n\n\n\
coefficientsthatarezeroonlystrings3=Table[ToString[\
coefficientsthatarezeroonly3[[i]]]<>\"==0\",{i,1,\
coefficientsthatarezeroonly3length}];\n\n\n\
coefficientsthatarezeroonlystringsrules3=Table[ToString[\
coefficientsthatarezeroonly3[[i]]]<>\"->0\",{i,1,\
coefficientsthatarezeroonly3length}];\n\n\n\
coefficientsthatarezeroonlystringsrulesexpressions3=Table[ToExpression[\
coefficientsthatarezeroonlystringsrules3[[i]]],{i,1,\
coefficientsthatarezeroonly3length}];\n\n\n\
(********************************************************)\n\
(********************************************************)\n\
solveequations4expressions=DeleteCases[Table[ToExpression[solveequations3[[i]]\
],{i,1,solveequations3length}]/.\
coefficientsthatarezeroonlystringsrulesexpressions3,True];\n\n\n\
solveequations4length=Length[solveequations4expressions];\n\n\n\
solveequations4=Table[ToString[solveequations4expressions[[i]]],{i,1,\
solveequations4length}];\n\n\n\
(********************************************************)\n\
(********************FourthReduction*********************)\n\
solveequationsnoequalszero4=StringReplace[solveequations4,{\"==0\"->\"\"}];\n\
\n\nsolveequationsnoequalszeroexpressions4=ToExpression[\
solveequationsnoequalszero4];\n\n\n\
solveequationsnoequalszeroexpressionsoneterm4=Cases[\
solveequationsnoequalszeroexpressions4,x_*y_];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse4=Table[MemberQ[\
solveequationsnoequalszeroexpressionsoneterm4,allunknownsexpressions[[i]],\
Infinity],{i,1,allunknownslength}];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse4length=Length[\
solveequationsnoequalszeroexpressionsonetermtruefalse4];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero4=\
solveequationsnoequalszeroexpressionsonetermtruefalse4/.{False\[Rule]0,True\
\[Rule]1};\n\n\n\
coefficientsthatarezero4=Table[\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero4[[i]]*\
allunknownsexpressions[[i]],{i,1,allunknownslength}];\n\n\n\
coefficientsthatarezeroonly4=DeleteCases[coefficientsthatarezero4,0];\n\n\n\
coefficientsthatarezeroonly4length=Length[coefficientsthatarezeroonly4];\n\n\n\
coefficientsthatarezeroonlystrings4=Table[ToString[\
coefficientsthatarezeroonly4[[i]]]<>\"==0\",{i,1,\
coefficientsthatarezeroonly4length}];\n\n\n\
coefficientsthatarezeroonlystringsrules4=Table[ToString[\
coefficientsthatarezeroonly4[[i]]]<>\"->0\",{i,1,\
coefficientsthatarezeroonly4length}];\n\n\n\
coefficientsthatarezeroonlystringsrulesexpressions4=Table[ToExpression[\
coefficientsthatarezeroonlystringsrules4[[i]]],{i,1,\
coefficientsthatarezeroonly4length}];\n\n\n\
(********************************************************)\n\
(********************************************************)\n\
solveequations5expressions=DeleteCases[Table[ToExpression[solveequations4[[i]]\
],{i,1,solveequations4length}]/.\
coefficientsthatarezeroonlystringsrulesexpressions4,True];\n\n\n\
solveequations5length=Length[solveequations5expressions];\n\n\n\
solveequations5=Table[ToString[solveequations5expressions[[i]]],{i,1,\
solveequations5length}];\n\n\n\
(*******************************************************)\n\
(********************FifthReduction*********************)\n\
solveequationsnoequalszero5=StringReplace[solveequations5,{\"==0\"->\"\"}];\n\
\n\nsolveequationsnoequalszeroexpressions5=ToExpression[\
solveequationsnoequalszero5];\n\n\n\
solveequationsnoequalszeroexpressionsoneterm5=Cases[\
solveequationsnoequalszeroexpressions5,x_*y_];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse5=Table[MemberQ[\
solveequationsnoequalszeroexpressionsoneterm5,allunknownsexpressions[[i]],\
Infinity],{i,1,allunknownslength}];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse5length=Length[\
solveequationsnoequalszeroexpressionsonetermtruefalse5];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero5=\
solveequationsnoequalszeroexpressionsonetermtruefalse5/.{False\[Rule]0,True\
\[Rule]1};\n\n\n\
coefficientsthatarezero5=Table[\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero5[[i]]*\
allunknownsexpressions[[i]],{i,1,allunknownslength}];\n\n\n\
coefficientsthatarezeroonly5=DeleteCases[coefficientsthatarezero5,0];\n\n\n\
coefficientsthatarezeroonly5length=Length[coefficientsthatarezeroonly5];\n\n\n\
coefficientsthatarezeroonlystrings5=Table[ToString[\
coefficientsthatarezeroonly5[[i]]]<>\"==0\",{i,1,\
coefficientsthatarezeroonly5length}];\n\n\n\
coefficientsthatarezeroonlystringsrules5=Table[ToString[\
coefficientsthatarezeroonly5[[i]]]<>\"->0\",{i,1,\
coefficientsthatarezeroonly5length}];\n\n\n\
coefficientsthatarezeroonlystringsrulesexpressions5=Table[ToExpression[\
coefficientsthatarezeroonlystringsrules5[[i]]],{i,1,\
coefficientsthatarezeroonly5length}];\n\n\n\
(********************************************************)\n\
(********************************************************)\n\
solveequations6expressions=DeleteCases[Table[ToExpression[solveequations5[[i]]\
],{i,1,solveequations5length}]/.\
coefficientsthatarezeroonlystringsrulesexpressions5,True];\n\n\n\
solveequations6length=Length[solveequations6expressions];\n\n\n\
solveequations6=Table[ToString[solveequations6expressions[[i]]],{i,1,\
solveequations6length}];\n\n\n\
(********************************************************)\n\
(*************SixthReduction*****************************)\n\
solveequationsnoequalszero6=StringReplace[solveequations6,{\"==0\"->\"\"}];\n\
\n\nsolveequationsnoequalszeroexpressions6=ToExpression[\
solveequationsnoequalszero6];\n\n\n\
solveequationsnoequalszeroexpressionsoneterm6=Cases[\
solveequationsnoequalszeroexpressions6,x_*y_];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse6=Table[MemberQ[\
solveequationsnoequalszeroexpressionsoneterm6,allunknownsexpressions[[i]],\
Infinity],{i,1,allunknownslength}];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse6length=Length[\
solveequationsnoequalszeroexpressionsonetermtruefalse6];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero6=\
solveequationsnoequalszeroexpressionsonetermtruefalse6/.{False\[Rule]0,True\
\[Rule]1};\n\n\n\
coefficientsthatarezero6=Table[\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero6[[i]]*\
allunknownsexpressions[[i]],{i,1,allunknownslength}];\n\n\n\
coefficientsthatarezeroonly6=DeleteCases[coefficientsthatarezero6,0];\n\n\n\
coefficientsthatarezeroonly6length=Length[coefficientsthatarezeroonly6];\n\n\n\
coefficientsthatarezeroonlystrings6=Table[ToString[\
coefficientsthatarezeroonly6[[i]]]<>\"==0\",{i,1,\
coefficientsthatarezeroonly6length}];\n\n\n\
coefficientsthatarezeroonlystringsrules6=Table[ToString[\
coefficientsthatarezeroonly6[[i]]]<>\"->0\",{i,1,\
coefficientsthatarezeroonly6length}];\n\n\n\
coefficientsthatarezeroonlystringsrulesexpressions6=Table[ToExpression[\
coefficientsthatarezeroonlystringsrules6[[i]]],{i,1,\
coefficientsthatarezeroonly6length}];\n\n\n\
(********************************************************)\n\
(********************************************************)\n\
solveequations7expressions=DeleteCases[Table[ToExpression[solveequations6[[i]]\
],{i,1,solveequations6length}]/.\
coefficientsthatarezeroonlystringsrulesexpressions6,True];\n\n\n\
solveequations7length=Length[solveequations7expressions];\n\n\n\
solveequations7=Table[ToString[solveequations7expressions[[i]]],{i,1,\
solveequations7length}];\n\n\n\
(*******************************************************)\n\
(****************SeventhReduction***********************)\n\
solveequationsnoequalszero7=StringReplace[solveequations7,{\"==0\"->\"\"}];\n\
\n\nsolveequationsnoequalszeroexpressions7=ToExpression[\
solveequationsnoequalszero7];\n\n\n\
solveequationsnoequalszeroexpressionsoneterm7=Cases[\
solveequationsnoequalszeroexpressions7,x_*y_];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse7=Table[MemberQ[\
solveequationsnoequalszeroexpressionsoneterm7,allunknownsexpressions[[i]],\
Infinity],{i,1,allunknownslength}];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalse7length=Length[\
solveequationsnoequalszeroexpressionsonetermtruefalse7];\n\n\n\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero7=\
solveequationsnoequalszeroexpressionsonetermtruefalse7/.{False\[Rule]0,True\
\[Rule]1};\n\n\n\
coefficientsthatarezero7=Table[\
solveequationsnoequalszeroexpressionsonetermtruefalseoneorzero7[[i]]*\
allunknownsexpressions[[i]],{i,1,allunknownslength}];\n\n\n\
coefficientsthatarezeroonly7=DeleteCases[coefficientsthatarezero7,0];\n\n\n\
coefficientsthatarezeroonly7length=Length[coefficientsthatarezeroonly7];\n\n\n\
coefficientsthatarezeroonlystrings7=Table[ToString[\
coefficientsthatarezeroonly7[[i]]]<>\"==0\",{i,1,\
coefficientsthatarezeroonly7length}];\n\n\n\
coefficientsthatarezeroonlystringsrules7=Table[ToString[\
coefficientsthatarezeroonly7[[i]]]<>\"->0\",{i,1,\
coefficientsthatarezeroonly7length}];\n\n\n\
coefficientsthatarezeroonlystringsrulesexpressions7=Table[ToExpression[\
coefficientsthatarezeroonlystringsrules7[[i]]],{i,1,\
coefficientsthatarezeroonly7length}];\n\n\n\
(*******************************************************)\n\
(*******************************************************)\n\
solveequations8expressions=DeleteCases[Table[ToExpression[solveequations7[[i]]\
],{i,1,solveequations7length}]/.\
coefficientsthatarezeroonlystringsrulesexpressions7,True];\n\n\n\
solveequations8length=Length[solveequations8expressions];\n\n\n\
solveequations8=Table[ToString[solveequations8expressions[[i]]],{i,1,\
solveequations8length}];\n\n\n\
(*******************************************************)\n\
solutionrules8=Solve[solveequations8expressions,allunknownsexpressions];\n\n\
allcoefficients=Join[coefficientsthatarezeroonlystringsrulesexpressions1,\
coefficientsthatarezeroonlystringsrulesexpressions2,\
coefficientsthatarezeroonlystringsrulesexpressions3,\
coefficientsthatarezeroonlystringsrulesexpressions4,\
coefficientsthatarezeroonlystringsrulesexpressions5,\
coefficientsthatarezeroonlystringsrulesexpressions6,\
coefficientsthatarezeroonlystringsrulesexpressions7,Flatten[solutionrules8]];\
\n\nrulestablereducedsevenlevels=allcoefficients;*)",
  FontColor->GrayLevel[0.5]],
 StyleBox["\n\n",
  FontColor->RGBColor[0.6, 0.4, 0.2]],
 StyleBox["(*Print[StringForm[\"Step63 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["\n\n",
  FontColor->RGBColor[0.6, 0.4, 0.2]],
 StyleBox["Print[\"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.\"];\n\n(*Print[StringForm[\"Time = \
``\",TimeUsed[]]];*)\n\nPrint[StringForm[\"",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["The memory in use = ``, The time = ``\",MemoryInUse[],TimeUsed[]",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["]];",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n",
  FontColor->RGBColor[0.6, 0.4, 0.2]],
 "\n",
 StyleBox["(*Solve for the constants in the 'xse' and 'eta polynomial \n\
expansions. This was commented out and is not needed with the addition above \
in brown. Dec 29, 2009, the seven level reduction above turned out to make no \
improvement so I just sticking with the original approach of using the \
function Solve on the full (reduced) system.*)",
  FontWeight->"Plain"],
 "\nrulestable=Solve[rulestable1,unknowns];\n\n",
 StyleBox["Print[\"Solve has finished.\"];\n\n(*Print[StringForm[\"Time = \
``\",TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 1]],
 "\n",
 StyleBox["(*Be able to look at the table of rules that has been produced. \
Commented out Dec 29, 2009.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0.5]],
 StyleBox["\n(*coefficientrules=rulestablereducedsevenlevels;*)\n",
  FontColor->GrayLevel[0.5]],
 "\ncoefficientrules=rulestable;\n\n",
 StyleBox["(*Print[StringForm[\"Step65 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Create a table of the nonzero polynomial coefficients.*)",
  FontWeight->"Plain",
  FontColor->GrayLevel[0]],
 StyleBox["\n(*allunknowns1a=unknowns/.rulestablereducedsevenlevels;*)\n",
  FontColor->GrayLevel[0.5]],
 "\nallunknowns1a=unknowns/.rulestable;\n\n",
 StyleBox["(*Get rid of internal brackets.*)",
  FontWeight->"Plain"],
 "\nallunknowns1=Flatten[allunknowns1a];\n\n",
 StyleBox["(*Print[StringForm[\"Step66 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*To fully isolate the nonzero group parameters let's do a \n\
comparison with the full table of polynomial coefficients.\nGenerate an index \
limit equal to the total number of \npolynomial coefficients.*)",
  FontWeight->"Plain"],
 "\nlengthunknownstable=Length[unknowns];\n\n",
 StyleBox["(*Print[StringForm[\"Step67 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Create a table with ones at the positions of the \nnonzero \
polynomial coefficients and zeros elswhere.*)",
  FontWeight->"Plain"],
 "\ngroupparametersonesandzeros=Table[If[MemberQ[allunknowns1,unknowns[[ind]],\
Infinity],1,0],{ind,1,lengthunknownstable}];\n    \n",
 StyleBox["(*Print[StringForm[\"Step68 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "    \n\n",
 StyleBox["(*Multiply the table of unknowns by the table of ones and zeros.*)",
  FontWeight->"Plain"],
 "\ngroupparameterswithzeros=unknowns*groupparametersonesandzeros;\n\n",
 StyleBox["(*Print[StringForm[\"Step69 = ``\",TimeUsed[]]];*)\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Remove all zeros to produce the table of nonzero group \
parameters.*)",
  FontWeight->"Plain"],
 "\ngroupparameters1=DeleteCases[groupparameterswithzeros,0];\n\n",
 StyleBox["(*Print[StringForm[\"Step70 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Be able to look at the table of group parameters.*)",
  FontWeight->"Plain"],
 "\ngroupparameters=groupparameters1;\n\n",
 StyleBox["(*Print[StringForm[\"Step71 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n    \n",
 StyleBox["(*Substitute these constants into the table of 'xse' infinitesimal \
functions. Here is the final result.*)",
  FontWeight->"Plain"],
 "\n",
 StyleBox["(*xseinfinitesimals1=Flatten[tableofxxsefunctions//.\
rulestablereducedsevenlevels];*)",
  FontColor->GrayLevel[0.5]],
 "\n\nxseinfinitesimals1=Flatten[tableofxxsefunctions//.rulestable];\n\n",
 StyleBox["(*Print[StringForm[\"Step72 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Insert \"xsej==\" in front of each of the xse expressions.The \n\
final output is presented as a table of strings.*)",
  FontWeight->"Plain"],
 "\nxseinfinitesimalstrings=Table[\n\"xse\"<>ToString[j]<>\n\
\"[\"<>zvariablesundefinedstring<>\"]\"<>\"=\"<>\n\
ToString[InputForm[xseinfinitesimals1[[j]]]],{j,1,numberindependentvars}];\n\n\
",
 StyleBox["(*Print[StringForm[\"Step73 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Substitute these constants into the table of 'eta' infinitesimal \
functions. here is the final result.*)",
  FontWeight->"Plain"],
 "\n",
 StyleBox["(*etainfinitesimals1=Flatten[tableofeetafunctions//.\
rulestablereducedsevenlevels];*)",
  FontColor->GrayLevel[0.5]],
 "\n\netainfinitesimals1=Flatten[tableofeetafunctions//.rulestable];\n\n",
 StyleBox["(*Print[StringForm[\"Step74 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Insert \"etai==\" in front of each of the xse expressions.The \n\
final output is presented as a table of strings.*)",
  FontWeight->"Plain"],
 "\netainfinitesimalstrings=Table[\n\"eta\"<>ToString[i]<>\n\
\"[\"<>zvariablesundefinedstring<>\"]\"<>\"=\"<>\n\
ToString[InputForm[etainfinitesimals1[[i]]]],{i,1,numberdependentvars}];\n\n\
",
 StyleBox["(*Print[StringForm[\"Step75 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Use a simpler name for the xse output table of strings.\nThis is \
the main output of the ",
  FontWeight->"Plain"],
 "SolveDeterminingEquations",
 StyleBox[" function.*)",
  FontWeight->"Plain"],
 "\nxsefunctions=xseinfinitesimalstrings;\n\n",
 StyleBox["(*Print[StringForm[\"Step76 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Use a simpler name for the eta output table of strings.\nThis is \
the main output of the ",
  FontWeight->"Plain"],
 "SolveDeterminingEquations",
 StyleBox[" function.*)",
  FontWeight->"Plain"],
 "\netafunctions=etainfinitesimalstrings;\n\n",
 StyleBox["(*Print[StringForm[\"Step77 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*The number of group parameters.*)",
  FontWeight->"Plain"],
 "\nparameterlength=Length[groupparameters1];\n\n",
 StyleBox["(*Print[StringForm[\"Step78 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Finally, here is a table of the infinitesimal groups.*)",
  FontWeight->"Plain"],
 "\ninfinitesimalgroups1=Table[Coefficient[{ToExpression[xsefunctions],\
ToExpression[etafunctions]},{groupparameters1[[ind]],groupparameters1[[ind]]}]\
,{ind,1,parameterlength}];\n          \n",
 StyleBox["(*Print[StringForm[\"Step79 = ``\",TimeUsed[]]];*)",
  FontColor->RGBColor[1, 0, 0]],
 "\n\n",
 StyleBox["(*Be able to look at the table of the infinitesimal groups.*)",
  FontWeight->"Plain"],
 "\ninfinitesimalgroups=infinitesimalgroups1;\n\n",
 StyleBox["Print[\"The function SolveDeterminingEquations is finished \
executing.\"];\n\n(*Print[StringForm[\"Time = ``\",TimeUsed[]]];*)\n\n\
Print[StringForm[\"",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["The memory in use = ``, The time = ``\",MemoryInUse[],TimeUsed[]",
  FontColor->RGBColor[1, 0, 0]],
 StyleBox["]];",
  FontColor->RGBColor[1, 0, 1]],
 StyleBox["\n",
  FontColor->RGBColor[1, 0, 0]],
 "\n",
 StyleBox["(*Tell the user the output is ready.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nPrint[\"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.\"];])\n\
(**********END*OF*FUNCTION*SolveDeterminingEquations*****)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->{{3.470158879504171*^9, 3.470158885572098*^9}, {
   3.470158937626791*^9, 3.470158954390167*^9}, {3.470158988093308*^9, 
   3.470159038350047*^9}, {3.470159076312592*^9, 3.4701591337505836`*^9}, {
   3.4701592172102222`*^9, 3.4701592696926413`*^9}, {3.470159362364081*^9, 
   3.470159392343911*^9}, {3.470159479137285*^9, 3.4701595107807426`*^9}, {
   3.470159605012418*^9, 3.470159665542933*^9}, {3.470178223922452*^9, 
   3.470178231272366*^9}, {3.470179556528922*^9, 3.470179579325636*^9}, {
   3.470180094739863*^9, 3.470180189272691*^9}, {3.4701802282045794`*^9, 
   3.4701804983732147`*^9}, {3.470180568794078*^9, 3.4701805689377317`*^9}, {
   3.470180668631432*^9, 3.4701807226839943`*^9}, {3.470180756951092*^9, 
   3.470180788149578*^9}, {3.470180947277302*^9, 3.470181398654147*^9}, {
   3.4701814377908077`*^9, 3.470181495485444*^9}, {3.470181535739641*^9, 
   3.4701816041220493`*^9}, {3.470181643647794*^9, 3.470181782796851*^9}, {
   3.470181858554926*^9, 3.4701819076395407`*^9}, {3.470181950566661*^9, 
   3.4701819793552322`*^9}, {3.4701821055838823`*^9, 3.470182232010727*^9}, {
   3.470182284941078*^9, 3.4701826984165993`*^9}, {3.4701828077522078`*^9, 
   3.470182823555735*^9}, {3.4701828848820877`*^9, 3.470182940712123*^9}, {
   3.470184279166769*^9, 3.4701843073969727`*^9}, 3.4701843858486977`*^9, {
   3.470185047847254*^9, 3.470185082456553*^9}, {3.470185191587226*^9, 
   3.470185203514131*^9}, {3.470185268529853*^9, 3.470185517241192*^9}, {
   3.470185549087192*^9, 3.470185695726165*^9}, {3.470185734707745*^9, 
   3.470186190226489*^9}, {3.470186232032902*^9, 3.4701865811162024`*^9}, {
   3.470186680896549*^9, 3.470186940702753*^9}, {3.47018730728331*^9, 
   3.470187318537279*^9}, {3.470188257937574*^9, 3.470188271559133*^9}, {
   3.4701921520340443`*^9, 3.470192206610643*^9}, {3.4701922488432407`*^9, 
   3.470192289051256*^9}, {3.470192344016368*^9, 3.4701924859987926`*^9}, {
   3.470192608588263*^9, 3.470193066548624*^9}, {3.470236395822517*^9, 
   3.470236441324589*^9}, {3.470236619622424*^9, 3.4702378143230467`*^9}, {
   3.47023784585673*^9, 3.470238165759351*^9}, {3.470257238335793*^9, 
   3.4702573808993*^9}, {3.470257667784946*^9, 3.470257761532165*^9}, {
   3.470257801114246*^9, 3.47025780876929*^9}, {3.4702732585983887`*^9, 
   3.470273391496993*^9}, {3.470273503104566*^9, 3.470273541273508*^9}, {
   3.470276671698571*^9, 3.4702766929413223`*^9}, {3.470324311686406*^9, 
   3.470324642721158*^9}, {3.4703246728990507`*^9, 3.470324734007856*^9}, {
   3.4704063946259403`*^9, 3.4704064210198803`*^9}, {3.4704064522843122`*^9, 
   3.470406566642515*^9}, {3.470406601997908*^9, 3.470406615394161*^9}, {
   3.470406651082509*^9, 3.470406733633334*^9}, {3.470583405191946*^9, 
   3.470583595778562*^9}, {3.470583847115964*^9, 3.470583910535654*^9}, {
   3.470583958357814*^9, 3.4705839854389763`*^9}, 3.4705840942324123`*^9, {
   3.470585526188201*^9, 3.470585731534313*^9}, {3.470585818106369*^9, 
   3.470585857656242*^9}, {3.470585908277421*^9, 3.470586051645609*^9}, {
   3.4705860860177927`*^9, 3.470586189622802*^9}, {3.470586291662887*^9, 
   3.4705862922567883`*^9}, {3.470586325312462*^9, 3.4705863372640457`*^9}, {
   3.4705863881669807`*^9, 3.470586405604506*^9}, {3.470586484659265*^9, 
   3.4705864929065733`*^9}, {3.470586568840436*^9, 3.470586606690145*^9}, {
   3.4705866664627934`*^9, 3.470586727652763*^9}, {3.470586783665833*^9, 
   3.4705867903593903`*^9}, {3.4705868388279543`*^9, 3.470586971203679*^9}, {
   3.470587354387918*^9, 3.470587405718286*^9}, {3.470587436609592*^9, 
   3.47058745165914*^9}, {3.470587663831291*^9, 3.470587667034978*^9}, {
   3.470588418726616*^9, 3.470588464198059*^9}, {3.470588532117178*^9, 
   3.470588752148815*^9}, {3.470588830281618*^9, 3.47058893503428*^9}, {
   3.470588967920518*^9, 3.470589117215034*^9}, {3.470925432829022*^9, 
   3.470925495583186*^9}, {3.4709257063168097`*^9, 3.470925707236396*^9}, {
   3.4709257456284723`*^9, 3.470925818168754*^9}, {3.470925937504369*^9, 
   3.4709259747339907`*^9}, {3.470926068323193*^9, 3.4709262188426847`*^9}, {
   3.47092636478494*^9, 3.470926494899928*^9}, {3.470926556875338*^9, 
   3.470926577670892*^9}, {3.4709269313060637`*^9, 3.470926996708267*^9}, {
   3.47092831986224*^9, 3.47092832229497*^9}, {3.470928371073864*^9, 
   3.470928372905464*^9}, {3.4709287966312017`*^9, 3.4709289762021646`*^9}, {
   3.4709295100821133`*^9, 3.470929637681198*^9}, {3.470930507753566*^9, 
   3.470930582183045*^9}, {3.4709312304703207`*^9, 3.470931250661746*^9}, {
   3.470931309485701*^9, 3.4709313138579884`*^9}, {3.470931654646714*^9, 
   3.47093165530087*^9}, {3.470932263660288*^9, 3.470932295391575*^9}, {
   3.4709328867562*^9, 3.470932931156629*^9}, {3.470932991758752*^9, 
   3.4709330020335913`*^9}, {3.470933264265018*^9, 3.470933375996014*^9}, {
   3.470937394374961*^9, 3.47093743349327*^9}, {3.4709374799074163`*^9, 
   3.470937498042316*^9}, {3.470937758101655*^9, 3.4709378372551727`*^9}, {
   3.470937898519247*^9, 3.4709379164003696`*^9}, {3.4709387495652657`*^9, 
   3.470938766945462*^9}, {3.4709388898015537`*^9, 3.470938921983385*^9}, 
   3.470938976016385*^9, {3.470939029694565*^9, 3.470939054004177*^9}, 
   3.4709391680645943`*^9, 3.470939214274209*^9, {3.470939605679615*^9, 
   3.470939644958275*^9}, {3.470941870415819*^9, 3.470941958237959*^9}, 
   3.4709420744505377`*^9, 3.4709421681544952`*^9, {3.470942493402398*^9, 
   3.470942542218451*^9}, {3.47094258339253*^9, 3.470942617374544*^9}, {
   3.470942650500536*^9, 3.470942667212285*^9}, {3.470943103249379*^9, 
   3.470943144026246*^9}, {3.470970296737157*^9, 3.47097036336054*^9}, {
   3.470970790108632*^9, 3.470970792588174*^9}, {3.4709709558852777`*^9, 
   3.47097097099323*^9}, {3.4709710166090183`*^9, 3.470971057751688*^9}, {
   3.470971115365163*^9, 3.4709711921613626`*^9}, {3.4709731015237207`*^9, 
   3.470973102909336*^9}, {3.470974635351424*^9, 3.4709746689139957`*^9}, {
   3.470975699269064*^9, 3.470975727503751*^9}, {3.47097577703449*^9, 
   3.470975825988806*^9}, {3.470976235682411*^9, 3.470976326118135*^9}, {
   3.4709763669982157`*^9, 3.470976390069569*^9}, {3.470976432682786*^9, 
   3.470976473855609*^9}, {3.4709765313966837`*^9, 3.4709765444196873`*^9}, {
   3.470976899103587*^9, 3.470976917804027*^9}, {3.470977165952601*^9, 
   3.470977169572877*^9}, {3.4710194953005867`*^9, 3.471019503777453*^9}, {
   3.4710195543985033`*^9, 3.471019572820869*^9}, {3.471021190315385*^9, 
   3.471021213950458*^9}, {3.471023834076783*^9, 3.4710239265117617`*^9}, {
   3.471024018737213*^9, 3.471024065508792*^9}, {3.47102414309374*^9, 
   3.471024144867446*^9}, {3.471027534437324*^9, 3.471027592356588*^9}, {
   3.471028159615746*^9, 3.471028211191717*^9}, {3.47102824926632*^9, 
   3.471028287564665*^9}, {3.471028676766564*^9, 3.471028698071725*^9}, {
   3.471028728819619*^9, 3.471028750877842*^9}, {3.471029102538561*^9, 
   3.471029124573613*^9}, {3.471029163189506*^9, 3.471029172698613*^9}, {
   3.4710292516584797`*^9, 3.471029286681739*^9}, 3.471029572967263*^9, {
   3.471033534545314*^9, 3.471033634991046*^9}, {3.471033892715948*^9, 
   3.471033892887621*^9}, {3.471049814570113*^9, 3.471049822846547*^9}, {
   3.47104987111942*^9, 3.471049881234577*^9}, {3.471120984457306*^9, 
   3.4711210061970043`*^9}, {3.4711222969761257`*^9, 3.471122325999793*^9}, {
   3.4711236283822603`*^9, 3.471123711591556*^9}, {3.47112380649196*^9, 
   3.4711241458512163`*^9}, {3.47112418023415*^9, 3.4711241853692503`*^9}, {
   3.471124224919655*^9, 3.471124314920978*^9}, {3.47112439154869*^9, 
   3.471124463616026*^9}, {3.471124496001668*^9, 3.471124884929017*^9}, {
   3.4711249237597857`*^9, 3.471125067664349*^9}, {3.471125110895706*^9, 
   3.471125216963687*^9}, {3.4711252625609083`*^9, 3.471125563651*^9}, {
   3.471125621503602*^9, 3.471125693240642*^9}, {3.471125752182863*^9, 
   3.4711261078084183`*^9}, {3.4711261483940287`*^9, 3.471126152469987*^9}, {
   3.471126183309338*^9, 3.4711261877003937`*^9}, {3.47112622244654*^9, 
   3.4711262732234917`*^9}, {3.471126313504331*^9, 3.47112639919178*^9}, {
   3.471126577366632*^9, 3.471126633689556*^9}, {3.471126684991086*^9, 
   3.47112668994215*^9}, {3.471126730492764*^9, 3.471126768354108*^9}, {
   3.4711268254426003`*^9, 3.4711269808866873`*^9}, {3.471127092105386*^9, 
   3.471127095614998*^9}, {3.471127127069827*^9, 3.4711271311730127`*^9}, {
   3.471127166123845*^9, 3.471127170306808*^9}, {3.471127203489472*^9, 
   3.471127300851945*^9}, {3.471127332844287*^9, 3.471127369680468*^9}, {
   3.471127725639616*^9, 3.471127774536141*^9}, {3.471127808167139*^9, 
   3.4711279991144648`*^9}, {3.471128032696937*^9, 3.471128047911285*^9}, {
   3.471128099383919*^9, 3.471128208949923*^9}, {3.471128299570491*^9, 
   3.471128301777811*^9}, {3.471128334488811*^9, 3.471128339847447*^9}, {
   3.471128403606635*^9, 3.4711284210929203`*^9}, {3.471128455634327*^9, 
   3.471128525925129*^9}, {3.471128663756372*^9, 3.471128798692308*^9}, {
   3.4711298355548162`*^9, 3.471129969727779*^9}, {3.4711301046654387`*^9, 
   3.471130176114377*^9}, {3.471130214408085*^9, 3.4711302854683447`*^9}, {
   3.4711303519694157`*^9, 3.471130417197575*^9}, {3.471130458451481*^9, 
   3.471130484177868*^9}, {3.471130548850279*^9, 3.471130554542533*^9}, {
   3.471130637042618*^9, 3.471130705990127*^9}, {3.471130765477697*^9, 
   3.471130770233938*^9}, {3.471130842996232*^9, 3.4711311929701*^9}, {
   3.471131243785631*^9, 3.4711312574702253`*^9}, {3.4711312917742043`*^9, 
   3.471131488633906*^9}, {3.471131574816311*^9, 3.471131837156905*^9}, {
   3.4711318701873827`*^9, 3.471131937277381*^9}, {3.4711319720213423`*^9, 
   3.471132063695363*^9}, {3.47113209791984*^9, 3.471132102437337*^9}, {
   3.471132137308255*^9, 3.471132184121234*^9}, {3.471132214180447*^9, 
   3.471132220828704*^9}, {3.471132271472628*^9, 3.4711323452643747`*^9}, {
   3.471132375863553*^9, 3.471132481232031*^9}, {3.471132517497376*^9, 
   3.471132541460147*^9}, {3.471132595409634*^9, 3.471132677540456*^9}, {
   3.471132744364644*^9, 3.471132748832541*^9}, {3.471132940618066*^9, 
   3.471132961861562*^9}, {3.471134011845232*^9, 3.471134033366523*^9}, {
   3.4711340697490597`*^9, 3.471134101178521*^9}, {3.471134165650033*^9, 
   3.471134168694481*^9}, 3.471134265393094*^9, {3.471134300286908*^9, 
   3.4711343270630217`*^9}, 3.471134378724918*^9, {3.4711344385989647`*^9, 
   3.471134547408478*^9}, {3.471134587705831*^9, 3.471134591118493*^9}, {
   3.4711347108912582`*^9, 3.4711347327666187`*^9}, {3.471134820203005*^9, 
   3.471134840239744*^9}, {3.471135257618622*^9, 3.4711353304379*^9}, {
   3.471135381355631*^9, 3.4711355404954567`*^9}, {3.471135581744177*^9, 
   3.471135656367812*^9}, {3.4711356962966423`*^9, 3.4711357173645*^9}, {
   3.471135758541936*^9, 3.471135784040847*^9}, {3.4711361505528183`*^9, 
   3.471136362207534*^9}, {3.4711364119122677`*^9, 3.471136417452733*^9}, {
   3.471136864808461*^9, 3.4711368760585814`*^9}, {3.471137130798163*^9, 
   3.471137159923336*^9}, {3.4711375958224087`*^9, 3.4711376027059917`*^9}, {
   3.4711376332959957`*^9, 3.4711376803316717`*^9}, {3.471537209358274*^9, 
   3.471537337266243*^9}, {3.471537387456449*^9, 3.471537414374496*^9}, {
   3.471537517540646*^9, 3.47153752767237*^9}, {3.471537607725862*^9, 
   3.4715376309300537`*^9}, {3.471538547118268*^9, 3.471538573533621*^9}, {
   3.4715387749070044`*^9, 3.471538826083869*^9}, {3.471539134011561*^9, 
   3.4715391472659616`*^9}, {3.471539185553039*^9, 3.4715391988954763`*^9}, 
   3.47154001316614*^9, {3.471540091007801*^9, 3.471540166414156*^9}, {
   3.471540325081758*^9, 3.471540356837089*^9}, {3.471540459066897*^9, 
   3.4715404633671513`*^9}, {3.471540494621688*^9, 3.4715405031564074`*^9}, {
   3.4715405381388607`*^9, 3.471540544089758*^9}, {3.471543154319664*^9, 
   3.471543156227499*^9}, {3.471543188286233*^9, 3.4715432213609047`*^9}, {
   3.4715434166000233`*^9, 3.47154346009956*^9}, {3.471543502357615*^9, 
   3.4715435115837584`*^9}, {3.471543575932949*^9, 3.471543585038908*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[{
 "(******BEGINNING*OF*FUNCTION*MakeCommutatorTable*********)\n",
 StyleBox["(*This function is used to generate the commutator table of the \
Lie \nalgebra of the groups contained in 'infinitesimalgroupsxy'.\nThe \
symbols used for 'independentvariables' and\n'dependentvariables' must \
correspond to the symbols in\n'infinitesimalgroupsxy'. The output is \
contained in the table\n'commutatortable'. This is the last function in the \
package.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nMakeCommutatorTable[independentvariablesstrings_, \
dependentvariablesstrings_, \n   infinitesimalgroupsxy_] := \n ",
 StyleBox["(*The function 'Module' protects variable names from the outside \
world.*)",
  FontWeight->"Plain"],
 "  \n   (Module[{nnumberindependentvars, mnumberdependentvars, \
numberofgroups, i, j, i1, j1, a, b,\n   \
independentvariables,dependentvariables}, \n   \n",
 StyleBox["(*Convert the list of independentvariables to expressions.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nindependentvariables=ToExpression[independentvariablesstrings];\n\n",
 StyleBox["(*Convert the list of dependentvariables to expressions.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ndependentvariables=ToExpression[dependentvariablesstrings];\n    \n",
 StyleBox["(*The number of independent variables.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nnnumberindependentvars = Length[independentvariables]; \n    \n",
 StyleBox["(*The number of dependent variables.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nmnumberdependentvars = Length[dependentvariables]; \n    \n",
 StyleBox["(*The number of groups in the list infinitesimalgroupsxy.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nnumberofgroups = \n  Length[infinitesimalgroupsxy]; \n     \n",
 StyleBox["(*Construct the commutator table.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\ncommutatortable = \n  Table[{Table[Sum[infinitesimalgroupsxy[[a,1,j1]]*\n \
          D[infinitesimalgroupsxy[[b,1,j]], independentvariables[[j1]]], \n   \
       {j1, 1, nnumberindependentvars}] + \
Sum[infinitesimalgroupsxy[[a,2,i1]]*\n           \
D[infinitesimalgroupsxy[[b,1,j]], dependentvariables[[i1]]], \n          {i1, \
1, mnumberdependentvars}] - Sum[infinitesimalgroupsxy[[b,1,j1]]*\n           \
D[infinitesimalgroupsxy[[a,1,j]], independentvariables[[j1]]], \n          \
{j1, 1, nnumberindependentvars}] - Sum[infinitesimalgroupsxy[[b,2,i1]]*\n     \
      D[infinitesimalgroupsxy[[a,1,j]], dependentvariables[[i1]]], \n         \
 {i1, 1, mnumberdependentvars}], {j, 1, nnumberindependentvars}], \n       \
Table[Sum[infinitesimalgroupsxy[[a,1,j1]]*D[infinitesimalgroupsxy[[b,2,\n     \
        i]], independentvariables[[j1]]], {j1, 1, nnumberindependentvars}] + \
\n         Sum[infinitesimalgroupsxy[[a,2,i1]]*D[infinitesimalgroupsxy[[b,2,\n\
             i]], dependentvariables[[i1]]], {i1, 1, mnumberdependentvars}] - \
\n         Sum[infinitesimalgroupsxy[[b,1,j1]]*D[infinitesimalgroupsxy[[a,2,\n\
             i]], independentvariables[[j1]]], {j1, 1, \
nnumberindependentvars}] - \n         \
Sum[infinitesimalgroupsxy[[b,2,i1]]*D[infinitesimalgroupsxy[[a,2,\n           \
  i]], dependentvariables[[i1]]], {i1, 1, mnumberdependentvars}], {i, 1, \
mnumberdependentvars}]}, \n      {a, 1, numberofgroups}, {b, 1, \
numberofgroups}];\n      \n      ",
 StyleBox["(*Tell the user the output is ready.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nPrint[\"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.\"];])\n \
(*****END*OF*FUNCTION*MakeCommutatorTable********************)"
}], "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 CellChangeTimes->{{3.47113260091496*^9, 3.471132606784225*^9}}],

Cell[TextData[{
 StyleBox["(*Note that this is not an initialization cell.*)",
  FontWeight->"Plain",
  FontVariations->{"CompatibilityType"->0}],
 "\nEnd[]"
}], "Input",
 PageWidth->PaperWidth],

Cell[BoxData[
 RowBox[{
  RowBox[{"Protect", "[", 
   RowBox[{
   "GenerateVariableTable", ",", "SecondTerm", ",", "PthInfinitesimal", ",", 
    "GenerateInfinitesimalTable", ",", "InvarianceConditionNoRules", ",", 
    "InvarianceConditionRulesApplied", ",", "MakeRulesArray", ",", 
    "FindDeterminingEquations", ",", "SolveDeterminingEquations", ",", 
    "MakeCommutatorTable"}], "]"}], ";"}]], "Input",
 PageWidth->PaperWidth],

Cell["EndPackage[]", "Input",
 PageWidth->PaperWidth,
 InitializationCell->True,
 ImageRegion->{{0, 1}, {0, 1}}]
},
AutoGeneratedPackage->Automatic,
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{842, 1024},
WindowMargins->{{31, Automatic}, {Automatic, 31}},
PrintingCopies->1,
PrintingPageRange->{1, Automatic},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
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, 132, 3, 27, "Input",
 InitializationCell->True],
Cell[680, 25, 11365, 167, 2640, "Input",
 InitializationCell->True],
Cell[12048, 194, 880, 19, 235, "Input",
 InitializationCell->True],
Cell[12931, 215, 16107, 237, 5227, "Input",
 InitializationCell->True],
Cell[29041, 454, 157, 3, 27, "Input",
 InitializationCell->True],
Cell[29201, 459, 151, 3, 27, "Input",
 InitializationCell->True],
Cell[29355, 464, 404, 10, 105, "Input",
 InitializationCell->True],
Cell[29762, 476, 411, 11, 118, "Input",
 InitializationCell->True],
Cell[30176, 489, 434, 11, 105, "Input",
 InitializationCell->True],
Cell[30613, 502, 508, 12, 144, "Input",
 InitializationCell->True],
Cell[31124, 516, 493, 11, 144, "Input",
 InitializationCell->True],
Cell[31620, 529, 827, 17, 274, "Input",
 InitializationCell->True],
Cell[32450, 548, 583, 13, 170, "Input",
 InitializationCell->True],
Cell[33036, 563, 957, 20, 287, "Input",
 InitializationCell->True],
Cell[33996, 585, 883, 18, 300, "Input",
 InitializationCell->True],
Cell[34882, 605, 577, 13, 183, "Input",
 InitializationCell->True],
Cell[35462, 620, 325, 9, 40, "Input"],
Cell[35790, 631, 938, 27, 58, "Input"],
Cell[36731, 660, 327, 9, 66, "Input",
 InitializationCell->True],
Cell[37061, 671, 6579, 129, 2185, "Input",
 InitializationCell->True],
Cell[43643, 802, 2756, 58, 820, "Input",
 InitializationCell->True],
Cell[46402, 862, 4335, 80, 1223, "Input",
 InitializationCell->True],
Cell[50740, 944, 8597, 180, 2653, "Input",
 InitializationCell->True],
Cell[59340, 1126, 9947, 200, 2575, "Input",
 InitializationCell->True],
Cell[69290, 1328, 6001, 123, 1730, "Input",
 InitializationCell->True],
Cell[75294, 1453, 20398, 351, 7203, "Input",
 InitializationCell->True],
Cell[95695, 1806, 70512, 1612, 14938, "Input",
 InitializationCell->True],
Cell[166210, 3420, 76733, 1535, 20112, "Input",
 InitializationCell->True],
Cell[242946, 4957, 4260, 75, 1171, "Input",
 InitializationCell->True],
Cell[247209, 5034, 194, 6, 40, "Input"],
Cell[247406, 5042, 432, 9, 103, "Input"],
Cell[247841, 5053, 112, 3, 27, "Input",
 InitializationCell->True]
}
]
*)

(* End of internal cache information *)
