module partitns;
% definitions of particular tensors.
global '(dimex!* sgn!* signat!* spaces!* numindxl!* pair_id_num!*);
fluid('(dummy_id!* g_dvnames epsilon!*));
% epsilon!* keeps track of the various epsilon tensors
% which may be defined when onespace is OFF
% It is a list pairs (<space-name> . <name>)
switch exdelt; % default is OFF
switch onespace;
!*onespace:=t; % working inside a unique space is the default.
flag(list('delta,'epsilon,'del,'eta,'metric), 'reserved); % they are keywords.
symbolic flag(list('make_partic_tens),'opfn);
symbolic procedure make_partic_tens(u,v);
% u is a bare identifier (free of properties)
% the result is T(rue) when it suceeds to create
% the properties of being a particular tensor on u.
% can be trivially generalized to other tensors.
if v memq {'delta,'eta,'epsilon,'del,'metric} then
<<
if get(u,'avalue)
% or (get(u,'reserved) and null flagp(u,'tensor))
or getrtype u or (gettype u eq 'procedure) or
% is this necessary?
(u memq list('sin,'cos,'tan,'atan,'acos,'asin,'df,'int)) then
rerror(cantens,5,list(u,"may not be defined as tensor"))
else
if flagp(u,'tensor) then
<<lpri {"*** Warning:", u,"redefined as particular tensor"};
remprop(u,'kvalue);
remprop(u,'simpfn);
remprop(u,'bloc_diagonal);
remflag(list u,'generic);
>>;
% the 'name' indicator allows to find
% the name chosen for a particular tensor from the keyword
% associated to it.
% Only ONE tensor of type 'delta' and 'eta' are allowed so:
(if x and v memq {'delta,'eta,'del} then rem_tensor1 x)where x=get(v,'name);
make_tensor(u,nil); % contains the action of rem_tensor
put(u,'partic_tens, if v = 'delta then 'simpdelt
else
if v = 'eta then 'simpeta
else
if v = 'epsilon then 'simpepsi
else
if v = 'del then 'simpdel
else
if v= 'metric then 'simpmetric);
if null !*onespace and v = 'epsilon
then
if epsilon!*
then <<put(v,'name,u);
lpri {"*** Warning:", u,"MUST belong to a space"};>>
else nil;
put(v,'name, u);
if v memq {'metric,'delta} then <<flag(list u,'generic);
make_bloc_diagonal u>>;
t
>>
else "unknown keyword";
symbolic procedure find_name u;
% find the name of a particular tensor whose keyword is u.
% Must still be extended for u=epsilon
(if null x then
rerror(cantens,6,{" no name found for", list u})
else x)where x=get(u,'name);
% **** Simplification functions for particular tensors
symbolic procedure simpdelt (x,varl);
% x is is a list {<tensor> indices}
% for instance (tt a (minus b)) for tt(a,-b)
% varl is the set of variables {v1,v2, ...}
% result is the simplified form of the Dirac delta function if varl is nil
% and cdr x is nil.
If varl and null cdr x then !*k2f(car x . varl . nil) else
if null varl or null cdr varl then
begin scalar delt,ind,y,yv,yc;
delt := car x; ind:= cdr x;
y:=split_cov_cont_ids ind;
if (length car y * length cadr y) neq 1 then
rerror(cantens,7, "bad choice of indices for DELTA tensor");
yv:=caar y;
yc:=caadr y;
% The conditional statement below can be suppressed if
% 'wholespace' can be defined with an indexrange.
% if get(delt,'belong_to_space) eq 'wholespace then
% if get_sign_space('wholespace) = 0 then
% if yv='!0 or yc ='!0 then
% rerror(cantens,2,"bad value of indices for DELTA tensor");
if !*id2num yv and !*id2num yc then return
if yv=yc then 1
else 0
else
if !*onespace then return
if yv eq yc then dimex!*
else !*k2f(delt . append(cadr y,lowerind_lst car y))
else return
if null get(yv,'space) and yv eq yc then
if assoc('wholespace,spaces!*) then !*k2f get_dim_space 'wholespace
else "not meaningful"
else
if yv eq yc then !*k2f space_dim_of_idx yv
else !*k2f(delt . append(cadr y,lowerind_lst car y))
end
else "not meaningful";
symbolic procedure simpdel u;
% u is the list {<del-name> <covariant indices>
% <contravariant indices>}
% when 'DEL' is used by the system through simpepsi,
% indices are already ordered and, when 'canonical' is entered,
% they are again ordered after contractions. So ordering is
% necessary only if the user enters it from the start.
% in spite of this, the procedure is made to order them
% in all cases. REFINEMENTS to avoid that are possible.
% returns a standard form.
begin scalar del,ind,x,idv,idc,idvn,idcn,bool,spweight;
integer free_ind,tot_ind,dim_space;
del:= car u;
ind:=cdr u;
spweight:=1;
% though it is antisymmetric separately with respect to the cov
% and cont indices we do not declare it as such for the time being.
x:=split_cov_cont_ids ind;
idv:= car x; idc:=cadr x;
if length idv neq length idc then
rerror(cantens,7, "bad choice of indices for DEL tensor")
else
if null !*onespace then
if null symb_ids_belong_same_space!:(
append(idv,idc),nil) then
rerror(cantens,7, "all indices should belong to the SAME space")
else
if repeats idv or repeats idc then return 0
else
if length idc =1 then return
apply2('simpdelt, find_name('delta) . append(lowerind_lst idv,idc),nil);
% here we shall start to find the dummy indices which are internal
% to 'del' as in the case del(a,b,a1..an, -a,-b,-c1, ...-cn) which
% can be simplified to del(a1,...an,-c1, ...,-cn)*polynomial in the
% space-dimension or a number if N_space=number
% first arrange each list so that dummy indices are at the beginning
% of idv and idc.
idv:=for each y in idv collect %au lieu de idvn
if null !*id2num y and memq(y,idc) then list('dum,y)
else y;
idc:=for each y in idc collect
if null !*id2num y and memq(y,car x) then list('dum,y)
else y;
if permp!:(idvn:=ordn idv,idv)=permp!:(idcn:=ordn idc,idc) then bool:=t;
% the form of these new lists is ((dum a) (dum b) ..ak..) etc ...
% 1. they contain only numeric indices:
if num_indlistp append(idvn,idcn) then
return simpdelnum(idvn,idcn,bool);
% 2. some indices are symbolic:
tot_ind:=length idvn;
% dummy indices can be present:
idv:=splitlist!:(idvn,'dum); % if no dummy indices, it is nil.
free_ind:=tot_ind - length idv;
% now search the space in which we are working.
dim_space:= if idv then %% since, may be, no dummy indices
if null spaces!* then dimex!*
else !*k2f space_dim_of_idx cadar idv;
for i:=free_ind : (tot_ind -1) do
<<spweight:=multf(addf(dim_space,negf !*n2f i),spweight);
idvn:=cdr idvn; idcn:=cdr idcn;
>>;
spweight:=!*a2f reval prepf spweight;
if null idvn then
return
if bool then spweight
else negf spweight;
% left indices can again be all numeric indices
if num_indlistp append(idvn,idcn) then
return
multf(spweight,simpdelnum(idvn,idcn,bool));
% 3. There is no more internal dummy indices, so
return
% if !*exdelt then
% if bool then
% multf(spweight,extract_delt(del,idvn,idcn,1))
% else negf multf(spweight,extract_delt(del,idvn,idcn,1))
% else
if !*exdelt then
if bool then
multf(spweight,extract_delt(del,idvn,idcn,'full))
else negf multf(spweight,extract_delt(del,idvn,idcn,'full))
else
if length idvn=1 then
if bool then
multf(spweight,
!*k2f(find_name('delta) . append(lowerind_lst idvn,idcn)))
else
negf multf(spweight,
!*k2f(find_name('delta) . append(lowerind_lst idvn,idcn)))
else
if bool then
multf(spweight,!*k2f(del . append(lowerind_lst idvn ,idcn)))
else
multf(spweight,negf
!*k2f(del . append(lowerind_lst idvn , idcn)))
end;
symbolic procedure simpdelnum(idvn,idcn,bool);
% simplification of 'DEL' when all indices are numeric.
if idvn=idcn then
if bool then 1
else -1
else 0;
symbolic procedure extract_delt(del,idvn,idcn,depth);
% we deal with already ordered lists. Numeric indices
% come first like (!1 !2 a). So, extraction is done from
% the left because the result simplify more.
if length idcn =1 then
apply2(function simpdelt,
get('delta,'name) . lowerind car idvn . car idcn . nil,nil)
else
begin scalar uu,x,ind;
ind:=car idcn;
idcn:=cdr idcn;
if depth =1 then
for i:=1:length idvn do
<<x:=multf(exptf(-1,i-1),
multf(apply2(function simpdelt,
get('delta,'name) . (ind . list lowerind nth(idvn,i)),nil),
!*q2f mksq((if length idvn=2 then get('delta,'name)
else del) . append(idcn,
lowerind_lst remove(idvn,i)),1)
)
);
uu:=addf(x,uu)
>>
else
if depth='full then
for i:=1:length idvn do
<<x:= multf(exptf(-1,i-1),
multf(apply2(function simpdelt,
get('delta,'name) . (ind . list lowerind nth(idvn,i)),nil),
extract_delt(del,remove(idvn,i),idcn,depth)
)
);
uu:=addf(x,uu)
>>;
return uu
end;
symbolic procedure idx_not_member_whosp u;
% u is an index
(if x then x neq 'wholespace) where x=get(u,'space);
symbolic procedure ids_not_member_whosp u;
% U is a list of indices.
if null u then t
else
if idx_not_member_whosp car u then ids_not_member_whosp cdr u
else nil;
symbolic procedure simpeta u;
% u is a list {<tensor> indices}
% for instance tt(a b) or tt(a -b) or tt(-a,-b)
% result is the simplified form of the Minkowski metric tensor.
if (!*onespace and signat!*=0)
then msgpri(nil,nil,
"signature must be defined equal to 1 for ETA tensor",nil,t)
else
if
(null !*onespace and null get_sign_space get(car u,'belong_to_space))
then
msgpri(nil,nil,
"ETA tensor not properly assigned to a space",nil,nil)
else
begin scalar eta,ind,x;
eta := car u; ind:= cdr u;
flag(list eta,'symmetric);
x:=split_cov_cont_ids ind;
if car x and cadr x then return
apply2('simpdelt,find_name('delta) . ind,nil);
% Now BOTH indices are up or down, so
x:=if null car x then cadr x else car x;
if length x neq 2 then
rerror(cantens,8, "bad choice of indices for ETA tensor");
x:=for each y in x collect !*id2num y;
return if numlis x then num_eta x
else
if !*onespace then !*k2f(eta . ordn ind)
else
if ids_not_member_whosp {car ind,cadr ind} and
get(car ind,'space) neq get(cadr ind,'space) then 0
else !*k2f(eta . ordn ind)
end;
symbolic procedure num_eta u;
% u is the list of covariant or contravariant indices of ETA.
if car u = cadr u then
if car u = 0 then sgn!*
else negf sgn!*
else 0;
symbolic procedure simpepsi u;
% Simplification procedure for the epsilon tensor.
begin scalar epsi,ind,x,spx,bool;
epsi := car u;
% spx is the space epsi belongs to.
% so we can define SEVERAL epsi tensors.
spx:= get(epsi,'belong_to_space); % In case several spaces are used.
% otherwise it is nil
ind:= cdr u;
flag(list epsi,'antisymmetric);
x:=split_cov_cont_ids ind;
if null car x then x:='cont . cadr x
else
if null cadr x then x:= 'cov . car x
else
x:= 'mixed . append(car x, cadr x);
% If the space has a definite dimension we must take care of the number
% of indices:
(if fixp y and y neq length cdr x then
rerror(cantens,9,
list("bad number of indices for ", list car u," tensor"))
)where y= if spx then get_dim_space spx
else (if fixp z then z)where z=wholespace_dim '?;
if repeats x then return 0;
% if null !*onespace then one must verify that all
% indices belong to the same space as epsi.
if null !*onespace and spx then
if null ind_same_space_tens(cdr u,car u) then
rerror(cantens,9, list("some indices are not in the space of",epsi));
return
if car x eq 'mixed or not num_indlistp cdr x then
begin scalar xx,xy;
xx:=ordn ind;
bool:=permp!:(xx,ind);
if car x eq 'mixed then
<<xy:=cont_before_cov ind;
if null permp!:(xy,xx) then bool:=not bool>>;
return if bool then
!*k2f(epsi . if car x eq 'mixed then
xy else xx)
else negf !*k2f(epsi . if car x eq 'mixed then
xy else xx)
end
else
% cases where all indices are numeric ones must be handled separately
% Take the case where either no space is defined or declared. Then
% space is euclidean.
% look out ! spx is EUCLIDEAN by default. To avoid it, use
% 'make_tensor_belong_space'.
if !*onespace or null spx then
if signat!* =0 then num_epsi_euclid(x)
else
if signat!* =1 then num_epsi_non_euclid (epsi,x)
else nil
else
if null get_sign_space spx or get_sign_space spx=0
then num_epsi_euclid (cdr x)
else
if get_sign_space spx =1 then num_epsi_non_euclid (epsi,x)
else
"undetermined signature or signature bigger then 1";
end;
symbolic procedure num_epsi_non_euclid(epsi,ind);
% epsi is the name of the epsilon tensor
% ind is the list (cont n1 n2 nk) or (cov n1 n2 .. nk)
% result is either 0 OR +- (epsi 0 1 2 .... k))
% i.e. in terms of contravariant indices.
% So, in case of covariant indices we must take care of the
% product eta(0,0)*... *eta(spx,spx) and the convention
% sgn!* enters the game.
begin scalar x;
x:=ordn cdr ind;
return if car ind eq 'cont then
(if y then y
else if permp!:(x,cdr ind) then !*k2f(epsi . x)
else negf !*k2f(epsi . x))where
y=!*q2f match_kvalue(epsi,x,nil)
else
if car ind eq 'cov then
if sgn!* = 1 then
if evenp length cdr x then
(if y then y
else if permp!:(x,cdr ind) then !*k2f(epsi . x)
else negf !*k2f(epsi . x))where
y=!*q2f match_kvalue(epsi,x,nil)
else
(if y then negf y
else if permp!:(x,cdr ind) then negf !*k2f(epsi . x)
else !*k2f(epsi . x))where
y=!*q2f match_kvalue(epsi,x,nil)
else
if sgn!* =-1 then
(if y then negf y
else if permp!:(x,cdr ind) then negf !*k2f(epsi . x)
else !*k2f(epsi . x))where
y=!*q2f match_kvalue(epsi,x,nil)
else nil
else nil;
end;
flag({'show_epsilons},'opfn);
symbolic procedure show_epsilons();
(if null x then {'list}
else 'list . for each y in x collect
list('list,mk!*sq !*k2q car y,mk!*sq !*k2q cdr y))where x=epsilon!*;
symbolic procedure match_kvalue(te,ind,varl);
% te is a tensor, result is nil or a standard form.
% Must return a standard quotient.
(if x then simp!* cadr x)where
x= if varl then
assoc(te . varl . ind,get(te,'kvalue))
else assoc(te . ind,get(te,'kvalue));
symbolic procedure num_epsi_euclid(ind);
% ind is the list (i1, ...,in), therefore
% here epsi(1,2, n)=1=epsi(-1,-2, ... -n)
begin scalar x;
x:=ordn ind;
return if permp!:(x,ind) then 1
else -1
end;
symbolic procedure simpmetric(u,var);
% generic definition of the metric tensor
% covers the possibility of several spaces.
% may depend of any number of variables if needed.
% 'var' is {x1, .. xn}.
% receives an SF and sends back an SQ.
% CORRECTED
begin scalar g,ind,x;
if x:=opmtch u then return simp x;
g:=car u; ind:=cdr u;
flag(list g,'symmetric);
x:=split_cov_cont_ids ind;
if car x and cadr x then return
apply2('simpdelt,find_name('delta) . ind,nil) ./ 1;
% Now BOTH indices are up or down, so
x:=if null car x then cadr x else car x;
if length x neq 2 then
rerror(cantens,10, "bad choice of indices for a METRIC tensor");
% case of numeric indices.
x:=for each y in x collect !*id2num y;
return if numlis x then
if !*onespace then
if x:= match_kvalue(g,ordn ind,var) then x
else !*k2f(g . if var then var . ordn ind
else ordn ind) ./ 1
else mult_spaces_num_metric(g,ind,var) ./ 1
else
if !*onespace then
if x:= match_kvalue(g,ordn ind,var) then x
else !*k2f(g . if var then var . ordn ind
else ordn ind) ./ 1
else
if get(car ind,'space) neq get(cadr ind,'space) then 0
else
if x:= match_kvalue(g,ordn ind,var) then x
else !*k2f(g . if var then var . ordn ind
else ordn ind) ./ 1
end;
symbolic procedure mult_spaces_num_metric(g,ind,var);
% g, is the name of the metric tensor
% ind its numeric indices (both covariant or contravariant)
begin scalar x,y;
x:=if pairp car ind then raiseind_lst ind else ind;
return
if numindxl!* and null numids2_belong_same_space(car x,cadr x,g) then 0
else
if y:= match_kvalue(g,if var then var . ordn ind
else ordn ind,var) then y
else !*k2f(g . if var then var . ordn ind
else ordn ind)
end;
endmodule;
end;