SICP演習問題4.39,4.40,4.41,4.42

4.38はパス．めんどー．

4.39

影響しない(はず)

4.40

backerたちがそもそもすまないところは，始めからリストに入れない．

;exercise4.40
(define (multiple-dwelling)
  (let ((cooper (amb 2 3 4 5))
        (miller (amb 1 2 3 4 5)))
    (require (not (= cooper miller)))
    (require (> miller cooper))
    (let ((smith (amb 1 2 3 4 5)))
      (require (not (= smith cooper)))
      (require (not (= smith miller)))
      (let ((fletcher (amb 2 3 4)))
        (require (not (= fletcher cooper)))
        (require (not (= fletcher miller)))
        (require (not (= fletcher smith)))
        (require (not (= (abs (- fletcher smith)) 1)))
        (require (not (= (abs (- fletcher cooper)) 1)))
        (let ((backer (amb 1 2 3 4)))
          (require (not (= backer cooper)))
          (require (not (= backer miller)))
          (require (not (= backer smith)))
          (require (not (= backer fletcher)))
          (list (list 'backer backer)
                (list 'cooper cooper)
                (list 'fletcher fletcher)
                (list 'miller miller)
                (list 'smith smith)))))))

4.41

(やってないけど)4.38の確認も兼ねて，4.38の制限をコメントアウトした

;;exercise4.41
(use util.combinations)

(define (multiple-dwelling)
  (for-each (lambda (seq)
              (let ((backer   (car   seq))
                    (cooper   (cadr  seq))
                    (fletcher (caddr seq))
                    (miller   (cadddr seq))
                    (smith    (car (cddddr seq))))
                (if (and
                     (not (= backer 5))
                     (not (= cooper 1))
                     (not (= fletcher 5))
                     (not (= fletcher 1))
                     (> miller cooper)
;                    (not (= (abs (- smith fletcher)) 1))
                     (not (= (abs (- fletcher cooper)) 1)))
                    (print seq))))
              (permutations '(1 2 3 4 5))))
(time (multiple-dwelling))

gosh> (1 2 4 3 5)
(1 2 4 5 3)
(1 4 2 5 3)
(3 2 4 5 1)
(3 4 2 5 1)
;(time (multiple-dwelling))
; real   0.000
; user   0.000
; sys    0.000
#<undef>

ちなみに，letをlist-refでやると，

gosh> (1 2 4 3 5)
(1 2 4 5 3)
(1 4 2 5 3)
(3 2 4 5 1)
(3 4 2 5 1)
;(time (multiple-dwelling))
; real   0.010
; user   0.010
; sys    0.000
#<undef>

若干遅い．

4.42

一度ノートに解いて，その後4.41を使って解いてみた．
証言は排他的なので，xorを作成．

(use util.combinations)

(define (xor a b)
  (if (or (and a b) (and (not a) (not b))) #f #t))

(define (true-ranking-of-schoolgirls)
  (for-each (lambda (seq)
              (let ((betty  (car   seq))
                    (ethel  (cadr  seq))
                    (joan   (caddr seq))
                    (kitty  (cadddr seq))
                    (mary   (car (cddddr seq))))
                (if (and
                     (xor (= kitty 2) (= betty 3))
                     (xor (= ethel 1) (= joan  2))
                     (xor (= joan  3) (= ethel 5))
                     (xor (= kitty 2) (= mary  4))
                     (xor (= mary  4) (= betty 1)))
;                   (print seq))))
;                   (print (cons 'betty betty)
;                          (cons 'ethel ethel)
;                          (cons 'joan joan)
;                          (cons 'kitty kitty)
;                          (cons 'mary mary)))))
                    (print
                     (list 'betty betty
                           'ethel ethel
                           'joan  joan
                           'kitty kitty
                           'mary  mary)))))
              (permutations '(1 2 3 4 5))))
(time (true-ranking-of-schoolgirls))

;表示の時間も計測してみた
;(print seq)
;gosh> (3 5 2 1 4)
;(time (true-ranking-of-schoolgirls))
; real   0.000
; user   0.000
; sys    0.000
;#<undef>

;(print (cons ~))
;gosh> (betty . 3)(ethel . 5)(joan . 2)(kitty . 1)(mary . 4)
;(time (true-ranking-of-schoolgirls))
; real   0.010
; user   0.000
; sys    0.000
;#<undef>

;(print (list ~))
;gosh> (betty 3 ethel 5 joan 2 kitty 1 mary 4)
;(time (true-ranking-of-schoolgirls))
; real   0.000
; user   0.000
; sys    0.000