SICP 読み (209) 4.3.2 非決定性プログラムの例

8queen な問題 2.42 は全然記憶にないなぁ。基本的にカンニングはしてないはずなんですがどうなんだろうか。てか、それすら覚えてない、とゆーのも微妙。

問題 4.42

通勤バスの中で検討しかけてるんですが、パズルの解の一つ (??) として

'((Betty 3) (Ethel 5) (Joan 2) (Kitty 1) (Mary 4))

というのが出てきとります。で、これを実際の手続きにする場合どうしたものやら、とゆーあたりで前の問題に戻った記憶あり。あと、最初に

'((Betty 5) (Ethel 1) (Joan 3) (Kitty 2) (Mary 4))

という可能性も見出してたんですが、Mary Kitty の情報がどちらも真になるんでこれは破棄なのかなぁ、と。
あと、手続きなんですが、カブらない形で数え上げをした後の制限なソレの方法が微妙にイメージできん。

続き

こんなカンジで条件が持てる??

(let ((betty-cond (list (lambda () (= kitty 2)) (lambda () (betty 3)))))
  ;; 以下略

これを amb でナニすりゃ良いのだろうか。

(define (liars)
  (let ((betty (amb 1 2 3 4 5))
	(ethel (amb 1 2 3 4 5))
	(joan (amb 1 2 3 4 5))
	(kitty (amb 1 2 3 4 5))
	(mary (amb 1 2 3 4 5)))
    (let ((betty-cond (list (lambda () (= kitty 2))
			    (lambda () (= betty 3))))
	  (ethel-cond (list (lambda () (= ethel 1))
			    (lambda () (= joan 2))))
	  (joan-cond (list (lambda () (= joan 3))
			   (lambda () (= ethel 5))))
	  (kitty-cond (list (lambda () (= kitty 2))
			    (lambda () (=mary 4))))
	  (mary-cond (list (lambda () (= mary 4))
			   (lambda () (= betty 1)))))
      (let ((b-cond-list (amb (list (car betty-cond)
				    (cadr betty-cond))
			      (list (cadr betty-cond)
				    (car betty-cond))))
	    (e-cond-list (amb (list (car ethel-cond)
				    (cadr ethel-cond))
			      (list (cadr ethel-cond)
				    (car ethel-cond))))
	    (j-cond-list (amb (list (car joan-cond)
				    (cadr joan-cond))
			      (list (cadr joan-cond)
				    (car joan-cond))))
	    (k-cond-list (amb (list (car kitty-cond)
				    (cadr kitty-cond))
			      (list (cadr kitty-cond)
				    (car kitty-cond))))
	    (m-cond-list (amb (list (car mary-cond)
				    (cadr mary-cond))
			      (list (cadr mary-cond)
				    (car mary-cond)))))
	(require (and (not ((car b-cond-list)))
		      ((cadr b-cond-list))))
	(require (and (not ((car e-cond-list)))
		      ((cadr e-cond-list))))
	(require (and (not ((car j-cond-list)))
		      ((cadr j-cond-list))))
	(require (and (not ((car k-cond-list)))
		      ((cadr k-cond-list))))
	(require (and (not ((car m-cond-list)))
		      ((cadr m-cond-list))))))))

こ、これはヒドい。(とほほほ
しかも distinct? してない。(泣

改良

してみる。なんとなく手続きにまとめる事ができそうなカンジ。

(define (liars)
  (define (cond-set l)
    (amb l (list (cadr l) (car l))))
  (let ((betty (amb 1 2 3 4 5)))
    (let ((ethel (amb 1 2 3 4 5)))
      (require (distinct? (list betty ethel)))
      (let ((joan (amb 1 2 3 4 5)))
	(require (distinct? (list betty ethel joan)))
	(let ((kitty (amb 1 2 3 4 5)))
	  (require (distinct? (list betty ethel joan kitty)))
	  (let ((mary (amb 1 2 3 4 5)))
	    (require (distinct? (list betty ethel joan kitty mary)))
	    (let ((betty-cond (list (lambda () (= kitty 2))
				    (lambda () (= betty 3))))
		  (ethel-cond (list (lambda () (= ethel 1))
				    (lambda () (= joan 2))))
		  (joan-cond (list (lambda () (= joan 3))
				   (lambda () (= ethel 5))))
		  (kitty-cond (list (lambda () (= kitty 2))
				    (lambda () (=mary 4))))
		  (mary-cond (list (lambda () (= mary 4))
				   (lambda () (= betty 1)))))
	      (let ((cond-list (list (cond-set betty-cond)
				     (cond-set ethel-cond)
				     (cond-set joan-cond)
				     (cond-set kitty-cond)
				     (cond-set mary-cond))))
		(let f ((l cond-list))
		  (cond ((null? l)
			 (list (list 'betty betty)
			       (list 'ethel ethel)
			       (list 'joan joan)
			       (list 'kitty kitty)
			       (list 'mary mary)))
			(else
			 (require (and (not ((car (car l))))
				       ((cadr (car l)))))
			 (f (cdr l)))))))))))))

本当かなぁ。てか、まだひと括りにできそうなナニがあるな。あと、最初のナニは、なーんも戻してませんが、ご愛嬌ってコトでご勘弁下さひ。(を

さらに

調子にのってヤッてみる。

(define (liars)
  (define (cond-set l)
    (amb l (list (cadr l) (car l))))
  (let ((betty (amb 1 2 3 4 5)))
    (let ((ethel (amb 1 2 3 4 5)))
      (require (distinct? (list betty ethel)))
      (let ((joan (amb 1 2 3 4 5)))
	(require (distinct? (list betty ethel joan)))
	(let ((kitty (amb 1 2 3 4 5)))
	  (require (distinct? (list betty ethel joan kitty)))
	  (let ((mary (amb 1 2 3 4 5)))
	    (require (distinct? (list betty ethel joan kitty mary)))
	    (let f ((l (list (cond-set (list (lambda () (= kitty 2))
					     (lambda () (= betty 3))))
			     (cond-set (list (lambda () (= ethel 1))
					     (lambda () (= joan 2))))
			     (cond-set (list (lambda () (= joan 3))
					     (lambda () (= ethel 5))))
			     (cond-set (list (lambda () (= kitty 2))
					     (lambda () (=mary 4))))
			     (cond-set (list (lambda () (= mary 4))
					     (lambda () (= betty 1)))))))
	      (cond ((null? l)
		     (list (list 'betty betty)
			   (list 'ethel ethel)
			   (list 'joan joan)
			   (list 'kitty kitty)
			   (list 'mary mary)))
		    (else
		     (require (and (not ((car (car l))))
				   ((cadr (car l)))))
		     (f (cdr l)))))))))))

これ、本当に動くのかなぁ。てか、本題のパズルを解くのをそっちのけにしてるんですが。(を