SICP/ex-4_35-xx.scm

(load "util.scm")
(load "misc/amb.scm")

(define (require p)
  (if (not p) (amb)))

(define (an-element-of items)
  (require (not (null? items)))
  (amb (car items) (an-element-of (cdr items))))

(define (an-integer-starting-from n)
  (amb n (an-integer-starting-from (+ n 1))))

(display "\nex-4.35 - an-integer-between\n")

(define (an-integer-between a b)
  (require (<= a b))
  (amb a (an-integer-between (+ a 1) b)))

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

(display "[done]\n")

(display "\nex-4.36 - all-pythagorean-triples\n")

; If we replace an-integer-between with an-integer-starting-from the variables
; i and j will stay at their initial value 1 while k will increment endlessly.
; Hence, only triplets of the form (1 1 n) will be generated.

(define (all-pythagorean-triples)
  (let ((i (an-integer-starting-from 1)))
    (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)))))

(define (all-pythagorean-triples)
  (let ((k (an-integer-starting-from 1)))
    (let ((i (an-integer-between 1 k)))
      (let ((j (an-integer-between i k)))
        (require (= (+ (* i i) (* j j)) (* k k)))
        (list i j k)))))

; Note: It would be more efficient to choose to integers and then calculate if
; (+ (* i i) (* j j)) is a perfect square.

(display "[done]\n")

(display "\nex-4.37 - more-efficient-pythagorean-triples\n")

(define (a-pythagorean-triple-between low high)
  (let ((i (an-integer-between low high))
        (hsq (* high high)))
    (let ((j (an-integer-between i high)))
      (let ((ksq (+ (* i i) (* j j))))
        (require (>= hsq ksq))
        (let ((k (sqrt ksq)))
          (require (integer? k))
          (list i j k))))))

; This implementation uses my note from the previous exercises. Computing sqrt
; and checking for integer is faster ultimately, because the majority of
; combinations are not solutions.

(display "[answered]\n")

(display "\nex-4.38 - multiple-dwelling\n")

(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))

(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))) ; adjacent floors constraint
    (require (not (= (abs (- fletcher cooper)) 1)))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

(my-assert (multiple-dwelling)
           '((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)))


(display "\nex-4.39 - multiple-dwelling-ordering\n")

; The ordering does not matter because the interpreter first evaluates all ambs
; and then runs the checks. The interpreter will check all combinations even if
; they cannot yield a possible solution, such as (fletcher 1). To avoid this one
; would have to interleave the am expression and the checks.

(display "[answered]\n")

(define (repeat proc n)
  (if (= n 0)
    't
    (begin
      (proc)
      (repeat proc (- n 1)))))

(let ((start-time (runtime)))
  (repeat multiple-dwelling 10)
  (display "[default = ")
  (display (- (runtime) start-time))
  (display "]\n"))

(display "\nex-4.40 - multiple-dwelling-improved\n")

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

(my-assert (multiple-dwelling)
           '((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)))

(let ((start-time (runtime)))
  (repeat multiple-dwelling 10)
  (display "[improved = ")
  (display (- (runtime) start-time))
  (display "]\n"))

(display "\nex-4.41 - multiple-dwelling-ordinary\n")


(display "\nex-4.42\n")

; (display "\nex-4.43\n")
; (display "\nex-4.44 - eight-queens\n")