blob: af5b500be45ff3d4e7c29caa9d2cfb342dfa9f4a (
plain) (
tree)
|
|
;;;;
;;;; License: CC0-1.0
;;;;
(define-module (net ricketyspace sicp two fortytwo)
#:export (safe?
adjoin-position
queens))
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (enumerate-interval low high)
(if (> low high)
'()
(cons low (enumerate-interval (+ low 1) high))))
(define (flatmap proc seq)
(accumulate append '() (map proc seq)))
(define (position-row pos)
(car pos))
(define (position-col pos)
(cdr pos))
(define (abs-diff pos-a pos-b)
(cons (abs (- (position-row pos-a) (position-row pos-b)))
(abs (- (position-col pos-a) (position-col pos-b)))))
(define (safe? k positions)
(define (kth-position)
(let ((kpos (filter (lambda (pos)
(= (position-col pos) k))
positions)))
(if (not (null? kpos)) (car kpos) #f)))
(define (same-row?)
(let* ((kpos (kth-position))
(in-same-row (filter (lambda (pos)
(and (not (equal? pos kpos))
(= (position-row pos)
(position-row kpos))))
positions)))
(if (null? in-same-row) #f #t)))
(define (same-diagonal?)
(let* ((kpos (kth-position))
(in-same-diag (filter (lambda (pos)
(let ((diff (abs-diff pos kpos)))
(and (not (equal? pos kpos))
(= (car diff) (cdr diff)))))
positions)))
(if (null? in-same-diag) #f #t)))
(not (or (same-row?) (same-diagonal?))))
(define (adjoin-position new-row k rest-of-queens)
(let ((queen-at-k (cons new-row k)))
(append rest-of-queens (list queen-at-k))))
(define empty-board '())
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (safe? k positions))
(flatmap
(lambda (rest-of-queens)
(map (lambda (new-row)
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
;;;
;;; Guile REPL
;;;
;;; scheme@(guile-user)> ,use (net ricketyspace sicp two fortytwo)
;;; scheme@(guile-user)> (queens 8)
;;; $2 = (((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)))
;;; scheme@(guile-user)> (length $2)
;;; $3 = 92
;;; scheme@(guile-user)> (list-ref $2 (random 93))
;;; $4 = ((5 . 1) (2 . 2) (6 . 3) (1 . 4) (7 . 5) (4 . 6) (8 . 7) (3 . 8))
;;; scheme@(guile-user)> (list-ref $2 (random 93))
;;; $5 = ((4 . 1) (6 . 2) (1 . 3) (5 . 4) (2 . 5) (8 . 6) (3 . 7) (7 . 8))
;;; scheme@(guile-user)> (list-ref $2 (random 93))
;;; $6 = ((7 . 1) (2 . 2) (4 . 3) (1 . 4) (8 . 5) (5 . 6) (3 . 7) (6 . 8))
;;; scheme@(guile-user)> (list-ref $2 (random 93))
;;; $7 = ((6 . 1) (3 . 2) (1 . 3) (8 . 4) (5 . 5) (2 . 6) (4 . 7) (7 . 8))
;;; scheme@(guile-user)> (list-ref $2 (random 93))
;;; $8 = ((4 . 1) (8 . 2) (5 . 3) (3 . 4) (1 . 5) (7 . 6) (2 . 7) (6 . 8))
|