约束系统

约束系统

SICP 练习3.33 - 3.37

引言

你的函数可以倒着算吗？

欧姆定律$U=IR$，建模到编程语言中是什么？你也许会感到，这个公式描述的是一种约束，排除了很多不可能的$(U,I,R)$三元组。而约束是不能直接对应到编程语言中的。

为了在编程语言中建模，可以这样理解约束：一种值之间的关系，当足够的条件满足时，其中一些值将决定另一些值。

SICP 中介绍了一个约束系统，系统中有两类对象：

• 连接器：保存值，并在值变化时通知它参与的约束
• 约束器：接收 “得值”、“失值” 两种信号，将合适的消息发送给受影响的连接器

可见，连接器保有其参与的约束的引用（约束列表），约束器也保有受其约束的连接器。

连接器

连接器保有的数据：

• 值
• 值的设置者，可能是用户或者约束
• 所参与约束的集合

连接器接收的消息：

• ”值是否已经被设置“ 的查询

• ”值是什么“ 的查询

• ”设置值“ 的命令，需要给出设置者

  在没有值的状态下，会设置值、记录设置者、通知参与的约束；在有值的状态下，收到不一致的值设置命令说明发生冲突，约束不能被满足。

• ”忘记值“ 的命令，需要给出设置者

  只有值的设置者发出的忘记命令才有效，非自己值的设置者的忘记命令会被忽略。所谓忘记值，就是回到没有值的状态并通知参与的约束。

• ”连接到约束器“ 的命令

  将约束器添加到约束集合中（同一个约束器不会被添加多次）

(define (make-connector)

  (define (for-each-except exception procedure list)
    (define (loop items)
      (if (not (null? items))
          (if (eq? (car items) exception)
              (loop (cdr items))
              (begin
                (procedure (car items))
                (loop (cdr items))))))
    (loop list))
 
  (let ((value false) (informant false) (constraints '()))

    (define (set-my-value newval setter)
      (cond ((not (has-value? me))
             (begin
               (set! value newval)
               (set! informant setter)
               (for-each-except setter
                                inform-about-value
                                constraints)))
            ((not (= value newval))
             (error "Contradiction" (list value newval)))
            (else 'ignored)))

    (define (forget-my-value retractor)
      (if (eq? retractor informant)
          (begin (set! informant false)
                 (for-each-except retractor
                                  inform-about-no-value
                                  constraints))
          'ignored))

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

    (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 (inform-about-value constraint)
  (constraint 'I-have-a-value))

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


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

其他一些约束器：

(define (multiplier m1 m2 product)

  (define (process-new-value)
    (cond ((or (and (has-value? m1) (= (get-value m1) 0))
               (and (has-value? m2) (= (get-value m2) 0)))
           (set-value! product 0 me))
          ((and (has-value? m1) (has-value? m2))
           (set-value! product
                       (* (get-value m1) (get-value m2))
                       me))
          ((and (has-value? product) (has-value? m1))
           (set-value! m2
                       (/ (get-value product) (get-value m1))
                       me))
          ((and (has-value? product) (has-value? m2))
           (set-value! m1
                       (/ (get-value product) (get-value m2))
                       me))))

  (define (process-forget-value)
    (begin
      (forget-value! product me)
      (forget-value! m1 me)
      (forget-value! m2 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 -- MULTIPLIER" request))))

  (connect m1 me)
  (connect m2 me)
  (connect product me)
  me)


(define (averager a b c)
  ; c = (a + b) * 0.5
  (let ((s (make-connector))
        (d (make-connector)))
    (adder a b s)
    (multiplier s d c)
    (constant 0.5 d))
  averager)


(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 (expt (get-value b) 0.5) me))
        (if (has-value? a)
            (set-value! b (expt (get-value a) 2) me))))

  (define (process-forget-value)
    (begin
      (forget-value! a me)
      (forget-value! b 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 -- SQUARER" request))))
  (connect a me)
  (connect b me)
  me)

      
(define (constant value connector)
  (define (me request)
    (error "Unknown request -- CONSTANT" request))
  (connect connector me)
  (set-value! connector value me)
  me)

注意，常数约束器会给它的连接器设置一个值，并成为该连接器独一无二的设置者。被设置的连接器不会再接收其他约束的忘记命令，同时可以 ”抱怨“ 不一致的设置命令。

监视器

可以将监视器添加到连接器的约束集合中，在连接器的值发生变化（收到连接器的得值、失值消息）时打印连接器的值。

(define (probe name connector)

  (define (print-probe value)
    (begin
      (newline)
      (display "Probe: ")
      (display name)
      (display " = ")
      (display value)))

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

测试

(define C (make-connector))
(define F (make-connector))
(celsius-fahrenheit-converter C F)

(probe "Celsius temp" C)
(probe "Fahrenheit temp" F)

(set-value! C 25 'user)

Probe: Celsius temp = 25
Probe: Fahrenheit temp = 77

设计回顾

这个约束系统的设计有很多巧妙之处，和大家分享两点。

连接器记录值的设置者

这是一个很高明的、反映因果逻辑的设计。

对于一个连接器来说，不仅需要知道它的值，还需要知道设置这个值是哪个约束导致的（值可以是用户设置的，像上文测试中那样）。

失值更新联动得值更新

当一个值有多个因素时，连接器只会记住第一个设置者。撤去一个因素后，其余的因素应该尝试重新介入。

(define A (make-connector))
(define B (make-connector))
(define SUM (make-connector))
(define C (make-connector))
(define D (make-connector))

(set-value! A 1 'user)
(set-value! B 1 'user)
(set-value! SUM 2 'user)
;(set-value! C 1 'user)
;(set-value! D 1 'user)

(adder A B SUM)
;(adder C D SUM)

(begin
  (probe "A" A)
  (probe "B" B)
  (probe "C" C)
  (probe "D" D)
  (probe "SUM" SUM)
  'probe-done)