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函数 参考代码
转载于:https://www.cnblogs.com/tclan126/p/6422498.html
相关资源：数据结构—成绩单生成器
