(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)))
