155 lines
4.3 KiB
Scheme
155 lines
4.3 KiB
Scheme
(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)))
|
|
|
|
;; EXERCISE 2.42
|
|
(define (queens board-size)
|
|
(define (queen-cols k)
|
|
(if (= k 0)
|
|
(list empty-board)
|
|
(filter
|
|
(lambda (positions) (safe? k positions))
|
|
(flatmap
|
|
(lambda (rest-of-queens)
|
|
(map (lambda (new-row)
|
|
(adjoin-position new-row k rest-of-queens))
|
|
(enumerate-interval 1 board-size)))
|
|
(queen-cols (- k 1))))))
|
|
(queen-cols board-size))
|
|
|
|
(define empty-board '())
|
|
|
|
(define (position row col) (cons row col))
|
|
(define (row position) (car position))
|
|
(define (col position) (cdr position))
|
|
(define (intercepts horiz pos neg) (list horiz pos neg))
|
|
(define (horiz intercepts) (car intercepts))
|
|
(define (pos intercepts) (cadr intercepts))
|
|
(define (neg intercepts) (caddr intercepts))
|
|
(define (col-k-pos k positions)
|
|
(car (filter (lambda (x) (= (col x) k)) positions)))
|
|
|
|
; Compute the y-intercepts of the horizontal line the line
|
|
; of gradient +1 and the line of gradient -1 through the
|
|
; given position. Any two positions that share one of these
|
|
; intercepts put are not safe wrt each other.
|
|
(define (compute-intercepts position)
|
|
(intercepts (row position)
|
|
(- (row position) (col position))
|
|
(+ (row position) (col position))))
|
|
|
|
(define (checks pos1 pos2)
|
|
(if (= (col pos1) (col pos2))
|
|
#f
|
|
(let ((int1 (compute-intercepts pos1))
|
|
(int2 (compute-intercepts pos2)))
|
|
(or (= (horiz int1) (horiz int2))
|
|
(= (pos int1) (pos int2))
|
|
(= (neg int1) (neg int2))))))
|
|
|
|
(define (adjoin-position row col rest-of-queens)
|
|
(append rest-of-queens (list (position row col))))
|
|
|
|
|
|
; Calculuate the intercepts of each of the position. If any
|
|
; match, then the k-th position is not safe.
|
|
(define (safe? k positions)
|
|
(if (= (col (car positions)) k) #t ; Need to only check with first k-1
|
|
(let* ((k-pos (col-k-pos k positions))
|
|
(k-int (compute-intercepts k-pos))
|
|
(int (compute-intercepts (car positions))))
|
|
(and (not (= (horiz int) (horiz k-int)))
|
|
(not (= (pos int) (pos k-int)))
|
|
(not (= (neg int) (neg k-int)))
|
|
(safe? k (cdr positions))))))
|
|
|
|
; Neater solution using map / accumulate with checks?
|
|
;(define (safe? k positions)
|
|
; (accumulate and #t (map
|