八皇后问题

queen.scm

(define (range a b)
  (define (iter v current)
    (if (< v a) current
      (iter (- v 1) (cons v current))))
  (iter (- b 1) '()))


(define (accmulate f init seq)
  (if (null? seq) init
    (accmulate f (f (car seq) init) (cdr seq))))

(define (flatmap proc seq)
  (accmulate append '() (map proc seq)))

;(display (flatmap (lambda (x) (list x x)) '(1 2 3)))
;(display "\n")

(define (draw size queen-list)

  (define T1 "┌")
  (define T2 "┬")
  (define T3 "┐")
  (define T4 "├")
  (define T5 "┼")
  (define T6 "┤")
  (define T7 "└")
  (define T8 "┴")
  (define T9 "┘")
  (define T10 "───")
  (define T11 "│")
  (define EMPTY "   ")
  (define QUEEN " ▣ ")
  (define NEW_LINE "\n")

  (define row-count (+ (* size 2) 1))
  (define col-count (+ (* size 2) 1))

  (define max-row (- row-count 1))

  (define max-col (- col-count 1))

  (define (is-queen? row col)
    (let ((r (/ (- row 1) 2))
          (c (/ (- col 1) 2)))
      (not (null? (filter (lambda (item) (and (= r (car item))
                                              (= c (car (cdr item)))))
                          queen-list)))))

  (define (process row col)
    (cond ((= row 0)
           (cond ((= col 0) (display T1))
                 ((= col max-col) (display T3))
                 ((even? col) (display T2))
                 ((odd? col) (display T10))
                 (else '())))
          ((= row max-row)
           (cond ((= col 0) (display NEW_LINE) (display T7))
                 ((= col max-col) (display T9))
                 ((even? col) (display T8))
                 ((odd? col) (display T10))
                 (else '())))
          ((even? row)
           (cond ((= col 0) (display NEW_LINE) (display T4))
                 ((= col max-col) (display T6))
                 ((even? col) (display T5))
                 ((odd? col) (display T10))
                 (else '())))
          ((odd? row)
           (cond ((= col 0) (display NEW_LINE) (display T11))
                 ((= col max-col) (display T11))
                 ((even? col) (display T11))
                 ((odd? col) (if (is-queen? row col) (display QUEEN) (display EMPTY)))
                 (else '())))
          (else '())))
  (let ((row-list (range 0 row-count))
        (col-list (range 0 col-count)))
    (map (lambda (row) 
           (map (lambda (col) (process row col)) col-list)) row-list)))

;(draw 17 17 (list '(0 5) '(1 2) '(2 0) '(3 6) '(4 4) '(5 7) '(6 1) '(7 3)))

(define (cross-hit? point queen)
  (define (sum p) (+ (car p) (cadr p)))
  (define (sub p) (- (car p) (cadr p)))
  (or (= (sum point) (sum queen)) (= (sub point) (sub queen))))

(define (queen size)
  (define row-list (range 0 size))
  (define (safe? p group)
    (define (iter g)
      (define now (if (null? g) '() (car g)))
      (cond ((null? g) #t)
            ((= (car p) (car now)) #f)
            ((= (car (cdr p)) (car (cdr now))) #f)
            ((cross-hit? p now) #f)
            (else (iter (cdr g)))))
    (iter group))
  (define (iter-col c current)
    (cond ((= c size) (filter (lambda (group) (= (length group) size)) current))
          (else
            (iter-col (+ 1 c)
                      (flatmap
                        (lambda (x) x)
                        (map (lambda (r)
                               (if (null? current) (list (list (list r c)))
                                 (map (lambda (group)
                                        (if (safe? (list r c) group)
                                          (cons (list r c) group)
                                          group))
                                      current))) row-list))))))
  (iter-col 0 '()))

(define L 4)
(map (lambda (group)  (display "\n") (draw L group)) (queen L))