Code of my sicp lecture chapter 2

sicp2.rkt

;; 2.1  Introduction to Data Abstraction
;; 2.1.1  Example: Arithmetic Operations for Rational Numbers

(define (add-rat x y)
  (make-rat (+ (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))
(define (sub-rat x y)
  (make-rat (- (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))
(define (mul-rat x y)
  (make-rat (* (numer x) (numer y))
            (* (denom x) (denom y))))
(define (div-rat x y)
  (make-rat (* (numer x) (denom y))
            (* (denom x) (numer y))))
(define (equal-rat? x y)
  (= (* (numer x) (denom y))
     (* (numer y) (denom x))))

;; Representing rational numbers

(define (make-rat n d) (cons n d))
(define (numer x) (car x))
(define (denom x) (cdr x))

(define (print-rat x)
  (newline)
  (display (numer x))
  (display "/")
  (display (denom x))
  (newline))

(define one-half (make-rat 1 2))
(print-rat one-half)
;; 1/2
(define one-third (make-rat 1 3))
(print-rat (add-rat one-half one-third))
;; 5/6
(print-rat (mul-rat one-half one-third))
;; 1/6
(print-rat (add-rat one-third one-third))
;; 6/9

(define (make-rat n d)
  (let ((g (gcd n d)))
    (cons (/ n g) (/ d g))))

(print-rat (add-rat one-third one-third))
;; 2/3

;; Exercise 2.1

(define (make-rat n d)
  (let         (m (sgn (* n d)))
    (cons (* m (/ (abs n) g))
          (/ (abs d) g))))

;; Exercise 2.2.

(define (point/make x y) (cons x y))
(define (point/x p) (car p))
(define (point/y p) (cdr p))

(define (point/sum p1 p2)
  (make-point (+ (x-point p1) (x-point p2))
              (+ (y-point p1) (y-point p2))))

(define (point/product p k)
  (make-point (* (x-point p) k)
              (* (y-point p) k)))

(define (segment/make start end) (list start end))
(define (segment/start segment) (car segment))
(define (segment/end segment) (last segment))

(define (segment/midpoint segment)
  (point/product
   (point/sum (segment/start segment)
              (segment/end segment))
   (/ 1 2)))

(define (point/print p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))

(define (segment/print s)
  (point/print (segment/start s))
  (point/print (segment/end s))
  (newline))

(define my-segment
  (segment/make
   (point/make 1 2)
   (point/make 3 4)))

(segment/print my-segment)
(segment/midpoint my-segment)

;; Exercise 2.3

;; first representation diagonal extreme points (it could be a segment)

(define (rectangle/diagonal d1 d2)
  (list d1 d2))

(define (rectangle/perimeter r)
  (* 2 (+ (rectangle/height r)
          (rectangle/width r))))

(define (rectangle/area r)
  (* (rectangle/height r)
     (rectangle/width r)))

(define (point/dx p1 p2)
    (abs (- (point/x p1)
            (point/x p2))))

(define (point/dy p1 p2)
    (abs (- (point/y p1)
            (point/y p2))))

(define (rectangle/height r)
  (apply point/dy r))

(define (rectangle/width r)
  (apply point/dx r))

(define my-rectangle
  (rectangle/make (point/make 0 0)
                  (point/make 5 -2)))

(rectangle/height my-rectangle)
(rectangle/width my-rectangle)
(rectangle/perimeter my-rectangle)
(rectangle/area my-rectangle)

;; second representaion: map with base segment and height

(define (rectangle/segment+height s h)
  (list (cons 'segment s) (cons 'height h)))

(define (rectangle/height r)
  (abs (dict-ref r 'height)))

(define (pythagorean-theorem a b)
  (sqrt (+ (* a a) (* b b))))

(define (point/distance p1 p2)
  (pythagorean-theorem (point/dx p1 p2)
                       (point/dy p1 p2)))

(define (segment/length s)
  (point/distance
   (segment/start s) (segment/end s)))

(define (rectangle/width r)
  (segment/length (dict-ref r 'segment)))

(define my-2-rectangle
  (rectangle/segment+height
   (segment/make (point/make 0 0)
                 (point/make 5 0))
   -2))

(rectangle/height my-2-rectangle)
(rectangle/width my-2-rectangle)
(rectangle/perimeter my-2-rectangle)
(rectangle/area my-2-rectangle)

;; 2.1.3  What Is Meant by Data?

(define (cons x y)
  (define (dispatch m)
    (cond ((= m 0) x)
          ((= m 1) y)
          (else (error "Argument not 0 or 1 -- CONS" m))))
  dispatch)

(define (car z) (z 0))

(define (cdr z) (z 1))

;; A closure (dispatch closes over x y) used as data representation
;; simulating object behaviour. Messsage passing (object methods)
;; though partial application

;; Exercise 2.4

(define (cons x y)
  (lambda (m) (m x y)))

(define (car z)
  (z (lambda (p q) p)))

;; (cons 1 2) >> (lambda (m) (m 1 2))
;; (car (cons 1 2)) >> ((lambda (m) (m 1 2)) (lambda (p q) p)) >>
;;   ((lambda (p q) p) 1 2) >> 1

(define (cdr z)
  (z (lambda (p q) q)))

;; Exercise 2.5

(define (cons a b) (* (expt 2 a) (expt 3 b)))

(define (integer-logn x n)
  (let  ((q (quotient x n))
         (m (remainder x n)))
    (if (= m 0) (+ 1 (integer-logn q)) 0)))

(define (car p)
  (integer-logn p 2))

(define (cdr p)
  (integer-logn p 3))

;; Exercise 2.6

(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))

(lambda (n) (lambda (f) (lambda (x) (f ((n f) x)))))

;; (add-1 zero) -> (add-1 (lambda (g) (lambda (y) y))) ->
;; (lambda (f) (lambda (x) (f (((lambda (g) (lambda (y) y)) f) x)))) ->
;; (lambda (f) (lambda (x) (f ((lambda (y) y) x)))) ->
;; (lambda (f) (lambda (x) (f x)))

(define one (lambda (f) (lambda (x) (f x))))

;; (add-1 one) -> (add-1 (lambda (g) (lambda (y) (g y)))) ->
;; (lambda (f) (lambda (x) (f (   ((lambda (g) (lambda (y) (g y))) f)   x)))) ->
;; (lambda (f) (lambda (x) (f   ((lambda (y) (f y)) x)   ))) ->
;; (lambda (f) (lambda (x) (f (f x))))

(define two (lambda (f) (lambda (x) (f (f x)))))

;; add1
(lambda (n) (lambda (f) (lambda (x) (f ((n f) x)))))
;; one
(lambda (f) (lambda (x) (f x)))
;;two
(lambda (f) (lambda (x) (f (f x))))
;; three
(lambda (f) (lambda (x) (f (f (f x)))))

;; Deduction from add1
;; add1 (lambda (n) (lambda (f) (lambda (x) (f ((n f) x)))))
;; (lambda (n) (lambda (f) ((lambda (f) (lambda (x) (f x))) (lambda (x) ((n f) x)) )))
;; (lambda (n) (lambda (f) (lambda (x) ((n f) x))))

(define (lc/+ m n)
  (lambda (f) (m (lambda (x) ((n f) x)))))

;; 2 + 2
(lc/+ (lambda (f) (lambda (x) (f (f x))))
      (lambda (f) (lambda (x) (f (f x)))))

(lambda (f) ((lambda (f) (lambda (x) (f (f x))))
        (lambda (x) ((n f) x))))

(lambda (f) ((lambda (x) ((lambda (x) ((n f) x))
                ((lambda (x) ((n f) x)) x)))))

(lambda (f) ((lambda (x) ((lambda (x) (f (f x)))
                (f (f x))))))

(define four (lc/+ two two))
((four inc) 0)
;; 4

;; 2.1.4  Extended Exercise: Interval Arithmetic

(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))

(define (mul-interval x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (make-interval (min p1 p2 p3 p4)
                   (max p1 p2 p3 p4))))

(define (div-interval x y)
  (mul-interval x 
                (make-interval (/ 1.0 (upper-bound y))
                               (/ 1.0 (lower-bound y)))))

;; Exercise 2.7.

(define (make-interval a b) (cons a b))

(define upper-bound cdr)
(define lower-bound car)

;; Exercise 2.8.

(define (sub-interval x y)
  (make-interval (- (lower-bound x) (lower-bound y))
                 (- (upper-bound x) (upper-bound y))))

;; Exercise 2.9

(define (width interval)
  (/ (- (upper-bound interval)
        (lower-bound interval))
     2))

;; Obviously + and - maintains the difference between bounds
;; and * / not

(define i1 (make-interval 10 20))
(define i2 (make-interval 5 15))

(= (width (mul-interval i1 i2))
   (* (width i1) (width i2)))
;; #f

(= (width (add-interval i1 i2))
   (+ (width i1) (width i2)))
;; #t

;; Exercise 2.10

(define i0 (make-interval 3 3))

(div-interval i1 i0)

(define (span-interval x)
   (- (upper-bound x) (lower-bound x)))

(define (div-interval x y)
  (when (= 0 (span-interval y))
    (error "Divide by an interval of zero"))
  (mul-interval x 
                (make-interval (/ 1.0 (upper-bound y))
                               (/ 1.0 (lower-bound y)))))

;; Exercise 2.11

(define (test-mult x1 x2 y1 y2)
  (mul-interval (make-interval x1 x2)
                (make-interval y1 y2)))

(define (test-mult-2 x1 x2 y1 y2)
  (mul-interval-2 (make-interval x1 x2)
                  (make-interval y1 y2)))

(define (mul-interval-2 x y)
  (let* ((low-x (lower-bound x)) (up-x (upper-bound x))
         (low-y (lower-bound y)) (up-y (upper-bound y))
         (signs (map (lambda (x) (if (negative? x) -1 1))
                     (list low-x up-x low-y up-y)))
         (is (curry equal? signs))
         (mk (lambda (w x y z) (make-interval (* w x) (* y z))))) 
    (cond
     ((is '(1 1 1 1)) 
      (mk low-x low-y up-x up-y))
     ((is '(-1 -1 -1 -1))
      (mk up-x up-y low-x low-y))
     ((is '(-1 -1 1 1))
      (mk low-x up-y up-x low-y))
     ((is '(1 1 -1 -1))
      (mk up-x low-y low-x up-y))
     ((is '(-1 1 1 1))
      (mk low-x up-y up-x up-y))
     ((is '(1 1 -1 1))
      (mk up-x low-y up-x up-y))
     ((is '(-1 -1 -1 1))
      (mk low-x up-y low-x low-y))
     ((is '(-1 1 -1 -1))
      (mk up-x low-y low-x low-y))
     (make-interval (min (* low-x up-y) (* up-x low-y))
                    (max (* up-x up-y) (* low-x low-y)))))))

(define (test-mults x1 x2 y1 y2)
  (let ((t1 (test-mult x1 x2 y1 y2))
        (t2 (test-mult-2 x1 x2 y1 y2)))
    (equal? t1 t2)))

(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))
(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))

;; Exercise 2.12

(define (make-center-percent center tolerance)
  (make-center-width center (/ (* center tolerance) 100)))

(define (percent interval)
  (/ (* (width interval) 100) (center interval)))

;; Exercise 2.13

(define ip1 (make-center-percent 10 2))
(define ip2 (make-center-percent 20 3))
(define ip3 (make-center-percent 30 5))

(define (appox-mul-percent i1 i1)
  (+ (percent i1 i2)))


;; Exercise 2.14

(define (par1 r1 r2)
  (div-interval (mul-interval r1 r2)
                (add-interval r1 r2)))
(define (par2 r1 r2)
  (let ((one (make-interval 1 1))) 
    (div-interval one
                  (add-interval (div-interval one r1)
                                (div-interval one r2)))))

;; Exercise 2.15
(define one (make-interval 1 1))

(equal? ip1 '(49/5 . 51/5))
(div-interval ip1 ip1)
;; (49/51 . 51/49)
(div-interval one ip1)
;; (5/51 . 5/49)
(div-interval one (div-interval one ip1))
;; (49/5 . 51/5)
(equal? ip2 (97/5 . 103/5))
(div-interval ip1 ip2)
;; (49/103 . 51/97)
(mul-interval ip2 (div-interval ip1 ip2))
;;  (4753/515 . 5253/485)
(div-interval one ip2)
;; (5/103 . 5/97)


(percent ip1)
(center ip1)
(percent (div-interval ip1 ip1))
(center (div-interval ip1 ip1))
(width ip1)
(width (div-interval ip1 ip1))

;; i'm no specially interested in the problematic of
;; interval arithmetic
;; see http://www.billthelizard.com/2010/12/sicp-212-216-extended-exercise-interval.html

;;2.2  Hierarchical Data and the Closure Property

(define (list-ref items n)
  (if (= n 0)
      (car items)
      (list-ref (cdr items) (- n 1))))
(define squares (list 1 4 9 16 25))

define (length items)
  (if (null? items)
      0
      (+ 1 (length (cdr items)))))
(define odds (list 1 3 5 7))

(length odds)

(define (length items)
  (define (length-iter a count)
    (if (null? a)
        count
        (length-iter (cdr a) (+ 1 count))))
  (length-iter items 0))

(define (append list1 list2)
  (if (null? list1)
      list2
      (cons (car list1) (append (cdr list1) list2))))

;; Exercise 2.17.

(define (last-pair xs)
  (if (or (null? xs)
          (null? (cdr xs)))
      xs (last-pair (cdr xs))))

;; Exercise 2.18.

(define (reverse xs)
  (if (null? xs) null
      (append (reverse (cdr xs))
              (list (car xs)))))

;; Exercise 2.19

(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else
         (+ (cc amount
                (except-first-denomination coin-values))
            (cc (- amount
                   (first-denomination coin-values))
                coin-values)))))

(define first-denomination car)
(define except-first-denomination cdr)
(define no-more? null?)

(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))

(cc 100 us-coins)
(cc 100 uk-coins)

;; the order doesn't affect the result cause all coins are
;; calculated with the same amount

(cc 100 (list 1 5 10 25 50))

;; Exercise 2.20.

(define (filter pred xs)
  (if (null? xs) null
      (let ((next (filter pred (cdr xs))))
        (if (pred (car xs))
            (cons (car xs) next)
            next))))

(define (same-parity x . xs)
  (cons x (filter (if (even? x) even? odd?) xs)))
            
;; Mapping over lists

(define (map proc items)
  (if (null? items)
      nil
      (cons (proc (car items))
            (map proc (cdr items)))))

;; Exercise 2.21.

(define (square-list xs)
  (if (null? xs) null
      (cons (expt (car xs)) (cdr sx))))

(define (square-list xs)
  (map (lambda (x) (expt x 2)) xs))

;; Exercise 2.22.

(define (square-list items)
  (define (iter things answer)
    (if (null? things)
        answer
        (iter (cdr things) 
              (cons (expt (car things) 2)
                    answer))))
  (iter items null))

;; Cause is consing each step result  in the head of the list before
;; the call to next step

;; The second one constructs pairs with a list in car and a number in cdr

(cons (cons (cons null 1) 4) 9)
;;(((() . 1) . 4) . 9)

;; Exercise 2.23.

(define (for-each proc xs)
  (if (null? xs) null
      (let ((_ (proc (car xs))))
          (for-each proc (cdr xs)))))
;; equivalent with lambda
(define (for-each proc xs)
  (if (null? xs) null
      ((lambda (_)
         (for-each proc (cdr xs)))
       (proc (car xs)))))

(for-each (lambda (x) (newline) (display x))
          (list 57 321 88))

;; 2.2.2  Hierarchical Structures

(define (count-leaves x)
  (cond ((null? x) 0)  
        ((not (pair? x)) 1)
        (else (+ (count-leaves (car x))
                 (count-leaves (cdr x))))))

;; Exercise 2.24. 

(list 1 (list 2 (list 3 4)))

;;                           (2 (3 4))    (3 4)     
;;                           |            |
;; (1 (2 (3 4))) -> | | |-> | | | -----> | | | --> | |X| 
;;                   |       |            |         |
;;                   1       2            3         4

;; (1 (2 (3 4)))
;;      |
;;  1 ----- (2 (3 4))
;;              |
;;          2 ----- (3 4)
;;                    |
;;                3 ----- 4

;; Exercise 2.25.

(car (cdaddr '(1 3 (5 7) 9)))
(caar '((7)))
(cadadr (cadadr (cadadr '(1 (2 (3 (4 (5 (6 7)))))))))

;; Exercise 2.26.

;; (1 2 3 4 5 6)
;; ((1 2 3) 4 5 6)
;; ((1 2 3) (4 5 6))

;; Exercise 2.27.

(define (deep-reverse xs)
  (map (lambda (x)
         (if (list? x)
             (deep-reverse x) x))
       (reverse xs)))

(define xs (list (list 1 2) (list 3 4)))

(deep-reverse xs)
;; ((4 3) (2 1))

;; Exercise 2.28.

(define (fringe xs)
  (apply append
         (map (lambda (x)
                (if (list? x)
                    (fringe x) (list x)))
              xs)))

;; Exercise 2.29.

(define (make-mobile left right)
  (list left right))

(define (make-branch length structure)
  (list length structure))

;; a.-

(define left-branch car)
(define right-branch cadr)
(define branch-length car)
(define branch-structure cadr)

(define (branch? x)
  (and
   (pair? x) 
   (number? (branch-length x))))

(define (mobile? x)
  (and
   (pair? x)
   (branch? (left-branch x))
   (branch? (right-branch x))))

(define (total-weight x)
  (cond
   ((mobile? x) (+ (total-weight (left-branch x))
                  (total-weight (right-branch x))))
   ((branch? x) (* (branch-length x)
                  (total-weight (branch-structure x))))
   (else x)))

(define mob
     (make-mobile
      (make-branch 2 (make-mobile
                      (make-branch 3 4)
                      (make-branch 5 6)))
      (make-branch 7 8)))

(total-weight mob)
;; 140

;; c

(define (balanced? node)
  (cond
   ((mobile? node)
    (let ((lb (left-branch node))
          (rb (right-branch node)))
      (and (= (total-weight lb)
              (total-weight rb))
      (balanced? lb)
      (balanced? rb))))
   ((branch? node)
    (balanced? (branch-structure node)))
   (else true)))
                 
;; d

(define (make-mobile left right)
  (cons left right))
(define (make-branch length structure)
  (cons length structure))
;; only 2 methods
(define right-branch cdr)
(define branch-structure cdr)

;; Exercise 2.30.

(define (square-tree x)
  (cond
   ((null? x) x)
   ((pair? x)
      (cons (square-tree (car x))
       (square-tree (cdr x))))
   (else (expt x 2))))


(define (square-tree x)
  (if (pair? x) (map square-tree x)
      (expt x 2)))

(define (square-tree x)
  (map (lambda (x)
         (if (pair? x) 
             (expt x 2))) xs))

(square-tree
 (list 1
       (list 2 (list 3 4) 5)
       (list 6 7)))

;; Exercise 2.31.

(define (tree-map proc tree)
  (map (lambda (x)
         (if (list? x)
             (tree-map proc x)
             (proc x))) tree))

(define (square-tree tree)
  (tree-map (lambda (x) (expt x 2)) tree))


;; Exercise 2.32.

(define (subsets s) 
  (if (null? s)
      (list null)
      (let ((rest (subsets (cdr s))))
        (append rest
                (map (lambda (x) (cons (car s) x))
                     rest)))))

;; 2.2.3  Sequences as Conventional Interfaces

(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (enumerate-interval low high)
  (if (> low high)
      null
      (cons low (enumerate-interval (+ low 1) high))))

;; this is the fringe (or flatten) proc
(define (enumerate-tree tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (list tree))
        (else (append (enumerate-tree (car tree))
                      (enumerate-tree (cdr tree))))))

;; Exercise 2.33.

(define (map p sequence)
  (accumulate (lambda (x y)
                (cons (p x) y)) null sequence))
(define (append seq1 seq2)
  (accumulate cons seq2 seq1))
(define (length sequence)
  (accumulate (lambda (x y) (+ y 1) ) 0 sequence))

;; Exercise 2.34.

(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms)
               (+ this-coeff (* x higher-terms)) )
              0
              coefficient-sequence))

(horner-eval 2 (list 1 3 0 5 0 1))

;; Exercise 2.35.

(define (count-leaves t)
  (accumulate
   (lambda (x y) (+ x y)) 0
   (map (lambda (x)
          (if (list? x)
              (count-leaves x) 1)) t)))

;; Exercise 2.36.

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      null
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

(define s '((1 2 3) (4 5 6) (7 8 9) (10 11 12)))
(accumulate-n + 0 s)

;; Exercise 2.37.

(define (dot-product v w) 
  (accumulate + 0 (map * v w)))
(define (matrix-*-vector m v)
  (map (lambda (x)
         (dot-product v x))  m))
(define (transpose mat)
  (accumulate-n
   (lambda (x y) (cons x y))
   null mat))
(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x)
           (matrix-*-vector cols x)) m)))

;; Exercise 2.38.

(define fold-right accumulate)

;; accumulate/fold-right (op x1 (op x2 .. (op xn initial) .. ))

(define (fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial sequence))

;; fold-left (op (op .. (op initial x1) ..  x2) xn )

(fold-right / 1 (list 1 2 3))
;; 3/2
(fold-left / 1 (list 1 2 3))
;; 1/6
(fold-right list null (list 1 2 3))
;;  (1 (2 (3 ())))
(fold-left list null (list 1 2 3))
;; (((() 1) 2) 3)

;; the commutative property

;; Exercise 2.39.

(define (reverse sequence)
  (fold-right (lambda (x y)(append y (list x))) null sequence))
(define (reverse sequence)
  (fold-left (lambda (x y) (cons y x)) null sequence))

;; Nested Mappings

(define (flatmap proc seq)
  (accumulate append null (map proc seq)))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (flatmap
                (lambda (i)
                  (map (lambda (j) (list i j))
                       (enumerate-interval 1 (- i 1))))
                (enumerate-interval 1 n)))))

(define (remove item sequence)
  (filter (lambda (x) (not (= x item)))
          sequence))

(define (permutations s)
  (if (null? s)                    ; empty set?
      (list nil)                   ; sequence containing empty set
      (flatmap (lambda (x)
                 (map (lambda (p) (cons x p))
                      (permutations (remove x s))))
               s)))

;; Exercise 2.40.

(define (unique-pairs from to )
  (flatmap
   (lambda (i)
     (map (lambda (j) (list i j))
          (enumerate-interval 1 (- i 1))))
   (enumerate-interval from to)))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (unique-pairs 1 n))))

;; Exercise 2.41.

(define (ordered-triples from to)
  (flatmap
   (lambda (i)
     (map (lambda (j) (cons i j))
          (unique-pairs from (- i 1))))
     (enumerate-interval from to)))
                  

(define (triples-up-to-n-equals-to-x n x)
  (filter (lambda (triple)
            (= x (apply + triple)))
          (ordered-triples 1 n)))

;; Exercise 2.42.

(define (queens board-size)
  (define (queen-cols k)  
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

(define (adjoin-position row col queens)
  (cons (list row col) queens))
(define empty-board null)

(define row car)
(define col cadr)

(define (some-in-same-row cell cells-with-queens) 
  (let ((rows (map row cells-with-queens)))
    (member (row cell) rows)))

(define (some-in-same-col cell cells-with-queens) 
  (let ((cols (map col cells-with-queens)))
    (member (col cell) cols)))

(define (writenl x) (write x) (newline))

(define (in-same-diagonal cell1 cell2)
  (and (= (abs (- (first cell1) (first cell2)))
          (abs (- (second cell1) (second cell2))))
       (not (= (first cell1) (first cell2)))))

(in-same-diagonal '(1 1) '(2 2))

(define (some-in-same-diagonal cell queens)
  (ormap (lambda (queen) (in-same-diagonal cell queen)) queens))

(define (safe? k queens) 
  (andmap (lambda (f) (not (f (car queens) (cdr queens))))
          (list some-in-same-row
                some-in-same-col
                some-in-same-diagonal)))