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

SICP scheme

直前エントリに追記しすぎな気もするので新たなエントリを起こす事に。

問題 4.43

Mary Ann の姓が Moore で無い場合なナニについて最初は机上で、と思っていたんですが面倒なのと 8queen なソレの手続きが微妙にイメージできんというナニにより、マシンに解決を依頼する事に。手続きは以下。

(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)))
      (let ((Mary (list 'Mary 
			(amb Moore Dowing Hall Parker)))
	    (Lorna (list 'Lorna
			 (amb Moore Dowing Hall Parker))))
	(require (distinct? (list Melissa Mary Lorna)))
	(let ((Rosalind (list 'Rosalind
			      (amb Moore Dowing Hall Parker))))
	  (require (distinct? (list Melissa Mary Lorna Rosalind)))
	  (let ((Gabrielle (list 'Gabrielle
				 (amb Moore 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)))))))

上記手続きが出した答が以下。(出力整形済み

;;; 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

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

;;; Amb-Eval input:
try-again

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

;;; Amb-Eval input:
try-again

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

;;; Amb-Eval input:
try-again

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

;;; Amb-Eval input:

かったるいけど、順に検証してみよう。ちなみに

  • Barnacle の船は Gabrielle
  • Moore は Lorna
  • Hall は Rosalind
  • Dowing は Melissa (父親は Barnacle)
  • Parker は Mary Ann

という持ってる船の名前なナニはセイフな模様。あと、当たり前ですが、Melissa の父親もセイフ。残った条件としては_Gabrielle の父親は Parker の娘の名前を付けたヨットを持っている_というものですが、最初の解は

  • Gab の父は Hall
  • Parker の娘は Rosalind
  • Hall の船は Rosalind

でセイフ。次は

  • Gab の父は Hall
  • Parker の娘は Rosalind
  • Hall の船は Rosalind

って何が違うのか、というと Mary Ann と Lorna の親父が違うのか。次は

  • Gab の父は Moore
  • Parker の娘は Lorna
  • Moore の船は Lorna

でセイフ。次。

  • Gab の父は Moore
  • Parker の娘は Lorna
  • Moore の船は Lorna

これもセイフか。ってこれで終わりか。一応大丈夫と見ることにします。次の問題に着手予定なんで、調子が良ければ追記するかもしれません。

問題 4.44

最初、n-queen なソレ (問題 2.42 のナニ) に、と思っていたのですが、思考の迷路というか無知なる故の不明なソレでワケワカ。日本語も微妙なんですが、とりあえず 8 限定で解決する手法を試行錯誤してみる事に。

で、問題 2.42 なソレをカンニングしつつ、以下の手続きをでっち上げてみた。DRY 違反満点ってカンジですが一応動いてるのかなぁ。一応以下の解はビンゴな模様。

;;; Amb-Eval input:
(8queen)

;;; Starting a new problem 
;;; Amb-Eval value:
(1 5 8 6 3 7 2 4)

;;; Amb-Eval input:

一連の手続きは以下。

(define (require p) (if (not p) (amb)))
(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))

(define (tailend seq)
  (define (tailend-iter seq ret)
    (if (null? seq)
	ret
	(tailend-iter (cdr seq) (car seq))))
  (tailend-iter seq '()))

(define (safe? k seq)
  (define (safe-iter p k seq)
    (cond ((= (- k p) 0) true)
	  ((= (abs (- (car seq) (tailend seq))) (- k p)) false)
	  ((= (car seq) (tailend seq)) false)
	  (else
	   (safe-iter (+ p 1) k (cdr seq)))))
  (safe-iter 1 k seq))

(define (8queen)
  (let ((one (amb 1 2 3 4 5 6 7 8))
	(two (amb 1 2 3 4 5 6 7 8)))
    (require (distinct? (list one two)))
    (require (safe? 2 (list one two)))
    (let ((three (amb 1 2 3 4 5 6 7 8)))
      (require (distinct? (list one two three)))
      (require (safe? 3 (list one two three)))
      (let ((four (amb 1 2 3 4 5 6 7 8)))
	(require (distinct? (list one two three four)))
	(require (safe? 4 (list one two three four)))
	(let ((five (amb 1 2 3 4 5 6 7 8)))
	  (require (distinct? (list one two three four five)))
	  (require (safe? 5 (list one two three four five)))
	  (let ((six (amb 1 2 3 4 5 6 7 8)))
	    (require (distinct? (list one two three four five six)))
	    (require (safe? 6 (list one two three four five six)))
	    (let ((seven (amb 1 2 3 4 5 6 7 8)))
	      (require (distinct? (list one two three four five six seven)))
	      (require (safe? 7 (list one two three four five six seven)))
	      (let ((eight (amb 1 2 3 4 5 6 7 8)))
		(require (distinct? (list one two three four five six seven eight)))
		(require (safe? 8 (list one two three four five six seven eight)))
		(list one two three four five six seven eight)))))))))

マス目を可変にできれば、なんですがどうしたものやら。

続

こんなワザができるのを (以下略

gosh> (apply + '(1 2 3))
6
gosh>

これで一つハードル越えたカンジですが、amb 評価器が apply をどう扱うんだろうか。