module calimat;
Comment
#######################
# #
# MATRIX SUPPLEMENT #
# #
#######################
Supplement to the REDUCE matrix package.
Matrices are transformed into nested lists of s.q.'s.
end comment;
% ------ The Jacobian matrix -------------
symbolic operator matjac;
symbolic procedure matjac(m,l);
% Returns the Jacobian matrix from the ideal m in prefix form
% (given as an algebraic mode list) with respect to the var. list l.
if not eqcar(m,'list) then typerr(m,"ideal basis")
else if not eqcar(l,'list) then typerr(l,"variable list")
else 'mat . for each x in cdr l collect
for each y in cdr m collect prepsq difff(numr simp reval y,x);
% ---------- Random linear forms -------------
symbolic operator random_linear_form;
symbolic procedure random_linear_form(vars,bound);
% Returns a random linear form in algebraic prefix form.
if not eqcar(vars,'list) then typerr(vars,"variable list")
else 'plus . for each x in cdr vars collect
{'times,random(2*bound)-bound,x};
% ----- Singular locus -----------
symbolic operator singular_locus;
symbolic procedure singular_locus(m,c);
if !*mode='algebraic then
(if not numberp c then
rederr"Syntax : singular_locus(polynomial list, codimension)"
else dpmat_2a singular_locus!*(m,c))
else singular_locus!*(m,c);
symbolic procedure singular_locus!*(m,c);
% m must be a complete intersection of codimension c given as a list
% of polynomials in prefix form. Returns the singular locus computing
% the corresponding jacobian.
matsum!* {dpmat_from_a m, mat2list!* dpmat_from_a
minors(matjac(m,makelist ring_names cali!=basering),c)};
% ------------- Minors --------------
symbolic operator minors;
symbolic procedure minors(m,k);
% Returns the matrix of k-minors of the matrix m.
if not eqcar(m,'mat) then typerr(m,"matrix")
else begin scalar r,c;
m:=for each x in cdr m collect for each y in x collect simp y;
r:=cali_choose(for i:=1:length m collect i,k);
c:=cali_choose(for i:=1:length car m collect i,k);
return 'mat . for each x in r collect for each y in c collect
mk!*sq detq calimat!=submat(m,x,y);
end;
symbolic operator ideal_of_minors;
symbolic procedure ideal_of_minors(m,k);
% The ideal of the k-minors of the matrix m.
if !*mode='algebraic then dpmat_2a ideal_of_minors!*(m,k)
else ideal_of_minors!*(m,k);
symbolic procedure ideal_of_minors!*(m,k);
if not eqcar(m,'mat) then typerr(m,"matrix") else
interreduce!* mat2list!* dpmat_from_a minors(m,k);
symbolic procedure calimat!=submat(m,x,y);
for each a in x collect for each b in y collect nth(nth(m,a),b);
symbolic procedure calimat!=sum(a,b);
for each x in pair(a,b) collect
for each y in pair(car x,cdr x) collect addsq(car y,cdr y);
symbolic procedure calimat!=neg a;
for each x in a collect for each y in x collect negsq y;
symbolic procedure calimat!=tp a;
tp1 append(a,nil); % since tp1 is destructive.
symbolic procedure calimat!=zero!? a;
begin scalar b; b:=t;
for each x in a do for each y in x do b:=b and null car y;
return b;
end;
% -------------- Pfaffians ---------------
symbolic procedure calimat!=skewsymmetric!? m;
calimat!=zero!? calimat!=sum(m,calimat!=tp m);
symbolic operator pfaffian;
symbolic procedure pfaffian m;
% The pfaffian of a skewsymmetric matrix m.
if not eqcar(m,'mat) then typerr(m,"matrix") else
begin scalar m1;
m1:=for each x in cdr m collect for each y in x collect simp y;
if not calimat!=skewsymmetric!? m1
then typerr(m,"skewsymmetic matrix");
return mk!*sq calimat!=pfaff m1;
end;
symbolic procedure calimat!=pfaff m;
if length m=1 then nil . 1
else if length m=2 then cadar m
else begin scalar a,b,p,c,d,ind,sgn;
b:=for each x in cdr m collect cdr x;
a:=cdar m; ind:=for i:=1:length a collect i;
p:=nil . 1;
for i:=1:length a do
<< c:=delete(i,ind); d:=calimat!=pfaff calimat!=submat(b,c,c);
if sgn then d:=negsq d; sgn:=not sgn;
p:=addsq(p,multsq(nth(a,i),d));
>>;
return p;
end;
symbolic operator ideal_of_pfaffians;
symbolic procedure ideal_of_pfaffians(m,k);
% The ideal of the 2k-pfaffians of the skewsymmetric matrix m.
if !*mode='algebraic then dpmat_2a ideal_of_pfaffians!*(m,k)
else ideal_of_pfaffians!*(m,k);
symbolic procedure ideal_of_pfaffians!*(m,k);
% The same, but for a dpmat m.
if not eqcar(m,'mat) then typerr(m,"matrix") else
begin scalar m1,u;
m1:=for each x in cdr m collect for each y in x collect simp y;
if not calimat!=skewsymmetric!? m1
then typerr(m,"skewsymmetic matrix");
u:=cali_choose(for i:=1:length m1 collect i,2*k);
return interreduce!* dpmat_from_a makelist
for each x in u collect
prepsq calimat!=pfaff calimat!=submat(m1,x,x);
end;
endmodule; % calimat
end;