Life Game

前回のブログの最後. Schemeの実装はTAOCPのアルゴリズムそのもののコピーで, 実はもっと関数プログラムらしく書きたかった. 書き直したのが以下のプログラムである. ある変数を後段で1回しか使わぬなら, 直接使う場所の書き込んである.

(define (b x- x x+)
 (define (and a b) (fix:and a b))
 (define (or a b) (fix:or a b))
 (define (xor a b) (fix:xor a b))
 (define (lsh a b) (fix:lsh a b))
 (let* ((a0 (and x- x+)) (b0 (xor x- x+)) (c0 (xor x b0))
   (d0 (lsh c0 -1)) (c1 (lsh c0 1)) (e0 (xor c1 d0))
   (f1 (or (and b0 e0) (and c1 d0))) (c4 (or (and x b0) a0))
   (b1 (lsh c4 1)) (c5 (lsh c4 -1)))
  (and (xor (or (and b1 c5) (or a0 f1))
  (or (and a0 f1) (or b1 c5)))
  (or (xor b0 e0) x))))

このプログラムは, fixnumでも動くが, fixnumは24ビットしかないので, 実用的には長さが自由なbit-string型の方を使いたい. それに対処すべく, 上のプログラムでは, and, or等は別に定義してある.

MIT Schemeのreference manualでBit Stringを見ると, bit-string-and, bit-string-or, bit-string-xorはあるが, シフトはない. そこでシフトはbit-substringとbit-string-append使って実装することになる.

(define (bit-string-lsh a c)
 (if (>= c 0)
  (bit-string-append (make-bit-string c #f)
   (bit-substring a 0 (- (bit-string-length a) c)))
  (bit-string-append
   (bit-substring a (- c) (bit-string-length a))
   (make-bit-string (- c) #f))))

(define bs (unsigned-integer->bit-string 12 #b111010010111))
 =>#*111010010111  ;12ビットのテスト用bit stringを作る.
(bit-string-lsh bs 2) => #*101001011100 ;左シフト
(bit-string-lsh bs -2) => #*001110100101 ;右シフト

こんな具合いである.