queens.scm

scheme实现的把皇后问题解法。输出为矩阵形式

;*******************************************************************************************************
;程序名称：程序设计语言大作业--Scheme语言的八皇后问题
;程序内容：八皇后
;作者：张宏基 051221136
;日期：2008年4月1号
;*******************************************************************************************************

;----------------------------------------------------------------------------------------------------------------------------------------------------------
;----------------------------------------------------------------------------------------------------------------------------------------------------------
;要用到的一般函数
(define (filter predicate sequence)                           ;定义函数filter
  (cond ((null? sequence) '())
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

(define map (lambda (p ls)                                    ;定义函数map
              (if (null? ls)
                  '()
                   (cons (p (car ls)) (map p (cdr ls))))))

(define (flat-map op seqs)                                    ;定义函数flat-map
  (accumulate append () (map op seqs)))

(define (accumulate op initial sequence)                      ;定义函数accumlate
  (if (null? sequence)
      initial
      (op (car sequence)
      (accumulate op initial (cdr sequence)))))

(define (enumerate-interval low high)                         ;定义函数enumerate-interval
  (if (> low high)
      '()
      (cons low
        (enumerate-interval (+ low 1) high))))

(define (length items)                                        ;定义函数length       
  (if (null? items)
      0
      (+ 1 (length (cdr items)))))
;----------------------------------------------------------------------------------------------------------------------------------------------------------
;----------------------------------------------------------------------------------------------------------------------------------------------------------
;本次问题的相关函数
;(一)
;求解部分，结果由(queen-equ board-size)返回，其数据结构描述为：第i个元素带表第i个可能结果，每个元素的第j成员，代表这个可能结果中，第j行皇后的位置。

;check
;判断first与second两个皇后的位置是否冲突
;
(define (check first second)                                     ;用于判断冲突;
  (or (= (car first) (car second))                               ;表明两个皇后在同一列上
    (= (abs (- (car first) (car second)))
      (abs (- (cadr first) (cadr second))))))                    ;表明两个皇后在同一斜线上

;safe?
;判断k行是否与其他已经确定的皇后的位置冲突
;
(define (safe? k positions)                                   ;判断该次放皇后的地方是否与其他以放好的皇后产生冲突
  (let ((current (car positions))                             ;current 取(car positions)
    (rest (cdr positions)))                                   ;rest 取(cdr positions)
    (or (= k 1)                                               ;第一行则不需要判断，肯定安全
    (null? (filter (lambda (first) (check first current)) rest)))))  ;rest中存放已放好皇后的信息，current中是当前皇后的位置。（check first 
                                                                     ;current）成立，则产生冲突，这个产生“冲突”的rest元素，被放入filter结果的表中。
                                                                     ;所以若filter的结果为空，则没有“冲突”产生
;add-position
;将某行的安全列加入到结果中
;
(define (add-position new-row k rest-of-queens)             
  (cons (list new-row k) rest-of-queens))                   ;rest-of-queens的元素数据结构是（new-row k），分别对应“列”和“行”

;queens-equ
;核心函数
;用递归的方法对所有可能的情况进行判断，并将正确皇后分布保存
(define (queens-equ board-size)
  (define (queen-cols k)                                    ;参数k
    (if (= k 0)
        (list '())                                          ;八行都已经都放好的
        (filter
         (lambda (positions) (safe? k positions))           ;过滤掉不安全的位置
         (flat-map 
          (lambda (rest-of-queens)
            (map (lambda (new-row)                            ;map把k行中每一列的位置都带入rest-of-queens中
                   (add-position new-row k rest-of-queens))   
                 (enumerate-interval 1 board-size)))         
          (queen-cols (- k 1))))))                            ;该行放好后,递归调用下一行;
  (queen-cols board-size))

;----------------------------------------------------------------------------------------------------------------------------------------------------------
;(二)
;输出部分

;outputmember
;输出一行皇后的位置
;根据(car line)的值输出一行皇后的位置
(define (outputmember line)                                     
          (cond ((= 1 (car line)) (begin (display "(Q * * * * * * *)") (newline)))
                ((= 2 (car line)) (begin (display "(* Q * * * * * *)") (newline)))
                ((= 3 (car line)) (begin (display "(* * Q * * * * *)") (newline)))
                ((= 4 (car line)) (begin (display "(* * * Q * * * *)") (newline)))
                ((= 5 (car line)) (begin (display "(* * * * Q * * *)") (newline)))
                ((= 6 (car line)) (begin (display "(* * * * * Q * *)") (newline)))
                ((= 7 (car line)) (begin (display "(* * * * * * Q *)") (newline)))
                ((= 8 (car line)) (begin (display "(* * * * * * * Q)") (newline)))
                 ))
;showtop
;输出之中可能情况的标号
;
(define(showtop k)                                   ;输出每一种结果前的标签
  (begin (display "Number: ")(display k) (newline))) ;k代表第几种正确结果
 
(define(outputf member)                              ;用于输出一种正确结果
  (cond((null? member)  (newline))                   ;onerestult的数据结构如下：
        ( else(outputmember (car member))            ; 第i个元素为j，代表第i行的皇后在第j列
              (outputf (cdr member)))))

;putf
;输出restlt中保存的所有结果
;
(define(putf result)                                 ;用于输出所有正确结果，result中的一个元素为一种正确结果
  (cond((null? result) (newline))
       (else (showtop (- 93 (length result))) (outputf (car result)) (putf (cdr result)))))

;queens
;主程序
;参数board—size表示棋盘大小，亦即皇后个数
(define (queens board-size)                          
  (putf (queens-equ board-size)))