On 12/18/06, Joerg Arndt <arndt@jjj.de> wrote:
Can you elaborate? I am big fan of Trotter's algorithm (in fact several implementations are given in pp.233-238 of my scribblings online at http://www.jjj.de/fxt/#fxtbook ).
[fxtbook typo sect 6.9.4.4 --- "An routine" -> "A routine"] I think the best way is probably just to give a (cleaned up) version of the Maple program code, which doesn't use any clever syntax and should be reasonably easy to follow [famous last words]. For somebody who knows the method, the only new idea is the way the parity l of the partial permutation of symbols (k+1,...,n) is continuously updated as the symbol k under consideration increases, until one is found not blocked by smaller symbols along the direction l in which it is currently moving The loop on i which makes the time linear rather than (CAT) constant is avoided in the version I actually use, which just computes everything it needs from the counter, and initialises the array. I'll post that as well for completeness. Sorry about the long lines! Fred Lunnon # Adjacent transposition next permutation generator: # perm = current array of symbols, n = length, cter = name of counter; # result = symbol k transposed; terminate k = n with initial setting restored. # Version for Joerg Arndt utilising only parity of cter; no initialisation; # the loop on i could be avoided using also cter mod n*(n-1)*...*(n+1-k). permute_jj := proc (n, cter, perm) local i,j0,j1,k,l; if n < 2 then k := n else l := (-1)^(eval(cter)-1); # pick up parity j0 := 1; j1 := n; # endpoints of unblocked region k := 1; # current symbol while (perm[j0] = k and l = -1) or (perm[j1] = k and l*(-1)^(j1-j0) = +1) do if perm[j0] = k then j0 := j0+1 # blocked symbol at left end else l := l*(-1)^(j1-j0); j1 := j1-1 fi; # blocked at right k := k+1 od; k := min(n, k); j0 := min(j1, j0); # termination fudge for i from j0 to j1 while perm[i] <> k do od; # locate min unblocked symbol l := l*(-1)^(i+j0); # update symbol direction perm[i] := perm[i+l]; perm[i+l] := k fi; # adjacent transpose cter := eval(cter)+1; # update counter variable in caller k end; # return transposed symbol # Test n := 4: cter := 1: perm := array([seq(i, i = 1..n)]): print(cter, perm); while permute_jj(n, 'cter', perm) < n do print(cter, perm) od: print(cter, perm); # Adjacent transposition permutation generator for n >= 0: constant mean time; # counter set zero to initialise; termination when result = n; user call # cter := 0; perm := array(1..n); while permute('cter', perm) < n do ... od; # initial state restored after termination. permute := proc (cter, perm) local n,i,j0,j1,k,l,cter0,dum; n := op(2, op(2, op(1, perm))); # recover number of symbols if eval(cter) = 0 then # initialise symbol array k := 0; for i from 1 to n do perm[i] := i od; else if n < 2 then k := n+1 else # special cases n = 0,1 cter0 := eval(cter); k := 1; # symbol k currently considered for transposition j0 := 0; j1 := n+1; # limits of smaller symbols blocked at left,right end while cter0 mod(n+1-k) = 0 and k < n do # find smallest unblocked symbol k cter0 := cter0/(n+1-k); k := k+1; if cter0 mod 2 = 0 then j0 := j0+1 else j1 := j1-1 fi od; i := cter0 mod(n+1-k); cter0 := (cter0-i)/(n+1-k); l := 1 - 2*(cter0 mod 2); # direction l of symbol k if l = +1 then i := j0+i else i := j1-i fi; # location i of symbol k dum := perm[i]; perm[i] := perm[i+l]; perm[i+l] := dum; # transpose fi fi; # (know dum = k, except on termination!) cter := eval(cter)+1; # increment counter, called by name k end; # return transposed symbol n := 6; cter := 0; perm := array(1..n); while permute('cter', perm) < n do print(cter, perm) od: print(cter, perm);