Chapter 4, Metalinguistic Abstraction
Exercise 4.44
This turned out quite concise.
I just changed the main procedure queens of ex-2.42 and other helper procedures were not changed(except i removed one redundant argument in 1 or 2 procedures which i kept in that exercise to make procedure parameters same as in the problem statement).
Note that I use the same structure to represent the board as i used in ex-2.42. Thus display-board procedure which i implemented there can work here too.
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
(define (queens board-size)
(define (queens-col k)
(if (= k 0)
empty-board
(let ((k-1-positions (queens-col (- k 1))))
(let ((new-row (amb 1 (an-integer-between 1 (+ board-size 1)))))
(let ((positions (adjoin-position new-row k-1-positions)))
(require (safe? positions))
positions)))))
(queens-col board-size))
(define (or a b)
(if a
true
(if b true false)))
(define empty-board '())
(define (adjoin-position new-row rest-of-queens) (cons new-row rest-of-queens))
(define (exists? predicate? ls)
(define (iter count ls)
(cond ((null? ls) false)
((predicate? count (car ls)) true)
(else (iter (+ count 1) (cdr ls)))))
(iter 1 ls))
(define (safe? positions)
(let ((row (car positions)))
(not
(exists?
(lambda (pos el)
(or
(= (- el pos) row)
(or
(= (+ el pos) row)
(= el row))))
(cdr positions)))))
(define (an-integer-between low high)
(let ((l (+ low 1)))
(require (> high l))
(amb l (an-integer-between l high))))
Also, i found one subtle bug in my procedure an-integer-between. It should return integer between them. Thus should(as per my understanding) not include the edge points. The old code can be found in ex-4.35.
Output: (only tested for board-size 6, as most of the code is same as ex-2.42)
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
input:
(queens 6)
;;; Starting a new problem
;;; Amb-Eval value:
(5 3 1 6 4 2)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(4 1 5 2 6 3)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(3 6 2 5 1 4)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(2 4 6 1 3 5)
;;; Amb-Eval input:
try-again
;;; There are no more values of
(queens 6)