In this example we use the package IntroToSymmetry.m to work out point and Lie-Backlund groups of the Burgers potential equation, 

Uxx-(1/2)Ux^2-Ut=0.

This next command turns off spurious spelling error warnings.

Off[General::spell]

Clear all symbols in the current context.

ClearAll[Evaluate[Context[]<>"*"]]

First read in the package which is located in User Home Folder/Library/Mathematica/Applications/SymmetryAnalysis.

Needs["SymmetryAnalysis`IntroToSymmetry`"]

Enter the input equation as a string. Don't include the == 0 at the end.

inputequation=
"D[U[x,t],t]+(1/2)*D[U[x,t],x]^2-D[U[x,t],x,x]";

The function U[x,t] is a solution of the equation and this constraint must be applied in the form of a rule to the invariance condition. Be careful to check signs.

rulesarray=
{"D[U[x,t],x,x]->D[U[x,t],t]+(1/2)*D[U[x,t],x]^2"};

Enter the list of independent variables.

independentvariables={"x","t"};

Enter the list of dependent variables.

dependentvariables={"U"};

Enter the list of function and/or constant names that need to be preserved when the equation is expressed in terms of generic variables.

frozennames={};

Enter the maximum derivative order of the input equation(s).

porder=2;

The maximum derivative order that the infinitesimals are assumed to depend on is specified by the input parameter rorder. This parameter is only nonzero when the user is looking for Lie contact groups or Lie-Backlund groups. For the usual case where one is searching for point groups set rorder=0.

rorder=0;

When searching for Lie-Backlund groups (rorder=1 or greater) one can, without loss of generality, leave the independent variables untransformed. The corresponding infinitesimals (the xse's) are set to zero by setting xseon=0. If one is searching for point groups then set xseon=1. The choice xseon=1 is also an option when looking for Lie-Backlund groups and this can be useful when looking for contact symmetries.

xseon=1;

When searching for Lie-Backlund groups it is necessary to differentiate the input equation to produce derivatives of order p+r and append these higher order differential consequences to the set of rules applied to the invariance condition. This process is carried out automatically when internalrules=1. For point groups the equation or equation system is the only rule or set of rules needed and one sets internalrules=0.

internalrules=0;

Now work out the determining equations of the Lie point group that leaves the equation invariant. The output is available as a table of strings called zdeterminingequations.

Timing[FindDeterminingEquations[
independentvariables,dependentvariables,frozennames,porder,rorder,xseon,
inputequation,rulesarray,internalrules]]

Let's look at the partial derivatives of Burgers equation thatappear in the invariance condition.

invarconditiontable

Here are the determining equations in terms of z-variables.

zdeterminingequations;

Length[zdeterminingequations]

Here is the correspondence between z-variables and conventional variables.

ztableofrules

Now solve the determining equations in terms of multivariable polynomials. The Mathematica function Solve uses Gaussian elimination to solve a large number of linear equations for the polynomial coefficients. The time roughly follows

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

where the exponent is between 2.4 and 2.7. The Mathematica function Timing outputs the time required for the SolveDeterminingEquations function to execute.

Timing[SolveDeterminingEquations[
independentvariables,dependentvariables,rorder,xseon,zdeterminingequations,polyorder=2]]

Here are the infinitesimal transformation functions for the independent variables.

xsefunctions

and for the dependent variables.

etafunctions

Usually Burger's equation is expressed in terms of x, t and U.Express the xse functions in terms of these variables.

ToExpression[xsefunctions]/.{z1->x,z2->t,z3->U}

Express the eta function in terms of these variables.

ToExpression[etafunctions]/.{z1->x,z2->t,z3->U}

infinitesimalgroups1=infinitesimalgroups/.{z1->x,z2->t,z3->U};

Check the groups.xse's are on the left,eta's are on the right.

Column[infinitesimalgroups1]

Check the infinitesimals in the determining equations.

Simplify[ToExpression[zdeterminingequations]]

This is the six-parameter point group of the Burger's potential equation. Note that the package does not capture the infinite parameter group involving an arbitrary solution of the heat equation. This is discussed extensively in Chapter 14 and Chapter 16. Let's construct the commutator table.

MakeCommutatorTable[
independentvariables,dependentvariables,infinitesimalgroups1]

MatrixForm[commutatortable]

Note that the package does not capture the infinite parameter group involving an arbitrary solution of the heat equation. This is discussed extensively in Chapter 14 and Chapter 16. Let's see if we can find this group using a slightly different approach to the invariance condition.

rorder=0

Turn off the transformation of independent variables.

xseon=0

Timing[FindDeterminingEquations[independentvariables,dependentvariables,frozennames,porder,rorder,xseon,inputequation,rulesarray,internalrules]]

zdeterminingequations1=ToExpression[zdeterminingequations]/.{z1->x,z2->t,z3->U}

Note that we are now just looking for a single unknown eta1 and it is a point group. This is an example where we can turn off the transformation of independent variables and still look 
  for a point group rather than a Lie Backlund Group. The frst determining equation is
   
  (1/2)eta1u-eta1uu==0.
  
  This is clearly satisfied by a function of the form 
  
  eta1=f[x,t]Exp[u/2]. 
  
  The third equation is also satisfied by the same function. Let's check

eta1[x_,t_,U_]:=f[x,t]*Exp[U/2]

Column[Simplify[zdeterminingequations1]]

The invariance condition is satisfied if f[x,t] is a solution of the heat equation.

By summing the Lie series, this infinitesimal group generates a solution of the Burgers potential equation in the form of the corresponding finite transformation. Let's check this solution in the equation. The solution is

Utilda[x_,t_]:=U[x,t]-2*Log[1-(s/2)*f[x,t]*Exp[U[x,t]/2]]

D[Utilda[x,t],t]+(1/2)*D[Utilda[x,t],x]^2-D[Utilda[x,t],x,x]

ExpandAll[%]

Cancel[%]

This is the Burgers potential equation plus a term proportional to f[x,t] substituted into the heat equation plus the Burgers potential equation multiplied by f[x,t]*Exp[-U[x,t]. As long as U[x,t] is a solution of the Burgers potential equation and f[x,t] is a solution of the heat equation then Utilda is a solution.

*************************************************************

Let's use the package to work out the first order order Lie-Backlund groups of the Burgers potential equation.

rorder=1;

xseon=0;

internalrules=1;

Timing[FindDeterminingEquations[independentvariables,dependentvariables,frozennames,porder,rorder,xseon,inputequation,rulesarray,internalrules]]

Timing[SolveDeterminingEquations[independentvariables,dependentvariables,rorder,xseon,
zdeterminingequations,polyorder=4]]

ToExpression[xsefunctions]/.
{z1->x,z2->t,z3->U,z4->Ux,z5->Ut}

ToExpression[etafunctions]/.
{z1->x,z2->t,z3->U,z4->Ux,z5->Ut}

Column[infinitesimalgroups]/.{z1->x,z2->t,z3->U,z4->Ux,z5->Ut}

Check the infinitesimals in the determining equations.

Simplify[ToExpression[zdeterminingequations]]

These are the six first-order Lie-Backlund symmetries corresponding to the point groups of the Burgers potential equation.

MaxMemoryUsed[ ]