Scheme - 非決定性プログラムの例(論理パズル(特殊形式ambを使わず通常の方法で解く(map, filter)))

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)

開発環境

• OS X Lion - Apple(OS)
• Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
• Scheme (プログラミング言語)
• MIT/GNU Scheme (処理系)

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の4(超言語的抽象)、4.3(Scheme の変形 - 非決定性計算)、4.3.2(非決定性プログラムの例)、論理パズル、問題 4.41を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題 4.41

コード(BBEdit)

sample.scm

(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))

(define (filter predicate sequence)
  (cond ((null? sequence) '())
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

(define (multiple-dwelling)
  (define (iter a b c d e product)
    (cond ((< e 5)
           (iter a b c d (+ e 1) (cons (list a b c d (+ e 1))
                                       product)))
          ((< d 5)
           (iter a b c (+ d 1) 1 (cons (list a b c (+ d 1) 1)
                                       product)))
          ((< c 5)
           (iter a b (+ c 1) 1 1 (cons (list a b (+ c 1) 1 1)
                                       product)))
          ((< b 5)
           (iter a (+ b 1) 1 1 1 (cons (list a (+ b 1) 1 1 1)
                                       product)))
          ((< a 5)
           (iter (+ a 1) 1 1 1 1 (cons (list (+ a 1) 1 1 1 1)
                                       product)))
          (else product)))
  (map (lambda (x)
         (list (list 'baker (car x))
               (list 'cooper (cadr x))
               (list 'fletcher (caddr x))
               (list 'miller (cadddr x))
               (list 'smith (car (cddddr x)))))
       (filter (lambda (x)
                 (let ((baker (car x))
                       (cooper (cadr x))
                       (fletcher (caddr x))
                       (miller (cadddr x))
                       (smith (car (cddddr x))))
                   (and (not (= fletcher 5))
                        (not (= fletcher 1))
                        (not (= cooper 1))
                        (not (= (abs (- fletcher
                                        cooper))
                                1))
                        (> miller cooper)
                        (not (= (abs (- fletcher
                                        smith))
                                1))
                        (not (= baker
                                5))
                        (distinct? (list baker
                                         cooper
                                         fletcher
                                         miller
                                         smith)))))
               (iter 1 1 1 1 1 (list (list 1 1 1 1 1))))))

入出力結果(Terminal, REPL(Read, Eval, Print, Loop))

$ scheme
MIT/GNU Scheme running under MacOSX
Type `^C' (control-C) followed by `H' to obtain information about interrupts.

Copyright (C) 2011 Massachusetts Institute of Technology
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

Image saved on Friday April 13, 2012 at 9:02:52 AM
  Release 9.1.1 || Microcode 15.3 || Runtime 15.7 || SF 4.41 || LIAR/C 4.118
  Edwin 3.116

1 ]=> (load "./sample.scm")

;Loading "./sample.scm"... done
;Value: multiple-dwelling

1 ]=> (multiple-dwelling)

;Value 2: (((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)))

1 ]=> ^D
End of input stream reached.
Moriturus te saluto.
$