|
|
|
@ -1,97 +1,22 @@
|
|
|
|
|
;; Exercise 4.42
|
|
|
|
|
|
|
|
|
|
(define (fathers-daughters)
|
|
|
|
|
(let ((moore 'mary)
|
|
|
|
|
(hood 'melissa)
|
|
|
|
|
(downing (amb 'gabrielle 'lorna 'rosalind))
|
|
|
|
|
(hall (amb 'gabrielle 'lorna))
|
|
|
|
|
(parker (amb 'gabrielle 'lorna 'rosalind)))
|
|
|
|
|
(require (distinct? (list downing hall parker)))
|
|
|
|
|
())
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
(define (fathers-daughers)
|
|
|
|
|
(let ((mary 'moore)
|
|
|
|
|
(melissa 'hood)
|
|
|
|
|
(gabrielle (amb 'downing 'hall 'parker))
|
|
|
|
|
(lorna (amb 'downing 'hall 'parker))
|
|
|
|
|
(rosalind (amb 'downing 'hall 'parker)))
|
|
|
|
|
(require (distinct? (list gabrielle lorna rosalind)))
|
|
|
|
|
(require (gabrielle ))))
|
|
|
|
|
|
|
|
|
|
(define (daughter father) (car father))
|
|
|
|
|
(define (yacht father) (cadr father))
|
|
|
|
|
(define (father daugher yacht) (list daugher yacht))
|
|
|
|
|
|
|
|
|
|
(define (fathers-daughters)
|
|
|
|
|
(let ((moore (father 'mary 'lorna))
|
|
|
|
|
(hood (father 'melissa 'gabrielle))
|
|
|
|
|
(downing (father (amb 'gabrielle 'lorna 'rosalind) 'melissa))
|
|
|
|
|
(hall (father (amb 'gabrielle 'lorna) 'rosalind))
|
|
|
|
|
(parker (father (amb 'gabrielle 'lorna 'rosalind) (amb 'mary 'melissa))))
|
|
|
|
|
(require (distinct? (list (daughter downing) (daughter hall) (daughter parker))))
|
|
|
|
|
(require (distinct? (list (yacht downing) (yacht hall) (yacht parker))))
|
|
|
|
|
(require (= (yacht )(daughter parker))))) ;; TODO
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (caar x) (car (car x)))
|
|
|
|
|
|
|
|
|
|
(define (assoc key records)
|
|
|
|
|
(cond ((null? records) false)
|
|
|
|
|
((equal? key (caar records)) (car records))
|
|
|
|
|
(else (assoc key (cdr records)))))
|
|
|
|
|
|
|
|
|
|
(define (fathers-daughters)
|
|
|
|
|
(let ((yachts '((moore lorna)
|
|
|
|
|
(hood gabrielle)
|
|
|
|
|
(downing melissa)
|
|
|
|
|
(hall rosalind)
|
|
|
|
|
(parker mary)))
|
|
|
|
|
(moore 'mary)
|
|
|
|
|
(hood 'melissa)
|
|
|
|
|
(downing (amb 'lorna 'gabrielle 'rosalind))
|
|
|
|
|
(hall (amb 'lorna 'gabrielle))
|
|
|
|
|
(parker (amb 'lorna 'gabrielle 'rosalind))
|
|
|
|
|
(lorna (amb 'downing 'hall 'parker))
|
|
|
|
|
(gabrielle (amb 'downing 'hall 'parker))
|
|
|
|
|
(melissa 'hood)
|
|
|
|
|
(rosalind (amb 'downing 'parker))
|
|
|
|
|
(mary 'moore))
|
|
|
|
|
(require (distinct? (list lorna gabrielle rosalind
|
|
|
|
|
downing hall parker)))
|
|
|
|
|
(require (eq? (car (cdr (assoc gabrielle yachts))) parker))
|
|
|
|
|
(list (list 'mary mary)
|
|
|
|
|
(list 'rosalind rosalind)
|
|
|
|
|
(list 'melissa melissa)
|
|
|
|
|
(list 'gabrielle gabrielle)
|
|
|
|
|
(list 'lorna lorna))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (caar x) (car (car x)))
|
|
|
|
|
(define (cadr x) (car (cdr x)))
|
|
|
|
|
(define (caddr x) (car (cdr (cdr x))))
|
|
|
|
|
|
|
|
|
|
(define (assq key records)
|
|
|
|
|
(cond ((null? records) false)
|
|
|
|
|
((eq? key (caar records)) (car records))
|
|
|
|
|
(else (assq key (cdr records)))))
|
|
|
|
|
|
|
|
|
|
(define (fathers-daughters)
|
|
|
|
|
|
|
|
|
|
(define daughter caddr)
|
|
|
|
|
(define father car)
|
|
|
|
|
(define yacht cadr)
|
|
|
|
|
(define daughter caddr)
|
|
|
|
|
|
|
|
|
|
(define (lookup-daughter father fathers)
|
|
|
|
|
(daughter (assq father fathers)))
|
|
|
|
|
(define (lookup-daughter f fathers)
|
|
|
|
|
(daughter (assq f fathers)))
|
|
|
|
|
|
|
|
|
|
(define (lookup-yacht father fathers)
|
|
|
|
|
(yacht (assq father fathers)))
|
|
|
|
|
(define (lookup-yacht f fathers)
|
|
|
|
|
(yacht (assq f fathers)))
|
|
|
|
|
|
|
|
|
|
(define (lookup-father daughter fathers)
|
|
|
|
|
(cond ((null? fathers) false)
|
|
|
|
|
((eq? daughter (daughter (car fathers)))
|
|
|
|
|
(define (lookup-father d fathers)
|
|
|
|
|
(cond ((null? fathers) '())
|
|
|
|
|
((eq? d (daughter (car fathers)))
|
|
|
|
|
(car (car fathers)))
|
|
|
|
|
(else (father daughter (cdr fathers)))))
|
|
|
|
|
(else (lookup-father d (cdr fathers)))))
|
|
|
|
|
|
|
|
|
|
;; Optimisation. Put everything we already know in a table. Each
|
|
|
|
|
;; row is father, yacht, daughter.
|
|
|
|
@ -109,7 +34,7 @@
|
|
|
|
|
(lookup-daughter 'hall fathers)
|
|
|
|
|
(lookup-daughter 'parker fathers))))
|
|
|
|
|
;; Gabrielle's father owns the yacht named after parker's daughter
|
|
|
|
|
(require (eq? (lookup-yacht (lookup-father 'gabrielle fathers))
|
|
|
|
|
(require (eq? (lookup-yacht (lookup-father 'gabrielle fathers) fathers)
|
|
|
|
|
(lookup-daughter 'parker fathers)))
|
|
|
|
|
fathers)
|
|
|
|
|
|
|
|
|
|