Личный сайт Алексея Григорьева

SICP: Propagation of Constraints

Конспект SIPC, раздел SICP 3.3.5 Propagation of Constraints.

В данном разделе речь идет о создании языка, который позволит манипулировать отношениями между величинами и ограничениями, лежащими в их основе. Propagation of Constraints, или «распространение ограничений» — система, позволяющая работать с отношениями (такими, как ) с помощью уведомлений.

Язык будет состоять из следующих элементов

Рассмотрим связь между величинами из шкалы Цельсия и шкалы Фаренгейта:

Это отношение можно выразить с помощью сети ограничений, в которой участвуют элемент сложения (adder), элементов умножения (multiplier) и констант (constant)

Рассмотрим ограничение

На этом блоке присутствуют три вывода — m1, m2 и p. Вывод m1 привязан к соединителю C, содержащему значение в градусах Цельсия. m2 привязан к блоку, содержащему константу 9. p — результат произведения значений, присоединенных к выводам m1 и m2, который, в свою очередь, связан с другим блоком умножения.

Когда в соединитель передается определенное значение — его могут задать как пользователь, так и блок ограничений, с которым ограничитель связан — он оповещает все связанные с ним блоки об изменении значения. Затем каждый из оповещенных блоков опрашивает присоединенные к нему соединители и проверяет, достаточно ли информации для того, чтобы определить значения на для всех соединителей, связанных с блоком. Если так, то блок задает новые значение для соединителей, которые, в свою очередь, оповещают о своем изменении других подписанных слушателей, тем самым распространяя ограничения по всей сети.

 

Продолжим рассмотрение сети ограничений перевода градусов. В данном случае w, x, y сразу же связываются с константами 9, 15, 32 соответственно. Если пользователь или какая-либо из процедур приложения устанавливает C в 25, самый правый элемент умножения устанавливает u в 25 * 9 = 225. Далее, u оповещает об изменении следующий элемент умножения, который устанавливает v в 225/5 = 45. v, в свою очередь, оповещает о своем изменении элемент сложения, который, наконец, устанавливает F в 77.

Представим эту сеть на языке ограничений:

(define C (make-connector))
(define F (make-connector))
(celsius-fahrenheit-converter C F)
 
(define (celsius-fahrenheit-converter c f)
    (let 
        ((u (make-connector))
         (v (make-connector))
         (w (make-connector))
         (x (make-connector))
         (y (make-connector)))
 
        (multiplier c w u)
        (multiplier v x u)
        (adder v y f)
        (constant 9 w)
        (constant 5 x)
        (constant 32 y)
 
        (void)
    )
)

Соединители (Connections)

Соединители поддерживают следующий набор операций

Соединители взаимодействуют с ограничителями с помощью отправки сообщений «у меня появилось значение» — 'I-have-a-value и «я потерял значение» — 'I-lost-my-value.

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

Ограничения (Constraints)

Ограничения состоят из трех процедур:

 

Рассмотрим элемент сложения. Так как он является ограничением, то содержит следующие функции:

Далее, процедура-диспетчер добавляется в списки оповещения для коннекторов a1 a2 и sum.

(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-adder)
            )
            ((and (has-value? a1) (has-value? sum))
                (set-value! a2
                    (- (get-value sum) (get-value a1))
                    me-adder)
            )
            ((and (has-value? a2) (has-value? sum))
                (set-value! a1
                    (- (get-value sum) (get-value a2))
                    me-adder)
            )
        )
    )
 
    (define (process-forget-value)
        (forget-value! sum me-adder)
        (forget-value! a1 me-adder)
        (forget-value! a2 me-adder)
        (process-new-value)
    )
 
    (define (me-adder 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-adder)
    (connect a2 me-adder)
    (connect sum me-adder)
 
    me-adder
)

Аналогичным образом реализуется элемент произведения

