SICP_2.40-2.43

  1 #lang racket
  2 
  3 ;;;;;;;;;;;;;;;;;;;;;;;
  4 (define (flatmap proc seq)
  5   (accumulate append nil (map proc seq)))
  6 
  7 ;;;;;;;;;;;;;;;;;2.40
  8 (define nil '())
  9 
 10 (define (accumulate op intial seq)
 11   (if (null? seq)
 12       intial
 13       (op (car seq)
 14           (accumulate op intial (cdr seq)))))
 15 
 16 (define (enumerate-interval low high)
 17   (if (> low high)
 18       nil
 19       (cons low (enumerate-interval (+ low 1) high))))
 20 
 21 (define (make-pair-sum pair)
 22   (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
 23 
 24 (define (prime-sum? pair)
 25   (prime? (+ (car pair) (cadr pair))))
 26 
 27 (define (prime? n)
 28   (define (test number)
 29     (cond ((> (square number) n) #t)
 30           ((= (remainder n number) 0) #f)
 31           (else (test (+ number 1)))))
 32   (test 2))
 33 
 34 (define (square x)
 35   (* x x))
 36 
 37 (define (unique-pairs n)
 38   (accumulate append
 39               nil
 40               (map (lambda (i)
 41                      (map (lambda (j) (list i j))
 42                           (enumerate-interval 1 (- i 1))))
 43                    (enumerate-interval 1 n))))
 44 
 45 ;;;;;;;;test
 46 (unique-pairs 5)
 47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 48 (define (prime-sum-pairs n)
 49   (map make-pair-sum
 50        (filter prime-sum?
 51                (unique-pairs n))))
 52 
 53 ;;;;;;;;;test
 54 (prime-sum-pairs 5)
 55 
 56 ;;;;;;;;;;;;;;;;;;;2.41 假设s等于7
 57 (define (unique-triples n)
 58   (flatmap (lambda (i)
 59              (map (lambda (j)
 60                     (cons i j))
 61                   (unique-pairs (- i 1))))
 62            (enumerate-interval 1 n)))
 63 
 64 (define (sum-equal? sum triple)
 65   (= sum (+ (car triple) (cadr triple) (caddr triple))))
 66 
 67 ;(define (sum-equal? sum triple)
 68 ; (= sum
 69 ;     (fold-right + 0 triple)))
 70 
 71 (define (remove-triples-not-equal-to sum triple)
 72   (filter (lambda (current-triple)
 73             (sum-equal? sum current-triple))
 74           triple))
 75 
 76 ;;;;;;;;;;;;;;test
 77 (remove-triples-not-equal-to 10 (unique-triples 13))
 78 
 79 ;;;;;;;;;;;;;;;;;;;;2.42
 80 (define (queens board-size)
 81   (define (queen-cols k)
 82     (if (= k 0)
 83         (list empty-board)
 84         (filter
 85          (lambda (positions) (safe? k positions))
 86          (flatmap
 87          (lambda (rest-of-queens)
 88            (map (lambda (new-row)
 89                   (adjoin-position new-row k rest-of-queens))
 90                 (enumerate-interval 1 board-size)))
 91         (queen-cols (- k 1))))))
 92   (queen-cols board-size))
 93 
 94 (define (make-position row col)
 95   (cons row col))
 96 
 97 (define (position-row position)
 98   (car position))
 99 
100 (define (position-col position)
101   (cdr position))
102 
103 (define empty-board null)
104 
105 (define (adjoin-position row col positions)
106   (append positions (list (make-position row col))))
107 
108 (define (safe? col positions)
109   (let ((kth-queen (list-ref positions (- col 1)))
110     (other-queens (filter (lambda (q)
111                             (not (= col (position-col q))))
112                           positions)))
113     (define (attacks? q1 q2)
114       (or (= (position-row q1) (position-row q2))
115           (= (abs (- (position-row q1) (position-row q2)))
116              (abs (- (position-col q1) (position-col q2))))))
117     (define (iter q board)
118       (or (null? board)
119           (and (not (attacks? q (car board)))
120                (iter q (cdr board)))))
121     (iter kth-queen other-queens)))
122 
123 (queens 4)
2.42 尚未理解书上的queens函数参考代码
Yosoro