repstack.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 

partial class STACK_ALG{GT}

partial class STACK_ALG{GT} is attr st:ARRAY{GT}; -- stack group GT attr pt:CARD; -- stack pointer. assume that stack.has_ind(pt). attr bottom:CARD; -- 0<bottom<pt<st.size -- [ 0..(static work).. Bottom..(stack work) ] private get_element:GT is return #GT; end; -- create create:SAME is res:SAME:=new; res.bottom:=0; res.pt:=0; res.st:=#(1); res.st[0]:=get_element; res.resize; return res; end; resize is loop while!(st.size<pt+10); n0::=st.size; st:=st.resize(n0+n0); loop i::=n0.upto!(st.size-1);st[i]:=get_element; end; end; end; ---------------------stack operations---------------------- Pu is -- +1 pt:=pt+1; resize; end; Pu(n:CARD) is -- +n pt:=pt+n; resize; end; Pd post (pt>=bottom) is -- -1 pt:=pt-1; end; Pd(n:CARD) post (pt>=bottom) is -- -n pt:=pt-n; end; Dup is -- +1 Pu; st[pt]:=st[pt-1].copy; end; Swap is -- 0 g::=st[pt]; st[pt]:=st[pt-1]; st[pt-1]:=g; end; Drop is -- -1 Swap; Pd; end; Over is -- +1 Pu; st[pt]:=st[pt-2].copy; end; Rot is -- 0 g::=st[pt-2]; st[pt-2]:=st[pt-1]; st[pt-1]:=st[pt]; st[pt]:=g; end; Fetch(i:CARD) is -- +1 Fetch(i.int); end; Store(i:CARD) is -- -1 Store(i.int); end; end;

class SL2P_STACK_GT

class SL2P_STACK_GT is attr mat:SL2P; attr y,n:CARD; create:SAME is res:SAME:=new; res.mat:=#(1.int,0.int,0.int,1.int); return res; end; copy:SAME is res:SAME:=new; res.mat:=mat.copy; res.y:=y; res.n:=n; return res; end; end;

class SL2P_STACK

