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:INT):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:INT):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}; create(r,c:INT):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.floor; end; mat_rat:MAT_RAT is matr:MAT_RAT:=#(nr,nc); loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); 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::=0.upto!(nr-1); loop j::=0.upto!(nc-1); matf.m[i][j]:=m[i][j].fltd; end; end; return matf; end; row_mod(i:INT, n:INTI) is loop j:INT:=0.upto!(nc-1); m[i][j]:=m[i][j]%n; end; end; col_mod(j:INT, n:INTI) is loop i:INT:=0.upto!(nr-1); 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:INT; -- row attr nc:INT; -- column attr m:ARRAY{ARRAY{ET}}; shared r_1:ET; shared r_0:ET; create(r,c:INT, r_one:ET):SAME pre (r>=0) and (c>=0) 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::=0.upto!(r-1); res.m[i]:=#(c); end; return(res); 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:INT):BOOL is -- return (m.has_ind(i) and m[i].has_ind(j)); return ((0<=i)and(i<nr)and(0<=j)and(j<nc)); end; resize(nr1,nc1:INT):SAME is res:SAME:=#(nr1,nc1,r_1); res.clear; loop i::=0.upto!(nr1-1); loop j::=0.upto!(nc1-1); 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:INT):ET pre has_ind(i1,i2) is -- The element with indices `[i1,i2]'. return(m[i1][i2]); end; aset(i1,i2:INT,val:ET) pre has_ind(i1,i2) is -- Set the element with indices `[i1,i2]' to val. m[i1][i2]:=val; end; aget(i1:INT):ARRAY{ET} pre m.has_ind(i1) is -- The array with index `[i1]'. return(m[i1]); end; aset(i1:INT,val:ARRAY{ET}) pre m.has_ind(i1) and(val.size=nc) is -- Set row with index `[i1]' to val. m[i1]:=val; end; copy:SAME is res:SAME:=#(self); loop i::=0.upto!(nr-1); res.m[i]:=m[i].copy; end; return res; end; clear is loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); m[i][j]:=r_0; end; end; end; negate:SAME is res:SAME:=#(self); loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); res.m[i][j]:=-m[i][j]; end; end; return res; end; negate is -- destructive loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); m[i][j]:=-m[i][j]; end; end; end; trans:SAME is res:SAME:=#(nc,nr,r_1); loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); res.m[j][i]:=m[i][j]; end; end; return res; end; trans is res:SAME:=#(nc,nr,r_1); loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); res.m[j][i]:=m[i][j]; end; end; nr:=res.nr; nc:=res.nc; m:=res.m; end; swap_row(i1,i2:INT) is if i1=i2 then return; end; tmp::=m[i1]; m[i1]:=m[i2]; m[i2]:=tmp; end; swap_col(j1,j2:INT) is 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:INT, i_start, i_end:INT) is 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:INT, c:ET) is -- m[*,j0]=m[*,j0]+c*m[*,j1] loop i::=0.upto!(nr-1); m[i][j0]:=m[i][j0]+c*m[i][j1]; end; end; row_plus_scaled_row(i0,i1:INT, c:ET) is -- m[i0,*]=m[i0,*]+c*m[i1,*] loop j::=0.upto!(nc-1); 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 res:SAME:=#(self); loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); 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 -- destructive loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); m[i][j]:=m[i][j]+o.m[i][j]; end; end; end; minus(o:SAME):SAME pre (nr=o.nr)and(nc=o.nc) is res:SAME:=#(self); loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); 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 -- self:=self-o -- destructive loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); 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 -- self:=arg-self -- destructive loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); 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::=0.upto!(nr-1); loop j::=0.upto!(o.nc-1); res.m[i][j]:=r_0; loop k::=0.upto!(nc-1); 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 -- destructive w:ARRAY{ET}:=#(nc); loop i::=0.upto!(nr-1); w:=m[i]; m[i]:=#(o.nc); loop j::=0.upto!(o.nc-1); m[i][j]:=r_0; loop k::=0.upto!(nc-1); m[i][j]:=m[i][j]+w[k]*o.m[k][j]; end; end; end; nc:=o.nc; end; times_trans(o:SAME):SAME pre (nc=o.nc) is -- self*(o.trans) res:SAME:=#(nr,o.nr,r_1); loop i::=0.upto!(nr-1); loop j::=0.upto!(o.nr-1); res.m[i][j]:=r_0; loop k::=0.upto!(nc-1); 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 -- destructive -- self:=self*(o.trans) w:ARRAY{ET}:=#(nc); loop i::=0.upto!(nr-1); w:=m[i]; m[i]:=#(o.nr); loop j::=0.upto!(o.nr-1); m[i][j]:=r_0; loop k::=0.upto!(nc-1); 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::=0.upto!(nr-1); loop j::=0.upto!(nc-1); res.m[i][j]:=m[i][j]*o; end; end; return res; end; times(o:ET) is -- destructive loop i::=0.upto!(nr-1); loop j::=0.upto!(nc-1); m[i][j]:=m[i][j]*o; end; end; end; minor_matrix_row(ip:INT):SAME is -- remove row [ip]. res:SAME:=#(nr-1,nc,r_1); loop i::=0.upto!(nr-1); if i/=ip then i1::=0.up!; res.m[i1]:=m[i].copy; end; end; return res; end; minor_matrix_column(jp:INT):SAME is -- remove column [jp]. res:SAME:=#(nr,nc-1,r_1); loop i::=0.upto!(nr-1); i1::=0.up!; loop j::=0.upto!(nc-1); if j/=jp then j1::=0.up!; res.m[i1][j1]:=m[i][j]; end; end; end; return res; end; minor_matrix(ip,jp:INT):SAME pre has_ind(ip,jp) is -- remove row [ip] and column [jp]. res:SAME:=#(nr-1,nc-1,r_1); loop i::=0.upto!(nr-1); if i/=ip then i1::=0.up!; loop j::=0.upto!(nc-1); if j/=jp then j1::=0.up!; res.m[i1][j1]:=m[i][j]; end; end; end; end; return res; end; minor(ip,jp:INT):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:INT):ET pre has_ind(ip,jp)and(nr=nc) is -- assume the matrix is square(nr=nc) if (ip+jp).is_odd then return -minor(ip,jp); else return minor(ip,jp); end; end; sub_matrix(ci,cj:ARRAY{INT}):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::=0.upto!(nr-1); loop j::=0.upto!(nc-1); 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_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::=0.upto!(nr-1); loop j::=0.upto!(nc-1); 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:INT,jpiv:ARRAY{INT},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.subarr(0,j); if j<jpiv.size-1 then jpiv1:=jpiv1.append(jpiv.subarr(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 --#OUT+"det_primitive\n"; if 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{INT}:=#(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 shared jPivot:ARRAY{INT}; shared iPivot:ARRAY{INT}; private SetPivot_set(p0,ip,jp:INT) is tmp:INT; tmp:=iPivot[ip]; iPivot[ip]:=iPivot[p0]; iPivot[p0]:=tmp; tmp:=jPivot[jp]; jPivot[jp]:=jPivot[p0]; jPivot[p0]:=tmp; end; SetPivot(p0:INT, nc1:INT):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:INT):BOOL is return SetPivot(p0,nc); end; -- Pivot m[iPivot[p0],jPivot[p0]] SubC(p0,i:INT) is ip::=iPivot[p0]; jp::=jPivot[p0]; cv0::=m[ip]; cv1::=m[iPivot[i]]; q::=cv1[jp]/cv0[jp]; j1:INT; 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:INT) 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:INT):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; initPivot is iPivot:=#(nr); loop i::=iPivot.ind!; iPivot[i]:=i; end; jPivot:=#(nc); loop j::=jPivot.ind!; jPivot[j]:=j; end; end; SolveD is -- make diagonal initPivot; Pivot:ET:=#; ip,jp:INT; 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; 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 0<PERM::parity0(iPivot)*PERM::parity0(jPivot) 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]]+" "; 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:INT, inout Rank:INT, inout ipivot:ARRAY{INT}, inout jpivot:ARRAY{INT}, inout i_set:ARRAY{INT}) 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:INT,inout iPivot:ARRAY{INT}) is -- Rename setPivot for "continuous field". -- set pivot as maximal element -- e.g. FLTD, CPXD -- need "abs" i:INT:=k; i1,i2:INT; loop j:INT:=(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:INT,inout iPivot:ARRAY{INT}) is -- Rename setPivot for "discrete field". -- e.g. finite field Zp, RAT(in the sense of no-error) i::=k; j:INT; 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{INT}) 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.upto!(dim-2); 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).upto!(dim-1) ; t:=m[iPivot[i]][k]/Pivot; m[iPivot[i]][k]:=t; loop j::=(k+1).upto!(dim-1) ; 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{INT}; LUdec(out iPivot); d:ET:=m[iPivot[0]][0]; loop i::=1.upto!(nr-1); d:=d* m[iPivot[i]][i]; end; if 0<PERM::parity0(iPivot) then return d; else return -d; end; end; end; -- class