@uents blog

Code wins arguments.

SICP 読書ノート#33 - 3.3.5 制約の拡散 (pp.168-175)

SICP Scheme

「§3.3.5 制約の拡散」から。

全体のソースコードはGitHubに置いています。

原本のタイトルは "Propagation of Constraints" なので「拡散」というよりかは「伝播」の方が適切かもしれない。

前節では論理回路のシミュレータを考えたが、ここではさらに抽象的な概念として「制約」とその制約同士をつなぐ「コネクタ」について考える。ちょうどいまSICPと並行して読んでいるダニエル・ヒリスの「思考する機械 - コンピュータ」の一節を検証するかのようだ。

驚異的にサイズを小さくすることを除けば、コンピュータチップの作成にシリコン・テクノロジーを使わなければならない特別な理由など存在しない。コンピュータチップは、大量の「スイッチ」とコネクタ」を提供できるテクノロジーであればどんなテクノロジーを使っても作成できる。… よってコンピュータの作成に必要なのは「スイッチ」と「コネクタ」である。

ぞくぞくするよね。

文庫 思考する機械コンピュータ (草思社文庫)

文庫 思考する機械コンピュータ (草思社文庫)

コネクタの実装

コネクタとは制約をつなぐ回線の役割を果たす。コネクタは内部状態として値と制約を持ち、その値を変更するとfor-each-exceptによって関わりのある制約にそれを知らせる。

