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)
61 ;; Exercise 2.41. Write a procedure to find all ordered triples of distinct positive integers i, j, and k less than or equal to a given integer n that sum to a given integer s.
63 ;; 1 <= k < j < i <= n
64 (define (triples n sum)
65 (define (triple-sum? lst)
66 (= (+ (car lst)
67 (cadr lst)
68 (caddr lst)) sum))
69 (filter triple-sum?
70 (flatmap (lambda (i)
71 (flatmap (lambda (j)
72 (map (lambda (k)
73 (list i j k))
74 (enumerate-interval 1 (- j 1))))
75 (enumerate-interval 1 (- i 1))))
76 (enumerate-interval 1 n))))
78 (triples 10 12)