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*))))

2.41

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

n に対し 0 < i < j < k <= n という三つの数字の組のうち,

合計が s になるものをみつけたい.

問題文では,i, j, k の大小について記述されていないが,

順序が無い場合は回答重複するだけなので,省いてもよい.

まいどおなじみの accumurate の中で再帰しています.

再帰は,size を減らしていって,accumurate のループは,

決まった数値より後ろの部分で回ります.

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

;; 準備
(define nil (list))

;; 2.2.3 より (日本語版 p.66)
(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

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

;; 2.2.3 より (日本語版 p.67)
(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

;; 問題文より

;; 答え
(define (make-unique-tupple size max)
  (define (iter size n)
    (if (= size 0)
        (list nil)
        (accumulate append nil
                    (map (lambda (i)
                           (map (lambda (l)
                                  (cons i l))
                                (iter (- size 1) (+ i 1))))
                         (enumerate-interval n max)))))
  (iter size 1))

(define (find-parted-3-numbers n s)
  (filter (lambda (triple)
            (= s (+ (car triple)
                    (cadr triple)
                    (caddr triple))))
          (make-unique-tupple 3 n)))

;; 確認
(define n 10)
(define s 15)

(format #t "n = ~d" n) (newline) ; 10
(format #t "s = ~d" s) (newline) ; 15
(display (find-parted-3-numbers n s)) (newline) ; ((1 4 10) (1 5 9) (1 6 8) (2 3 10) (2 4 9) (2 5 8) (2 6 7) (3 4 8) (3 5 7) (4 5 6))
 |