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

現実トウヒな下書き含め、なエントリだったり (を

問題 4.43

適当なデータ構造を思いつかず、微妙。普通のリストだと

(2 4 5 3 1)

いっちゃんケツの Parker の船の名前が 1 で Moore の娘だな、というのは判別できる (それでも無理矢理気味) んですが、Gabrielle の父親は 3 の Hall でこいつの船の名前は Parker の娘のヤツだな、というナニを手続きの中で認識させるのはどうすりゃ良いのだ、と。
上のようにリストになってりゃ無理矢理繰り返しで何とかなりそうではありますが、これはこれで微妙。で、以下のような形になってりゃ良いのかな、と gosh 上で試験。

gosh> (define Moore '())
Moore
gosh> (define Dowing '())
Dowing
gosh> (define Hall '())
Hall
gosh> (define Barnacle '())
Barnacle
gosh> (define Parker '())
Parker
gosh> (set! Moore (list 'Lorna (list Dowing Hall Parker)))
(Lorna (() () ()))
gosh> (set! Dowing (list 'Melissa Barnacle))
(Melissa ())
gosh> (set! Hall (list 'Rosalind (list Dowing Parker)))
(Rosalind ((Melissa ()) ()))
gosh> (set! Barnacle (list 'Gabrielle (list Dowing Hall Parker)))
(Gabrielle (#0=(Melissa ()) (Rosalind (#0# ())) ()))
gosh> (set! Parker (list 'Mary Moore))
(Mary (Lorna (() () ())))
gosh>

駄目です。Moore 再設定時に Dowing やら Hall やら Parker は評価されている。で、lambda で囲んでしまえ、という安易な結論に達っしています。効率を考えろ、とゆーのはメモ化しろ、という事なのかなぁ、と思いつつもとりあえず手続きをでっち上げてみたいと思います。(がしかし投入は別途

つづき

例えば Moore だと以下。

(let ((Moore (list 'Moore 'Lorna (amb (lambda () Dowing)
				      (lambda () Hall)
				      (lambda () Parker)))))
  )

こうやって見るに delay と force を使った方が良さげに見えるな。以下に下書き。

(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 (disinct-iter l)
	(cond ((null? (cdr l)) #t)
	      ((eq? (cadr (car l)) (cadr last-elem)) #f)
	      (else
	       (distinct-iter (cdr l)))))
      (distinct-iter l)))
  (let ((Dowing (list 'Dowing 'Melissa (lambda () Barnacle)))
	(Parker (list 'Parker 'Mary (lambda () Moore)))
	(Moore (list 'Moore 'Lorna (amb (lambda () Dowing)
					(lambda () Hall)
					(lambda () Parker)))))
    (require (distinct? (list Dowing Parker Moore)))
    (let ((Hall (list 'Hall 'Rosalind (amb (lambda () Dowing)
					   (lambda () Parker)))))
      (require (distinct? (list Dowing Parker Moore Hall)))
      (let ((Barnacle (list 'Barnacle 'Gabrielle (amb (lambda () Dowing)
						      (lambda () Hall)
						      (lambda () Parker)))))
	(require
	 (distinct? (list Dowing Parker Moore Hall Barnacle)))

あとは、制限がかけてれば、ですが制限の書き方によっては

(let ((Dowing (list 'Dowing 'Melissa (amb (lambda () Moore)
					  (lambda () Dowing)
					  (lambda () Hall)
					  (lambda () Barnacle)
					  (lambda () Parker)))))
  )

な書き方でも良いのか。
# 本当だろうか。(とほほ

さらに続き

ええと、制限としては

Dowing の船は Melissa で彼女の父親は Barnacle
Parker の船は Mary Ann で彼女の父親は Moore
Gabrielle の父親は Parker の娘の名前を付けた船を持つ

の三点。

名前をチェックする必要はないので、上二点は以下か

(require (eq? 'Barnacle (car ((caddr Dowing)))))
(require (eq? 'Moore (car ((caddr Parker)))))

これ、その人が持ってる船の名前の娘の父親を戻す手続き、という事で

(define (get-father-name x)
  (car ((caddr x))))

なソレはやり過ぎなのか。あと、最後の制限ですが、Gabrielle の父親は

(car ((caddr Barnacle)))

で、名前を戻せる。あ、船の名前は cadr だな。あるいは Parker の娘は

(cadr Parker)

で名前が戻るのでこれを比較すりゃ良いはず。

(require (eq? (cadr ((caddr Barnacle))) (cadr Parker)))

eq? が適切なのかどうか微妙。でも微妙ながらデータ構造がイメージできて良かった。動くかどうか分からん、というかおそらくダウトなソレが以下です。

(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 (disinct-iter l)
	(cond ((null? (cdr l)) #t)
	      ((eq? (cadr (car l)) (cadr last-elem)) #f)
	      (else
	       (distinct-iter (cdr l)))))
      (distinct-iter l)))
  (let ((Dowing (list 'Dowing 'Melissa (lambda () Barnacle)))
	(Parker (list 'Parker 'Mary (lambda () Moore)))
	(Moore (list 'Moore 'Lorna (amb (lambda () Dowing)
					(lambda () Hall)
					(lambda () Parker)))))
    (require (distinct? (list Dowing Parker Moore)))
    (let ((Hall (list 'Hall 'Rosalind (amb (lambda () Dowing)
					   (lambda () Parker)))))
      (require (distinct? (list Dowing Parker Moore Hall)))
      (let ((Barnacle (list 'Barnacle 'Gabrielle (amb (lambda () Dowing)
						      (lambda () Hall)
						      (lambda () Parker)))))
	(require
	 (distinct? (list Dowing Parker Moore Hall Barnacle)))
	(require (eq? 'Barnacle (car ((caddr Dowing)))))
	(require (eq? 'Moore (car ((caddr Parker)))))
	(require (eq? (cadr ((caddr Barnacle))) (cadr Parker)))
	(list (list 'Moore (cadr Moore))
	      (list 'Dowing (cadr Dowing))
	      (list 'Hall (cadr Hall))
	      (list 'Barnacle (cadr Barnacle))
	      (list 'Parker (cadr Parker)))))))

なんとなくデキ上がったソレを見るに動きそうな気もしますが、多分見せかけだけなのではないか、と。恥ずかしいんで先に 4.3.3 な評価器仕込んで動作確認してやろうかな。