Quit[];

(* Set the Directory where you have saved the codes DDERecursionOperator.m and InvariantsSymmetries.m and this notebook *)

SetDirectory["e:\\data\\demoDDERecursionOperator\\onwebJune3-2010"]

Get["DDERecursionOperator.m"]

Volterra (KvM) Equation (ref.[1])

volterraResult = DDERecursionOperator[{D[u[n,t],t]-(u[n,t]*(u[n+1,t]-u[n-1,t]))==0},{u},{n,t}]

volterraRecursionOperator=First[volterraResult]

Checking  if we get the next symmetry after applying the recursion operator to the known first symmetry, i.e. the Volterra lattice itself, and subtracting the known second symmetry. The test should give a zero:

knownVolterraFirstSymmetry={u[n,t]*(u[n+1,t]-u[n-1,t])}

knownVolterraSecondSymmetry = {-u[-2+n,t] u[-1+n,t] u[n,t]-((u[-1+n,t])^2) u[n,t]-u[-1+n,t] ((u[n,t])^2)+((u[n,t])^2) u[1+n,t]+u[n,t] ((u[1+n,t])^2)+u[n,t] u[1+n,t] u[2+n,t]}

testVolterra = GenerateSymmetries[volterraRecursionOperator,knownVolterraFirstSymmetry,1][[1]]-knownVolterraSecondSymmetry//Expand

Evaluating the second symmetry from the first symmetry:

computedVolterraSecondSymmetry = GenerateSymmetries[volterraRecursionOperator,knownVolterraFirstSymmetry,1][[1]]

Evaluating the third symmetry from the second symmetry computed above:

computedVolterraThirdSymmetry = GenerateSymmetries[volterraRecursionOperator,computedVolterraSecondSymmetry,1][[1]]

Given the first symmetry and evaluating the next 3 symmetries starting from the first one (this may take a bit of time, and the output is long -- scroll horizontally to the right to see all the pieces):

GenerateSymmetries[volterraRecursionOperator,knownVolterraFirstSymmetry,3]//TableForm

Modified Volterra Equation (ref.[1])

(* The computation of the recursion operator for the modified Volterra equation is very, very slow *)

modifiedVolterraResult = Timing[DDERecursionOperator[{D[u[n,t],t]-(u[n,t]^2*(u[n+1,t]-u[n-1,t]))==0},{u},{n,t}]]

