Completed 2.41

This commit is contained in:
Oliver Payne 2021-11-06 13:15:04 +00:00
parent 32fd86edcb
commit 28864609ed
1 changed files with 89 additions and 0 deletions

89
2_40.sch Normal file
View File

@ -0,0 +1,89 @@
(define (filter predicate sequence)
(cond ((null? sequence) '())
((predicate (car sequence))
(cons (car sequence)
(filter predicate (cdr sequence))))
(else (filter predicate (cdr sequence)))))
(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 (make-pair-sum pair)
(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (smallest-divisor n)
(find-divisor n 2))
(define (square x) (* x x))
(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 (divides? a b)
(= (remainder b a) 0))
(define (prime? n)
(= n (smallest-divisor n)))
(define (permutations s)
(if (null? s) ; empty set?
(list '()) ; sequence containing empty set
(flatmap (lambda (x)
(map (lambda (p) (cons x p))
(permutations (remove x s))))
s)))
(define (remove item sequence)
(filter (lambda (x) (not (= x item)))
sequence))
(define (enumerate-interval low high)
(if (> low high)
'()
(cons low (enumerate-interval (+ low 1) high))))
(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))))
; 2.41
(define (ordered-triples n)
(flatmap
(lambda (i)
(flatmap
(lambda (j)
(map (lambda (k) (list i j k))
(enumerate-interval 1 (- j 1))))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(define (sum l)
(if (null? l)
0
(+ (car l) (sum (cdr l)))))
(define (triple-leq-n-sum-s n s)
(filter (lambda (x) (= (sum x) s)) (ordered-triples n)))