module auxitens;
% this module introduces basic manipulation functions
% for handling indices and tensor structure
lisp remflag(list 'minus,'intfn);
global '(dimex!* sgn!* signat!* spaces!* numindxl!* pair_id_num!*) ;
lisp (pair_id_num!*:= '((!0 . 0) (!1 . 1) (!2 . 2) (!3 . 3) (!4 . 4)
(!5 . 5) (!6 . 6) (!7 . 7) (!8 . 8) (!9 . 9)
(!10 . 10) (!11 . 11) (!12 . 12) (!13 . 13)));
fluid('(dummy_id!* g_dvnames epsilon!*));
% g_dvnames is a vector.
switch onespace;
!*onespace:=t; % working inside a unique space is the default.
symbolic procedure raiseind!: u;
if atom u then u else raiseind u;
symbolic procedure lowerind_lst u;
% u is a list of indices.
% transforms into a list of covariant indices
for each j in u collect lowerind j;
symbolic procedure raiseind_lst u;
% u is a list of indices.
% transforms into a list of contravariant indices
for each j in u collect raiseind!: j;
symbolic procedure flatindxl u;
% This is taken from EXCALC
for each j in u collect
if atom j
then j
else if careq_minus(j)
then cadr j
else cdr j;
symbolic procedure cov_lst_idsp u;
% True if all indices in list u are covariant
if null u then t
else
if careq_minus car u then cov_lst_idsp cdr u;
symbolic procedure cont_lst_idsp u;
% True if all indices in list u are contravariant
if null u then t
else
if atom car u then cont_lst_idsp cdr u;
symbolic procedure identify_pos_cov_lst(u,i);
% allows to get the position of a fully covariant list
% u is a list of lists
% returns i which is the position of the FIRST relevant list in u.
% starting value of i is zero.
if null u then
if i=0 then nil
else i-1
else
if cov_lst_idsp car u then i:=i+1
else
identify_pos_cov_lst(cdr u,i+1);
symbolic procedure identify_pos_cont_lst(u,i);
% allows to get the position of a fully contravariant list
% u is a list of lists
% returns i which is the position of the FIRST relevant list in u.
% starting value of i is zero.
if null u then
if i=0 then nil
else i-1
else
if cont_lst_idsp car u then i:=i+1
else
identify_pos_cont_lst(cdr u,i+1);
symbolic procedure splitlist!: (u,idp);
% EXTRACTS THE SUBLIST OF ELEMENTS WHOSE CAR ARE EQUAL THE IDP.
% TAG.
% taken from my old tensor package.
if null u then nil
else
if eqcar(car u,idp) then car u . splitlist!:(cdr u,idp)
else splitlist!:(cdr u,idp);
symbolic procedure list_to_ids!: l;
if atom l then rederr "argument for list_to_ids must be a list"
else
intern compress for each i in l join explode i;
symbolic procedure split!:(u,v);
% split!:(list(a,b,c),list(1,1,1)); ==> {{A},{B},{C}}
% No longer used below but ...
if listp u and listp v then
begin scalar x;
return for each n in v collect
for i := 1:n collect
<<x := car u; u := rest u; x>>
end;
symbolic procedure symtree_splitlst(idtens,lsy,bool);
% idtens is the tensor indices argument list and lsy
% is cdr of symtree.
% output is the splitted indices list which mirrors lsy
% and make partial reordering whenever possible .
for each i in lsy collect
if bool and car i memq {'!+,'!-} then
ordn for each j in cdr i collect nth(idtens,j)
else for each j in cdr i collect nth(idtens,j);
symbolic procedure symtree_zerop (idtens,lsym);
% idtens is the list of indices of a given tensor.
% lsym is the symmetry tree list as generated by the
% 'symtree' operator of DUMMY.RED.
% pseudo-boolean: returns the set of indices which is repeated or
% nil.
% It DOES detect MOST but NOT ALL possibilities leaving the rest for
% canonical.
if null cdr lsym then nil
else
if numlis cdr lsym then
if car lsym eq '!- and repeats idtens then repeats idtens
else nil
else
% here we start considering proper partial symmetries
begin scalar lsy, idt,y;
if car lsym eq '!- then
if (y := repeats symtree_splitlst(idtens,cdr lsym,nil))
then return y;
idt:= symtree_splitlst(idtens,cdr lsym,t);
if car lsym eq '!- then
if (y:=repeats idt) then return y;
lsy:=for each j in cdr lsym collect car j;
return partsym_zerop(idt,lsy)
end;
symbolic procedure partsym_zerop(idt,lsy);
% idt: splitted list of indices
% lsy list of tags for partial symmetries.
% they should have the same lengths
if null idt then nil
else
(if car lsy eq '!- and y then y
else partsym_zerop(cdr idt,cdr lsy))where y=repeats car idt;
symbolic procedure cont_before_cov u;
% is a list of indices some are covariant
% others are contravariant
% returns a list with contravariant indices placed
% in front of the covariant indices.
begin scalar x;
x:=splitlist!:(u,'minus);
return append(setdiff(u,x) ,x)
end;
endmodule;
end;