covering_linkage.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
class COVERING_LINKAGE
class COVERING_LINKAGE is
-- Covering linkage.
-- c.f.
-- Hartrey,R. & K.Murasugi,"Covering linkage invariants",
-- Canad. J. Math.,29(1977).
-- 2002/11 incOrbitsToCDBr: debug: sort is needed.
-- 1998/05 LongInt
-- 1996/10 LINUX version
-- 1991/7 rational version
-- 1989/8 Modula2 FLT version.
-- 1983 Basic
-- Kouji Kodama
shared LRdeg0,LGdeg0:CARD; -- allocate length of vect
shared CharL:ARRAY{RAT}; -- [1..Jn]
shared CChar:MAT_RAT; -- [1..GenMax],[1..Jn]
shared link:MAT_RAT; -- [0..NOrbit] ,[0..NOrbit]
shared oTbl:ARRAY{CARD}; -- [1..NOrbit]
shared RelMat:MAT_INTI; -- [0..rL*Jn-1][0..GenMax*Jn-1]
shared cv0:ARRAY{INTI}; -- RelMat[*]
shared Rank:CARD;
shared i_set:ARRAY{CARD}; -- [0..GenMax*Jn-1]
shared iPivot:ARRAY{CARD}; -- [0..rL*Jn-1]
shared jPivot:ARRAY{CARD}; -- [0..GenMax*Jn-1]
shared rL:CARD; -- (# of relation)=Relator.size
shared Relator:ARRAY{WORD};
shared GenMax:CARD;
wait is
#OUT+"Hit return key."+#IN.get_line.str;
end;
printVChar is
#OUT+" check ! Relation Matrix "+"\n";
k1,i1:CARD;
loop k::=1.upto!(rL) ;
loop l::=1.upto!(REP::rcode.stack.Jn);
k1:=(k-1)*REP::rcode.stack.Jn+l-1;
loop i::=1.upto!(GenMax);
loop j::=1.upto!(REP::rcode.stack.Jn);
i1:=(i-1)*REP::rcode.stack.Jn+j-1;
#OUT+RelMat[k1][i1].str+" ";
end;
#OUT+":";
end;
#OUT+"\n";
end;
end;
end;
printElChar is
#OUT+" check ! Char. Vectors for Generators.\n";
loop i::=1.upto!(GenMax);
#OUT+"CV(X"+i.str+")=";
loop j::=1.upto!(REP::rcode.stack.Jn); #OUT+CChar[i][j].str+" "; end;
#OUT+"\n";
end;
end;
printLChar is
#OUT+" check ! Char. Vector of Longitude\n";
#OUT+"CV( L )=";
loop i::=1.upto!(REP::rcode.stack.Jn); #OUT+CharL[i].str+" "; end;
#OUT+"\n";
end;
LinkPrintLog(NOrbit:CARD) is
LOGOUT::Title("Linking of the covering link:","(link( Ki , Kj ))");
loop i::=1.upto!(NOrbit);
loop j::=1.upto!(NOrbit);
if j/=1 then #LOGOUT+" & "; end;
if link[i,0].num=-(1.inti) then #LOGOUT+" fail ";
else
if i/=j then
#LOGOUT+link[i][j].str;
else #LOGOUT+" **";
end;
end;
end;
if i<NOrbit then #LOGOUT+" \\"; end;
#LOGOUT+"\n";
end;
LOGOUT::flush;
end;
incOrbitsToCDBr(compo:CARD, out br:ARRAY{CARD}) is
br:=REP::rcode.stack.st[REP::rcode.orbitmPtr+compo].slice(1,REP::rcode.stack.st[REP::rcode.orbitpPtr+compo][0]);
br.sort; br:=br.reverse;
end;
BrIndex(TCode:TCODE) is
-- print branch index
Mer:INT;
NOrbit:CARD;
Lon:WORD;
br:ARRAY{CARD};
brTbl:ARRAY{ARRAY{CARD}}:=#;
-- if checkBand then #OUT+"exist saddle band \n"; return; end;
GenMax:=TCode.number_gen;
loop compo::=1.int.upto!(TCode.number_compo);
if compo>1.int then #LOGOUT+"\n"; end;
COV_PRIM::SetLongitude(TCode,compo,out Mer, out Lon);
COV_PRIM::LonPrint(compo,Mer,Lon);
COV_PRIM::SetOrbits(compo,out NOrbit);
incOrbitsToCDBr(compo.card,out br);
brTbl:=brTbl.append(br.copy);
COV_PRIM::OrbitPrintLog(compo,NOrbit);
end;
#LOGOUT+"\n";
REP::cdBranch.IncCDBranchindex(brTbl);
end;
CRm2(gen,base:INT) is
el5:INT:=(gen.abs-1)*REP::rcode.stack.Jn.int+base-1;
if gen.is_pos then cv0[el5]:=cv0[el5]+1.inti;
else cv0[el5]:=cv0[el5]-1.inti;
end;
end;
RelationMatrix is
rout:ROUT{INT,INT}:=bind(CRm2(_,_));
RelMat:=#(LRdeg0, LGdeg0);
loop re::=0.upto!(rL-1);
loop pt::=1.upto!(REP::rcode.stack.Jn);
cv0:=RelMat[ re*REP::rcode.stack.Jn+pt-1 ];
cv0.to_val(0.inti);
COV_PRIM::Relation(Relator[re],pt.int,rout);
end;
end;
end;
CharacteristicVector(NOrbit:CARD) is
-- Solve the Matrix 'RelMat' ,and set Rank,oTbl
LGdeg,LRdeg:CARD;
cv0,cv1:ARRAY{INTI};
j0,j1,js,mer,op:CARD;
LGdeg:=LGdeg0; LRdeg:=LRdeg0;
iPivot:=#(RelMat.nr); loop i::=iPivot.ind!; iPivot[i]:=i; end;
jPivot:=#(RelMat.nc); loop j::=jPivot.ind!; jPivot[j]:=j; end;
i_set:=#(RelMat.nc); i_set.to_val(0);
oTbl:=#(NOrbit+1); oTbl.to_val(0);
mer:=REP::rcode.merPtr+1; op:=REP::rcode.orbitpPtr+1;
loop no1::=1.upto!(NOrbit);
loop j0:=1.up!; until!(REP::rcode.stack.st[op][j0]=no1); end;
oTbl[no1]:=j0; js:=j0;
loop
j1:=jPivot[LGdeg-1]; jPivot[LGdeg-1]:=jPivot[j0-1];
jPivot[j0-1]:=j1;
j0:=REP::rcode.stack.st[mer][j0];
LGdeg:=LGdeg-1;
until!(j0=js);
end;
end;
Rank:=LRdeg.min(LGdeg);
RelMat.SolveL(LGdeg-1,inout Rank,
inout iPivot, inout jPivot, inout i_set);
end;
---------------LinkingNumber----------
LinkC(j0:CARD):BOOL is
i:CARD:=Rank+1;
loop while!((i<=LRdeg0)and(RelMat[i-1][j0-1]=0.inti)); i:=i+1; end;
return (i>LRdeg0);
end;
SetChar(j0:CARD) is
j:CARD;
jp:CARD;
cv0,cv1:ARRAY{INTI};
ccharV:ARRAY{RAT}:=#(GenMax*REP::rcode.stack.Jn+1); -- [1..GenMax*Jn]
loop k::=ccharV.ind!; ccharV[k]:=#(0); end;
ccharV[j0]:=#(1);
j:=Rank;
loop while!(1<=j);
jp:=jPivot[j-1]+1;
if (i_set[jp-1]+1>0) then
cv0:=RelMat[i_set[jp-1]];
loop k::=(j+1).upto!(GenMax*REP::rcode.stack.Jn);
ccharV[jp]:=ccharV[jp]
-ccharV[jPivot[k-1]+1]*#RAT(cv0[jPivot[k-1]]);
end;
ccharV[jp]:=ccharV[jp]/#RAT(cv0[jp-1]);
end;
j:=j-1;
end;
CChar:=#(GenMax+1,REP::rcode.stack.Jn+1);
loop k::=1.upto!(GenMax);
loop l::=1.upto!(REP::rcode.stack.Jn);
CChar[k][l] := ccharV[(k-1)*(REP::rcode.stack.Jn)+l];
end;
end;
end;
scl1(el,el1:INT) is
REP::rcode.stack.Fetch(el1);
if el.is_neg then REP::rcode.stack.Inv; end;
REP::rcode.stack.Mul; REP::rcode.stack.Store(REP::rcode.Work); REP::rcode.stack.Pu;
end;
scl2(el1:INT) is
loop i::=1.upto!(REP::rcode.stack.Jn);
CharL[i]:=CharL[i]+CChar[el1.card][ REP::rcode.stack.st[REP::rcode.Work][i] ];
end;
end;
scl3(el1:INT) is
loop i::=1.upto!(REP::rcode.stack.Jn);
CharL[i]:=CharL[i]-CChar[el1.card][ REP::rcode.stack.st[REP::rcode.Work][i] ];
end;
end;
SetCharL(Lon:WORD) is
el,el1,el3:INT;
CharL:=#(REP::rcode.stack.Jn1); CharL.to_val(#RAT(0));
REP::rcode.stack.Unit; REP::rcode.stack.Store(REP::rcode.Work); REP::rcode.stack.Pu;
l::=1;
loop el:=Lon.w.elt!;
if el.is_pos then el1:=el; scl2(el1); scl1(el,el1);
else el1:=-el; scl1(el,el1); scl3(el1);
end;
end;
REP::rcode.stack.Pd;
end;
SetLink(no1:CARD) is
o,j:CARD;
j:=REP::rcode.orbitmPtr+1;
loop i::=1.upto!(REP::rcode.stack.Jn);
o:=REP::rcode.stack.st[REP::rcode.orbitpPtr+1][i]; -- o:link number
-- wl:=st[j][o]; -- Br.index
link[no1][o]:=link[no1][o]+CharL[i]/#RAT(REP::rcode.stack.st[j][o]);
end;
end;
CheckChar(NOrbit:CARD,no1:CARD) is
s:RAT;
RelationMatrix;
flg:BOOL:=true;
flgMod:BOOL:=true;
loop r::=1.upto!(rL*REP::rcode.stack.Jn);
s:=#RAT(0); cv0:=RelMat[r-1];
loop g::=1.upto!(GenMax);
loop n::=1.upto!(REP::rcode.stack.Jn);
s:=s+#RAT(cv0[(g-1)*REP::rcode.stack.Jn+n-1])*CChar[g][n];
end;
end;
if s/=#RAT(0) then flg:=false; end;
end;
--#OUT+"check C.V.\n";
if flg then #OUT+"solve";
else link[no1][0]:=#RAT(-1); #OUT+"########## fail to solve ########";
end;
CharacteristicVector(NOrbit);
end;
LinkingNumber(NOrbit:CARD,Lon:WORD) is
j0:CARD;
mer,js:CARD;
link:=#(NOrbit+1,NOrbit+1); link.clear;
loop no1:CARD:=1.upto!(NOrbit);
j0:=oTbl[no1]; js:=j0; mer:=REP::rcode.merPtr+1;
loop j0:=REP::rcode.stack.st[REP::rcode.merPtr+1][j0];
until!((j0=js) or LinkC(j0));
end;
if LinkC(j0) then
SetChar(j0);
SetCharL(Lon);
CheckChar(NOrbit,no1);
-- printElChar; printLChar; wait;
SetLink(no1);
link[no1][0]:=#RAT(1);
else link[no1][0]:=#RAT(-1);
#OUT+"########## fail to solve #######\n";
end;
end;
end;
covering(TCode:TCODE) is
pn:INT;
GenMax:=TCode.number_gen;
KNOT_GROUP::get_Relator(TCode,out Relator);
if Relator.size=0 then #OUT+"\n The group is free."; return; end;
if TCode.has_band then rL:=Relator.size;
else rL:=Relator.size-1;
end;
LRdeg0:=REP::rcode.stack.Jn*rL; LGdeg0:=REP::rcode.stack.Jn*GenMax;
-- InitCheck;
-- RepGenPrint;
CChar:=#(1,1);
link:=#(1,1);
Mer:INT;
Lon:WORD;
NOrbit:CARD;
br:ARRAY{CARD};
compo::=1.int;
COV_PRIM::SetLongitude(TCode,compo,out Mer, out Lon);
COV_PRIM::LonPrint(compo,Mer,Lon);
COV_PRIM::SetOrbits(compo,out NOrbit);
incOrbitsToCDBr(compo.card,out br);
REP::cdBranch.IncCDBranchindex(|br|);
COV_PRIM::OrbitPrintLog(compo,NOrbit);
if NOrbit>1 then
#OUT+"\n covering link. computing. \n";
RelationMatrix;
-- printVChar; -- for check
CharacteristicVector(NOrbit.card);
-- printVChar; -- for check
LinkingNumber(NOrbit,Lon);
LinkPrintLog(NOrbit);
REP::cdLink.IncCDLinking(link,NOrbit);
RelMat:=#(1,1);
else
REP::cdLink.IncCDLinking(link,1);
#OUT+"\n covering link is one component. \n";
end;
link:=#(1,1);
CChar:=#(1,1);
end;
CoveringLinkage(TCode:TCODE) is
-- if te .in TCode[INT(TLength-1)].sep then
-- BrIndex;
-- ErrorMessage('Exist saddle band',''); return;
-- end;
GenMax:=TCode.number_gen;
if TCode.number_compo>1.int then
#OUT+"Link is not supported on linkage.\n";
BrIndex(TCode);
else
covering(TCode);
end;
LOGOUT::flush;
end;
end;