sicp-ex-4.43



<< Previous exercise (4.42) | Index | Next exercise (4.44) >>


woofy

  
  
 ; a. Lorna's father is Colonel Downing 
  
 ; b. 
 (define yacht-names  
     '((Moore Lorna)  
       (Downing Melissa)  
       (Barnacle Gabrielle)  
       (Hall Rosalind) 
       (Parker Mary))) 
  
 (define daddy-options 
     '((Lorna (Downing Barnacle Hall Parker)) 
       (Melissa (Barnacle)) 
       (Gabrielle (Moore Downing Hall Parker)) 
       (Rosalind (Moore Downing Parker)) 
       (Mary (Moore Downing Barnacle Hall)))) 
  
 (define (find-cdr kv-list k) 
     (define (iter rest) 
         (cond ((null? rest) false) 
               ((eq? k (caar rest)) (cadar rest)) 
               (else (iter (cdr rest))))) 
     (iter kv-list)) 
  
 (define (find-car kv-list k) 
     (define (iter rest) 
         (cond ((null? rest) false) 
               ((eq? k (cadar rest)) (caar rest)) 
               (else (iter (cdr rest))))) 
     (iter kv-list)) 
  
 (define (daddy girl set) (find-cdr set girl)) 
 (define (daughter daddy set) (find-car set daddy)) 
 (define (yacht daddy set) (find-cdr set daddy)) 
  
 (define (no-share-daddy daddy set) 
     (define (iter rest) 
         (cond ((null? rest) true) 
               ((eq? (cadar rest) daddy) false) 
               (else (iter (cdr rest))))) 
     (iter set)) 
  
 (define (nice-daughters) 
     (define (iter options result) 
         (if (null? options) 
             (begin 
                 (require (eq? (yacht (daddy 'Gabrielle)) (daughter 'Parker))) 
                 result) 
             (let ((girl (caar options)) 
                   (daddies (cadar options))) 
                 (let ((daddy (a-element-of daddies))) 
                     (require (no-share-daddy daddy result)) 
                     (iter (cdr options) (cons (list girl daddy) result)))))) 
     (iter daddy-options '())) 

xdavidliu

Here's a solution that doesn't explicitly leave out solutions, instead having amb and require eliminate them naturally.

 (define (yacht) 
   (define gab 'gabrielle) 
   (define lor 'lorna) 
   (define ros 'rosalind) 
   (define mel 'melissa) 
   (define mar 'mary-ann) 
   (let ((barnacle (amb gab lor ros mel mar))) 
     (require (eq? barnacle mel)) 
     (let ((moore (amb gab lor ros mel mar))) 
       (require (eq? moore mar))     
       (let ((hall (amb gab lor ros mel mar))) 
         (require (not (memq hall (list barnacle moore ros))))  
         (let ((downing (amb gab lor ros mel mar))) 
           (require (not (memq downing (list barnacle moore hall mel)))) 
           (let ((parker (amb gab lor ros mel mar))) 
             (require (not (memq parker 
                                 (list barnacle moore hall downing mar)))) 
             (let ((yacht-names 
                    (list (list barnacle gab) 
                          (list moore lor) 
                          (list hall ros) 
                          (list downing mel) 
                          (list parker mar)))) 
               (require (eq? parker (cadr (assq gab yacht-names)))) 
               (list (list 'barnacle barnacle) 
                     (list 'moore moore) 
                     (list 'hall hall) 
                     (list 'downing downing) 
                     (list 'parker parker))))))))) 

meteorgan

  
  
  
 (define (father-daughter) 
   (let ((Moore 'Mary) 
         (Barnacle 'Melissa) 
         (Hall (amb 'Gabrielle 'Lorna)) 
         (Downing (amb 'Gabrielle 'Lorna 'Rosalind)) 
         (Parker (amb 'Lorna 'Rosalind))) 
     (require (cond ((eq? Hall 'Gabrielle) (eq? 'Rosalind Parker)) 
                    ((eq? Downing 'Gabrielle) (eq? 'Melissa Parker)) 
                    (else false))) 
     (require (distinct? (list Hall Downing Parker))) 
     (list (list 'Barnacle Barnacle) 
           (list 'Moore Moore) 
           (list 'Hall Hall) 
           (list 'Downing Downing) 
           (list 'Parker Parker)))) 
  
 run (father-daughter), get ((Barnacle Melissa) (Moore Mary) (Hall Gabrielle) (Downing Lorna) (Parker Rosalind)), so Lorna's father is Colonel Downing. 
 If we don't know Mary Ann's family name is Moore, we get: 
 ;;; Starting a new problem 
 ;;; Amb-Eval output: 
 ((Barnacle Melissa) (Moore Gabrielle) (Hall Mary) (Downing Rosalind) (Parker Lorna)) 
  
 ;;; Amb-Eval input: 
 try-again 
  
 ;;; Amb-Eval output: 
 ((Barnacle Melissa) (Moore Mary) (Hall Gabrielle) (Downing Lorna) (Parker Rosalind)) 
  

davl

To express `Gabrielle's father owns the yacht that is named after Dr. Parker's daughter', I introduce 2 procedures `name-of-his-yacht` and `her-father`

 (define (game-of-yacht) 
   (define (all-fathers) (amb 'mr-moore 'colonel-downing 'mr-hall 'sir-barnacle-hood 'dr-parker)) 
  
   (define (all-fathers-except except-father) 
     (let ((fathers (all-fathers))) 
       (require (not (eq? fathers except-father))) 
       fathers)) 
  
   (define (name-of-his-yacht father-name) 
     (cond ((eq? father-name 'mr-moore) 'lorna) 
           ((eq? father-name 'colonel-downing) 'melissa) 
           ((eq? father-name 'mr-hall) 'rosalind) 
           ((eq? father-name 'sir-barnacle-hood) 'gabrielle) 
           ((eq? father-name 'dr-parker) 'marry))) ;; a little jumpy here 
  
   (define lorna-father (all-fathers-except 'mr-moore)) 
   (define melissa-father 'sir-barnacle-hood) 
   (define rosalind-father (all-fathers-except 'mr-hall)) 
   (define gabrielle-father (all-fathers-except 'sir-barnacle-hood)) 
   (define marry-father 'mr-moore) 
  
   (define (her-father she) 
     (cond ((eq? she 'lorna) lorna-father) 
           ((eq? she 'melissa) melissa-father) 
           ((eq? she 'rosalind) rosalind-father) 
           ((eq? she 'gabrielle) gabrielle-father) 
           ((eq? she 'marry) marry-father))) 
  
   (require (distinct? (list lorna-father melissa-father rosalind-father gabrielle-father marry-father))) 
   (require (eq? (her-father (name-of-his-yacht gabrielle-father)) 'dr-parker)) 
   (list lorna-father melissa-father rosalind-father gabrielle-father marry-father)) 
  

Output:

 (game-of-yacht) 
 ;;; Starting a new problem 
 ;;; Amb-Eval value: 
 (colonel-downing sir-barnacle-hood dr-parker mr-hall mr-moore) 
  
 try-again 
 ;;; There are no more values of 
 (game-of-yacht) 

revc

self-documenting code.

 (define (list-ref lst n) 
   (if (= n 0) 
       (car lst) 
       (list-ref (cdr lst) (- n 1)))) 
  
 ;; single let but inefficient 
 (define (Yacht) 
   (define moore 1) 
   (define downing 2) 
   (define hall 3) 
   (define barnacle 4) 
   (define parker 5) 
  
   (define lorna 1) 
   (define mellissa 2) 
   (define rosalind 3) 
   (define gabrille 4) 
   (define mary 5) 
  
   (define (father-name father) 
     (define names (list 'moore 'downing 'hall 'barnacle 'parker)) 
     (list-ref names (- father 1))) 
    
   (define (owned-yacht father) 
     father) 
    
   (define (father-of daughter fathers) 
     (list-ref fathers (- daughter 1))) 
    
   (let ((F-lorna (amb moore downing hall barnacle parker)) 
         (F-mellissa (amb moore downing hall barnacle parker)) 
         (F-rosalind (amb moore downing hall barnacle parker)) 
         (F-gabrille (amb moore downing hall barnacle parker)) 
         (F-mary (amb moore downing hall barnacle parker))) 
     (let ((fathers (list F-lorna F-mellissa F-rosalind F-gabrille F-mary))) 
       (require (not (= F-lorna moore))) 
       (require (not (= F-rosalind hall))) 
       (require (not (= F-gabrille barnacle))) 
       (require (= F-mellissa barnacle)) 
       (require (= F-mary moore)) 
       (require (= (father-of (owned-yacht F-gabrille) fathers) parker)) 
       (require 
        (distinct? fathers)) 
       (list (list 'lorna (father-name F-lorna)) 
             (list 'mellissa (father-name F-mellissa)) 
             (list 'rosalind (father-name F-rosalind)) 
             (list 'gabrille (father-name F-gabrille)) 
             (list 'mary (father-name F-mary)))))) 
  
 ;; nested let but but efficient 
 (define (Yacht) 
   (define moore 1) 
   (define downing 2) 
   (define hall 3) 
   (define barnacle 4) 
   (define parker 5) 
  
   (define lorna 1) 
   (define mellissa 2) 
   (define rosalind 3) 
   (define gabrille 4) 
   (define mary 5) 
  
   (define (father-name father) 
     (define names (list 'moore 'downing 'hall 'barnacle 'parker)) 
     (list-ref names (- father 1))) 
    
   (define (owned-yacht father) 
     father) 
    
   (define (father-of daughter fathers) 
     (list-ref fathers (- daughter 1))) 
    
   (let ([F-mary (amb moore downing hall barnacle parker)]) 
     (require (= F-mary moore)) 
     (let ([F-mellissa (amb moore downing hall barnacle parker)]) 
       (require (= F-mellissa barnacle)) 
       (let ([F-lorna (amb moore downing hall barnacle parker)]) 
         (require (not (= F-lorna moore))) 
         (let ([F-rosalind (amb moore downing hall barnacle parker)]) 
           (require (not (= F-rosalind hall))) 
           (let ([F-gabrille (amb moore downing hall barnacle parker)]) 
             (require (not (= F-gabrille barnacle))) 
             (let ((fathers (list F-lorna F-mellissa F-rosalind F-gabrille F-mary))) 
               (require (= (father-of (owned-yacht F-gabrille) fathers) parker)) 
               (require (distinct? fathers)) 
               (list (list 'lorna (father-name F-lorna)) 
                     (list 'mellissa (father-name F-mellissa)) 
                     (list 'rosalind (father-name F-rosalind)) 
                     (list 'gabrille (father-name F-gabrille)) 
                     (list 'mary (father-name F-mary)))))))))) 

>>>Thomas (04-2020) Here's a solutions in normal scheme (had to change the structure to make it readable)

 (define (puzzle) 
   ;;internal helper definition 
   (define (filter predicate list) 
     (if (null? list) '() 
       (if (predicate (car list)) 
           (cons (car list) (filter predicate (cdr list))) 
           (filter predicate (cdr list))))) 
   (define (accumulate proc int list) 
     (if (null? list) int 
       (proc (car list) (accumulate proc int (cdr list))))) 
   (define (flatmap proc list) 
     (accumulate append '() (map proc list))) 
   (let ((all-tripples ;;form: dad yacht daugher - gives a list whos sublists are all tripples with one of the dads (5 sublist- in total 36 tripples) 
            (map (lambda (dad) 
                   (filter (lambda (x) (if (eq? x 'yacht=daughter) false ;;in order to get a shorter list, we filter whats possible directly 
                       (and (if (eq? dad 'B) (if (eq? (cadr x) 'G) true false) true) ;; Barnacles yacht is gabriele 
                              (if (eq? dad 'M) (if (eq? (cadr x) 'L) true false) true) ;;Moores is Lorna 
                               (if (eq? dad 'H) (if (eq? (cadr x) 'R) true false) true) ;;Halls is Rosalinda 
                               (if (eq? dad 'D) (if (eq? (cadr x) 'M) true false)) true))) ;; Downings is Melissa 
                    (flatmap (lambda (yacht) 
                                     (map (lambda (daughter) 
                                           (if (eq? yacht daughter) 'yacht=daughter 
                                               (list dad yacht daughter))) 
                                           (list 'G 'L 'R 'A 'M))) ;;daughter names are 
                                    (list 'G 'L 'R 'A 'M)))) ;;also yacht names 
                 (list 'B 'M 'H 'P 'D)))) ;abbrevations for dad names 
   (let ((all-combinations ;;gives a list with all combinations of tripples (with the incorperated restrictions 44 in total) 
     (let ((all all-tripples)) 
     (let ((tripples-1dad (car all)) 
           (tripples-2dad (cadr all)) 
           (tripples-3dad (caddr all)) 
           (tripples-4dad (cadddr all)) 
           (tripples-5dad (car (cddddr all)))) 
     (flatmap (lambda (1dad) 
           (flatmap (lambda (2dad) 
                   (flatmap (lambda (3dad) 
                          (flatmap (lambda (4dad) 
 ;; we want to filter out all combinations where the dady have same yachts or daughters 
       (filter (lambda (x) (let ((1dady (cadr (car x)))  
       (1dadd (caddr (car x))) ;;we therefor abbreviate (dadd dad-daughter) (dady dad-yacht) 
                            (2dady (cadr (cadr x))) 
                            (2dadd (caddr (cadr x))) 
                            (3dady (cadr (caddr x))) 
                            (3dadd (caddr (caddr x))) 
                            (4dady (cadr (cadddr x))) 
                            (4dadd (caddr (cadddr x))) 
                            (5dady (cadar (cddddr x))) 
                           (5dadd (caddar (cddddr x)))) 
                      (if (or (eq? 1dady 2dady) (eq? 1dady 3dady) (eq? 1dady 4dady) (eq? 1dady 5dady) 
                             (eq? 2dady 3dady) (eq? 2dady 4dady) (eq? 2dady 5dady) 
                              (eq? 3dady 4dady) (eq? 3dady 5dady) (eq? 4dady 5dady) 
                              (eq? 1dadd 2dadd) (eq? 1dadd 3dadd) (eq? 1dadd 4dadd) (eq? 1dadd 5dadd) 
                             (eq? 2dadd 3dadd) (eq? 2dadd 4dadd) (eq? 2dadd 5dadd) 
                            (eq? 3dadd 4dadd) (eq? 3dadd 5dadd) (eq? 4dadd 5dadd)) false true))) 
                    (map (lambda (5dad) (list 1dad 2dad 3dad 4dad 5dad)) tripples-5dad))) 
                               tripples-4dad)) 
                        tripples-3dad)) 
                 tripples-2dad)) 
          tripples-1dad))))) 
   (filter (lambda (combination)  
  ;; finally we filter for the remaining two (+1) restrictions 
      (let ((B-tripple (car combination)) 
                             (M-tripple (cadr combination)) 
                             (H-tripple (caddr combination)) 
                             (P-tripple (cadddr combination)) 
                             (D-tripple (car (cddddr combination)))) 
     (if (and (eq? (cadr D-tripple) (caddr B-tripple)) ;; yacht from Downing is Barnacles daughter 
   (eq? (caddr M-tripple) 'A);; Ann is Moores daughter 
  (cond ((eq? (caddr B-tripple) 'G) (eq? (cadr B-tripple) (caddr P-tripple)));;the one who's Gabrielle's father owns the yacht thats parkers daughter 
                   ((eq? (caddr M-tripple) 'G) (eq? (cadr M-tripple) (caddr P-tripple))) 
                   ((eq? (caddr H-tripple) 'G) (eq? (cadr H-tripple) (caddr P-tripple))) 
                    ((eq? (caddr P-tripple) 'G) (eq? (cadr P-tripple) (caddr P-tripple))) 
                   ((eq? (caddr D-tripple) 'G) (eq? (cadr D-tripple) (caddr P-tripple)) true false))) 
                           true false))) all-combinations)))) 
 ;;result: (((B G M) (M L A) (H R G) (P A R) (D M L))) 
 ;;if we erase the restriction that Ann is Moores daughter, we get two possibilities 
 ;; result: (((B G M) (M L G) (H R A) (P A L) (D M R)) ((B G M) (M L A) (H R G) (P A R) (D M L)))