Hatena::Groupcsnagoya-sicp

クラなんとかの日記 このページをアンテナに追加 RSSフィード

 | 

2009-07-05このニコタマが好きだから

2.42

| 2.42 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.42 - クラなんとかの日記 2.42 - クラなんとかの日記 のブックマークコメント

エイトクイーンパズルです.

日本語訳版を忘れたので,拙訳

エイトクイーンパズルは,チェス盤に
どのクイーンも互いに取られないような
8つのクイーンの置き方を答えるものです.
(例えば,2つのクイーンは同じ縦,横,斜めの線上に無いということです)
1つの解を,図2.8 に示します.
パズルを解く1つの方法は,盤上に順番に,
各列それぞれにクイーンを置くことです.
k-1個のクイーンを一旦置ければ,
k 番目のクイーンが,盤上に既に置かれたクイーンのどれにもチェックされない,
場所に置かれなければなりません.
このアプローチを,再帰的に形式化することができる.
k-1列の盤上に,k-1個のクイーンが置かれる,全ての可能な組み合わせが生成されていると仮定する.
それらの組み合わせそれぞれに対して,k番目の列の全行にクイーンを置いた拡張された集合を生成する.
それをフィルターし,他のクイーンと干渉しない安全な行にクイーンを置いたものだけ残す.
これで,k列にk 個のクイーンが置かれた全組み合わせを生成する.
この手続きを繰り返すことによって,1つだけでなく,全てのパズルの解を得られる.

この解法をqueens という手続きで実装する.
これは,n x nのチェス盤にn個のクイーンを置く問題への全ての解の列を返す.
queens は,queens-cols という盤上の先頭k column 分のクイーンの位置の全
部の場合のシーケンスを返す内部手続きを持つ.

この手続きの中で,rest-of-queens は,先頭のk-1列の中のk-1個のクイーン
の位置の1つの状態であり,
new-row は,k番目のcolumn に対する,queen の位置の1つの提案を差す.
盤の位置の集合を表現と,
位置集合に新しいrow-column を追加する adjoin-position,
位置集合が空である場合の表現 empty-board 手続き
を実装することで,このプログラムを完成させなさい.
それには,k 番目のcolumn の中のクイーンが,他のものと干渉していないか
どうかを,位置集合が決定するsafe? 手続きも書かなければならない,
(ここで,新しいクイーンのみをsafe であることをチェックすればよいことを
注釈する.残りのクイーンは,既に保証されている)

# row - 行, column - 列

方針としては,再帰的に n x (k-1) から n x k の盤を作るというもの.

こうすれば,k 行目のクイーン1つだけをチェックすればよくなる.

queens は,全解を得るための関数.

queen-cols は,n x k の盤のうち許されるものを返す.

埋める関数は,以下.

  • adjoin-position
  • empty-board
  • safe?
(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

ということで,ポジションのxy座標をリストにして持つ感じの実装してみた.

nth みたいなのを使うとアレかもしれん.

#!/usr/bin/env gosh
;;; -*- coding: utf-8-unix; -*-

(define nil (list))

;;; en p120
(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

;;; en p125
(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))

;;; jp p66
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

;;; jp p66
(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

;;; answer
(define empty-board nil)

;;; answer
(define (adjoin-position new-row col rest-of-queens)
  (cons (cons new-row col) rest-of-queens))

(define (queen-x queen)
  (car queen))
(define (queen-y queen)
  (cdr queen))

;;; answer
(define (safe? col positions)
  (define (diagonal a b)
    (let ((ax (queen-x a))
          (ay (queen-y a))
          (bx (queen-x b))
          (by (queen-y b)))
      (= (abs (- ax bx))
         (abs (- ay by)))))
  (let ((last-queen (car positions))
        (rest-of-queens (cdr positions)))
    (cond ((null? rest-of-queens)
           #t)
          (else
           (let ((x (queen-x last-queen))
                 (y (queen-y last-queen)))
             (null? (filter
                     (lambda (pos)
                       (cond ((= x (queen-x pos)) ; x
                              #t)
                             ((= y (queen-y pos)) ; y
                              #t)
                             ((diagonal last-queen pos) ; diagnal
                              #t)
                             (else
                              #f))) ; ok
                     rest-of-queens)))))))

;;; from question
(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

;;; for print
(define (print-queens positions)
  (let ((size (length positions)))
    (for-each
     (lambda (i)
       (display "|")
       (for-each
        (lambda (j)
          (display
           (if (null?
                (filter
                 (lambda (pos)
                   (cond ((and (= i (queen-x pos))
                               (= j (queen-y pos)))
                             #t)
                         (else
                          #f)))
                 positions))
               " " "*"))
          (display "|"))
        (enumerate-interval 1 size))
       (newline))
     (enumerate-interval 1 size))))

(for-each (lambda (x)
            (print-queens x)
            (newline))
          (queens (string->number (car *argv*))))

 |