sicp/mceval/amb-fathers-daughters.rkt

102 lines
2.6 KiB
Racket

;; Exercise 4.42
;; Optimisation. Put everything we already know in a table. Each
;; row is father, yacht, daughter.
(define (fathers-daughters mary)
(define first-row car)
(define rest-rows cdr)
(define (daughter father)
(caddr (assq father fathers)))
(define (yacht father)
(cadr (assq father fathers)))
(define (father daughter)
(define (loop f)
(cond ((null? f) false)
((eq? daughter (caddr (first-row f)))
(car (first-row f)))
(else (loop (rest-rows f)))))
(loop fathers))
(define fathers
(if (eq? mary 'moore)
;; Mary's surname is Moore
(list
(list 'moore 'lorna 'mary)
(list 'hood 'gabrielle 'melissa)
(list 'downing 'melissa (amb 'lorna 'gabrielle 'rosalind))
(list 'hall 'rosalind (amb 'lorna 'gabrielle))
(list 'parker 'mary (amb 'lorna 'gabrielle 'rosalind)))
;; Mary's surname is unkonwn
(list
(list 'moore 'lorna (amb 'mary 'gabrielle 'rosalind))
(list 'hood 'gabrielle 'melissa)
(list 'downing 'melissa (amb 'mary 'lorna 'gabrielle 'rosalind))
(list 'hall 'rosalind (amb 'mary 'lorna 'gabrielle))
(list 'parker 'mary (amb 'lorna 'gabrielle 'rosalind)))))
(require (distinct? (list (daughter 'moore)
(daughter 'hood)
(daughter 'downing)
(daughter 'hall)
(daughter 'parker))))
;; Gabrielle's father owns the yacht named after parker's daughter
(require (eq? (yacht (father 'gabrielle))
(daughter 'parker)))
fathers)
;; Output
;;; Amb-Eval input:
(fathers-daughters 'moore)
;;; Starting a new problem
;;; Amb-Eval value:
1
((moore lorna mary) (hood gabrielle melissa) (downing melissa lorna) (hall rosalind gabrielle) (parker mary rosalind))
;;; Amb-Eval input:
try-again
;;; There are no more values of
3
(fathers-daughters (quote moore))
;; Lorna's father must be Colonel Downing.
;; If we don't assume that Mary's surname is Moore:
(fathers-daughters false)
;;; Starting a new problem
;;; Amb-Eval value:
1
((moore lorna mary) (hood gabrielle melissa) (downing melissa lorna) (hall rosalind gabrielle) (parker mary rosalind))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
5
((moore lorna gabrielle) (hood gabrielle melissa) (downing melissa rosalind) (hall rosalind mary) (parker mary lorna))
;;; Amb-Eval input:
try-again
;;; There are no more values of
10
(fathers-daughters false)
;; Lorna's father is either Colonel Downing or Dr Parker