eightqueens.scm

用 Scheme 来解决八皇后问题。八皇后问题：在 8*8 的棋盘上放置彼此不受攻击的 8 个皇后。按照国际象棋的规 则皇 后可以攻击与之处在同一行或同一列或同意斜线上的棋子。找出所有合法的 使8 个

;实现scheme的基本结构函数filter ,flatmap,accumulate,enumerate-interval
;
;filter函数功能：将表中满足predicate函数的元素留下，返回这些元素组成的新的表
(define (filter predicate sequence) 
  (cond ((null? sequence) '())       
  ((predicate (car sequence))        
   (cons (car sequence)          
         (filter predicate (cdr sequence))))  
  (else (filter predicate (cdr sequence)))))

;flatmap 实现
(define (flatmap proc seq)  
  (accumulate append '() (map proc seq)))

;accumulate 实现
(define (accumulate op initial sequence) 
  (if (null? sequence)      
      initial      
      (op (car sequence) (accumulate op initial (cdr sequence)))))


;enumerate-interval 实现
(define (enumerate-interval low high)  
  (if (> low high)      '()     
      (cons low (enumerate-interval (+ low 1) high))))

;实验要求给定的程序框架
(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))


;以下为需要自己实现的程序框架中的empty-board，
;adjoin-position new-row k rest-of-queens,
;safe? k positions

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

;前k-1个皇后在1-（k-1）列无冲突的安排无问题后，将第k个皇后放于棋盘第k列的第new-row行
(define (adjoin-position new-row k rest-of-queens)
  (cons (cons new-row k) rest-of-queens ))


;第k个皇后在棋盘的位置是否会与其他k-1个皇后产生冲突时（即不与前k-1中的任何一个处于同一行或同一列或同一对角线上）
(define (safe? k positions) 
  (define qk (car positions))  
  (define ret 
    (map (lambda (w)(if(not (or                
                             (= (+ (car qk)(cdr qk)) (+ (car w)(cdr w)))                      
                             (= (-(car qk)(cdr qk)) (-(car w)(cdr w)))                      
                             (= (car qk)(car w))          
                             (= (cdr qk)(cdr w)))) 0 1)) 
         (cdr positions))) 
  (= (accumulate + 0 ret) 0))         


;Queen 为保存所有合法的八皇后放置的解的表。表中每一项都是一个合法的放置，
;形式如下((4 . 8) (2 . 7) (7 . 6) (3 . 5) (6 . 4) (8 . 3) (5 . 2) (1 . 1))
;每一项由八个点对组成，且点对的cdr 为从8递减到1，（i.j）表示第j个皇后放置与第j列的第i行

(define Queen (queens 8)  )



;(define len ( length (queens 8)))

;插入排序的实现，lsbegin 为输入表，lsend为lsbegin的点对元素的car 从小到大排列的结果
(define (insert lsend lsbegin )
  ( let((cark (car lsbegin )))
     (let ((large ( filter (lambda(ele) ( let( (x (car ele ))(k (car cark )))
                                        (if(> x k) #t
                                           #f)
                                             )) lsend))(small (filter (lambda (ele)(let ((y (car ele))(z (car cark)))(if(<= y z)#t
                                                                                                                          #f)))lsend)))
       (append  small (cons cark large))))
  )

;将lsbegin的第一个元素插入到lsend表中，且lsend在操作前后都是排好序的
(define (insertsort lsend lsbegin)
  (if(null? lsbegin) lsend
     (insertsort (insert lsend lsbegin) (cdr lsbegin) )
   ))

;打印八皇后问题的解根据（queens board-size）生成的排列方式的表，oktimes用于计数当前打印的第几个合法放置
(define (print-queens queens oktimes)
  (if(null? queens)
     (begin
     (newline)
     (display 'There\ are\ )
     (display oktimes)
     (display '\ Solutions))
      (begin (set! oktimes(+ 1 oktimes))
              (display '\ Solution\ No.\ )
              (display oktimes)
              (newline)
              (disprowQ  (car queens ));
              (print-queens (cdr queens) oktimes))
             ))
  

;打印rowlist存储的八皇后的合法放置
;rowlist中为Queen 表中的一个元素
;rowlsit 由八个点对组成,且点对的cdr 为从8递减到1,(i.j)表示第j个皇后放置与第j列的第i行
(define (disprowQ rowlist )
  ( let ((row (insertsort '() rowlist)))
     ( dispL row 0 0)
     ))


;打印list存储的八皇后的合法放置
;list为使用insertsort方法对rowlist排序得到的结果表
;list中的表表项为形如(i,j)的点对,表示第i个皇后放置在第i行的第j列
(define (dispL list i j)
   ;显示八个皇后放置的矩阵,i,j为循环条件,表示第i行第j列
  (begin
 
       (if(= i 8) (newline)) ;如果八行显示完,换行
          
         (if (< i 8)    (disprow list i 0))))
         ;如果没显示完八行,继续显示每一行  
(define (disprow list i j)
     ;显示第i行,j表示列
        (if ( = j (+ 1 8)) '() 
           (begin
            (if (>= j 8)  
                (begin
                  (display '\))
                  (newline)
                  (dispL list (+ 1 i) 0)))
             (if (= j 0)
                 (display '\(\ ))
            (if(< j (-(cdr (list-ref list i)) 1))
               (display '*\ ))
             (if(= j (-(cdr (list-ref list i)) 1))
                (display 'Q\ ))
              (if(> j (-(cdr (list-ref list i)) 1))
                 (if (< j 8)
                   (display '*\ )))
             (disprow list i (+ 1 j));继续显示该行的下一个符号
             )))

Queen   ;显示queens board-size 产生结果表

(print-queens Queen 0);打印所有的合法皇后放置