exerise 4.41,42,43

SICP exercise

明日が最後の試験となるとblog更新にも熱が(ry

exercise 4.41

ambを使わずに multiple-dwelling を解け という問題。
以下が以前書いた解答。
我ながら酷い解答だな、おい。

(use srfi-1)
(use util.combinations)
(define (multiple-dwelling)
  (define (baker seq) (list-ref seq 0))
  (define (cooper seq)  (list-ref seq 1))
  (define (fletcher seq) (list-ref seq 2))
  (define (miller seq) (list-ref seq 3))
  (define (smith seq) (list-ref seq 4))
  (define name-list '(baker cooper fletcher miller smith))
  (map (lambda (seq)
         (map list name-list seq))
       (filter
        (lambda (seq) (not (= (baker seq) 5)))
        (filter
         (lambda (seq) (not (= (cooper seq) 1)))
         (filter
          (lambda (seq) (not (= (fletcher seq) 1)))
          (filter
           (lambda (seq) (not (= (fletcher seq) 5)))
           (filter
            (lambda (seq) (> (miller seq)(cooper seq)))
            (filter
             (lambda (seq) (not (= (abs (- (smith seq) (fletcher seq))) 1)))
             (filter
              (lambda (seq) (not (= (abs (- (fletcher seq) (cooper seq))) 1)))
              (permutations '(1 2 3 4 5)))))))))))

効率？何美味しいの？
以下に実行例。

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

あ、あれ？4.40でamb使った方が速(ry

exercise 4.42

liarsパズルを解け とさ。
正直この問題は全然綺麗にでけんかった。
方針としては、発言をそれぞれ2つずつをlistで保持 -> ambで順位と発言の正解の方(0 or 1)を束縛 -> あとはひたすらrequire。
発言を選ぶのはlist-refで正解の数字を渡してる。効率わるいなぁ。
最後のrequire連打はmap使ってまとめりゃ良かったかな。

(define (liars-puzzle)
  (letrec ((betty (lambda (x) (list-ref x 0)))
           (ethel (lambda (x) (list-ref x 1)))
           (joan (lambda (x) (list-ref x 2)))
           (kitty (lambda (x) (list-ref x 3)))
           (mary (lambda (x) (list-ref x 4))))
    (let ((betty-statements (list (lambda (x) (= (kitty x) 2))
                                   (lambda (x) (= (betty x) 3))))
           (ethel-statments (list (lambda (x) (= (ethel x) 1))
                                  (lambda (x) (= (joan x) 2))))
           (joan-statements (list (lambda (x) (= (joan x) 3))
                                  (lambda (x) (= (ethel x) 5))))
           (kitty-statements (list (lambda (x) (= (kitty x) 2))
                                   (lambda (x) (= (mary x) 4))))
           (mary-statements (list (lambda (x) (= (mary x) 4))
                                  (lambda (x) (= (betty x) 1)))))
      (let ((bs (amb 0 1))
            (es (amb 0 1))
            (js (amb 0 1))
            (ks (amb 0 1))
            (ms (amb 0 1))
            (b (amb 1 2 3 4 5))
            (e (amb 1 2 3 4 5))
            (j (amb 1 2 3 4 5))
            (k (amb 1 2 3 4 5))
            (m (amb 1 2 3 4 5)))
        (let ((seq (list b e j k m)))
          (require (distinct? seq))
          (require ((list-ref betty-statements bs) seq))
          (require (not ((list-ref betty-statements (remainder (+ bs 1) 2)) seq)))
          (require ((list-ref ethel-statments es) seq))
          (require (not ((list-ref ethel-statments (remainder (+ es 1) 2)) seq)))
          (require ((list-ref joan-statements js) seq))
          (require (not ((list-ref joan-statements (remainder (+ js 1) 2 )) seq)))
          (require ((list-ref kitty-statements ks) seq))
          (require (not ((list-ref kitty-statements (remainder (+ ks 1) 2)) seq)))
          (require ((list-ref mary-statements ms) seq))
          (require (not ((list-ref mary-statements (remainder (+ ms 1) 2)) seq)))
          (list (list 'betty b)
                (list 'ethel e)
                (list 'joan j)
                (list 'kitty k)
                (list 'mary m)))))))

実行。

gosh> (time (liars-puzzle))
;(time (liars-puzzle))
; real   1.314
; user   1.300
; sys    0.000
((betty 3) (ethel 5) (joan 2) (kitty 1) (mary 4))

遅い・・・。


流石にこれは無いだろjk ってことでambのページ
http://www.shido.info/lisp/scheme_amb.html
を見ると、下の方に4.42の解答例があるじゃないですか。
なるほど、xorを使えば綺麗にかけるのか、と納得。

exercise 4.43

またまたパズル。

;; 0 Moore: Loura(father: ???)
;; 1 Colonel Downing: Mellisa (father: Barnacle)
;; 2 Mr. Hall: Rosalind(father: ???)
;; 3 Sir Barnacle Hood: Gabrielle(father: ???)
;; 4 Dr. Parker: Mary Ann (father: Moose)

;;誰の娘の名のヨットを持っているか？
(define (ex4-43)
  (let ((moore (amb 0 1 2 3 4))
        (downing (amb 01 2 3 4))
        (hall (amb 0 1 2 3 4))
        (barnacle (amb 0 1 2 3 4))
        (parker (amb 0 1 2 3 4)))
    (require
     (distinct? (list moore downing hall barnacle parker)))
    (require (= downing 3))
    (require (= parker 0))
    (require (= (list-ref (list moore downing hall barnacle parker)
                          barnacle)
                4))
    (list-ref '(Moore Downing Hall Barnacle Parker) moore))) ;; who is Loura's father (yach "Laura" is owned by Moore)

実行

gosh> (ex4-43)
Downing
gosh> (amb)
no-choise

Mary Annの父がMooreとは決まってない場合
上のコードの
(require (= parker 0))
をコメントアウト。

gosh> (ex4-43)
Moore
gosh> (amb)
Downing
gosh> (amb)
Parker
gosh> (amb)
Parker
gosh> (amb)
no-choise

そろそろ本気で試験勉強に向かわないかんのでここまで。
さらば現実逃避・・・。