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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
(define (enumerate-interval l r)
(if (= l r)
(list l)
(cons l (enumerate-interval (+ l 1) r))))
;(enumerate-interval 1 10)
(define (contains? e pl)
(if (null? pl)
#f
(or (eq? e (car pl))
(contains? e (cdr pl)))))
;检查形如(2 1 4 3 2)这样的positions list中有没有重复元素,简单办法，hash会是更好的办法。
(define (no-repeat? positions)
(if (null? positions)
#t
(and (not (contains? (car positions) (cdr positions)))
(no-repeat? (cdr positions)))))
;(no-repeat? '(1 2))
;(no-repeat? '(1 2 1))
;按理说应该检查一下rest-of-queens是不是length = (- k 1)...
;使用cons可以想象成把所有列往右移一列再把新的添到第一列，这样不影响safe?的判断，简单。
(define (addjoin-position new-row k rest-of-queens)
(cons new-row rest-of-queens))
(define (flatmap proc seq)
(foldr append () (map proc seq)))
(define (safe? k positions)
;两个点在对角线上，也就是满足同一个方程x+y=n或x-y=n
;所以要判断两个点是不是在同一条“左下至右上对角线”上，
;只需要算出两个x-y，判断是否相等即可。左上至右下同理。
(define (px-y pl)
(map + positions (enumerate-interval 1 k)))
(define (px+y pl)
(map - positions (enumerate-interval 1 k)))
(and
(no-repeat? positions);不在同一行
(no-repeat? (px-y positions));不在同一条“左下至右上对角线”上
(no-repeat? (px+y positions));不在同一条“左上至右下对角线”上
))
;(safe? 1 '(1))
;(safe? 2 '(1 2))
;(safe? 3 '(1 2 3))
;(safe? 4 '(3 1 4 2))
;(safe? 4 '(2 4 1 3))
;层次遍历状态空间树，剪掉每一层中不合适的分支后再扩展到下一层。
(define (queens board-size)
(define empty-board ())
(define (queen-cols k)
;一个布局表示成一个list,形如(2 4 1 3),表示第一列为2，第二列为2，第三列为1...
;queens-cols 返回((1,2,3)(2,1,3)(3,2,1))这样的布局组成的list
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (safe? k positions))
(flatmap
(lambda (reat-of-queens)
(map (lambda (new-row)
(addjoin-position new-row k reat-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
;(queens 4)
(queens 8)
|