repstack.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
class REP_STACK
class REP_STACK is
-- 1996/10
--LINUX version
--
--Kouji Kodama 1989/8
-- kernel of computing the group S(Jn).
attr st:ARRAY{ARRAY{INT}}; -- stack
readonly attr Jn:INT; -- index of permutation
readonly attr Jn1:INT; -- Jn+1
readonly attr Jn2:INT; -- Jn+2
attr pt:INT; -- stack pointer. assume that stack.has_ind(pt).
attr bottom:INT;
attr presentationType:INT;
private generate_stack(jn:INT):SAME is
res:SAME:=new;
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.Jn2);
res.st[0].to_val(0);
res.presentationType:=2;
res.resize;
return res;
end;
create(jn:INT):SAME is
return generate_stack(jn);
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]:=#(Jn2); end;
end;
end;
---------------------stack operations----------------------
Pu is
-- +1
pt:=pt+1;
resize;
end;
Pu(n:INT) is
-- +n
pt:=pt+n;
resize;
end;
Pd post (pt>=bottom) is
-- -1
pt:=pt-1;
end;
Pd(n:INT) is
-- -n
pt:=pt-n;
end;
Fetch(i:INT) is
-- +1
Pu;
if i>=0 then st[pt]:=st[i].copy;
else i1::=-i;
st[pt]:=#(Jn2);
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>=0 then st[i]:=st[pt].copy;
else i1::=-1;
loop s::=1.upto!(Jn); st[i1][st[pt][s]]:=s; end; -- Inv
st[i1][0]:=0; st[i1][Jn1]:=0;
end;
Pd;
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;
------------ 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:INT) 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:INT) 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>=0 then
if P>=0 then CjP(P,Q); else CjP(-P,Q); Inv; end;
else
if P>=0 then CjN(P,-Q); else CjN(-P,-Q); Inv; end;
end;
end;
Mul is
-- -1
-- store(a); store(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]/=0 then
p::=st[pt-1]; q::=st[w[i].abs]; r::=st[pt];
if w[i]>0 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;
s0:INT;
if s<=Jn then
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]>0);
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:INT) 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:INT;
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:INT;
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:INT;
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:INT;
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]>0); 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:INT) 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:INT;
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:INT;
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.MOD.
-- Conjugate of the normal form element be normal form.
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;
-- Jnc::=st3[0]; Jnc1::=Jnc+1;
st2[2]:=3; st2[st3[0]+1]:=0; st1[st3[0]+1]:=0; st0[Jn1]:=0;
end;
-- Jnc:=st3[0]; Jnc1:=Jnc+1;
private GenConjGen:BOOL is
s::=2; s0:INT;
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:INT):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,os,oe, Jnc:INT;
on:=1; os:=1; oe:=st4[2]-1; Jnc:=st3[0];
loop while!((on<=Jnc) and (~ GenConjRot(on,os,oe))) ;
on:=on+1; os:=st4[on]; oe:=st4[on+1]-1;
end;
if on<=Jnc then return true; end;
loop
if ~ GenConjGen then Pd(5); return false; end;
if GenConjCanExg then GenConjExg; return true; end;
end;
end;
get_str:STR is
-- -1
return get_str(presentationType);
end;
get_str(preType:INT):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;