Compare commits

...

2 Commits

Author SHA1 Message Date
Oliver Payne 78bfc38b81 Add output for original 8-queens in exercise 2.42 2023-11-17 21:50:39 +00:00
Oliver Payne 1bc48e4e78 Add amb-8-queens.rkt (exercise 4.44)
Currently fixed for n = 8.
2023-11-17 21:48:52 +00:00
4 changed files with 155 additions and 1 deletions

View File

@ -74,6 +74,102 @@
(not (memv (negative-intercept kth-position) (not (memv (negative-intercept kth-position)
(map negative-intercept pre-kth-positions)))))) (map negative-intercept pre-kth-positions))))))
;; ;; Output
;; (((1 . 1) (5 . 2) (8 . 3) (6 . 4) (3 . 5) (7 . 6) (2 . 7) (4 . 8))
;; ((1 . 1) (6 . 2) (8 . 3) (3 . 4) (7 . 5) (4 . 6) (2 . 7) (5 . 8))
;; ((1 . 1) (7 . 2) (4 . 3) (6 . 4) (8 . 5) (2 . 6) (5 . 7) (3 . 8))
;; ((1 . 1) (7 . 2) (5 . 3) (8 . 4) (2 . 5) (4 . 6) (6 . 7) (3 . 8))
;; ((2 . 1) (4 . 2) (6 . 3) (8 . 4) (3 . 5) (1 . 6) (7 . 7) (5 . 8))
;; ((2 . 1) (5 . 2) (7 . 3) (1 . 4) (3 . 5) (8 . 6) (6 . 7) (4 . 8))
;; ((2 . 1) (5 . 2) (7 . 3) (4 . 4) (1 . 5) (8 . 6) (6 . 7) (3 . 8))
;; ((2 . 1) (6 . 2) (1 . 3) (7 . 4) (4 . 5) (8 . 6) (3 . 7) (5 . 8))
;; ((2 . 1) (6 . 2) (8 . 3) (3 . 4) (1 . 5) (4 . 6) (7 . 7) (5 . 8))
;; ((2 . 1) (7 . 2) (3 . 3) (6 . 4) (8 . 5) (5 . 6) (1 . 7) (4 . 8))
;; ((2 . 1) (7 . 2) (5 . 3) (8 . 4) (1 . 5) (4 . 6) (6 . 7) (3 . 8))
;; ((2 . 1) (8 . 2) (6 . 3) (1 . 4) (3 . 5) (5 . 6) (7 . 7) (4 . 8))
;; ((3 . 1) (1 . 2) (7 . 3) (5 . 4) (8 . 5) (2 . 6) (4 . 7) (6 . 8))
;; ((3 . 1) (5 . 2) (2 . 3) (8 . 4) (1 . 5) (7 . 6) (4 . 7) (6 . 8))
;; ((3 . 1) (5 . 2) (2 . 3) (8 . 4) (6 . 5) (4 . 6) (7 . 7) (1 . 8))
;; ((3 . 1) (5 . 2) (7 . 3) (1 . 4) (4 . 5) (2 . 6) (8 . 7) (6 . 8))
;; ((3 . 1) (5 . 2) (8 . 3) (4 . 4) (1 . 5) (7 . 6) (2 . 7) (6 . 8))
;; ((3 . 1) (6 . 2) (2 . 3) (5 . 4) (8 . 5) (1 . 6) (7 . 7) (4 . 8))
;; ((3 . 1) (6 . 2) (2 . 3) (7 . 4) (1 . 5) (4 . 6) (8 . 7) (5 . 8))
;; ((3 . 1) (6 . 2) (2 . 3) (7 . 4) (5 . 5) (1 . 6) (8 . 7) (4 . 8))
;; ((3 . 1) (6 . 2) (4 . 3) (1 . 4) (8 . 5) (5 . 6) (7 . 7) (2 . 8))
;; ((3 . 1) (6 . 2) (4 . 3) (2 . 4) (8 . 5) (5 . 6) (7 . 7) (1 . 8))
;; ((3 . 1) (6 . 2) (8 . 3) (1 . 4) (4 . 5) (7 . 6) (5 . 7) (2 . 8))
;; ((3 . 1) (6 . 2) (8 . 3) (1 . 4) (5 . 5) (7 . 6) (2 . 7) (4 . 8))
;; ((3 . 1) (6 . 2) (8 . 3) (2 . 4) (4 . 5) (1 . 6) (7 . 7) (5 . 8))
;; ((3 . 1) (7 . 2) (2 . 3) (8 . 4) (5 . 5) (1 . 6) (4 . 7) (6 . 8))
;; ((3 . 1) (7 . 2) (2 . 3) (8 . 4) (6 . 5) (4 . 6) (1 . 7) (5 . 8))
;; ((3 . 1) (8 . 2) (4 . 3) (7 . 4) (1 . 5) (6 . 6) (2 . 7) (5 . 8))
;; ((4 . 1) (1 . 2) (5 . 3) (8 . 4) (2 . 5) (7 . 6) (3 . 7) (6 . 8))
;; ((4 . 1) (1 . 2) (5 . 3) (8 . 4) (6 . 5) (3 . 6) (7 . 7) (2 . 8))
;; ((4 . 1) (2 . 2) (5 . 3) (8 . 4) (6 . 5) (1 . 6) (3 . 7) (7 . 8))
;; ((4 . 1) (2 . 2) (7 . 3) (3 . 4) (6 . 5) (8 . 6) (1 . 7) (5 . 8))
;; ((4 . 1) (2 . 2) (7 . 3) (3 . 4) (6 . 5) (8 . 6) (5 . 7) (1 . 8))
;; ((4 . 1) (2 . 2) (7 . 3) (5 . 4) (1 . 5) (8 . 6) (6 . 7) (3 . 8))
;; ((4 . 1) (2 . 2) (8 . 3) (5 . 4) (7 . 5) (1 . 6) (3 . 7) (6 . 8))
;; ((4 . 1) (2 . 2) (8 . 3) (6 . 4) (1 . 5) (3 . 6) (5 . 7) (7 . 8))
;; ((4 . 1) (6 . 2) (1 . 3) (5 . 4) (2 . 5) (8 . 6) (3 . 7) (7 . 8))
;; ((4 . 1) (6 . 2) (8 . 3) (2 . 4) (7 . 5) (1 . 6) (3 . 7) (5 . 8))
;; ((4 . 1) (6 . 2) (8 . 3) (3 . 4) (1 . 5) (7 . 6) (5 . 7) (2 . 8))
;; ((4 . 1) (7 . 2) (1 . 3) (8 . 4) (5 . 5) (2 . 6) (6 . 7) (3 . 8))
;; ((4 . 1) (7 . 2) (3 . 3) (8 . 4) (2 . 5) (5 . 6) (1 . 7) (6 . 8))
;; ((4 . 1) (7 . 2) (5 . 3) (2 . 4) (6 . 5) (1 . 6) (3 . 7) (8 . 8))
;; ((4 . 1) (7 . 2) (5 . 3) (3 . 4) (1 . 5) (6 . 6) (8 . 7) (2 . 8))
;; ((4 . 1) (8 . 2) (1 . 3) (3 . 4) (6 . 5) (2 . 6) (7 . 7) (5 . 8))
;; ((4 . 1) (8 . 2) (1 . 3) (5 . 4) (7 . 5) (2 . 6) (6 . 7) (3 . 8))
;; ((4 . 1) (8 . 2) (5 . 3) (3 . 4) (1 . 5) (7 . 6) (2 . 7) (6 . 8))
;; ((5 . 1) (1 . 2) (4 . 3) (6 . 4) (8 . 5) (2 . 6) (7 . 7) (3 . 8))
;; ((5 . 1) (1 . 2) (8 . 3) (4 . 4) (2 . 5) (7 . 6) (3 . 7) (6 . 8))
;; ((5 . 1) (1 . 2) (8 . 3) (6 . 4) (3 . 5) (7 . 6) (2 . 7) (4 . 8))
;; ((5 . 1) (2 . 2) (4 . 3) (6 . 4) (8 . 5) (3 . 6) (1 . 7) (7 . 8))
;; ((5 . 1) (2 . 2) (4 . 3) (7 . 4) (3 . 5) (8 . 6) (6 . 7) (1 . 8))
;; ((5 . 1) (2 . 2) (6 . 3) (1 . 4) (7 . 5) (4 . 6) (8 . 7) (3 . 8))
;; ((5 . 1) (2 . 2) (8 . 3) (1 . 4) (4 . 5) (7 . 6) (3 . 7) (6 . 8))
;; ((5 . 1) (3 . 2) (1 . 3) (6 . 4) (8 . 5) (2 . 6) (4 . 7) (7 . 8))
;; ((5 . 1) (3 . 2) (1 . 3) (7 . 4) (2 . 5) (8 . 6) (6 . 7) (4 . 8))
;; ((5 . 1) (3 . 2) (8 . 3) (4 . 4) (7 . 5) (1 . 6) (6 . 7) (2 . 8))
;; ((5 . 1) (7 . 2) (1 . 3) (3 . 4) (8 . 5) (6 . 6) (4 . 7) (2 . 8))
;; ((5 . 1) (7 . 2) (1 . 3) (4 . 4) (2 . 5) (8 . 6) (6 . 7) (3 . 8))
;; ((5 . 1) (7 . 2) (2 . 3) (4 . 4) (8 . 5) (1 . 6) (3 . 7) (6 . 8))
;; ((5 . 1) (7 . 2) (2 . 3) (6 . 4) (3 . 5) (1 . 6) (4 . 7) (8 . 8))
;; ((5 . 1) (7 . 2) (2 . 3) (6 . 4) (3 . 5) (1 . 6) (8 . 7) (4 . 8))
;; ((5 . 1) (7 . 2) (4 . 3) (1 . 4) (3 . 5) (8 . 6) (6 . 7) (2 . 8))
;; ((5 . 1) (8 . 2) (4 . 3) (1 . 4) (3 . 5) (6 . 6) (2 . 7) (7 . 8))
;; ((5 . 1) (8 . 2) (4 . 3) (1 . 4) (7 . 5) (2 . 6) (6 . 7) (3 . 8))
;; ((6 . 1) (1 . 2) (5 . 3) (2 . 4) (8 . 5) (3 . 6) (7 . 7) (4 . 8))
;; ((6 . 1) (2 . 2) (7 . 3) (1 . 4) (3 . 5) (5 . 6) (8 . 7) (4 . 8))
;; ((6 . 1) (2 . 2) (7 . 3) (1 . 4) (4 . 5) (8 . 6) (5 . 7) (3 . 8))
;; ((6 . 1) (3 . 2) (1 . 3) (7 . 4) (5 . 5) (8 . 6) (2 . 7) (4 . 8))
;; ((6 . 1) (3 . 2) (1 . 3) (8 . 4) (4 . 5) (2 . 6) (7 . 7) (5 . 8))
;; ((6 . 1) (3 . 2) (1 . 3) (8 . 4) (5 . 5) (2 . 6) (4 . 7) (7 . 8))
;; ((6 . 1) (3 . 2) (5 . 3) (7 . 4) (1 . 5) (4 . 6) (2 . 7) (8 . 8))
;; ((6 . 1) (3 . 2) (5 . 3) (8 . 4) (1 . 5) (4 . 6) (2 . 7) (7 . 8))
;; ((6 . 1) (3 . 2) (7 . 3) (2 . 4) (4 . 5) (8 . 6) (1 . 7) (5 . 8))
;; ((6 . 1) (3 . 2) (7 . 3) (2 . 4) (8 . 5) (5 . 6) (1 . 7) (4 . 8))
;; ((6 . 1) (3 . 2) (7 . 3) (4 . 4) (1 . 5) (8 . 6) (2 . 7) (5 . 8))
;; ((6 . 1) (4 . 2) (1 . 3) (5 . 4) (8 . 5) (2 . 6) (7 . 7) (3 . 8))
;; ((6 . 1) (4 . 2) (2 . 3) (8 . 4) (5 . 5) (7 . 6) (1 . 7) (3 . 8))
;; ((6 . 1) (4 . 2) (7 . 3) (1 . 4) (3 . 5) (5 . 6) (2 . 7) (8 . 8))
;; ((6 . 1) (4 . 2) (7 . 3) (1 . 4) (8 . 5) (2 . 6) (5 . 7) (3 . 8))
;; ((6 . 1) (8 . 2) (2 . 3) (4 . 4) (1 . 5) (7 . 6) (5 . 7) (3 . 8))
;; ((7 . 1) (1 . 2) (3 . 3) (8 . 4) (6 . 5) (4 . 6) (2 . 7) (5 . 8))
;; ((7 . 1) (2 . 2) (4 . 3) (1 . 4) (8 . 5) (5 . 6) (3 . 7) (6 . 8))
;; ((7 . 1) (2 . 2) (6 . 3) (3 . 4) (1 . 5) (4 . 6) (8 . 7) (5 . 8))
;; ((7 . 1) (3 . 2) (1 . 3) (6 . 4) (8 . 5) (5 . 6) (2 . 7) (4 . 8))
;; ((7 . 1) (3 . 2) (8 . 3) (2 . 4) (5 . 5) (1 . 6) (6 . 7) (4 . 8))
;; ((7 . 1) (4 . 2) (2 . 3) (5 . 4) (8 . 5) (1 . 6) (3 . 7) (6 . 8))
;; ((7 . 1) (4 . 2) (2 . 3) (8 . 4) (6 . 5) (1 . 6) (3 . 7) (5 . 8))
;; ((7 . 1) (5 . 2) (3 . 3) (1 . 4) (6 . 5) (8 . 6) (2 . 7) (4 . 8))
;; ((8 . 1) (2 . 2) (4 . 3) (1 . 4) (7 . 5) (5 . 6) (3 . 7) (6 . 8))
;; ((8 . 1) (2 . 2) (5 . 3) (3 . 4) (1 . 5) (7 . 6) (4 . 7) (6 . 8))
;; ((8 . 1) (3 . 2) (1 . 3) (6 . 4) (2 . 5) (5 . 6) (7 . 7) (4 . 8))
;; ((8 . 1) (4 . 2) (1 . 3) (3 . 4) (6 . 5) (2 . 6) (7 . 7) (5 . 8)))
;; Exercise 2.43 ;; Exercise 2.43
;; This is slower than the first version from the book because ;; This is slower than the first version from the book because