class SL2P_STACK is -- 2002-12 K.Kodama include STACK_ALG{SL2P_STACK_GT}; readonly attr p:INT; -- prime --attr lst:ARRAY{SL2P}; attr cnj:SL2P_CNJ_CLS; attr presentationType:CARD; create(prime_number:INT):SAME is SL2P::set_base(prime_number); res:SAME:=new; --res.lst:=SL2P::get_list; res.cnj:=#; res.bottom:=0; res.pt:=0; res.p:=prime_number; res.st:=#(1); res.st[0]:=res.get_element; res.resize; return res; end; Fetch(i:INT) is -- +1 Pu; if i.is_neg then st[pt].mat:=st[(-i).card].mat.inverse; else st[pt]:=st[i.card].copy; end; end; Store(i:INT) is -- -1 if i.is_neg then st[(-i).card].mat:=st[pt].mat.inverse; else st[i.card]:=st[pt].copy; end; Pd; end; ------------ group operations--------- Unit is -- +1 Pu; st[pt].mat:=SL2P::one; end; Inv is -- 0 st[pt].mat:=st[pt].mat.inverse; end; Conjugate( P,Q :INT) is -- +1 -- Fetch Q P Q~ if Q.is_non_neg then Fetch(P); st[pt].mat:=st[pt].mat.conjugate(st[Q.card].mat); else Fetch(P); st[pt].mat:=st[pt].mat.conjugateR(st[(-Q).card].mat); end; end; Mul is -- -1 -- fetch(a); fetch(b); Mul implies a*b st[pt-1].mat:=st[pt-1].mat*st[pt].mat; Pd; end; CMul(w:ARRAY{INT}) is -- +1 Unit; loop n::=w.elt!; --Fetch(n); Mul; if n.is_non_neg then st[pt].mat:=st[pt].mat*st[n.card].mat; else st[pt].mat:=st[pt].mat/st[(-n).card].mat; end; end; end; Eq:BOOL is -- -2 -- if st[pt]=st[pt-1] f::=(st[pt].mat=st[pt-1].mat); Pd(2); return f; end; Eq1:BOOL is -- -1 -- check if unit f::=st[pt].mat.is_one; Pd; return f; end; ------------Generators---------- -- generating all elements InitGen is -- +2 Pu(2); st[pt-1].mat:=#(0.int,1.int,-1,0.int); end; Gen:BOOL is -- 0/-2 if st[pt-1].mat.is_zero then Pd(2); return false; end; st[pt].mat:=st[pt-1].mat; st[pt-1].mat:=st[pt].mat.next_sl; return true; end; -------------gen permutations according to Conjugate class/Yang-------------- -- generate all elements having a given conjugate class InitGenY(Ynum:CARD) is -- +2 Pu(2); y::=st[Ynum].y; st[pt-1].y:=y; st[pt-1].n:=0; st[pt].mat:=cnj.cls[y][0]; end; GenY:BOOL is -- 0/-2 y::=st[pt-1].y; i::=st[pt-1].n+1; if i<cnj.cls[y].size then st[pt-1].n:=i; st[pt].mat:=cnj.cls[y][i]; return true; else Pd(2); return false; end; end; ------------------gen yangs & perm.--------------- -- Generate all conjugate class ( and a standard element. ). InitYang is -- +2 Pu(2); st[pt-1].y:=0; st[pt-1].n:=0; st[pt].mat:=cnj.cls[0][0]; end; GenYang:BOOL is -- true: +0, false: -2 y::=st[pt-1].y+1; if y<cnj.cls.size then st[pt-1].y:=y; st[pt].mat:=cnj.cls[y][0]; return true; else Pd(2); return false; end; end; Yang is -- +1 Pu; st[pt].y:=cnj.map[st[pt-1].mat]; end; ---------------conjugate eq. check------------- -- Specific to conjugacy check -- find element c s.t. c~ n c = n for the normal form. InitConj is -- Assume thet a conj. class id/Yang-diagram is on the stack top. -- 1+3 : 0:c, -1:work, -2:n, -3:class. Pu; st[pt].mat:=cnj.cls[st[pt-1].y][0]; InitGen; loop while!(Gen); Conjugate(pt.int-2,-pt.int); Fetch(pt-3); if Eq then return; end; end; end; GenConj:BOOL is -- 0/-4 --if Gen then return true; else Pd(2);return false; end; loop while!(Gen); Conjugate(pt.int-2,-pt.int); Fetch(pt-3); if Eq then return true; end; end; Pd(2); return false; end; GenConjDispose is -- -4 Pd(4); end; WriteStackLog is -- -1 if presentationType=1 then #LOGOUT+st[pt].mat.str; Pd; else #LOGOUT+st[pt].mat.str; Pd; end; end; end; -- MAT2_STACK

class REP_STACK

