queens8.scm

scheme实现的八皇后问题

(define (getsub ls n)
    (if(<=  n  1)
        ls
        (getsub (cdr ls)  (- n 1) )))

(define (deletetail ls end)
         (if (= 0 end)
             '()
              ( cons (car ls) (deletetail (cdr ls) (- end 1)))
             )
    )

(define (substring ls  start end)
    (getsub (deletetail ls end) start)
)

(define split
  (let ((start 1) (n 8))
    (lambda (ls)
      (if (< n 1)
        (begin
          (set! n 8)
          (set! start 1)
          '()
         )
        (begin
          (display  (substring ls start (+ start 7)))
          (newline)
          (set! start (+ start 8))
          (set! n (- n 1))
          (split ls )
         )
      )
    )
    ))

(define (setqueen ls row index)
    (append 
      (append (deletetail ls (- (+ ( * (- row 1) 8) index) 1))
      '(Q) )
      (getsub ls (+ (+ ( * (- row 1) 8) index) 1))))

(define (setbackqueen ls row index)
    (append 
      (append (deletetail ls (- (+ ( * (- row 1) 8) index) 1))
      '(*) )
      (getsub ls (+ (+ ( * (- row 1) 8) index) 1))))

(define create64
    (let ((n 8))
      (lambda ()
    (if (< n 1)
        '()
        (begin 
          (set! n (- n 1))
        (append '(* * * * * * * * ) (create64)) ))
      )))

(define (setflag ls num)
    (append
      (append (deletetail ls (- num 1))
        '(1))
        (getsub ls (+ num 1))))

(define (setzeroflag ls num)
    (append
      (append (deletetail ls (- num 1))
        '(0))
        (getsub ls (+ num 1))))

(define (isexit list n)
    (if (not (memq  '1 (getsub (deletetail list n) n)))
        #f
        #t        
    )
    )
(define (getlist n)
    (if (<= n 0)
        '()
        (append '(0) (getlist (- n 1)))))

(define showNum
  (let ((n 1))
    (lambda ()
    (begin
    (display "Solution No.")
      (display n)
      (display ":")
      (newline)      
      (set! n (+ n 1))
      ))))

(define print-queens
           (lambda  (rows cols collist diagonallist antidiagonallist)
             (if(<= cols 8)
                (if (and 
                    (not (isexit collist cols) )
                    (not (isexit diagonallist (- (+ rows cols) 1)) )
                    (not (isexit antidiagonallist (+ (- cols rows) 8)))
                     )
                    (begin 
                      (set! queenslist  (setqueen queenslist rows cols))
                      (set! collist (setflag collist cols))
                      (set! diagonallist (setflag diagonallist (- (+ rows cols) 1)))
                      (set! antidiagonallist (setflag antidiagonallist (+ (- cols rows) 8)))
                      (
                       if (< rows 8)
                             (let ((subcols 1))
                             (print-queens (+ rows 1) subcols collist diagonallist antidiagonallist))
                              (begin
                                (showNum)
                                (split queenslist)                                   
                               )
                       )
                      (set! queenslist  (setbackqueen queenslist rows cols))
                      (set! collist (setzeroflag collist cols))
                      (set! diagonallist (setzeroflag diagonallist (- (+ rows cols) 1)))
                      (set! antidiagonallist (setzeroflag antidiagonallist (+ (- cols rows) 8)))
                      (print-queens rows (+ cols 1) collist diagonallist antidiagonallist)
                     )
                     (print-queens rows (+ cols 1) collist diagonallist antidiagonallist)
                  )
             )
    )     
  )

(define array1 (getlist 8))
(define array2 (getlist 15))
(define array3 (getlist 15))

(define queenslist (create64))

(print-queens 1 1 array1 array2 array3)