2009年9月2日水曜日

中西式置換プログラム

前回のブログ(2009年8月27日中西流置換プログラム)の最後に書いたTAOCPのアルゴリズム7.2.1.2-Lは, Lというだけあって辞書式順(lexicographicalorder)で, n項の置換, 例えば(1 2 2 3)の置換

((1 2 2 3) (1 2 3 2) (1 3 2 2) (2 1 2 3) (2 1 3 2) (2 2 1 3)
(2 2 3 1) (2 3 1 2) (2 3 2 1) (3 1 2 2) (3 2 1 2) (3 2 2 1))

を作る. 辞書式順とは, 配列の左端に小数点があるとして, 数値順にソートするものである.

(0 1 2 3)の中西ソートの結果

(perm '(0 1 2 3)) =>
((0 1 2 3) (1 0 2 3) (1 2 0 3) (1 2 3 0) (0 2 1 3) (2 0 1 3)
(2 1 0 3) (2 1 3 0) (0 2 3 1) (2 0 3 1) (2 3 0 1) (2 3 1 0)
(0 1 3 2) (1 0 3 2) (1 3 0 2) (1 3 2 0) (0 3 1 2) (3 0 1 2)
(3 1 0 2) (3 1 2 0) (0 3 2 1) (3 0 2 1) (3 2 0 1) (3 2 1 0))



(define (dec s)
(string->number (string-append "."
(apply string-append (map number->string s)))))

で小数にする.

(dec '(0 1 2 3)) => .0123


先ほどの置換を小数にしてソートすると

(sort (map dec (perm '(0 1 2 3))) <) =>
(.0123 .0132 .0213 .0231 .0312 .0321 .1023 .1032 .1203 .123
.1302 .132 .2013 .2031 .2103 .213 .2301 .231 .3012 .3021
.3102 .312 .3201 .321)


アルゴリズムLの結果の辞書式順
 
                                                                    
(algorithm7212l '(0 1 2 3))=>
((0 1 2 3) (0 1 3 2) (0 2 1 3) (0 2 3 1) (0 3 1 2) (0 3 2 1)
(1 0 2 3) (1 0 3 2) (1 2 0 3) (1 2 3 0) (1 3 0 2) (1 3 2 0)
(2 0 1 3) (2 0 3 1) (2 1 0 3) (2 1 3 0) (2 3 0 1) (2 3 1 0)
(3 0 1 2) (3 0 2 1) (3 1 0 2) (3 1 2 0) (3 2 0 1) (3 2 1 0))

になる. いまはどれも4桁なので, 小数ではなく, 整数と思ってソートするのでもよい.

私のブログの2008年10月28日のに, 切頭八面体の絵があり, {0,1,2,3}の全順列を, 隣り同士の交換で実現したと書いてある. 隣り同士の交換で, 全順列を作るのを, 英語ではPlain Changeという.

下の図がその1例である. 左の24段が, {0,1,2,3}の置換で, x印のところが隣り同士交換した場所である. 一番下のx印の交換をすると, 一番上に戻る.

右上の6段は, 左で0を挿入される{1,2,3}の置換である. これも同じように出来ている.

赤線は0の移動を示す.




x印が連続するように, 中西アルゴリズムを少し修正すると,plain changeのアルゴリズムになる. 前回のプログラムのappendを1つおきに逆にappendするようにすればよい. それが下のrevap (reverse appendのつもり)

(revap '(0 1) '(2 3) '(4 5) '(6 7)) => (0 1 3 2 4 5 7 6)

これを使うとplain changeが出来る.

(define (plainchange ls)
(define (revap . ls)
(cond ((null? ls) '())
((null? (cdr ls)) (car ls))
(else (append (car ls) (reverse (cadr ls))
(apply revap (cddr 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 revap (map (lambda (l) (ins (car ls) l))
(plainchange (cdr ls))))))

(plainchange '(0 1 2 3))の結果を切頭八面体のHamiltonian閉路にしたのが



である.

0 件のコメント: