Hatena::Grouphokudaisicp

raindrop84の日記

2009-01-04

2.43

00:52

2.42の場合
queen-colsの戻り値の要素数の回数だけenumerate-intervalを実行する
2.43の場合
enumerate-intervalの戻り値の要素数の回数だけqueen-colsを実行する

2.42

00:40


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

;ボードの中の1マスの表現
(define (make-cell row col) (cons row col))
(define (get-row cell) (car cell))
(define (get-col cell) (cdr cell))
(define (same-cell? c1 c2)
  (and (= (get-row c1) (get-row c2))
       (= (get-col c1) (get-col c2))))

;ボード内のセルを操作する手続き
(define (add-cell board cell)
  (append board (list cell)))
(define (get-cell board col)
  (if (= (get-col (car board)) col)
      (car board)
      (get-cell (cdr board) col)))

;任意の集合に新しい場所の座標を連結する
(define (adjoin-position new-row k rest-of-queens)
  (add-cell rest-of-queens (make-cell new-row k)))

;空ボードの表現
(define empty-board '())

;k番目のクイーンが安全かどうか判断する
(define (safe? k positions)
  (define (safe-iter new-cell cells)
    (cond ((same-cell? (car cells) new-cell))
          ((= (get-row new-cell) (get-row (car cells))) #f)
          ((= (abs (- (get-row new-cell) (get-row (car cells))))
              (abs (- (get-col new-cell) (get-col (car cells))))) #f)
          (else (safe-iter new-cell (cdr cells)))))
  (safe-iter (get-cell positions k) positions))

;ボードを見やすい形式で出力する
(define (display-board board)
  (define (display-row cells row)
    (cond ((not (null? cells))
           (if (= (get-row (car cells)) row)
            (display "*")
            (display "."))
           (display-row (cdr cells) row))
          (else (newline))))
  (for-each (lambda (n) (display-row board n))
            (enumerate-interval 1 (length board))))

;ボードの集合を出力する
(define (display-board-all boards)
  (for-each (lambda (board) (display-board board) (newline)) boards))

2.40

00:33


(define (unique-pairs n)
  (flatmap
   (lambda (i)
     (map (lambda (j) (list i j))
          (enumerate-interval 1 (- i 1))))
   (enumerate-interval 1 n)))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum? (unique-pairs n))))