(* Confirming the c's in expXexpY by showing that

   exp(x)*exp(y) and exp(c[1][x,y]+...+c[9][x,y])

   agree up to t^9, where x= t X and y=t Y.

   Due to the limitation of both computer memory and 
   Mathematica software, expanding exp(x), exp(y), ...
   has to be done a bit by bit as below.   

                         Ren-Cang Li, June 1, 1996
                         na.rcli@na-net.ornl.gov    *)

(* Rules for non-commutative product Mm[x,y] *)
Mm[a___,y_+z_,b___]:=Mm[a,y,b]+Mm[a,z,b]; 
Mm[a___,x_ X, b___]:=x Mm[a,X,b];
Mm[a___,x_ Y, b___]:=x Mm[a,Y,b];
Mm[a___,x_ y_Mm, b___]:=x Mm[a,y,b];
Mm[a___,n_?NumberQ x_, b___]:=n Mm[a,x,b];

SetAttributes[Mm, Flat];

(* Define bracket *)
Cmt[x_,y_]:=Mm[x,y]-Mm[y,x];

$RecursionLimits=1024;

x= t X; y=t Y;

(* Loading c[i][*,*] *)
<<expXexpY;

DEGREE=9;
w=Sum[c[i][x,y],{i,DEGREE}];
w=Expand[w];

MmPoly[p_,q_]:=Block[{coefp=CoefficientList[p,t],coefq=CoefficientList[q,t],
	 pq, k, i},
	 pq=Expand[coefp[[1]] q+p coefq[[1]]- coefp[[1]] coefq[[1]]];
	 Do[{pq=pq+Expand[Sum[Mm[Expand[coefp[[i]]],Expand[coefq[[k+2-i]]]],{i,2,k}]] t^k},{k,2,DEGREE}];
	 pq];

Print["Compute exp(X)"];
termx=x; tmpn=1; tmpx=x;
Do[{tmpx=Mm[tmpx,x];
	tmpn=ii tmpn; termx=termx+tmpx/tmpn}, {ii,2,DEGREE}];
termx=1+termx;

Print["Compute exp(Y)"];
termy=y; tmpn=1; tmpy=y;
Do[{tmpy=Mm[tmpy,y];
	tmpn=ii tmpn; termy=termy+tmpy/tmpn}, {ii,2,DEGREE}];
termy=1+termy;

Print["Compute exp(W)"];
termw=w; tmpn=1; tmpw=Expand[Sum[c[i][x,y],{i,DEGREE-1}]]; workw=tmpw;
Do[{tmpw=Expand[Normal[Series[Mm[Expand[tmpw],workw],{t,0,DEGREE}]]];
         workw=Expand[Sum[c[i][x,y],{i,DEGREE-ii}]];
         tmpn=ii tmpn; termw=termw+Expand[tmpw/tmpn]}, {ii,2,DEGREE}];
termw=1+termw;

Print["Compute exp(X)exp(Y)"];
termxyx=MmPoly[termx,termy];

Print["Compute Error"];
error=Expand[termxyx-termw];
If[error==0,
   Print["Correctness is verified"],
   Print["Correctness is NOT verified"]];
(* Save["Err",error];*)
