Hena Hena Nikki ～悔い倒れの日々～(2005-05-13)

2005.05.13 / Friday [長年日記]

* [computer/update] Ruby ver.1.8.3 preview1

“object-oriented programming”を意識して作られた interpreted scripting language。所謂人柱版。

* [computer/update] Mozilla Firefox 1.0.4 日本語版

標準的な選択肢になりつつある multi platform な web browser, Firefox の日本語版。約 1 ヶ月ぶりの version up。

* [computer/update] Becky! Internet Mail ver.2.21.00

Windows 定番の message user agent。約 1 ヶ月ぶりの version up。

* [computer] いつまでもプログラミングを楽しむために

各所より。ふむ…。

* [computer/update] まめ File 4 ver.4.20

高機能な Windows 向け filer。約 2 ヶ月ぶりの version up。

* [computer] 再帰のお勉強をやってみる (8 クイーン: 効き筋のチェック)

“クイーンを左端に置いてみよう”と“クイーンを 8 個置いてみよう”は後回し (やらないかも)。

(defsubst ys:8queen-exist-piece (x y)
  "指定した位置に、既にクイーンが置いてあるか否か"
  (nth (+ x (* y ys:8queen-board-width)) ys:8queen-board-data))

(defun ys:8queen-exist-getable-pieces (x y)
  "指定した位置にクイーンがある場合、他のクイーンを取ることが可能か否か"
  (let ((i 0) j exist)
    ;; 横方向
    (while (and (not exist) (< i ys:8queen-board-width))
      (when (and (ys:8queen-exist-piece i y) (not (= i x)))
        (setq exist t))
      (setq i (1+ i)))
    ;; 縦方向
    (setq i 0)
    (while (and (not exist) (< i ys:8queen-board-height))
      (when (and (ys:8queen-exist-piece x i) (not (= i y)))
        (setq exist t))
      (setq i (1+ i)))
    ;; 右肩下り方向
    (setq i 0
          j (- y x))
    (while (and (not exist)
                (< i ys:8queen-board-width)
                (< j ys:8queen-board-height))
      (when (and (<= 0 j) (ys:8queen-exist-piece i j)
                 (not (and (= i x) (= j y))))
        (setq exist t))
      (setq i (1+ i)
            j (1+ j)))
    ;; 右肩上がり方向
    (setq i 0
          j (+ y x))
    (while (and (not exist)
                (< i ys:8queen-board-width)
                (<= 0 j))
      (when (and (< j ys:8queen-board-height)
                 (ys:8queen-exist-piece i j)
                 (not (and (= i x) (= j y))))
        (setq exist t))
      (setq i (1+ i)
            j (1- j)))
    exist))

(defun ys:8queen-display-board ()
  "チェス盤を表示する"
  (let ((buf (get-buffer-create " *8queen-board*"))
        (x 0) (width (1- ys:8queen-board-width))
        (y 0) (height (1- ys:8queen-board-height)))
    (save-excursion
      (set-buffer buf)
      (erase-buffer)
      ;; 上端
      (insert "┏")
      (while (< x width)
        (insert "━┳")
        (setq x (1+ x)))
      (insert "━┓\n")
      ;; 中
      (while (< y height)
        (setq x 0
              width ys:8queen-board-width)
        (insert "┃")
        (while (< x width)
          (if (ys:8queen-exist-piece x y)
              (insert "●")
            (insert "  "))
          (insert "┃")
          (setq x (1+ x)))
        (insert "\n┣")
        (setq x 0
              width (1- ys:8queen-board-width))
        (while (< x width)
          (insert "━╋")
          (setq x (1+ x)))
        (insert "━┫\n")
        (setq y (1+ y)))
      ;; 下端
      (setq x 0
            width ys:8queen-board-width)
      (insert "┃")
      (while (< x width)
        (if (ys:8queen-exist-piece x y)
            (insert "●")
          (insert "  "))
        (insert "┃")
        (setq x (1+ x)))
      (insert "\n┗")
      (setq x 0
            width (1- ys:8queen-board-width))
      (while (< x width)
        (insert "━┻")
        (setq x (1+ x)))
      (insert "━┛\n"))
    (display-buffer buf)))

(let ((x 0) (y 0) pieces)
  (while (< y ys:8queen-board-height)
    (while (< x ys:8queen-board-width)
      (setq pieces 0)
      (ys:8queen-init-board)
      (ys:8queen-put-queen x y)
      (let (i (j 0))
        (while (< j ys:8queen-board-height)
          (setq i 0)
          (while (< i ys:8queen-board-width)
            (unless (ys:8queen-exist-getable-pieces i j)
              (ys:8queen-put-queen i j)
              (setq pieces (1+ pieces)))
            (setq i (1+ i)))
          (setq j (1+ j))))
      (when (<= 7 pieces)
        (ys:8queen-display-board)
        (sit-for 1))
      (setq x (1+ x)))
    (setq x 0
          y (1+ y))))

いちおううまく動いているかな? 汚いけど…。 orz

続きはまた今度。