Scheme - 超言語的抽象(Schemeの変形 - 非決定性計算(非決定性プログラムの例(論理パズル(嘘つきパズル, 通常のSchemeプログラム))))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)

開発環境

• OS X Mavericks - Apple(OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第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.3(非決定性プログラムの例)、論理パズル、問題 4.42.を解いてみる。

その他参考書籍

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

問題 4.42.

コード(BBEdit, Emacs)

sample42.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

(define (distinct? items)
  (cond ((null? items) #t)
        ((null? (cdr items)) #t)
        ((member (car items) (cdr items)) #f)
        (else (distinct? (cdr items)))))

(define (liar-puzzle)
  (define (inner betty ethel joan kitty mary)
    (and (or (and (= kitty 2)
                  (not (= betty 3)))
             (and (not (= kitty 2))
                  (= betty 3)))
         (or (and (= ethel 1)
                  (not (= joan 2)))
             (and (not (= ethel 1))
                  (= joan 2)))
         (or (and (= joan 3)
                  (not (= ethel 5)))
             (and (not (= joan 3))
                  (= ethel 5)))
         (or (and (= kitty 2)
                  (not (= mary 4)))
             (and (not (= kitty 2))
                  (= mary 4)))
         (or (and (= mary 4)
                  (not (= betty 1)))
             (and (not (= mary 4))
                  (= betty 1)))
         (distinct? (list betty ethel joan kitty mary))))
  (define (iter list-of-list)
    (if (null? list-of-list)
        '()
        (let ((items (car list-of-list)))
          (if (inner (car items)
                     (cadr items)
                     (caddr items)
                     (cadddr items)
                     (car (cddddr items)))
              (cons (list (list 'betty (car items))
                          (list 'ethel (cadr items))
                          (list 'joan (caddr items))
                          (list 'kitty (cadddr items))
                          (list 'mary (car (cddddr items))))
                    (iter (cdr list-of-list)))
              (iter (cdr list-of-list))))))
  (define (make-list-of-list list-of-list)
    (if (null? list-of-list)
        '()
        (let ((first (car list-of-list))
              (rest (cdr list-of-list)))
          (cond ((null? first) '())
                ((null? rest)
                 (map list
                      first))
                (else
                 (append (map (lambda (items)
                                (cons (car first)
                                      items))
                              (make-list-of-list rest))
                         (make-list-of-list (cons (cdr first)
                                                  rest))))))))
  (iter
   (make-list-of-list
    (list (list 1 2 3 4 5)
          (list 1 2 3 4 5)
          (list 1 2 3 4 5)
          (list 1 2 3 4 5)
          (list 1 2 3 4 5)))))

(for-each print
          (liar-puzzle))

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

$ ./sample42.scm
((betty 3) (ethel 5) (joan 2) (kitty 1) (mary 4))
$