permutation.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
class PERM_NR_STREAM
class PERM_NR_STREAM is
-- generate all permutations of {1..n}, P(n,r) by lexical order.
-- K.Kodama
attr perm:ARRAY{INT};
attr perm_r:ARRAY{INT};
attr pos:ARRAY{INT};
attr num:INT;
attr rank:INT;
create(n,r:INT):SAME pre (r<=n)and(0<=r) is
res:SAME:=new;
res.num:=n; res.rank:=r;
res.pos:=#(r+1); res.pos.to_val(1); res.pos[r]:=0;
res.perm:=#(r+1); res.perm.to_val(0);
loop i::=1.upto!(r-1); res.perm[i]:=i; end;
res.perm_r:=#(n+1); res.perm_r.to_val(0);
loop i::=1.upto!(r-1); res.perm_r[i]:=i; end;
return res;
end;
get(out p:ARRAY{INT}):BOOL is
-- format: [0, permutation ]
-- Example: {2,5,3} from {1..5} then returns {0,2,5,3}
if num<rank then p:=|0|; return false;
elsif rank<=0 then num:=rank-1; p:=|0|; return true;
end;
i:INT:=rank;
loop while!(pos[i]>=num-i+1);
perm_r[perm[i]]:=0; perm[i]:=1; pos[i]:=1; i:=i-1;
end;
if i<=0 then return false; end;
perm_r[perm[i]]:=0; perm[i]:=perm[i]+1; pos[i]:=pos[i]+1;
loop i1::=i.upto!(rank);
j:INT; loop j:=perm[i1].up!; until!(perm_r[j]=0); end;
perm_r[j]:=i1; perm[i1]:=j;
end;
p:=perm.copy; return true;
end;
end;
class COMBI_NR_STREAM
class COMBI_NR_STREAM is
-- generate all combinations of {1..n} C(n,r) by lexical order.
-- K.Kodama
attr pos:ARRAY{INT}; -- 1<=pos[i]<=n-r+i
attr num:INT;
attr rank:INT;
create(n,r:INT):SAME pre (r<=n)and(0<=r) is
res:SAME:=new; res.num:=n; res.rank:=r;
res.pos:=#(r+1); loop i::=0.upto!(r); res.pos[i]:=i; end;
res.pos[r]:=r-1;
return res;
end;
get(out c:ARRAY{INT}):BOOL is
-- format: [0, combination of 1 to n ]
-- For C(n,0). return |0| once.
if num<rank then c:=|0|; return false;
elsif rank<=0 then num:=rank-1; c:=|0|; return true;
end;
i:INT:=rank; loop while!((i>0)and(pos[i]>=num-rank+i)); i:=i-1; end;
if i<=0 then return false; end;
pos[i]:=pos[i]+1;
loop i1::=(i+1).upto!(rank); pos[i1]:=pos[i1-1]+1; end;
c:=pos.copy; return true;
end;
end;
class PERM_STREAM
class PERM_STREAM is
-- generating all permutations in S(Jn).
-- Heap's algorithm.
-- c.f. Robert Sedgewick,"Permutation Generating Methods",
-- Computing Surveys, Vol.9, No.2, June 1977.
attr perm:PERM;
attr c:ARRAY{INT};
create(n:INT):SAME is
r:SAME:=new; r.perm:=#(n);
r.c:=#(n+2); loop i::=0.upto!(n); r.c[i]:=i; end;
r.c[2]:=3; r.c[n+1]:=0;
return r;
end;
get(out p:PERM):BOOL is
k::=2; loop while!(c[k]=1); c[k]:=k; k:=k+1; end;
if k<=perm.jn then
c[k]:=c[k]-1;
if k.is_odd then perm.swap(1,k) else perm.swap(c[k],k); end;
p:=perm.copy; return true;
end;
p:=perm.copy; return false;
end;
end;
class YANG_STREAM
class YANG_STREAM is
-- Generate all Yang diagrams.
-- format: [ #orbit, length of orbits(sorted), fill 0 upto jn+1].
-- K.Kodama.
attr yang:ARRAY{INT};
attr jn:INT;
create(n:INT):SAME is
r:SAME:=new; r.jn:=n;
r.yang:=#(n+2); r.yang.to_val(1); r.yang[0]:=0; r.yang[n+1]:=0;
return r;
end;
get(out y:ARRAY{INT}):BOOL is
if yang[0]=0 then yang[0]:=jn; y:=yang.copy; return true;
elsif yang[0]=1 then y:=yang.copy; return false;
else
s0,s1:INT;
s1:=yang[0]; yang[0]:=0;
count::=0;
loop
count:=count+yang[s1]; yang[s1]:=0; s1:=s1-1;
until!(yang[s1-1]/=yang[s1]);
end;
yang[s1]:=yang[s1]+1;
loop (count-1).times!; s1:=s1+1; yang[s1]:=1; end;
yang[0]:=s1;
y:=yang.copy;
return true;
end;
end;
end;
class PERM_Y_STREAM
class PERM_Y_STREAM is
-- generate permutations according to Yang.
-- K.Kodama
attr st3,st4,st5:ARRAY{INT}; -- work
attr yang:ARRAY{INT};
attr orbit:ARRAY{INT};
attr jn:INT;
private CnvG:PERM is
-- set perm from orbit and yang
perm:PERM:=#(jn);
s1::=1;
loop o::=1.upto!(yang[0]);
count::=1; s0::=orbit[s1];
loop while!(count<yang[o]);
perm[orbit[s1]]:=orbit[s1+1]; s1:=s1+1; count:=count+1;
end;
perm[orbit[s1]]:=s0; s1:=s1+1;
end;
return perm;
end;
create(y:ARRAY{INT}):SAME is
n:INT:=PERM::check_yang(y);
r:SAME:=new; r.jn:=n; r.yang:=y.copy;
if n<=0 then return r; end;
r.st5:=#(n+2); r.st5.to_val(0);
s,s0,s1,len:INT;
s0:=1;
loop o::=1.upto!(y[0]);
-- check same length
s:=s0; r.st5[s]:=0; s1:=o; len:=y[o];
loop while!(len=y[s1]); r.st5[s]:=r.st5[s]+len; s1:=s1+1; end;
s:=s+1;
loop while!(s<s0+len); r.st5[s]:=1; s:=s+1; end;
s0:=s;
end;
r.orbit:=#(n+2); loop i::=0.upto!(n); r.orbit[i]:=i; end;
r.orbit[0]:=1; r.orbit[n+1]:=0;
r.st3:=#(n+2); r.st3.to_val(1);
r.st4:=#(n+2); loop i::=0.upto!(n); r.st4[i]:=n+1-r.st5[i]; end;
return r;
end;
get(out perm:PERM):BOOL is
if orbit[0]=1 then orbit[0]:=0; perm:=CnvG; return true; end;
s2::=yang[0]; s1::=jn; s0::=jn+1-yang[s2]; st3[orbit[s1]]:=0;
s4:INT;
loop
if orbit[s1]>=st4[s1] then
orbit[s1]:=0; s1:=s1-1; s4:=st4[s1];
if s1<=0 then perm:=#(jn); return false; end;
if s1<s0 then s2:=s2-1; s0:=s0-yang[s2]; end;
st3[orbit[s1]]:=0;
else
orbit[s1]:=orbit[s1]+1;
if st3[orbit[s1]]=0 then
st3[orbit[s1]]:=1;
if s1=jn then perm:=CnvG; return true; end;
s1:=s1+1;
if s1>=s0+yang[s2] then -- new orbit
s0:=s1;
-- set end of orbit[*] , s4 and st4[*]
count::=st5[s1]; s4:=jn+1;
loop
s4:=s4-1;
if st3[s4]=0 then count:=count-1; end;
until!(count=0);
end;
st4[s0]:=s4;
s2:=s2+1;
-- set orbit[*] to start
if yang[s2]=yang[s2-1] then
-- same length
orbit[s0]:=orbit[s0-yang[s2]];
end;
else orbit[s1]:=orbit[s0];
end;
end;
end;
end;
perm:=#(jn); return false;
end;
end;
class PERM < $IS_LT{PERM},$STR,$HASH
class PERM < $IS_LT{PERM},$STR,$HASH is
-- permutation group S(jn)
-- format: p[0]=0 and p[jn+1]=0.
-- [1..jn]: permutation as a map p[i].
include COMPARABLE;
attr p:ARRAY{INT};
attr jn:INT;
alloc(n:INT):SAME is
-- allocate
r:SAME:=new; r.jn:=n; r.p:=#(n+2); r.p[0]:=0; r.p[n+1]:=0; return r;
end;
create(n:INT):SAME is
-- trivial permutation.
r:SAME:=alloc(n); loop i::=0.upto!(n); r.p[i]:=i; end;
return r;
end;
one(n:INT):SAME is
return create(n);
end;
copy:SAME is
r:SAME:=new; r.jn:=jn; r.p:=p.copy; return r;
end;
str:STR is
s:STR:=""; s1:STR:="";
loop i::=1.upto!(jn); s:=s+s1+p[i].str; s1:=" "; end;
return s;
end;
str_orbit:STR is
os::=orbits;
s:STR:="";
loop o::=os.ind!;
s:=s+"("; sep:STR:="";
loop e::=os[o].elt!;
s:=s+sep+e.str; sep:=",";
end;
s:=s+")";
end;
return s;
end;
hash:INT is
hval ::= 0; -- c.f. INTI::hash
loop i::=1.upto!(jn); hval:=hval.bxor(p[i]).lrotate(3); end;
return hval;
end;
aget(i:INT):INT is
return p[i];
end;
aset(i:INT, x:INT) is
p[i]:=x;
end;
compare(o:SAME):INT is
-- <=> : rank--lexical order.
s:INT:=(jn-o.jn).sign; if s/=0 then return s; end;
loop i::=p.ind!;
s:=(p[i]-o.p[i]).sign; if s/=0 then return s; end;
end;
return 0;
end;
is_eq(o:SAME):BOOL is
return compare(o)=0;
end;
is_lt(o:SAME):BOOL is
-- c.f. compare
return compare(o)<0;
end;
is_one:BOOL is
loop i::=1.upto!(jn); if i/=p[i] then return false; end; end;
return true;
end;
times(o:SAME):SAME pre jn=o.jn is
r:SAME:=alloc(jn);
loop i::=1.upto!(jn); r.p[i]:=o.p[p[i]]; end;
return r;
end;
swap(i,j:INT) is
-- (i,j) * self
t::=p[i]; p[i]:=p[j]; p[j]:=t;
end;
swap(i,j:INT):SAME is
-- (i,j) * self
r::=copy; r.swap(i,j); return r;
end;
inv:SAME is
-- self~. inverse.
r:SAME:=alloc(jn); loop i::=1.upto!(jn); r.p[p[i]]:=i; end;
return r;
end;
div(o:SAME):SAME pre jn=o.jn is
-- self * o~
return times(o.inv);
end;
pow(n:INT):SAME is
r:SAME:=#(jn); w:SAME; s:INT;
if n<0 then s:=-n; w:=inv; else s:=n; w:=copy; end;
loop while!(s>0);
if n.is_odd then r:=r*w; end;
s:=s/2; w:=w*w;
end;
return r;
end;
inv_times(o:SAME):SAME pre jn=o.jn is
-- self~ * o
r:SAME:=alloc(jn); loop i::=1.upto!(jn); r.p[p[i]]:=o.p[i]; end;
return r;
end;
conj(o:SAME):SAME pre jn=o.jn is
-- o * self * o~
r:SAME:=alloc(jn); oi::=o.inv;
loop i::=1.upto!(jn); r.p[i]:=oi.p[p[o.p[i]]]; end;
return r;
end;
conj_inv(o:SAME):SAME pre jn=o.jn is
-- o~ * self * o
r:SAME:=alloc(jn);
loop i::=1.upto!(jn); r.p[o[i]]:=o.p[p[i]]; end;
return r;
end;
inv_conj_inv(o:SAME):SAME pre jn=o.jn is
-- o~ * self~ * o
r:SAME:=alloc(jn);
loop i::=1.upto!(jn); r.p[ o.p[p[i]]]:=o.p[i]; end;
return r;
end;
inv_conj(o:SAME):SAME pre jn=o.jn is
-- o * self~ * o~ = (o*self*o~)~
return self.inv.conj(o);
end;
parity0(perm:ARRAY{INT}):INT is
-- parity of premutation [0..n-1]
j:INT;
w:ARRAY{INT}:=#(perm.size); loop i:INT:=w.ind!; w[perm[i]]:=i; end;
s::=1;
loop i:INT:=0.upto!(perm.size-2);
j:=perm[i]; if j/=i then perm[w[i]]:=j; w[j]:=w[i]; s:=-s; end;
end;
return s;
end;
parity:INT is
w0::=copy; w::=inv; s::=1; j:INT;
loop i:INT:=1.upto!(jn-1);
j:=w0[i]; if j/=i then w0[w[i]]:=j; w[j]:=w[i]; s:=-s; end;
end;
return s;
end;
braid:BRAID is
-- permutation to braid word of standard form.
-- i.e. i<j, i-th string is cross over with j-th string.
w:BRAID:=#(jn);
loop i::=(jn-1).downto!(1);
loop j::=(i+1).upto!(jn);
if p[i]>p[j] then w:=w*(-(i.up!)); end;
end;
end;
return w;
end;
mark_orbit(out mark:ARRAY{INT}, out length:ARRAY{INT}) is
-- mark up orbits.
-- format of mark
-- [0]:= #of orbits, [i]:= p[i] is element of [i]-th orbit, [jn+1]:=0.
-- format of length
-- [0]:= #of orbits, [i]:= length of i-th orbit.
mark:=#(jn+2); mark.to_val(0);
length:=#(jn+2); length.to_val(0);
so:INT:=0; s:INT:=1;
loop
so:=so+1;
loop -- trace the orbit
mark[s]:=so; length[so]:=length[so]+1;
s:=p[s]; until!(mark[s]>0);
end;
loop s:=s+1; until!(mark[s]=0); end; -- prepare for next orbit
until!(s>jn);
end;
mark[0]:=so; length[0]:=so; -- # of orbits
end;
private orbit_is_lt(o1,o2:ARRAY{INT}):BOOL is
-- sort function for orbits.
if o1.size=o2.size then return o1[0]<o2[0];
else return o1.size>o2.size;
end;
end;
orbits:ARRAY{ARRAY{INT}} is
oarr:ARRAY{ARRAY{INT}}; oarr:=#;
mark:ARRAY{INT}:=#(jn+2); mark.to_val(0);
so:INT:=0; s:INT:=1;
loop
so:=so+1;
orbit:ARRAY{INT}; orbit:=#;
loop -- trace the orbit
mark[s]:=so;
orbit:=orbit.append(|s|);
s:=p[s]; until!(mark[s]>0);
end;
oarr:=oarr.append(|orbit|);
loop s:=s+1; until!(mark[s]=0); end; -- prepare for next orbit
until!(s>jn);
end;
o_lt:ROUT{ARRAY{INT},ARRAY{INT}}:BOOL:=bind(orbit_is_lt(_,_));
oarr.insertion_sort_by(o_lt);
return oarr;
end;
Yang_diagram:ARRAY{INT} is
-- Yang diagram(list of length of orbits)
-- format: [ #orbit, length of orbits(sorted), fill 0 upto jn+1]
mark, length:ARRAY{INT};
mark_orbit(out mark,out length);
ARRAY_SORT{INT}::insertion_sort_range(inout length,1,jn);
return length;
end;
check_yang(yang:ARRAY{INT}):INT is
n:INT:=0;
so:INT:=yang[0]; -- # of orbits
if (so<=0)or(yang.has_ind(so).not) then return n; end;
loop i::=1.upto!(so); n:=n+yang[i]; end;
loop i::=(so+1).upto!(yang.size-1);
if yang[i]/=0 then return 0; end;
end;
return n;
end;
create_from_yang(yang:ARRAY{INT}):SAME is
-- standard permutation for the yang diagram.
n:INT:=check_yang(yang);
if n<=0 then return #SAME(1); end;
r:SAME:=alloc(n);
s0::=1; s1::=1; count::=0;
loop s::=1.upto!(n);
count:=count+1;
if count=yang[s1] then r.p[s]:=s0; s0:=s+1; count:=0; s1:=s1+1;
else r.p[s]:=s+1;
end;
end;
return r;
end;
end;