Petar Kapriš
2ca5e73a27
Notes: The exercise 2.37 on Hexlet's site has an error, noted in the comments. Also, their page for exercise 2.38 should probably have 0 tests. And finally, I did not calculate the exact number in the final exercise 2.43, but I included a relevant discussion.
71 lines
No EOL
2.2 KiB
Scheme
71 lines
No EOL
2.2 KiB
Scheme
#lang sicp
|
|
|
|
(define (accumulate op initial sequence)
|
|
(if (null? sequence)
|
|
initial
|
|
(op (car sequence)
|
|
(accumulate op initial (cdr sequence)))))
|
|
|
|
(define (flatmap proc seq)
|
|
(accumulate append nil (map proc seq)))
|
|
|
|
(define (filter predicate sequence)
|
|
(cond ((null? sequence) nil)
|
|
((predicate (car sequence))
|
|
(cons (car sequence)
|
|
(filter predicate (cdr sequence))))
|
|
(else (filter predicate (cdr sequence)))))
|
|
|
|
(define (enumerate-interval a b)
|
|
(if (> a b)
|
|
'()
|
|
(cons a (enumerate-interval (+ a 1) b))))
|
|
|
|
; the board will be implemented as a list, which will, in a reversed order, list
|
|
; the rows of the queens, who are sorted by columns, for example:
|
|
; (5 3 1 4) means there are four queens with coordinates:
|
|
; (1,4), (2,1), (3,3), (4,5)
|
|
; this implementation is mostly chosen because of its efficiency and ease of use
|
|
(define empty-board '())
|
|
|
|
; with this implementation, k is unnecessary
|
|
(define (adjoin-position new-row k rest-of-queens)
|
|
(cons new-row rest-of-queens))
|
|
|
|
(define (all-false lst)
|
|
(cond ((eq? lst '()) #t)
|
|
((not (car lst)) (all-false (cdr lst)))
|
|
(else #f)))
|
|
|
|
(define (diagonals-from-row row len)
|
|
(list (enumerate-interval (+ row 1) (+ row len))
|
|
(reverse (enumerate-interval (- row len) (- row 1)))))
|
|
|
|
; same here
|
|
(define (safe? k positions)
|
|
(let* ((first (car positions))
|
|
(rest (cdr positions))
|
|
(diags (diagonals-from-row first (length rest)))
|
|
(upper-diag (car diags))
|
|
(lower-diag (cadr diags))
|
|
(match-row (map (lambda (x) (= x first))
|
|
rest))
|
|
(match-diag1 (map = rest upper-diag))
|
|
(match-diag2 (map = rest lower-diag)))
|
|
(and (all-false match-row)
|
|
(all-false match-diag1)
|
|
(all-false match-diag2))))
|
|
|
|
(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)) |