1 (define (test-case actual expected)
10 (define (flatmap proc seq)
11 (fold-right append '() (map proc seq)))
12 (define (enumerate-interval low high)
15 (cons low (enumerate-interval (1+ low) high))))
18 (define (queens board-size)
19 (define (queen-cols k)
23 (lambda (positions) (safe? k positions))
25 (lambda (rest-of-queens)
26 (map (lambda (new-row)
27 (adjoin-position new-row k rest-of-queens))
28 (enumerate-interval 1 board-size)))
29 (queen-cols (- k 1))))))
30 (queen-cols board-size))
32 ;; For example, '((2 4 1 3)) might represent a solution to the 4-queens problem. This represents having queens in col#1 row#2, col#2 row#4, col#3 row#1, col#4 row#3.
33 (define empty-board '())
35 ;; take positions and append new-queen-row in the (new-queen-col - 1)st position in the list
36 (define (adjoin-position new-queen-row new-queen-col positions)
38 (list new-queen-row)))
39 (define (safe? col positions)
40 (define (exclude-last list)
41 (cond ((null? list) (error "empty list"))
42 ((null? (cdr list)) '())
43 (else (cons (car list) (exclude-last (cdr list))))))
44 (let ((row (list-ref positions (- col 1)))
45 (all-but-last (exclude-last positions)))
47 (fold-left (lambda (result next-row)
52 (same-positive-diagonal?
53 (fold-left (lambda (result row-col-sum)
55 (= (+ row col) row-col-sum)))
57 (map + all-but-last (enumerate-interval 1 (- col 1)))))
58 (same-negative-diagonal?
59 (fold-left (lambda (result row-col-dif)
61 (= (- row col) row-col-dif)))
63 (map - all-but-last (enumerate-interval 1 (- col 1))))))
64 (not (or same-row? same-positive-diagonal? same-negative-diagonal?)))))
67 ;; (test-case (safe? 1 '(1)) #t)
68 ;; (test-case (safe? 4 '(2 4 1 1)) #f)
69 ;; (test-case (safe? 4 '(2 4 1 2)) #f)
70 ;; (test-case (safe? 4 '(2 4 1 3)) #t)
71 ;; (test-case (safe? 4 '(2 4 1 4)) #f)
72 ;; (test-case (safe? 7 '(2 4 6 8 3 1 1)) #f)
73 ;; (test-case (safe? 7 '(2 4 6 8 3 1 2)) #f)
74 ;; (test-case (safe? 7 '(2 4 6 8 3 1 3)) #f)
75 ;; (test-case (safe? 7 '(2 4 6 8 3 1 4)) #f)
76 ;; (test-case (safe? 7 '(2 4 6 8 3 1 5)) #f)
77 ;; (test-case (safe? 7 '(2 4 6 8 3 1 6)) #f)
78 ;; (test-case (safe? 7 '(2 4 6 8 3 1 7)) #t)
79 ;; (test-case (safe? 7 '(2 4 6 8 3 1 8)) #f)