入力された有限列に対し、その順列を全て重複することなく列挙する効率的なアルゴリズムとしてHeap's algorithmがあります。このアルゴリズムの著しい特長は、「列挙している前後の順列でちょうど1組のペアを入れ替えるだけ」という点です。
これが効率的な理由でもあるのですが、同じ特長を持つアルゴリズムとしてSteinhaus–Johnson–Trotter (SJT) algorithmが知られています。こちらのSJTアルゴリズムはさらに、「全ての順列を挙げた後に元の入力列に戻る」というもう1つの顕著な特長があります。
このためHeap'sよりもSJTの方がかっこよく見えますが、Heap'sには入力列の長さに依存せず列挙するという別の特長があります。今回は、これをSchemeのSRFI-41で定義されているstreamを用いて無限列を表現することで実演します。以下のプログラムはGuileで動作を確認しています。
(use-modules (srfi srfi-41)
(srfi srfi-43))
(define (Heaps-vector-proc ivec proc)
(let* ((n (vector-length ivec))
(cvec (make-vector n 0)))
(define (loop i)
(when (< i n)
(let ((c_i (vector-ref cvec i)))
(cond ((< c_i i)
(vector-swap! ivec (if (even? i) 0 c_i) i)
(vector-set! cvec i (+ c_i 1))
(proc ivec)
(loop 0))
(else
(vector-set! cvec i 0)
(loop (+ i 1)))))))
(proc ivec)
(loop 0)))
(define-stream (Heaps-stream istr)
(define-stream (loop istr cstr i)
(let ((c_i (stream-ref cstr i)))
(cond ((< c_i i)
(let* ((i_i (stream-ref istr i))
(ostr (if (even? i)
(stream-cons i_i
(stream-append (stream-drop 1 (stream-take i istr))
(stream-cons (stream-ref istr 0)
(stream-drop (+ i 1) istr))))
(stream-append (stream-take c_i istr)
(stream-cons i_i
(stream-append (stream-drop (+ c_i 1) (stream-take i istr))
(stream-cons (stream-ref istr c_i)
(stream-drop (+ i 1) istr))))))))
(stream-cons ostr
(loop ostr
(stream-append (stream-take i cstr)
(stream-cons (+ c_i 1) (stream-drop (+ i 1) cstr)))
0))))
(else
(loop istr
(stream-append (stream-take i cstr)
(stream-cons 0 (stream-drop (+ i 1) cstr)))
(+ i 1))))))
(stream-cons istr (loop istr (stream-constant 0) 0)))
最初の関数Heaps-vector-procは、SRFI-43のvectorで表された入力列ivecの順列ごとに、与えられた手続きprocを呼び出します。例えば、以下のように長さ7の列\([a, b, c, d, e, f, g]\)を列挙します。
scheme@(guile-user)> (define input '(a b c d e f g))
scheme@(guile-user)> (Heaps-vector-proc (list->vector input) (lambda (v) (display v) (newline)))
#(a b c d e f g)
#(b a c d e f g)
#(c a b d e f g)
#(a c b d e f g)
#(b c a d e f g)
#(c b a d e f g)
#(d b a c e f g)
#(b d a c e f g)
#(a d b c e f g)
#(d a b c e f g)
#(b a d c e f g)
#(a b d c e f g)
#(a c d b e f g)
#(c a d b e f g)
#(d a c b e f g)
#(a d c b e f g)
#(c d a b e f g)
#(d c a b e f g)
...
#(c g b d e f a)
#(b g c d e f a)
#(g b c d e f a)
scheme@(guile-user)>
一方、もう1つの関数Heaps-streamは入力としてstreamを取り、出力として順列を表すstreamを列挙するstreamを返します。入力のstreamは無限列でも構いません。
scheme@(guile-user)> (define output (Heaps-stream (list->stream input)))
scheme@(guile-user)> (stream-for-each (lambda (s) (display (stream->list s)) (newline)) (stream-take (* 1 2 3 4 5 6 7) output))
(a b c d e f g)
(b a c d e f g)
(c a b d e f g)
(a c b d e f g)
(b c a d e f g)
(c b a d e f g)
(d b a c e f g)
(b d a c e f g)
(a d b c e f g)
(d a b c e f g)
(b a d c e f g)
(a b d c e f g)
(a c d b e f g)
(c a d b e f g)
(d a c b e f g)
(a d c b e f g)
(c d a b e f g)
(d c a b e f g)
...
(c g b d e f a)
(b g c d e f a)
(g b c d e f a)
scheme@(guile-user)> (define n (stream-from 0)) ; a stream of natural numbers from 0
scheme@(guile-user)> (define s (Heaps-stream n))
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 0)))
$1 = (0 1 2 3 4 5 6 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 1)))
$2 = (1 0 2 3 4 5 6 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 2)))
$3 = (2 0 1 3 4 5 6 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 100)))
$4 = (4 1 3 2 0 5 6 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 1000)))
$5 = (2 6 0 1 5 4 3 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 10000)))
$6 = (3 4 0 2 1 5 7 6 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 100000)))
$7 = (5 0 8 1 7 2 3 6 4 9)
scheme@(guile-user)>
最後になりますが、Heap'sは入力が無限列でも順列を列挙しますが、あり得る順列を網羅はできないことに注意してください。集合論の言葉では、無限集合\(X\)の順列全体の集合、つまり\(X\)から\(X\)への全単射全体の集合は非可算です。Heap'sは入力列のうち有限個の要素だけ入れ替えた順列を網羅します。しかし、例えば、無限入力列の偶数番目の要素全体と奇数番目の要素全体を入れ替えた順列は含まれていません。