sicp-ex-4.43



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


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))))))))))