49
mceval/amb-8-queens.rkt Normal file
View File

@ -0,0 +1,49 @@
(define (enumerate-interval low high)
(if (> low high)
'()
(cons low (enumerate-interval (+ low 1) high))))
(define (list-ref l n)
(if (= n 0) (car l)
(list-ref (cdr l) (- n 1))))
;; Not sure how to get a procedure to create (amb 1 ... n) for
;; arbitrary n without doing quasiquote, unsplice, etc, so fix for
;; n=8.
(define (queens)
(define (position row col) (cons row col))
(define (row position) (car position))
(define (col position) (cdr position))
(define (positive-intercept position)
(- (row position) (col position)))
(define (negative-intercept position)
(+ (row position) (col position)))
(define (safe? k positions)
(if (< k 2) true
(let ((kth-position (list-ref positions (- k 1)))
(pre-kth-positions (cdr (reverse positions))))
;; If the row, positive or negative intercept of the k-th position
;; is equal to any of the first k-1 positions, then the k-th
;; position is not safe.
(if (memv (row kth-position) (map row pre-kth-positions))
false
(if (memv (positive-intercept kth-position)
(map positive-intercept pre-kth-positions))
false
(if (memv (negative-intercept kth-position)
(map negative-intercept pre-kth-positions))
false
true))))))
(define (queens-add-columns current-queens column)
(if (> column 8) current-queens
(let ((new-queens
(append current-queens
(list (position (amb 1 2 3 4 5 6 7 8) column)))))
(require (safe? column new-queens))
(queens-add-columns new-queens (+ column 1)))))
(queens-add-columns '() 1))

View File

@ -25,5 +25,11 @@
(define (map f l) (define (map f l)
(if (null? l) '() (if (null? l) '()
(cons (f (car l)) (cons (f (car l))
(map f (cdr l))))))) (map f (cdr l)))))
(define (and-map f l)
(if (null? l) true
(if (f (car l))
true
false)))))

View File

@ -163,7 +163,10 @@
(list 'cons cons) (list 'cons cons)
(list 'null? null?) (list 'null? null?)
(list 'list list) (list 'list list)
(list 'reverse reverse)
(list 'append append)
(list 'memq memq) (list 'memq memq)
(list 'memv memv)
(list 'member member) (list 'member member)
(list 'not not) (list 'not not)
(list '= =) (list '= =)