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

なんと言えばよいやら、へろへろです。後半になってきて息切れ気味かなぁ。リキの無い自分が情けないやら

問題 4.43

データ構造を見直し。親父は自分の名前と船の名前のみ。娘は自分の名前と父親と自分の名前な船を持つ人をそれぞれリストで保持。で、手続きをでっち上げて評価器に吸わせてみたら答えが 4 つ出てきた。びっくり。ってか机上検討足らなスギ。
評価器が出した答えが以下です。(整形してます

;;; Amb-Eval input:
(solver)

;;; Starting a new problem
;;; Amb-Eval value:
((Melissa (Barnacle Gabrielle) (Dowing Melissa)) 
 (Mary (Moore Lorna) (Parker Mary)) 
 (Lorna (Dowing Melissa) (Moore Lorna)) 
 (Rosalind (Parker Mary) (Hall Rosalind)) 
 (Gabrielle (Hall Rosalind) (Barnacle Gabrielle)))

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
((Melissa (Barnacle Gabrielle) (Dowing Melissa)) 
 (Mary (Moore Lorna) (Parker Mary)) 
 (Lorna (Dowing Melissa) (Hall Rosalind)) 
 (Rosalind (Parker Mary) (Moore Lorna)) 
 (Gabrielle (Hall Rosalind) (Barnacle Gabrielle)))

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
((Melissa (Barnacle Gabrielle) (Dowing Melissa)) 
 (Mary (Moore Lorna) (Parker Mary)) 
 (Lorna (Dowing Melissa) (Hall Rosalind)) 
 (Rosalind (Parker Mary) (Barnacle Gabrielle)) 
 (Gabrielle (Hall Rosalind) (Moore Lorna)))

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
((Melissa (Barnacle Gabrielle) (Dowing Melissa)) 
 (Mary (Moore Lorna) (Parker Mary)) 
 (Lorna (Dowing Melissa) (Barnacle Gabrielle)) 
 (Rosalind (Parker Mary) (Hall Rosalind)) 
 (Gabrielle (Hall Rosalind) (Moore Lorna)))

;;; Amb-Eval input:
try-again

;;; There are no more values of
(solver)

;;; Amb-Eval input:

~~改行なくって微妙なんですが、~~以下に整理。まだ上記の戻りが正しいのかどうかさえ未検証ッス。

Melissa
- 父は Barnacle
- 自分の名前が付いた船は Dowing が所有
Mary
- 父は Moore
- 自分の名前が付いた船は Parker が所有
Lorna
- 父は Dowing
- 自分の名前が付いた船は Moore か Hall か Barnacle が所有
Rosalind
- 父は Parker
- 自分の名前が付いた船は Moore か Hall か Barnacle が所有
Gabrielle
- 父は Hall
- 自分の名前が付いた船は Moore か Barnacle が所有

という形になっている模様。Gabrielle の父は Parker の娘の名前が付いた船を持っている、というシバリだけのはずなんですが、上記ってダウト??

つづき

ダウトか。Gabrielle の父は Hall で Parker の娘は Rosalind 確定なので、Rosalind の名前が付いた船は Hall しか持ってはイケナいはずだな。てコトは

((Melissa (Barnacle Gabrielle) (Dowing Melissa)) 
 (Mary (Moore Lorna) (Parker Mary)) 
 (Lorna (Dowing Melissa) (Moore Lorna)) 
 (Rosalind (Parker Mary) (Hall Rosalind)) 
 (Gabrielle (Hall Rosalind) (Barnacle Gabrielle)))

((Melissa (Barnacle Gabrielle) (Dowing Melissa)) 
 (Mary (Moore Lorna) (Parker Mary)) 
 (Lorna (Dowing Melissa) (Barnacle Gabrielle)) 
 (Rosalind (Parker Mary) (Hall Rosalind)) 
 (Gabrielle (Hall Rosalind) (Moore Lorna)))

の二つが正解のはず。手続きで確認してるのは ... って制限が足らない事に気づいた。上側のは大丈夫だけど下側は自分の名前な船を持つ人ではない娘がいる。てか、それ以前に娘の属性である_自分の名前な船を持つヒト_って余計っぽい。
ちなみにこの時点での手続きが以下。

(define (solver)
  (define (last-elem l)
    (cond ((null? (cdr l)) (car l))
	  (else
	   (last-elem (cdr l)))))
  (define (distinct? l)
    (let ((last (last-elem l)))
      (define (distinct-iter l)
	(cond ((null? (cdr l)) true)
	      ((eq? (cadr (car l)) (cadr last)) false)
	      ((eq? (caddr (car l)) (caddr last)) false)
	      (else
	       (distinct-iter (cdr l)))))
      (distinct-iter l)))
  (define (find-parker l)
    (cond ((null? l) (list false false false))
	  ((eq? 'Parker (car (cadr (car l)))) (car l))
	  (else
	   (find-parker (cdr l)))))

  (let ((Moore (list 'Moore 'Lorna))
	(Dowing (list 'Dowing 'Melissa))
	(Hall (list 'Hall 'Rosalind))
	(Barnacle (list 'Barnacle 'Gabrielle))
	(Parker (list 'Parker 'Mary)))
    (let ((Melissa (list 'Melissa Barnacle Dowing))
	  (Mary (list 'Mary Moore Parker))
	  (Lorna (list 'Lorna
		       (amb Dowing Hall Parker)
		       (amb Moore Hall Barnacle))))
      (require (not (eq? (cadr Lorna) (caddr Lorna))))
      (let ((Rosalind (list 'Rosalind
			    (amb Dowing Hall Parker)
			    (amb Moore Hall Barnacle))))
	(require (not (eq? (cadr Rosalind) (caddr Rosalind))))
	(require (distinct? (list Melissa Mary Lorna Rosalind)))
	(let ((Gabrielle (list 'Gabrielle
			       (amb Dowing Hall Parker)
			       (amb Moore Hall Barnacle))))
	  (require (not (eq? (cadr Gabrielle) (caddr Gabrielle))))
	  (require (distinct? (list Melissa Mary Lorna Rosalind Gabrielle)))
	  (require (eq? (cadr (cadr Gabrielle))
			(car (find-parker (list Melissa
						Mary
						Lorna
						Rosalind
						Gabrielle)))))
	  (list Melissa Mary Lorna Rosalind Gabrielle))))))

で、件の属性とそれに関わる手続きを削除してみたら正常動作。別途投入予定ッス。解もエントリに入れていたものが一つだけ、な模様。眠い。

つづき

(211) なエントリによると

Moore の船の名前は Lorna で彼女の父親は Dowing 又は Hall
Dowing の船の名前は Melissa で彼女の父親は Barnacle
Hall の船の名前は Rosalind で彼女の父親は Parker
Barnacle の船の名前は Gabrielle で彼女の父親は Hall
Parker の船の名前は Mary Ann で彼女の父親は Moore

となってて、評価器の出力は以下 (見づらいので整形

;;; Amb-Eval input:
(solver)

;;; Starting a new problem
;;; Amb-Eval value:
((Melissa (Barnacle Gabrielle)) 
 (Mary (Moore Lorna)) 
 (Lorna (Dowing Melissa)) 
 (Rosalind (Parker Mary)) 
 (Gabrielle (Hall Rosalind)))

;;; Amb-Eval input:
try-again

;;; There are no more values of
(solver)

;;; Amb-Eval input:

むむ。難しく考えスギだったのか (ため息

(define (solver)
  (define (last-elem l)
    (cond ((null? (cdr l)) (car l))
	  (else
	   (last-elem (cdr l)))))
  (define (distinct? l)
    (let ((last (last-elem l)))
      (define (distinct-iter l)
	(cond ((null? (cdr l)) true)
	      ((eq? (cadr (car l)) (cadr last)) false)
	      (else
	       (distinct-iter (cdr l)))))
      (distinct-iter l)))
  (define (find-parker l)
    (cond ((null? l) (list false false false))
	  ((eq? 'Parker (car (cadr (car l)))) (car l))
	  (else
	   (find-parker (cdr l)))))

  (let ((Moore (list 'Moore 'Lorna))
	(Dowing (list 'Dowing 'Melissa))
	(Hall (list 'Hall 'Rosalind))
	(Barnacle (list 'Barnacle 'Gabrielle))
	(Parker (list 'Parker 'Mary)))
    (let ((Melissa (list 'Melissa Barnacle))
	  (Mary (list 'Mary Moore))
	  (Lorna (list 'Lorna
		       (amb Dowing Hall Parker))))
      (let ((Rosalind (list 'Rosalind
			    (amb Dowing Hall Parker))))
	(require (distinct? (list Melissa Mary Lorna Rosalind)))
	(let ((Gabrielle (list 'Gabrielle
			       (amb Dowing Hall Parker))))
	  (require (distinct? (list Melissa Mary Lorna Rosalind Gabrielle)))
	  (require (eq? (cadr (cadr Gabrielle))
			(car (find-parker (list Melissa
						Mary
						Lorna
						Rosalind
						Gabrielle)))))
	  (list Melissa Mary Lorna Rosalind Gabrielle))))))

上記が現時点の手続きッス。ちなみに評価器方面に primitive な and と cadr を追加しないと動きません。