Blob


1 (define (smallest-divisor n)
2 (find-divisor n 2))
3 (define (find-divisor n test-divisor)
4 (cond ((> (square test-divisor) n) n)
5 (( divides? test-divisor n) test-divisor)
6 (else (find-divisor n (+ test-divisor 1)))))
7 (define (divides? a b)
8 (= (remainder b a) 0))
9 (define (prime? n)
10 (= n (smallest-divisor n)))
11 (define (flatmap proc seq)
12 (accumulate append '() (map proc seq)))
13 (define (accumulate op initial seq)
14 (if (null? seq)
15 initial
16 (op (car seq)
17 (accumulate op initial (cdr seq)))))
18 (define (enumerate-interval low high)
19 (if (> low high)
20 '()
21 (cons low (enumerate-interval (1+ low) high))))
22 (define (prime-sum? pair)
23 (prime? (+ (car pair) (cadr pair))))
24 (define (make-pair-sum pair)
25 (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
26 (define (prime-sum-pairs n)
27 (map make-pair-sum
28 (filter prime-sum?
29 (flatmap
30 (lambda (i)
31 (map
32 (lambda (j)
33 (list i j))
34 (enumerate-interval 1 (- i 1)))
35 (enumerate-interval 1 n))))))
36 (define (permutations s)
37 (if (null? s)
38 '(())
39 (flatmap (lambda (x)
40 (map (lambda (p) (cons x p))
41 (permutations (remove x s))))
42 s)))
43 (define (remove item sequence)
44 (filter (lambda (x) (not (= x item)))
45 sequence))
46 (define (unique-pairs n)
47 (flatmap
48 (lambda (i)
49 (map (lambda (j)
50 (list i j))
51 (enumerate-interval 1 (- i 1))))
52 (enumerate-interval 1 n)))
53 (define (prime-sum-pairs n)
54 (map make-pair-sum
55 (filter
56 prime-sum?
57 (unique-pairs n))))
59 (prime-sum-pairs 10)