assigno('uniggt,'moduniggt)_

stagb:=0_

delete("/home/uli/felix/Twisted2Felix.out")_
output("/home/uli/felix/Twisted2Felix.out")_

% 1. Generators %

select int(p)<g,x,y,z,h,hh,ee,ff,e,f,k,l,kk,ll,d,a,b,c>_

gens:=list(a,b,c,d)_
deris:=list(h,e,f,hh,ee,ff)_

% 2. Constants %

q :=p*p_ 
qq :=1/q_
qp:=q+qq_
qm:=q-qq_

% 3. Relations %

% 3.1. The main ones %

rels:=ideal(
a*b-q*b*a,
a*c-q*c*a,
a*d-q*b*c-1,
b*c-c*b,
b*d-q*d*b,
c*d-q*d*c,
d*a-qq*b*c-1,
h*e-e*h-2*e,
h*f-f*h+2*f,
h*k-k*h,
h*l-l*h,
k*l-1,
l*k-1,
k*l-l*k,
k*e-q*e*k,
k*f-qq*f*k,
l*e-qq*e*l,
l*f-q*f*l,
e*f-f*e-(k*k-l*l)/qm,
hh*ee-ee*hh-2*ee,
hh*ff-ff*hh+2*ff,
hh*kk-kk*hh,
hh*ll-ll*hh,
kk*ll-1,
ll*kk-1,
kk*ll-ll*kk,
kk*ee-q*ee*kk,
kk*ff-qq*ff*kk,
ll*ee-qq*ee*ll,
ll*ff-q*ff*ll,
ee*ff-ff*ee-(kk*kk-ll*ll)/qm,
ll*k-k*ll,
ll*l-l*ll,
ll*e-e*ll,
ll*f-f*ll,
ll*h-h*ll,
kk*k-k*kk,
kk*l-l*kk,
kk*e-e*kk,
kk*f-f*kk,
kk*h-h*kk,
hh*k-k*hh,
hh*l-l*hh,
hh*e-e*hh,
hh*f-f*hh,
hh*h-h*hh,
ee*k-k*ee,
ee*l-l*ee,
ee*e-e*ee,
ee*f-f*ee,
ee*h-h*ee,
ff*k-k*ff,
ff*l-l*ff,
ff*e-e*ff,
ff*f-f*ff,
ff*h-h*ff,
k*a-1/p*a*k,
k*b-p*b*k,
k*c-1/p*c*k,
k*d-p*d*k,
l*a-p*a*l,
l*b-1/p*b*l,
l*c-p*c*l,
l*d-1/p*d*l,
h*a-a*h+a,
h*b-b*h-b,
h*c-c*h+c,
h*d-d*h-d,
e*a-p*a*e-b*k,
e*b-1/p*b*e,
e*c-p*c*e-d*k,
e*d-1/p*d*e,
f*a-p*a*f,
f*b-1/p*b*f-a*k,
f*c-p*c*f,
f*d-1/p*d*f-c*k,
ll*a-1/p*a*ll,
ll*c-p*c*ll,
ll*b-1/p*b*ll,
ll*d-p*d*ll,
kk*a-p*a*kk,
kk*c-1/p*c*kk,
kk*b-p*b*kk,
kk*d-1/p*d*kk,
hh*a-a*hh-a,
hh*b-b*hh-b,
hh*c-c*hh+c,
hh*d-d*hh+d,
ee*a-p*a*ee,
ee*b-p*b*ee,
ee*c-1/p*c*ee+1/q*a*ll,
ee*d-1/p*d*ee+1/q*b*ll,
ff*a-p*a*ff+q*c*ll,
ff*b-p*b*ff+q*d*ll,
ff*c-1/p*c*ff,
ff*d-1/p*d*ff,
g*a-a*g,
g*b-b*g,
g*c-c*g,
g*d-d*g,
g*g-1,
g*x+x*g,
g*y+y*g,
x*x,
y*a-a*y,
y*b-b*y,
y*c-c*y,
y*d-d*y,
y*x+x*y-1,
g*z-z*g,
y*z-z*y,
z*z
)_

rels:=standard(rels)_

% 3.2. Auxiliary sets of relations % 
 
auxa :=ideal(y*x-1,a*x-x,b*x-x,c*x-x,d*x-x)_

auxa :=standard(auxa)_

auxb:=ideal(x-1,z-1)_

auxb:=standard(auxb)_

auxc:=ideal(z*z)_

auxc:=standard(auxc)_

auxd:=ideal(a*z-z,b*z-z,c*z-z,d*z-z,x*z-1)_

auxd:=standard(auxd)_

auxg:=ideal(a-1,b-1,c-1,d-1,z-1,y*x-x*y-1)_

auxg:=standard(auxg)_

% 4. The automorphism a -> q^paral a,b -> q^param b %

'aut operator(var,parameterl,parameterm)(aux,hilf)()
hilf:=mksimple(parameterl);
aux:=var;
if negative(hilf) then 
		  hilf:=mksimple(-hilf);
		  aux:=k^hilf*ll^hilf*aux*l^hilf*kk^hilf; 
