8queens.scm

八皇后的scheme

(define (queens board-size);主程序，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))))))
  (print-queens (queen-cols board-size) board-size 1))


(define empty-board ()) ;empty-board为空表


(define (safe? k positions) ;函数safe? 判断第k行摆放是否冲突
  (define (check new old)
    (or (= (car new) (car old)) ;判断同一行是否已经有皇后
        (= (cdr new) (cdr old)) ;判断同一列是否已经有皇后
        (= (abs (- (car new) (car old))) ;判断同一斜线是否已经有皇后
           (abs (- (cdr new) (cdr old))))))
  (let ((current (car positions)) (rest (cdr positions)))
    (or (= k 1)                 ;第一行可以随意摆放
        (null? (filter (lambda (new) (check new current)) rest)))))


(define (adjoin-position new-row k rest-of-queens);函数adjoin-position:把rest-of-queens追加到新位置的尾部
        (cons (cons k new-row) rest-of-queens))


(define (accumulate op initial seq);累计运算函数accumulate,用于flatmap
        (if (null? seq) 
            initial
            (op (car seq) (accumulate op initial (cdr seq)))))


(define (filter predicate sequence);函数filter:list元素过滤
  (cond ((null? sequence) ())
        ((predicate (car sequence))
         (cons (car sequence) (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))


(define (flatmap proc seq);函数flatmap
        (accumulate append  () (map proc seq)))


(define (enumerate-interval low high);函数enumerate-interval:产生list
        (if (> low high)
            ()
            (cons low (enumerate-interval (+ low 1) high))))


(define (printonerow pair board-size);函数printonerow用来输出棋盘的某一行
  (define (shownext pair board-size count)
    (cond ((= count 0) 
           (begin (display "( ") (shownext pair board-size (+ count 1))))
          ((> count board-size) 
           (display ")"))
          ((= count (cdr pair)) 
           (begin (display "Q ") (shownext pair board-size (+ count 1))))
          ((or (< count (cdr pair)) (> count (cdr pair))) 
           (begin (display "* ") (shownext pair board-size (+ count 1))))))
  (begin ( shownext pair board-size 0)
         (newline)))


(define (print-queens ls board-size count);函数print-queens在搜索结束以后输出所有解法
  (define (printOneSolu list)
    (if (not(null? list))
        (begin
          (printonerow (car list) board-size)
          (printOneSolu (cdr list)))))
  (begin 
    (if (null? ls)
        (begin;输出总解法数
          (newline)
          (display "The problem has ")
          (display (- count 1))
          (display " Solutions"))
        (begin;依次输出各解法
          (display "Solution No")
          (display count)
          (display ":")
          (newline)
          (+ count 1)
          (printOneSolu (car ls)) 
          (print-queens (cdr ls) board-size (+ count 1))))))