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 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 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 ] 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 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 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 ] i:INT:=rank; loop while!(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;