module susy2;
%version 1.2
%changes and bugs compare to version 1.0
%8.12.1996
%vericication of cp,axp;
%12.05.1997
%lyst in order to consider n(0)*d(1)^3+m(0)*d(1)^3;
%10.09.1997
%verification of jacob(wx,wx1,wx2) i fjacob
%1.10.1997
%introduction chiral1 and
%b_chiral,f_chiral,b_antychiral,f_antychiral
%introduction lyst2
%introduction of matrix(expression,boson or fermion, full or boson sector)
%3.10.1997
%verification of coordinates
%6.10.1997
%verification of wcomb,fcomb;
%19.04.1999
%changes and bugs compare to version 1.1
%new command s_int
algebraic;
operator !@f_f,!@g_g,newton,delta,b_part,bf_part,pg,chan,s_part,prykr,prykl;
operator bos,fer,der,del,d,axp,axx,zan,zen,fun,tet,gras,ber,fir,berz,firr,dr,
stp,byk,r_r,!&a,p_p,s_s,waga;
noncom bos,fer,der,del,d,axp,axx,zan,zen,fun,tet,gras,ber,fir,berz,firr,dr,
stp,byk,r_r;
factor !&a,byk;
factor fer,bos,fun,gras;
%fer,bos,axp superfunctions
%der,del,d,dr operations
%zan,zen needs to divergency
%fun,tet,gras,axx classical part
%stp to adjoint
%ber,fir,berz,firr corresponds to Gato
%byk,r_r,!&a,p_p,s_s,waga for super integration
%*******************************************%
%*** declaration of chirality and **********%
%*** cutoff and drr ************************%
%*******************************************%
chiral:={ abra_kadabra => 1 ,
der(~n)**2 => 0, del(~n)**2 => 0,del(2)*del(1) => - d(1) - del(1)*del(2),
der(2)*der(1) => -d(1) - der(1)*der(2),der(~n)*del(~n) => 0,
del(~n)*der(~n) => 0,der(1)*del(2)=> -d(1) - del(2)*der(1),
der(2)*del(1)=> -d(1) - del(1)*der(2),
%b_chiral,f_chiral,b_antychiral,f_antychiral as lists
b_chiral => {}, f_chiral => {}, b_antychiral => {}, f_antychiral => {},
fer(~f,1,~m) => 0 when not freeof(b_chiral,f),
bos(~f,3,~m) => -bos(f,0,m+1) when not freeof(b_chiral,f),
bos(~f,3,~m,~k) => (-1)**k*bos(f,0,m+1,k) when not freeof(b_chiral,f),
bos(~f,1,~m) => 0 when not freeof(f_chiral,f),
bos(~f,1,~m,~k) => 0 when not freeof(f_chiral,f),
fer(~f,3,~m) => -fer(f,0,m+1) when not freeof(f_chiral,f),
fer(~f,2,~m) => 0 when not freeof(b_antychiral,f),
bos(~f,3,~m) => 0 when not freeof(b_antychiral,f),
bos(~f,3,~m,~k) => 0 when not freeof(b_antychiral,f),
bos(~f,2,~m) => 0 when not freeof(f_antychiral,f),
bos(~f,2,~m,~k) => 0 when not freeof(f_antychiral,f),
fer(~f,3,~m) => 0 when not freeof(f_antychiral,f),
der(1)*fer(~f,1,~m) => - fer(f,1,m)*der(1),
der(1)*fer(~f,2,~m) => bos(f,3,m) - fer(f,2,m)*der(1),
der(1)*fer(~f,3,~m) => - fer(f,3,m)*der(1),
fer(~f,1,~m)*del(1) => - del(1)*fer(f,1,m),
fer(~f,2,~m)*del(1) => bos(f,3,m) - del(1)*fer(f,2,m),
fer(~f,3,~m)*del(1) => - del(1)*fer(f,3,m),
der(2)*fer(~f,1,~m) => -bos(f,0,m+1) - bos(f,3,m) - fer(f,1,m)*der(2),
der(2)*fer(~f,2,~m) => - fer(f,2,m)*der(2),
der(2)*fer(~f,3,~m) => -bos(f,2,m+1)-fer(f,3,m)*der(2),
fer(~f,1,~m)*del(2) => -bos(f,0,m+1) - bos(f,3,m) - del(2)*fer(f,1,m),
fer(~f,2,~m)*del(2) => - del(2)*fer(f,2,m),
fer(~f,3,~m)*del(2) => -bos(f,2,m+1)-del(2)*fer(f,3,m),
der(1)*bos(~f,1,~m) => bos(f,1,m)*der(1),
der(1)*bos(~f,2,~m) => fer(f,3,m) + bos(f,2,m)*der(1),
der(1)*bos(~f,3,~m) => bos(f,3,m)*der(1),
bos(~f,1,~m)*del(1) => del(1)*bos(f,1,m),
bos(~f,2,~m)*del(1) => -fer(f,3,m)+del(1)*bos(f,2,m),
bos(~f,3,~m)*del(1) => del(1)*bos(f,3,m),
der(2)*bos(~f,1,~m) => -fer(f,0,m+1) - fer(f,3,m) + bos(f,1,m)*der(2),
der(2)*bos(~f,2,~m) => bos(f,2,m)*der(2),
der(2)*bos(~f,3,~m) => -fer(f,2,m+1) + bos(f,3,m)*der(2),
bos(~f,1,~m)*del(2) => fer(f,0,m+1) + fer(f,3,m) + del(2)*bos(f,1,m),
bos(~f,2,~m)*del(2) => del(2)*bos(f,2,m),
bos(~f,3,~m)*del(2) => fer(f,2,m+1) + del(2)*bos(f,3,m),
der(1)*bos(~f,1,~m,~l) => bos(f,1,m,l)*der(1),
der(1)*bos(~f,2,~m,~l) => l*fer(f,3,m)*bos(f,2,m,l-1)+bos(f,2,m,l)*der(1),
der(1)*bos(~f,3,~m,~l) => bos(f,3,m,l)*der(1),
bos(~f,1,~m,~l)*del(1) => del(1)*bos(f,1,m,l),
bos(~f,2,~m,~l)*del(1) => -l*fer(f,3,m)*bos(f,2,m,l-1)+del(1)*bos(f,2,m,l),
bos(~f,3,~m,~l)*del(1) => del(1)*bos(f,3,m,l),
der(2)*bos(~f,1,~m,~l) => -l*(fer(f,0,m+1)+fer(f,3,m))*bos(f,1,m,l-1) +
bos(f,1,m,l)*der(2),
der(2)*bos(~f,2,~m,~l) => bos(f,2,m,l)*der(2),
der(2)*bos(~f,3,~m,~l) => -l*fer(f,2,m+1)*bos(f,3,m,l-1) +
bos(f,3,m,l)*der(2),
bos(~f,1,~m,~l)*del(2) => l*(fer(f,0,m+1)+fer(f,3,m))*bos(f,1,m,l-1) +
del(2)*bos(f,1,m,l),
bos(~f,2,~m,~l)*del(2) => del(2)*bos(f,2,m,l),
bos(~f,3,~m,~l)*del(2) => l*fer(f,2,m+1)*bos(f,3,m,l-1) +
del(2)*bos(f,3,m,l)}$
chiral1:={abra_kadabra => 3 ,
%der(3) as commutator,bos(f,3,n) or fer(f,3,4) as commutator
der(~n)**2 => 0 when n neq 3, del(~n)**2 => 0 when n neq 3,
der(3)^2 => d(1)^2, del(3)^2 => d(1)^2,
der(2)*der(1) => -(d(1)+der(3))/2,der(1)*der(2) => (-d(1)+der(3))/2,
del(2)*del(1) => -(d(1)+del(3))/2,del(1)*del(2) => (-d(1)+del(3))/2,
der(1)*der(3) => d(1)*der(1), der(2)*der(3) => -d(1)*der(2),
der(3)*der(1) => -d(1)*der(1), der(3)*der(2) => d(1)*der(2),
del(1)*del(3) => d(1)*del(1), del(2)*del(3) => -d(1)*del(2),
del(3)*del(1) => -d(1)*del(1), del(3)*del(2) => d(1)*del(2),
der(~n)*del(~n) => if n neq 3 then 0 else if n eq 3 then d(1)^2,
del(~n)*der(~n) => if n neq 3 then 0 else if n eq 3 then d(1)^2,
der(1)*del(2) => -d(1) -del(2)*der(1),der(2)*del(1) => -d(1) -del(1)*der(2),
der(1)*del(3) => d(1)*del(1), der(2)*del(3) => -d(1)*del(2),
b_chiral => {}, f_chiral => {}, b_antychiral => {}, f_antychiral => {},
fer(~f,1,~m) => 0 when not freeof(b_chiral,f),
bos(~f,3,~m) => -bos(f,0,m+1) when not freeof(b_chiral,f),
bos(~f,3,~m,~k) => (-1)**k*bos(f,0,m+1,k) when not freeof(b_chiral,f),
bos(~f,1,~m) => 0 when not freeof(f_chiral,f),
bos(~f,1,~m,~k) => 0 when not freeof(f_chiral,f),
fer(~f,3,~m) => -fer(f,0,m+1) when not freeof(f_chiral,f),
fer(~f,2,~m) => 0 when not freeof(b_antychiral,f),
bos(~f,3,~m) => bos(f,0,m+1) when not freeof(b_antychiral,f),
bos(~f,3,~m,~k) => bos(f,0,m+1,k) when not freeof(b_antychiral,f),
bos(~f,2,~m) => 0 when not freeof(f_antychiral,f),
bos(~f,2,~m,~k) => 0 when not freeof(f_antychiral,f),
fer(~f,3,~m) => fer(f,0,m+1) when not freeof(f_antychiral,f),
der(1)*fer(~f,1,~m) => - fer(f,1,m)*der(1),
der(1)*fer(~f,2,~m) => -bos(f,0,m+1)/2+bos(f,3,m)/2 - fer(f,2,m)*der(1),
der(1)*fer(~f,3,~m) => bos(f,1,m+1)-fer(f,3,m)*der(1),
fer(~f,1,~m)*del(1) => - del(1)*fer(f,1,m),
fer(~f,2,~m)*del(1) => -bos(f,0,m+1)/2 + bos(f,3,m)/2 - del(1)*fer(f,2,m),
fer(~f,3,~m)*del(1) => bos(f,1,m+1) - del(1)*fer(f,3,m),
der(2)*fer(~f,1,~m) => -bos(f,0,m+1)/2 - bos(f,3,m)/2 - fer(f,1,m)*der(2),
der(2)*fer(~f,2,~m) => - fer(f,2,m)*der(2),
der(2)*fer(~f,3,~m) => -bos(f,2,m+1)-fer(f,3,m)*der(2),
fer(~f,1,~m)*del(2) => -bos(f,0,m+1)/2 - bos(f,3,m)/2 - del(2)*fer(f,1,m),
fer(~f,2,~m)*del(2) => - del(2)*fer(f,2,m),
fer(~f,3,~m)*del(2) => -bos(f,2,m+1)-del(2)*fer(f,3,m),
der(3)*fer(~f,0,~m) => fer(f,3,m) + fer(f,0,m)*der(3) - 2*bos(f,1,m)*der(2)
+ 2*bos(f,2,m)*der(1),
der(3)*fer(~f,1,~m) => -fer(f,1,m+1) - bos(f,0,m+1)*der(1) -bos(f,3,m)*der(1)
+fer(f,1,m)*der(3),
der(3)*fer(~f,2,~m) => bos(f,0,m+1)*der(2) - bos(f,3,m)*der(2) + fer(f,2,m+1)
+fer(f,2,m)*der(3),
der(3)*fer(~f,3,~m) => fer(f,0,m+2) + fer(f,3,m)*der(3)
-2*bos(f,1,m+1)*der(2)-2*bos(f,2,m+1)*der(1),
fer(~f,0,~m)*del(3) => fer(f,3,m)+ del(3)*fer(f,0,m) + 2*del(2)*bos(f,1,m)
- 2*del(1)*bos(f,2,m),
fer(~f,1,~m)*del(3) => -fer(f,1,m+1)+ del(1)*bos(f,0,m+1) +
del(1)*bos(f,3,m) + del(3)*fer(f,1,m),
fer(~f,2,~m)*del(3) => - del(2)*bos(f,0,m+1) +del(2)*bos(f,3,m) +fer(f,2,m+1)
+del(3)*fer(f,2,m),
fer(~f,3,~m)*del(3) => fer(f,0,m+2) + del(3)*fer(f,3,m)
+ 2*del(2)*bos(f,1,m+1) + 2*del(1)*bos(f,2,m+1),
der(1)*bos(~f,1,~m) => bos(f,1,m)*der(1),
der(1)*bos(~f,2,~m) => -fer(f,0,m+1)/2 + fer(f,3,m)/2 + bos(f,2,m)*der(1),
der(1)*bos(~f,3,~m) => fer(f,1,m+1) + bos(f,3,m)*der(1),
bos(~f,1,~m)*del(1) => del(1)*bos(f,1,m),
bos(~f,2,~m)*del(1) => fer(f,0,m+1)/2 - fer(f,3,m)/2 +del(1)*bos(f,2,m),
bos(~f,3,~m)*del(1) => - fer(f,1,m+1) + del(1)*bos(f,3,m),
der(2)*bos(~f,1,~m) => -fer(f,0,m+1)/2 - fer(f,3,m)/2 + bos(f,1,m)*der(2),
der(2)*bos(~f,2,~m) => bos(f,2,m)*der(2),
der(2)*bos(~f,3,~m) => -fer(f,2,m+1) + bos(f,3,m)*der(2),
bos(~f,1,~m)*del(2) => fer(f,0,m+1)/2 + fer(f,3,m)/2 + del(2)*bos(f,1,m),
bos(~f,2,~m)*del(2) => del(2)*bos(f,2,m),
bos(~f,3,~m)*del(2) => fer(f,2,m+1) + del(2)*bos(f,3,m),
der(3)*bos(~f,0,~m) => bos(f,3,m) + bos(f,0,m)*der(3) + 2*fer(f,1,m)*der(2)
-2*fer(f,2,m)*der(1),
der(3)*bos(~f,1,~m) => -bos(f,1,m+1) + fer(f,0,m+1)*der(1) + fer(f,3,m)*der(1)
+ bos(f,1,m)*der(3),
der(3)*bos(~f,2,~m) => - fer(f,0,m+1)*der(2) + fer(f,3,m)*der(2)
+ bos(f,2,m)*der(3) +bos(f,2,m+1),
der(3)*bos(~f,3,~m) => bos(f,0,m+2) + 2*fer(f,2,m+1)*der(1) +
2*fer(f,1,m+1)*der(2) + bos(f,3,m)*der(3),
bos(~f,0,~m)*del(3) => bos(f,3,m) + del(3)*bos(f,0,m) + 2*del(2)*fer(f,1,m)
- 2*del(1)*fer(f,2,m),
bos(~f,1,~m)*del(3) => del(1)*fer(f,0,m+1) + del(1)*fer(f,3,m) -bos(f,1,m+1)
+ del(3)*bos(f,1,m),
bos(~f,2,~m)*del(3) => -del(2)*fer(f,0,m+1) + del(2)*fer(f,3,m)
+ del(3)*bos(f,2,m) +bos(f,2,m+1) ,
bos(~f,3,~m)*del(3) => bos(f,0,m+2) + 2*del(1)*fer(f,2,m+1) +
2*del(2)*fer(f,1,m+1) + del(3)*bos(f,3,m),
der(1)*bos(~f,1,~m,~l) => bos(f,1,m,l)*der(1),
der(1)*bos(~f,2,~m,~l) => l*bos(f,2,m,l-1)*(-fer(f,0,m+1)/2 + fer(f,3,m)/2)
+ bos(f,2,m,l)*der(1),
der(1)*bos(~f,3,~m,~l) => l*bos(f,3,m,l-1)*fer(f,1,m+1) +
bos(f,3,m,l)*der(1),
bos(~f,1,~m,~l)*del(1) => del(1)*bos(f,1,m,l),
bos(~f,2,~m,~l)*del(1) => - l*bos(f,2,m,l-1)*(-fer(f,0,m+1)/2 + fer(f,3,m)/2)
+del(1)*bos(f,2,m,l),
bos(~f,3,~m,~l)*del(1) => - l*bos(f,3,m,l-1)*fer(f,1,m+1) +
del(1)*bos(f,3,m,l),
der(2)*bos(~f,1,~m,~l) => - l*bos(f,1,m,l-1)*(fer(f,0,m+1)/2+ fer(f,3,m)/2)
+ bos(f,1,m,l)*der(2),
der(2)*bos(~f,2,~m,~l) => bos(f,2,m,l)*der(2),
der(2)*bos(~f,3,~m,~l) => -l*fer(f,2,m+1)*bos(f,3,m,l-1) +
bos(f,3,m,l)*der(2),
bos(~f,1,~m,~l)*del(2) => l*(fer(f,0,m+1)/2+fer(f,3,m)/2)*bos(f,1,m,l-1) +
del(2)*bos(f,1,m,l),
bos(~f,2,~m,~l)*del(2) => del(2)*bos(f,2,m,l),
bos(~f,3,~m,~l)*del(2) => l*fer(f,2,m+1)*bos(f,3,m,l-1) +
del(2)*bos(f,3,m,l),
der(3)*bos(~f,~k,~m,~l) =>
der(1)*prykr(bos(f,k,m,l),2)-der(2)*prykr(bos(f,k,m,l),1),
bos(~f,~k,~m,~l)*del(3) =>
-prykl(bos(f,k,m,l),2)*del(1)+prykl(bos(f,k,m,l),1)*del(2) }$
trad:={abra_kadabra => 2 ,
der(~n)**2 => d(1),del(~n)**2 => d(1),del(2)*del(1) => -del(1)*del(2),
der(2)*der(1) => -der(1)*der(2), der(~n)*del(~n) => d(1),
del(~n)*der(~n) => d(1), der(1)*del(2) => -del(2)*der(1),
der(2)*del(1) => -del(1)*der(2),
der(1)*fer(~f,1,~m) => bos(f,0,m+1) - fer(f,1,m)*der(1),
der(1)*fer(~f,2,~m) => bos(f,3,m) - fer(f,2,m)*der(1),
der(1)*fer(~f,3,~m) => bos(f,2,m+1) - fer(f,3,m)*der(1),
fer(~f,1,~m)*del(1) => bos(f,0,m+1) - del(1)*fer(f,1,m),
fer(~f,2,~m)*del(1) => bos(f,3,m) - del(1)*fer(f,2,m),
fer(~f,3,~m)*del(1) => bos(f,2,m+1) - del(1)*fer(f,3,m),
der(2)*fer(~f,1,~m) => -bos(f,3,m) - fer(f,1,m)*der(2),
der(2)*fer(~f,2,~m) => bos(f,0,m+1) - fer(f,2,m)*der(2),
der(2)*fer(~f,3,~m) => -bos(f,1,m+1)-fer(f,3,m)*der(2),
fer(~f,1,~m)*del(2) => -bos(f,3,m) - del(2)*fer(f,1,m),
fer(~f,2,~m)*del(2) => bos(f,0,m+1) - del(2)*fer(f,2,m),
fer(~f,3,~m)*del(2) => -bos(f,1,m+1)-del(2)*fer(f,3,m),
der(1)*bos(~f,1,~m) => fer(f,0,m+1) + bos(f,1,m)*der(1),
der(1)*bos(~f,2,~m) => fer(f,3,m)+bos(f,2,m)*der(1),
der(1)*bos(~f,3,~m) => fer(f,2,m+1) + bos(f,3,m)*der(1),
bos(~f,1,~m)*del(1) => -fer(f,0,m+1) + del(1)*bos(f,1,m),
bos(~f,2,~m)*del(1) => -fer(f,3,m)+del(1)*bos(f,2,m),
bos(~f,3,~m)*del(1) => -fer(f,2,m+1) + del(1)*bos(f,3,m),
der(2)*bos(~f,1,~m) => -fer(f,3,m) + bos(f,1,m)*der(2),
der(2)*bos(~f,2,~m) => fer(f,0,m+1) + bos(f,2,m)*der(2),
der(2)*bos(~f,3,~m) => -fer(f,1,m+1) + bos(f,3,m)*der(2),
bos(~f,1,~m)*del(2) => fer(f,3,m) + del(2)*bos(f,1,m),
bos(~f,2,~m)*del(2) => -fer(f,0,m+1) + del(2)*bos(f,2,m),
bos(~f,3,~m)*del(2) => fer(f,1,m+1) + del(2)*bos(f,3,m),
der(1)*bos(~f,1,~m,~l) => l*fer(f,0,m+1)*bos(f,1,m,l-1) +
bos(f,1,m,l)*der(1),
der(1)*bos(~f,2,~m,~l) => l*fer(f,3,m)*bos(f,2,m,l-1)+
bos(f,2,m,l)*der(1),
der(1)*bos(~f,3,~m,~l) => l*fer(f,2,m+1)*bos(f,3,m,l-1) +
bos(f,3,m,l)*der(1),
bos(~f,1,~m,~l)*del(1) => -l*fer(f,0,m+1)*bos(f,1,m,l-1) +
del(1)*bos(f,1,m,l),
bos(~f,2,~m,~l)*del(1) => -l*fer(f,3,m)*bos(f,2,m,l-1)+
del(1)*bos(f,2,m,l),
bos(~f,3,~m,~l)*del(1) => -l*fer(f,2,m+1)*bos(f,3,m,l-1) +
del(1)*bos(f,3,m,l),
der(2)*bos(~f,1,~m,~l) => -l*fer(f,3,m)*bos(f,1,m,l-1) +
bos(f,1,m,l)*der(2),
der(2)*bos(~f,2,~m,~l) => l*fer(f,0,m+1)*bos(f,2,m,l-1) +
bos(f,2,m,l)*der(2),
der(2)*bos(~f,3,~m,~l) => -l*fer(f,1,m+1)*bos(f,3,m,l-1) +
bos(f,3,m,l)*der(2),
bos(~f,1,~m,~l)*del(2) => l*fer(f,3,m)*bos(f,1,m,l-1) +
del(2)*bos(f,1,m,l),
bos(~f,2,~m,~l)*del(2) => -l*fer(f,0,m+1)*bos(f,2,m,l-1) +
del(2)*bos(f,2,m,l),
bos(~f,3,~m,~l)*del(2) => l*fer(f,1,m+1)*bos(f,3,m,l-1) +
del(2)*bos(f,3,m,l)}$
drr:= { d(-1)**(~n) => dr(-n) when n neq 1,d(-1) => dr(-1) }$
nodrr:={ dr(-~n) => d(-1)**n when n neq 1, dr(-1) => d(-1) }$
cutoff:= { dr(~n) => 0 when n < - cut }$
inverse:={bos(~f,~n,~m) => bos(f,n,m,1) ,
fun(~f,~n) => fun(f,n,1) }$
%*******************************************%
%*** module ordering **********************%
%*******************************************%
%ordering of bos with 4 and 3 indices and (fer,axp,ber,fir,zen,zan)
let {
bos(~f,~n,~m,~k)*bos(~g,~x,~z,~v) => bos(g,x,z,v)*bos(f,n,m,k) when
ordp(f,g) and f neq g or f equal g and n<x or
f equal g and n equal x and m<z,
bos(~f,~n,~m)*bos(~g,~x,~z) => bos(g,x,z)*bos(f,n,m) when
ordp(f,g) and f neq g or f equal g and n<x or
f equal g and n equal x and m<z,
bos(~f,~n,~m,~k)*bos(~g,~x,~z) => bos(g,x,z)*bos(f,n,m,k) when
ordp(f,g) and f neq g or f equal g and n<x or
f equal g and n equal x and m<z,
bos(~g,~x,~z)*bos(~f,~n,~m,~k) =>bos(f,n,m,k)*bos(g,x,z) when
ordp(g,f) and f neq g or f equal g and n>x or
f equal g and n equal x and m>z,
bos(~f,~n,~m,~k)*bos(~f,~n,~m,~l) => bos(f,n,m,k+l),
bos(~f,~n,~m,~k)**2 => bos(f,n,m,2k),
bos(~f,~n,~m,0) => 1, bos(0,~f,~n,~m) => 0, bos(0,~f,~n) => 0,
bos(~f,~n,~m,~k)*bos(~f,~n,~m) => bos(f,n,m,k+1),
bos(~f,~n,~m)*bos(~f,~n,~m,~k) => bos(f,n,m,k+1),
ber(~f,~n,~m)*bos(~g,~k,~x,~l) => bos(g,k,x,l)*ber(f,n,m),
fir(~f,~n,~m)*bos(~g,~k,~x,~l) => bos(g,k,x,l)*fir(f,n,m),
ber(~f,~n,~m)*bos(~g,~k,~l) => bos(g,k,l)*ber(f,n,m),
ber(~f,~n,~m)*fer(~g,~k,~l) => fer(g,k,l)*ber(f,n,m),
fir(~f,~n,~m)*bos(~g,~k,~l) => bos(g,k,l)*fir(f,n,m),
fir(~f,~n,~m)*fer(~g,~k,~l) => -fer(g,k,l)*fir(f,n,m),
%ordering of fer,
fer(0,~n,~m) => 0,
bos(~f,~n,~m,~y)*fer(~g,~x,~h) => fer(g,x,h)*bos(f,n,m,y),
bos(~f,~n,~m)*fer(~g,~x,~h) => fer(g,x,h)*bos(f,n,m),
fer(~f,~n,~m)**2 => 0,
fer(~f,~n,~m)*fer(~g,~k,~l) => - fer(g,k,l)*fer(f,n,m) when
ordp(f,g) and f neq g or f equal g and n<k or
f equal g and n equal k and m<l,
%ordering classical,
fun(~f,~n,~m)*fun(~g,~k,~l) => fun(g,k,l)*fun(f,n,m) when
ordp(f,g) and f neq g or f equal g and n<k or
f equal g and n equal k and m<l,
fun(~f,~n,~m)*fun(~g,~x) => fun(g,x)*fun(f,n,m) when
ordp(f,g) and f neq g or f equal g and n<x ,
fun(~g,~x)*fun(~f,~n,~m) => fun(f,n,m)*fun(g,x) when
ordp(g,f) and f neq g or f equal g and n>x,
fun(~f,~n)*fun(~g,~m) => fun(g,m)*fun(f,n) when
ordp(f,g) and f neq g or f equal g and n<m,
fun(~f,~n,~m,~k,~l)*fun(~s,~x) => fun(s,x)*fun(f,n,m,k,l),
fun(~f,~n,~m,~k,~l)*fun(~s,~x,~z) => fun(s,x,z)*fun(f,n,m,k,l),
fun(~f,~n,~m,~k,~l)*gras(~s,~x) => gras(s,x)*fun(f,n,m,k,l),
fun(~f,~n,~m,~k,~l)*tet(~s) => tet(s)*fun(f,n,m,k,l),
fun(~f,~n,~m,~k,~l)*fun(~s,~x,~z) => fun(s,x,z)*fun(f,n,m,k,l),
fun(~f,~n,~m)*gras(~g,~x) => gras(g,x)*fun(f,n,m),
fun(~f,~n)*gras(~g,~x) => gras(g,x)*fun(f,n),
gras(~f,~n)*gras(~g,~m) =>-gras(g,m)*gras(f,n) when
ordp(f,g) and f neq g or f equal g and n<m,
ber(~f,~n)*fun(~g,~m) => fun(g,m)*fun(f,n),
ber(~f,~n)*gras(~g,~m) => gras(g,m)*fun(f,n),
fir(~f,~n)*fun(~g,~m) => fun(g,m)*fir(f,n),
fir(~f,~n)*gras(~g,~m) => - fir(g,m)*gras(f,n),
gras(~f,~n)^2 => 0,
fun(~f,~n,0) => 1,fun(0,~n,~m) => 0, fun(0,~n) => 0, gras(0,~n) => 0,
fun(~f,~n,~m)*fun(~f,~n,~k) => fun(f,n,m+k),
fun(~f,~n,~m)**2 => fun(f,n,2m),
fun(~f,~n,~m)*tet(~k) => tet(k)*fun(f,n,m),
fun(~f,~n)*tet(~k) => tet(k)*fun(f,n),
gras(~f,~n)*tet(~k) => - tet(k)*gras(f,n),
axx(~f)*fun(~g,~n) => fun(g,n)*axx(f),
axx(~f)*gras(~g,~n) => gras(g,n)*axx(f),
axx(~f)*fun(~g,~n,~m) => fun(g,n,m)*axx(f),
axx(~f)*fun(~g,~n,~m,~k,~l) => fun(g,n,m,~k,~l)*axx(f),
fun(~f,~n,~g,~m,~k) => (for s:=0:k sum
(-1)**s*newton(k,s)*fun(f,n,k-s)*fun(g,m,s)/(2**s))
when numberp(k) and k >=0,
%ordering other,
bos(~g,~x,~h)*zan(~f,~n,~m) => zan(f,n,m)*bos(g,x,h),
bos(~g,~x,~h,~l)*zan(~f,~n,~m) => zan(f,n,m)*bos(g,x,h,l),
fer(~g,~x,~h)*zan(~f,~n,~m) => zan(f,n,m)*fer(g,x,h),
bos(~g,~x,~h)*zen(~f,~n,~m) => zen(f,n,m)*bos(g,x,h),
bos(~g,~x,~h,~l)*zen(~f,~n,~m) => zen(f,n,m)*bos(g,x,h,l),
fer(~g,~x,~h)*zen(~f,~n,~m) => - zen(f,n,m)*fer(g,x,h),
axp(~g)*zan(~f,~n,~m) => zan(f,n,m)*axp(g),
axp(~g)*zen(~f,~n,~m) => zen(f,n,m)*axp(g),
axp(~g)*bos(~f,~n,~m) => bos(f,n,m)*axp(g),
axp(~g)*bos(~f,~n,~m,~l) => bos(f,n,m,l)*axp(g),
axp(~g)*fer(~f,~n,~m) => fer(f,n,m)*axp(g),
axp(~f)*axp(~g) => axp(f+g), axp(~f)**(~n) => axp(n*f)}$
%other;
let { dr(~n)*dr(~m) => dr(n+m),tet(~n)^2 => 0,
tet(~n)*tet(~m) => -tet(m)*tet(n) when n<m,
!@g_g(~f,~m,~n)**2 => 0 when m=0 or m=3,
dr(~n)*d(1) => dr(n+1), d(1)*dr(~n) => dr(n+1),dr(~n)*d(2) => dr(n+1),
d(2)*dr(~n) => dr(n+1),der(~m)*dr(~n) => dr(n)*der(m),
dr(~n)*del(~m) => del(m)*dr(n), dr(~n)**2 => dr(2n),axp(0)=> 1,
axx(0)=> 1,dr(0)=> 1, der(0) => 1,
der(~n)*d(~m) => d(m)*der(n) when m neq t,
d(1)*del(~n) => del(n)*d(1),del(~n)*d(2) => d(2)*del(n),
d(-1)*del(~n) => del(n)*d(-1),del(~n)*d(-2) => d(-2)*del(n),
d(-3)*del(~n) => del(n)*d(-3),del(~n)*d(-4) => d(-4)*del(n),
d(1)*d(-1)=> 1,d(-1)*d(1)=>1,d(1)*d(-2)=> 1,d(-2)*d(1)=> 1,
d(1)*d(-3)=> 1,d(-3)*d(1)=>1,d(1)*d(-4)=> 1,d(-4)*d(1)=> 1,
d(3)*d(-1)=> 1,d(-1)*d(3)=>1,d(3)*d(-2)=> 1,d(-2)*d(3)=> 1,
d(3)*d(-4)=> 1,d(-4)*d(3)=>1,d(2)*d(-1)=> 1,d(-1)*d(2)=> 1,
d(2)*d(-2)=> 1,d(-2)*d(2)=>1,d(2)*d(-3)=> 1,d(-3)*d(2)=> 1,
d(2)*d(-4)=> 1,d(-4)*d(2)=>1,d(3)*d(-3)=>1,
d(1)*d(3)=> d(3)*d(1), d(-3)*d(3)=>1,
d(t)*d(1)=> d(1)*d(t),d(t)*d(2)=>d(2)*d(t),
d(t)*der(~n)=>der(n)*d(t),d(t)*del(~n)=>del(n)*d(t),
d(t)*d(-1)=>d(-1)*d(t),d(t)*d(-2)=> d(-2)*d(t),!@x_y^2 =>1,
d(t)*d(-3)=>d(-3)*d(t),d(t)*d(-4)=> d(-4)*d(t),abs(!#ll) =>1,
delta(~f,~g) => if f equal g then 1 else 0,
bf_part(~wx,~n) => part(fpart(wx),n+1),
b_part(~wx,~n) => part(bpart(wx),n+1),
pg(~n,~x) => sub(d(1)=0,d(1)**n*x),
chan(~x) => sub(d(2)=d(1),sub(d(1)=d(2),x)),
s_part(~x,~n) => coeffn(sub(der(1)=!@k,der(2)=(!@k)^2,der(3)=(!@k)^3,
del(1)=!@k,del(2)=(!@k)^2,der(3)=(!@k)^3,x),!@k,n),
newton(~n,~m) => factorial(n)/(factorial(m)*factorial(n-m)),
prykr(~f,~g) => if g eq 1 then der(1)*f else if g eq 2 then der(2)*f,
prykl(~f,~g) => if g eq 1 then f*del(1) else if g eq 2 then f*del(2)}$
%adjoint
let { bos(~f,~n,~m)*stp(~x) => stp(x)*bos(f,n,m),
bos(~f,~n,~m,~l)*stp(~x) => stp(x)*bos(f,n,m,l),
axp(~f)*stp(~x) => stp(x)*axp(f),
d(~n)*stp(~x) => -stp(x)*d(n) ,
der(~k)*stp(1) => stp(2)*der(k) when k neq 3,
der(~k)*stp(2) => - stp(1)*der(k) when k neq 3,
del(~k)*stp(1) => - del(k) when k neq 3,
del(~k)*stp(2) => - stp(1)*del(k) when k neq 3,
der(3)*stp(~x) => stp(x)*der(3),del(3)*stp(~x) => stp(x)*der(3),
del(~x)*stp(10) => stp(20)*del(x) when x neq 3,
del(~x)*stp(20) => -stp(10)*del(x) when x neq 3,
fer(~f,~n,~m)*stp(1) => stp(10)*fer(f,n,m),
fer(~f,~n,~m)*stp(10) => -stp(20)*fer(f,n,m),
fer(~f,~n,~m)*stp(20) => stp(10)*fer(f,n,m),
fer(~f,~n,~m)*stp(2) => stp(10)*fer(f,n,m)}$
%***********************************%
%*** Local action ******************%
%***********************************%
tryk:={ d(~f)*fer(~g,~n,~m) => delta(f,g)*zen(g,n,m) + fer(g,n,m)*d(f),
d(~f)*bos(~g,~n,~m) => delta(f,g)*zan(g,n,m) + bos(g,n,m)*d(f),
d(~f)*bos(~g,~n,~m,~l) => l*delta(f,g)*zan(g,n,m)*bos(g,n,m,l-1)+
bos(g,n,m,l)*d(f),
d(~f)*axp(~g) => axp(g)*(d(f)*g-g*d(f))+axp(g)*d(f) }$
tryk1:={zan(~f,0,~m) => (-1)**m*d(1)**m,
zan(~f,3,~m) =>
if abra_kadabra eq 2 then (-1)**m*der(1)*der(2)*d(1)**m
else if abra_kadabra eq 1 then (-1)**(m+1)*der(2)*der(1)*d(1)**m
else if abra_kadabra eq 3 then (-1)**m*der(3)*d(1)**m,
zan(~f,1,~m) => (-1)**m*der(1)*d(1)**m,
zan(~f,2,~m) => (-1)**m*der(2)*d(1)**m,
zen(~f,1,~m) => (-1)**(m+1)*der(1)*d(1)**m,
zen(~f,2,~m) => (-1)**(m+1)*der(2)*d(1)**m,
zen(~f,0,~m) => (-1)**m*d(1)**m,
zen(~f,3,~m) =>
if abra_kadabra eq 2 then (-1)**m*der(1)*der(2)*d(1)**m
else if abra_kadabra eq 1 then (-1)**(m+1)*der(2)*der(1)*d(1)**m
else if abra_kadabra eq 3 then (-1)**m*der(3)*d(1)**m}$
tryk2:={zan(~f,0,~m) => bos(f,0,0)*(-1)**m*d(1)**m,
zan(~f,3,~m) => bos(f,0,0)*(
if abra_kadabra eq 2 then (-1)**m*der(1)*der(2)*d(1)**m
else if abra_kadabra eq 1 then (-1)**(m+1)*der(2)*der(1)*d(1)**m
else if abra_kadabra eq 3 then (-1)**m*der(3)*d(1)**m),
zan(~f,1,~m) => fer(f,0,0)*(-1)**m*der(1)*d(1)**m,
zan(~f,2,~m) => fer(f,0,0)*(-1)**m*der(2)*d(1)**m,
zen(~f,1,~m) => bos(f,0,0)*(-1)**(m+1)*der(1)*d(1)**m,
zen(~f,2,~m) => bos(f,0,0)*(-1)**(m+1)*der(2)*d(1)**m,
zen(~f,0,~m) => fer(f,0,0)*(-1)**m*d(1)**m,
zen(~f,3,~m) => fer(f,0,0)*(
if abra_kadabra eq 2 then (-1)**m*der(1)*der(2)*d(1)**m
else if abra_kadabra eq 1 then (-1)**(m+1)*der(2)*der(1)*d(1)**m
else if abra_kadabra eq 3 then (-1)**m*der(3)*d(1)**m)}$
tryk3:={fer(~f,~n,~m) =>1, bos(~f,~n,~m) =>1,
bos(~f,~n,~m,~l) =>1, axp(~f) => 1 }$
tryk4:={fer(~f,~n,~m) => 1, bos(~f,~n,~m) => 1,
axp(~f) => 1, bos(~f,~n,~m,~l) => 1,
der(~n) => 1, d(~n) => 1, del(~n) => 1}$
%only for trad
tryk5:={bos(~f,~m,~n) => if m=0 then
fun(mkid(f,0),n)+tet(1)*gras(mkid(f,mkid(f,1)),n)+
tet(2)*gras(mkid(f,mkid(f,2)),n)+tet(2)*tet(1)*fun(mkid(f,1),n)
else if m=1 then
fun(mkid(f,0),n) - tet(2)*gras(mkid(f,mkid(f,2)),n) +
tet(1)*gras(mkid(f,mkid(f,1)),n+1) - tet(2)*tet(1)*fun(mkid(f,1),n+1)
else if m=2 then
fun(mkid(f,1),n) + tet(1)*gras(mkid(f,mkid(f,2)),n) +
tet(2)*gras(mkid(f,mkid(f,1)),n+1) + tet(2)*tet(1)*fun(mkid(f,0),n+1)
else if m=3 then
tet(1)*gras(mkid(f,mkid(f,2)),n+1) + fun(mkid(f,1),n) -
tet(2)*tet(1)*fun(mkid(f,0),n+2) - tet(2)*gras(mkid(f,mkid(f,1)),n+1)
else rederr " wrong values of arguments",
fer(~f,~m,~n) => if m=0 then
gras(mkid(f,mkid(f,1)),n)+tet(1)*fun(mkid(f,0),n)+
tet(2)*fun(mkid(f,1),n)+tet(2)*tet(1)*gras(mkid(f,mkid(f,2)),n)
else if m=1 then
gras(mkid(f,mkid(f,1)),n)-tet(2)*fun(mkid(f,1),n)+
tet(1)*fun(mkid(f,0),n+1)-tet(2)*tet(1)*gras(mkid(f,mkid(f,2)),n+1)
else if m=2 then
gras(mkid(f,mkid(f,2)),n)+tet(1)*fun(mkid(f,1),n)+
tet(2)*fun(mkid(f,0),n+1)+tet(2)*tet(1)*gras(mkid(f,mkid(f,1)),n+1)
else if m=3 then
tet(1)*fun(mkid(f,1),n+1) + gras(mkid(f,mkid(f,2)),n) -
tet(2)*tet(1)*gras(mkid(f,mkid(f,1)),n+2) - tet(2)*fun(mkid(f,0),n+1)
else rederr "wrong values of arguments" ,
bos(~f,~m,~n,~l) => if m equal 0 then
fun(mkid(f,0),n,l) + l*fun(mkid(f,0),n,l-1)*(tet(1)*gras(mkid(f,1),n)+
tet(2)*gras(mkid(g,2),n) +tet(2)*tet(1)*(fun(mkid(f,1),n,1)+
(l-1)*fun(mkid(f,0),n,-1)*gras(mkid(g,1),n)*gras(mkid(g,2),n)))
else if m=1 then
fun(mkid(f,0),n,l)+l*fun(mkid(f,0),n,l-1)*(tet(1)*gras(mkid(g,1),n+1)-
tet(2)*gras(mkid(g,2),n)+tet(2)*tet(1)*(fun(mkid(f,1),n+1,1)-
(l-1)*fun(mkid(f,0),n,-1)*gras(mkid(g,1),n+1)*gras(mkid(g,2),n)))
else if m=2 then
fun(mkid(f,1),n,l)+l*fun(mkid(f,1),n,l-1)*(tet(1)*gras(mkid(g,2),n)+
tet(2)*gras(mkid(g,1),n+1)+tet(2)*tet(1)*(fun(mkid(f,0),n+1,1) -
(l-1)*fun(mkid(f,1),n,-1)*gras(mkid(g,1),n+1)*gras(mkid(g,2),n)))
else if m=3 then
fun(mkid(f,1),n,l)+l*fun(mkid(f,1),n,l-1)*(tet(1)*gras(mkid(g,2),n+1)-
tet(2)*gras(mkid(g,1),n+1) + tet(2)*tet(1)*(-fun(mkid(f,0),n+1,1)+
(l-1)*fun(mkid(f,1),n,-1)*gras(mkid(g,1),n+1)*gras(mkid(g,2),n+1) ) )
else rederr "wrong values of arguments" ,
axp(~f) => axx(bf_part(f,0))*(1+ tet(1)*bf_part(f,1)+
tet(2)*bf_part(f,2) + tet(2)*tet(1)*(bf_part(f,3)+
2*bf_part(f,1)*bf_part(f,2))) }$
tryk6:={ gras(~f,~n) =>0 }$
tryk7:={ !@f_f(~f,0,~n) => bos(f,0,n),
!@f_f(~f,1,~n) => if abra_kadabra eq 2 then bos(f,1,n) else
if not freeof(f_chiral,f) then 0 else bos(f,1,n),
!@f_f(~f,2,~n) => if abra_kadabra eq 2 then bos(f,2,n) else
if not freeof(f_antychiral,f) then 0 else bos(f,2,n),
!@f_f(~f,3,~n) => if abra_kadabra eq 2 then bos(f,3,n) else
if not freeof(b_chiral,f) then - bos(f,0,n+1) else
if abra_kadabra eq 1 and not freeof(b_antychiral,f) then 0 else
if abra_kadabra eq 3 and not freeof(b_antychiral,f) then bos(f,0,n+1) else
bos(f,3,n),
!@g_g(~f,0,~n) => fer(f,0,n),
!@g_g(~f,1,~n) => if abra_kadabra eq 2 then fer(f,1,n) else
if not freeof(b_chiral,f) then 0 else fer(f,1,n),
!@g_g(~f,2,~n) => if abra_kadabra eq 2 then fer(f,2,n) else
if not freeof(b_antychiral,f) then 0 else fer(f,2,n),
!@g_g(~f,3,~n) => if abra_kadabra eq 2 then fer(f,3,n) else
if not freeof(f_chiral,f) then -fer(f,0,n+1) else
if abra_kadabra eq 1 and not freeof(f_antychiral,f) then 0 else
if abra_kadabra eq 3 and not freeof(f_antychiral,f) then fer(f,0,n+1) else
fer(f,3,n)}$
tryk8:={ bos(~f,~n,~m) => berz(f,n,m)+eps*ber(f,n,m),
fer(~f,~n,~m) => firr(f,n,m)+eps*fir(f,n,m),
bos(~f,~n,~m,~l) => berz(f,n,m,l)+l*eps*berz(f,n,m,l-1)*ber(f,n,m)}$
tryk9:={ berz(~f,~n,~m) => bos(f,n,m), firr(~f,~n,~m) => fer(f,n,m),
berz(~f,~n,~m,~l) => bos(f,n,m,l)}$
tryk10:= { fir(~f,~n,~m) => pg(m,pr(n,bos(f))),
ber(~f,~n,~m) => pg(m,pr(n,bos(f)))}$
tryk11:= { !#a(~n) => !#aa(n), !#b(~n) => !#bb(n), !#c(~n) => !#cc(n) }$
tryk12:= { !#aa(~n) => !#b(n), !#bb(~n) => !#c(n), !#cc(~n) => !#a(n) }$
tryk13:= { !#aa(~n) => !#c(n), !#bb(~n) => !#a(n), !#cc(~n) => !#b(n) }$
tryk14:={ bos(~f,~n,~m,t,t) => pg(m,pr(n,bos(f,t))),
fer(~f,~n,~m,t) => pg(m,pr(n,bos(f,t))) }$
tryk15:={ bos(~f,~n,~m,~l) => if n equal 0 or n equal 3 then berz(f,n,m,l)
else if n equal 1 then (-1)**l*berz(f,2,m,l)
else if n equal 2 then berz(f,1,m,l),
bos(~f,~n,~m) => if n equal 0 or n equal 3 then berz(f,n,m)
else if n equal 1 then -berz(f,2,m)
else if n equal 2 then berz(f,1,m),
fer(~f,~n,~m) => if n equal 0 or n equal 3 then firr(f,n,m)
else if n equal 1 then -firr(f,2,m)
else if n equal 2 then firr(f,1,m) }$
%only for chiral
tryk16:={
bos(~f,0,~n) => if not freeof(b_chiral,f) then
fun(mkid(f,0),n)+tet(2)*gras(mkid(f,mkid(f,2)),n)-
tet(2)*tet(1)*fun(mkid(f,0),n+1)/2
else if not freeof(b_antychiral,f) then
fun(mkid(f,0),n)+tet(1)*gras(mkid(f,mkid(f,1)),n) +
tet(2)*tet(1)*fun(mkid(f,0),n+1)/2
else fun(mkid(f,0),n)+tet(1)*gras(mkid(f,mkid(f,1)),n)+
tet(2)*gras(mkid(f,mkid(f,2)),n)+tet(2)*tet(1)*fun(mkid(f,1),n),
bos(~f,1,~n) => if not freeof(f_chiral,f) then 0 else
if not freeof(f_antychiral,f) then
fun(mkid(f,0),n) - tet(2)*gras(mkid(f,mkid(f,1)),n+1) -
tet(2)*tet(1)*fun(mkid(f,0),n+1)/2
else fun(mkid(f,0),n) - tet(2)*gras(mkid(f,mkid(f,2)),n) -
tet(2)*gras(mkid(f,mkid(f,1)),n+1)/2 -
tet(2)*tet(1)*fun(mkid(f,0),n+1)/2,
bos(~f,2,~n) => if not freeof(f_chiral,f) then
fun(mkid(f,0),n) - tet(2)*gras(mkid(f,mkid(f,1)),n+1) -
tet(2)*tet(1)*fun(mkid(f,0),n+1)/2
else if not freeof(f_antychiral,f) then 0
else fun(mkid(f,1),n) + tet(1)*gras(mkid(f,mkid(f,2)),n) -
tet(1)*gras(mkid(f,mkid(f,1)),n+1) + tet(2)*tet(1)*fun(mkid(f,1),n+1)/2,
bos(~f,3,~n) => if abra_kadabra eq 1 then
if not freeof(b_chiral,f) then - bos(f,0,n+1) else
if not freeof(b_antychiral,f) then 0 else
fun(mkid(f,1),n) - fun(mkid(f,0),n+1)/2 -
tet(2)*gras(mkid(f,mkid(f,2)),n+1) -
tet(2)*tet(1)*fun(mkid(f,1),n+1)/2 +
tet(2)*tet(1)*fun(mkid(f,0),n+2)/4
else if abra_kadabra eq 3 then
if not freeof(b_chiral,f) then - bos(f,0,n+1) else
if not freeof(b_antychiral,f) then bos(f,0,n+1) else
2*fun(mkid(f,1),n) - tet(2)*gras(mkid(f,mkid(f,2)),n+1) +
tet(1)*gras(mkid(f,mkid(f,1)),n+1)+tet(2)*tet(1)*fun(mkid(f,0),n+2)/2,
bos(~f,0,~n,~k) =>
if not freeof(b_chiral,f) then
fun(mkid(f,0),n,k)+k*tet(2)*fun(mkid(f,0),n,k-1)*
(gras(mkid(f,mkid(f,2)),n) -tet(1)*fun(mkid(f,0),n+1,1)/2)
else if not freeof(b_antychiral,f) then
fun(mkid(f,0),n,k)+k*tet(1)*fun(mkid(f,0),n,k-1)*
(gras(mkid(f,mkid(f,1)),n) - tet(2)*fun(mkid(f,0),n+1,1)/2)
else fun(mkid(f,0),n,k)+
k*tet(1)*gras(mkid(f,mkid(f,1)),n)*fun(mkid(f,0),n,k-1)+
k*tet(2)*gras(mkid(f,mkid(f,2)),n)*fun(mkid(f,0),n,k-1)+
+tet(2)*tet(1)*(k*fun(mkid(f,1),n,1)*fun(mkid(f,0),n,k-1)+
k*(k-1)*gras(mkid(f,mkid(f,1)),n)*gras(mkid(f,mkid(f,2)),n)*
fun(mkid(f,0),n,k-2)),
bos(~f,1,~n,~k) =>
if not freeof(f_chiral,f) then 0 else
if not freeof(f_antychiral,f) then
fun(mkid(f,0),n,k) - k*fun(mkid(f,0),n,k-1)*tet(2)*(
gras(mkid(f,mkid(f,1)),n+1) + tet(1)*fun(mkid(f,0),n+1,1)/2)
else fun(mkid(f,0),n,k) -k*fun(mkid(f,0),n,k-1)*tet(2)*
(gras(mkid(f,mkid(f,2)),n) + gras(mkid(f,mkid(f,1)),n+1)/2 +
tet(1)*fun(mkid(f,0),n+1,1)/2),
bos(~f,2,~n,~k) => if not freeof(f_chiral,f) then
fun(mkid(f,0),n,k) - k*tet(2)*fun(mkid(f,0),n,k-1)*
(gras(mkid(f,mkid(f,1)),n+1) + tet(1)*fun(mkid(f,0),n+1)/2)
else if not freeof(f_antychiral,f) then 0
else fun(mkid(f,1),n,k) + k*tet(1)*fun(mkid(f,1),n,k-1)*
(gras(mkid(f,mkid(f,2)),n) - gras(mkid(f,mkid(f,1)),n+1) -
tet(2)*fun(mkid(f,1),n+1,1)/2),
bos(~f,3,~n,~k) => if abra_kadabra eq 1 then
if not freeof(b_chiral,f) then (-1)**k*bos(f,0,n+1,k)
else if not freeof(b_antychiral,f) then 0
else fun(mkid(f,1),n,mkid(f,0),n+1,k) - k*fun(mkid(f,1),n,mkid(f,0),n+1,k-1)*
(tet(2)*gras(mkid(f,mkid(f,2)),n+1) +
tet(2)*tet(1)*fun(mkid(f,1),n+1,1)/2 -
tet(2)*tet(1)*fun(mkid(f,0),n+2,1)/4)
else if abra_kadabra eq 3 then
if not freeof(b_chiral,f) then (-1)**k*bos(f,0,n+1,k)
else if not freeof(b_antychiral,f) then bos(f,0,n+1,k)
else 2**k*fun(mkid(f,1),n,k) + k*2**(k-1)*fun(mkid(f,1),n,k-1)*
(- tet(2)*gras(mkid(f,mkid(f,2)),n+1) +
tet(1)*gras(mkid(f,mkid(f,1)),n+1)+tet(2)*tet(1)*fun(mkid(f,0),n+2,1)/2)
-k*(k-1)*2**(k-2)*tet(2)*tet(1)*fun(mkid(f,1),n,k-2)*
gras(mkid(f,mkid(f,1)),n+1)*gras(mkid(f,mkid(f,2)),n+1),
fer(~f,0,~n) => if not freeof(f_chiral,f) then
gras(mkid(f,mkid(f,1)),n)+tet(2)*fun(mkid(f,1),n) -
tet(2)*tet(1)*gras(mkid(f,mkid(f,1)),n+1)/2
else if not freeof(f_antychiral,f) then
gras(mkid(f,mkid(f,1)),n)+tet(1)*fun(mkid(f,0),n)+
tet(2)*tet(1)*gras(mkid(f,mkid(f,1)),n+1)/2
else gras(mkid(f,mkid(f,1)),n)+tet(1)*fun(mkid(f,0),n)+
tet(2)*fun(mkid(f,1),n)+tet(2)*tet(1)*gras(mkid(f,mkid(f,2)),n),
fer(~f,1,~n) => if not freeof(b_chiral,f) then 0
else if not freeof(b_antychiral,f) then
gras(mkid(f,mkid(f,1)),n) -
tet(2)*fun(mkid(f,0),n+1) -
tet(2)*tet(1)*gras(mkid(f,mkid(f,1)),n+1)/2
else gras(mkid(f,mkid(f,1)),n) - tet(2)*fun(mkid(f,1),n)-
tet(2)*fun(mkid(f,0),n+1)/2 -
tet(2)*tet(1)*gras(mkid(f,mkid(f,1)),n+1)/2,
fer(~f,2,~n) => if not freeof(b_chiral,f) then
gras(mkid(f,mkid(f,2)),n) -tet(1)*fun(mkid(f,0),n+1)+
tet(2)*tet(1)*gras(mkid(f,mkid(f,2)),n+1)/2
else if not freeof(b_antychiral,f) then 0
else gras(mkid(f,mkid(f,2)),n)+tet(1)*fun(mkid(f,1),n) -
tet(1)*fun(mkid(f,0),n+1)/2 +
tet(2)*tet(1)*gras(mkid(f,mkid(f,2)),n+1)/2,
fer(~f,3,~n) => if abra_kadabra eq 1 then
if not freeof(f_chiral,f) then - fer(f,0,n+1)
else if not freeof(f_antychiral,f) then 0
else gras(mkid(f,mkid(f,2)),n) - gras(mkid(f,mkid(f,1)),n+1)/2 -
tet(2)*fun(mkid(f,1),n+1) -
tet(2)*tet(1)*gras(mkid(f,mkid(f,1)),n+2)/4 -
tet(2)*tet(1)*gras(mkid(f,mkid(f,2)),n+1)/2
else if abra_kadabar eq 3 then
if not freeof(f_chiral,f) then - fer(f,0,n+1)
else if not freeof(f_antychiral,f) then fer(f,0,n+1)
else 2*gras(mkif(f,mkid(f,2)),n) - tet(2)*fun(mkid(f,1),n+1) +
tet(1)*fun(mkid(f,0),n+1) +tet(2)*tet(1)*gras(mkid(f,mkid(f,1)),n+2)/2,
axp(~f) => axx(bf_part(f,0))*(1+ tet(1)*bf_part(f,1)+
tet(2)*bf_part(f,2) + tet(2)*tet(1)*(bf_part(f,3)+
2*bf_part(f,1)*bf_part(f,2))) }$
%***********************************%
%*** module - operators ***********%
%***********************************%
%differentations
let { d(1)*fer(~f,~n,~m) => fer(f,n,m+1)+fer(f,n,m)*d(1),
d(1)*bos(~f,~n,~m) => bos(f,n,m+1)+bos(f,n,m)*d(1),
fer(~f,~n,~m)*d(2) => -fer(f,n,m+1)+d(2)*fer(f,n,m),
bos(~f,~n,~m)*d(2) => -bos(f,n,m+1)+d(2)*bos(f,n,m),
d(1)*bos(~f,~n,~m,~l) => l*bos(f,n,m+1,1)*bos(f,n,m,l-1)+bos(f,n,m,l)*d(1),
bos(~f,~n,~m,~l)*d(2) => -l*bos(f,n,m+1,1)*bos(f,n,m,l-1)+d(2)*bos(f,n,m,l),
der(~k)*fer(~f,0,~m) => bos(f,k,m)-fer(f,0,m)*der(k) when numberp k and k < 3,
der(~k)*bos(~f,0,~m) => fer(f,k,m)+bos(f,0,m)*der(k) when numberp k and k < 3,
fer(~f,0,~m)*del(~k) => bos(f,k,m)-del(k)*fer(f,0,m) when numberp k and k < 3,
bos(~f,0,~m)*del(~k) => -fer(f,k,m)+del(k)*bos(f,0,m) when numberp k and k < 3,
der(~k)*bos(~f,0,~m,~l) => l*fer(f,k,m)*bos(f,0,m,l-1)+bos(f,0,m,l)*der(k)
when numberp k and k < 3,
bos(~f,0,~m,~l)*del(~k) => -l*fer(f,k,m)*bos(f,0,m,l-1)+del(k)*bos(f,0,m,l)
when numberp k and k < 3,
d(1)*axp(~g) => pg(1,g)*axp(g)+axp(g)*d(1),
der(1)*axp(~g) => pr(1,g)*axp(g)+axp(g)*der(1),
der(2)*axp(~g) => pr(2,g)*axp(g)+axp(g)*der(2),
axp(~g)*d(2) => -pg(1,g)*axp(g)+d(2)*axp(g),
axp(~g)*del(1) => -pr(1,g)*axp(g)+del(1)*axp(g),
axp(~g)*del(2) => -pr(2,g)*axp(g)+del(2)*axp(g),
d(1)*fun(~f,~m) => fun(f,m+1)+fun(f,m)*d(1),
fun(~f,~m)*d(2) => -fun(f,m+1)+d(2)*fun(f,m),
d(1)*fun(~f,~n,~m) => m*fun(f,n+1,1)*fun(f,n,m-1)+fun(f,n,m)*d(1),
fun(~f,~n,~m)*d(2) => -m*fun(f,n+1,1)*fun(f,n,m-1)+d(2)*fun(f,n,m),
gras(~f,~m)*d(2) => -gras(f,m+1)+d(2)*gras(f,m),
d(1)*gras(~f,~m) => gras(f,m+1)+gras(f,m)*d(1),
d(1)*axx(~f) => pg(1,f)*axx(f)+axx(f)*d(1),
axx(~f)*d(2) => -pg(1,f)*axx(f)+d(2)*axx(f)}$
%integrations;
let { d(-1)*fer(~f,~n,~m) => if numberp(ww) then
for k:=0:ww-1 sum (-1)**k*fer(f,n,m+k)*d(-1)**(k+1) else
rederr "introduce the precision e.g. give the value of ww > 0",
fer(~f,~n,~m)*d(-2) => if numberp(ww) then
for k:=0:ww-1 sum d(-2)**(k+1)*fer(f,n,m+k) else
rederr "introduce the precision e.g. give the value of ww > 0",
d(-1)*bos(~f,~n,~m) => if numberp(ww) then
for k:=0:ww-1 sum (-1)**k*bos(f,n,m+k)*d(-1)**(k+1) else
rederr "introduce the precision e.g. give the value of ww > 0",
bos(~f,~n,~m)*d(-2) => if numberp(ww) then
for k:=0:ww-1 sum d(-2)**(k+1)*bos(f,n,m+k) else
rederr "introduce the precision e.g. give the value of ww > 0",
d(-1)*bos(~f,~n,~m,~l) => if numberp(ww) then
for k:=0:ww-1 sum (-1)**k*pg(k,bos(f,n,m,l))*d(-1)**(k+1) else
rederr "introduce the precision e.g. give the value of ww > 0",
bos(~f,~n,~m,~l)*d(-2) => if numberp(ww) then
for k:=0:ww-1 sum d(-2)**(k+1)*pg(k,bos(f,n,m,l)) else
rederr "introduce the precision e.g. give the value of ww > 0",
d(-1)*axp(~f) => if numberp(ww) then
for k:=0:ww-1 sum (-1)**k*pg(k,axp(f))*d(-1)**(k+1) else
rederr "introduce the precision e.g. give the value of ww > 0",
axp(~f)*d(-2) => if numberp(ww) then
for k:=0:ww-1 sum d(-2)**(k+1)*pg(k,axp(f)) else
rederr "introduce the precision e.g. give the value of ww > 0",
%acceleration;
dr(~x)*bos(~f,~n,~m) => if numberp(ww) then
for s:=0:ww sum (-1)**s*newton(-x+s-1,-x-1)*bos(f,n,m+s)*dr(x-s)
else rederr "introduce the precision e.g. give the value of ww > 0",
dr(~x)*fer(~f,~n,~m) => if numberp(ww) then
for s:=0:ww sum (-1)**s*newton(-x+s-1,-x-1)*fer(f,n,m+s)*dr(x-s)
else rederr "introduce the precision e.g. give the value of ww > 0",
dr(~x)*bos(~f,~n,~m,~l) => if numberp(ww) then
for s:=0:ww sum (-1)**s*newton(-x+s-1,-x-1)*pg(s,bos(f,n,m,l))*dr(x-s)
else rederr "introduce the precision e.g. give the value of ww > 0",
dr(~x)*fun(~f,~n) => if numberp(ww) then
for s:=0:ww sum (-1)**s*newton(-x+s-1,-x-1)*fun(f,n+s)*dr(x-s)
else rederr "introduce the precision e.g. give the value of ww > 0",
dr(~x)*gras(~f,~n) => if numberp(ww) then
for s:=0:ww sum (-1)**s*newton(-x+s-1,-x-1)*gras(f,n+s)*dr(x-s)
else rederr "introduce the precision e.g. give the value of ww > 0",
dr(~x)*fun(~f,~n,~l) => if numberp(ww) then
for s:=0:ww sum (-1)**s*newton(-x+s-1,-x-1)*pg(s,fun(f,n,l))*dr(x-s)
else rederr "introduce the precision e.g. give the value of ww > 0",
%classical
d(-1)*fun(~f,~n,~m) => if numberp(ww) then
for k:=0:ww-1 sum (-1)**k*pg(k,fun(f,n,m))*d(-1)**(k+1) else
rederr "introduce the precision e.g. give the value of ww > 0",
fun(~f,~n,~m)*d(-2) => if numberp(ww) then
for k:=0:ww-1 sum d(-2)**(k+1)*pg(k,fun(f,n,m)) else
rederr "introduce the precision e.g. give the value of ww > 0",
d(-1)*fun(~f,~n) => if numberp(ww) then
for k:=0:ww-1 sum (-1)**k*fun(f,n+k)*d(-1)**(k+1) else
rederr "introduce the precision e.g. give the value of ww > 0",
fun(~f,~n)*d(-2) => if numberp(ww) then
for k:=0:ww-1 sum d(-2)**(k+1)*fun(f,n+k) else
rederr "introduce the precision e.g. give the value of ww > 0",
d(-1)*gras(~f,~n) => if numberp(ww) then
for k:=0:ww-1 sum (-1)**k*gras(f,n+k)*d(-1)**(k+1) else
rederr "introduce the precision e.g. give the value of ww > 0",
gras(~f,~n)*d(-2) => if numberp(ww) then
for k:=0:ww-1 sum d(-2)**(k+1)*gras(f,n+k) else
rederr "introduce the precision e.g. give the value of ww > 0",
d(-1)*axx(~f) => if numberp(ww) then
for k:=0:ww-1 sum (-1)**k*pg(k,axx(f))*d(-1)**(k+1) else
rederr "introduce the precision e.g. give the value of ww > 0",
axx(~f)*d(-2) => if numberp(ww) then
for k:=0:ww-1 sum d(-2)**(k+1)*pg(k,axx(f)) else
rederr "introduce the precision e.g. give the value of ww > 0" }$
%other time
let
{ d(t)*axp(~f) => axp(f)*d(t)*f,
d(t)*bos(~f,~n,~m) => bos(f,n,m,t,t) + bos(f,n,m)*d(t),
d(t)*fer(~f,~n,~m) => fer(f,n,m,t) +fer(f,n,m)*d(t),
d(t)*bos(~f,~n,~m,~l) => l*bos(f,n,m,l-1)*bos(f,n,m,t,t)+bos(f,n,m,l)*d(t) }$
%******************************************%
%*** module - actions ********************%
%******************************************%
procedure rzut(rr,n);
begin scalar ola,ewa;
ola:=chan(rr); ewa:=sub(d(-1)=0,d(-2)=0,d(-3)=0,d(-4)=0,ola);
if n = 0 then return ewa;
if n = 1 then ewa:=ewa-sub(der(1)=0,der(2)=0,der(3)=0,d(1)=0,ewa);
if n = 2 then ewa:=ewa-sd_part(ewa,0,0)-sd_part(ewa,1,0)*der(1)-
sd_part(ewa,2,0)*der(2)-sd_part(ewa,0,1)*d(1);
return ewa end$
procedure sd_part(wr,n,m);
begin scalar ewa,ola;
ewa:=sub(d(1)=!@kk,d(2)=!@kk,d(-2)=!@ss,d(-1)=!@ss,
d(-3)=!@ss*d(-33),d(-4)=!@ss*d(-44),wr);
ola:=if m greaterp 0 then coeffn(ewa,!@kk,m) else if m equal 0 then
sub(!@ss=0,!@kk=0,ewa) else coeffn(ewa,!@ss,-m);
return s_part(sub(!@ss=1,!@kk=1,d(-33)=d(-3),d(-44)=d(-4),ola),n) end$
procedure d_part(ww,n);
begin scalar ewa,ola;
ewa:=sub(d(1)=!@kk,d(2)=!@kk,d(-1)=!@ss,d(-2)=!@ss,
d(-3)=!@ss*d(-33),d(-4)=d(-44)*!@ss,ww);
ola:=if n greaterp 0 then coeffn(ewa,!@kk,n) else if n=0 then
sub(!@kk=0,!@ss=0,ewa) else coeffn(ewa,!@ss,-n);
return sub(d(-33)=d(-3),d(-44)=d(-4),ola) end$
procedure pr(n,ww);
begin scalar ewa;
if n=0 then ewa:=ww; if n=1 then ewa:=der(1)*ww;
if n=2 then ewa:=der(2)*ww;
if n=3 then if abra_kadabra eq 3 then ewa:=der(3)*ww else
ewa:=der(1)*pr(2,ww);
return sub(der(1)=0,der(2)=0,der(3)=0,ewa) end$
%*********************************%
%*** module adjoint **********%
%*********************************%
% stp(1),stp(10),stp(20) if does not appeare der or apeapare der(1)*der(2);
% stp(2) if appeare der;
!@rak:={ stp(1)=1, stp(10)=1, stp(20)=1, stp(2)= - 1 }$
procedure cp(xwx);
begin scalar kap,kap1,ess,k,l;
if xwx equal 0 then return 0;kap:=length(xwx);
if numberp(kap) then return cp1(xwx);
kap1:=first kap;
matrix !@z_z(kap1,kap1);matrix !@s_s(kap1,kap1);
for k:=1:kap1 do for l:=1:kap1 do <<
ess:=sub(!@krr=1,!@krr*xwx(k,l));!@z_z(k,l):=cp1(ess); clear ess; >>;
clear !@krr;!@s_s:=tp(!@z_z);clear !@z_z; return !@s_s end$
procedure cp1(yyz);
begin scalar ewa,ola,xx,yyy;
if yyz equal 0 then return 0; yyy:=if length(yyz) equal 1 and arglength(yyz)
equal -1 then !@*yyz else yyz; factor d,der,del; ewa:=lyst(yyy);
ola:=for each xx in ewa collect
begin scalar mew,wem,em1,em2,em,em3,licz,mian;
licz:=num(xx);mian:=den(xx); if numberp(licz) then return xx;
mew:=licz*stp(1);wem:=sub(!@rak,mew);em:=if part(wem,0) equal minus
then -1 else 1;
em1:= cp2(em*wem);
em2:=part(reverse(em1),0):=*;
return em2*em/mian end; remfac d,der,del;
return sub(!@=1,part(ola,0):=+) end$
procedure cp2(zz);
begin scalar ewa,ola,ela,el1;
if arglength(@*zz) equal 2 then return {zz};
ewa:=(zz where tryk4);
ola:=zz/ewa;
ela:=if arglength(!@*ola) equal 2 then {ola} else part(ola,0):=list;
el1:=append({ewa},ela);
return el1 end$
%************************************%
%*** module O(2) invariance ********%
%************************************%
procedure odwa(wx);
begin scalar ewa,ola;
let tryk15; ewa:=sub(der(1)=-der(20),der(2)=der(10),
del(1)=-del(20),del(2)=del(10),wx); clearrules tryk15;
let tryk9; ola:=ewa; clearrules tryk9;
return sub(der(10)=der(1),der(20)=der(2),del(10)=del(1),del(20)=del(2),ola) end$
%************************************%
%*** module - coefficients **********%
%************************************%
procedure lyst(wx);
begin scalar ewa,ola,kap,kap1,adam;
if wx=0 then return {0};
factor d,der,del;kap:=length(wx);kap1:=arglength(wx);
if kap equal 1 and kap1 equal -1 then return {wx};
if kap1>kap then return {wx}; on div; ewa:=wx;
if part(ewa,0) = plus then adam:=part(ewa,0):=list else
adam:={ewa};off div; remfac d,der,del;return adam; end$
procedure lyst1(wy);
begin scalar ewa,ola; ewa:=lyst(wy);
ola:=(ewa where tryk3);return ola end$
procedure lyst2(wy);
begin scalar ewa,ola; ewa:=lyst(wy);
ola:=(ewa where tryk4);return ola end$
%************************************%
%*** module - gradients *************%
%************************************%
procedure war(wa,f);
begin scalar ewa,ola,adam,mew;
let tryk; ewa:=d(f)*wa-wa*d(f); clearrules tryk;
ola:=(ewa where tryk1);
ewa:=sub(d(1)=0,der(1)=0,der(2)=0,der(3)=0,ola);
if ewa=0 then return 0; adam:=lyst(ewa); mew:=(adam where tryk3);
return if mew equal 0 then {} else mew end$
procedure dyw(wa,f);
begin scalar ewa,ola;
ewa:=(d(f)*wa-wa*d(f) where tryk);
ola:=(ewa where tryk2);
ewa:=sub(d(1)=0,der(1)=0,der(2)=0,der(3)=0,ola);
if ewa=0 then return 0;
return lyst(ewa) end$
procedure gra(wa,f);
begin scalar ewa,ola;
ewa:=(d(f)*wa-wa*d(f) where tryk); ola:=(ewa where tryk1);
return sub(d(1)=0,der(1)=0,der(2)=0,der(3)=0,ola) end$
%***************************************%
%*** module - coordinates **************%
%***************************************%
procedure fpart(wx);
begin scalar ewa,ola,adam;
ewa:=if abra_kadabra eq 2 then (wx where tryk5) else (wx where tryk16);
ola:=sub(tet(1)=!#qw,tet(2)=!#qq,ewa);
adam:= {coeffn(coeffn(ola,!#qw,0),!#qq,0),
coeffn(coeffn(ola,!#qw,1),!#qq,0),
coeffn(coeffn(ola,!#qw,0),!#qq,1),
coeffn(coeffn(ola,!#qw,1),!#qq,1)}; return adam end$
procedure bpart(wx);
begin scalar ewa,ola,adam;
ewa:=if abra_kadabra eq 2 then (wx where tryk5) else (wx where tryk16);
let tryk6; ola:=sub(tet(1)=!#qw,tet(2)=!#qq,ewa);clearrules tryk6;
adam:= {coeffn(coeffn(ola,!#qw,0),!#qq,0),
coeffn(coeffn(ola,!#qw,1),!#qq,0),
coeffn(coeffn(ola,!#qw,0),!#qq,1),
coeffn(coeffn(ola,!#qw,1),!#qq,1)}; return adam end$
%******************************************%
%*** module combinations ******************%
%******************************************%
procedure koza(wx,wi,wn);
begin scalar ew1,ew2,am;
ew3:=part(wx,3);ew1:=part(wx,1);
am:=
if ew3 eq f and wi eq 0 or ew3 eq f and wi eq 3 then
!@x_y*!@g_g(ew1,wi,wn) else
if ew3 eq f and wi eq 1 or ew3 eq f and wi eq 2 then
!@x_y**2*!@f_f(ew1,wi,wn) else
if ew3 eq b and wi eq 0 or ew3 eq b and wi eq 3 then
!@x_y**2*!@f_f(ew1,wi,wn) else
if ew3 eq b and wi eq 1 or ew3 eq b and wi eq 2 then
!@x_y*!@g_g(ew1,wi,wn); return am end$
procedure w_comb(as,m,a,bb);
begin scalar kap,ewa,ola,wic,wid,wod,wod1,wx,k,s,!*precise;
kap:=length(as);
if m = 0 then return 0;if m = 0.5 then return w_comb1(as,a,bb);
(!#l)^(m+1):=0;(!#l)^(m+1/2):=0;
ewa:=for s:=0:floor(m) sum for k:=1:kap sum
(!#l)^(part(as,k,2)+s)*(koza(part(as,k),0,s)*2+
(!#l)*koza(part(as,k),3,s)+
(!#l)^(1/2)*koza(part(as,k),1,s)+
(!#l)^(1/2)*koza(part(as,k),2,s));
ola:=ewa;wic:=ewa;
for k:=0:floor(m) do << ola:=ewa*ola;
ewa:=for s:=0:m-k+1 sum for r:=1:kap sum
(!#l)^(part(as,r,2)+s)*(koza(part(as,r),0,s)*2+
(!#l)*koza(part(as,r),3,s)+
(!#l)^(1/2)*koza(part(as,r),1,s)+
(!#l)^(1/2)*koza(part(as,r),2,s)); wic:=wic+ola;>>;
wid:=sub((!#l)=(!#ll)^2,wic); wod:=coeffn(wid,(!#ll),2m);
wod:=if bb eq b then sub(!@x_y=0,wod) else
if bb eq f then coeffn(wod,!@x_y,1);
wod1:=lyst((wod where tryk7)); clear (!#l)^(m+1),(!#l)^(m+1/2);
kap:=length(wod1);ewa:=0; for k:=1:kap do <<adam:=
if wod1 eq 0 then 0 else part(wod1,k);
ola:=if adam eq 0 then 0 else
if part(adam,0)=minus then -adam else adam;
wx:=if ola eq 0 then 1 else
if part(ola,0)=times then
if fixp(part(ola,1)) then part(ola,1) else 1 else 1;
ewa:=ewa+mkid(a,k)*ola/wx;>>;
return ewa end$
procedure w_comb1(as,a,bb);
begin scalar ew,kap1,ew1,kap;
kap:=length(as);
ew:=for n:=1:kap join
if part(as,n,2) neq 1/2 then {} else
if part(as,n,3) eq f and bb eq f then {fer(part(as,n,1),0,0)} else
if part(as,n,3) eq f and bb eq b then {} else
if part(as,n,3) eq b and bb eq f then {} else
if part(as,n,3) eq b and bb eq b then {bos(part(as,n,1),0,0)};
kap1:=length(ew);
ew1:=if kap1 eq 0 then 0 else
for n:=1:kap1 sum mkid(a,n)*part(ew,n);
return ew1 end$
procedure fcomb(as,n,b,bb);
begin scalar ewa,ola,ala,k,kap,wx,wy,kap1,wod,wod1,ema,wz,wz1;
operator b;ewa:=w_comb(as,n,a,bb);kap:=length(as);ala:={};
wz:=ewa;wz1:=ewa;ema:={};
for k:=1:kap do << wz:=sub(part(as,k,1)=0,wz);
wx:=wz1-wz; wz1:=wz;ema:=append(ema,{{wx}});>>;
for k:=1:kap do << wx:=dyw(part(ema,k,1),part(as,k,1));
wy:=if wx=0 then {} else wx;
ala:=append(ala,wy);>>; kap1:=length(ala); ewa:=0;
for k:=1:kap1 do << wod:=part(ala,k);
wod1:=(wod where tryk3);ewa:=ewa+b(k)*wod/wod1;>>; return ewa end$
procedure pse_ele(n,ww,ss);
begin scalar ewa,ola,kap,k,maj,maj1,ela;
ewa:=0;
operator ss;
for k:=1:n do << ewa:=ewa+
(w_comb(ww,k,mkid(mkid(a,k),a),b)+
w_comb(ww,k-1/2,mkid(mkid(a,k),b),f)*der(1) +
w_comb(ww,k-1/2,mkid(mkid(a,k),c),f)*der(2)+
w_comb(ww,k-1,mkid(mkid(a,k),d),b)*(if abra_kadabra eq 3 then
der(3) else der(1)*der(2)))*d(1)**(n-k);>>;
remfac fer,bos; kap:=length(ewa); ola:=0;
for k:=1:kap do << maj:=if ewa eq 0 then 0 else
if kap equal 1 then ewa else part(ewa,k);
maj1:=if maj eq 0 then 1 else (maj where tryk4);
ola:=ola+ss(k+1)*maj/maj1;>>;
ela:=ss(0)*d(1)**n+ss(1)*(if abra_kadabra eq 3 then der(3) else
der(1)*der(2))*d(1)**(n-1)+ola;factor fer,bos;
if abra_kadabra eq 3 then ela:=(ela where {der(1)*der(2) => der(3)});
return ela end$
%********************************************%
%*** module jacobi *************************%
%********************************************%
%wim as {bos(f)=>expression};
procedure n_gat(pp,wim);
begin scalar kap,niech,zyje;
kap:=length(wim);
niech:=gato(pp); let wim;zyje:=(niech where tryk10);
clearrules wim;
return zyje end$
procedure gato(p);
begin scalar as,ess,mess;
if numberp(length(p)) then return gat1(p);
as:=first length(p); matrix !#zz(as,as);
for k:=1:as do for l:=1:as do
<< ess:=(!#zab*p(k,l) where tryk8);
mess:=(ess/!#zab where tryk9);!#zz(k,l):=sub(eps=0,df(mess,eps));>>;
return !#zz end$
procedure gat1(p);
begin scalar ess,zz,mess;
ess:=(p where tryk8); mess:=(ess where tryk9);
zz:=sub(eps=0,df(mess,eps)); return zz end$
% p is a hamiltonian operator in d,der;
% w is a list of functions with the ordering such way that
%first corresponds to the (1,1) element of p corresponds to {f,f};
% m is a list of components of the test vecor functions;
procedure fjacob(p,w);
begin scalar as,as1,es1,wod0,wod1,wod2,wod3,wodx;
if numberp(length(p)) then return jacob1(p,w);
as:=first length(p); matrix !#ala(as,as),!#ela(as,as);
!#ala:=gato(p); operator !#a,!#b,!#c;
as1:=for k:=1:as collect for l:=1:as sum
sub(d(1)=0,der(1)=0,der(2)=0,p(k,l)*bos(!#b(l),0,0));
for k:=1:as do << bos(part(w,k)):=part(as1,k);>>;
!#ela:=(!#ala where tryk10);
wod:=for k:=1:as sum for l:=1:as sum
bos(!#c(k),0,0)*!#ela(k,l)*bos(!#a(l),0,0);
wod1:=sub(d(1)=0,der(1)=0,der(2)=0,wod);
%permutation;
wodx:=(wod1 where tryk11); wod2:=(wodx where tryk12);
wod3:=(wodx where tryk13); return wod1+wod2+wod3 end$
procedure jacob(p,w,m);
begin scalar woda;
woda:=for wx:=1:3 sum
begin scalar trys,as1,as,wod;
operator !#a,!#b,!#c,!@a,!@b,!@c;
as:=first length(p);
trys:=for k:=1:as join {
!@a(k)=if k equal first(m) then !#a(k) else 0,
!@b(k)=if k equal second(m) then !#b(k) else 0,
!@c(k)=if k equal third(m) then !#c(k) else 0};
let trys; matrix !@ala(as,as),!@ela(as,as);
!@ala:=gato(p);
as1:=for k:=1:as collect for l:=1:as sum
sub(d(1)=0,der(1)=0,der(2)=0,p(k,l)*bos(
if wx eq 1 then !@b(l) else
if wx eq 2 then !@c(l) else
if wx eq 3 then !@a(l),0,0));
for k:=1:as do << bos(part(w,k)):=part(as1,k);>>;
!@ela:=(!@ala where tryk10);
wod:=for k:=1:as sum for l:=1:as sum
bos(if wx eq 1 then !@c(k) else
if wx eq 2 then !@a(k) else
if wx eq 3 then !@b(k),0,0)*!@ela(k,l)*
bos(if wx eq 1 then !@a(l) else
if wx eq 2 then !@b(l) else
if wx eq 3 then !@c(l),0,0);
for k:=1:as do clear !@a(k),!@b(k),!@c(k),bos(part(w,k));
return sub(d(1)=0,der(1)=0,der(2)=0,wod) end; return woda end$
procedure jacob1(p,w);
begin scalar ala,ela,wod,wod1,wod2,wodx,ewa;
ala:=gat1(p);bos(w):=sub(d(1)=0,der(1)=0,der(2)=0,p*bos(!#b,0,0));
let tryk10;ela:=ala;clearrules tryk10;wod:=bos(!#c,0,0)*ela*bos(!#a,0,0);
wod1:=sub(d(1)=0,der(1)=0,der(2)=0,wod);
%permutation;
wodx:=sub(!#a=!#aa,!#b=!#bb,!#c=!#cc,wod1);
wod2:=sub(!#aa=!#b,!#bb=!#c,!#cc=!#a,wodx);
wod3:=sub(!#aa=!#c,!#bb=!#a,!#cc=!#b,wodx);
clear bos(w);
return wod1+wod2+wod3 end$
%************************************************
%********* module macierz ***********************
%************************************************
%wx pse_ele
%xx f (fermion) or b (boson)
%yy bosonic part or fermionic part
procedure macierz(wx,xx,yy);
begin scalar ewa,ola,ew1,ew2;
matrix !@z_z_x(4,4); ewa:=if xx eq f then
sub(der(1)=0,der(2)=0,der(3)=0,d(1)=0,wx*fer(!#z_z,0,0)) else
if xx eq b then sub(der(1)=0,der(2)=0,der(3)=0,d(1)=0,wx*bos(!#z_z,0,0)) else
rederr "wrong value of second argument which should be b or f";
ola:=if yy eq b then bpart(ewa) else if yy eq f then fpart(ewa) else
rederr "wrong value of third argument which should be b or f";
ew1:=(ola where
{fun(!#z_z0,~n) => ber(1,n),fun(!#z_z1,~n) => ber(2,n),
gras(!#z_z!#z_z1,~n) => fir(1,n),gras(!#z_z!#z_z2,~n) => fir(2,n)});
ew2:=(ew1 where {
ber(1,~n) => !#s_s*d(1)^n, ber(2,~n) => !#s_s^4*d(1)^n,
fir(1,~n) => !#s_s^2*d(1)^n,fir(2,~n) => !#s_s^3*d(1)^n});
for k:=1:4 do for l:=1:4 do !@z_z_x(k,l):=chan(coeffn(part(ew2,k),!#s_s,l));
return !@z_z_x end$
%********************************************%
%*** module dot_ham *************************%
%********************************************%
procedure dot_ham(ww,mm);
begin scalar ewa,ola,ala,as;
as:=length(ww); ewa:=d(t)*mm-mm*d(t);
for k:=1:as do bos(part(part(ww,k),1),t):=part(part(ww,k),2);
ola:=(ewa where tryk14);
for k:=1:as do clear bos(part(part(ww,k),1),t);
return ola end$
%module supersymmetric integration
%############################################################################
%######### F U N C T I O N A L S U S Y I N T E G R A T I O N ######
%######### O N L Y F O R T R A D ######
%############################################################################
% s_int(number,expression,variable)
% numbers corespond to integration over: 0 => d(1),
% 1=> der(1), 2=> der(2), 3 => der(1)*der(2)
% variable {f,g,...} the names of the superfunctions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% G L O B A L A C T I O N %%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
let {
waga(~k,~s,~m) =>
2*m+delta(k,s)+2*delta(3,s)+delta(3-k,s)*(if m>0 then 1 else 0),
s_s(~f,~n) =>1, s_s(1,~f,~n) => 1,
der(1)*del(-1)=>1, der(2)*del(-2) => 1, der(3)*del(-3) =>1,
del(0)=>d(-3), der(1)*del(-3) => 1, der(2)*del(-3) =>del(-3),
der(1)*der(2)*del(-3)=>1
}$
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%&&&&&&&&&&&&&&&&&
%%%% L O C A L A C T I O N %%%%%%%%%%%%%%%%&&&&&&&&&&&&&&&&&
%##############################################################
%%%%%%%%%%%%%%%%%%%%%%% n_dyw %%%%%%%%%%%%%%%%%%%%%%
%##############################################################
%scaling
dryk:= {d(~f,~n)*fer(~g,~k,~m) => fer(g,k,m)*d(f,n+delta(f,g)),
d(~f,~n)*bos(~g,~k,~m) => bos(g,k,m)*d(f,n+delta(f,g)),
d(~f,~n)*zan(~g,~k,~m) => zan(g,k,m)*d(f,n+1),
d(~f,~n)*zen(~g,~k,~m) => zen(g,k,m)*d(f,n+1)
}$
%wariation
wariat_0:={
zen(~f,~k,~n) => (-1)^n*fer(f,k,0)*d(1)^n,
zan(~f,~k,~n) => (-1)^n*bos(f,k,0)*d(1)^n
}$
wariat_1:={
zen(~f,~k,~n) => if k = 3 or k = 1 then
(-1)^(n+1)*bos(f,k-1,0)*der(1)*d(1)^n else (-1)^n*fer(f,k,0)*d(1)^n ,
zan(~f,~k,~n) => if k = 3 or k = 1 then
(-1)^n*fer(f,k-1,0)*der(1)*d(1)^n else (-1)^n*bos(f,k,0)*d(1)^n
}$
wariat_2:={
zen(~f,~k,~n) => if k = 3 or k = 2 then
(-1)^(k-1+n)*bos(f,k-2,0)*der(2)*d(1)^n else (-1)^n*fer(f,k,0)*d(1)^n ,
zan(~f,~k,~n) => if k = 3 or k = 2 then
(-1)^(k+n)*fer(f,k-2,0)*der(2)*d(1)^n else (-1)^n*bos(f,k,0)*d(1)^n
}$
wariat_3:={
zen(~f,0,~n) => if n > 1 then (-1)^(n-1)*(-fer(f,0,0)*d(1)^n
+ n*d(1)*fer(f,0,0)*d(1)^(n-1)) else fer(f,0,n) ,
zen(~f,1,~n) =>
(-1)^n*(fer(f,1,0)*d(1)^n + n*d(1)*bos(f,0,0)*der(1)*d(1)^(n-1)),
zen(~f,2,~n) =>
(-1)^n*(fer(f,2,0)*d(1)^n + n*d(1)*bos(f,0,0)*der(2)*d(1)^(n-1)),
zen(~f,3,~n) =>
-zen(f,0,n)*der(1)*der(2) + zan(f,1,n)*der(2) - zan(f,2,n)*der(1),
zan(~f,0,~n) => if n>1 then (-1)^(n-1)*(-bos(f,0,0)*d(1)^n
+ n*d(1)*bos(f,0,0)*d(1)^(n-1)) else bos(f,0,n),
zan(~f,1,~n) =>
(-1)^n*(bos(f,1,0)*d(1)^n - n*d(1)*fer(f,0,0)*der(1)*d(1)^(n-1)),
zan(~f,2,~n) =>
(-1)^n*(bos(f,2,0)*d(1)^n - n*d(1)*fer(f,0,0)*der(2)*d(1)^(n-1)),
zan(~f,3,~n) =>
-zan(f,0,n)*der(1)*der(2) - zen(f,1,n)*der(2)+zen(f,2,n)*der(1)
}$
%###########################################################
%%%%%%%%%%%%%%%%%%%%%% maxi %%%%%%%%%%%%%%%%%%%
%###########################################################
szukaj0:={
byk(~n,~g)*fer(~f,~k,~m) => if n<=2*m then fer(f,k,m)*byk(2*m,f)
else fer(f,k,m)*byk(n,g),
byk(~n,~g)*bos(~f,~k,~m) => if n<=2*m then bos(f,k,m)*byk(2*m,f)
else bos(f,k,m)*byk(n,g)
}$
szukaj1:={
byk(~k,~g)*fer(~f,~n,~m) => if k <= waga(1,n,m) then
fer(f,n,m)*byk(waga(1,n,m),f) else fer(f,n,m)*byk(k,g),
byk(~k,~g)*bos(~f,~n,~m) =>if k <= waga(1,n,m) then
bos(f,n,m)*byk(waga(1,n,m),f) else bos(f,n,m)*byk(k,g)
}$
szukaj2:={
byk(~k,~g)*fer(~f,~n,~m) => if k <= waga(2,n,m) then
fer(f,n,m)*byk(waga(2,n,m),f) else fer(f,n,m)*byk(k,g),
byk(~k,~g)*bos(~f,~n,~m) => if k<= waga(2,n,m) then
bos(f,n,m)*byk(waga(2,n,m),f) else bos(f,n,m)*byk(k,g)
}$
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
szukaj3:={
byk(~k,~g)*fer(~f,0,~m) => if m < 2 then fer(f,0,m)*byk(k,g) else
<< if k <= 2*m then fer(f,0,m)*byk(2*m,f) else fer(f,0,m)*byk(k,g) >>,
byk(~k,~g)*fer(~f,1,~m) => if m < 1 then fer(f,1,m)*byk(k,g) else
<< if k <= 2*m+1 then fer(f,1,m)*byk(2*m+1,f) else fer(f,1,m)*byk(k,g) >>,
byk(~k,~g)*fer(~f,2,~m) => if m < 1 then fer(f,2,m)*byk(k,g) else
<< if k <= 2*m+1 then fer(f,2,m)*byk(2*m+1,f) else fer(f,2,m)*byk(k,g) >> ,
byk(~k,~g)*fer(~f,3,~m) => if k <= 2*m+2 then fer(f,3,m)*byk(2*m+2,f)
else fer(f,3,m)*byk(k,g),
byk(~k,~g)*bos(~f,0,~m) => if m < 2 then bos(f,0,m)*byk(k,g) else
<< if k <= 2*m then bos(f,0,m)*byk(2*m,f) else bos(f,0,m)*byk(k,g) >> ,
byk(~k,~g)*bos(~f,1,~m) => if m < 1 then bos(f,1,m)*byk(k,g) else
<< if k <= 2*m+1 then bos(f,1,m)*byk(2*m+1,f) else bos(f,1,m)*byk(k,g) >>,
byk(~k,~g)*bos(~f,2,~m) => if m < 1 then bos(f,2,m)*byk(k,g) else
<< if k <= 2*m+1 then bos(f,2,m)*byk(2*m+1,f) else bos(f,2,m)*byk(k,g) >>,
byk(~k,~g)*bos(~f,3,~m) => if k<=2*m+2 then bos(f,3,m)*byk(2*m+2,f)
else bos(f,3,m)*byk(k,g)
}$
%###########################################################################
poszukaj0:={
fer(~f,~s,~m)*r_r(~k,~g) => if k = 2*m and g equal f then
r_r(2*m,f)*zen(f,s,m) else r_r(k,g)*fer(f,s,m),
bos(~f,~s,~m)*r_r(~k,~g) => if k = 2*m and g equal f then
r_r(2*m,f)*zan(f,s,m) else r_r(k,g)*bos(f,s,m)
}$
poszukaj1:={
fer(~f,~s,~m)*r_r(~k,~g) => if k = waga(1,s,m) and g equal f
then r_r(k,f)*zen(f,s,m) else r_r(k,g)*fer(f,s,m) ,
bos(~f,~s,~m)*r_r(~k,~g) => if k = waga(1,s,m) and g equal f
then r_r(k,f)*zan(f,s,m) else r_r(k,g)*bos(f,s,m)
}$
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
poszukaj2:={
fer(~f,~s,~m)*r_r(~k,~g) => if k = waga(2,s,m) and g equal f
then r_r(k,f)*zen(f,s,m) else r_r(k,g)*fer(f,s,m),
bos(~f,~s,~m)*r_r(~k,~g) => if k = waga(2,s,m) and g equal f
then r_r(k,f)*zan(f,s,m) else r_r(k,g)*bos(f,s,m)
}$
poszukaj3:={
fer(~f,0,~m)*r_r(~k,~g) => if m < 2 then r_r(k,g)*fer(f,0,m) else
<< if k = 2*m and f equal g then r_r(1,2*m,f)*zen(f,0,m)
else r_r(k,g)*fer(f,0,m) >>,
fer(~f,1,~m)*r_r(~k,~g) => if m < 1 then r_r(k,g)*fer(f,1,m) else
<<if k = 2*m+1 and f equal g then r_r(1,2*m+1,f)*zen(f,1,m) else
r_r(k,g)*fer(f,1,m)>>,
fer(~f,2,~m)*r_r(~k,~g) => if m < 1 then r_r(k,g)*fer(f,2,m) else
<< if k = 2*m+1 and f e qual g then r_r(1,2*m+1,f)*zen(f,2,m) else
r_r(k,g)*fer(f,2,m) >> ,
fer(~f,3,~m)*r_r(~k,~g) => if k = 2*m+2 and f equal g then
r_r(1,2*m+2,f)*zen(f,3,m) else r_r(k,g)*fer(f,3,m),
bos(~f,0,~m)*r_r(~k,~g) => if m < 2 then r_r(k,g)*bos(f,0,m) else
<< if k = 2*m and f equal g then r_r(1,2*m,f)*zan(f,0,m)
else r_r(k,g)*bos(f,0,m) >>,
bos(~f,1,~m)*r_r(~k,~g) => if m < 1 then r_r(k,g)*bos(f,1,m) else
<< if k = 2*m+1 and f equal g then r_r(1,2*m+1,f)*zan(f,1,m)
else r_r(k,g)*bos(f,1,m) >>,
bos(~f,2,~m)*r_r(~k,~g) => if m < 1 then r_r(k,g)*bos(f,2,m) else
<< if k = 2*m+1 and f e qual g then r_r(1,2*m+1,f)*zan(f,2,m)
else r_r(k,g)*bos(f,2,m) >> ,
bos(~f,3,~m)*r_r(~k,~g) => if k = 2*m+2 and f equal g then
r_r(1,2*m+2,f)*zan(f,3,m) else r_r(k,g)*bos(f,3,m)
}$
%#######################################################################
%%%%%%%%%%%%%%%%%%%%% I N T E G R A T I O N %%%%%%%%%%%%%%%%%%%%%%%%%%%
%#######################################################################
calkuj0:={
zen(~f,~n,~m) => fer(f,n,m-1),zan(~f,~n,~m) => bos(f,n,m-1)
}$
pocalkuj0:={
zen(~f,~n,~m) => -fer(f,n,m-1)*d(1),
zan(~f,~n,~m) => -bos(f,n,m-1)*d(1)
}$
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
calkuj1:={
zen(~f,~k,~n) => if k = 3 or k = 1 then bos(f,k-1,n) else
if k = 0 and n > 0 or k = 2 and n > 0 then bos(f,k+1,n-1),
zan(~f,~k,~n) => if k = 3 or k = 1 then fer(f,k-1,n) else
if k = 0 and n > 0 or k = 2 and n > 0 then fer(f,k+1,n-1)
}$
pocalkuj1:={
zen(~f,~k,~n) => if k = 3 or k = 1 then -bos(f,k-1,n)*der(1) else
if k = 0 and n > 0 or k = 2 and n > 0 then -bos(f,k+1,n-1)*der(1),
zan(~f,~k,~n) => if k = 3 or k = 1 then fer(f,k-1,n)*der(1) else
if k = 0 and n > 0 or k = 2 and n > 0 then fer(f,k+1,n-1)*der(1)
}$
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
calkuj2:={
zen(~f,~k,~n) => if k = 3 or k = 2 then (-1)^k*bos(f,k-2,n) else
if k = 0 and n > 0 or k = 1 and n > 0 then (-1)^k*bos(f,k+2,n-1) ,
zan(~f,~k,~n) => if k = 3 or k = 2 then (-1)^k*fer(f,k-2,n) else
if k = 0 and n > 0 or k = 1 then (-1)^k*fer(f,k+2,n-1)
}$
pocalkuj2:={
zen(~f,~k,~n) => if k = 3 or k = 2 then -(-1)^k*bos(f,k-2,n)*der(2) else
if k = 0 and n > 0 or k = 1 and n > 0 then -(-1)^k*bos(f,k+2,n-1)*der(2) ,
zan(~f,~k,~n) => if k = 3 or k = 2 then (-1)^k*fer(f,k-2,n)*der(2) else
if k = 0 and n > 0 or k = 1 and n > 0 then (-1)^k*fer(f,k+2,n-1)*der(2)
}$
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
calkuj3:={
zen(~f,0,~n) => if n < 2 then fer(f,0,n) else -fer(f,3,n-2),
zen(~f,1,~n) => if n < 1 then fer(f,1,0) else fer(f,2,n-1),
zen(~f,2,~n) => if n < 1 then fer(f,2,0) else -fer(f,1,n-1),
zen(~f,3,~n) => fer(f,0,n),
zan(~f,0,~n) => if n < 2 then fer(f,0,n) else -bos(f,3,n-2),
zan(~f,1,~n) => if n < 1 then fer(f,1,0) else bos(f,2,n-1),
zan(~f,2,~n) => if n < 1 then fer(f,2,0) else -bos(f,1,n-1),
zan(~f,3,~n) => bos(f,0,n)
}$
pocalkuj3:={
zen(~f,0,~n) => -bos(f,2,n-1)*der(2)-bos(f,1,n-1)*der(1)+
fer(f,3,n-2)*der(1)*der(2) ,
zen(~f,1,~n) => bos(f,3,n-1)*der(2)-bos(f,0,n)*der(1)-
fer(f,2,n-1)*der(1)*der(2) ,
zen(~f,2,~n) => -bos(f,0,n)*der(2)-bos(f,3,n-1)*der(1)+
fer(f,1,n-1)*der(1)*der(2),
zen(~f,3,~n) => -fer(f,0,n)*der(1)*der(2)+bos(f,1,n)*der(2)-bos(f,2,n)*der(1),
zan(~f,0,~n) => bos(f,3,n-2)*der(1)*der(2)+fer(f,2,n-1)*der(2)+
fer(f,1,n-1)*der(1),
zan(~f,1,~n) => -fer(f,3,n-1)*der(2)+fer(f,0,n)*der(1)-
bos(f,2,n-1)*der(1)*der(2) ,
zan(~f,2,~n) => fer(f,3,n-1)*der(1)+fer(f,0,n)*der(2)+
bos(f,1,n-1)*der(1)*der(2) ,
zan(~f,3,~n) => -bos(f,0,n)*der(1)*der(2)-fer(f,1,n)*der(2)+fer(f,2,n)*der(1)
}$
%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
%$$$$$ $$$$$$
%$$$$$ P R O C E D U R E S $$$$$$
%$$$$$ $$$$$$
%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
%%%%%%%%%%%%%%%%% one maximum %%%%%%%%%%%%%%%%%%%%%
procedure maxi(wrt,wx);
begin scalar kr,kr1,ew1,ew2,ew3,ew4,ew5;
if wx equal 0 then return {0,0};
kr:=num wx; kr1:=den wx;
ew1:=(byk(0,0)*kr where (help!* := mkid(szukaj,wrt)));
ew2:=(ew1 where {byk(~n,~f) => (!l_a_!@m)^n*p_p(n,f)});
ew2:=sub(p_p=r_r,lcof(ew2,!l_a_!@m));
ew2:=(ew2 where (help!* := mkid(poszukaj,wrt)));
ew3:=sub(r_r=s_s,ew2);
ew1:=if part(ew3,0) equal minus then -1 else 1;
ew4:=sub(x_x=0,if length(ew1*ew3) < arglength(ew1*ew3)
then ew1*ew3 else part(ew1*ew3+x_x,1));
ew5:=kr-sub(zen=fer,zan=bos,ew1*ew4);
return {ew1*ew4/kr1,ew5/kr1} end$
%#################################################################
%%%%%%%%%%%%%%%%% dywergent terms %%%%%%%%%%%%%%%%%%%%%%%%%%%
%#################################################################
procedure n_dyw(wrt,wx,wz);
begin scalar eks0,eks,eks1,eks2,osa1,osa2,osa3,osa4;
kap:=length wz;
eks:=num wx; eks0:=den wx;
eks1:=if part(eks,0) equal minus then -1 else 1;
eks2:=eks1*eks;osa4:=0;
for k:=1:kap do <<
osa1:=eks2-sub(part(wz,k)=0,eks2);
eks2:=eks2-osa1;
osa2:=sub(d(part(wz,k))=0,(d(part(wz,k))*osa1 where tryk));
%scaling
osa3:=(d(part(wz,k),0)*osa2 where dryk);
osa3:=(osa3 where {d(~f,~n) => 1/n when n>0});
%end scaling
osa3:=sub(der(1)=0,d(1)=0,der(3)=0,der(2)=0,
(osa3 where (help!* := mkid(wariat_,wrt))));
osa4:=osa4+osa3;
>>;
return {wx-eks1*osa4/eks0,eks1*osa4/eks0} end$
%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
%*************** *******************************
%*************** MAIN PROCEDURE *******************************
%*************** *******************************
%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
procedure s_int(wrt,wx,wz);
begin scalar kak,kak1,kak2,pak,pak1,pak2,kap,pak3,pak4;
if wx equal 0 then return 0;
if abra_kadabra equal 1 and wrt > 0 or abra_kadabra equal 3
and wrt > 0 then
rederr " **** I T is Impossible to define in a proper
manner this integral => use trad representation for computation only";
kak:=n_dyw(wrt,wx,wz);
kak1:=first kak;
kak2:=second kak;
%if kak2 neq 0 then return del(-wrt)*wx;
pak:=hom(kak1);
pak1:=first first pak; pak2:=second pak;
kap:=length pak2;
pak3:=if pak2 equal 0 then 0 else for k:=1:kap sum cal(wrt,part(pak2,k));
pak4:= pak1*pak3+del(-wrt)*kak2 ;
return pak4 end$
procedure cal(wrt,wx);
begin scalar wem,wem1,wem2,wem3,wem4,wem5,wem6,z_z_z;
if wx equal 0 then return 0;
wem:=maxi(wrt,wx); wem1:=first(wem); wem2:=second(wem);
z_z_z:=0;
while wem1 neq 0 do <<
wem3:=sub(zen=fer,zan=bos,wem1);
wem4:=(wem1 where (help!* := mkid(calkuj,wrt)));
wem5:=sub(der(3)=0,der(1)=0,d(1)=0,der(2)=0,(-wem1 where
(help!* := mkid(pocalkuj,wrt))));
if wem4 = 0 then
z_z_z:=z_z_z+del(-wrt)*wem3 else <<
xxx:=(-!l_a_!@m*wem4+wem3+wem5 where {wem3=>koz});
wem6:=(rhs first solve(xxx,koz));clear xxx;
z_z_z:=z_z_z+coeffn(wem6,!l_a_!@m,1);
wem6:=sub(!l_a_!@m=0,wem6); wem2:=wem2+wem6 >>;
wem6:=maxi(wrt,wem2);
wem1:=first wem6; wem2:=second wem6;
>>;
return z_z_z end$
procedure hom(wx);
begin scalar zet1,zet2,iks,iks1,iks2;
if wx equal 0 then return {{0},0};
iks:=num wx;iks2:=den wx;
iks1:=if part(iks,0) equal minus then -1 else 1;
iks:=iks1*iks;
zet1:=(iks where {
fer(~f,~k,~n) => !&a(f)*!&a(!@)^(2n+(if k = 1 or k = 2 then 1 else
if k = 3 then 2 else 0))*zen(f,k,n),
bos(~f,~k,~n) => !&a(f)*!&a(!@)^(2n+(if k = 1 or k = 2 then 1 else
if k = 3 then 2 else 0))*zan(f,k,n)});
zet2:=part(zet1+x_x,0):=list;
zet1:=reverse rest reverse zet2;
return {{iks1/iks2},sub(zen=fer,zan=bos,(zet1 where
{!&a(~f) =>1,!&a(!@) => 1}))}
end$
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% D E C L A R A T I O N %%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
let trad;
endmodule;
end;