SICP-Refresher-Chapter-4(3)

1
2
3

(define (an-integer-between low high)
  (require (<= low high))
  (amb low (an-integer-between (+ low 1) high)))

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21

;; only an-integer-starting-from is utilized

(define (a-pythagorean-triple-between low high)
  (let ((i (an-integer-starting-from low)))
    (let ((j (an-integer-starting-from i)))
      (let ((k (an-integer-starting-from j)))
	(require (= (+ (* i i) (* j j)) (* k k)))
	(list i j k)))))

;; initial status i = j = k
;; of course the initial i j k will fail
;; but will never stop
;; cause (let ((k (an-integer-starting-from i)))) would never stop
;; and no value of k could satisfy the equation

(define (a-pythagorean-triple-between low high)
  (let ((k (an-integer-starting-from low)))
    (let ((i (an-integer-between low k)))
      (let ((j (an-integer-between i k)))
	(require (= (+ (* i i) (* j j)) (* k k)))
	(list i j k)))))

1
2
3
4
5
6
7

;; I think it is as efficient as the one of exercise 4.35
;; cause the predication and computation of k
;; is theoretically a iteration of k
;; which makes no difference compared to the one in exercise 4.35

;; though (require (>= hsq ksq)) and (require (integer? k)) may filter some values of k
;; considered from bigger scale, the conputation work will not be significantly reduced

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21

(define (multiple-dwelling)
  (let ((baker (amb 1 2 3 4 5))
	(cooper (amb 1 2 3 4 5))
	(fletcher (amb 1 2 3 4 5))
	(miller (amb 1 2 3 4 5))
	(smith (amb 1 2 3 4 5)))
    (require
     (distinct? (list baker cooper fletcher miller smith)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (> miller cooper))
    (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (require (not (= (abs (- fletcher miller)) 1)))
    (list (list 'baker baker)
	  (list 'cooper cooper)
	  (list 'fletcher fletcher)
	  (list 'miller miller)
	  (list 'smith smith))))

1
2
3
4
5
6

;; just move the (require (distinct? (list baker cooper fletcher miller smith)))
;; to the end of the require statements

;; at the end of require statements, many combinations have been filtered
;; so times of calling distinct? are significantly reduced
;; thus the efficiency improved

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15

(define (multiple-dwelling)
  (let ((cooper (amb 2 3 4 5))
	(miller (amb 3 4 5)))
    (require (> miller cooper))
    (let ((fletcher (amb 2 3 4)))
      (require (not (= (abs (- fletcher cooper)) 1)))
      (let ((smith (amb (1 2 3 4 5)))
	    (require (not (= (abs (- smith fletcher)) 1))))
	(let ((baker (amb 1 2 3 4)))
	  (require (distinct? (list baker cooper fletcher miller smith)))
	  (list (list 'baker baker)
		(list 'cooper cooper)
		(list 'fletcher fletcher)
		(list 'miller miller)
		(list 'smith smith)))))))

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

(define (multiple-dwelling-traditional)
  (define (baker (list 1 2 3 4 5)))
  (define (cooper (list 1 2 3 4 5)))
  (define (fletcher (list 1 2 3 4 5)))
  (define (miller (list 1 2 3 4 5)))
  (define (smith (list 1 2 3 4 5)))

  (define (requirements temp)
    (apply
     (lambda (baker cooper fletcher miller smith)
       (and (> miller cooper)
	    (not (= (abs (- smith fletcher)) 1))
	    (not (= (abs (- fletcher cooper)) 1))
	    (distinct? (list baker cooper fletcher miller smith))))
     temp))

  (define (arrange lists)
    (if (null? lists)
	'(())
	(flatmap (lambda (x)
		   (map (lambda (y) (cons x y))
			(arrange (cdr lists))))
		 (car lists))))

  (filter requirements (arrange (list baker cooper fletcher miller smith))))

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17

(define (rank)
  (let ((betty (amb 1 2 3 4 5))
	(a (amb 1 2 3 4 5))
	(joan (amb 1 2 3 4 5))
	(katty (amb 1 2 3 4 5))
	(mary (amb 1 2 3 4 5)))
    (require (or (and (= katty 2) (not (= betty 3))) (and (not (= katty 2)) (= betty 3))))
    (require (or (and (= a 1) (not (= joan 2))) (and (not (= a 1)) (= joan 2))))
    (require (or (and (= joan 3) (not (= a 5))) (and (not (= joan 3)) (= a 5))))
    (require (or (and (= katty 2) (not (= mary 4))) (and (not (= katty 2)) (= mary 4))))
    (require (or (and (= mary 4) (not (= betty 1))) (and (not (= mary 4)) (= betty 1))))
    (require (distinct? (list betty a joan katty mary)))
    (list (list 'betty betty)
	  (list 'a a)
	  (list 'joan joan)
	  (list 'katty katty)
	  (list 'mary mary))))

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21

(define (daugther-father)
  (define (sailor exp)
    (car exp))
  (define (father exp)
    (cadr exp))
  (define (name exp)
    (caddr exp))
  (let ((mary (list 'parker (amb 'moore) 'mary)))
    (let ((melissa (list 'downing (amb 'barnacle) 'melissa)))
      (let ((garbrielle (list 'barnacle (amb 'downing 'hall 'parker) 'garbrielle))
	    (rosalind (list 'hall (amb 'downing 'hall 'parker) 'rosalind))
	    (lorna (list 'moore (amb 'downing 'hall 'parker) 'lorna)))
	(require (not (eq? (father garbrielle) 'parker)))
	(require (not (eq? (father rosalind) 'hall)))
	(require (distinct? (map (lambda (i) (father (i)))
				 (list mary melissa garbrielle rosalind lorna))))
	(require (eq? (father
		       (car (filter (lambda (i) (= (father garbrielle) (sailor i)))
				    (list mary melissa garbrielle rosalind lorna))))
		      'parker))
	(father lorna)))))

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17

(define (queen-8)
  (let ((first (amb 0 1 2 3 4 5 6 7)))
    (let ((second (amb 0 1 2 3 4 5 6 7)))
      (require (and (not (= first second)) (not (= (abs (- first second)) 1))))
      (let ((third (amb 0 1 2 3 4 5 6 7)))
	(require (and (not (= second third)) (not (= (abs (- second third)) 1))))
	(let ((fourth (amb 0 1 2 3 4 5 6 7)))
	  (require (and (not (= third fourth)) (not (= (abs (- third fourth)) 1))))
	  (let ((fifth (amb 0 1 2 3 4 5 6 7)))
	    (require (and (not (= fourth fifth)) (not (= (abs (- fourth fifth)) 1))))
	    (let ((sixth (amb 0 1 2 3 4 5 6 7)))
	      (require (and (not (= fifth sixth)) (not (= (abs (- fifth sixth)) 1))))
	      (let ((seventh (amb 0 1 2 3 4 5 6 7)))
		(require (and (not (= sixth seventh)) (not (= (abs (-sixth seventh)) 1))))
		(let ((eighth (amb 0 1 2 3 4 5 6 7)))
		  (require (and (not (= seventh eighth)) (not (= (abs (- seventh eighth)) 1))))
		  (list first second third fourth fifth sixth seventh eighth))))))))))