1: ;; -*- coding: euc-jp -*-
    2: ;;  Nqueen
    3: ;;  n?? ?θߤ??˸????ʤ???????????ߤĤ???;;  SHINYAMA Yusuke (euske@cl.cs.titech.ac.jp)
    4: ;;  This software is public domain.
    5: 
    6: (define (decr x) (- x 1))
    7: (define (incr x) (+ x 1))
    8: 
    9: ; rotate: ?٥??? x ??s?? ??????????define (rotate x pos)
   10:   (do ((last (decr (vector-length x)))
   11:        (x0 (vector-ref x pos))
   12:        (i pos (incr i)))
   13:       ((= i last) (vector-set! x last x0))
   14:     (vector-set! x i (vector-ref x (incr i)))))
   15: 
   16: ; rotrec: ?٥??? x ???ǤΡ??????????Ȥ߹?????func ??Ѥ???define (rotrec func x pos)
   17:   (let ((last (decr (vector-length x))))
   18:     (if (= pos last)
   19:         (func x)
   20:         (do ((i pos (incr i)))
   21:             ((< last i) #f)
   22:           (rotrec func x (incr pos))
   23:           (rotate x pos)))))
   24: 
   25: ; genpat: n?? ??פν??ѥ??????
   26: (define (genpat n)
   27:   (let ((x (make-vector n)))
   28:     (do ((i 0 (incr i)))
   29:         ((= n i) x)
   30:       (vector-set! x i i))))
   31: 
   32: ; checkqueen: ?ѥ??????????٤Ƹߤ??˸????ʤ??????????t
   33: (define (checkqueen p)
   34:   (define (loop i diag0 diag1) ; i ?ϥ????? diag0, diag1 ?ϥꥹ??    (or (zero? i)
   35:         (let* ((x (decr i))
   36:                (y (vector-ref p x))
   37:                (d0 (+ x y))
   38:                (d1 (- x y)))
   39: ;         (format #t "check: ~a (~a,~a) in ~a,~a\n" p x y diag0 diag1)
   40:           (and (not (or (memv d0 diag0)
   41:                         (memv d1 diag1)))
   42:                (loop (decr i) (cons d0 diag0) (cons d1 diag1))))))
   43:   (loop (vector-length p) '() '()))
   44: 
   45: ; nqueen: ?ᥤ??????efine (nqueen n)
   46:   (let ((result '()))
   47:     (rotrec (lambda (p) 
   48:               (if (checkqueen p)
   49:                   (set! result
   50:                         (cons (vector->list p) result))))
   51:             (genpat n) 0)
   52:     result))
   53: 
   54: ; sample
   55: ;(display (nqueen 8))(newline)(exit)
   56: 
   57: (define (main args)
   58:   (display (nqueen 8))
   59:   (newline)
   60:   0)