#lang racket
(require math/number-theory) ; for prime? used in 2.40
;;;;;;;;;;
;; 2.33 ;;
;;;;;;;;;;
(define (accumulate op initial sequence)
(if (empty? sequence)
initial
(op (first sequence)
(accumulate op initial (rest sequence)))))
(define (my-map p sequence)
(accumulate (lambda (x y) (cons (p x) y)) empty sequence))
(my-map sqr (list 1 2 3))
;; '(1 4 9)
(define (my-append seq1 seq2)
(accumulate cons seq2 seq1))
(my-append (list 1 2 3) (list 4 5 6))
;; '(1 2 3 4 5 6)
(define (my-length sequence)
(accumulate (lambda (x y) (add1 y)) 0 sequence))
(my-length (list 1 2 3 4))
;; 4
;;;;;;;;;;
;; 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)) ; 1 + 3 * 2 + 5 * 2 ^ 3 + 2 ^ 5 = 79
;; 79
;;;;;;;;;;
;; 2.35 ;;
;;;;;;;;;;
(define (enumerate-tree tree)
(cond [(empty? tree) empty]
[(not (pair? tree)) (list tree)]
[else (append (enumerate-tree (first tree))
(enumerate-tree (rest tree)))]))
(define (count-leaves t)
(accumulate +
0
(map (lambda (x) 1) (enumerate-tree t))))
(count-leaves (list (list 1 2) (list 3 (list 4 5))))
;; 5
;;;;;;;;;;
;; 2.36 ;;
;;;;;;;;;;
(define (accumulate-n op init seqs)
(if (empty? (first seqs))
empty
(cons (accumulate op init (map first seqs))
(accumulate-n op init (map rest seqs)))))
(accumulate-n +
0
(list (list 1 2 3)
(list 4 5 6)
(list 7 8 9)))
;; '(12 15 18)
;;;;;;;;;;
;; 2.37 ;;
;;;;;;;;;;
(define (dot-product v w)
(accumulate + 0 (map * v w)))
(dot-product (list 1 2) (list 4 5))
;; 14
(define (matrix-*-vector m v)
(map (lambda (row) (dot-product row v))
m))
(matrix-*-vector (list (list 1 2 3)
(list 4 5 6)
(list 7 8 9))
(list 1 1 1))
;; '(6 15 24)
(define (transpose mat)
(accumulate-n cons
empty
mat))
(transpose (list (list 1 2 3)
(list 4 5 6)
(list 7 8 9)))
;; '((1 4 7) (2 5 8) (3 6 9))
(define (matrix-*-matrix m n)
(define cols (transpose n))
(map (lambda (row) (matrix-*-vector cols row))
m))
(matrix-*-matrix (list (list 1 2 3)
(list 4 5 6)
(list 7 8 9))
(list (list 0 1 0)
(list 0 0 1)
(list 1 0 0)))
;; '((3 1 2) (6 4 5) (9 7 8))
;;;;;;;;;;
;; 2.38 ;;
;;;;;;;;;;
(define fold-right accumulate)
(define (fold-left op initial sequence)
(define (iter result rst)
(if (null? rst)
result
(iter (op result (first rst))
(rest rst))))
(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 empty (list 1 2 3))
;; '(1 (2 (3 ())))
(fold-left list empty (list 1 2 3))
;; '(((() 1) 2) 3)
;; If op is associative and initial is an identity for op, then fold-right and
;; fold-left will produce the same value for any sequence. Also note that
;; fold-left is constant space but fold-right is linear space.
;;;;;;;;;;
;; 2.39 ;;
;;;;;;;;;;
(define (reverse1 sequence)
(fold-right (lambda (x y) (append y (list x)))
empty
sequence))
(reverse1 (list 1 2 3))
;; '(3 2 1)
(define (reverse2 sequence)
(fold-left (lambda (x y) (cons y x))
empty
sequence))
(reverse2 (list 1 2 3))
;; '(3 2 1)
;;;;;;;;;;
;; 2.40 ;;
;;;;;;;;;;
(define (enumerate-interval low high)
(if (> low high)
empty
(cons low (enumerate-interval (add1 low) high))))
(define (flatmap proc seq) ; only sensible when proc returns a list
(accumulate append empty (map proc seq)))
(define (prime-sum? pair)
(prime? (+ (first pair) (second pair))))
(define (make-pair-sum pair)
(list (first pair) (second pair) (+ (first pair) (second pair))))
(define (unique-pairs n)
(flatmap (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (sub1 i))))
(enumerate-interval 1 n)))
(unique-pairs 5)
;; '((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4))
;; A more Racketeering way of writing unique-pairs would be to use the built-in
;; list comprehensions:
(define (racket-unique-pairs n)
(for*/list ([i (in-range 1 (add1 n))]
[j (in-range 1 i)])
(list i j)))
(racket-unique-pairs 5)
;; '((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4))
(define (prime-sum-pairs n)
(map make-pair-sum (filter prime-sum? (unique-pairs n))))
(prime-sum-pairs 5)
;; '((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7))
;;;;;;;;;;
;; 2.41 ;;
;;;;;;;;;;
(define (sum-triples n s)
(filter (lambda (triple) (= (apply + triple) s))
(for*/list ([i (in-range 1 (add1 n))]
[j (in-range 1 i)]
[k (in-range 1 j)])
(list k j i))))
(sum-triples 9 12)
;; '((3 4 5) (2 4 6) (1 5 6) (2 3 7) (1 4 7) (1 3 8) (1 2 9))
;;;;;;;;;;
;; 2.42 ;;
;;;;;;;;;;
(define (queens board-size)
(define (queen-cols k)
(if (zero? k)
(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 (sub1 k))))))
(queen-cols board-size))
;; A queen is a list of row and column coordinates. A position is a list of queens.
(define empty-board empty)
(define (make-queen column row) (list column row))
(define (col-coord queen) (first queen))
(define (row-coord queen) (second queen))
(define (adjoin-position column row position)
(cons (make-queen column row) position))
(define (safe? k position)
; #t if the first queen in position is safe from the other k - 1 queens
(define (safe-from-one? queen1 queen2)
(and (not (= (col-coord queen1)
(col-coord queen2)))
(not (= (row-coord queen1)
(row-coord queen2)))
(not (= (abs (- (col-coord queen1) ; different diagonals
(col-coord queen2)))
(abs (- (row-coord queen1)
(row-coord queen2)))))))
(andmap (lambda (q) (safe-from-one? (first position) q))
(rest position)))
(queens 3)
;; '()
(queens 4)
;; '(((3 4) (1 3) (4 2) (2 1)) ((2 4) (4 3) (1 2) (3 1)))
(queens 5)
;; '(((4 5) (2 4) (5 3) (3 2) (1 1))
;; ((3 5) (5 4) (2 3) (4 2) (1 1))
;; ((5 5) (3 4) (1 3) (4 2) (2 1))
;; ((4 5) (1 4) (3 3) (5 2) (2 1))
;; ((5 5) (2 4) (4 3) (1 2) (3 1))
;; ((1 5) (4 4) (2 3) (5 2) (3 1))
;; ((2 5) (5 4) (3 3) (1 2) (4 1))
;; ((1 5) (3 4) (5 3) (2 2) (4 1))
;; ((3 5) (1 4) (4 3) (2 2) (5 1))
;; ((2 5) (4 4) (1 3) (3 2) (5 1)))
(queens 6)
;; '(((5 6) (3 5) (1 4) (6 3) (4 2) (2 1))
;; ((4 6) (1 5) (5 4) (2 3) (6 2) (3 1))
;; ((3 6) (6 5) (2 4) (5 3) (1 2) (4 1))
;; ((2 6) (4 5) (6 4) (1 3) (3 2) (5 1)))
;;;;;;;;;;
;; 2.43 ;;
;;;;;;;;;;
(define (slow-queens board-size)
(define (slow-queen-cols k)
(if (zero? k)
(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))
(slow-queen-cols (sub1 k))))
(enumerate-interval 1 board-size)))))
(slow-queen-cols board-size))
;; Interchanging the order of the loops causes the program to needlessly repeat
;; the call to queen-cols(k - 1) board-size times, for each new column k. But
;; it's even worse than that, because each one of those calls causes the program
;; to needlessly repeat all the recursive calls to queen-cols(j) for smaller j.
;; I'm not really sure what that does to the overall run time of queens(n). I
;; think it should be increased by a factor = 1 + n + n ^ 2 + ... + n ^ (n - 1)
;; which is on the order of n ^ (n - 1), but I couldn't get enough run times to
;; really test that.
(for ([n (in-range 6 10)])
(define fast-start-time (current-inexact-milliseconds))
(define fast-num-solns (queens n))
(define fast-time (- (current-inexact-milliseconds) fast-start-time))
(define slow-start-time (current-inexact-milliseconds))
(define slow-num-solns (slow-queens n))
(define slow-time (- (current-inexact-milliseconds) slow-start-time))
(printf "~a ~a ~a ~a ~a ~a ~n"
n
(length fast-num-solns)
(round fast-time)
(length slow-num-solns)
(round slow-time)
(round (/ slow-time fast-time))))
;; n solns1 fast-time solns2 slow-time ratio
;; 6 4 1.0 4 101.0 101.0
;; 7 40 3.0 40 1571.0 523.0
;; 8 92 15.0 92 32677.0 2252.0
;; 9 352 82.0 352 776164.0 9459.0
Comments