(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-multiplier)
            )
            ((and (has-value? m1) (has-value? m2))
                (set-value! product
                    (* (get-value m1) (get-value m2))
                    me-multiplier)
            )
            ((and (has-value? product) (has-value? m1))
                (set-value! m2
                    (/ (get-value product) (get-value m1))
                    me-multiplier)
            )
            ((and (has-value? product) (has-value? m2))
                (set-value! m1
                    (/ (get-value product) (get-value m2))
                    me-multiplier)
            )
        )
    )
 
    (define (process-forget-value)
        (forget-value! product me-multiplier)
        (forget-value! m1 me-multiplier)
        (forget-value! m2 me-multiplier)
        (process-new-value)
    )
 
    (define (me-multiplier 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-multiplier)
    (connect m2 me-multiplier)
    (connect product me-multiplier)
 
    me-multiplier
)

Блок с константой не может получать новое значение или терять старое, поэтому на полученные сообщения реагирует ошибкой.

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

Реализация соединителей

Соединитель представляет собой процедурный объект с локальными переменными

Соединитель имеет значение только тогда, когда в нем содержатся данные об объекте, который инициировал связывание значения.

(define (make-connector)
    (let 
        ((value false) (informant false) (constraints '()))
 
        (define (set-my-value newval setter)
            (cond 
                ((not (has-value? me-connector))
                    (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))
                'not-same-informant
            )
        )
 
        (define (connect new-constraint)
            ; memq finds value in given list, returns true, if found, false otherwise
            (if (not (memq new-constraint constraints))
                (set! constraints (cons new-constraint constraints))
                (void)
            )
 
            (if (has-value? me-connector)
                (inform-about-value new-constraint)
                (void)
            )
 
            'done
        )
 
        (define (has-value-inner?)
            (if informant true false)
        )
 
        (define (get-value-inner)
            (if (has-value-inner?)
                value
                'no-value
            )
        )
 
        (define (me-connector request)
            (cond 
                ((eq? request 'has-value?) (has-value-inner?))
                ((eq? request 'value) (get-value-inner))
                ((eq? request 'set-value!) set-my-value)
                ((eq? request 'forget) forget-my-value)
                ((eq? request 'connect) connect)
                ((eq? request 'informant) informant)
                (else 
                    (error "Unknown operation -- CONNECTOR" request))
            )
        )
 
        me-connector
    )
)

Теперь можно определить процедуры доступа к объектам-соединителям:

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

И метод for-each-exept, выполняющий процедуры и переданного списка одну за одной, за исключенеим процедуры exception

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

Так как все ограничения имеют один и тот же интерфейс, можно создать объект, следящий за изменениями в соединителях и печатающий отладочную информацию:

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

Код целиком

Пример

Рассмотрим поведение системы распространения ограничений по шагам на примере одного элемента умножения

Зададим соединители I1, I2, O и свяжем их с элементом умножения

(define I1 (make-connector))
(define I2 (make-connector))
(define O (make-connector))
 
(multiplier I1 I2 O)

А так же подписываемся на все изменения функцией probe

(probe "I1" I1)
(probe "I2" I2)
(probe "O" O)

Посмотрим по шагам, что произойдет, если пользователь устанавливает значение I1 в 2

(set-value! I1 2 'user)

=> Рассылка оповещения всем слушателям, подписанным на события в I1, а именно, multiplier и probe.
=> Оповещается mutliplier.
=>=> mutliplier проверяет, достаточно ли у него данных, чтобы вычислить все остальное, и приходит к выводу, что не достаточно, ничего не делает.
=> Оповещается probe.
=>=> probe печатает что значение I1 изменилось.

Далее, пользователь устанавливает значение O в 4

(set-value! O 4 'user)

=> Оповещаются все слушатели, подписанные на события в O — это multiplier и probe.
=> Оповещается mutliplier.
=>=> mutliplier проверяет, достаточно ли у него данных, чтобы вычислить все остальное. Данных достаточно, и он вычисляет значение для i2: i2 = O / i1. mutliplier связывает I2 со значением 2.
=>=>=> Оповещаются все слушатели, подписаные на изменение I2, кроме самого инициатора изменения — mutliplier исключается, остается только probe.
=>=>=> Оповещается probe.
=>=>=>=> probe печатает что значение I2 изменилось.
=> Оповещается probe.
=>=> probe печатает что значение O изменилось.

Все значения получены.

Для I1 и O инициатором изменения (informant) является пользователь пользователь ('user), а для I2 — процедура me-multiplier. Значения в соединителе могут быть сброшены только инициатором. Т.е.
(forget-value! I2 'user) вернет 'not-same-informant и ничего не сделает.

Однако пользователь может сбросить значение для O

(forget-value! O 'user)

=> Проверяется, является ли retractor тем же самым, что и informant — да, тот же самый.
=> Устанавливается новое значение для informantfalse. has-value? теперь будет возвращать false.
=> Рассылается уведомление на очистку значения всем подписчикам, его получают multiplier и probe.
=> Оповещается mutliplier.
=>=> multiplier посылает запрос на очистку значений всех своих коннекторов — I1, I2, O.
=>=>=> I1 установлено пользователем, поэтому значение не сбрасывается, возвращается not-same-informant.
=>=>=> I2 установлено процедурой multiplier, сбрасывается значение, уведомляются все подписчики, кроме самого инициатора.
=>=>=>=> probe печатает, что значение I2 было сброшено.
=>=>=> O2 уже сброшено, переменная informant в нем установлена в false, поэтому возвращается not-same-informant.
=> Оповещается probe.
=>=> probe печатает, что значение O было сброшено.

Код теста

Решение задач из секции

ex. 3.33

Написать процедуру averager, используя adder и multiplier

(define (averager in1 in2 output)
    (let 
        ((u    (make-connector))
         (half (make-connector)))
 
        (adder in1 in2 u)
        (multiplier u half output)
 
        (constant 0.5 half)
        (void)
    )
)

Целиком

ex. 3.34

Почему нельзя делать так?

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

Проверим:

(define in-square  (make-connector))
(define out-square (make-connector))
 
(probe "in-square" in-square)
(probe "out-square" out-square)
 
(squarer in-square out-square)

При установке значения в in-square значение в out-square считаются правильно.

(set-value! in-square 5 'user)
; Probe: out-square = 25
; Probe: in-square = 5
(forget-value! in-square 'user)

Однако, если установить значение out-square, in-square посчитан не будет.

(set-value! out-square 16 'user)
; Probe: out-square = 16

Целиком

ex. 3.35

Задача — написать правильную реализацию ограничения squarer

(define (squarer in-square out-square)
    (define (process-new-value)
        (cond
            ((has-value? out-square) 
                (if (< (get-value out-square) 0)
                    (error "square less than 0 -- SQUARER" (get-value out-square))
                    (set-value! in-square 
                        (sqrt (get-value out-square)) 
                        me-squarer)
                )
            )
            ((has-value? in-square)
                (set-value! out-square
                    (square (get-value in-square))
                    me-squarer)
            )
        )
    )
 
    (define (process-forget-value) 
        (forget-value! in-square  me-squarer)
        (forget-value! out-square me-squarer)
    )
 
    (define (me-squarer 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 in-square  me-squarer)
    (connect out-square me-squarer)
 
    (void)
)

Целиком

ex. 3.36

http://wqzhang.wordpress.com/2009/07/29/sicp-exercise-3-36/

ex. 3.37
(define (c+ x y)
    (let 
        ((z (make-connector)))
        (adder x y z)
        z
    )
)
 
(define (c* x y)
    (let 
        ((z (make-connector)))
        (multiplier x y z)
        z
    )
)
 
(define (c/ z y)
    (let 
        ((x (make-connector)))
        (multiplier x y z)
        x
    )
)
 
(define (cv c)
    (let 
        ((z (make-connector)))
        (constant c z)
        z
    )
)
 
(define (celsius-fahrenheit-converter x)
    (c+ (c* (c/ (cv 9) (cv 5)) x)
        (cv 32))
)
 
 
(define C (make-connector))
(define F (celsius-fahrenheit-converter C))

Целиком

Источник

SICP 3.3.5 Propagation of Constraints

Далее:

Воскресенье, 29 Июл 2012 в 22:28. Вы можете следить за комментариями к этой статье через RSS 2.0.