Racket で順列組合せを生成

最近、scheme 処理系の（？） Racket という言語を使ってみている。いわゆる batteries included の精神なのか、インスタントなサーバやプレゼン用のライブラリがあったり、図形が関数で作れたり（しかも対話環境で返り値として画像が表示される）、いろいろ凝ってて面白い。
そういうのでひとしきり遊んだところで、今日は順列・組合せの生成関数を書いてみた。全然先進的な話題じゃありません。

#lang racket

(define (for-perm n proc)
  (unless (exact-positive-integer? n)
    (error "n is illegal"))
  (define perm (make-vector n #f))
  (define flag (make-vector n #f))
  (define (perm-set! i x) (vector-set! perm i x))
  (define (used? x) (vector-ref flag x))
  (define (on! x) (vector-set! flag x #t))
  (define (off! x) (vector-set! flag x #f))
  (define (perm1 i)
    (if (= i n)
        (proc (vector->list perm))
        (for ((x (in-range n)))
          (unless (used? x)
            (on! x)
            (perm-set! i x)
            (perm1 (add1 i))
            (off! x)))))
  (perm1 0))

(define (for-comb n m proc)
  (unless (and (integer? m) (<= 0 m n))
    (error "m is illegal"))
  (define comb (make-vector n #f))
  (define (on? i) (vector-ref comb i))
  (define (on! i) (vector-set! comb i #t))
  (define (off! i) (vector-set! comb i #f))
  (define (comb->list)
    (let rec ((i 0) (count 0))
      (cond
        ((= count m) null)
        ((on? i) (cons i (rec (add1 i) (add1 count))))
        (else (rec (add1 i) count)))))
  (define (possible? i count)
    (> (+ n count) (+ m i)))            ; (>= (- n i 1) (- m count))
  (define (comb1 i count)
    (if (= count m)
        (proc (comb->list))
      (begin
        (on! i)
        (comb1 (add1 i) (add1 count))
        (off! i)
        (when (possible? i count)
          (comb1 (add1 i) count)))))
  (comb1 0 0))

どちらも内部イテレータ、つまり一気に生成するタイプ。関数を渡して for-each のように使う。

使用例：

> (for-perm 3 displayln)
(0 1 2)
(0 2 1)
(1 0 2)
(1 2 0)
(2 0 1)
(2 1 0)
> (for-comb 4 2 displayln)
(0 1)
(0 2)
(0 3)
(1 2)
(1 3)
(2 3)

継続を使えば、これらを外部イテレータ（ジェネレータ）に変換できる。Racket には、それを簡単に書くためのマクロがある。

(require racket/generator)

(define (gen-perm n (endval #f))
  (generator ()
    (for-perm n yield)
    (yield endval)))

(define (gen-comb n m (endval #f))
  (generator ()
    (for-comb n m yield)
    (yield endval)))

generator マクロによって作られた関数は yield で一時停止し、値を返す。

使用例：（対話環境でトップレベルに返ってきたリストやシンボルの頭にクォートが付くのは Racket の仕様。正直言って私はあんまり好きじゃない……。print という関数で表示するとこうなるらしい。write や display といった他の関数では普通にクォートなしで表示される）

> (define g (gen-perm 3))
> (g)
'(0 1 2)
> (g)
'(0 2 1)
> (g)
'(1 0 2)
> (g)
'(1 2 0)
> (g)
'(2 0 1)
> (g)
'(2 1 0)
> (g)
#f
> (g)
> (g)
> (define g (gen-comb 4 2))
> (g)
'(0 1)
> (g)
'(0 2)
> (g)
'(0 3)
> (g)
'(1 2)
> (g)
'(1 3)
> (g)
'(2 3)
> (g)
#f
> (g)
> (g)