sicp-ex-4.42



<< Previous exercise (4.41) | Index | Next exercise (4.43) >>


meteorgan

  
  
 (define (lier) 
   (let ((a (amb 1 2 3 4 5)) 
         (b (amb 1 2 3 4 5)) 
         (c (amb 1 2 3 4 5)) 
         (d (amb 1 2 3 4 5)) 
         (e (amb 1 2 3 4 5))) 
     (require (or (and (= d 2) (not (= a 3))) (and (not (= d 2)) (= a 3)))) 
     (require (or (and (= b 1) (not (= c 2))) (and (not (= b 1)) (= c 2)))) 
     (require (or (and (= c 3) (not (= b 5))) (and (not (= c 3)) (= b 5)))) 
     (require (or (and (= d 2) (not (= e 4))) (and (not (= d 2)) (= e 4)))) 
     (require (or (and (= e 4) (not (= a 1))) (and (not (= e 4)) (= a 1)))) 
     (require (distinct? (list a b c d e))) 
     (list a b c d e))) 
 result is: (3 5 2 1 4) 

Shaw

  
  
 (define (flatmap f lst) 
   (if (null? lst) 
       null 
       (let ((result (f (car lst))) 
             (rest (flatmap f (cdr lst)))) 
         (if (or (pair? result) (null? result)) 
             (append result rest) 
             (cons result rest))))) 
  
 (define (permuta lst) 
   (if (null? lst) 
       '(()) 
       (flatmap 
        (lambda (x) 
          (map 
           (lambda (y) 
             (cons x y)) 
           (permuta (remove x lst)))) 
        lst))) 
  
 (define (remove a lst) 
   (cond 
    ((null? lst) null) 
    ((eq? a (car lst)) (cdr lst)) 
    (else (cons (car lst) 
                (remove a (cdr lst)))))) 
  
  
 (define first car) 
 (define second cadr) 
 (define third caddr) 
 (define fourth cadddr) 
 (define (fifth x) 
   (car (cddddr x))) 
  
  
 (define (xor a b) 
   (and (or a b) 
        (not (and a b)))) 
  
 (define betty-restrictions 
   (lambda (lst) 
     (xor (eq? (second lst) 'kitty) 
          (eq? (third lst) 'betty)))) 
  
 (define ethel-restrictions 
   (lambda (lst) 
     (xor (eq? (first lst) 'ethel) 
          (eq? (second lst) 'john)))) 
  
 (define john-restrictions 
   (lambda (lst) 
     (xor (eq? (third lst) 'john) 
          (eq? (fifth lst) 'ethel)))) 
  
  
 (define kitty-restrictions 
   (lambda (lst) 
     (xor (eq? (second lst) 'kitty) 
          (eq? (fourth lst) 'mary)))) 
  
 (define mary-restrictions 
   (lambda (lst) 
     (xor (eq? (fourth lst) 'mary) 
          (eq? (first lst) 'betty)))) 
  
 (define restrictions-lists 
    (list betty-restrictions 
          ethel-restrictions 
          john-restrictions 
          kitty-restrictions 
          mary-restrictions)) 
  
  
 (define name-lists 
   (permuta '(betty ethel john kitty mary))) 
  
 (define (pass-all? tests ele) 
   (if (null? tests) 
       #t 
       (and ((car tests) ele) 
            (pass-all? (cdr tests) ele)))) 
  
 (define (filter f lst) 
   (cond 
    ((null? lst) null) 
    ((f (car lst)) (cons (car lst) (filter f (cdr lst)))) 
    (else  
     (filter f (cdr lst))))) 
  
 (filter (lambda (x) (pass-all? restrictions-lists x)) 
           name-lists) 
  
 ;;((kitty john betty mary ethel))