1 665c255d 2023-08-04 jrmu (define (test-case actual expected)
3 665c255d 2023-08-04 jrmu (display "Actual: ")
4 665c255d 2023-08-04 jrmu (display actual)
6 665c255d 2023-08-04 jrmu (display "Expected: ")
7 665c255d 2023-08-04 jrmu (display expected)
10 665c255d 2023-08-04 jrmu (define (flatmap proc seq)
11 665c255d 2023-08-04 jrmu (fold-right append '() (map proc seq)))
12 665c255d 2023-08-04 jrmu (define (enumerate-interval low high)
13 665c255d 2023-08-04 jrmu (if (> low high)
15 665c255d 2023-08-04 jrmu (cons low (enumerate-interval (1+ low) high))))
17 665c255d 2023-08-04 jrmu (define (queens board-size)
18 665c255d 2023-08-04 jrmu (define (queen-cols k)
20 665c255d 2023-08-04 jrmu (list empty-board)
22 665c255d 2023-08-04 jrmu (lambda (positions) (safe? k positions))
24 665c255d 2023-08-04 jrmu (lambda (rest-of-queens)
25 665c255d 2023-08-04 jrmu (map (lambda (new-row)
26 665c255d 2023-08-04 jrmu (adjoin-position new-row k rest-of-queens))
27 665c255d 2023-08-04 jrmu (enumerate-interval 1 board-size)))
28 665c255d 2023-08-04 jrmu (queen-cols (- k 1))))))
29 665c255d 2023-08-04 jrmu (queen-cols board-size))
31 665c255d 2023-08-04 jrmu ;; For example, '(((2 1) (4 2) (1 3) (3 4))) represents col#1 row#2, col#2 row#4, col#3 row#1, col#4 row#3.
32 665c255d 2023-08-04 jrmu (define empty-board '())
34 665c255d 2023-08-04 jrmu ;; (adjoin-position 1 3 '((2 1) (4 2))) = '((2 1) (4 2) (1 3))
35 665c255d 2023-08-04 jrmu (define (adjoin-position row col positions)
36 665c255d 2023-08-04 jrmu (append positions (list (list row col))))
39 665c255d 2023-08-04 jrmu ;; not finished
40 665c255d 2023-08-04 jrmu (define (safe? col positions)
41 665c255d 2023-08-04 jrmu (define (exclude-last list)
42 665c255d 2023-08-04 jrmu (cond ((null? list) (error "empty list"))
43 665c255d 2023-08-04 jrmu ((null? (cdr list)) '())
44 665c255d 2023-08-04 jrmu (else (cons (car list) (exclude-last (cdr list))))))
45 665c255d 2023-08-04 jrmu (let ((row (list-ref positions (- col 1)))
46 665c255d 2023-08-04 jrmu (all-but-last (exclude-last positions)))
47 665c255d 2023-08-04 jrmu (let ((same-row?
48 665c255d 2023-08-04 jrmu (fold-left (lambda (result next-row)
50 665c255d 2023-08-04 jrmu (= next-row row)))
52 665c255d 2023-08-04 jrmu all-but-last))
53 665c255d 2023-08-04 jrmu (same-positive-diagonal?
54 665c255d 2023-08-04 jrmu (fold-left (lambda (result row-col-sum)
56 665c255d 2023-08-04 jrmu (= (+ row col) row-col-sum)))
58 665c255d 2023-08-04 jrmu (map + all-but-last (enumerate-interval 1 (- col 1)))))
59 665c255d 2023-08-04 jrmu (same-negative-diagonal?
60 665c255d 2023-08-04 jrmu (fold-left (lambda (result row-col-dif)
62 665c255d 2023-08-04 jrmu (= (- row col) row-col-dif)))
64 665c255d 2023-08-04 jrmu (map - all-but-last (enumerate-interval 1 (- col 1))))))
65 665c255d 2023-08-04 jrmu (not (or same-row? same-positive-diagonal? same-negative-diagonal?)))))
68 665c255d 2023-08-04 jrmu ;; (test-case (safe? 1 '(1)) #t)
69 665c255d 2023-08-04 jrmu ;; (test-case (safe? 4 '(2 4 1 1)) #f)
70 665c255d 2023-08-04 jrmu ;; (test-case (safe? 4 '(2 4 1 2)) #f)
71 665c255d 2023-08-04 jrmu ;; (test-case (safe? 4 '(2 4 1 3)) #t)
72 665c255d 2023-08-04 jrmu ;; (test-case (safe? 4 '(2 4 1 4)) #f)
73 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 1)) #f)
74 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 2)) #f)
75 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 3)) #f)
76 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 4)) #f)
77 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 5)) #f)
78 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 6)) #f)
79 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 7)) #t)
80 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 8)) #f)