(* expectedResult= {{{(1/2) DiscreteShift[#1,{n,-1}] ((u[n,t])^2)+(1/2) DiscreteShift[#1,{n,1}] ((u[n,t])^2)+#1 u[n,t] u[1+n,t]+(Subscript[△, n]^(-1))[((#1)/(u[n,t])),{n,t}] (-u[-1+n,t] ((u[n,t])^2)+((u[n,t])^2) u[1+n,t])&}}} *)

modifiedVolterraRecursionOperator=modifiedVolterraResult[[2]]

Checking if we get the known second symmetry after applying the recursion operator to the known first symmetry, which is the modified Volterra lattice,  (we need to multiply the know first symmetry by 2) --- the test should produce a zero:

knownModifiedVolterraFirstSymmetry =u[n,t]^2*(u[n+1,t]-u[n-1,t])

knownModifiedVolterraSecondSymmetry = {-u[-2+n,t] ((u[-1+n,t])^2) ((u[n,t])^2)-((u[-1+n,t])^2) ((u[n,t])^3)+((u[n,t])^3) ((u[1+n,t])^2)+((u[n,t])^2) ((u[1+n,t])^2) u[2+n,t]}

testModifiedVolterra = GenerateSymmetries[modifiedVolterraRecursionOperator,{2*knownModifiedVolterraFirstSymmetry},1][[1]]-knownModifiedVolterraSecondSymmetry//Expand

Evaluating the second symmetry (first symmetry is multiplied by 2):

computedModifiedVolterraSecondSymmetry = GenerateSymmetries[modifiedVolterraRecursionOperator,{2*knownModifiedVolterraFirstSymmetry},1][[1]]

Evaluating the third symmetry from the second symmetry computed above:

computedModifiedVolterraThirdSymmetry = GenerateSymmetries[modifiedVolterraRecursionOperator,computedModifiedVolterraSecondSymmetry,1][[1]]

Evaluating the next 3 symmetries starting from the first one (first symmetry is multiplied by 2):

modifiedVolterraFirstSymmetry={2*knownModifiedVolterraFirstSymmetry}

GenerateSymmetries[modifiedVolterraRecursionOperator,modifiedVolterraFirstSymmetry,3]//TableForm

Toda Lattice (ref.[1])

TodaResult = DDERecursionOperator[{D[u[n,t],t]-(v[n-1,t]-v[n,t])==0,D[v[n,t],t]-v[n,t]*(u[n,t]-u[n+1,t])==0},{u,v},{n,t}]

TodaRecursionOperator=First[TodaResult]

Checking if we can get the second known symmetry after applying the recursion operator to the known first symmetry, i.e., the Toda lattice itself. The test should give a couple of zeros:

knownTodaFirstSymmetry ={-v[-1+n,t]+v[n,t],-u[n,t] v[n,t]+u[1+n,t] v[n,t]}

knownTodaSecondSymmetry = {-u[-1+n,t] v[-1+n,t]-u[n,t] v[-1+n,t]+u[n,t] v[n,t]+u[1+n,t] v[n,t],-((u[n,t])^2) v[n,t]+((u[1+n,t])^2) v[n,t]-v[-1+n,t] v[n,t]+v[n,t] v[1+n,t]}

testToda = GenerateSymmetries[TodaRecursionOperator,knownTodaFirstSymmetry,1][[1]]-knownTodaSecondSymmetry//Expand

Evaluating the second symmetry:

computedTodaSecondSymmetry = GenerateSymmetries[TodaRecursionOperator,knownTodaFirstSymmetry,1][[1]]

Evaluating the third symmetry:

computedTodaThirdSymmetry = GenerateSymmetries[TodaRecursionOperator,computedTodaSecondSymmetry,1][[1]]

Evaluating the next 3 symmetries starting from the known first symmetry :

GenerateSymmetries[TodaRecursionOperator,knownTodaFirstSymmetry,3]//TableForm

The Ablowitz-Ladik Lattice (ref.[1])

ALResult = DDERecursionOperator[{D[u[n,t],t]-(u[n+1,t]-2*u[n,t]+u[n-1,t])-u[n,t]*v[n,t]*(u[n+1,t]+u[n-1,t])==0,D[v[n,t],t]+(v[n+1,t]-2*v[n,t]+v[n-1,t])+u[n,t]*v[n,t]*(v[n+1,t]+v[n-1,t])==0},{u,v},{n,t},WeightRules->{Weight[t]->-1,Weight[u]->1/2,Weight[v]->1/2},HadToUseWeightedParameters->True]

The first operator above is just the Identity operator. So, we will proceed with the other TWO operators :

ALRecursionOperatorR1=ALResult[[2]]

ALRecursionOperatorR2=Last[ALResult]

AL lattice has two series (branches) of symmetries: one branch is produced by ALRecursionOperatorR1 (R1); the other branch is produced by ALRecursionOperatorR2 (R2).

First,  let us check if R1 produces to the first symmetry gives the known second symmetry (both of the first branch of symmetries) (first symmetry is multiplied by -1) -- the test should be zero:

ALtestR1 = GenerateSymmetries[ALRecursionOperatorR1,{u[n,t],-v[n,t]},1][[1]]-{-u[1+n,t]-u[n,t] u[1+n,t] v[n,t],v[-1+n,t]+u[n,t] v[-1+n,t] v[n,t]}//Expand

Evaluating the second symmetry (first symmetry is multiplied by -1) :

ALSecondSymmetryR1 = GenerateSymmetries[ALRecursionOperatorR1,{u[n,t],-v[n,t]},1][[1]]

Evaluating the third symmetry:

ALThirdSymmetryR1 = GenerateSymmetries[ALRecursionOperatorR1,ALSecondSymmetryR1,1][[1]]

Evaluating the fourth symmetry:

ALFourthSymmetryR1 = GenerateSymmetries[ALRecursionOperatorR1,ALThirdSymmetryR1,1][[1]]

Evaluating the next 4 symmetries starting from the first one (first symmetry is multiplied by -1)-- the expressions are long, scroll horizontally to the right:

knownALFirstSymmetryBranch1={u[n,t],-v[n,t]}

GenerateSymmetries[ALRecursionOperatorR1,knownALFirstSymmetryBranch1,4]//TableForm

Now we apply ALRecursionOperatorR2 (R2). First, let us check if R2 produces the known second symmetry (of the second branch of symmetries). Again this test should give zero:

testALR2= GenerateSymmetries[ALRecursionOperatorR2,{-u[n,t],v[n,t]},1][[1]]-{-u[-1+n,t]-u[-1+n,t] u[n,t] v[n,t],v[1+n,t]+u[n,t] v[n,t] v[1+n,t]}//Expand

Evaluating the second symmetry :

ALSecondSymmetryR2 = GenerateSymmetries[ALRecursionOperatorR2,{-u[n,t],v[n,t]},1][[1]]

Evaluating the third symmetry:

ALThirdSymmetryR2 = GenerateSymmetries[ALRecursionOperatorR2,ALSecondSymmetryR2 ,1][[1]]

Evaluating the fourth symmetry:

ALFourthSymmetryR2  = GenerateSymmetries[ALRecursionOperatorR2,ALThirdSymmetryR2 ,1][[1]]

Evaluating the next 3 symmetries starting from the first one:

knownALFirstSymmetryBranch2={-u[n,t],v[n,t]};
GenerateSymmetries[ALRecursionOperatorR2,knownALFirstSymmetryBranch2,3]//TableForm

Next, let us verify that the recursion operator R2 satisfies the defining equation for the recursion operator :

{F1,F2}={u[-1+n,t]-2 u[n,t]+u[1+n,t]+u[-1+n,t] u[n,t] v[n,t]+u[n,t] u[1+n,t] v[n,t],-v[-1+n,t]+2 v[n,t]-u[n,t] v[-1+n,t] v[n,t]-v[1+n,t]-u[n,t] v[n,t] v[1+n,t]};
R0={{function[(1+u[n,t] v[n,t])**discreteShift[#1,{n,-1}]],function[(-u[-1+n,t] u[n,t])**#1]},{function[(v[n,t] v[1+n,t])**#1],function[(1+u[n,t] v[n,t])**discreteShift[#1,{n,1}]+((+1)**(u[-1+n,t] v[n,t])+u[n,t] v[1+n,t])**#1]}};
R1={{function[(+1)**(-u[n,t])**inverseDifferenceDelta[v[1+n,t]**#1,{n,t}]+(+1)**(-u[-1+n,t]-u[-1+n,t] u[n,t] v[n,t])**inverseDifferenceDelta[((v[n,t])/(1+u[n,t] v[n,t]))**#1,{n,t}]],function[(+1)**(-u[n,t])**inverseDifferenceDelta[u[-1+n,t]**#1,{n,t}]+(+1)**(-u[-1+n,t]-u[-1+n,t] u[n,t] v[n,t])**inverseDifferenceDelta[((u[n,t])/(1+u[n,t] v[n,t]))**#1,{n,t}]]},{function[(+1)**v[n,t]**inverseDifferenceDelta[v[1+n,t]**#1,{n,t}]+(+1)**(v[1+n,t]+u[n,t] v[n,t] v[1+n,t])**inverseDifferenceDelta[((v[n,t])/(1+u[n,t] v[n,t]))**#1,{n,t}]],function[(+1)**v[n,t]**inverseDifferenceDelta[u[-1+n,t]**#1,{n,t}]+(+1)**(v[1+n,t]+u[n,t] v[n,t] v[1+n,t])**inverseDifferenceDelta[((u[n,t])/(1+u[n,t] v[n,t]))**#1,{n,t}]]}};

R=(R0+R1 /. {a_.*function[b_]+c_.*function[d_]:> function[a*b+c*d]});

FPrime={{(1+u[n,t] v[n,t])**discreteShift[#1,{n,-1}]+(1+u[n,t] v[n,t])**discreteShift[#1,{n,1}]+(-2+u[-1+n,t] v[n,t]+u[1+n,t] v[n,t])**#1&,(u[-1+n,t] u[n,t]+u[n,t] u[1+n,t])**#1&},{(-v[-1+n,t] v[n,t]-v[n,t] v[1+n,t])**#1&,(-1-u[n,t] v[n,t])**discreteShift[#1,{n,-1}]+(-1-u[n,t] v[n,t])**discreteShift[#1,{n,1}]+(2-u[n,t] v[-1+n,t]-u[n,t] v[1+n,t])**#1&}};

obstr=Integrability`DDERecursionOperator`Private`FrechetDerivativeOfR0InDirectionOfF[{F1,F2},R0,{u,v},{n,t},function,discreteShift] +Integrability`DDERecursionOperator`Private`FrechetDerivativeOfR1InDirectionOfF[{F1,F2},R1,{u,v},{n,t},function,inverseDifferenceDelta]+Integrability`DDERecursionOperator`Private`CompositionOfOperators[R/.function->Function,FPrime,function,discreteShift,inverseDifferenceDelta,n,t]-Integrability`DDERecursionOperator`Private`CompositionOfOperators[FPrime,R/.function->Function,function,discreteShift,inverseDifferenceDelta,n,t];

obstr=obstr//.a_.*function[b_]+c_.*function[d_]:> function[a*b+c*d];

obstr=obstr/.function[a_]:> function[Expand[a]];

(((obstr/.function->Identity)/.{a_.*inverseDifferenceDelta[b_.*Slot[1],{n,t}]:>Together[a]*inverseDifferenceDelta[Together[b]*Slot[1],{n,t}],
a_.*discreteShift[b_.*Slot[1],{n,k_}]:> Together[a]*discreteShift[b*Slot[1],{n,k}]})//.
{
a_.*discreteShift[Slot[1],{n,k_}]+b_.*discreteShift[Slot[1],{n,k_}]:> Together[a+b]*discreteShift[Slot[1],{n,k}],

a_.*Slot[1]+b_.*Slot[1]:> Together[a+b]*Slot[1],

a_.*inverseDifferenceDelta[b_.*Slot[1],{n,t}]+c_.*inverseDifferenceDelta[b_.*Slot[1],{n,t}]:> Together[(a+c)]*inverseDifferenceDelta[b*Slot[1],{n,t}],

a_.*inverseDifferenceDelta[b_.*Slot[1],{n,t}]+a_.*inverseDifferenceDelta[c_.*Slot[1],{n,t}]:> a*inverseDifferenceDelta[Together[(b+c)]*Slot[1],{n,t}]
})//.{
inverseDifferenceDelta[a_*b_/;FreeQ[a,Slot|n|t],{n,t}]:>a*inverseDifferenceDelta[b,{n,t}],

discreteShift[a_*b_/;FreeQ[a,Slot|n|t],{n,m_}]:>a*discreteShift[b,{n,m}],

inverseDifferenceDelta[0,{n,t}]->0
}

Relativistic Toda (RT) Lattice (ref.[2])

relativisticTodaResult = DDERecursionOperator[{D[v[n,t],t]-v[n,t](u[n-1,t]-u[n,t])==0,D[u[n,t],t]-u[n,t]*(u[n-1,t]-u[n+1,t]-v[n+1,t]+v[n,t])==0},{v,u},{n,t}]

relativisticTodaRecursionOperator=First[relativisticTodaResult]

Checking if we get the known second symmetry after applying the recursion operator to the known first symmetry (test should be zero):

knownRelativisticTodaFirstSymmetry = {u[-1+n,t] v[n,t]-u[n,t] v[n,t],u[-1+n,t] u[n,t]-u[n,t] u[1+n,t]+u[n,t] v[n,t]-u[n,t] v[1+n,t]}

knownRelativisticTodaSecondSymmetry = {u[-2+n,t] u[-1+n,t] v[n,t]+((u[-1+n,t])^2) v[n,t]-((u[n,t])^2) v[n,t]-u[n,t] u[1+n,t] v[n,t]+u[-1+n,t] v[-1+n,t] v[n,t]+u[-1+n,t] ((v[n,t])^2)-u[n,t] ((v[n,t])^2)-u[n,t] v[n,t] v[1+n,t],u[-2+n,t] u[-1+n,t] u[n,t]+((u[-1+n,t])^2) u[n,t]+u[-1+n,t] ((u[n,t])^2)-((u[n,t])^2) u[1+n,t]-u[n,t] ((u[1+n,t])^2)-u[n,t] u[1+n,t] u[2+n,t]+u[-1+n,t] u[n,t] v[-1+n,t]+2 u[-1+n,t] u[n,t] v[n,t]+((u[n,t])^2) v[n,t]+u[n,t] ((v[n,t])^2)-((u[n,t])^2) v[1+n,t]-2 u[n,t] u[1+n,t] v[1+n,t]-u[n,t] ((v[1+n,t])^2)-u[n,t] u[1+n,t] v[2+n,t]}

testRelativisticToda = GenerateSymmetries[relativisticTodaRecursionOperator,knownRelativisticTodaFirstSymmetry ,1][[1]]-knownRelativisticTodaSecondSymmetry//Expand

Evaluating the second symmetry:

computedRelativisticTodaSecondSymmetry = GenerateSymmetries[relativisticTodaRecursionOperator,{u[-1+n,t] v[n,t]-u[n,t] v[n,t],u[-1+n,t] u[n,t]-u[n,t] u[1+n,t]+u[n,t] v[n,t]-u[n,t] v[1+n,t]},1][[1]]

Evaluating the third symmetry:

computedRelativisticTodaThirdSymmetry = GenerateSymmetries[relativisticTodaRecursionOperator,computedRelativisticTodaSecondSymmetry,1][[1]]

Evaluating the next 3 symmetries starting from the first known symmetry (scroll horizontally to to the right to see the whole result):

GenerateSymmetries[relativisticTodaRecursionOperator,knownRelativisticTodaFirstSymmetry,3]//TableForm

References

1) W. Hereman, J.A. Sanders, J. Sayers, and J. P. Wang, Symbolic Computation of Polynomial Conserved Densities, Generalized Symmetries, and Recursion Operators for Nonlinear Differentia-Difference Equations. In: Group Theory and Numerical Analysis, CRM Proceedings and Lecture Series 39, Eds.: P. Winternitz, D. Gomez-Ullate, A. Iserles, D. Levi, P. J. Olver, R. Quispel, and P. Tempesta, American Mathematical Society, Providence, Rhode Island (2005), 267-282.

2) R. Sahadevan and S. Khousalya, Belov-Chaltikian and Blaszak-Marciniak Lattice Equations: Recursion Operators and Factorization, J. Math. Phys. 44-2, 2003, 882-898.