Sophie

Sophie

distrib > Fedora > 15 > i386 > by-pkgid > 010670e365eac4bfdf0087ea1c497c2e > files > 83

gauche-0.9.3.2-1.fc15.i686.rpm

;; -*- coding: euc-jp -*-
;;  Nqueen
;;  n¡ßn ¤Î¸ß¤¤¤Ë¸ú¤­Àþ¾å¤Ë¤Ê¤¤¥¯¥¤¡¼¥ó¤ÎÇÛÎó¤ò¤ß¤Ä¤±¤ë

;;  SHINYAMA Yusuke (euske@cl.cs.titech.ac.jp)
;;  This software is public domain.

(define (decr x) (- x 1))
(define (incr x) (+ x 1))

; rotate: ¥Ù¥¯¥¿ x ¤ò posÍ×ÁÇ ¤À¤±²óž¤µ¤»¤ë
(define (rotate x pos)
  (do ((last (decr (vector-length x)))
       (x0 (vector-ref x pos))
       (i pos (incr i)))
      ((= i last) (vector-set! x last x0))
    (vector-set! x i (vector-ref x (incr i)))))

; rotrec: ¥Ù¥¯¥¿ x ¤ÎÍ×ÁǤΡ¢¤¢¤é¤æ¤ëÇÛÃÖ¤ÎÁȤ߹ç¤ï¤»¤Ë func ¤òŬÍѤ¹¤ë
(define (rotrec func x pos)
  (let ((last (decr (vector-length x))))
    (if (= pos last)
	(func x)
	(do ((i pos (incr i)))
	    ((< last i) #f)
	  (rotrec func x (incr pos))
	  (rotate x pos)))))

; genpat: n¡ßn ¤ÎÈפνé´ü¥Ñ¥¿¡¼¥ó¤òºî¤ë
(define (genpat n)
  (let ((x (make-vector n)))
    (do ((i 0 (incr i)))
	((= n i) x)
      (vector-set! x i i))))

; checkqueen: ¥Ñ¥¿¡¼¥ó p ¤¬¤¹¤Ù¤Æ¸ß¤¤¤Ë¸ú¤­Àþ¾å¤Ë¤Ê¤¤¥¯¥¤¡¼¥ó¤Ê¤é #t
(define (checkqueen p)
  (define (loop i diag0 diag1) ; i ¤Ï¥«¥¦¥ó¥¿, diag0, diag1 ¤Ï¥ê¥¹¥È
    (or (zero? i)
	(let* ((x (decr i))
	       (y (vector-ref p x))
	       (d0 (+ x y))
	       (d1 (- x y)))
;	  (format #t "check: ~a (~a,~a) in ~a,~a\n" p x y diag0 diag1)
	  (and (not (or (memv d0 diag0)
			(memv d1 diag1)))
	       (loop (decr i) (cons d0 diag0) (cons d1 diag1))))))
  (loop (vector-length p) '() '()))

; nqueen: ¥á¥¤¥ó¥ë¡¼¥Á¥ó
(define (nqueen n)
  (let ((result '()))
    (rotrec (lambda (p) 
	      (if (checkqueen p)
		  (set! result
			(cons (vector->list p) result))))
	    (genpat n) 0)
    result))

; sample
;(display (nqueen 8))(newline)(exit)

(define (main args)
  (display (nqueen 8))
  (newline)
  0)