Scheme - 超言語的抽象(Scheme の変形 - 非決定性計算(amb と探索(論理パズル、通常のScheme プログラム)))

計算機プログラムの構造と解釈[第2版] 原著

開発環境

• OS X El Capitan - Apple (OS)
• Emacs(Text Editor)
• Scheme (プログラミング言語)
• Gauche, kscheme(github) (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原著: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の第4章(超言語的抽象)、4.3(Scheme の変形 - 非決定性計算)、4.3.1(amb と探索)、問題4.41.を取り組んでみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
• Scheme手習い

問題4.41.

コード(Emacs)

(begin
  (define multiple-dwelling
    (lambda ()
      (define distinct?
        (lambda (items)
          (if (null? items)
              #t
              (if (null? (cdr items))
                  #t
                  (if (member (car items) (cdr items))
                      #f
                      (distinct? (cdr items)))))))
      (define (pred baker cooper fletcher miller smith)
        (if (= baker 5)
            #f
            (if (= cooper 1)
                #f
                (if (= fletcher 5)
                    #f
                    (if (= fletcher 1)
                        #f
                        (if (< miller cooper)
                            #f
                            (if (= (abs (- smith fletcher)) 1)
                                #f
                                (if (= (abs (- fletcher cooper)) 1)
                                    #f
                                    (if (distinct? (list baker cooper fletcher
                                                         miller smith))
                                        #t
                                        #f)))))))))
      (define (flat items)
        (if (null? items)
            '()
            (append (car items)
                    (flat (cdr items)))))
      (define (map proc items)
        (if (null? items)
            '()
            (cons (proc (car items))
                  (map proc (cdr items)))))
      (define (proc items)
        (if (null? items)
            '(())
            (flat
             (map (lambda (head)
                    (map (lambda (rest)
                           (cons head rest))
                         (proc (filter (lambda (x)
                                         (not (= x head)))
                                       items))))
                  items))))
      (define (filter pred items)
        (if (null? items)
            '()
            (if (pred (car items))
                (cons (car items)
                      (filter pred (cdr items)))
                (filter pred (cdr items)))))
      (map (lambda (items)
             (list (list 'baker (car items))
                   (list 'cooper (cadr items))
                   (list 'fletcher (caddr items))
                   (list 'miller (cadddr items))
                   (list 'smith (car (cddddr items)))))
           (filter (lambda (items)
                     (pred (car items)
                           (cadr items)
                           (caddr items)
                           (cadddr items)
                           (car (cddddr items))))
                   (proc '(1 2 3 4 5))))))

  (define for-each
    (lambda (proc items)
      (if (null? items)
          'done
          ((lambda ()
             (proc (car items))
             (for-each proc (cdr items)))))))
  
  (for-each (lambda (item)
              (display item)
              (newline))
            (multiple-dwelling))
  )

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

$ gosh sample41.scm
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
$