理系学生日記

おまえはいつまで学生気分なのか

問題3-33 (3.3.5 Propagation of Constraints)

問題3-33

Constraint ベースのものがどんなものかということですが,以下の例が分かりやすい.
averager は 2 つの入力端子 (in-A,in-B) に与えられた数値の平均が出力端子 out に出力されるというものです.なんとなく,そんなのすぐできるじゃんみたいな印象ですね.

(add-load-path "/Users/ykiri/programming/SICP")
(load "section3/constraint-system")

(define a (make-connector))
(define b (make-connector))
(define c (make-connector))

(define (averager in-A in-B out)
  (let ((s (make-connector))
        (two (make-connector)))
    (adder in-A in-B s)
    (multiplier out two s)
    (constant 2 two)
    'ok))

(averager a b c)

(probe "in-A" a)
(probe "in-B" b)
(probe "average" c)

実際,入力を 2 つ与えてやると,単に平均が出力されます.

(set-value! a 10 'kiriirmode)
(set-value! b 14 'kiririmode)

; 出力
; Probe: average = 12#t

ところが面白いのが,入力 (in-A) と出力 (out) に数値を与えてやると…

(set-value! a 10 'kiriirmode)
(set-value! c 24 'kiririmode)

; 出力
; Probe: in-B = 38

in-B の値が自動的に計算される!!

仕組み

ホントにこれ,電子回路とかとおんなじ仕組みです.
ただ,電子回路とかだと入力端子とか出力端子とかわりかし厳密に決められてて,出力端子に入力を加えても入力端子には影響が出ないように普通なってますけど,今回のものは入力端子,出力端子の決まりはなく,どの端子も入出力が可能という形になってます!

じゃぁ電子回路でいうゲートとかに相当するものは何かっていうと,それが下の averager とかです.
関数 averager の中で使われている adder やら multiplexer やらもゲートに相当する部品で,procedural object として定義されています.adder も multiplexer も,基本的には

  • ある端子に新しい値が入力されたら,その値から計算できる他の端子用の値を出力する (process-new-value)
  • 既に入力されている値を,全部消去する (process-new-value)
  • インタフェース (me)

から構成されています.

; constructs an adder constraint among summand connectors
; a1 and a2 and a sum connector.
(define (adder a1 a2 sum)
  ; is called when the adder is informed that one of its
  ; connectors has a value
  (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)

じゃぁ,その averager なり,adder なりに入力として与えるものって何よってことになりますが,与えるのも procedural objectで,make-connector 関数で作る.connector という言葉どおり,電子回路ではゲートとかの部品を繋ぐもの,ワイヤという認識でオッケーっぽい.
ただ,ワイヤそのものが明示的に値を持つので,なんとなく違和感は拭えません.ホントの回路とかですとハードウェアですから,ゲートに与えられた入力を基にゲートはずっと出力を計算し続けますが,今回はあくまでプログラムなので,どうやってゲートが入力の変化を知るかが問題になります.この節ではどうやっているかというと,このワイヤ自身がゲート (adder とか) に入力信号の変化を伝えます.set-my-value がそのあたりの事を行ってます.

;; A connector is represented as a procedural object with local state variables value, the current value of the connector; informant, the object that set the connector's value; and constraints, a list of the constraints in which the connector participates.
(define (make-connector)
  (let ((value #f) (informant #f) (constraints '()))
    ; is called when there is a request to set the connector's 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)))
    ; first checks to make sure that the request is coming from the same object that set the value originally. If so, the connector informs its associated constraints about the loss of the value
    (define (forget-my-value retractor)
      (if (eq? retractor informant)
          (begin (set! informant #f)
                 (for-each-except retractor
                                  inform-about-no-value
                                  constraints))
          'ignored))
    ; adds the designated new constraint to the list of constraints if it is not already in that list. Then, if the connector has a value, it informs the new constraint of this fact.
    (define (connect new-constraint)
      (if (not (memq new-constraint constraints))
          (set! constraints
                (cons new-constraint constraints)))
      (if (has-value? me)
          (inform-about-value new-constraint))
      'done)
    (define (me request)
      (cond ((eq? request 'has-value?)
             (if informant #t #f))
            ((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))

あとはインタフェース部分を使いやすくしてる.

; tells whetherthe connector has a value
(define (has-value? connector)
  (connector 'has-value?))

; returns the connector's current value
(define (get-value connector)
  (connector 'value))

; indicates that the informantis requesting the connector to set
; its value to the new value
(define (set-value! connector new-value informant)
  ((connector 'set-value!) new-value informant))

; tells the connector that the retractor is requesting it to
; forget its value
(define (forget-value! connector retractor)
  ((connector 'forget) retractor))

; tells the connector to participate in the new constraint
(define (connect connector new-constraint)
  ((connector 'connect) new-constraint))

面白い!!