matrix.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
class MAT_FLTD
class MAT_FLTD is
include MAT_RING{FLTD};
include MAT_FIELD{FLTD} setPivotC->setPivot;
create(r,c:CARD):SAME is
return create(r,c,1.0d);
end;
end;
class MAT_RAT
class MAT_RAT is
include MAT_RING{RAT};
include MAT_FIELD{RAT} setPivotD->setPivot;
create(r,c:CARD):SAME is
return create(r,c,#RAT(1.inti));
end;
end;
class MAT_INTI
class MAT_INTI is
include MAT_RING{INTI};
include DET_PRIMITIVE_ALG{INTI} det->det_p;
include MAT_PID{INTI};
include MAT_PID_DET{INTI};
include MAT_EIGEN{INTI,POLYS_INTI,MAT_POLYS_INTI};
create(r,c:CARD):SAME is
return create(r,c,1.inti);
end;
det:INTI is
d:RAT:=mat_rat.det;
if d.is_int.not then #OUT+"det error: det is not inti\n"; end;
return d.inti;
end;
mat_rat:MAT_RAT is
matr:MAT_RAT:=#(nr,nc);
loop i::=m.ind!; loop j::=m[i].ind!;
matr.m[i][j]:=#RAT(m[i][j]);
end; end;
return matr;
end;
mat_fltd:MAT_FLTD is
matf:MAT_FLTD:=#(nr,nc);
loop i::=m.ind!; loop j::=m[i].ind!;
matf.m[i][j]:=m[i][j].fltd;
end; end;
return matf;
end;
row_mod(i:CARD, n:INTI) is
loop j::=m[i].ind!; m[i][j]:=m[i][j]%n; end;
end;
col_mod(j:CARD, n:INTI) is
loop i::=m.ind!; m[i][j]:=m[i][j]%n; end;
end;
end;
partial class MAT_RING{ET}
partial class MAT_RING{ET} is
-- matrix of element ring ET.
-- index: [0..nr-1][0..nc-1]
attr nr:CARD; -- row
attr nc:CARD; -- column
attr m:ARRAY{ARRAY{ET}};
shared r_1:ET;
shared r_0:ET;
create(r,c:CARD, r_one:ET):SAME
is
-- Create a matrix with r rows and c columns
res:SAME:=new;
res.nr:=r; res.nc:=c; res.r_1:=r_one; res.r_0:=r_one-r_one;
res.m:=#(r); loop i::=res.m.ind!; res.m[i]:=#(c); end;
return(res);
end;
create(r,c:INT, r_one:ET):SAME is
return create(r.card,c.card,r_one);
end;
create(arg:SAME):SAME pre ~void(arg) is
-- Creates a new matrix with the same dimensions.
res:SAME:=create(arg.nr, arg.nc, arg.r_1); return res;
end;
has_ind(i,j:CARD):BOOL is
-- return (m.has_ind(i) and m[i].has_ind(j));
return (i<nr)and (j<nc);
end;
has_ind(i,j:INT):BOOL is
-- return (m.has_ind(i) and m[i].has_ind(j));
return (i.is_non_neg and(i<nr.int)and j.is_non_neg and(j<nc.int));
end;
resize(nr1,nc1:CARD):SAME is
res:SAME:=#(nr1,nc1,r_1); res.clear;
loop i::=res.m.ind!;
loop j::=res.m[i].ind!;
if has_ind(i,j) then res.m[i][j]:=m[i][j];
else res.m[i][j]:=r_0;
end;
end;
end;
return res;
end;
aget(i1,i2:CARD):ET pre has_ind(i1,i2) is
-- The element with indices `[i1,i2]'.
return(m[i1][i2]);
end;
aget(i1,i2:INT):ET is
-- The element with indices `[i1,i2]'.
return aget(i1.card, i2.card);
end;
aset(i1,i2:CARD,val:ET) pre has_ind(i1,i2) is
-- Set the element with indices `[i1,i2]' to val.
m[i1][i2]:=val;
end;
aset(i1,i2:INT,val:ET) is
-- Set the element with indices `[i1,i2]' to val.
aset(i1.card,i2.card,val);
end;
aget(i1:CARD):ARRAY{ET} pre m.has_ind(i1) is
-- The array with index `[i1]'.
return(m[i1]);
end;
aget(i1:INT):ARRAY{ET} pre m.has_ind(i1.card) is
-- The array with index `[i1]'.
return (m[i1]);
end;
aset(i1:CARD,val:ARRAY{ET}) pre (val.size=nc) is
-- Set row with index `[i1]' to val.
m[i1]:=val;
end;
aset(i1:INT,val:ARRAY{ET}) pre (val.size=nc) is
-- Set row with index `[i1]' to val.
m[i1]:=val;
end;
copy:SAME is
res:SAME:=#(self);
loop i::=m.ind!; res.m[i]:=m[i].copy; end;
return res;
end;
clear is
-- in place
-- make zero matrix
loop i::=m.ind!; loop m[i].set!(r_0); end; end;
end;
to_diagonal(d:ARRAY{ET}) is
-- in place
-- make diagonal matrix with values from "d".
if (d.size>nr)or(d.size>nc) then
w:SAME:=#(d.size.max(nr),d.size.max(nc));
m:=w.m; nr:=w.nr; nc:=w.nc;
end;
clear; loop i::=d.ind!; m[i][i]:=d[i]; end;
end;
to_unit is
-- in place
-- make unit matrix
clear; loop i::=0.up!; while!(i<(nr.min(nc))); m[i][i]:=r_1; end;
end;
unit(r,c:CARD):SAME is
-- unit matrix of (r,c)
a:SAME:=#(r,c); a.to_unit; return a;
end;
trace:ET is
w:ET:=r_0; loop i::=0.up!; while!(i<(nr.min(nc))); w:=w+m[i][i]; i:=i+1; end;
return w;
end;
diagonal:ARRAY{ET} is
arr:ARRAY{ET}:=#(nr.min(nc));
loop i::=arr.ind!; arr[i]:=m[i][i]; end;
return arr;
end;
negate:SAME is
res:SAME:=#(self);
loop i::=m.ind!; loop j::=m[i].ind!;
res.m[i][j]:=-m[i][j];
end; end;
return res;
end;
negate is
-- in place
loop i::=m.ind!; loop j::=m[i].ind!;
m[i][j]:=-m[i][j];
end; end;
end;
trans:SAME is
-- transpose
res:SAME:=#(nc,nr,r_1);
loop i::=m.ind!; loop j::=m[i].ind!;
res.m[j][i]:=m[i][j];
end; end;
return res;
end;
trans is
-- in place
-- transpose
res:SAME:=#(nc,nr,r_1);
loop i::=m.ind!; loop j::=m[i].ind!;
res.m[j][i]:=m[i][j];
end; end;
nr:=res.nr; nc:=res.nc; m:=res.m;
end;
swap_row(i1,i2:CARD) is
-- in place
if i1=i2 then return; end;
tmp::=m[i1]; m[i1]:=m[i2]; m[i2]:=tmp;
end;
swap_col(j1,j2:CARD) is
-- in place
if j1=j2 then return; end;
loop i::=m.ind!;
tmp::=m[i][j1]; m[i][j1]:=m[i][j2]; m[i][j2]:=tmp;
end;
end;
swap_col(j1,j2:CARD, i_start, i_end:CARD) is
-- in place
if j1=j2 then return; end;
loop i::=i_start.upto!(i_end);
tmp::=m[i][j1]; m[i][j1]:=m[i][j2]; m[i][j2]:=tmp;
end;
end;
col_plus_scaled_col(j0,j1:CARD, c:ET) is
-- in place
-- m[*,j0]=m[*,j0]+c*m[*,j1]
loop i::=m.ind!; m[i][j0]:=m[i][j0]+c*m[i][j1]; end;
end;
row_plus_scaled_row(i0,i1:CARD, c:ET) is
-- in place
-- m[i0,*]=m[i0,*]+c*m[i1,*]
loop j::=m[i1].ind!; m[i0][j]:=m[i0][j]+c*m[i1][j]; end;
end;
plus(o:SAME):SAME pre (nr=o.nr)and(nc=o.nc) is
-- self + o
res:SAME:=#(self);
loop i::=m.ind!; loop j::=m[i].ind!;
res.m[i][j]:=m[i][j]+o.m[i][j];
end; end;
return res;
end;
plus(o:SAME) pre (nr=o.nr)and(nc=o.nc) is
-- in place
-- self:=self + o
loop i::=m.ind!; loop j::=m[i].ind!;
m[i][j]:=m[i][j]+o.m[i][j];
end; end;
end;
plus(o:SAME, r_ofs:CARD, c_ofs:CARD) pre (nc>=o.nc+c_ofs)and(nr>=o.nr+r_ofs) is
-- in place
-- plus with offset.
loop i::=o.m.ind!; loop j::=o.m[i].ind!;
m[i+r_ofs][j+c_ofs]:=m[i+r_ofs][j+c_ofs]+o.m[i][j];
end; end;
end;
minus(o:SAME, r_ofs:CARD, c_ofs:CARD) pre (nc>=o.nc+c_ofs)and(nr>=o.nr+r_ofs) is
-- in place
-- minus with offset
loop i::=o.m.ind!; loop j::=o.m[i].ind!;
m[i+r_ofs][j+c_ofs]:=m[i+r_ofs][j+c_ofs]-o.m[i][j];
end; end;
end;
minus(o:SAME):SAME pre (nr=o.nr)and(nc=o.nc) is
-- self-o
res:SAME:=#(self);
loop i::=m.ind!; loop j::=m[i].ind!;
res.m[i][j]:=m[i][j]-o.m[i][j];
end; end;
return res;
end;
minus(o:SAME) pre (nr=o.nr)and(nc=o.nc) is
-- in place
-- self:=self-o
loop i::=m.ind!; loop j::=m[i].ind!;
m[i][j]:=m[i][j]-o.m[i][j];
end; end;
end;
minus_arg(arg:SAME) pre (nr=arg.nr)and(nc=arg.nc) is
-- in place
-- self:=arg-self
loop i::=m.ind!; loop j::=m[i].ind!;
m[i][j]:=arg.m[i][j]-m[i][j];
end; end;
end;
times(o:SAME):SAME pre (nc=o.nr) is
res:SAME:=#(nr,o.nc,r_1);
loop i::=m.ind!;
loop j::=res.m[i].ind!;
res.m[i][j]:=r_0;
loop k::=o.m.ind!;
res.m[i][j]:=res.m[i][j]+m[i][k]*o.m[k][j];
end;
end;
end;
return res;
end;
times(o:SAME) pre (nc=o.nr) is
-- in place
w:ARRAY{ET}:=#(nc);
loop i::=m.ind!;
w:=m[i]; m[i]:=#(o.nc);
loop j::=m[i].ind!;
m[i][j]:=r_0;
loop k::=w.ind!;
m[i][j]:=m[i][j]+w[k]*o.m[k][j];
end;
end;
end;
nc:=o.nc;
end;
times(a:SAME, shift:CARD) pre (a.nr>=a.nc)and(shift+a.nr<=nc) is
-- in place
-- self = self*(a,shift)
-- the argument "a,shift" means:
-- | E 0 0 | -- diagonal of size of "shift"
-- | 0 a 0 | -- arg.
-- | 0 0 E | -- rest
if a.nr<=0 then return; end;
w:ARRAY{ET}:=#(nc);
loop i::=m.ind!;
loop j::=shift.upto!(shift+a.nc-1); w[j]:=r_0; end;
loop sk::=a.m.ind!; k::=sk+shift;
loop sj::=a.m[sk].ind!; j::=sj+shift;
w[j]:=w[j]+m[i][k]*a.m[sk][sj];
end;
end;
loop j::=shift.upto!(shift+a.nc-1); m[i][j]:=w[j]; end;
end;
end;
times_arg(a:SAME, shift:CARD) pre (a.nr<=a.nc)and(shift+a.nc<=nr) is
-- in place
-- self = (a,shift)*self
-- the argument "a,shift" means:
-- | E 0 0 | -- diagonal of size of "shift"
-- | 0 a 0 | -- arg.
-- | 0 0 E | -- rest
if a.nr<=0 then return; end;
w:ARRAY{ET}:=#(nr);
loop j::=m[0].ind!;
loop i::=shift.upto!(shift+a.nr-1); w[i]:=r_0; end;
loop sk::=a.m[0].ind!; k::=sk+shift;
loop si::=a.m.ind!; i::=si+shift;
w[i]:=w[i]+a.m[si][sk]*m[k][j];
end;
end;
loop i::=shift.upto!(shift+a.nr-1); m[i][j]:=w[i]; end;
end;
end;
times_trans(o:SAME):SAME pre (nc=o.nc) is
-- self*(o.trans)
res:SAME:=#(nr,o.nr,r_1);
loop i::=m.ind!;
loop j::=o.m.ind!;
res.m[i][j]:=r_0;
loop k::=m[i].ind!;
res.m[i][j]:=res.m[i][j]+m[i][k]*o.m[j][k];
end;
end;
end;
return res;
end;
times_trans(o:SAME) pre (nc=o.nc) is
-- in place
-- self:=self*(o.trans)
w:ARRAY{ET}:=#(nc);
loop i::=m.ind!;
w:=m[i]; m[i]:=#(o.nr);
loop j::=o.m.ind!;
m[i][j]:=r_0;
loop k::=w.ind!;
m[i][j]:=m[i][j]+w[k]*o.m[j][k];
end;
end;
end;
nc:=o.nc;
end;
times(o:ET):SAME is
res:SAME:=#(self);
loop i::=m.ind!; loop j::=m[i].ind!;
res.m[i][j]:=m[i][j]*o;
end; end;
return res;
end;
times(o:ET) is
-- in place
loop i::=m.ind!; loop j::=m[i].ind!;
m[i][j]:=m[i][j]*o;
end; end;
end;
minor_matrix_row(ip:CARD):SAME pre ip<nr is
-- remove row [ip].
res:SAME:=#(nr-1,nc,r_1);
loop i::=m.ind!;
if i/=ip then i1::=0.up!; res.m[i1]:=m[i].copy; end;
end;
return res;
end;
minor_matrix_column(jp:CARD):SAME pre jp<nc is
-- remove column [jp].
res:SAME:=#(nr,nc-1,r_1);
loop i::=m.ind!;
i1::=0.up!;
loop j::=m[i].ind!;
if j/=jp then j1::=0.up!;
res.m[i1][j1]:=m[i][j];
end;
end;
end;
return res;
end;
minor_matrix(ip,jp:CARD):SAME pre has_ind(ip,jp) is
-- remove row [ip] and column [jp].
res:SAME:=#(nr-1,nc-1,r_1);
loop i::=m.ind!;
if i/=ip then i1::=0.up!;
loop j::=m[i].ind!;
if j/=jp then j1::=0.up!;
res.m[i1][j1]:=m[i][j];
end;
end;
end;
end;
return res;
end;
minor(ip,jp:CARD):ET pre has_ind(ip,jp) and (nr=nc) is
-- assume the matrix is square(nr=nc)
return minor_matrix(ip,jp).det;
end;
cofactor(ip,jp:CARD):ET pre has_ind(ip,jp)and(nr=nc) is
-- return -minor(ip,jp) if ip+jp odd
-- minor(ip,jp) if ip+jp even
if (ip+jp).is_odd then return -minor(ip,jp);
else return minor(ip,jp);
end;
end;
sub_matrix(ci,cj:ARRAY{CARD}):SAME pre (ci.size<=nr)and(cj.size<=nc) is
-- sub-matrix with combination(selection)
-- ci[] for row {0..nr-1} and cj[] for column {0..nc-1}
res:SAME:=#(ci.size,cj.size,r_1);
loop i0::=ci.elt!; i1::=0.up!;
loop j0::=cj.elt!; j1::=0.up!;
res.m[i1][j1]:=m[i0][j0];
end;
end;
return res;
end;
str:STR is
return m.str;
end;
str_pmatrix:STR is
-- TeX \pmatrix{ }. v:var name
s::="";
s:=s+"\pmatrix{\n";
loop i::=m.ind!;
loop j::=m[i].ind!;
if j>0 then s:=s+" & "; end;
s:=s+m[i][j].str;
end;
s:=s+" \\cr";
-- if i<nr-1 then s:=s+"\\\\"; end;
s:=s+"\n";
end;
s:=s+"}\n";
return s;
end;
str_latex_array:STR is
-- LaTeX array. v:var name
s::="";
s:=s+"\\left(\n";
s:=s+"\\begin{array}{"; loop nc.times!; s:=s+"c"; end; s:=s+"}\n";
loop i::=m.ind!;
loop j::=m[i].ind!;
if j>0 then s:=s+" & "; end;
s:=s+m[i][j].str;
end;
--s:=s+"\\cr"
if i<nr-1 then s:=s+" \\\\"; end;
s:=s+"\n";
end;
s:=s+"\\end{array}\n";
s:=s+"\\right)\n";
return s;
end;
strTeX:STR is
return str_pmatrix;
end;
end; -- class MAT_RING
partial class DET_PRIMITIVE_ALG{ET}
partial class DET_PRIMITIVE_ALG{ET} is
det:ET is
-- Use when cannot work Gaussian algorithm.
-- i.e. "ET" is not a field
return det_primitive;
end;
private shared det_primitive_d:ET;
private det_primitive_r(i:CARD,jpiv:ARRAY{CARD},d:ET) is
if jpiv.size=3 then
--#OUT+"det_primitive_r:3\n";
det_primitive_d:=det_primitive_d
+d*(
m[i][jpiv[0]]*(m[i+1][jpiv[1]]*m[i+2][jpiv[2]]
-m[i+1][jpiv[2]]*m[i+2][jpiv[1]])
-m[i][jpiv[1]]*(m[i+1][jpiv[0]]*m[i+2][jpiv[2]]
-m[i+1][jpiv[2]]*m[i+2][jpiv[0]])
+m[i][jpiv[2]]*(m[i+1][jpiv[0]]*m[i+2][jpiv[1]]
-m[i+1][jpiv[1]]*m[i+2][jpiv[0]])
);
elsif jpiv.size>3 then
--#OUT+"det_primitive_r:"+jpiv.size.str+"\n";
d1::=d;
loop j::=jpiv.ind!;
if m[i][jpiv[j]]/=r_0 then
jpiv1::=jpiv.slice(0,j);
if j+1<jpiv.size then
jpiv1:=jpiv1.append(jpiv.slice(j+1,jpiv.size-j-1));
end;
det_primitive_r(i+1,jpiv1,d1*m[i][jpiv[j]]);
end;
d1:=d1.negate;
end;
elsif jpiv.size=2 then
det_primitive_d:=det_primitive_d
+d*(m[i][jpiv[0]]*m[i+1][jpiv[1]]
-m[i][jpiv[1]]*m[i+1][jpiv[0]]);
elsif jpiv.size=1 then
det_primitive_d:=det_primitive_d+d*m[i][jpiv[0]];
end;
end;
det_primitive:ET pre nr=nc is
-- Use when cannot work Gaussian algorithm. __very slow__
if nr=0 then return r_1;
elsif nr=1 then det_primitive_d:=m[0][0];
elsif nr=2 then
det_primitive_d:=m[0][0]*m[1][1]-m[0][1]*m[1][0];
elsif nr=3 then
det_primitive_d:=
m[0][0]*(m[1][1]*m[2][2]-m[1][2]*m[2][1])
-m[0][1]*(m[1][0]*m[2][2]-m[1][2]*m[2][0])
+m[0][2]*(m[1][0]*m[2][1]-m[1][1]*m[2][0]);
else
jpiv:ARRAY{CARD}:=#(nc); loop j::=jpiv.ind!; jpiv[j]:=j; end;
det_primitive_d:=r_0;
det_primitive_r(0,jpiv,r_1);
end;
return det_primitive_d;
end;
end; -- DET_PRIMITIVE_ALG
partial class MAT_PID{ET}
partial class MAT_PID{ET} is
-- matrix over ring PID
-- ET needs div,mod, is_lt ,abs
-- c.f CovPrim::Solve
end;
partial class MAT_PID_DET{ET}
partial class MAT_PID_DET{ET} is
-- matrix over ring PID
shared jPivot:ARRAY{CARD};
shared iPivot:ARRAY{CARD};
initPivot is
iPivot:=#(nr); loop i::=iPivot.ind!; iPivot[i]:=i; end;
jPivot:=#(nc); loop j::=jPivot.ind!; jPivot[j]:=j; end;
end;
private SetPivot_set(p0,ip,jp:CARD) is
tmp:CARD;
tmp:=iPivot[ip]; iPivot[ip]:=iPivot[p0]; iPivot[p0]:=tmp;
tmp:=jPivot[jp]; jPivot[jp]:=jPivot[p0]; jPivot[p0]:=tmp;
end;
SetPivot(p0:CARD, nc1:CARD):BOOL is
-- Set Pivot,iPivot,jPivot
-- "is_lt" "abs" is needed
ip::=p0; jp::=p0;
Pivot::=m[iPivot[p0]][jPivot[p0]];
if (Pivot*Pivot/=r_1) then
loop i::=p0.upto!(nr-1); cv1::=m[iPivot[i]];
loop j::=p0.upto!(nc1-1);
if (cv1[jPivot[j]]/=r_0)and
((cv1[jPivot[j]].abs<Pivot.abs)or(Pivot=r_0))
then ip:=i; jp:=j;
Pivot:=cv1[jPivot[jp]];
if (Pivot*Pivot=r_1) then -- Pivot is unit
SetPivot_set(p0,ip,jp);
return (Pivot/=r_0);
end;
end;
end;
end;
end;
SetPivot_set(p0,ip,jp);
return (Pivot/=r_0);
end;
SetPivot(p0:CARD):BOOL is
return SetPivot(p0,nc);
end;
-- Pivot m[iPivot[p0],jPivot[p0]]
SubC(p0,i:CARD) is
ip::=iPivot[p0]; jp::=jPivot[p0];
cv0::=m[ip]; cv1::=m[iPivot[i]];
q::=cv1[jp]/cv0[jp];
j1:CARD;
if q=r_1 then
loop j::=p0.upto!(nc-1); j1:=jPivot[j];
if cv0[j1]/=r_0 then cv1[j1]:=cv1[j1]-cv0[j1]; end;
end;
elsif q=-r_1 then
loop j::=p0.upto!(nc-1); j1:=jPivot[j];
if cv0[j1]/=r_0 then cv1[j1]:=cv1[j1]+cv0[j1]; end;
end;
else
loop j::=p0.upto!(nc-1); j1:=jPivot[j];
if cv0[j1]/=r_0 then cv1[j1]:=cv1[j1]-q*cv0[j1]; end;
end;
end;
end;
SubL(p0,j:CARD) is
ip::=iPivot[p0]; jp::=jPivot[p0];
cv1:ARRAY{ET};
j1::=jPivot[j];
q::=m[ip][j1]/m[ip][jp];
if q=r_1 then
loop i::=p0.upto!(nr-1); cv1:=m[iPivot[i]];
if cv1[jp]/=r_0 then cv1[j1]:=cv1[j1]-cv1[jp]; end;
end;
elsif q=-r_1 then
loop i::=p0.upto!(nr-1); cv1:=m[iPivot[i]];
if cv1[jp]/=r_0 then cv1[j1]:=cv1[j1]+cv1[jp]; end;
end;
else
loop i::=p0.upto!(nr-1); cv1:=m[iPivot[i]];
if cv1[jp]/=r_0 then cv1[j1]:=cv1[j1]-q*cv1[jp]; end;
end;
end;
end;
CheckZero(p0:CARD):BOOL is
i1::=iPivot[p0]; j1::=jPivot[p0];
loop i::=(p0+1).upto!(nr-1);
if m[iPivot[i]][j1]/=r_0 then return false; end;
end;
loop j::=(p0+1).upto!(nc-1);
if m[i1][jPivot[j]]/=r_0 then return false; end;
end;
return true;
end;
SolveD is
-- make diagonal
initPivot;
Pivot:ET:=r_1;
ip,jp:CARD;
dim::= nr.min(nc);
loop p0::=0.upto!(dim-1);
--#OUT+"SolveD: p0="+p0.str+"\n";
loop
if ~ SetPivot(p0) then break!; end;
ip:=iPivot[p0]; jp:=jPivot[p0]; Pivot:=m[ip][jp];
--#OUT+"SolveD: m="+m.str+"\n";
--#OUT+"SolveD: ip,jp="+ip+","+jp+"\n";
loop i::=(p0+1).upto!(nr-1);
if m[iPivot[i]][jp]/=r_0 then SubC(p0,i); end;
end;
if (Pivot*Pivot=r_1) then
loop j::=(p0+1).upto!(nc-1); m[ip][jPivot[j]]:=r_0; end;
break!;
elsif CheckZero(p0) then break!;
end;
if ~ SetPivot(p0) then break!; end;
ip:=iPivot[p0]; jp:=jPivot[p0]; Pivot:=m[ip][jp];
loop j::=(p0+1).upto!(nc-1);
if m[ip][jPivot[j]]/=r_0 then SubL(p0,j); end;
end;
if (Pivot*Pivot=r_1) then
loop i::=(p0+1).upto!(nr-1);
m[iPivot[i]][jp]:=r_0;
end;
break!;
elsif CheckZero(p0) then break!;
end;
end;
end;
-- PrintRelation;
end;
reduce(out jpivot:ARRAY{CARD},out rDeg:CARD) is
SolveD;
work::=m.copy;
loop p::=0.upto!(nr-1); m[p]:=work[iPivot[p]]; end;
jpivot:=jPivot.copy;
rDeg:=nr;
end;
det:ET pre nr=nc is
-- destructive
SolveD;
d::=r_1; loop p::=0.upto!(nr-1); d:=d*m[iPivot[p]][jPivot[p]]; end;
if #PERM(jPivot,0).sgn=#PERM(jPivot,0).sgn then return d; else return -d; end;
end;
printRelation is
-- for Homology
#OUT+"relation matrix:\n";
loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1);
#OUT+m[iPivot[i]][jPivot[j]].str+" ";
end; #OUT+"\n"; end;
end;
SolveH(inout Group:ARRAY{ET}) is
-- for Homology
SolveD;
z:ET;
Group:=#;
loop p::=0.upto!(nc-1);
if p<nr then z:=m[iPivot[p]][jPivot[p]]; else z:=r_0; end;
-- z:=z.abs
if (z/=r_1)and(z/=-r_1) then Group:=Group.append(|z|); end;
end;
end;
SolveL(jDeg:CARD, inout Rank:CARD, inout ipivot, inout jpivot, inout i_set:ARRAY{CARD}) is
-- for covering linkage
iPivot:=ipivot.copy; jPivot:=jpivot.copy;
pFlg:BOOL;
loop p0::=0.upto!(Rank-1);
loop
pFlg:=true;
if SetPivot(p0,jDeg) then
i_set[jPivot[p0]]:=iPivot[p0];
loop i::=(p0+1).upto!(nr-1);
if (i/=p0)and(m[iPivot[i]][jPivot[p0]]/=r_0) then
SubC(p0,i);
pFlg:=pFlg and(m[iPivot[i]][jPivot[p0]]=r_0);
end;
end;
else Rank:=p0; ipivot:=iPivot.copy; jpivot:=jPivot.copy;
return;
end;
until!( pFlg); -- CheckZero
end;
end;
ipivot:=iPivot.copy; jpivot:=jPivot.copy;
end;
end;
partial class MAT_FIELD{ET}
partial class MAT_FIELD{ET} is
-- field element
setPivotC(k:CARD,inout iPivot:ARRAY{CARD}) is
-- Rename setPivot for "continuous field".
-- set pivot as maximal element
-- e.g. FLTD, CPXD
-- need "abs"
i:CARD:=k; i1,i2:CARD;
loop j:CARD:=(k+1).upto!(nr-1);
if ((m[iPivot[j]][k].abs)>(m[iPivot[i]][k].abs)) then i:=j; end;
end;
j::=iPivot[k]; iPivot[k]:=iPivot[i]; iPivot[i]:=j;
end;
setPivotD(k:CARD,inout iPivot:ARRAY{CARD}) is
-- Rename setPivot for "discrete field".
-- e.g. finite field Zp, RAT(in the sense of no-error)
i::=k; j:CARD;
loop j:=(k+1).upto!(nr-1);
if (m[iPivot[j]][k]/=r_0) then i:=j; break!; end;
end;
j:=iPivot[k]; iPivot[k]:=iPivot[i]; iPivot[i]:=j;
end;
LUdec(out iPivot:ARRAY{CARD}) pre nr=nc is
-- destructive
-- c.f. INT calculate version. Homology.MOD
dim::=nr;
Pivot,t:ET;
iPivot:=#(dim); loop k::=iPivot.ind!; iPivot[k]:=k; end;
loop k::=0.up!; while!(k+1<dim);
setPivot(k,inout iPivot);
Pivot:=m[iPivot[k]][k];
if Pivot.abs=r_0 then
-- #OUT+"Too small pivot.\n";
m[iPivot[k]][k]:=r_0;
else
loop i::=(k+1).up!; while!(i<dim) ;
t:=m[iPivot[i]][k]/Pivot;
m[iPivot[i]][k]:=t;
loop j::=(k+1).up!; while!(j<dim) ;
m[iPivot[i]][j]:=m[iPivot[i]][j]-t*m[iPivot[k]][j];
end;
end;
end;
end;
end;
det:ET pre nr=nc is
mat::=copy; return mat.det_destructive;
end;
det_destructive:ET pre nr=nc is
iPivot:ARRAY{CARD};
LUdec(out iPivot);
d:ET:=m[iPivot[0]][0];
loop i::=1.up!; while!(i<nr); d:=d* m[iPivot[i]][i]; end;
if #PERM(iPivot,0).sgn.is_pos then return d; else return -d; end;
end;
end; -- class
partial class MAT_EIGEN{ET,PT,MPT}
partial class MAT_EIGEN{ET,PT,MPT} is
-- characteristic and signature
-- ET: element
-- PT: polynomial of ET coefficient
-- MPT: matrix of PT
--2003 K.Kodama MAT_EIGEN
characteristic_poly:PT is
-- Assume matrix is square.
p:PT;
if nr<1 or nc<1 then p:=PT::one;
elsif nr/=nc then p:=PT::zero; -- not square
else
A:MPT:=#(nr,nc);
loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); A[i][j]:=#PT(m[i][j]); end; end;
loop i::=0.upto!(nr-1); A[i][i]:=A[i][i]-PT::x; end;
p:=A.det_mod_unit;
end;
return p;
end;
signature:INTI is
-- signature = #of_positive_eigen_values - #of_negative_eigen_values.
-- Note that all eigenvalues are real for real symmetric matrix.
p:PT:=characteristic_poly;
sig::= p.countSolution(#ET(0),#ET(0),false,true,true).inti
-p.countSolution(#ET(0),#ET(0),true,false,true).inti;
return sig;
end;
end;