else
		  aux:=l^hilf*kk^hilf*aux*k^hilf*ll^hilf; 
endi;
hilf:=mksimple(parameterm);
if negative(hilf) then 
		  hilf:=mksimple(-hilf);
		  aux:=l^hilf*ll^hilf*aux*k^hilf*kk^hilf; 
else
		  aux:=k^hilf*kk^hilf*aux*l^hilf*ll^hilf; 
endi;
endo_ 

% 5. Routines that manipulate ELEMENTARY tensors %
 
% 5.1. The scalar in front of a tensor %

'skalar operator (var)()()
		  first(nth(2,var))
endo_

% 5.2. Beginning and last component; the output contains the %
% full scalar part of the tensor %

'anfang operator(var)()()
		  remainder(remainder(var,auxd)*z,auxc)
endo_

'ende operator(var)()()
		  remainder(remainder(var,auxa),auxb)
endo_

% 5.3. The degree % 

'gradu operator(var)(aux)()
		  aux:=var/skalar(var);
		  mksimple(aux:=remainder(remainder(y*aux-aux*y,auxg),auxb));
endo_
 
% 6. The Hochschild boundary operator %

% 6.1. The operator b' %

'bstrich operator(var)()()
		  remainder (y*var-g*var*g*y,rels)
endo_

% 6.2. Its last term bn on ELEMENTARY tensors %

'bn operator(var,parl,parm)(aux)()
		  aux:=aut(ende(var),parl,parm)/skalar(var);
		  remainder(-g*aux*anfang(var)*g,rels)
endo_

% 6.3. The nth elementary tensor in a tensor %

'termn operator(var,nummer)(aux)()
		  aux:=list(NCPOL,nth(nummer,rest(var)))
endo_

% 6.4. And here we go, this works for GENERAL tensors %
		  
'hochschild operator(var,parl,parm)(aux,term,zaehl)()
		  aux:=0;
		  for zaehl:=1 to mksimple(length(var)-1) do
					 term:=termn(var,zaehl);
					 aux:=aux+bstrich(term)+bn(term,parl,parm)
		  endf;
		  remainder(aux,rels)
endo_

'hochmodular operator(var)()()
		  hochschild(var,-2,0)
endo_

% 7. The basic generators of H_2 and H_3 %

chain1:=x*b*x*c*z-x*c*x*b*z_

hochmodular(chain1)$

chain2:=b*c*x*a*x*d*z-b*c*x*d*x*a*z-q*d*b*x*a*x*c*z+q*b*d*x*c*x*a*z+d*a*x*b*x*c*z-a*d*x*c*x*b*z-qq*c*a*x*b*x*d*z+qq*a*c*x*d*x*b*z_

hochmodular(chain2)$

chain3:=d*x*a*x*b*x*c*z-d*x*a*x*c*x*b*z+q*d*x*c*x*a*x*b*z-q*q*d*x*c*x*b*x*a*z+q*q*d*x*b*x*c*x*a*z-q*d*x*b*x*a*x*c*z+c*x*b*x*a*x*d*z-c*x*b*x*d*x*a*z+q*c*x*d*x*b*x*a*z-c*x*d*x*a*x*b*z+c*x*a*x*d*x*b*z-qq*c*x*a*x*b*x*d*z-qm*c*x*b*x*c*x*b*z_

hochmodular(chain3)$

% 8. Twisted derivations %

% 8.1. Left and right action of h,e*l,f*l %

'derih operator(var)()()
		  remainder(h*var-var*h,rels)
endo_

'derie operator(var)()()
		  remainder(e*l*var-q*l*l*var*k*e,rels)
endo_

'derif operator(var)()()
		  remainder(f*l*var-qq*l*l*var*k*f,rels)
endo_

'derihh operator(var)()()
		  remainder(var*hh-hh*var,rels)
endo_

'deriee operator(var)()()
		  remainder(kk*kk*var*ll*ee-q*ee*kk*var,rels)
endo_

'deriff operator(var)()()
		  remainder(kk*kk*var*ll*ff-qq*ff*kk*var,rels)
endo_

% 8.2. Combine all derivations and their twists %

'ablaitung operator(var,abal)()(ergebnis)
		  if abal=h then ergebnis:=derih(var); else
					 if abal=e then ergebnis:=derie(var); else 
								if abal=f then ergebnis:=derif(var); else
										  if abal=ee then ergebnis:=deriee(var); else 
													 if abal=ff then ergebnis:=deriff(var); else
																if abal=hh then ergebnis:=derihh(var); endi;
		  										  endi;
					 					endi;
								endi;
					 endi;
		  endi;
endo_

'dreh operator(var,abal)()(ergebnis)
		  if abal=h then ergebnis:=1*var*1; else
					 if abal=e then ergebnis:=l^2*var*k^2; else 
								if abal=f then ergebnis:=l^2*var*k^2; else
										  if abal=ee then ergebnis:=kk^2*var*ll^2; else 
													 if abal=ff then ergebnis:=kk^2*var*ll^2; else
																if abal=hh then ergebnis:=1*var*1; endi;
		  										  endi;
					 					endi;
								endi;
					 endi;
		  endi;