;;; constractor
(define (make-connector)
  (let ((value false)        ; value
        (informant false)    ; object of value supplier
        (constraints '()))   ; constraints list
    ;; set-value!
    (define (set-my-value newval setter)
      (cond ((not (has-value? me))
             (set! value newval)
             (set! informant setter)
             (for-each-except setter
                              inform-about-value
                              constraints))
            ((not (= value newval))
             (error "Contradiction" (list value newval)))
            (else 'ignored)))
    ;; forget-value!
    (define (forget-my-value retractor)
      (if (eq? retractor informant)
          (begin (set! informant false)
                 (for-each-except retractor
                                  inform-about-no-value
                                  constraints))
          'ignored))
    ;; connect
    (define (connect new-constraint)
      (if (not (memq new-constraint constraints))
          (set! constraints
                (cons new-constraint constraints))
          false)
      (if (has-value? me)
          (inform-about-value new-constraint)
          false)
      'done)

    ;; dispatcher
    (define (me request)
      (cond ((eq? request 'has-value?)
             (if informant true false))
            ((eq? request 'value)
             value)
            ((eq? request 'set-value!)
             set-my-value)
            ((eq? request 'forget)
             forget-my-value)
            ((eq? request 'connect)
             connect)
            (else
             (error "Unknown operation -- CONNECTOR" request))))
    me))

(define (for-each-except exception procedure lst)
  (define (loop items)
    (cond ((null? items)
           'done)
          ((eq? (car items) exception)
           (loop (cdr items)))
          (else
           (procedure (car items))
           (loop (cdr items)))))
  (loop lst))


;; interfaces
(define (has-value? connector)
  (connector 'has-value?))

(define (get-value connector)
  (connector 'value))

(define (set-value! connector new-value informant)
  ((connector 'set-value!) new-value informant))

(define (forget-value! connector retractor)
  ((connector 'forget) retractor))

(define (connect connector new-constraint)
  ((connector 'connect) new-constraint))

制約の実装

制約はまさにスイッチ回路である。その制約条件によっては、接続されているコネクタの値が変わるとそれを伝播して他のコネクタの値を変えることができる。

コネクタが値を保持した/消去した場合に、制約へそれを伝えるインターフェースを以下のように定義する。

(define (inform-about-value constraint)
  (constraint 'I-have-a-value))

(define (inform-about-no-value constraint)
  (constraint 'I-lost-my-value))

コネクタの値が変更されたらその値を出力する制約としてprobeを定義する。

(define (probe name connector)
  (define (print-probe value)
    (display "Probe: ")
    (display name)
    (display " = ")
    (display value)
    (newline))
  (define (process-new-value)
    (print-probe (get-value connector)))
  (define (process-forget-value)
    (print-probe "?"))
  (define (me request)
    (cond ((eq? request 'I-have-a-value)
           (process-new-value))
          ((eq? request 'I-lost-my-value)
           (process-forget-value))
          (else
           (error "Unknown request -- PROBE" request))))
  (connect connector me)
  me)

２値の和をとる加算制約adderも定義する。

(define (adder a1 a2 sum)
  (define (process-new-value)
    (cond ((and (has-value? a1) (has-value? a2))
           (set-value! sum
                       (+ (get-value a1) (get-value a2))
                       me))
          ((and (has-value? a1) (has-value? sum))
           (set-value! a2
                       (- (get-value sum) (get-value a1))
                       me))
          ((and (has-value? a2) (has-value? sum))
           (set-value! a1
                       (- (get-value sum) (get-value a2))
                       me))))
  (define (process-forget-value)
    (forget-value! sum me)
    (forget-value! a1 me)
    (forget-value! a2 me)
    (process-new-value))

  (define (me request)
    (cond ((eq? request 'I-have-a-value)
           (process-new-value))
          ((eq? request 'I-lost-my-value)
           (process-forget-value))
          (else
           (error "Unknown request -- ADDER" request))))

  (connect a1 me)
  (connect a2 me)
  (connect sum me)
  me)

加算制約のテスト

ここまでくれば加算回路をテストすることができる。

racket@> (define a (make-connector))
(define b (make-connector))
(define s (make-connector))
(probe "a" a)
(probe "b" b)
(probe "sum" s)
(adder a b s)

racket@> (set-value! a 3 'user)
Probe: a = 3
'done

racket@> (set-value! b 4 'user)
Probe: sum = 7
Probe: b = 4
'done

racket@> (forget-value! b 'user)
Probe: sum = ?
Probe: b = ?
'done

racket@> (set-value! s 2 'user)
Probe: b = -1
Probe: sum = 2
'done

すごい！

練習問題

問題 3.33

2つの値の平均をとる制約averagerを作成する。

(define (averager a b c)
  (let ((u (make-connector))
        (v (make-connector))
        (w (make-connector)))
    (adder a b u)
    (multiplier c v u)
    (constant 2 v)
    'ok))

テスト。

racket@> (define a (make-connector))
(define b (make-connector))
(define c (make-connector))
(probe "a" a)
(probe "b" b)
(probe "c" c)
(averager a b c)
'ok
racket@> (set-value! a 3 'user)
Probe: a = 3
'done
racket@> (set-value! b 5 'user)
Probe: c = 4
Probe: b = 5
'done
racket@> (forget-value! b 'user)
Probe: c = ?
Probe: b = ?
'done
racket@> (set-value! c 1 'user)
Probe: b = -1
Probe: c = 1
'done

問題 3.34

Louisの以下のプログラムが動作しない理由を述べよ。

(define (squarer a b)
  (multiplier a a b))

コネクタbに値を設定しても2つのaの値が決定されるわけではないため動作しない。

問題 3.35

Benのsquarerを完成させる。

(define (squarer a b)
  (define (process-new-value)
    (if (has-value? b)
        (if (< (get-value b) 0)
            (error "square less than 0 --- SQUARER" (get-value b))
            (set-value! a (sqrt (get-value b)) me))         ; <代替部1>
        (set-value! b (* (get-value a) (get-value a)) me))) ; <代替部2>
  (define (process-forget-value)
    (forget-value! a me)  ; <本体1>
    (forget-value! b me))
  (define (me request)
    (cond ((eq? request 'I-have-a-value)  ; <本体2>
           (process-new-value))
          ((eq? request 'I-lost-my-value) 
           (process-forget-value))
          (else 
           (error "Unknown request -- SQUARER" request))))
  (connect a me)   ; <定義の残り>
  (connect b me)
  me)

テスト。

racket@> (define x (make-connector))
(define y (make-connector))
(probe "x" x)
(probe "y" y)
(squarer x y)
racket@> (set-value! x 3 'user)
Probe: y = 9
Probe: x = 3
'done
racket@> (forget-value! x 'user)
Probe: y = ?
Probe: x = ?
'done
racket@> (set-value! y 3 'user)
Probe: x = 1.7320508075688772
Probe: y = 3
'done

問題 3.36

環境図めんどいので飛ばします ;-P

問題 3.37

(define (celsius-fahrenheit-converter x)
  (c+ (c* (c/ (cv 9) (cv 5))
          x)
      (cv 32)))

(define (c+ x y)
  (let ((z (make-connector)))
    (adder x y z)
    z))

とした場合のc*、c/、cvを求めよ。

出力値のコネクタを返す手続きを実装すればよいので、

(define (c* x y)
  (let ((z (make-connector)))
    (multiplier x y z)
    z))

(define (c/ x y)
  (let ((z (make-connector)))
    (multiplier z y x)
    z))

(define (cv x)
  (let ((z (make-connector)))
    (constant x z)
    z))

テスト。

racket@> (define C (make-connector))
racket@> (define F (celsius-fahrenheit-converter C))
racket@> (probe "C" C)
racket@> (probe "F" F)
racket@> (set-value! C 30 'user)
Probe: C = 30
Probe: F = 86
'done
racket@> (forget-value! C 'user)
Probe: C = ?
Probe: F = ?
'done
racket@> (set-value! F 72 'user)
Probe: F = 72
Probe: C = 200/9
'done

ちゃんと動いてる？ 華氏ってどうもピンと来ないよね。

次は「§3.4 並列性：時が本質的」から。

※「SICP読書ノート」の目次はこちら