きくらげ観察日記

好きなことを、適当に。

Gaucheでn-queen問題

Gaucheの練習。
任意のnに対してn-queen問題を総当りで解きます。

;; 横x, 縦yマス目の位置のクイーンを(x . y)で表す
(define (x queen) (car queen))
(define (y queen) (cdr queen))
(define (queen-at x y) (cons x y))

;; queenがqueensのうち、1つでも取れるものがあれば#t
;; 1つも取れるコマがなければ#f
(define (can-take? queen queens)
  (any (^(enemy)
         (or (= (x queen) (x enemy))
             (= (abs (- (x queen) (x enemy)))
                (abs (- (y queen) (y enemy))))))
       queens))

;; 幅がwidthの盤において、m行目におけるすべての位置を返す
(define (queens m width) (map (^(i) (queen-at i m)) (iota width 1)))

;; nクイーン問題を総当りで解く
(define (n-queen n :optional (width n))
  ;; 互いに取れないn-1-queensに対し、n行目クイーンを置いても
  ;; それぞれ互いに取れないようなコマの置き方があるのならば、それを
  ;; n-queens-listに追加したものを返す
  (define (add-queen n-queens-list n-1-queens)
    (fold-left
     (^(n-queens-list queen)
       (if (not (can-take? queen n-1-queens))
           (cons (cons queen n-1-queens) n-queens-list)
           n-queens-list))
     n-queens-list
     (queens n width)))
  (if (= n 1)
      (map (^(q) (list q)) (queens 1 width))
      (let ((valid-n-1-queens-list (n-queen (- n 1) width)))
        (fold-left add-queen '() valid-n-1-queens-list))))
gosh> (length (n-queen 8))
92

Wikipediaの8-queen問題の解の個数と一致しているので、多分あってるはずです。