%5:%
%line 108 "liesuper.web"

symbolic$
write"Lie (super)algebra package for REDUCE 3.4, $Revision: 1.5 $"$terpri()$
%6:%
%line 120 "liesuper.web"

%line 121 "liesuper.web"
if not getd 'operator_coeff then

msgpri("LIESUPER_INIT: load the TOOLS package before continuing",nil,nil,nil,nil)


%:6%
%line 111 "liesuper.web"
$
%33:%
%line 844 "liesuper.web"

%line 845 "liesuper.web"
put( 'liebracket, 'rtypefn, 'liebracket_rtypefn)$
put( 'liebracket, 'setelemfn, 'set_liebracket)$

%:33%%43:%
%line 1097 "liesuper.web"

%line 1098 "liesuper.web"
put( 'liebracket, 'clearfn, 'clear_liebracket)$


%:43%%80:%
%line 2099 "liesuper.web"

%line 2100 "liesuper.web"


global '(!*solve_parameters)$
!*solve_parameters:=nil$
flag( '(solve_parameters), 'switch)$

%:80%%82:%
%line 2133 "liesuper.web"

%line 2134 "liesuper.web"


global '(!*print_identities)$
!*print_identities:=nil$
flag( '(print_identities), 'switch)$

%:82%%87:%
%line 2233 "liesuper.web"

global '(indentation_level!*)$
initl!*:= 'indentation_level!* . initl!*$
put( 'indentation_level!*, 'initl,0)$

%:87%%97:%
%line 2388 "liesuper.web"

put( 'algebra_generator, 'setelemfn, 'set_generator)$
put( 'algebra_generator, 'clearfn, 'clear_generator)$
put( 'algebra_generator, 'rtypefn, 'generator_rtypefn)$

%:97%%120:%
%line 2879 "liesuper.web"

%line 2880 "liesuper.web"
put( 'definition_of, 'psopfn, 'definition_of1)$
put( 'history_of, 'psopfn, 'history_of1)$


%:120%%137:%
%line 3198 "liesuper.web"

%line 3199 "liesuper.web"
put( 'liebracket, 'stat, 'rlis)$

%:137%%154:%
%line 3559 "liesuper.web"

%line 3560 "liesuper.web"

global '(default_liebracket!*)$
default_liebracket!*:= 'lie$

%:154%%155:%
%line 3572 "liesuper.web"

%line 3573 "liesuper.web"
put( '![, 'stat, 'liebracket_stat)$
flag(list '!], 'delim)$

%:155%%158:%
%line 3620 "liesuper.web"

%line 3621 "liesuper.web"
put(default_liebracket!*, 'prifn, 'liebracket_prifn)$

%:158%%161:%
%line 3708 "liesuper.web"

%line 3709 "liesuper.web"


global '(!*full_transformation)$
!*full_transformation:=nil$
flag( '(full_transformation), 'switch)$

%:161%
%line 112 "liesuper.web"

algebraic$

%:5%%17:%
%line 490 "liesuper.web"

%line 491 "liesuper.web"
lisp procedure simp_liebracket val;
if length val=3 then%18:%
%line 503 "liesuper.web"

%line 504 "liesuper.web"
 begin scalar bracketname,arg1,arg2;
bracketname:=car val;
arg1:=mk!*sq simp!* cadr val;
arg2:=mk!*sq simp!* caddr val;
return
if fixp arg1 and fixp arg2 then simp_liebracket_vector(bracketname,arg1,arg2)
else%19:%
%line 535 "liesuper.web"

%line 536 "liesuper.web"
 simp_multilinear list(bracketname,
if fixp arg1 and arg1 neq 0 then list(generatorname,arg1)else arg1,
if fixp arg2 and arg2 neq 0 then list(generatorname,arg2)else arg2)
where generatorname=get(bracketname, 'generatorname)

%:19%
%line 510 "liesuper.web"
;
end

%:18%
%line 492 "liesuper.web"

else if length val>3 then%22:%
%line 592 "liesuper.web"

%line 593 "liesuper.web"
 begin scalar bracketname,arguments,result;
bracketname:=car val;
arguments:=reverse cdr val;
result:=simp_liebracket list(bracketname,second arguments,first arguments);
arguments:=cddr arguments;
for each arg in arguments do
result:=simp_liebracket list(bracketname,arg,mk!*sq result);
return result;
end

%:22%
%line 493 "liesuper.web"

else rederr("SIMP_LIEBRACKET: wrong number of arguments")$

%:17%%21:%
%line 570 "liesuper.web"
lisp procedure resimp_liebracket val;
begin scalar bracketname,generatorname,arg1,arg2,resimplify;
bracketname:=car val;
generatorname:=get(bracketname, 'generatorname);
arg1:=cadr val;arg2:=caddr val;

if fixp arg1 then rederr("SIMP_LIEBRACKET: argument contains a non algebra element")
else if car arg1=generatorname then arg1:=cadr arg1
else if car arg1= 'list then
 <<resimplify:=t;arg1:=bracketname . cdr arg1>> ;
if fixp arg2 then rederr("SIMP_LIEBRACKET: argument contains a non algebra element")
else if car arg2=generatorname then arg2:=cadr arg2
else if car arg2= 'list then
 <<resimplify:=t;arg2:=bracketname . cdr arg2>> ;
return
if resimplify then simp_liebracket list(bracketname,arg1,arg2)
else
if fixp arg1 and fixp arg2
then simp_liebracket_vector(bracketname,arg1,arg2)
else simp_liebracket_kvalue(bracketname,arg1,arg2);
end$

%:21%%27:%
%line 732 "liesuper.web"

lisp procedure even_element(bracketname,exprn);
if fixp exprn then exprn>0
else if car exprn=bracketname then
((b1 and b2)or(not b1 and not b2))where
b1=even_element(bracketname,cadr exprn),
b2=even_element(bracketname,caddr exprn)
else if car exprn= 'df then
even_element(bracketname,cadr exprn)
else if fixp cadr exprn then
cadr exprn>0
else
msgpri("EVEN_ELEMENT: impossible to determine sign of",
exprn,nil,nil,t)$

%:27%%30:%
%line 787 "liesuper.web"

%line 788 "liesuper.web"
lisp procedure simp_liebracket_vector(bracketname,arg1,arg2);
begin scalar sign,commutator;
%28:%
%line 751 "liesuper.web"

%line 752 "liesuper.web"
if
(if fixp arg1 and fixp arg2 then arg1>arg2 else
ordp(arg1,arg2)and arg1 neq arg2)then
begin scalar h;
sign:=(even_element(bracketname,arg1)or even_element(bracketname,arg2));
h:=arg1;arg1:=arg2;arg2:=h;
end

%:28%
%line 790 "liesuper.web"
;
%29:%
%line 763 "liesuper.web"

%line 764 "liesuper.web"
if arg1<-get(bracketname, 'odd_dimension)or arg2>get(bracketname, 'even_dimension)then

msgpri("SIMP_LIEBRACKET:",list(bracketname,arg1,arg2),"out of range",nil,t)

%:29%
%line 791 "liesuper.web"
;
%68:%
%line 1840 "liesuper.web"

%line 1841 "liesuper.web"
commutator:=
getv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2);
commutator:=
if commutator and cddr commutator then
if
(car commutator and caar commutator neq 's
)then
if cddr commutator=0 then nil . 1
else resimp cadr cddr commutator
else simp cddr commutator
else mksq(list(bracketname,arg1,arg2),1)


%:68%
%line 792 "liesuper.web"
;
return
if sign then negsq commutator
else commutator;
end$

%:30%%31:%
%line 805 "liesuper.web"

%line 806 "liesuper.web"
lisp procedure simp_liebracket_kvalue(bracketname,arg1,arg2);
begin scalar sign,commutator;
%28:%
%line 751 "liesuper.web"

%line 752 "liesuper.web"
if
(if fixp arg1 and fixp arg2 then arg1>arg2 else
ordp(arg1,arg2)and arg1 neq arg2)then
begin scalar h;
sign:=(even_element(bracketname,arg1)or even_element(bracketname,arg2));
h:=arg1;arg1:=arg2;arg2:=h;
end

%:28%
%line 808 "liesuper.web"
;
commutator:=assoc(list(bracketname,arg1,arg2),get(bracketname, 'kvalue));
commutator:=
if commutator then simp cadr commutator
else mksq(list(bracketname,arg1,arg2),1);
return
if sign then negsq commutator
else commutator;
end$

%:31%%34:%
%line 849 "liesuper.web"

%line 850 "liesuper.web"
lisp procedure liebracket_rtypefn u;nil$

%:34%%38:%
%line 950 "liesuper.web"

%line 951 "liesuper.web"
lisp procedure set_liebracket(val,value);
if length val neq 3 then
rederr("SET_LIEBRACKET: assignment only possible to commutators")
else begin scalar bracketname,generatorname,algebra_elements,arg1,arg2,
error,sign;
bracketname:=car val;
generatorname:=get(bracketname, 'generatorname);
algebra_elements:=bracketname . generatorname . get(bracketname, 'algebra_elements);
arg1:=reval cadr val;
arg2:=reval caddr val;
%36:%
%line 910 "liesuper.web"


if atom arg1 then error:=
((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension)
or arg1>get(bracketname, 'even_dimension))
else begin
error:=not member(car arg1,algebra_elements);
if not error and car arg1=generatorname then
begin
arg1:=cadr arg1;
error:=not atom arg1 or
((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension)
or arg1>get(bracketname, 'even_dimension));
end;
end;
if not error then
if atom arg2 then error:=
((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension)
or arg2>get(bracketname, 'even_dimension))
else begin
error:=not member(car arg2,algebra_elements);
if not error and car arg2=generatorname then
begin
arg2:=cadr arg2;
error:=not atom arg2 or
((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension)
or arg2>get(bracketname, 'even_dimension));
end;
end;
if error then
rederr("SET_/CLEAR_LIEBRACKET: argument(s) invalid or out of range")

%:36%
%line 961 "liesuper.web"
;
%28:%
%line 751 "liesuper.web"

%line 752 "liesuper.web"
if
(if fixp arg1 and fixp arg2 then arg1>arg2 else
ordp(arg1,arg2)and arg1 neq arg2)then
begin scalar h;
sign:=(even_element(bracketname,arg1)or even_element(bracketname,arg2));
h:=arg1;arg1:=arg2;arg2:=h;
end

%:28%
%line 962 "liesuper.web"
;
%37:%
%line 934 "liesuper.web"

error:=if fixp arg1 and fixp arg2 then
(if entry then car entry)
where entry=
getv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2);
if error then
if car error= 's
then
rederr("SET_/CLEAR_LIEBRACKET: commutator can not be changed")
else
msgpri("SET_/CLEAR_LIEBRACKET: changing",
list(bracketname,arg1,arg2),"may lead to errors",nil,nil)

%:37%
%line 963 "liesuper.web"
;
value:=aeval value;
%35:%
%line 866 "liesuper.web"

%line 867 "liesuper.web"
if independent_part(value,algebra_elements)neq 0 then
rederr("SET_LIEBRACKET: assigned value invalid as algebra element")

%:35%
%line 965 "liesuper.web"
;
if sign then value:=mk!*sq negsq simp value;
%41:%
%line 1033 "liesuper.web"

if fixp arg1 and fixp arg2 then
begin
if
 'used!* memq cddr fkern list(bracketname,arg1,arg2)then rmsubs();

(if old_value then

putv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2,nil . (cadr old_value) . value)
else
putv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2,nil . nil . value))
where old_value=
getv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2);
end else
setk1(list(bracketname,arg1,arg2),value,t)

%:41%
%line 967 "liesuper.web"
;
end$

%:38%%42:%
%line 1075 "liesuper.web"

%line 1076 "liesuper.web"
lisp procedure clear1 u;
begin scalar x,xx;
while u do
 <<if flagp(x:=car u, 'share)
then if not flagp(x, 'reserved)then set(x,x)else rsverr x
else if eqcar(x, 'list)
then u:=nil . append(cdr x,cdr u)
else if eqcar(x, 'replaceby)then rule!-list(list x,nil)
else if smemq( '!~,x)
then if eqcar(x, 'equal)then rule!-list(list x,nil)
else rule!-list(list list( 'replaceby,x,nil),nil)
else if(xx:=get(if atom x then x else car x, 'rtype))
and(xx:=get(xx, 'clearfn))
then apply1(xx,x)
else <<let2(x,nil,nil,nil);let2(x,nil,t,nil)>> ;
u:=cdr u>> 
end$

%:42%%44:%
%line 1105 "liesuper.web"

%line 1106 "liesuper.web"
lisp procedure clear_liebracket val;
if atom val then%142:%
%line 3306 "liesuper.web"

%line 3307 "liesuper.web"
 begin scalar bracketname,generatorname;
bracketname:=val;
generatorname:=get(bracketname, 'generatorname);
for each property in
 '(vector_structure info_list !*jacobi_var!* even_dimension odd_dimension
even_used odd_used degree_length degree_sequence algebra_elements
parameters oplist resimp_fn
generatorname rtype simpfn commutator_list identity_list
unsolved_identities kvalue)do
remprop(bracketname,property);
for each property in
 '(bracketname rtype simpfn kvalue)do
remprop(generatorname,property);
remflag(list bracketname, 'full);
end

%:142%
%line 1107 "liesuper.web"

else if length val=3 then%45:%
%line 1117 "liesuper.web"

%line 1118 "liesuper.web"
 begin scalar bracketname,generatorname,algebra_elements,arg1,arg2,error,h;
bracketname:=car val;
generatorname:=get(bracketname, 'generatorname);
algebra_elements:=bracketname . generatorname . get(bracketname, 'algebra_elements);
arg1:=reval cadr val;
arg2:=reval caddr val;
%36:%
%line 910 "liesuper.web"


if atom arg1 then error:=
((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension)
or arg1>get(bracketname, 'even_dimension))
else begin
error:=not member(car arg1,algebra_elements);
if not error and car arg1=generatorname then
begin
arg1:=cadr arg1;
error:=not atom arg1 or
((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension)
or arg1>get(bracketname, 'even_dimension));
end;
end;
if not error then
if atom arg2 then error:=
((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension)
or arg2>get(bracketname, 'even_dimension))
else begin
error:=not member(car arg2,algebra_elements);
if not error and car arg2=generatorname then
begin
arg2:=cadr arg2;
error:=not atom arg2 or
((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension)
or arg2>get(bracketname, 'even_dimension));
end;
end;
if error then
rederr("SET_/CLEAR_LIEBRACKET: argument(s) invalid or out of range")

%:36%
%line 1124 "liesuper.web"
;
if
(if fixp arg1 and fixp arg2 then arg1>arg2 else
ordp(arg1,arg2)and arg1 neq arg2)then
begin
h:=arg1;arg1:=arg2;arg2:=h;
end;
%37:%
%line 934 "liesuper.web"

error:=if fixp arg1 and fixp arg2 then
(if entry then car entry)
where entry=
getv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2);
if error then
if car error= 's
then
rederr("SET_/CLEAR_LIEBRACKET: commutator can not be changed")
else
msgpri("SET_/CLEAR_LIEBRACKET: changing",
list(bracketname,arg1,arg2),"may lead to errors",nil,nil)

%:37%
%line 1129 "liesuper.web"
;
%46:%
%line 1140 "liesuper.web"

%line 1141 "liesuper.web"
val:=list(bracketname,arg1,arg2);
if fixp arg1 and fixp arg2 then
if
(if entry then cddr entry)
where entry=
getv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2)then

(if old_value then

putv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2,nil . (cadr old_value) . nil)
else
putv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2,nil . nil . nil))
where old_value=
getv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+arg1),
get(bracketname, 'even_dimension)-arg2)
else
msgpri("CLEAR_LIEBRACKET:",val,"not found",nil,nil)
else begin scalar kvalue;
kvalue:=get(bracketname, 'kvalue);
if(h:=assoc(val,kvalue))then
put(bracketname, 'kvalue,delete(h,kvalue))
else
msgpri("CLEAR_LIEBRACKET:",val,"not found",nil,nil);
end

%:46%
%line 1130 "liesuper.web"
;
end

%:45%
%line 1108 "liesuper.web"

else rederr("CLEAR_LIEBRACKET: wrong number of arguments to commutator")$


%:44%%48:%
%line 1303 "liesuper.web"

lisp operator recompute_jacobi_identities_of;

lisp procedure recompute_jacobi_identities_of bracketname;
begin scalar !*jacobi_var!*;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("RECOMPUTE_JACOBI_IDENTITIES:",bracketname,"is not a liebracket",nil,t);
!*jacobi_var!*:=get(bracketname, '!*jacobi_var!*);
rplaca(!*jacobi_var!*,nil);
put(bracketname, '!*jacobi_var!*,list t);
end$

%:48%%51:%
%line 1395 "liesuper.web"

%line 1396 "liesuper.web"
lisp procedure find_unprocessed_commutators_of bracketname;
begin scalar vector_i,entry_i_j,k_info_i_j,commutator,form,kord!*,


vector_structure,m,m_used,n,n_used
,generatorname,non_generators,
commutator_list,!*jacobi_var!*
,comm_list_i,
dependent_generators;
%50:%
%line 1370 "liesuper.web"

%49:%
%line 1355 "liesuper.web"

vector_structure:=get(bracketname, 'vector_structure);
m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension);
m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used)

%:49%
%line 1371 "liesuper.web"
;
generatorname:=get(bracketname, 'generatorname);
non_generators:=bracketname . get(bracketname, 'algebra_elements);
commutator_list:=get(bracketname, 'commutator_list);
!*jacobi_var!*:=get(bracketname, '!*jacobi_var!*)

%:50%
%line 1400 "liesuper.web"
;
%52:%
%line 1417 "liesuper.web"

%line 1418 "liesuper.web"
dependent_generators:=
for each entry in get(generatorname, 'kvalue)collect
cadr car entry

%:52%
%line 1401 "liesuper.web"
;
for i:=-n_used:m_used do
if not memq(i,dependent_generators)then
begin
vector_i:=getv(vector_structure,n+i);
for j:=i:m_used do
if not memq(j,dependent_generators)then
%56:%
%line 1492 "liesuper.web"

begin
entry_i_j:=getv(vector_i,m-j);
if entry_i_j and cddr entry_i_j then
if null car entry_i_j then
begin
commutator:=simp!* cddr entry_i_j;
k_info_i_j:=cadr entry_i_j;
form:=numr commutator;
if
null get_all_kernels(form,non_generators)then begin

setkorder get_all_kernels(form,generatorname);
commutator:=!*ff2a(reorder form,denr commutator);

if(comm_list_i:=assoc(i,commutator_list))then
(if not member(j,comm_list_i)then
rplacd(comm_list_i,j . cdr comm_list_i))
else
 <<commutator_list:=list(i,j) . commutator_list;
put(bracketname, 'commutator_list,commutator_list)>> ;

putv(vector_i,m-j,!*jacobi_var!* . k_info_i_j . commutator);
end;
end
else if null caar
entry_i_j then begin
commutator:=cddr entry_i_j;
k_info_i_j:=cadr entry_i_j;

if(comm_list_i:=assoc(i,commutator_list))then
(if not member(j,comm_list_i)then
rplacd(comm_list_i,j . cdr comm_list_i))
else
 <<commutator_list:=list(i,j) . commutator_list;
put(bracketname, 'commutator_list,commutator_list)>> ;

putv(vector_i,m-j,!*jacobi_var!* . k_info_i_j . commutator);
end;
end

%:56%
%line 1408 "liesuper.web"
;
end;
return commutator_list;
end$

%:51%%60:%
%line 1611 "liesuper.web"

lisp procedure find_Jacobi_identities_of bracketname;
begin scalar comm_list_i,i,j,vector_i,vector_j,vector_k,
entry_i_k,entry_j_k,


vector_structure,m,m_used,n,n_used
,commutator_list,identity_list
,
id_list_i,id_list_i_j;
%58:%
%line 1575 "liesuper.web"

%49:%
%line 1355 "liesuper.web"

vector_structure:=get(bracketname, 'vector_structure);
m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension);
m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used)

%:49%
%line 1576 "liesuper.web"
;
commutator_list:=get(bracketname, 'commutator_list);
identity_list:=get(bracketname, 'identity_list)

%:58%
%line 1617 "liesuper.web"
;
while commutator_list do begin
comm_list_i:=car commutator_list;
i:=car comm_list_i;
while cdr comm_list_i do begin
j:=cadr comm_list_i;
%61:%
%line 1641 "liesuper.web"

%line 1642 "liesuper.web"
vector_i:=getv(vector_structure,n+i);
vector_j:=getv(vector_structure,n+j);
for k:=-n_used:i-1 do begin
vector_k:=getv(vector_structure,n+k);
if(entry_i_k:=getv(vector_k,m-i))and(entry_j_k:=getv(vector_k,m-j))then

if
(car entry_i_k and caar entry_i_k neq 's
)and

(car entry_j_k and caar entry_j_k neq 's
)
then
if(id_list_i:=assoc(k,identity_list))then
if(id_list_i_j:=assoc(i,cdr id_list_i))then
(if not member(j,cdr id_list_i_j)then
rplacd(id_list_i_j,j . cdr id_list_i_j))
else rplacd(id_list_i,list(i,j) . cdr id_list_i)
else identity_list:=list(k,list(i,j)) . identity_list
;
end;
for k:=i:j-1 do begin
vector_k:=getv(vector_structure,n+k);
if(entry_i_k:=getv(vector_i,m-k))and(entry_j_k:=getv(vector_k,m-j))then

if
(car entry_i_k and caar entry_i_k neq 's
)and

(car entry_j_k and caar entry_j_k neq 's
)
then
if(id_list_i:=assoc(i,identity_list))then
if(id_list_i_j:=assoc(k,cdr id_list_i))then
(if not member(j,cdr id_list_i_j)then
rplacd(id_list_i_j,j . cdr id_list_i_j))
else rplacd(id_list_i,list(k,j) . cdr id_list_i)
else identity_list:=list(i,list(k,j)) . identity_list
;
end;
for k:=j:m_used do begin
if(entry_i_k:=getv(vector_i,m-k))and(entry_j_k:=getv(vector_j,m-k))then

if
(car entry_i_k and caar entry_i_k neq 's
)and

(car entry_j_k and caar entry_j_k neq 's
)
then
if(id_list_i:=assoc(i,identity_list))then
if(id_list_i_j:=assoc(j,cdr id_list_i))then
(if not member(k,cdr id_list_i_j)then
rplacd(id_list_i_j,k . cdr id_list_i_j))
else rplacd(id_list_i,list(j,k) . cdr id_list_i)
else identity_list:=list(i,list(j,k)) . identity_list
;
end;
put(bracketname, 'identity_list,identity_list)

%:61%
%line 1623 "liesuper.web"
;
rplacd(comm_list_i,cddr comm_list_i);
end;
commutator_list:=cdr commutator_list;
put(bracketname, 'commutator_list,commutator_list);
end;
return identity_list;
end$

%:60%%63:%
%line 1725 "liesuper.web"

lisp procedure sub_identity(bracketname,i,j,k);
begin scalar comm_j_k,denr_j_k,coeff_l,l,comm_i_l,term;
comm_j_k:=
(if entry then cddr entry)
where entry=
getv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+j),
get(bracketname, 'even_dimension)-k);
return if comm_j_k=0 then nil . 1 else
begin
comm_j_k:=cadr comm_j_k;
denr_j_k:=subf1(denr comm_j_k,nil);
comm_j_k:=numr comm_j_k;
%64:%
%line 1747 "liesuper.web"

term:=nil . 1;
while comm_j_k do begin
l:=cadr mvar comm_j_k;
coeff_l:=subf1(lc comm_j_k,nil);
if not fixp l then

msgpri("SOLVE_JACOBI_IDENTITIES:",list(bracketname,j,k),
"contains invalid generator",mvar comm_j_k,t);
comm_i_l:=simp_liebracket_vector(bracketname,i,l);
term:=addsq(term,multsq(coeff_l,comm_i_l));
comm_j_k:=red comm_j_k;
end

%:64%
%line 1734 "liesuper.web"
;
if i<0 and k<0 then term:=negsq term;

return quotsq(term,denr_j_k);
end;
end$

%:63%%65:%
%line 1768 "liesuper.web"

%line 1769 "liesuper.web"
lisp procedure special_Jacobi_identity(bracketname,i,j,k);
mk!*sq subs2 negsq
addsq(sub_identity(bracketname,i,j,k),
addsq(multsq((if j>0 then-1 else 1) . 1,
sub_identity(bracketname,j,i,k)),
sub_identity(bracketname,k,i,j)))$

%:65%%66:%
%line 1785 "liesuper.web"

%line 1786 "liesuper.web"
lisp operator update_vector_structure_of;
lisp procedure update_vector_structure_of bracketname;
begin scalar vector_i,entry_i_j,
commutator,form,kord!*,generatorname,
vector_structure,m,m_used,n,n_used
;
%49:%
%line 1355 "liesuper.web"

vector_structure:=get(bracketname, 'vector_structure);
m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension);
m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used)

%:49%
%line 1790 "liesuper.web"
;
generatorname:=get(bracketname, 'generatorname);
for i:=-n_used:m_used do begin
vector_i:=getv(vector_structure,n+i);
for j:=i:m_used do begin
entry_i_j:=getv(vector_i,m-j);
%67:%
%line 1805 "liesuper.web"

%line 1806 "liesuper.web"
if entry_i_j and cddr entry_i_j then
if null car entry_i_j then
putv(vector_i,m-j,nil . cadr(entry_i_j) . 
aeval cddr entry_i_j)
else if
(car entry_i_j and caar entry_i_j neq 's
)then begin
commutator:=simp!* cddr entry_i_j;
form:=numr commutator;

setkorder get_all_kernels(form,generatorname);
commutator:=!*ff2a(reorder form,denr commutator);
putv(vector_i,m-j,car(entry_i_j) . 
cadr(entry_i_j) . commutator);
end

%:67%
%line 1796 "liesuper.web"
;
end;
end;
end$

%:66%%70:%
%line 1912 "liesuper.web"
lisp operator relation_analysis;
lisp procedure relation_analysis(relation,bracketname);
begin scalar generatorname,parameters,kernel_list,solvable_kernels,
test,kernel,optimal_kernel,coefficient,clear_list;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("RELATION_ANALYSIS:",bracketname,"is not a liebracket",nil,t);
generatorname:=get(bracketname, 'generatorname);
parameters:=get(bracketname, 'parameters);
kernel_list:=operator_coeff(relation,generatorname);
return
if kernel_list= '(list 0)then 0
else if cadr kernel_list neq 0 then
%71:%
%line 1933 "liesuper.web"

begin
solvable_kernels:=cdr solvable_kernels(cadr
kernel_list,bracketname,parameters);
return
if null solvable_kernels then 'unsolvable
else begin
%76:%
%line 2011 "liesuper.web"

%line 2012 "liesuper.web"
optimal_kernel:=0 . nil;
while solvable_kernels and car optimal_kernel do begin
kernel:=car solvable_kernels;
if not fixp cadr kernel or
not fixp caddr kernel then optimal_kernel:=nil . nil
else
if not((test:=highest_degree(extended_commutator_degree(kernel,bracketname),
car optimal_kernel))eq car optimal_kernel)then
optimal_kernel:=test . kernel;
solvable_kernels:=cdr solvable_kernels;
end;
optimal_kernel:=cdr optimal_kernel

%:76%
%line 1940 "liesuper.web"
;
return
if optimal_kernel then
 <<linear_solve_and_assign(relation,optimal_kernel);optimal_kernel>> 
else 'nested_commutator;
end;
end

%:71%
%line 1923 "liesuper.web"

else%77:%
%line 2032 "liesuper.web"

%line 2033 "liesuper.web"
 begin
solvable_kernels:=cdr
solvable_kernels(relation,generatorname,parameters);
return
if null solvable_kernels then
%81:%
%line 2106 "liesuper.web"

%line 2107 "liesuper.web"
if !*solve_parameters then
begin
kernel_list:=cddr kernel_list;
%79:%
%line 2077 "liesuper.web"

%line 2078 "liesuper.web"
repeat begin
coefficient:=caddr car kernel_list;
solvable_kernels:=cdr
solvable_kernels(coefficient,parameters,parameters);
if null solvable_kernels then
begin
apply1( 'clear,clear_list);
clear_list:=nil
end
else begin
kernel:=car solvable_kernels;
linear_solve_and_assign(coefficient,kernel);
clear_list:=kernel . clear_list;
kernel_list:=cdr kernel_list;
end end
until null kernel_list or null clear_list

%:79%
%line 2110 "liesuper.web"
;
return if clear_list then 'list . clear_list else 'unsolvable;
end
else 'unsolvable

%:81%
%line 2038 "liesuper.web"

else
begin
%78:%
%line 2050 "liesuper.web"

%line 2051 "liesuper.web"
optimal_kernel:=0 . nil;
while solvable_kernels and car optimal_kernel do begin
kernel:=car solvable_kernels;
if not fixp cadr kernel then
optimal_kernel:=nil . nil
else
if not((test:=highest_degree(extended_generator_degree(kernel,bracketname),
car optimal_kernel))eq car optimal_kernel)then
optimal_kernel:=test . kernel;
solvable_kernels:=cdr solvable_kernels;
end;
optimal_kernel:=cdr optimal_kernel

%:78%
%line 2041 "liesuper.web"
;
return
if optimal_kernel then
 <<linear_solve_and_assign(relation,optimal_kernel);optimal_kernel>> 
else 'invalid_generator;
end;
end

%:77%
%line 1924 "liesuper.web"
;
end$

%:70%%72:%
%line 1964 "liesuper.web"

%line 1965 "liesuper.web"
lisp procedure first_degree_higher(degree_1,degree_2);
if null degree_1 then nil
else if car degree_1>car degree_2 then t
else first_degree_higher(cdr degree_1,cdr degree_2)$

%:72%%73:%
%line 1975 "liesuper.web"

%line 1976 "liesuper.web"
lisp procedure extended_commutator_degree(commutator,bracketname);
nconc(add_degrees(
permuted_degree(car
getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i),
get(bracketname, 'degree_sequence)),

permuted_degree(car
getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+j),
get(bracketname, 'degree_sequence))),
list(i,j))
where i=cadr commutator,j=caddr commutator$


%:73%%74:%
%line 1988 "liesuper.web"

%line 1989 "liesuper.web"
lisp procedure extended_generator_degree(generator,bracketname);
append(
permuted_degree(car
getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i),
get(bracketname, 'degree_sequence)),list abs(i))
where i=cadr generator$

%:74%%75:%
%line 1998 "liesuper.web"

%line 1999 "liesuper.web"
lisp procedure highest_degree(degree_1,degree_2);
if atom degree_2 then degree_1
else if first_degree_higher(degree_1,degree_2)then degree_1
else degree_2$

%:75%%83:%
%line 2149 "liesuper.web"

%line 2150 "liesuper.web"
lisp operator solve_Jacobi_identities_of;
lisp procedure solve_Jacobi_identities_of bracketname;
begin scalar generatorname,stage,identity_list,i,j,identity,
solution,nr_computed,nr_solved,environment,origin;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("SOLVE_JACOBI_IDENTITIES_OF:",bracketname,"is not a liebracket",nil,t);
generatorname:=get(bracketname, 'generatorname);
environment:=!*nat;!*nat:=t;stage:=0;
%84:%
%line 2168 "liesuper.web"

%line 2169 "liesuper.web"
%88:%
%line 2241 "liesuper.web"

%line 2242 "liesuper.web"
prin2!*"Starting stage ";prin2!*(stage:=stage+1);prin2!*":";terpri!* nil;
prin2!*"Reordering the commutators...";terpri!* nil

%:88%
%line 2169 "liesuper.web"
;
find_unprocessed_commutators_of bracketname;
%89:%
%line 2245 "liesuper.web"

%line 2246 "liesuper.web"
prin2!*"Searching for identities...";terpri!* nil

%:89%
%line 2171 "liesuper.web"
;
identity_list:=find_Jacobi_identities_of bracketname

%:84%
%line 2157 "liesuper.web"
;
while identity_list do
%85:%
%line 2174 "liesuper.web"

%line 2175 "liesuper.web"
begin
nr_computed:=0;nr_solved:=0;
%90:%
%line 2248 "liesuper.web"

%line 2249 "liesuper.web"
prin2!*"Solving the identities...";terpri!* nil;
if !*print_identities then
 <<prin2!*"==========================";
terpri!* nil>> 

%:90%
%line 2177 "liesuper.web"
;
%86:%
%line 2189 "liesuper.web"

%line 2190 "liesuper.web"
for each id_list_i in identity_list do begin
i:=car id_list_i;id_list_i:=cdr id_list_i;
for each id_list_i_j in id_list_i do begin
j:=car id_list_i_j;id_list_i_j:=cdr id_list_i_j;
for each k in id_list_i_j do begin
(nr_computed:=nr_computed+1);
identity:=special_Jacobi_identity(bracketname,i,j,k);
origin:=list( 'list,i,j,k);
%91:%
%line 2254 "liesuper.web"

%line 2255 "liesuper.web"
if !*print_identities and identity neq 0 then
begin
for i:=1:indentation_level!* do prin2!*"| ";maprin origin;terpri!* nil;

for i:=1:indentation_level!* do prin2!*"| ";maprin identity;terpri!* nil;
end

%:91%
%line 2198 "liesuper.web"
;
solution:=relation_analysis(identity,bracketname);
%94:%
%line 2293 "liesuper.web"

if solution neq 0 then
if member(solution, '(unsolvable nested_commutator invalid_generator))then

put(bracketname, 'unsolved_identities,
list( 'list,origin,identity) . get(bracketname, 'unsolved_identities))
else if car solution=generatorname or car solution= 'list then
begin(nr_solved:=nr_solved+1);
if not !*print_identities then
 <<
 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"*** Identity ">> ;maprin origin;
prin2!*" solved for: ";maprin solution;terpri!* nil>> 
end
else(nr_solved:=nr_solved+1)

%:94%
%line 2200 "liesuper.web"
;
%92:%
%line 2260 "liesuper.web"

%line 2261 "liesuper.web"
if !*print_identities and solution neq 0 then
begin
if member(solution, '(unsolvable nested_commutator invalid_generator))
then
 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Not solved.">> 
else <<if car solution=generatorname or car solution= 'list then

 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"*** Solved for: ">> 
else
 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Solved for: ">> ;
maprin solution>> ;

if indentation_level!*=0 then terpri!* t else
 <<terpri!* nil;
for i:=1:indentation_level!* do prin2!*"| ";terpri!* nil>> ;
end

%:92%
%line 2201 "liesuper.web"
;
end;
end;
end

%:86%
%line 2178 "liesuper.web"
;
put(bracketname, 'identity_list,nil);
%93:%
%line 2272 "liesuper.web"

%line 2273 "liesuper.web"

 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!* nr_solved>> ;prin2!*" identities solved of ";
prin2!* nr_computed;
if indentation_level!*=0 then terpri!* t else
 <<terpri!* nil;
for i:=1:indentation_level!* do prin2!*"| ";terpri!* nil>> 

%:93%
%line 2180 "liesuper.web"
;
%84:%
%line 2168 "liesuper.web"

%line 2169 "liesuper.web"
%88:%
%line 2241 "liesuper.web"

%line 2242 "liesuper.web"
prin2!*"Starting stage ";prin2!*(stage:=stage+1);prin2!*":";terpri!* nil;
prin2!*"Reordering the commutators...";terpri!* nil

%:88%
%line 2169 "liesuper.web"
;
find_unprocessed_commutators_of bracketname;
%89:%
%line 2245 "liesuper.web"

%line 2246 "liesuper.web"
prin2!*"Searching for identities...";terpri!* nil

%:89%
%line 2171 "liesuper.web"
;
identity_list:=find_Jacobi_identities_of bracketname

%:84%
%line 2181 "liesuper.web"
;
end

%:85%
%line 2159 "liesuper.web"
;
print_statistics_of bracketname;
!*nat:=environment;
end$

%:83%%95:%
%line 2316 "liesuper.web"

%line 2317 "liesuper.web"
lisp operator unsolved_identities_of;
lisp procedure unsolved_identities_of bracketname;
begin scalar unsolved_identities,id;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("UNSOLVED_IDENTITIES_OF:",bracketname,"is not a liebracket",nil,t);
unsolved_identities:=get(bracketname, 'unsolved_identities);
unsolved_identities:=
for each identity in unsolved_identities join
if(id:=aeval caddr identity)neq 0 then
list list( 'list,cadr identity,id);
put(bracketname, 'unsolved_identities,unsolved_identities);
return 'list . unsolved_identities;
end$

%:95%%96:%
%line 2341 "liesuper.web"

lisp operator print_statistics_of;
lisp procedure print_statistics_of bracketname;
begin scalar
vector_structure,m,m_used,n,n_used
,vector_i,entry_i_j,nr_solved,total;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("PRINTS_STATISTICS_OF:",bracketname,"is not a liebracket",nil,t);
%49:%
%line 1355 "liesuper.web"

vector_structure:=get(bracketname, 'vector_structure);
m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension);
m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used)

%:49%
%line 2346 "liesuper.web"
;
nr_solved:=0;
for i:=-n_used:m_used do begin
vector_i:=getv(vector_structure,n+i);
for j:=i:m_used do
if(entry_i_j:=getv(vector_i,m-j))and
cddr(entry_i_j)and car entry_i_j neq '(s
)
then(nr_solved:=nr_solved+1);
end;
total:=((m_used+n_used)^2-m_used+n_used)/2;
if total=0 then rederr("PRINT_STATISTICS_OF: first define used area");
terpri!* t;
prin2!*"Statistics for liebracket ";maprin bracketname;terpri!* nil;
prin2!* m_used;prin2!*" even and ";prin2!* n_used;
prin2!*" odd generators used";terpri!* nil;
prin2!* nr_solved;prin2!*" commutators solved of ";prin2!* total;
prin2!*" (";prin2!*((nr_solved*100)/total);prin2!*" %)";terpri!* nil;
prin2!* length get(get(bracketname, 'generatorname), 'kvalue);
prin2!*" linear dependencies found";terpri!* nil;
total:=for each parameter in get(bracketname, 'parameters)sum
length get(parameter, 'kvalue);
prin2!* total;prin2!*" parameters solved";terpri!* nil;
prin2!* length get(bracketname, 'unsolved_identities);
prin2!*" unsolved identities";terpri!* t;
end$


%:96%%98:%
%line 2398 "liesuper.web"

%line 2399 "liesuper.web"
lisp procedure generator_rtypefn u;
nil$

%:98%%99:%
%line 2415 "liesuper.web"
lisp procedure set_generator(val,value);if length val neq 2 then
%line 2416 "liesuper.web"
 rederr("SET_GENERATOR: generator must have one integer argument")
else begin scalar generatorname,bracketname,i,valuelist,
identity,solution,
nr_computed,nr_solved,environment,origin;
generatorname:=car val;
bracketname:=get(generatorname, 'bracketname);
i:=reval cadr val;
value:=aeval value;
%100:%
%line 2438 "liesuper.web"

%line 2439 "liesuper.web"
if not atom i or
((not fixp i)or i<-get(bracketname, 'odd_dimension)
or i>get(bracketname, 'even_dimension))then

msgpri("SET_GENERATOR:",val,"invalid or out of range",nil,t);
valuelist:=operator_coeff(value,generatorname);
if cadr valuelist neq 0 then

msgpri("SET_GENERATOR:",cadr valuelist,
"not a sum of generators",nil,t);
for each term in cddr valuelist do
if length(term:=cadr term)neq 2 or
not atom cadr term or

((not fixp cadr term)or cadr term<-get(bracketname, 'odd_dimension)
or cadr term>get(bracketname, 'even_dimension))then

msgpri("SET_GENERATOR:",term,"invalid or out of range",nil,t)

%:100%
%line 2424 "liesuper.web"
;
if
 'used!* memq cddr fkern val then rmsubs();
setk1(val,value,t);
%101:%
%line 2475 "liesuper.web"

%line 2476 "liesuper.web"
environment:=!*nat;!*nat:=t;
%102:%
%line 2495 "liesuper.web"

%line 2496 "liesuper.web"

 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Adjusting the commutators of ">> ;maprin val;prin2!*"...";
terpri!* nil;
if !*print_identities then
 <<
 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"| ========================">> ;
terpri!* nil;>> 

%:102%
%line 2477 "liesuper.web"
;
(indentation_level!*:=indentation_level!*+1);
nr_computed:=0;nr_solved:=0;
for j:=-get(bracketname, 'odd_dimension):get(bracketname, 'even_dimension)do
if j neq 0 and(i neq j or i<0)then
begin
(nr_computed:=nr_computed+1);
identity:=%103:%
%line 2510 "liesuper.web"

%line 2511 "liesuper.web"
mk!*sq subs2 subtrsq(simp_liebracket(list(bracketname,i,j)),
simp_liebracket(list(bracketname,value,j)))

%:103%
%line 2484 "liesuper.web"
;
origin:=list( 'list,i,j);
%91:%
%line 2254 "liesuper.web"

%line 2255 "liesuper.web"
if !*print_identities and identity neq 0 then
begin
for i:=1:indentation_level!* do prin2!*"| ";maprin origin;terpri!* nil;

for i:=1:indentation_level!* do prin2!*"| ";maprin identity;terpri!* nil;
end

%:91%
%line 2486 "liesuper.web"
;
solution:=relation_analysis(identity,bracketname);
%94:%
%line 2293 "liesuper.web"

if solution neq 0 then
if member(solution, '(unsolvable nested_commutator invalid_generator))then

put(bracketname, 'unsolved_identities,
list( 'list,origin,identity) . get(bracketname, 'unsolved_identities))
else if car solution=generatorname or car solution= 'list then
begin(nr_solved:=nr_solved+1);
if not !*print_identities then
 <<
 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"*** Identity ">> ;maprin origin;
prin2!*" solved for: ";maprin solution;terpri!* nil>> 
end
else(nr_solved:=nr_solved+1)

%:94%
%line 2488 "liesuper.web"
;
%92:%
%line 2260 "liesuper.web"

%line 2261 "liesuper.web"
if !*print_identities and solution neq 0 then
begin
if member(solution, '(unsolvable nested_commutator invalid_generator))
then
 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Not solved.">> 
else <<if car solution=generatorname or car solution= 'list then

 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"*** Solved for: ">> 
else
 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Solved for: ">> ;
maprin solution>> ;

if indentation_level!*=0 then terpri!* t else
 <<terpri!* nil;
for i:=1:indentation_level!* do prin2!*"| ";terpri!* nil>> ;
end

%:92%
%line 2489 "liesuper.web"
;
end;
%93:%
%line 2272 "liesuper.web"

%line 2273 "liesuper.web"

 <<
for i:=1:indentation_level!* do prin2!*"| ";prin2!* nr_solved>> ;prin2!*" identities solved of ";
prin2!* nr_computed;
if indentation_level!*=0 then terpri!* t else
 <<terpri!* nil;
for i:=1:indentation_level!* do prin2!*"| ";terpri!* nil>> 

%:93%
%line 2491 "liesuper.web"
;
(indentation_level!*:=indentation_level!*-1);
!*nat:=environment

%:101%
%line 2427 "liesuper.web"
;
end$

%:99%%104:%
%line 2526 "liesuper.web"

%line 2527 "liesuper.web"
lisp procedure clear_generator val;
if atom val then rederr("CLEAR_GENERATOR: clear associated liebracket instead")
else if length val neq 2 then
rederr("CLEAR_GENERATOR: generator must have one integer argument")
else begin scalar generatorname,kvalue,h;
generatorname:=car val;
val:=list(generatorname,reval cadr val);
kvalue:=get(generatorname, 'kvalue);
if(h:=assoc(val,kvalue))then
begin
put(generatorname, 'kvalue,delete(h,kvalue));

msgpri("CLEAR_GENERATOR: clearing",val,"may lead to errors",nil,nil);
end
else
msgpri("CLEAR_GENERATOR:",val,"not found",nil,nil);
end$

%:104%%106:%
%line 2592 "liesuper.web"
lisp procedure add_degrees(degree1,degree2);
if degree1 then(car degree1+car degree2) . add_degrees(cdr
degree1,cdr degree2)$

%:106%%107:%
%line 2611 "liesuper.web"
lisp operator degree_component_sequence;
%line 2612 "liesuper.web"
lisp procedure degree_component_sequence(bracketname,degree_sequence);
begin scalar degree_length;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("DEGREE_COMPONENT_SEQUENCE:",bracketname,"is not a liebracket",nil,t);
degree_sequence:=if null degree_sequence then degree_sequence else if atom
degree_sequence then list degree_sequence else if
car degree_sequence= 'list then cdr degree_sequence else degree_sequence;
degree_length:=get(bracketname, 'degree_length);
degree_sequence:=
for each component in degree_sequence collect
if fixp component and component>0 and component leq degree_length then
component
else

msgpri("DEGREE_COMPONENT_SEQUENCE: multigrading has no component",
component,nil,nil,t);
put(bracketname, 'degree_sequence,degree_sequence);
end$

%:107%%108:%
%line 2635 "liesuper.web"
lisp procedure permuted_degree(degree,sequence);
if null sequence then degree else permute_degree(degree,sequence)$

lisp procedure permute_degree(degree,sequence);
if sequence then
nth(degree,car sequence) . permute_degree(degree,cdr sequence)$

%:108%%109:%
%line 2661 "liesuper.web"
lisp procedure degree_of1(bracketname,element);
if atom element then
if
((not fixp element)or element<-get(bracketname, 'odd_dimension)
or element>get(bracketname, 'even_dimension))then

msgpri("DEGREE_OF: cannot determine degree of",element,nil,nil,t)
else
permuted_degree(car
getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+element),
get(bracketname, 'degree_sequence))
else
if car element=bracketname or car element= 'list then
add_degrees(degree_of1(bracketname,cadr element),
degree_of1(bracketname,caddr element))
else if car element=get(bracketname, 'generatorname)then
degree_of1(bracketname,cadr element)
else
msgpri("DEGREE_OF: cannot determine degree of",element,nil,nil,t)$

%:109%%110:%
%line 2686 "liesuper.web"
lisp operator degree_of;
%line 2687 "liesuper.web"
lisp procedure degree_of element;
begin scalar operatorname,bracketname,check_element;
if(element:=reval element)=0 then return nil;
if not atom element then
begin
operatorname:=car element;
if get(operatorname, 'rtype)= 'liebracket then bracketname:=operatorname
else if get(operatorname, 'rtype)= 'algebra_generator then
bracketname:=get(operatorname, 'bracketname)
end;
if null bracketname then%111:%
%line 2708 "liesuper.web"

%line 2709 "liesuper.web"
 begin
check_element:=element;
while not atom check_element and
member(car check_element, '(quotient plus minus difference))do
check_element:=cadr check_element;
if not atom check_element then
(if car check_element= 'times then
%112:%
%line 2727 "liesuper.web"

%line 2728 "liesuper.web"
while null bracketname and(check_element:=cdr check_element)do
 <<if not atom car check_element then
begin
operatorname:=car car check_element;
if get(operatorname, 'rtype)= 'liebracket then bracketname:=operatorname
else if get(operatorname, 'rtype)= 'algebra_generator then
bracketname:=get(operatorname, 'bracketname)
end;
if bracketname then element:=car check_element>> 


%:112%
%line 2716 "liesuper.web"

else
begin
operatorname:=car check_element;
if get(operatorname, 'rtype)= 'liebracket then bracketname:=operatorname
else if get(operatorname, 'rtype)= 'algebra_generator then
bracketname:=get(operatorname, 'bracketname);
if bracketname then element:=check_element
end)
end

%:111%
%line 2697 "liesuper.web"
;
if null bracketname then

msgpri("DEGREE_OF: cannot determine degree of",element,nil,nil,t);
return 'list . degree_of1(bracketname,element)
end$

%:110%%114:%
%line 2769 "liesuper.web"

%line 2770 "liesuper.web"
lisp procedure integer_valued degree;
if null degree then t
else if fixp car degree then integer_valued cdr degree$

%:114%%115:%
%line 2778 "liesuper.web"
lisp operator define_degree;
%line 2779 "liesuper.web"
lisp procedure define_degree(generator,degree);
begin scalar generatorname,bracketname,info;
%116:%
%line 2795 "liesuper.web"

%line 2796 "liesuper.web"
if atom generator then

msgpri("DEGREE:",generator,"invalid generator",nil,t);
generatorname:=car generator;

if get(generatorname, 'rtype)neq 'algebra_generator then

msgpri("DEGREE:",generatorname,"is not an algebra generator",nil,t);
bracketname:=get(generatorname, 'bracketname);
generator:=reval cadr generator;
if
((not fixp generator)or generator<-get(bracketname, 'odd_dimension)
or generator>get(bracketname, 'even_dimension))then

msgpri("DEGREE: generator index",
generator,"out of range",nil,t)

%:116%
%line 2781 "liesuper.web"
;
%113:%
%line 2761 "liesuper.web"

if not integer_valued(degree:=if null degree then degree else if atom
degree then list degree else if
car degree= 'list then cdr degree else degree)or
length degree neq get(bracketname, 'degree_length)then

msgpri("DEGREE:", 'list . degree,"invalid degree",nil,t)

%:113%
%line 2782 "liesuper.web"
;
info:=
getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+generator);

putv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+generator,
degree . cadr info . cddr info);
end$

%:115%%117:%
%line 2815 "liesuper.web"

%line 2816 "liesuper.web"
lisp operator change_degree_length;
lisp procedure change_degree_length(bracketname,degree_length);
begin scalar m,n,old_length,shortage,extension,info,degree;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("CHANGE_DEGREE_LENGTH:",bracketname,"is not a liebracket",nil,t);
if not fixp degree_length or degree_length<=0 then
rederr("CHANGE_DEGREE_LENGTH: degree length should be >= 0");
m:=get(bracketname, 'even_dimension);
n:=get(bracketname, 'odd_dimension);
old_length:=get(bracketname, 'degree_length);
shortage:=degree_length-old_length;
if shortage>0 then extension:=for i:=1:shortage collect 0;
%118:%
%line 2831 "liesuper.web"

%line 2832 "liesuper.web"
for i:=-n:m do
begin info:=
getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i);
degree:=if extension then append(car info,extension)
else sub_list(car info,degree_length);

putv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i,
degree . cadr info . cddr info)
end

%:118%
%line 2827 "liesuper.web"
;
put(bracketname, 'degree_length,degree_length);
end$

%:117%%119:%
%line 2843 "liesuper.web"

%line 2844 "liesuper.web"
lisp procedure sub_list(l,n);
if l and n>0 then car l . sub_list(cdr l,n-1)$

%:119%%121:%
%line 2885 "liesuper.web"
lisp procedure definition_of1 listed_generator;
%line 2886 "liesuper.web"
definition_of car listed_generator$

lisp procedure definition_of generator;
begin scalar generatorname,bracketname;
%116:%
%line 2795 "liesuper.web"

%line 2796 "liesuper.web"
if atom generator then

msgpri("DEGREE:",generator,"invalid generator",nil,t);
generatorname:=car generator;

if get(generatorname, 'rtype)neq 'algebra_generator then

msgpri("DEGREE:",generatorname,"is not an algebra generator",nil,t);
bracketname:=get(generatorname, 'bracketname);
generator:=reval cadr generator;
if
((not fixp generator)or generator<-get(bracketname, 'odd_dimension)
or generator>get(bracketname, 'even_dimension))then

msgpri("DEGREE: generator index",
generator,"out of range",nil,t)

%:116%
%line 2890 "liesuper.web"
;
return cadr
getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+generator);
end$

lisp procedure history_of1 listed_generator;
history_of car listed_generator$

lisp procedure history_of generator;
begin scalar generatorname,bracketname;
%116:%
%line 2795 "liesuper.web"

%line 2796 "liesuper.web"
if atom generator then

msgpri("DEGREE:",generator,"invalid generator",nil,t);
generatorname:=car generator;

if get(generatorname, 'rtype)neq 'algebra_generator then

msgpri("DEGREE:",generatorname,"is not an algebra generator",nil,t);
bracketname:=get(generatorname, 'bracketname);
generator:=reval cadr generator;
if
((not fixp generator)or generator<-get(bracketname, 'odd_dimension)
or generator>get(bracketname, 'even_dimension))then

msgpri("DEGREE: generator index",
generator,"out of range",nil,t)

%:116%
%line 2899 "liesuper.web"
;
return cddr
getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+generator);
end$

%:121%%122:%
%line 2918 "liesuper.web"

%line 2919 "liesuper.web"
lisp procedure sub_degree(degree1,degree2);
if null degree1 then t
else if null degree2 then nil
else if car degree1=car degree2 then
sub_degree(cdr degree1,cdr degree2)$

%:122%%123:%
%line 2934 "liesuper.web"

%line 2935 "liesuper.web"
lisp operator generators_of_degree;
lisp procedure generators_of_degree(bracketname,degree);
begin scalar even_used,odd_used,generatorname,kvalue;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("GENERATORS_OF_DEGREE:",bracketname,"is not a liebracket",nil,t);
if not integer_valued(degree:=if null degree then degree else if atom
degree then list degree else if
car degree= 'list then cdr degree else degree)then

msgpri("DEGREE:", 'list . degree,"invalid degree",nil,t);
even_used:=get(bracketname, 'even_used);
odd_used:=get(bracketname, 'odd_used);
generatorname:=get(bracketname, 'generatorname);
kvalue:=get(generatorname, 'kvalue);
%124:%
%line 2957 "liesuper.web"

%line 2958 "liesuper.web"
return 'list . 
for i:=-odd_used:even_used join
if i neq 0 and null assoc(list(generatorname,i),kvalue)and
sub_degree(degree,
permuted_degree(car
getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i),
get(bracketname, 'degree_sequence)))
then
list list(generatorname,i)

%:124%
%line 2945 "liesuper.web"
;
end$

%:123%%125:%
%line 2973 "liesuper.web"

%line 2974 "liesuper.web"
lisp operator commutators_of_degree;
lisp procedure commutators_of_degree(bracketname,degree);
begin scalar
vector_structure,m,m_used,n,n_used
,vector_i,entry_i_j,info_list,
degree_sequence,degree_i;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("COMMUTATORS_OF_DEGREE:",bracketname,"is not a liebracket",nil,t);
%49:%
%line 1355 "liesuper.web"

vector_structure:=get(bracketname, 'vector_structure);
m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension);
m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used)

%:49%
%line 2979 "liesuper.web"
;
info_list:=get(bracketname, 'info_list);
if not integer_valued(degree:=if null degree then degree else if atom
degree then list degree else if
car degree= 'list then cdr degree else degree)then

msgpri("DEGREE:", 'list . degree,"invalid degree",nil,t);
degree_sequence:=get(bracketname, 'degree_sequence);
%126:%
%line 2990 "liesuper.web"

%line 2991 "liesuper.web"
return 'list . 
for i:=-n_used:m_used join
 <<vector_i:=getv(vector_structure,n+i);
degree_i:=car getv(info_list,n+i);
for j:=i:m_used join
if(null(entry_i_j:=getv(vector_i,m-j))or
null cddr(entry_i_j))and
sub_degree(degree,
permuted_degree(add_degrees(degree_i,
car getv(info_list,n+j)),
degree_sequence))
then
list list(bracketname,i,j)
>> 

%:126%
%line 2984 "liesuper.web"
;
end$

%:125%%127:%
%line 3054 "liesuper.web"

%line 3055 "liesuper.web"
lisp operator new_generators;
lisp procedure new_generators commutator_list;
begin scalar operatorname,bracketname,arg1,arg2,indx,
generator,degree,definition,history;
return
if atom commutator_list then commutator_list
else <<
operatorname:=car commutator_list;
if operatorname= 'list then
 'list . for each commutator in cdr commutator_list collect
new_generators reval commutator
else
if not get(operatorname, 'rtype)= 'liebracket then commutator_list
else
%128:%
%line 3075 "liesuper.web"

%line 3076 "liesuper.web"
begin
bracketname:=operatorname;
arg1:=cadr commutator_list;
arg2:=caddr commutator_list;
if
((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension)
or arg1>get(bracketname, 'even_dimension))or
((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension)
or arg2>get(bracketname, 'even_dimension))then
return commutator_list;
%129:%
%line 3091 "liesuper.web"

%line 3092 "liesuper.web"
if even_element(operatorname,commutator_list)then
%130:%
%line 3100 "liesuper.web"

%line 3101 "liesuper.web"
begin
indx:=get(operatorname, 'even_used)+1;
if indx<=get(operatorname, 'even_dimension)
then
 <<put(operatorname, 'even_used,indx);
generator:=list(get(operatorname, 'generatorname),indx);
%132:%
%line 3127 "liesuper.web"

%line 3128 "liesuper.web"
degree:=add_degrees(car
getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg1),
car
getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg2));
history:=add_histories(cddr
getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg1),
cddr
getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg2));
definition:=list( 'list,arg1,arg2);

putv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+indx,degree . definition . history)

%:132%
%line 3107 "liesuper.web"
>> ;
end

%:130%
%line 3093 "liesuper.web"

else
%131:%
%line 3110 "liesuper.web"

%line 3111 "liesuper.web"
begin
indx:=get(operatorname, 'odd_used)+1;
if indx<=get(operatorname, 'odd_dimension)
then
 <<put(operatorname, 'odd_used,indx);
indx:=-indx;
generator:=list(get(operatorname, 'generatorname),indx);
%132:%
%line 3127 "liesuper.web"

%line 3128 "liesuper.web"
degree:=add_degrees(car
getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg1),
car
getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg2));
history:=add_histories(cddr
getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg1),
cddr
getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg2));
definition:=list( 'list,arg1,arg2);

putv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+indx,degree . definition . history)

%:132%
%line 3118 "liesuper.web"
>> ;
end

%:131%
%line 3095 "liesuper.web"


%:129%
%line 3082 "liesuper.web"
;
return if generator then
setk(commutator_list,generator)
else commutator_list
end

%:128%
%line 3069 "liesuper.web"
>> ;
end$

%:127%%133:%
%line 3139 "liesuper.web"
lisp procedure add_histories(history1,history2);
%line 3140 "liesuper.web"
if fixp history2 then list( 'list,history1,history2)
else
if fixp history1 then 'list . history1 . cdr history2
else 'list . append(list history1,cdr history2)$

%:133%%134:%
%line 3150 "liesuper.web"
lisp operator list_used;
%line 3151 "liesuper.web"
lisp procedure list_used bracketname;
 <<
if get(bracketname, 'rtype)neq 'liebracket then

msgpri("LIST_USED:",bracketname,"is not a liebracket",nil,t);
list( 'list,get(bracketname, 'even_used),get(bracketname, 'odd_used))>> $

%:134%%135:%
%line 3158 "liesuper.web"

%line 3159 "liesuper.web"
lisp operator define_used;
lisp procedure define_used(bracketname,used_list);
begin scalar even_used,odd_used;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("DEFINE_USED:",bracketname,"is not a liebracket",nil,t);
if atom(used_list)or car(used_list)neq 'list or
length(used_list)neq 3 then

msgpri("DEFINE_USED:",used_list,"invalid list of dimensions",nil,t);
even_used:=cadr used_list;
odd_used:=caddr used_list;
if even_used>get(bracketname, 'even_dimension)or
odd_used>get(bracketname, 'odd_dimension)
then rederr("DEFINE_USED: dimensions out of range");
put(bracketname, 'even_used,even_used);
put(bracketname, 'odd_used,odd_used);
end$

%:135%%138:%
%line 3206 "liesuper.web"
lisp procedure liebracket decl_list;
%line 3207 "liesuper.web"
begin scalar bracketname,generatorname,m,n,
algebra_elements,parameters,rtype,vector_structure,info_list;
for each decl in decl_list do
begin if length decl<4 then

msgpri("LIEBRACKET:",decl,"invalid liebracket declaration",nil,t);
%139:%
%line 3226 "liesuper.web"

%line 3227 "liesuper.web"
bracketname:=car decl;generatorname:=cadr decl;
m:=reval caddr decl;n:=reval cadddr decl;
if decl:=cddddr decl then
 <<algebra_elements:=car decl;algebra_elements:=if null algebra_elements then algebra_elements else if atom
algebra_elements then list algebra_elements else if
car algebra_elements= 'list then cdr algebra_elements else algebra_elements;
if cdr decl then parameters:=cadr decl;parameters:=if null parameters then parameters else if atom
parameters then list parameters else if
car parameters= 'list then cdr parameters else parameters>> 

%:139%
%line 3213 "liesuper.web"
;
%140:%
%line 3240 "liesuper.web"

%line 3241 "liesuper.web"
if not idp bracketname or not idp generatorname or not fixp m or not
fixp n or m<0 or n<0 then

msgpri("LIEBRACKET:",decl,"invalid liebracket declaration",nil,t);
if get(bracketname, 'simpfn)then

msgpri("LIEBRACKET: operator",bracketname,
"invalid as liebracket",nil,t);
if rtype:=get(bracketname, 'rtype)then

msgpri("LIEBRACKET:",rtype,bracketname,"invalid as liebracket",t);
if get(generatorname, 'simpfn)then

msgpri("LIEBRACKET: operator",generatorname,
"invalid as generator",nil,t);
if rtype:=get(generatorname, 'rtype)then

msgpri("LIEBRACKET:",rtype,generatorname,"invalid as generator",t)

%:140%
%line 3214 "liesuper.web"
;
%141:%
%line 3277 "liesuper.web"

%144:%
%line 3338 "liesuper.web"

%line 3339 "liesuper.web"
%143:%
%line 3327 "liesuper.web"

%line 3328 "liesuper.web"
vector_structure:=mkvect(m+n);
for i:=-n:m do putv(vector_structure,n+i,mkvect(m-i));
for i:=-n:0 do putv(getv(vector_structure,n+i),m, '(s
) . nil . 0);
for j:=1:m do
 <<putv(getv(vector_structure,n),m-j, '(s
) . nil . 0);
putv(getv(vector_structure,n+j),m-j, '(s
) . nil . 0)>> 

%:143%
%line 3339 "liesuper.web"
;
info_list:=mkvect(m+n);
for i:=-n:m do putv(info_list,n+i, '(0) . i . i)

%:144%
%line 3278 "liesuper.web"
;
put(bracketname, 'vector_structure,vector_structure);
put(bracketname, 'info_list,info_list);
put(bracketname, '!*jacobi_var!*,list t);
put(bracketname, 'even_dimension,m);
put(bracketname, 'odd_dimension,n);
put(bracketname, 'even_used,0);
put(bracketname, 'odd_used,0);
put(bracketname, 'degree_length,1);
put(bracketname, 'algebra_elements,algebra_elements);
put(bracketname, 'parameters,parameters);
put(bracketname, 'oplist,
bracketname . generatorname .  'list .  'df . algebra_elements);
put(bracketname, 'resimp_fn, 'resimp_liebracket);
put(bracketname, 'generatorname,generatorname);
put(bracketname, 'rtype, 'liebracket);
put(bracketname, 'simpfn, 'simp_liebracket);
put(generatorname, 'bracketname,bracketname);
put(generatorname, 'rtype, 'algebra_generator);
put(generatorname, 'simpfn, 'simpiden);
flag(list bracketname, 'full)

%:141%
%line 3215 "liesuper.web"
;
end;
end$

%:138%%145:%
%line 70 "list2vector.ch"

lisp operator save_liebracket;
lisp procedure save_liebracket(bracketname,savefile);
begin scalar generatorname,vector_list;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("SAVE_LIEBRACKET:",bracketname,"is not a liebracket",nil,t);
generatorname:=get(bracketname, 'generatorname);
rmsubs();
out savefile;
write"lisp$";
terpri();terpri();
%147:%
%line 3398 "liesuper.web"

%line 3399 "liesuper.web"
write"if not getd 'simp_liebracket then";terpri();
write"rederr(",
"""Load the Lie superalgebra package before reading this file""",")$";
terpri();terpri()

%:147%
%line 80 "list2vector.ch"
;
for each property in 'klist . cddr
 '(vector_structure info_list !*jacobi_var!* even_dimension odd_dimension
even_used odd_used degree_length degree_sequence algebra_elements
parameters oplist resimp_fn
generatorname rtype simpfn commutator_list identity_list
unsolved_identities kvalue)do

 <<prin2"put('";prin1 bracketname;prin2",'";prin1 property;prin2",'";
prin1 get(bracketname,property);prin2")$";terpri();terpri()>> ;
%146:%
%line 97 "list2vector.ch"

vector_list:=for each el in vector2list get(bracketname, 'vector_structure)
collect vector2list el;
prin2"put('";prin1 bracketname;
prin2",'VECTOR_STRUCTURE,list2vector(for each el in '";
prin1 vector_list;prin2" collect list2vector el))$";terpri();terpri();
vector_list:=vector2list get(bracketname, 'info_list);
prin2"put('";prin1 bracketname;prin2",'INFO_LIST,list2vector '";
prin1 vector_list;prin2")$";terpri();terpri()

%line 3394 "liesuper.web"

%:146%
%line 83 "list2vector.ch"
;
write"flag('(",bracketname,"),'full)$";terpri();terpri();
for each property in 'klist . 
 '(bracketname rtype simpfn kvalue)do

 <<prin2"put('";prin1 generatorname;prin2",'";prin1 property;prin2",'";
prin1 get(generatorname,property);prin2")$";terpri();terpri()>> ;
%149:%
%line 3434 "liesuper.web"

%line 3435 "liesuper.web"
write"repair_vector_structure_of '",bracketname,"$";terpri();terpri()

%:149%
%line 87 "list2vector.ch"
;
write"algebraic$ end$";
shut savefile;
end$

%:145%%148:%
%line 3420 "liesuper.web"

%line 3421 "liesuper.web"
lisp procedure repair_vector_structure_of bracketname;
begin scalar
vector_structure,m,m_used,n,n_used
,!*jacobi_var!*,vector_i,entry_i_j;
%49:%
%line 1355 "liesuper.web"

vector_structure:=get(bracketname, 'vector_structure);
m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension);
m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used)

%:49%
%line 3423 "liesuper.web"
;
!*jacobi_var!*:=get(bracketname, '!*jacobi_var!*);
for i:=-n_used:m_used do
begin vector_i:=getv(vector_structure,n+i);
for j:=i:m_used do
if(entry_i_j:=getv(vector_i,m-j))and car(entry_i_j)= '(t)
then
putv(vector_i,m-j,!*jacobi_var!* . cdr entry_i_j);
end;
end$

%:148%%150:%
%line 3448 "liesuper.web"

%line 3449 "liesuper.web"
lisp operator print_liebracket;
lisp procedure print_liebracket bracketname;
begin scalar
vector_structure,m,m_used,n,n_used
,vector_i,commutator_i_j;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("PRINT_LIEBRACKET:",bracketname,"is not a liebracket",nil,t);
%49:%
%line 1355 "liesuper.web"

vector_structure:=get(bracketname, 'vector_structure);
m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension);
m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used)

%:49%
%line 3453 "liesuper.web"
;
for i:=-n_used:m_used do
begin vector_i:=getv(vector_structure,n+i);
for j:=i:m_used do
if(i neq 0)and(j neq 0)and(i neq j or i<0)and
(commutator_i_j:=getv(vector_i,m-j))and
(commutator_i_j:=aeval cddr commutator_i_j)then
varpri(commutator_i_j,
list( 'setk,mkquote list(bracketname,i,j),mkquote commutator_i_j),
 'only);
end;
end$

%:150%%151:%
%line 3485 "liesuper.web"

%line 3486 "liesuper.web"
lisp operator change_dimensions_of;
lisp procedure change_dimensions_of(bracketname,m,n);
begin scalar old_vector_structure,old_m,old_n,new_m,new_n,old_vector_i,entry_i_j,
vector_structure,old_info_list,info_list,vector_i,m_used,n_used,
degree_length,kernel_list;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("CHANGE_DIMENSIONS_OF:",bracketname,"is not a liebracket",nil,t);
old_m:=get(bracketname, 'even_dimension);
old_n:=get(bracketname, 'odd_dimension);
new_m:=min(m,old_m);new_n:=min(n,old_n);
m_used:=min(new_m,get(bracketname, 'even_used));
n_used:=min(new_m,get(bracketname, 'odd_used));
old_vector_structure:=get(bracketname, 'vector_structure);
old_info_list:=get(bracketname, 'info_list);
%144:%
%line 3338 "liesuper.web"

%line 3339 "liesuper.web"
%143:%
%line 3327 "liesuper.web"

%line 3328 "liesuper.web"
vector_structure:=mkvect(m+n);
for i:=-n:m do putv(vector_structure,n+i,mkvect(m-i));
for i:=-n:0 do putv(getv(vector_structure,n+i),m, '(s
) . nil . 0);
for j:=1:m do
 <<putv(getv(vector_structure,n),m-j, '(s
) . nil . 0);
putv(getv(vector_structure,n+j),m-j, '(s
) . nil . 0)>> 

%:143%
%line 3339 "liesuper.web"
;
info_list:=mkvect(m+n);
for i:=-n:m do putv(info_list,n+i, '(0) . i . i)

%:144%
%line 3499 "liesuper.web"
;
%152:%
%line 3514 "liesuper.web"

%line 3515 "liesuper.web"
for i:=-new_n:new_m do
begin
old_vector_i:=getv(old_vector_structure,old_n+i);
vector_i:=getv(vector_structure,n+i);
for j:=i:new_m do
if(entry_i_j:=getv(old_vector_i,old_m-j))then
putv(vector_i,m-j,entry_i_j);
putv(info_list,n+i,getv(old_info_list,old_n+i));
end

%:152%
%line 3500 "liesuper.web"
;
put(bracketname, 'vector_structure,vector_structure);
put(bracketname, 'info_list,info_list);
put(bracketname, 'even_dimension,m);
put(bracketname, 'odd_dimension,n);
put(bracketname, 'even_used,m_used);
put(bracketname, 'odd_used,n_used);
%153:%
%line 3539 "liesuper.web"

%line 3540 "liesuper.web"
if m>old_m or n>old_n then
begin
degree_length:=get(bracketname, 'degree_length);
change_degree_length(bracketname,2*degree_length);
change_degree_length(bracketname,degree_length);
kernel_list:=
for each dependency in get(get(bracketname, 'generatorname), 'kvalue)collect
car dependency;
for each kernel in kernel_list do setk(kernel,aeval kernel);
end

%:153%
%line 3507 "liesuper.web"
;
end$

%:151%%156:%
%line 3587 "liesuper.web"

%line 3588 "liesuper.web"
lisp procedure liebracket_stat;
begin scalar arguments;
arguments:=xread nil;
arguments:=
if atom arguments or car arguments neq '!*comma!* then
arguments
else cdr arguments;
scan();
return default_liebracket!* . arguments;
end$

%:156%%157:%
%line 3609 "liesuper.web"

%line 3610 "liesuper.web"
lisp procedure liebracket_prifn commutator;
begin
prin2!*"[";
inprint( '!*comma!*,0,cdr commutator);
prin2!*"]";
end$

%:157%%159:%
%line 3627 "liesuper.web"
lisp operator default_liebracket;
%line 3628 "liesuper.web"

lisp procedure default_liebracket bracketname;
begin
remprop(default_liebracket!*, 'prifn);
default_liebracket!*:=bracketname;
put(default_liebracket!*, 'prifn, 'liebracket_prifn);
end$

%:159%%163:%
%line 3737 "liesuper.web"

%line 3738 "liesuper.web"
lisp operator transform_liebracket;
lisp procedure transform_liebracket(bracketname,new_bracketname,
new_generatorname,basis_transformation);
begin scalar generatorname,even_bound,odd_bound,transform_vector,inverse_vector,
new_generator,transformed_sq,splitted_sf,generator_list,x_gap,y_gap,
new_even_used,new_odd_used,result;

if get(bracketname, 'rtype)neq 'liebracket then

msgpri("TRANSFORM_LIEBRACKET:",bracketname,"is not a liebracket",nil,t);
generatorname:=get(bracketname, 'generatorname);
%162:%
%line 3719 "liesuper.web"

%line 3720 "liesuper.web"
if null !*full_transformation then
begin even_bound:=get(bracketname, 'even_used);
odd_bound:=get(bracketname, 'odd_used);
end
else
begin even_bound:=get(bracketname, 'even_dimension);
odd_bound:=get(bracketname, 'odd_dimension);
end;
transform_vector:=mkvect(even_bound+odd_bound);
inverse_vector:=mkvect(even_bound+odd_bound)


%:162%
%line 3746 "liesuper.web"
;
%164:%
%line 3759 "liesuper.web"

%line 3760 "liesuper.web"
%166:%
%line 3841 "liesuper.web"

if atom basis_transformation or car basis_transformation neq 'list
then
msgpri("TRANSFORM_LIEBRACKET",basis_transformation,
"not valid as a basis transformation",nil,t);
basis_transformation:=
for each transformation_rule in cdr basis_transformation collect
 <<if not
(eqexpr transformation_rule and
not atom cadr transformation_rule and
car cadr transformation_rule=new_generatorname)or not
 <<new_generator:=cadr cadr(transformation_rule);

(fixp new_generator and new_generator neq 0 and new_generator<=even_bound and
new_generator>=-odd_bound)>> 
then
msgpri("TRANSFORM_LIEBRACKET:",cadr(transformation_rule),
"not allowed as a new generator",nil,t);
transformed_sq:=simp caddr(transformation_rule);
splitted_sf:=split_form(numr transformed_sq,list(generatorname));
if not
null car splitted_sf and
for each generator in cdr splitted_sf product
if(generator:=cadr car generator)*new_generator>0 and

(fixp generator and generator neq 0 and generator<=even_bound and
generator>=-odd_bound)then 1 else 0=1 then

msgpri("TRANSFORM_LIEBRACKET",cadr(transformation_rule),
"must be a sum of generators with right sign",nil,t);

for each generator in cdr splitted_sf do
if not member(generator:=car generator,generator_list)then
generator_list:=generator . generator_list
;
putv(transform_vector,odd_bound+new_generator,transformed_sq . splitted_sf);

numr subtrsq(!*k2q cadr(transformation_rule),transformed_sq)>> 

%:166%
%line 3760 "liesuper.web"
;
%167:%
%line 3871 "liesuper.web"

%line 3872 "liesuper.web"
if length generator_list neq length basis_transformation then
rederr"TRANSFORM_LIEBRACKET: inconsistent transformation";
if basis_transformation then
basis_transformation:=caadr solvesys(basis_transformation,generator_list);
for each generator in generator_list do
 <<transformed_sq:=car basis_transformation;
putv(inverse_vector,odd_bound+cadr generator,
transformed_sq . split_form(numr transformed_sq,list(new_generatorname)));
basis_transformation:=cdr basis_transformation>> 

%:167%
%line 3761 "liesuper.web"
;
%168:%
%line 3927 "liesuper.web"

 <<
x_gap:=y_gap:=0;
repeat x_gap:=x_gap+direction
until abs(x_gap)>bound or(null getv(inverse_vector,odd_bound+x_gap)
and null assoc(list(generatorname,x_gap),get(generatorname, 'kvalue)));
if abs(x_gap)>bound then x_gap:=nil;
repeat y_gap:=y_gap+direction
until abs(y_gap)>bound or null getv(transform_vector,odd_bound+y_gap);
while x_gap do <<
putv(inverse_vector,odd_bound+x_gap,mksq(list(new_generatorname,y_gap),1) . 
list(nil,list(new_generatorname,y_gap) . 1));
putv(transform_vector,odd_bound+y_gap,mksq(list(generatorname,x_gap),1) . 
list(nil,list(generatorname,x_gap) . 1));
repeat x_gap:=x_gap+direction
until abs(x_gap)>bound or(null getv(inverse_vector,odd_bound+x_gap)
and null assoc(list(generatorname,x_gap),get(generatorname, 'kvalue)));
if abs(x_gap)>bound then x_gap:=nil;
repeat y_gap:=y_gap+direction
until abs(y_gap)>bound or null getv(transform_vector,odd_bound+y_gap)>> ;new_even_used:=y_gap-1>> where direction=1,bound=even_bound;
 <<
x_gap:=y_gap:=0;
repeat x_gap:=x_gap+direction
until abs(x_gap)>bound or(null getv(inverse_vector,odd_bound+x_gap)
and null assoc(list(generatorname,x_gap),get(generatorname, 'kvalue)));
if abs(x_gap)>bound then x_gap:=nil;
repeat y_gap:=y_gap+direction
until abs(y_gap)>bound or null getv(transform_vector,odd_bound+y_gap);
while x_gap do <<
putv(inverse_vector,odd_bound+x_gap,mksq(list(new_generatorname,y_gap),1) . 
list(nil,list(new_generatorname,y_gap) . 1));
putv(transform_vector,odd_bound+y_gap,mksq(list(generatorname,x_gap),1) . 
list(nil,list(generatorname,x_gap) . 1));
repeat x_gap:=x_gap+direction
until abs(x_gap)>bound or(null getv(inverse_vector,odd_bound+x_gap)
and null assoc(list(generatorname,x_gap),get(generatorname, 'kvalue)));
if abs(x_gap)>bound then x_gap:=nil;
repeat y_gap:=y_gap+direction
until abs(y_gap)>bound or null getv(transform_vector,odd_bound+y_gap)>> ;new_odd_used:=-y_gap-1>> where direction=-1,bound=odd_bound

%:168%
%line 3762 "liesuper.web"


%:164%
%line 3747 "liesuper.web"
;
%169:%
%line 3947 "liesuper.web"

%line 3948 "liesuper.web"
%170:%
%line 3963 "liesuper.web"

%line 3964 "liesuper.web"
put(bracketname, 'save_vector_structure,get(bracketname, 'vector_structure))

%:170%
%line 3948 "liesuper.web"
;
result:=errorset(list( 'transform_table,mkquote bracketname,mkquote generatorname,
mkquote new_bracketname,mkquote new_generatorname,
mkquote even_bound,mkquote odd_bound,
mkquote new_even_used,mkquote new_odd_used,
mkquote transform_vector,mkquote inverse_vector),t,t);
%178:%
%line 4167 "liesuper.web"

%line 4168 "liesuper.web"
put(bracketname, 'vector_structure,get(bracketname, 'save_vector_structure));
remprop(bracketname, 'save_vector_structure);
put(generatorname, 'simpfn, 'simpiden);
remprop(generatorname, 'inverse_vector);
remflag(list generatorname, 'full);
remprop(generatorname, 'bounds)

%:178%
%line 3954 "liesuper.web"
;
if result then return
list( 'list,
( 'list . for i:=1:new_even_used collect mk!*sq car getv(transform_vector,odd_bound+i)),
( 'list . for i:=1:new_odd_used collect mk!*sq car getv(transform_vector,odd_bound+-i)))

%:169%
%line 3748 "liesuper.web"
;
end$

%:163%%171:%
%line 3982 "liesuper.web"

%line 3983 "liesuper.web"
lisp procedure transform_table(bracketname,generatorname,
new_bracketname,new_generatorname,even_bound,odd_bound,
new_even_used,new_odd_used,
transform_vector,inverse_vector);
begin scalar m,n,vector_structure,vector_i,
save_vector_structure,save_vector_i,save_entry_i_j,arg_i,arg_j,degree_length;
remprop(new_generatorname, 'simpfn);
apply1( 'liebracket,list list(new_bracketname,new_generatorname,
even_bound,odd_bound,
get(bracketname, 'algebra_elements),get(bracketname, 'parameters)));
%175:%
%line 4086 "liesuper.web"

%line 4087 "liesuper.web"
%173:%
%line 4039 "liesuper.web"

%line 4040 "liesuper.web"
put(generatorname, 'inverse_vector,inverse_vector);
put(generatorname, 'bounds,odd_bound . even_bound);
put(generatorname, 'simpfn, 'simp_transform_vector);
flag(list generatorname, 'full);
rmsubs()

%:173%
%line 4087 "liesuper.web"
;
save_vector_structure:=get(bracketname, 'save_vector_structure);
m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension);
%143:%
%line 3327 "liesuper.web"

%line 3328 "liesuper.web"
vector_structure:=mkvect(m+n);
for i:=-n:m do putv(vector_structure,n+i,mkvect(m-i));
for i:=-n:0 do putv(getv(vector_structure,n+i),m, '(s
) . nil . 0);
for j:=1:m do
 <<putv(getv(vector_structure,n),m-j, '(s
) . nil . 0);
putv(getv(vector_structure,n+j),m-j, '(s
) . nil . 0)>> 

%:143%
%line 4090 "liesuper.web"
;
for i:=-odd_bound:even_bound do begin
save_vector_i:=getv(save_vector_structure,n+i);
vector_i:=getv(vector_structure,n+i);
arg_i:=getv(inverse_vector,odd_bound+i);
for j:=i:even_bound do
if(save_entry_i_j:=getv(save_vector_i,m-j))and
cddr(save_entry_i_j)then
(if car save_entry_i_j neq '(s
)then
putv(vector_i,m-j,nil . nil . aeval cddr save_entry_i_j))
else putv(vector_i,m-j,
nil . nil . mk!*sq transform_commutator(new_bracketname,arg_i,getv(inverse_vector,odd_bound+j)))
end;
put(bracketname, 'vector_structure,vector_structure);
rmsubs()

%:175%
%line 3993 "liesuper.web"
;
%176:%
%line 4135 "liesuper.web"

for i:=-new_odd_used:new_even_used do
if(arg_i:=getv(transform_vector,odd_bound+i))then
for j:=i:new_even_used do
if(arg_j:=getv(transform_vector,odd_bound+j))and
i neq 0 and j neq 0 and(i neq j or i<0)then
relation_analysis(mk!*sq subtrsq(simp!* list(new_bracketname,i,j),
subs2 transform_commutator(bracketname,arg_i,arg_j)),
new_bracketname);
put(new_bracketname, 'even_used,new_even_used);
put(new_bracketname, 'odd_used,new_odd_used)

%:176%
%line 3994 "liesuper.web"
;
%177:%
%line 4158 "liesuper.web"

%line 4159 "liesuper.web"
degree_length:=if get(bracketname, 'degree_sequence)then
length get(bracketname, 'degree_sequence)
else get(bracketname, 'degree_length);
change_degree_length(new_bracketname,degree_length);
for i:=-new_odd_used:new_even_used do
if i neq 0 then
define_degree(list(new_generatorname,i),degree_of(mk!*sq car getv(transform_vector,odd_bound+i)))

%:177%
%line 3995 "liesuper.web"
;
end$

%:171%%172:%
%line 4019 "liesuper.web"

%line 4020 "liesuper.web"

lisp procedure simp_transform_vector generator;
begin scalar generatorname,i,bounds,inverse_vector,value;
generatorname:=car generator;
i:=cadr generator;
bounds:=get(generatorname, 'bounds);
inverse_vector:=get(generatorname, 'inverse_vector);
if i<-car bounds or i>cdr bounds then

msgpri("TRANSFORM_LIEBRACKET:",generator,
"out of the transformation range. Use 'on fulltransformation;'.",nil,t);
return
if value:=getv(inverse_vector,car bounds+i)then car value
else simpiden generator
end$

%:172%%174:%
%line 4063 "liesuper.web"

%line 4064 "liesuper.web"
lisp procedure transform_commutator(bracketname,transformed_i,transformed_j);
quotsq(build_sum(bracketname,list(cdr transformed_j,cdr transformed_i)),
!*f2q multf(denr car transformed_i,denr car transformed_j))$

%:174%%180:%
%line 4198 "liesuper.web"

%line 4199 "liesuper.web"
symbolic procedure fkern u;
begin scalar x,y;
if atom u then return list(u,nil);
if get(car u, 'rtype)= 'liebracket and
fixp cadr u and fixp caddr u then
return fkern_liebracket u;
y:=if atom car u then get(car u, 'klist)else exlist!*;
if not(x:=assoc(u,y))
then <<x:=list(u,nil);
y:=ordad(x,y);
if atom car u
then <<kprops!*:=union(list car u,kprops!*);
put(car u, 'klist,y)>> 
else exlist!*:=y>> ;
return x
end$

%:180%%181:%
%line 4234 "liesuper.web"
symbolic procedure fkern_liebracket commutator;
%line 4235 "liesuper.web"
begin scalar bracketname,i,j,entry_i_j;
bracketname:=car commutator;
i:=cadr commutator;
j:=caddr commutator;
entry_i_j:=
getv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+i),
get(bracketname, 'even_dimension)-j);
if null entry_i_j then entry_i_j:=

putv(getv(get(bracketname, 'vector_structure),
get(bracketname, 'odd_dimension)+i),
get(bracketname, 'even_dimension)-j,nil . list(commutator,nil) . nil)
else if null cadr entry_i_j then
rplaca(cdr entry_i_j,list(commutator,nil));
return cadr entry_i_j;
end$

%:181%%182:%
%line 4259 "liesuper.web"

%line 4260 "liesuper.web"
symbolic procedure prepsq!* u;
begin scalar x,!*combinelogs;
if null numr u then return 0;
x:=setkorder
append((for each j in factors!*
join if not idp j then nil
else if get(j, 'rtype)= 'liebracket then
ordn get_all_kernels(numr u,j)
else for each k in get(j, 'klist)collect car k),
append(factors!*,ordl!*));
if kord!* neq x or wtl!*
then u:=formop numr u . formop denr u;
u:=if !*rat or !*div
or upl!* or dnl!*
then replus prepsq!*1(numr u,denr u,nil)
else sqform(u,function prepsq!*2);
setkorder x;
return u
end$

%:182%%183:%
%line 4281 "liesuper.web"
end;
%line 4282 "liesuper.web"

%:183%