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;