Add solutions to exercises from subsection 2.2.3

Notes:
The exercise 2.37 on Hexlet's site has an error, noted in the comments.
Also, their page for exercise 2.38 should probably have 0 tests.

And finally, I did not calculate the exact number in the final exercise
2.43, but I included a relevant discussion.

ex-2.33.scm

@@ -0,0 +1,21 @@
+#lang sicp
+
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+	(accumulate op initial (cdr sequence)))))
+
+(define (map p sequence)
+  (accumulate (lambda (x y) (cons (p x)
+                                  y))
+              nil
+              sequence))
+
+(define (append seq1 seq2)
+  (accumulate cons seq2 seq1))
+
+(define (inc x y) (+ y 1))
+
+(define (length sequence)
+  (accumulate inc 0 sequence))

ex-2.34.scm

@@ -0,0 +1,13 @@
+#lang sicp
+
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (accumulate op initial (cdr sequence)))))
+
+(define (horner-eval x coefficient-sequence)
+  (accumulate (lambda (this-coeff higher-terms)
+                (+ (* higher-terms x) this-coeff))
+              0
+              coefficient-sequence))

ex-2.35.scm

@@ -0,0 +1,14 @@
+#lang sicp
+
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (accumulate op initial (cdr sequence)))))
+
+(define (count-leaves t)
+  (accumulate + 0 (map (lambda (sub-t)
+                         (cond ((pair? sub-t) (count-leaves sub-t))
+                               ((null? sub-t) 0)
+                               (else 1)))
+                       t)))

ex-2.36.scm

@@ -0,0 +1,13 @@
+#lang sicp
+
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (accumulate op initial (cdr sequence)))))
+
+(define (accumulate-n op init seqs)
+  (if (null? (car seqs))
+      nil
+      (cons (accumulate op init (map car seqs))
+            (accumulate-n op init (map cdr seqs)))))

ex-2.37.scm

@@ -0,0 +1,36 @@
+#lang sicp
+
+;;;;
+;; Error in the hexlet exercise: the matrix-*-vector line should say
+;; m_ij*v_j not m_ij*v_i
+;;;;
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (accumulate op initial (cdr sequence)))))
+
+(define (accumulate-n op init seqs)
+  (if (null? (car seqs))
+      '()
+      (cons (accumulate op init (map car seqs))
+            (accumulate-n op init (map cdr seqs)))))
+
+(define (dot-product v w)
+  (accumulate + 0 (map * v w)))
+
+(define (matrix-*-vector m v)
+  (map (lambda (row)
+         (dot-product row v))
+       m))
+
+(define (matrix-*-matrix m n)
+  (let ((cols (transpose n)))
+    (map (lambda (row-m)
+           (map (lambda (col)
+                  (dot-product row-m col))
+                cols))
+         m)))
+
+(define (transpose m)
+  (accumulate-n cons '() m))

ex-2.38.scm

@@ -0,0 +1,22 @@
+#lang sicp
+
+(define (fold-right op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (fold-right op initial (cdr sequence)))))
+
+(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-right / 1 (list 1 2 3)) -> (1/(2/(3/1))) = 3/2
+; (fold-left / 1 (list 1 2 3)) -> (((1/1)/2)/3) = 1/6
+; (fold-right list nil (list 1 2 3)) -> (1 (2 (3 ())))
+; (fold-left list nil (list 1 2 3)) -> (((() 1) 2) 3)
+; in order to produce the same results, the operation
+; must be associative.

ex-2.39.scm

@@ -0,0 +1,21 @@
+#lang sicp
+
+(define (fold-right op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (fold-right op initial (cdr sequence)))))
+
+(define (fold-left op initial sequence)
+  (define (iter result rest)
+    (if (null? rest)
+        result
+        (iter (op result (car rest))
+              (cdr rest))))
+  (iter initial sequence))
+
+(define (reverse-right sequence)
+  (fold-right (lambda (x y) (append y (list x))) nil sequence))
+
+(define (reverse-left sequence)
+  (fold-left (lambda (x y) (cons y x)) nil sequence))

ex-2.40.scm

@@ -0,0 +1,55 @@
+#lang sicp
+
+; a) Define unique-pairs
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (accumulate op initial (cdr sequence)))))
+
+(define (flatmap proc seq)
+  (accumulate append nil (map proc seq)))
+
+(define (enumerate-interval a b)
+  (if (> a b)
+      '()
+      (cons a (enumerate-interval (+ a 1) b))))
+
+(define (unique-pairs n)
+  (flatmap (lambda (i)
+             (map (lambda (j) (list i j))
+                  (enumerate-interval 1 (- i 1))))
+           (enumerate-interval 1 n)))
+
+; b) use it to define prime-sum-pairs
+
+(define (filter predicate sequence)
+  (cond ((null? sequence) nil)
+        ((predicate (car sequence))
+         (cons (car sequence)
+               (filter predicate (cdr sequence))))
+        (else (filter predicate (cdr sequence)))))
+
+(define (square x) (* x x))
+
+(define (smallest-divisor n)
+  (find-divisor n 2))
+(define (find-divisor n test-divisor)
+  (cond ((> (square test-divisor) n) n)
+        ((divides? test-divisor n) test-divisor)
+        (else (find-divisor n (+ test-divisor 1)))))
+(define (divides? a b)
+  (= (remainder b a) 0))
+
+(define (prime? n)
+  (= n (smallest-divisor n)))
+
+(define (prime-sum? pair)
+  (prime? (+ (car pair) (cadr pair))))
+
+(define (prime-sum-pairs n)
+  (map (lambda (pair)
+         (list (car pair) (cadr pair) (+ (car pair)
+                                         (cadr pair))))
+       (filter prime-sum?
+               (unique-pairs n))))

