:

## Faster Permutations

Maple

A recent post asks how to create a Maple permutation iterator, that is, a procedure that, on successive calls, iterates through each permutation of a given input.  I suggested a routine that solved the problem, however, I wasn't satisfied with it.  It was slower than it should be.  Later I suggested an improvement.  Here is another improvement.  It uses the same algorithm (algorithm L, from The Art of Computer Programming, vol. 4, fasicle 2, by Donald E. Knuth) if the input has repeated elements, but uses a different method, algorithm T, ibid., if the input consists of distinct elements.  The sequences of permutations for the two algorithms differ, the second algorithm uses the initial order for the first element and consecutive outputs differ by one transposition.

The output is returned as a one-dimensional rtable.  This makes computing all permutations of reasonable sized lists efficient.  Note that iterating through all permutations of, say, a 10 element list of distinct items is substantially faster and, more significantly, less memory hungry, than attempting to instantiate all elements using combinat[permute].

```Permute := module()
export ModuleApply, Permute, Compile;
local AlgL, AlgT, compiled;

Compile := proc()
if compiled=true then
error "procedures are already compiled";
end if;
AlgL := Compiler:-Compile(AlgL);
AlgT := Compiler:-Compile(AlgT);
compiled := true;
NULL;
end proc;

ModuleApply := Permute;

Permute := proc(L :: Or(set,list,posint,range(integer)))
local u,n,DataType;

if L :: 'posint' then return procname([seq(u, u = 1..L)]);
elif L :: 'range' then return procname([seq(u, u = L)]);
end if;

DataType := 'datatype'='integer'[iquo(kernelopts('wordsize'),8)];

n := nops(L);
if n > 1 and (L :: set or n = nops(convert(L,'set'))) then

# elements are distinct

module()
export nextvalue, finished;
local complete,cnt,T,V,N;

V := rtable(convert(L,'list'));
N := n!;

T := rtable(1..N-1, DataType);
AlgT(T,n);
cnt := 0;
complete := evalb(n=0);
finished := () -> complete;

nextvalue := proc()
local j,k;
if complete then
error "attempt to call nextvalue on finished iterator";
end if;
if cnt<>0 then
j := T[cnt];
k := j+1;
(V[j], V[k]) := (V[k],V[j]);
end if;
cnt := cnt+1;
if cnt = N then
complete := true;
end if;
return V;
end proc;
end module;
else

# repeated elements

module()
export nextvalue, finished;
local complete,cnt,P,A,V;

A := rtable(1..n, sort(map(addressof,convert(L,'list')))
, DataType);
V := rtable(1..n, i -> pointto(A[i]));

cnt := 0;
P := rtable(1..n,1..2, DataType);

complete := evalb(n=0);
finished := () -> complete;

nextvalue := proc()
local i,j,k;
if complete then
error "attempt to call nextvalue on finished iterator";
end if;

# permute V per previous computation

for i to cnt do
(j,k) := (P[i,1],P[i,2]);
(V[j], V[k]) := (V[k],V[j]);
end do;
cnt := AlgL(A,P,n);
if cnt = 0 then complete := true end if;
return V;
end proc;
end module;
end if
end proc:

# This uses Algorithm L, pp 39-40, from
# "The Art of Computer Programming," vol 4, fasicle 2,
# "Generating all Tuples and Permutations", Donald Knuth

AlgL := proc(A :: Array(datatype=integer[BytesPerWord])
, P :: Array(datatype = integer[BytesPerWord])
, n :: posint
)

local j,k,l,cnt;

for j from n-1 to 1 by -1 do
if A[j+1] > A[j] then break; end if;
end do;

if j=0 then
return 0;
end if;

for l from n by -1 do
if A[l] > A[j] then break; end if;
end do;

(A[j],A[l]) := (A[l],A[j]);
cnt := 1;
P[1,1] := j;
P[1,2] := l;

l := n;
for k from j+1 do
if k >=l then break; end if;
(A[k],A[l]) := (A[l],A[k]);
cnt := cnt+1;
P[cnt,1] := k;
P[cnt,2] := l;
l := l-1;
end do;
return cnt;
end proc;

AlgT := proc(t :: Array(datatype=integer[BytesPerWord])
, n :: posint
)
local N,d,j,k,m;
N := n!;
d := N/2;
t[d] := 1;
k := N;
m := 2;
do
if k >= N then
if m=n then break; end if;
m := m+1;
d := d/m;
k := 0;
end if;

k := k+d;
j := m-1;
while j > 0 do
t[k] := j;
j := j-1;
k := k+d;
end do;

t[k] := t[k]+1;
k := k+d;

while j < m-1 do
j := j+1;
t[k] := j;
k := k+d;
end do;
end do;
return NULL;
end proc;

use bytesperword = iquo(kernelopts('wordsize'),8) in
AlgL := subs('BytesPerWord'=bytesperword, eval(AlgL));
AlgT := subs('BytesPerWord'=bytesperword, eval(AlgT));
end use;

end module:

LibraryTools:-Save(Permute,"Permute.mla");
```

Here is how it can be used.

```libname := libname,currentdir():