-
Notifications
You must be signed in to change notification settings - Fork 0
/
2_40.scm
41 lines (36 loc) · 1.13 KB
/
2_40.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
(define (enumerate-interval low high)
(if (> low high)
'()
(cons low (enumerate-interval (+ low 1) high))))
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (flatmap proc seq)
(accumulate append '() (map proc seq)))
(define (prime-sum? pair)
(prime? (+ (car pair) (cadr pair))))
(define (square n)
(* n n))
(define (divides? a b)
(= (remainder b a) 0))
(define (find-divisor n test-divisor)
(cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor)
(else (find-divisor n (+ test-divisor 1)))))
(define (smallest-divisor n)
(find-divisor n 2))
(define (prime? n)
(= n (smallest-divisor n)))
(define (make-pair-sum pair)
(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (unique-pairs n)
(flatmap (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(define (prime-sum-pairs n)
(map make-pair-sum
(filter prime-sum?
(unique-pairs n))))