ex-2.41.scm

@@ -0,0 +1,40 @@
+#lang sicp
+
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (accumulate op initial (cdr sequence)))))
+
+(define (flatmap proc seq)
+  (accumulate append nil (map proc seq)))
+
+(define (filter predicate sequence)
+  (cond ((null? sequence) nil)
+        ((predicate (car sequence))
+         (cons (car sequence)
+               (filter predicate (cdr sequence))))
+        (else (filter predicate (cdr sequence)))))
+
+(define (enumerate-interval a b)
+  (if (> a b)
+      '()
+      (cons a (enumerate-interval (+ a 1) b))))
+
+(define (sum l) (accumulate + 0 l))
+
+; returns a function which checks given list for
+; specific sum
+(define (sum-is-num s)
+  (lambda (list)
+    (= (sum list) s)))
+
+(define (ordered-triples-with-sum n s)
+  (filter (sum-is-num s)
+          (flatmap (lambda (i)
+                     (flatmap (lambda (j)
+                                (map (lambda (k)
+                                       (list i j k))
+                                     (enumerate-interval 1 (- j 1))))
+                              (enumerate-interval 1 (- i 1))))
+                   (enumerate-interval 1 n))))

ex-2.42.scm

@@ -0,0 +1,71 @@
+#lang sicp
+
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (accumulate op initial (cdr sequence)))))
+
+(define (flatmap proc seq)
+  (accumulate append nil (map proc seq)))
+
+(define (filter predicate sequence)
+  (cond ((null? sequence) nil)
+        ((predicate (car sequence))
+         (cons (car sequence)
+               (filter predicate (cdr sequence))))
+        (else (filter predicate (cdr sequence)))))
+
+(define (enumerate-interval a b)
+  (if (> a b)
+      '()
+      (cons a (enumerate-interval (+ a 1) b))))
+
+; the board will be implemented as a list, which will, in a reversed order, list
+; the rows of the queens, who are sorted by columns, for example:
+; (5 3 1 4) means there are four queens with coordinates:
+; (1,4), (2,1), (3,3), (4,5)
+; this implementation is mostly chosen because of its efficiency and ease of use
+(define empty-board '())
+
+; with this implementation, k is unnecessary
+(define (adjoin-position new-row k rest-of-queens)
+  (cons new-row rest-of-queens))
+
+(define (all-false lst)
+  (cond ((eq? lst '()) #t)
+        ((not (car lst)) (all-false (cdr lst)))
+        (else #f)))
+
+(define (diagonals-from-row row len)
+  (list (enumerate-interval (+ row 1) (+ row len))
+        (reverse (enumerate-interval (- row len) (- row 1)))))
+
+; same here
+(define (safe? k positions)
+  (let* ((first       (car positions))
+         (rest        (cdr positions))
+         (diags       (diagonals-from-row first (length rest)))
+         (upper-diag  (car diags))
+         (lower-diag  (cadr diags))
+         (match-row   (map (lambda (x) (= x first))
+                           rest))
+         (match-diag1 (map = rest upper-diag))
+         (match-diag2 (map = rest lower-diag)))
+    (and (all-false match-row)
+         (all-false match-diag1)
+         (all-false match-diag2))))
+
+(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))

ex-2.43.txt

@@ -0,0 +1,62 @@
+The normal function presented here:
+(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))
+
+gets executed in roughly the following way: Before any of the calls to filter
+or flatmap are performed (queen-cols (- k 1)) will be run. This will happen
+recursively, so it will recursively call until (queen-cols 0), which will
+return a list with a single empty-board.
+Then, in the (queens-col 1) call, eight new boards, each with a single queen,
+will be returned, then in the (queens-col 2), 64 will be created, then
+filtered, and so forth, each time we exit the current call in the stack, we
+have already filtered the results of the previous call.
+
+On the other hand Louis Reasoner's function looks like this:
+(define (queens board-size)
+  (define (queen-cols k)
+    (if (= k 0)
+        (list empty-board)
+        (filter
+         (lambda (positions) (safe? k positions))
+         (flatmap
+          (lambda (new-row)
+            (map (lambda (rest-of-queens)
+                   (adjoin-position new-row k rest-of-queens))
+                 (queen-cols (- k 1))))
+          (enumerate-interval 1 board-size)))))
+  (queen-cols board-size))
+
+And it first calls enumerate-interval, and generates a list of 8 numbers.
+After that, each of these numbers get the outer lambda applied to them, which
+then calls (queen-cols 7) eight times. It will then adjoin, and afterwards
+filter the results. It should be noted, these sub-calls WILL generate filtered
+lists of queens, it's not as if all possible cases will be generated, and only
+then filtered, however, each of these recursive subcalls will generate a list
+of (queen-cols (- k 1)) eight times, instead of once, and so on recursively.
+
+In other words, for the older version of the function, the execution time T(n)
+(assuming board-size is 8), is roughly equal to:
+T(n) = T(n-1) + O(8*Q(n-1))
+               ^adjoining and filtering ^
+(Q(n-1) is length of result of (queen-cols n))
+unraveling this we get: O(Q(n-1)+Q(n-2)+Q(n-3)+...+Q(0))
+
+Whereas the new function's time looks like this:
+T(n) = 8*T(n-1) + O(8*Q(n-1))
+unraveling, we get, very roughly:
+O(8*Q(n-1) + 8*8*Q(n-2) + ... + 8^8*Q(0))
+
+I haven't tried to run the exact numbers, because it would involve learning
+exactly what Q(0), ... ,Q(8) are, which I didn't care to do.