中西式置換プログラム

置換(順列)を計算するプログラムにもいろいろな流儀がある. あるとき中西流(と私が勝手に呼んでいる)というのを知った.

(2000年に身罷った中西正和君について, 私が以前, 「数式処理」に寄稿したものを, googleでサーチしていて, 偶然見つけた.)

中西君のプログラムは, むかし風にM式で書いてあり,

perm[x]
=[null [cdr [x]] -> list [x] ;
t -> mapcon [perm [cdr [x]];
quote [lambda [[y]; insert [nil; car [x]; car [y]]]]
  ]]
;
insert [x; a; y]
= [null [y] -> list [append [x; cons[a;y]]] ;
t -> cons [append [x; cons [a; y]];
  insert [nconc [x; list [car [y]]]; a; cdr [y]]
  ]]

いま風に書けば (近年はMS変換の出来る人も少ないに違いない.)

(define (perm x)
(if (null? (cdr x)) (list x)
   (mapcon (perm (cdr x))
    (lambda (y) (insert '() (car x) (car y))) )))

(define (insert x a y)
(if (null? y) (list (append x (cons a y)))
 (cons (append x (cons a y))
   (insert (append x (list (car y))) a (cdr y)))))

mapconも定義する.

(define (mapcon x f)
(if (null? x) '()
 (append (f x) (mapcon (cdr x) f))))

insertは以下のような関数である.

(insert '() 'a '(b c)) => ((a b c) (b a c) (b c a))

これを下請けにして, permは

(perm '(a b c)) =>
((a b c) (b a c) (b c a) (a c b) (c a b) (c b a))

これでもいいのだが, mapconやnconcが気に入らず, わたし風に中西流を書いてみた.

(define (perm ls)
(define (ins h tl)
(if (null? tl) (list (list h))
(cons (cons h tl)
 (map (lambda (l) (cons (car tl) l)) (ins h (cdr tl))))))
(if (null? ls) (list '())
(apply append (map (lambda (l) (ins (car ls) l))
(perm (cdr ls))))))

入れ子で定義してあるinsを見てみる. 働きは中西insertと同じである.

(define (ins h tl)
(if (null? tl) (list (list h))
(cons (cons h tl)
(map (lambda (l) (cons (car tl) l)) (ins h (cdr tl))))))

(ins 'a '(b c d)) =>
((a b c d) (b a c d) (b c a d) (b c d a))

3行目の(cons h tl)は, 完成したリストの先頭を作る, つまり(a b c d)を作って, 後から出来てきたリスト((b a c d) (b c a d) (b c d a))にconsする.

後のリストの作り方は, (ins h (cdr tl))が, (cdr tl)つまり(c d)に, hつまりaをinsしたもの, ((a c d) (c a d) (c d a))のそれぞれに, (car lt)つまりbをconsして作る. mapを使う.

tlがnilだったら, ((a))を返す. (list (list h))

(define (perm ls)
(if (null? ls) (list '())
(apply append (map (lambda (l) (ins (car ls) l))
(perm (cdr ls))))))

lsがnilの場合は後回しにして, lsが(a b c d)だったとする. 最後の方の(perm (cdr ls))により, (b c d)のperm, ((b c d) (c b d) (c d b) (b d c) (d b c) (d c b))が出来るわけで, このそれぞれにaをinsし, それを最後にappendする.

lsが段々短くなり, (d)だけになったときを考える. insでつけるのはd, つけられるリストは()で, そのときは, ()のpermで(())が返り, ((d))が出来る.

それにcをinsするから, ((c d) (d c))が出来る.

このようにしてpermが作れた.

ついでだが, TAOCPのアルゴリズム7.2.1.2-LのScheme版は以下の通り.

(define (algorithm7212l as)    ;TAOCP V4F2 p.39
 (define (interchange ls a b)
  (define (list-set! ls n a)
   (set-car! (list-tail ls n) a))
  (let ((t (list-ref ls a)))
   (list-set! ls a (list-ref ls b))
   (list-set! ls b t)))
 (let ((n 3) (j 0) (k 0) (l 0) (ps '()))
  (define (l1) (set! ps (cons (tree-copy as) ps)) (l2))
  (define (l2)
   (set! j (do ((j (- n 1) (- j 1)))
    ((or (< j 0) (< (list-ref as j) (list-ref as (+ j 1))))
      j)))
   (if (>= j 0)(l3) (reverse ps)))
 (define (l3)
  (set! l (do ((l n (- l 1)))
   ((< (list-ref as j) (list-ref as l)) l)))
  (interchange as j l) (l4))
 (define (l4)
  (define (loop)
   (if (< k l)
    (begin (interchange as k l) (set! k (+ k 1))
     (set! l (- l 1)) (loop))))
  (set! k (+ j 1)) (set! l n) (loop) (l1))
 (l1)))