exerise 4.38,39,40

気付いたらずっとblog放置しとった・・・。
そろそろまたサークルでのSICP読書会もあるっぽいし、また読み始める気分。
せめて春中には読み切りたいなぁ(夏もおまえそんなこと言ってただろ、とか言う突っ込みは無しの方向で)

とりあえず授業中にちまちま進めてた問題(少ししか無いけど)をうp。

exercise 4.38

multiple-dwellingで条件緩めると答はどうなるか？

(define (multiple-dwelling)
  (let ((baker (amb 1 2 3 4 5))
        (cooper (amb 1 2 3 4 5))
        (fletcher (amb 1 2 3 4 5))
        (miller (amb 1 2 3 4 5))
        (smith (amb 1 2 3 4 5)))
    (require
     (distinct? (list baker cooper fletcher miller smith)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (> miller cooper))
    ;;    (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

実行してみると、

;;; Amb-Eval input:
(multiple-dwelling)

;;; Starting a new problem 
;;; Amb-Eval value:
((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5))

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3))

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3))

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1))

;;; Amb-Eval input:
try-again

;;; There are no more values of
(multiple-dwelling)

と5つの可能性が出るようになる。

exercise 4.39

requireの順番が効率に影響するかのか。
実行時間を図りたいので gaucheのtimeマクロを使ってみる。
SICPのambの実装で、primitive-procedureにtime追加しても上手くいかなかったので(まぁマクロだし仕方ないのか)、
http://www.shido.info/lisp/scheme_amb.html
を参考にambをgaucheで動かしてみた。

まずは標準の multiple-dwelling の場合。

gosh> (time (multiple-dwelling))
;(time (multiple-dwelling))
; real   0.017
; user   0.020
; sys    0.000
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
gosh> (amb)
no-choise

(distinct ...)の行を最後にしてみる.

gosh> (time (multiple-dwelling))
;(time (multiple-dwelling))
; real   0.016
; user   0.010
; sys    0.000
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
gosh> (amb)
no-choise

ちなみにコードは

(define (multiple-dwelling)
  (let ((baker (amb 1 2 3 4 5))
        (cooper (amb 1 2 3 4 5))
        (fletcher (amb 1 2 3 4 5))
        (miller (amb 1 2 3 4 5))
        (smith (amb 1 2 3 4 5)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (> miller cooper))
    (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (require (distinct? (list baker cooper fletcher miller smith))) ;;変更。
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

うーん。確かに早くはなっている感じ。
「最速を求めるぜ！！」ってのは面倒なのでパス。
まぁ問題にも早くなる例を示せくらいにしか書いてないしいいか。

exercise 4.40

毎度毎度5人分のfloorを決め、失敗したらbacktraceしてくのは効率が悪い、と。
それを改善しろ という問題。
以下が変更したコード。

(require (not (hogehoge x)))
とやらずに、letの束縛でxを束縛しないようにすれば更に速くできそう。
(例: (let ((baker (amb 1 2 3 4))) ...) ;;5が候補に無い。)
でもそれってアリなのかなぁ？と疑問に思ったので以下の例ではやってないです。

(define (multiple-dwelling)
  (let ((baker (amb 1 2 3 4 5)))
    (require (not (= baker 5)))
    (let ((cooper (amb 1 2 3 4 5)))
      (require (distinct? (list baker cooper)))
      (require (not (= cooper 1)))
      (let ((fletcher (amb 1 2 3 4 5)))
        (require (distinct? (list baker cooper fletcher)))
        (require (not (= (abs (- fletcher cooper)) 1)))
        (require (not (= fletcher 1)))
        (require (not (= fletcher 5)))
        (let ((miller (amb 1 2 3 4 5)))
          (require (distinct? (list baker cooper fletcher miller)))
          (require (> miller cooper))
          (let ((smith (amb 1 2 3 4 5)))
            (require (distinct? (list baker cooper fletcher miller smith)))
            (require (not (= (abs (- smith fletcher)) 1)))
            (list (list 'baker baker)
                  (list 'cooper cooper)
                  (list 'fletcher fletcher)
                  (list 'miller miller)
                  (list 'smith smith))))))))

実行してみる。

gosh> (time (multiple-dwelling))
;(time (multiple-dwelling))
; real   0.001
; user   0.000
; sys    0.000
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
gosh> (amb)
no-choise

一応 exercise 4.39の時と比べて大幅に速くなっているようだ。