2.42.scm

#lang scheme/base
(define (filter predicate sequence)
  (cond ((null? sequence) null)
        ((predicate (car sequence)) (cons (car sequence) (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))
        )
  )
(define (accumulate op initial sequence)
  (if (null? sequence) initial
      (op (car sequence) (accumulate op initial (cdr sequence)))
      )
  )
(define (flatmap proc seq)
  (accumulate append null (map proc seq))
  )
(define (enumerate-interval low high)
  (if (> low high) null (cons low (enumerate-interval (+ 1 low) high)))
  )

(define empty-board '())
(define (adjoin-position new-row k rest-of-queens)
  (cons new-row rest-of-queens)
  )

(define (safe-horizontal v rem)
  (cond ((null? rem) #t)
        (else (and (not (= v (car rem))) (safe-horizontal v (cdr rem))))
        )
  )

(define (safe-diagonal-up v rem)
  (define (s-d-util v k rem)
    (cond ((null? rem) #t)
          (else (and (not (= (+ k v) (car rem))) (s-d-util v (+ k 1) (cdr rem))))
    )
  )
  (s-d-util v 1 rem)
  )

(define (safe-diagonal-down v rem)
  (define (s-d-util v k rem)
    (cond ((null? rem) #t)
          (else (and (not (= (- v k) (car rem))) (s-d-util v (+ k 1) (cdr rem))))
    )
  )
  (s-d-util v 1 rem)
  )


(define (safe? k positions)
  (and (safe-horizontal (car positions) (cdr positions)) 
       (safe-diagonal-up (car positions) (cdr positions)) 
       (safe-diagonal-down (car positions) (cdr positions))
       )
  )
(define (queen 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))
(queen 8)