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{CARD};
attr perm_r:ARRAY{CARD};
attr pos:ARRAY{CARD};
attr num:CARD;
attr rank:CARD;
create(n,r:CARD):SAME pre (r<=n) 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);
res.perm_r:=#(n+1); res.perm.to_val(0);
if r>0 then
loop i::=0.upto!(r-1); res.perm[i]:=i; res.perm_r[i]:=i; end;
end;
return res;
end;
get(out p:ARRAY{CARD}):BOOL is
-- format: [0, permutation ]
-- Example: {2,5,3} from {1..5} then returns {0,2,5,3}
-- For P(n,0). return |0| once.
if pos[0]>1 then p:=|0|; return false;
elsif num<rank then p:=|0|;return false;
elsif num=0 then p:=|0|; pos[0]:=2; return true;
elsif rank<=0 then num:=0; p:=|0|; pos[0]:=2; return true;
end;
i:CARD:=rank;
loop while!((i>0) and (pos[i]+i>=num+1));
perm_r[perm[i]]:=0;
perm[i]:=1;
pos[i]:=1;
i:=i-1;
end;
if i.is_zero 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:CARD;
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{CARD}; -- 1<=pos[i]<=n-r+i
attr num:CARD;
attr rank:CARD;
create(n,r:CARD):SAME pre (r<=n) is
res:SAME:=new; res.num:=n; res.rank:=r;
res.pos:=#(r+1); loop res.pos.set!(0.up!); end;
if r.is_pos then res.pos[r]:=r-1; end;
return res;
end;
get(out c:ARRAY{CARD}):BOOL is
-- format: [0, combination of 1 to n ]
-- For C(n,0). return |0| once.
if pos[0]/=0 then c:=|0|; return false;
elsif num<rank then c:=|0|; return false;
elsif num=0 then c:=|0|; pos[0]:=1; return true;
elsif rank<=0 then num:=0; c:=|0|; pos[0]:=1; return true;
end;
i:CARD:=rank; loop while!((i>0)and(pos[i]+rank>=num+i)); i:=i-1; end;
if i.is_zero 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{CARD};
create(n:CARD):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{CARD};
attr jn:CARD;
create(n:CARD):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{CARD}):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:CARD;
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{CARD}; -- work
attr yang:ARRAY{CARD};
attr orbit:ARRAY{CARD};
attr jn:CARD;
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{CARD}):SAME is
n:CARD:=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:CARD;
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:CARD;
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{CARD};
attr jn:CARD;
private alloc(n:CARD):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:CARD):SAME is
-- trivial permutation.
r:SAME:=alloc(n); loop i::=0.upto!(n); r.p[i]:=i; end;
return r;
end;
create(perm:ARRAY{CARD},base:CARD):SAME is
-- perm: permutation of base .. size+base-1
r:SAME:=alloc(perm.size); loop r.p.set!(1,perm.elt!(base)+1-base); end;
return r;
end;
one(n:CARD):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(lib : LIBCHARS) : STR is
return str;
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:CARD is
Prime : FIELD := 19 ;
res : FIELD := FIELD::zero ;
index : CARD := CARD::zero ;
loop i::=1.upto!(jn);
res := (res + p[i].field + i.field) * Prime ;
end ;
return res.card;
end;
aget(i:CARD):CARD is
return p[i];
end;
aset(i:CARD, x:CARD) is
p[i]:=x;
end;
compare(o:SAME):INT is
-- <=> : rank--lexical order.
s:INT:=(jn.int-o.jn.int).sgn; if s.is_non_zero then return s; end;
loop i::=p.ind!;
s:=(p[i].int-o.p[i].int).sgn; if s.is_non_zero then return s; end;
end;
return INT::zero;
end;
is_eq(o:SAME):BOOL is
return compare(o).is_zero;
end;
is_lt(o:SAME):BOOL is
-- c.f. compare
return compare(o).is_neg;
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:CARD) is
-- (i,j) * self
t::=p[i]; p[i]:=p[j]; p[j]:=t;
end;
swap(i,j:CARD):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:CARD;
if n.is_neg then s:=(-n).card; w:=inv; else s:=n.card; w:=copy; end;
loop while!(s.is_pos);
if s.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;
--sgn(perm:ARRAY{CARD}):INT is
--parity of premutation [0..n-1]
--j:CARD;
--w:ARRAY{CARD}:=#(perm.size); loop i:CARD:=w.ind!; w[perm[i]]:=i; end;
--s:INT:=1.int;
--if perm.size<2 then return s; end;
--loop i:CARD:=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;
sgn:INT is
-- 1/-1 : parity of premutation p[1..jn]
p0:SAME:=copy; p1:SAME:=inv;
s:INT:=1.int;
loop i:CARD:=1.upto!(jn-1); j::=p0[i];
if j/=i then
p0[p1[i]]:=j; p1[j]:=p1[i]; s:=-s;
--p0[i]:=i; p1[i]:=i;
end;
end;
--#OUT+"perm:"+str+":"+p0.str+":"+p1.str+"\n"; assert p0.is_one and p1.is_one;
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!.int)); end;
end;
end;
return w;
end;
mark_orbit(out mark:ARRAY{CARD}, out length:ARRAY{CARD}) 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:CARD:=0; s:CARD:=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{CARD}):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{CARD}} is
oarr:ARRAY{ARRAY{CARD}}; oarr:=#;
mark:ARRAY{CARD}:=#(jn+2); mark.to_val(0);
so:CARD:=0; s:CARD:=1;
loop
so:=so+1;
orbit:ARRAY{CARD}; 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{CARD},ARRAY{CARD}}:BOOL:=bind(orbit_is_lt(_,_));
oarr.insertion_sort_by(o_lt);
return oarr;
end;
Yang_diagram:ARRAY{CARD} is
-- Yang diagram(list of length of orbits)
-- format: [ #orbit, length of orbits(sorted), fill 0 upto jn+1]
mark, length:ARRAY{CARD};
mark_orbit(out mark,out length);
ARRAY_SORT{CARD}::insertion_sort_range(inout length,1,jn);
return length;
end;
check_yang(yang:ARRAY{CARD}):CARD is
-- check if format is correct
-- 0 for bad format. positive for otherwise
n:CARD:=0;
so:CARD:=yang[0]; -- # of orbits
if (so.is_zero)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{CARD}):SAME is
-- standard permutation for the yang diagram.
n:CARD:=check_yang(yang);
if n.is_zero 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;
is_regular:BOOL is
-- Orbits have same length.
y::=Yang_diagram;
loop
i::=1.upto!(y[0]);
if y[i]/=y[1] then return false; end;
end;
return true;
end;
end;
class TEST_PERM
class TEST_PERM is
include TEST;
test_perm_stream is
class_name("PERM_STREAM");
arr:ARRAY{CARD};
perm:PERM;
count:CARD;
perm_s:PERM_STREAM:=#(5);
count:=0;
loop while!(perm_s.get(out perm)); count:=1.up!;
-- #OUT+count.str+" "+perm.str+"\n";
end;
test("generate perm", count.str, 120.str);
count:=0;
ys:YANG_STREAM:=#(4);
yang:ARRAY{CARD};
loop while!( ys.get(out yang));
ps:PERM_Y_STREAM:=#(yang);
loop while!( ps.get(out perm));
count:=count+1;
-- #OUT+perm.str+"="+perm.str_orbit+"\n";
end;
end;
test("generate yang,perm", count.str, 24.str);
perm_nrs:PERM_NR_STREAM:=#(5,3);
count:=0;
loop while!(perm_nrs.get(out arr));
count:=1.up!;
#OUT+arr.str+"\n";
end;
test("generate perm(5,3)", count.str, 60.str);
perm_nrs:=#(1,1);
count:=0;
loop while!(perm_nrs.get(out arr));
count:=1.up!;
#OUT+arr.str+"\n";
end;
test("generate perm(1,1)", count.str, 1.str);
perm_nrs:=#(5,0);
count:=0;
loop while!(perm_nrs.get(out arr));
count:=1.up!;
#OUT+arr.str+"\n";
end;
test("generate perm(5,0)", count.str, 1.str);
perm_nrs:=#(0,0);
count:=0;
loop while!(perm_nrs.get(out arr));
count:=1.up!;
#OUT+arr.str+"\n";
end;
test("generate perm(0,0)", count.str, 1.str);
combi_nrs:COMBI_NR_STREAM:=#(5,3);
count:=0;
loop while!(combi_nrs.get(out arr));
count:=1.up!;
#OUT+arr.str+"\n";
end;
test("generate combi(5,3)", count.str, 10.str);
combi_nrs:=#(5,5);
count:=0;
loop while!(combi_nrs.get(out arr));
count:=1.up!;
#OUT+arr.str+"\n";
end;
test("generate combi(5,5)", count.str, 1.str);
combi_nrs:=#(5,0);
count:=0;
loop while!(combi_nrs.get(out arr));
count:=1.up!;
#OUT+arr.str+"\n";
end;
test("generate combi(5,0)", count.str, 1.str);
combi_nrs:=#(0,0);
count:=0;
loop while!(combi_nrs.get(out arr));
count:=1.up!;
#OUT+arr.str+"\n";
end;
test("generate combi(0,0)", count.str, 1.str);
finish;
end;
test_perm is
class_name("PERM");
s:STR;
perm_s:PERM_STREAM:=#(3);
p,p1:PERM;
w:BRAID;
s:="OK";
loop while!(perm_s.get(out p));
w:=p.braid; p1:=w.perm;
-- #OUT+p.str+" | "+w.str+"\n";
if p/=p1 then
s:="failed to convert\n";
end;
w1::=w;
#OUT+"call reduction\n";
w1:=BRAID_REDUCTION::wordReduction(w,false);
#OUT+"w="+w.str+", w1="+w1.str+"\n";
end;
test("convert word",s,"OK");
p:=#(5);
p.p:=|0,2, 3, 1, 5, 4,0|;
s:=p.str_orbit;
test("str_orbit",s,"(1,2,3)(4,5)");
finish;
end;
main is
test_perm_stream;
test_perm;
end;
end;