class REP_STACK is -- 1996/10 --LINUX version -- --Kouji Kodama 1989/8 -- kernel of computing the group S(Jn). include STACK_ALG{ARRAY{CARD}} get_element->get_element0; readonly attr Jn:CARD; -- index of permutation readonly attr Jn1:CARD; -- Jn+1 readonly attr Jn2:CARD; -- Jn+2 attr presentationType:CARD; private get_element:ARRAY{CARD} is return #(Jn2); end; create(jn:CARD):SAME is res:SAME:=new; res.presentationType:=2; res.Jn:=jn; res.Jn1:=res.Jn+1; res.Jn2:=res.Jn+2; res.bottom:=0; res.pt:=0; res.st:=#(1); res.st[0]:=res.get_element; res.resize; return res; end; Fetch(i:INT) is -- +1 Pu; if i.is_non_neg then st[pt]:=st[i.card].copy; else i1::=(-i).card; st[pt]:=get_element; loop s::=1.upto!(Jn); st[pt][st[i1][s]]:=s; end; -- Inv st[pt][0]:=0; st[pt][Jn1]:=0; end; end; Store(i:INT) is -- -1 if i.is_non_neg then st[i.card]:=st[pt].copy; else i1::=(-1).card; loop s::=1.upto!(Jn); st[i1][st[pt][s]]:=s; end; -- Inv st[i1][0]:=0; st[i1][Jn1]:=0; end; Pd; end; ------------ group operations--------- Unit is -- +1 Pu; loop s::=0.upto!(Jn); st[pt][s]:=s; end; st[pt][Jn1]:=0; end; Inv is -- 0 Pu; loop s::=1.upto!(Jn); st[pt][st[pt-1][s]]:=s; end; st[pt][0]:=0; st[pt][Jn1]:=0; Swap;Pd; end; -- P Q (i) means Q(P(i)) private CjN(pi,qi:CARD) is -- +1 -- q~ p q. pi,qi>=0 Pu; p::=st[pi]; q::=st[qi]; loop s::=1.upto!(Jn); st[pt][q[s]]:=q[p[s]]; end; st[pt][0]:=0; st[pt][Jn1]:=0; end; private CjP(pi,qi:CARD) is -- +1 -- q p q~. pi,qi>=0 Pu; p::=st[pi]; q::=st[qi]; r::=st[pt+1]; loop s::=1.upto!(Jn); r[q[s]]:=s; end; -- r=q~ loop s::=1.upto!(Jn); st[pt][s]:=r[p[q[s]]]; end; st[pt][0]:=0; st[pt][Jn1]:=0; end; Conjugate( P,Q :INT) is -- +1 -- Fetch Q P Q~ if Q.is_non_neg then if P.is_non_neg then CjP(P.card,Q.card); else CjP((-P).card,Q.card); Inv; end; else if P.is_non_neg then CjN(P.card,(-Q).card); else CjN((-P).card,(-Q).card); Inv; end; end; end; Mul is -- -1 -- fetch(a); fetch(b); Mul implies a b loop s::=1.upto!(Jn); st[pt-1][s]:=st[pt][st[pt-1][s]]; end; Pd; end; CMul(w:ARRAY{INT}) is -- +1 Unit; if w.size=0 then return; end; Unit; loop i::=(w.size-1).downto!(0); if w[i].is_non_zero then p::=st[pt-1]; q::=st[w[i].abs.card]; r::=st[pt]; if w[i].is_pos then loop s::=1.upto!(Jn); r[s]:=p[q[s]]; end; else loop s::=1.upto!(Jn); r[q[s]]:=p[s]; end; end; Swap; end; end; Pd; end; Eq:BOOL is -- -2 -- if st[pt]=st[pt-1] p::=st[pt-1]; q::=st[pt]; loop s::=1.upto!(Jn); if p[s]/=q[s] then Pd(2); return false; end; end; Pd(2); return true; end; Eq1:BOOL is -- -1 -- check if unit p::=st[pt]; loop s::=1.upto!(Jn); if p[s]/=s then Pd; return false; end; end; Pd; return true; end; ------------Generators---------- ---------------------gen permutations-------------- -- generating all permutations in S(Jn). -- Heap's algorithm. -- c.f. Robert Sedgewick,"Permutation Generating Methods", -- Computing Surveys, Vol.9, No.2, June 1977. InitGen is -- +2 Pu(2); p1::=st[pt-1]; p0::=st[pt]; loop s::=0.upto!(Jn); p1[s]:=s; p0[s]:=s; end; p1[2]:=3; p1[Jn1]:=0; -- and call Gen() to set up. end; Gen:BOOL is -- 0/-2 -- Heap's algorithm. p1::=st[pt-1]; p0::=st[pt]; s::=2; loop while!(p1[s]=1); p1[s]:=s; s:=s+1; end; if s<=Jn then s0:CARD; p1[s]:=p1[s]-1; if s.is_odd then s0:=1; else s0:=p1[s]; end; s1::=p0[s]; p0[s]:=p0[s0]; p0[s0]:=s1; return true; end; Pd(2); return false; end; -------------gen permutations according to Yang-------------- -- K.Kodama -- generate all elements having a given Yang diagram. --st3,st4,st5:work area. --st2:Yang. --st1:presentation as cyclic permutation / using st2 as a orbit tag. --st0:gen. private CnvG is -- 0 -- set st0 from st1 and st2 st0::=st[pt ]; st1::=st[pt-1]; st2::=st[pt-2]; -- st3:=st[pt-3]; st4:=st[pt-4]; st5:=st[pt-5]; st0[0]:=0; st0[Jn1]:=0; s2::=1; s1::=1; loop while!(st2[s2].is_pos); count::=1; s0::=st1[s1]; loop while!(count<st2[s2]); st0[st1[s1]]:=st1[s1+1]; s1:=s1+1; count:=count+1; end; st0[st1[s1]]:=s0; s2:=s2+1; s1:=s1+1; end; end; InitGenY(Ynum:CARD) is -- +6 Pu; st5::=st[pt]; Pu; st4::=st[pt]; Pu; st3::=st[pt]; Fetch(Ynum); st2::=st[pt]; Pu; st1::=st[pt]; Pu; st0::=st[pt]; s,s0,s1,s2:CARD; s0:=1; loop o::=1.upto!(st2[0]); s:=s0; st5[s]:=0; s1:=o; s2:=st2[o]; loop while!(s2=st2[s1]); st5[s]:=st5[s]+s2; s1:=s1+1; end; s:=s+1; loop while!(s<s0+s2); st5[s]:=1; s:=s+1; end; s0:=s; end; loop i::=0.upto!(Jn); st1[i]:=i; st3[i]:=1; st4[i]:=Jn1-st5[i]; end; CnvG; end; GenY:BOOL is -- 0/-6 st0::=st[pt ]; st1::=st[pt-1]; st2::=st[pt-2]; st3::=st[pt-3]; st4::=st[pt-4]; st5::=st[pt-5]; s2::=st2[0]; s1::=Jn; s0::=Jn1-st2[s2]; st3[st1[s1]]:=0; s4:CARD; loop if st1[s1]>=st4[s1] then st1[s1]:=0; s1:=s1-1; s4:=st4[s1]; if s1<=0 then Pd(6); return false; end; if s1<s0 then s2:=s2-1; s0:=s0-st2[s2]; end; st3[st1[s1]]:=0; else st1[s1]:=st1[s1]+1; if st3[st1[s1]]=0 then st3[st1[s1]]:=1; if s1=Jn then CnvG; return true; end; s1:=s1+1; if s1>=s0+st2[s2] then -- new orbit s0:=s1; -- set end of st1[*] , s4 and st4[*] count::=st5[s1]; s4:=Jn1; loop s4:=s4-1; if st3[s4]=0 then count:=count-1; end; until!(count=0); end; st4[s0]:=s4; s2:=s2+1; -- set st1[*] to start if st2[s2]=st2[s2-1] then -- same length st1[s0]:=st1[s0-st2[s2]]; end; else st1[s1]:=st1[s0]; end; end; end; end; return false; end; ------------------gen yangs & perm.--------------- -- K.Kodama -- Generate all Yang diagrams ( and a standard permutation. ). InitYang is -- +2 Pu(2); st1::=st[pt-1]; st0::=st[pt]; loop s::=0.upto!(Jn); st1[s]:=1; st0[s]:=s; end; st1[0]:=Jn; st1[Jn1]:=0; st0[Jn1]:=0; end; GenYang:BOOL is -- true: +0, false: -2 if st[pt-1][0]=1 then Pd(2); return false; else st1::=st[pt-1]; st0::=st[pt]; s0,s1:CARD; s1:=st1[0]; st1[0]:=0; count::=0; loop count:=count+st1[s1]; st1[s1]:=0; s1:=s1-1; until!(st1[s1-1]/=st1[s1]); end; st1[s1]:=st1[s1]+1; loop (count-1).times!; s1:=s1+1; st1[s1]:=1; end; st1[0]:=s1; s0:=1; s1:=1; count:=0; loop s::=1.upto!(Jn); count:=count+1; if count=st1[s1] then st0[s]:=s0; s0:=s+1; count:=0; s1:=s1+1; else st0[s]:=s+1; end; end; return true; end; end; ---------------------orbit & Yang-------------- OrbitS is -- +1 -- mark up orbits for stack top Pu; st1::=st[pt-1]; st0::=st[pt]; so, s:CARD; loop s:=0.upto!(Jn1); st0[s]:=0; end; so:=0; s:=1; loop so:=so+1; loop st0[s]:=so; s:=st1[s]; until!(st0[s].is_pos); end; loop s:=s+1; until!(st0[s]=0); end; until!(s>Jn); end; st0[0]:=so; -- # of orbits end; Sort is -- 0 -- sort stack top st[pt].insertion_sort_range(1,Jn); end; Yang is -- +1 -- Yang diagram(list of length of orbits) -- format: [ #orbit, length of orbits(sorted)] OrbitS; Pu; st0::=st[pt-1]; st1::=st[pt]; loop s::=0.upto!(Jn1); st1[s]:=0; end; st1[0]:=st0[0]; loop s::=1.upto!(Jn); st1[st0[s]]:=st1[st0[s]]+1; end; st[pt].insertion_sort_range(1,Jn); Drop; end; OrbitC(gn:CARD) is -- -gn+1 -- make orbit of gn-elements on stack top Pu; st0::=st[pt]; st1::=st[pt+1]; loop s::=0.upto!(Jn1); st0[s]:=0; st1[s]:=0; end; s::=1; so:CARD; loop so:=1.up!; --- st0[Jn1]:=so; st0[s]:=so; loop while!(s<=Jn); st1[s]:=1; loop pt1::=(pt-gn).upto!(pt-1); st0[st[pt1][s]]:=so; end; s:=so; loop s:=s+1; until!((st0[s]=so)and(st1[s]=0)); end; end; st0[Jn1]:=0; --- s:=so; loop s:=s+1; until!(st0[s]=0); end; until!(s>Jn); end; st0[0]:=so; pt0::=pt; Pd(gn); st[pt0]:=st[pt]; st[pt]:=st0; end; CnvCyclicForm is -- +1: -- presents a permutation as product of disjoint cycles. --in:gen. --out: --st1:Yang. --st0 =top:cyclic form. --Cut off st0[] with length of st1[], --then each segment is cycle, and it is the product of cycles. -- -- works. --st2:g permutation --st3:Orbit. --st4:start point of orbit. --st5:length of orbit. Pu; st0::=st[pt]; st1::=st[pt-1]; st2::=st[pt+1]; st3::=st[pt+2]; st4::=st[pt+3]; st5::=st[pt+4]; loop s::=0.upto!(Jn1); st3[s]:=0; end; st2:=st1.copy; s::=1; len,so,so1:CARD; loop so:=1.up!; len:=0; st4[so]:=s; loop st3[s]:=so; s:=st2[s]; len:=len+1; until!(st3[s]>0); end; st5[so]:=len; loop s:=s+1; until!(st3[s]=0); end; until!(s>Jn); end; st3[0]:=so; so:=0; c::=0; loop len:=Jn.downto!(1); loop so1:=1.upto!(st3[0]); if st5[so1]=len then so:=so+1; st1[so]:=len; s:=st4[so1]; loop c:=c+1; st0[c]:=s; s:=st2[s]; until!(s=st4[so1]); end; end; end; end; if c/=Jn then raise "error in CnvCyclicForm.\n"; end; st1[0]:=so; st1[so1+1]:=0; st0[0]:=0; st0[Jn1]:=0; end; ---------------conjugate eq. check------------- -- Specific to conjugacy check of Rep. -- generate c s.t. c~ n c = n for normal element n InitConj is -- +4 -- Assume thet a Yang-diagram is on the stack. st4::=st[pt]; -- start of orbit Dup; st3::=st[pt]; --Yang Pu; st2::=st[pt]; --gen g tag Pu; st1::=st[pt]; -- gen g Pu; st0::=st[pt]; -- g conj. st4[1]:=1; loop s::=1.upto!(st3[0]); st4[s+1]:=st4[s]+st3[s]; end; loop s::=0.upto!(Jn); st2[s]:=s; st1[s]:=s; st0[s]:=s; end; st2[2]:=3; st2[st3[0]+1]:=0; st1[st3[0]+1]:=0; st0[Jn1]:=0; end; private GenConjGen:BOOL is s::=2; s0:CARD; st2::=st[pt-2]; st1::=st[pt-1]; loop while!(st2[s]=1); st2[s]:=s; s:=s+1; end; if s<=st[pt-3][0] then st2[s]:=st2[s]-1; if s.is_odd then s0:=1; else s0:=st2[s]; end; s1::=st1[s]; st1[s]:=st1[s0]; st1[s0]:=s1; return true; end; return false; end; private GenConjRot(on,os,oe:CARD):BOOL is if st[pt-3][on]=1 then return false; end; e::=st[pt][os]; loop i::=os.upto!(oe-1); st[pt][i]:=st[pt][i+1]; end; st[pt][oe]:=e; return e<st[pt][os]; end; private GenConjCanExg:BOOL is st1::=st[pt-1]; st3::=st[pt-3]; loop i::=1.upto!(st3[0]); if st3[i]/=st3[st1[i]] then return false; end; end; return true; end; private GenConjExg is c::=1; loop on::=1.upto!(st[pt-3][0]); on2::=st[pt-1][on]; c2::=st[pt-4][on2]; loop i::=st[pt-4][on].upto!(st[pt-4][on+1]-1); st[pt][c2]:=c; c:=c+1; c2:=c2+1; end; end; end; GenConj:BOOL is -- 0/-5 -- st0::=st[pt]; st1::=st[pt-1]; st2::=st[pt-2]; st3::=st[pt-3]; st4::=st[pt-4]; on:CARD; Jnc:CARD:=st3[0]; loop on:=1.upto!(Jnc); if GenConjRot(on,st4[on],st4[on+1]-1) then return true; end; end; loop if ~ GenConjGen then Pd(5); return false; end; if GenConjCanExg then GenConjExg; return true; end; end; end; GenConjDispose is -- -5. dispose area for GenGonj Pd(5); end;
get_str:STR is -- -1 return get_str(presentationType); end; inspect:STR is -- 0/0 return inspect(pt); end; inspect(p:CARD):STR is -- 0/0 s:STR:="["; loop j::=0.upto!(Jn1); s:=s+" "+st[p][j].str; end; return s+"]"; end; get_str(preType:CARD):STR is -- -1 case preType when 1 then s:STR:=""; loop j::=1.upto!(Jn); s:=s+st[pt][j].str+" "; end; Pd; return s; when 2 then -- cyclic form CnvCyclicForm; s:STR:=""; flg:BOOL:=false; j::=0; loop orbit::=1.upto!(st[pt-1][0]); if st[pt-1][orbit]>=2 then flg:=true; s:=s+"("; loop l::=1.upto!(st[pt-1][orbit]); j:=j+1; if l>1 then s:=s+" "; end; s:=s+st[pt][j].str; end; s:=s+")"; end; end; Pd(2); if ~ flg then s:=s+"1"; end; return s; end; end; WriteStackLog is -- -1 #LOGOUT+get_str; end; end;