From a1fb98ddaddf7327139b1feb0c1e9101892ac692 Mon Sep 17 00:00:00 2001
From: Oliver Payne <ompayne@sdf.org>
Date: Thu, 9 Nov 2023 21:57:04 +0000
Subject: [PATCH] Tidy up code and add second part of exercise 4.42

---
 mceval/amb-fathers-daughters.rkt | 121 +++++++++++++++++++++++--------
 1 file changed, 91 insertions(+), 30 deletions(-)

diff --git a/mceval/amb-fathers-daughters.rkt b/mceval/amb-fathers-daughters.rkt
index 9164a6f..5071c12 100644
--- a/mceval/amb-fathers-daughters.rkt
+++ b/mceval/amb-fathers-daughters.rkt
@@ -1,40 +1,101 @@
 ;; Exercise 4.42
 
-(define (fathers-daughters)
+;; Optimisation.  Put everything we already know in a table.  Each
+;; row is father, yacht, daughter.
 
-  (define father car)
-  (define yacht cadr)
-  (define daughter caddr)
-  
-  (define (lookup-daughter f fathers)
-    (daughter (assq f fathers)))
 
-  (define (lookup-yacht f fathers)
-    (yacht (assq f fathers)))
-  
-  (define (lookup-father d fathers)
-    (cond ((null? fathers) false)
-          ((eq? d (daughter (car fathers)))
-           (car (car fathers)))
-          (else (lookup-father d (cdr fathers)))))
+(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))
 
-  ;; Optimisation.  Put everything we already know in a table.  Each
-  ;; row is father, yacht, daughter.
   (define fathers
-    (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))))
+    (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 (lookup-daughter 'moore fathers)
-                            (lookup-daughter 'hood fathers)
-                            (lookup-daughter 'downing fathers)
-                            (lookup-daughter 'hall fathers)
-                            (lookup-daughter 'parker fathers))))
+  (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? (lookup-yacht (lookup-father 'gabrielle fathers) fathers)
-                (lookup-daughter 'parker fathers)))
+  (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