queens.scm

分别用面向过程、面向对象和函数式程序设计的方法解决八皇后问题。 附报告

;=============================================================
;Program : 8Queens-Problem
;Author  : Shaozhen
;Date    : 08.04.02
;Function: This program gives all the solutions to the 8Queens-
;          problem. The answer is outputed well-formed to the  
;          screen.
;=============================================================


;-----------------------------------------------------------
;queens  : main function, calculating and outputing the ans
;paras   : cnt - which column we are dealing
;          trying - position in the column we are trying
;          record - most recently path record
;          rows - whether a certain row is occupied
;          ldiag - whether a certain left-diag is occupied
;          rdiag - whether a certain right-diag is occupied
;-----------------------------------------------------------

(define ( queens cnt trying record rows ldiag rdiag )
  (begin
    ;(display record )
    ;(display cnt)
    ;(display trying)
    ;(display rows)
    ;(newline)
    ( if (= 8 cnt)
         ( if (= trying 0)
              ( queens-print record )
              empty)
         (begin   
           ( if (= 1 (able? cnt trying rows ldiag rdiag) ) 
                ( queens (+ 1 cnt) 0 
                         (setr record cnt trying)
                         (setr rows (+ 1 trying) 0)
                         (setr ldiag (+ cnt (+ 1 trying) ) 0)
                         (setr rdiag (+ (- 8 trying) cnt ) 0))
                empty)
           
           ( if (< trying 7) 
                ( queens cnt (+ 1 trying) record rows ldiag rdiag)
                empty)
           )
         
         )
    )
  )


;--------------------------------------------------------------
;queens-print, q-print : output a set of answer
;paras                 : record - where the answer is recorded
;output                : the output of the function is in form:
;
;                        Solution No . 44 :
;                        (* * * Q * * * *)
;                        (* * * * * * * Q)
;                        (Q * * * * * * *)
;                        (* * Q * * * * *)
;                        (* * * * * Q * *)
;                        (* Q * * * * * *)
;                        (* * * * * * Q *)
;                        (* * * * Q * * *)
;--------------------------------------------------------------
(define ( queens-print record)
  ( q-print record 0 -1 )
  )

(define ( q-print record i j )
  (if ( and (= i 0) (= j -1) )
      (begin
        (set! counter (+ 1 counter) )
        (display "Solution No . ")
        (display counter)
        (display " :")
        (newline)
        (q-print record 0 0)
        )
      ( if (< i 8)   
           ( cond ((= j 0)   (begin
                               (display "(")
                               (if ( isT? record i j)
                                   (display "Q") 
                                   (display "*"))
                               (q-print record i (+ 1 j) ) 
                               )
                             )
                  ((= j 7)   (begin
                               (display " ")
                               (if ( isT? record i j)
                                   (display "Q")
                                   (display "*")                        
                                   )
                               (display ")")
                               (newline)
                               (q-print record (+ 1 i) 0 ) 
                               ))
                  (else      (begin
                               (display " ")
                               (if ( isT? record i j)
                                   (display "Q")
                                   (display "*")
                                   )
                               (q-print record i (+ 1 j) )
                               ))
                  )
           (newline))
      )
  )
 
;----------------------------------------------------------
;able?   :  check for whether a queen can be put in
;paras   :  the same as main function - queens
;return  :  True / False , indicating whether it can be put
;----------------------------------------------------------

(define ( able? cnt trying rows ldiag rdiag )
  ( cond (( not ( isT? rows (+ 1 trying ) 1 )) 0 )
         (( not ( isT? ldiag (+ cnt (+ 1 trying) ) 1)) 0 )
         (( not ( isT? rdiag (+ (- 8 trying) cnt ) 1)) 0 )
         ( else 1 )
         )

  )

;---------------------------------------------------------
;setr/isT  :  set/get function for a list, to give/test a 
;             value at a certain position.
;paras     :  lst - the object list
;             n - indicating the position, indexed from 0
;             v - the value to write/compare
;---------------------------------------------------------

(define ( setr lst n v)
  ( if (> n 0)
       (cons ( car lst ) ( setr ( cdr lst ) (- n 1 ) v ) )
       (cons  v  ( cdr lst ) )
       )
  )


(define ( isT? lst n v)
  ( if (> n 0)
       ( isT? ( cdr lst ) (- n 1)  v )
       (= (car lst) v ) 
       )
  )


;----------------------------------------------------------------
;for convenient debug and run
;----------------------------------------------------------------

( define rows ( list 1 1 1 1 1 1 1 1 1))
( define record ( list 0 0 0 0 0 0 0 0 0))
( define ldiag ( list 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1))
( define rdiag ( list 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1))

;---------------------------------------------------------------
;as global for counting number
;---------------------------------------------------------------

( define counter 0 )