Added examples from 2.40 onwards

ex-2-40.rkt

@@ -0,0 +1,149 @@
+#lang racket
+;; 2.40
+(define (unique-pairs n)
+  (define (collect j)
+    (let loop [(j j) (i n) (acc '())]
+      (if (>= j i)
+          acc
+          (loop j (- i 1) (cons (list i j) acc)))))
+  (define (iter j acc)
+    (if (>= j n)
+        acc
+        (iter (+ j 1) (append (collect j) acc))))
+  (iter 1 '()))
+
+;; 2.41
+;; Note: this is kind of inefficient, as it generates a ton of
+;; lists, but I presume that's what the book is kind of suggesting
+;; in this chapter: i.e. the generate list, then filter approach.
+(define (flatmap f l)
+  (foldr (λ (x y) (append (f x) y))
+         '()
+         l))
+(define (triples n s)
+  (define (genlast l)
+    (map (λ (x) (cons x l))
+         (range 1 (if (null? l)
+                      n
+                      (first l)))))
+  (define (gentriples)
+    (flatmap genlast
+             (flatmap genlast
+                      (flatmap genlast
+                               '(())))))
+  (define (sum-s? l)
+    (= (foldl + 0 l) s))
+  (filter sum-s? (gentriples)))
+
+;; 2.42
+;; We represent a board as a linked-list of queen positions.
+;; nth element is the position of the queen on column n.
+;; each position is a list of (x y) coordinates (starting from 0).
+(define empty-board '())
+(define (adjoin-position r c board)
+  (append board (list (list c r))))
+(define (kth-queen k board)
+  (list-ref board (- k 1)))
+(define (threatens? p1 p2)
+    (let [(ydiff (abs (- (second p1) (second p2))))]
+      (cond
+        [(= (abs (- (first p1) (first p2))) ydiff) #t]
+        [(= ydiff 0) #t]
+        [else #f])))
+(define (safe? c board)
+  (define (iter i)
+    (cond
+      [(< i 1) #t]
+      [(threatens? (kth-queen i board) (kth-queen c board)) #f]
+      [else (iter (- i 1))]))
+  (iter (- c 1)))
+(define (enumerate-interval a b) (range a (+ b 1)))
+(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))
+
+;; 2.43
+;; The reason this causes the program to run slowly, is that
+;; now the recursive queen-cols call is inside another map
+;; call. This means that queen-cols will recursively call
+;; itself again and again with the same value - for instance,
+;; (queen-cols 8) will call (queen-cols 7) 8 times, (one for each
+;; item in the result of the enumerate-interval call).
+;; But (queen-cols 7) itself will call (queen-cols 6) 7 times,
+;; and so on and so forth.
+
+;; This makes the algorithm inefficient,
+;; as the same work is unnecessarily repeated.
+;; The runtime of this flawed algorithm should roughly
+;; be proportional to T^2.
+
+;; 2.44
+;; we don't have definitions for these yet, so I'm providing
+;; dummy procedures
+(define (beside x y) #f)
+(define (below x y) #f)
+(define (right-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (right-split painter (- n 1))))
+        (beside painter (below smaller smaller)))))
+
+(define (up-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (up-split painter (- n 1))))
+        (below painter (beside smaller smaller)))))
+;; 2.45
+(define (split f1 f2)
+  (define (inner painter n)
+    (if (= n 0)
+        painter
+        (let [(smaller (inner painter (- n 1)))]
+          (f1 painter (f2 smaller smaller)))))
+  inner)
+;(define right-split (split beside below))
+;(define up-split (split below beside))
+
+;; 2.46
+;; make-vect is defined by the define-struct form.
+;; we could also define using a cons. literally the same,
+;; performance-wise. But a little nicer I think.
+(define-struct vect (xcoor ycoor))
+(define xcoor-vect vect-xcoor)
+(define ycoor-vect vect-ycoor)
+
+(define (op-vect op)
+  (λ (v1 v2)
+    (make-vect (apply op (map vect-xcoor (list v1 v2)))
+               (apply op (map vect-ycoor (list v1 v2))))))
+(define add-vect (op-vect +))
+(define sub-vect (op-vect -))
+(define (scale-vect v n)
+  (make-vect (* (vect-xcoor v) n)
+             (* (vect-ycoor v) n)))
+;; 2.47
+(define (make-frame1 origin edge1 edge2)
+  (list origin edge1 edge2))
+(define (frame-origin1 f)
+  (list-ref f 0))
+(define (frame-edge1-1 f)
+  (list-ref f 1))
+(define (frame-edge2-1 f)
+  (list-ref f 2))
+
+(define (make-frame2 origin edge1 edge2)
+  (cons origin (cons edge1 edge2)))
+(define frame-origin2 car)
+(define frame-edge1-2 cadr)
+(define frame-edge2-2 cddr)