endo_

% 9. The cap product %

'capproduct operator(var,abal)(totala,hilf,grada,roest,fakto,zaehl,term,zaehlb)()
totala:=0;
for zaehl:=1 to mksimple(length(var)-1) do
		  term:=termn(var,zaehl);
		  grada:=mksimple(gradu(term));
		  fakto:=skalar(term)^grada;
		  hilf:=z;
		  roest:=term;
		  for zaehlb:=2 to grada do
		  		hilf:=x*ende(roest)*hilf;
		  		roest:=anfang(roest);
			endf;
			hilf:=ablaitung(ende(roest),abal)*hilf;
			roest:=anfang(roest);
			hilf:=dreh(ende(roest),abal)*hilf;
			totala:=totala+remainder(hilf/fakto,rels);
endf;
remainder(totala,rels)
endo_

% 10. The orbits of the basic generators %

% 10.1. The orbit of chain1 and chain2 %

'orbit2 operator(var)(aux,zaehla,zaehlb)()
newline();
newline();
print("Here is the cap product orbit of ");
print(var);
print(": ");
for zaehla:=1 to 6 do
		  aux:=capproduct(var,nth(zaehla,deris));
		  newline();
		  newline();
		  print(nth(zaehla,deris));
		  print(" = ");
		  print(aux);
		  for zaehlb:=1 to 6 do
					 newline();
		  			 print(nth(zaehla,deris));
		  			 print(" ");
		  			 print(nth(zaehlb,deris));
		  			 print(" = ");
						  if mksimple(aux)=0 then print("0"); 
						  else print(capproduct(aux,nth(zaehlb,deris))); endi;
			endf;
endf;
endo$

orbit2(chain1)$
orbit2(chain2)$

% 10.2. The orbit of chain3 %

'orbit3 operator(var)(aux,hilf,zaehla,zaehlb,zaehlc)()
newline();
newline();
print("Here is the cap product orbit of ");
print(var);
print(":");
for zaehla:=1 to 6 do
		  aux:=capproduct(var,nth(zaehla,deris));
		  newline();
		  print(nth(zaehla,deris));
		  print(" = ");
		  print(aux);
		  for zaehlb:=1 to 6 do
					 newline();
		  			 print(nth(zaehla,deris));
		  			 print(" ");
		  			 print(nth(zaehlb,deris));
		  			 print(" = ");
		  			 hilf:=capproduct(aux,nth(zaehlb,deris));
					 print(hilf);
	 			 for zaehlc:=1 to 6 do
					 	  newline();
		  			 	  print(nth(zaehla,deris));
		  			 	  print(" ");
		  			 	  print(nth(zaehlb,deris));
		  			 	  print(" ");
		  			 	  print(nth(zaehlc,deris));
		  			 	  print(" = ");
						  if mksimple(hilf)=0 then print("0"); 
						  else print(capproduct(hilf,nth(zaehlc,deris)));					
						  endi;
					endf;
			endf;
endf;
endo$

orbit3(chain3)$

% 11. Bonus material: The big B operator %

% 11.1. The cyclic permuter %

'cyclicp operator(var,parl,parm)(aux,term,zaehl)()
aux:=0;
for zaehl:=1 to mksimple(length(var)-1) do
		  term:=termn(var,zaehl);
		  if mksimple(gradu(term))=0 then 
		  aux:=aut(ende(term),parl,parm)*z; else 
		  aux:=aux+aut(ende(term),parl,parm)*x*anfang(term)/skalar(term);
		  endi;
endf;
remainder(g*aux*g,rels)
endo$

% 11.2. The big B operator %

'bigb operator(var,parl,parm)(aux,hilf,term,zaehl,zaehla,zaehlb,grada)(ergebnis)
if mksimple(remainder(x*var,rels))=0 then ergebnis:=0; else
aux:=0;
for zaehl:=1 to mksimple(length(var)-1) do
		  term:=termn(var,zaehl);
		  grada:=mksimple(gradu(term));
		  if grada=0 then 
					 hilf:=x*ende(term)*z; 
					 aux:=aux+hilf;
		  else 
					 for zaehla:=0 to grada do
		  						hilf:=term;
								for zaehlb:=1 to zaehla do
										  hilf:=cyclicp(hilf,parl,parm);
								endf;
					 			aux:=aux+x*hilf;
					 endf;
		  endi;
endf;
remainder(aux,rels);
endi;
endo$

% 12. Test B(H_2)=0 %

% 12.1. Apply B to the generators %

chain2a:=bigb(chain1,-2,0)$
chain2b:=bigb(chain2,-2,0)$

hochmodular(chain2b)$

% 12.2. The test %

capproduct(capproduct(capproduct(chain2b,e),f),h)$

chain4:=bigb(chain3,-2,0)$

bye$