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;