本小節代碼需要和”序列操作”那節的代碼在一起運行
;仿照了二重循環的方式
(define (make-pairs1 n)
(define (i-iter i ans)
(define (j-iter j ansi)
(if (= j 0)
ansi
(j-iter (- j 1) (cons (list i j) ansi))))
(if (= 0 i)
ans
(i-iter (- i 1) (append (j-iter (- i 1) nil) ans))))
(i-iter n nil))
;
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
(define (isprime? x)
(define (smallest-divisor guess limit)
(cond ((> guess limit) x)
((= (remainder x guess) 0) guess)
(else (smallest-divisor (+ guess 1) limit))))
(= (smallest-divisor 2 (sqrt x)) x))
(define (prime-sum? pair)
(isprime? (+ (car pair) (cadr pair))))
(define (make-pair-sum pair)
(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (prime-sum-pairs n)
(map make-pair-sum
(filter prime-sum?
(flatmap (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))))
;
(define (remove item sequence)
(filter (lambda (x) (not (= x item))) sequence))
(define (permutations s)
(if (null? s)
(list nil);attention!!
(flatmap (lambda (x)
(map (lambda (sub-permutation)
(cons x sub-permutation))
(permutations (remove x s))))
s)))
;2.40
(define (unique-pairs n)
(flatmap (lambda (i)
(map (lambda (j) (list i j));list only,because of 'prime-sum? and so on
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(define (prime-sum-pairs1 n)
(map make-pair-sum
(filter prime-sum?
(unique-pairs n))))
;2.41
(define (3-pairs n)
(define numbers (enumerate-interval 1 n))
(flatmap (lambda (i)
(flatmap (lambda (j)
(map (lambda (k) (list i j k))
(filter (lambda (x)
(not (or (= x i) (= x j))))
numbers)))
(filter (lambda (x) (not (= x i))) numbers)))
numbers))
下面是八皇后問題,這裏方案的表示相當於將棋盤左右顛倒來看
;2.42
(define (queens board-size)
(define rows (enumerate-interval 1 board-size))
(define empty-board nil)
(define (safe? k positions)
(define new-row (car positions))
(define (iter tmp-k tmp-positions)
(if (null? tmp-positions)
(= 1 1)
(let ((tmp-row (car tmp-positions)))
(if (or (= new-row (car tmp-positions))
(= (+ k new-row) (+ tmp-k tmp-row))
(= (- k new-row) (- tmp-k tmp-row)))
(= 1 0)
(iter (- tmp-k 1) (cdr tmp-positions))))))
(iter (- k 1) (cdr positions)))
(define (adjoin-position new-row k rest-of-queens)
(cons new-row rest-of-queens))
(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))
rows))
(queen-cols (- k 1))))))
(queen-cols board-size))