alexmatm.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
--
--
-- 2001/12 Grobner bases for Elementary ideals.
-- 2001/02 merge codes for knot and theta curve.
-- 2001/02 Sather version
-- 1998/1 
-- Modula2 LongInt module.
--
--1999/2 K.Kodama
-- theta curve Linux version
--
--1997/1
--Theta curve
-- Alexander polynomial on Theta curve.
--	c.f. Litherland's method.
--un-oriented surface in S^4
--
--1996/10
--LINUX version
--
--bug fix for 2-knot
--
--1992/09/30 03:14:42
--1992/6  Alexander matrix and Alexander polynomial for 1-knot/link
--1992/6/20:  10para99(parallel of k10c99. 40 crossing) 10sec.
--K. Kodama
--
--1989/9  Kouji  Kodama
-- 


class ALEXMATM

class ALEXMATM is -- Multi variable Alexander matrix and Alexander polynomial -- for 1-knot, 2-knot, theta curve. shared AMat:MAT_POLYM_INTI; shared trimN:CARD; -- number of deleted relation shared trimC:CARD; -- component of over bridge of deleted relation shared jPivot:ARRAY{CARD}; shared Relator:ARRAY{WORD}; shared g2c:ARRAY{CARD}; -- map generator to component shared compoN:CARD; -- #of component WriteMatrix(p0:CARD) is zFlg:BOOL; LOGOUT::Title("Alexander","matrix"); zFlg:=true; degR::=AMat.nr; degG::=AMat.nc; --if p0>degR then p0:=degR; end; --if p0>degG then p0:=degG; end; -- Alexander matrix is the form of --\pmatrix{ --diagonal & 0 \cr -- 0 & matrix \cr --} if (degR=degG)and(p0+1=degR) then p0:=degR; end; -- Write diagonal part. d0:CARD; -- length of diagonel part d0:=(p0).min(degR).min(degG); loop i::=1.upto!(trimN); zFlg:=false; #LOGOUT+"diagonal part: 0\n"; end; loop i::=0.int.upto!(d0.int-1); j::=jPivot[i]; if (~AMat[i][j].is_one)and(~AMat[i][j].negate.is_one) then zFlg:=false; #LOGOUT+"diagonal part: "+ AMat[i][j].str("tex")+"\n"; end; end; -- Write other part if (p0<degR)or(p0<degG) then #LOGOUT+"\pmatrix{\n"; loop i::=(p0.int).upto!(degR.int-1); loop j::=(p0.int).upto!(degG.int-1); zFlg:=false; if p0.int<j then #LOGOUT+" & "; end; #LOGOUT+AMat[i][jPivot[j]].str("tex"); end; #LOGOUT+" \\cr"+"\n"; end; #LOGOUT+"}\n"; end; if zFlg then #LOGOUT+"0\n"; end; end; MakeMatrix(TCode:TCODE) is -- Make relation with Fox's free differential. -- Note that -- (1) w=(a b a~ c~) at crossings -- (2) w=(a b c) at verteces of theta curve -- (3) w=(a b) at the end of un-coherent band trimN:=0; trimC:=0; compoN:=TCode[TCode.length].compo.card; g::=g2c.size-1; r::=Relator.size; jPivot:=#(g); loop i::=jPivot.ind!; jPivot[i]:=i; end; AMat:=#(r,g); AMat.clear; if (r=0)or(g=0) then return; end; loop i::=AMat.m.ind!; AMat[i][(Relator[i][0]-1).card]:= AMat[i][(Relator[i][0]-1).card]+(POLYM_INTI::one); AMat[i][(Relator[i][1]-1).card]:= AMat[i][(Relator[i][1]-1).card]+(#POLYM_INTI("x"+g2c[(Relator[i][0]).card].str)); if Relator[i].w.has_ind(2) then if Relator[i][2].is_neg then -- crossing relatijon AMat[i][(-Relator[i][2]-1).card]:= AMat[i][(-Relator[i][2]-1).card]-(#POLYM_INTI("x"+g2c[(Relator[i][1]).card].str)); else -- theta curve vertex relation AMat[i][(Relator[i][2]-1).card]:=AMat[i][(Relator[i][2]-1).card] +(#POLYM_INTI("x"+g2c[(Relator[i][0]).card].str)* #POLYM_INTI("x"+g2c[(Relator[i][1]).card].str) ); end; end; if Relator[i].w.has_ind(3) then -- crossing relation AMat[i][(-Relator[i][3]-1).card]:= AMat[i][(-Relator[i][3]-1).card]-(POLYM_INTI::one); end; --#OUT+"Rel:\n"; --loop i::=Relator.ind!; #OUT+Relator[i].str+"\n"; end; -- -- #OUT+"AMat:"+i.int+":" -- +AMat[i][Relator[i][0]-1].str+", " -- +AMat[i][Relator[i][1]-1].str+", " -- +AMat[i][-Relator[i][2]-1].str+", " -- +AMat[i][-Relator[i][3]-1].str+"\n"; end; end; trimMat1r is if (compoN>1)and(trimC<=0) then return; end; trimPoly::=#POLYM_INTI("x"+trimC.str)-1.inti; loop i::=AMat.m.ind!; dFlg::=true; nzFlg::=false; loop j::=AMat.m[i].ind!; if AMat.m[i][j].is_zero.not then nzFlg:=true; dFlg:=dFlg and AMat.m[i][j].mod(trimPoly).is_zero; end; end; if dFlg and nzFlg then loop j::=AMat.m[i].ind!; if AMat.m[i][j].is_zero.not then AMat.m[i][j]:=AMat.m[i][j]/trimPoly; end; end; trimC:=0; return; end; end; end; trimMat1c is if (compoN>1)and(trimC<=0) then return; end; trimPoly::=#POLYM_INTI("x"+trimC.str)-1.inti; if AMat.nc=0 then return; end; loop j::=0.upto!(AMat.nc-1); dFlg::=true; nzFlg::=false; loop i::=AMat.m.ind!; if AMat.m[i][j].is_zero.not then nzFlg:=true; dFlg:=dFlg and AMat.m[i][j].mod(trimPoly).is_zero; end; end; if dFlg and nzFlg then loop i::=0.upto!(AMat.nr-1); if AMat.m[i][j].is_zero.not then AMat.m[i][j]:=AMat.m[i][j]/trimPoly; end; end; trimC:=0; return; end; end; end; trimMat1(TCode:TCODE) is pt:INT:=0; word:WORD; trimN:=0; trimC:=0; if TCode.has_band then -- 2-dim knot/link res::=KNOT_GROUP::getCrossR(TCode, inout pt, out word); if res and (pt<TCode.bandStart) then -- not implemented. end; else -- 1-dim knot/link -- delete a crossing relation res::=KNOT_GROUP::getCrossR(TCode, inout pt, out word); if res and (pt<TCode.bandStart) then trimN:=1; delR,delG:CARD; delR:=1; delG:=word[1].card; trimC:=g2c[delG]; #OUT+"removed x"+trimC.str+"\n"; AMat:=AMat.minor_matrix(delR-1,delG-1); jPivot:=#(AMat.nc); loop i::=jPivot.ind!; jPivot[i]:=i; end; end; end; end; trimMat1_Theta(TCode:TCODE) is delR,delG:INT; pt:INT:=0; word:WORD; trimN:=0; -- remove verteces relations AMat:=AMat.minor_matrix_row(AMat.nr-1); AMat:=AMat.minor_matrix_row(AMat.nr-1); -- remove generators at the head of each string loop c::=3.downto!(1); -- component j::=TCode.endOfString(TCode.compoStart(c.int),1.int); g::=TCode[j].gen; AMat:=AMat.minor_matrix_column(g.card-1); end; if AMat.nr/=AMat.nc then raise "trimMat_Theta: nr/=nc\n"; end; trimC:=3; jPivot:=#(AMat.nc); loop i::=jPivot.ind!; jPivot[i]:=i; end; end;
splitMatrix(p0:CARD, out diagonal_part:ARRAY{POLYM_INTI}, out SAMat:MAT_POLYM_INTI) is -- split Alexander matrix AMat to diagoanl part and other part. zFlg:BOOL; zFlg:=true; degR::=AMat.nr; degG::=AMat.nc; if (degR=degG)and(p0=degR-1) then p0:=degR; end; -- Get diagonal part. d0::=(p0).min(degR).min(degG);-- length of diagonel part diagonal_part:=#; -- Number of 0-part is trimN. loop i::=0.int.upto!(d0.int-1); j::=jPivot[i]; if (AMat[i][j].is_one)or(AMat[i][j].negate.is_one) then ;--remove trivial elsif (AMat[i][j].is_zero) then trimN:=trimN+1; else diagonal_part:=diagonal_part.append(AMat[i][j]); end; end; -- Get other part SAMat:=#(degR-p0,degG-p0); if (p0<degR)or(p0<degG) then loop i::=(p0.int).upto!(degR.int-1); si::=0.up!; loop SAMat[si][0.up!]:=AMat[i][jPivot[(p0).upto!(degG-1)]]; end; end; end; end; AlexIdeal(trimN:INT,diagonal_part:ARRAY{POLYM_INTI},SAMat:MAT_POLYM_INTI,ideg:INT) is #LOGOUT+"Elementary_ideal_E( "+(ideg-1).str+" ):\n"; -- When free differential method, we must delete __one__ free meridian generator. if ideg<trimN then #LOGOUT+"[\n"+"0\n"+"]\n\n"; return; end; ideg:=ideg-trimN; ddeg::=diagonal_part.size.int; degr::=ddeg+SAMat.nr.int; -- number of relator degc::=ddeg+SAMat.nc.int; -- number of generator mdeg:INT:=degc-ideg; -- degree of minor. if mdeg.is_non_pos then #LOGOUT+"[\n"+"1\n"+"]\n\n"; return; elsif degr<mdeg then #LOGOUT+"[\n"+"0\n"+"]\n\n"; return; end; -- separate "mdeg" to diagonal part "mdegd" and other part mdeg-mdegd. -- (1) 0<=mdegd<=ddeg , (2) 0<=mdeg-mdegd<= min(degr,degc)-ddeg -- (2) means mdegd<=mdeg and mdeg+ddeg-min(degr,degc)<=mdegd. trimPoly::=POLYM_INTI::zero; if (compoN>1)and(trimC>0) then trimPoly:=#POLYM_INTI("x"+trimC.str)-1.inti; end; gBases:ARRAY{POLYM_INTI}:=#; loop mdegd::=0.int.max(mdeg+ddeg-(degr.min(degc))).upto!(ddeg.min(mdeg)); combi3::=#COMBI_NR_STREAM(ddeg.card,mdegd.card); c3:ARRAY{CARD}; loop while!(combi3.get(out c3)); f3::=POLYM_INTI::one; loop f3:=f3*diagonal_part[c3.elt!(1)-1]; end; if (mdeg-mdegd).is_zero then gBases:=gBases.append(f3); else combi1::=#COMBI_NR_STREAM((degr-ddeg).card,(mdeg-mdegd).card); c1:ARRAY{CARD}; loop while!(combi1.get(out c1)); sub1::=c1.create(c1.size-1); loop sub1[0.up!]:=c1.elt!(1)-1; end; combi2::=#COMBI_NR_STREAM((degc-ddeg).card,(mdeg-mdegd).card); c2:ARRAY{CARD}; loop while!(combi2.get(out c2)); sub2::=c2.create(c2.size-1); loop sub2[0.up!]:=c2.elt!(1)-1; end; gf::=SAMat.sub_matrix(sub1,sub2).det*f3; if (compoN>1)and(trimC>0)and(gf.mod(trimPoly).is_zero) then gf:=gf/trimPoly; end; gBases:=gBases.append(gf); end; end; end; end; end; --#OUT+"bases: \n"+gBases.str+"\n\n"; gBases:=GBASE_INTI_L::getGBaseIL(gBases); -- get Grobner bases --#LOGOUT+"Grobner bases: "+gBases.str+"\n\n"; #LOGOUT+"[\n"; if gBases.size=0 then #LOGOUT+"0\n"; else loop b::=gBases.elt!; #LOGOUT+b.str("tex")+"\n"; end; end; #LOGOUT+"]\n"; LOGOUT::flush; end; AlexanderIdeals(p0:CARD) is diagonal_part:ARRAY{POLYM_INTI}; SAMat:MAT_POLYM_INTI; splitMatrix(p0,out diagonal_part,out SAMat); -- #OUT+"diagonal-0: "; loop trimN.times!; #OUT+"0,"; end; #OUT+"\n"; -- #OUT+"diagonal: "+diagonal_part+"\n"; -- #OUT+"matrix : "+SAMat.str+"\n"; -- diagonal is: trimN times 0 and diagonal_part loop ideg::=1.upto!(trimN+diagonal_part.size+SAMat.nc-1); --upto #_of_generator-1 AlexIdeal(trimN.int,diagonal_part,SAMat,ideg.int); end end; AlexPoly(p0:CARD, out apoly:POLYM_INTI) is apoly:=POLYM_INTI::one; --- alex.poly if AMat.nr/=AMat.nc then #OUT+"Alexander matrix is not square.\n"; apoly:=POLYM_INTI::zero; return; end; pw:POLYM_INTI; -- work -- diagonal part countz::=0; -- count "0" loop i::=0.upto!(p0-1); pw:=AMat[i,jPivot[i]]; if pw.is_zero then countz:=countz+1; else apoly:=apoly*pw; end; end; -- non-diagonal part if countz+trimN<=1 then if p0<AMat.nr then mat::=AMat.copy; jPivotm::=jPivot.copy; loop i::=0.upto!(p0-1); mat:=mat.minor_matrix(0,jPivotm[i]); loop j::=i.upto!(jPivotm.size-1); if jPivotm[j]>jPivotm[i] then jPivotm[j]:=jPivotm[j]-1; end; end; end; apoly:=apoly*mat.det; end; else apoly:=POLYM_INTI::zero; end; if apoly.is_zero.not then apoly:=apoly/#POLYM_INTI(apoly.gcd_term); -- if apoly.substitute(1.inti)<0.inti then apoly:=-apoly; end; --printApoly(apoly); if (trimN=1)and(compoN>1)and(trimC>0) then apoly:=apoly/(#POLYM_INTI("x"+trimC.str)-1.inti); end; slist:MAP{STR,POLYM_INTI}:=#; loop i::=1.upto!(compoN); slist["x"+i.str]:=#POLYM_INTI(1.inti); end; res_p::=apoly.substitute(slist); if res_p.lc<0.inti then apoly:=-apoly; end; end; end; printApoly(apoly:POLYM_INTI) is LOGOUT::Title("Alexander","Polynomial"); #LOGOUT+apoly.str("tex"); #LOGOUT+"\n"; --#OUT+"test poly\n"; #LOGOUT+apoly.inspect; #LOGOUT+"\n"; end; AlexMat(TCode:TCODE,testGb:BOOL) is rDeg:CARD; POLYM_INTI::init; KNOT_GROUP::get_Relator(TCode, out Relator, out g2c); MakeMatrix(TCode); #LOGOUT+"\n"; if AMat.nr<1 or AMat.nc<1 then s:STR:="The "; if TCode.number_compo=1.int then s:=s+"knot"; else s:=s+"link"; end; s:=s+" is "; if AMat.nc<1 then s:=s+"empty"; else s:=s+"Trivial"; end; #LOGOUT+s+".\n"; else LOGOUT::LogTime; WriteMatrix(0); trimMat1(TCode); trimMat1r; trimMat1c; --WriteMatrix(0); MAT_POLYM_INTI_REDUCTION::reduce(inout AMat,out jPivot,out rDeg); trimMat1r; trimMat1c; -- WriteMatrix(0); WriteMatrix(rDeg); if testGb then AlexanderIdeals(rDeg); end; if ~TCode.has_band then pa:POLYM_INTI; AlexPoly(rDeg,out pa); printApoly(pa); end; end; #LOGOUT+"\n"; LOGOUT::flush; AMat:=#(0,0); end; AlexMat_Theta(TCode:TCODE) is -- Assume TCode for Theta-curve rDeg:CARD; POLYM_INTI::init; KNOT_GROUP::get_Relator_Theta(TCode, out Relator, out g2c); MakeMatrix(TCode); #LOGOUT+"\n"; if AMat.nr<1 or AMat.nc<1 then #LOGOUT+"The theta curve is Trivial.\n"; else LOGOUT::LogTime; WriteMatrix(0); trimMat1_Theta(TCode); WriteMatrix(0); MAT_POLYM_INTI_REDUCTION::reduce(inout AMat,out jPivot,out rDeg); -- WriteMatrix(0); WriteMatrix(rDeg); -- pa:POLYM_INTI; AlexPoly(rDeg,out pa); printApoly(pa); #LOGOUT+"with relation x1x2x3=1.\n"; -- end; #LOGOUT+"\n"; LOGOUT::flush; AMat:=#(0,0); end; end;