「lisp勉強３日目ペグソリティア」の編集履歴（バックアップ）一覧に戻る
lisp勉強３日目ペグソリティア - (2012/08/03 (金) 17:38:48) のソース
http://www.geocities.jp/m_hiroi/xyzzy_lisp/abclisp20.html
リンク先練習問題のコードを追ってみた。
私は参考にするサイトを間違えてるのだろうか？
リンク先サイトはアルゴリズムが余り賢くないような気がしてならない。
もっと賢い方法だろうと決めてかかって読んだために、実際のアルゴリズムが思ったよりも賢くなかったので中々読解できなかった、、、
なぜ単純な記述で済むところを読み解くのが難しくなる再帰を使うのだろうか？
(defvar *jump-table* #(((2 . 5) (3 . 7)) ; 0
((3 . 6) (4 . 8)) ; 1
((3 . 4) (6 . 10)) ; 2
((6 . 9) (7 . 11)) ; 3
((3 . 2) (7 . 10)) ; 4
((2 . 0) (6 . 7)) ; 5
((3 . 1) (7 . 8)) ; 6
((3 . 0) (6 . 5)) ; 7
((4 . 1) (7 . 6)) ; 8
((6 . 3) (10 . 11)) ; 9
((6 . 2) (7 . 4)) ; 10
((7 . 3) (10 . 9)))) ; 11
*jump-table*
#(((2 . 5) (3 . 7)) ((3 . 6) (4 . 8)) ((3 . 4) (6 . 10)) ((6 . 9) (7 . 11)) ((3 . 2) (7 . 10)) ((2 . 0) (6 . 7)) ((3 . 1) (7 . 8)) ((3 . 0) (6 . 5)) ((4 . 1) (7 . 6)) ((6 . 3) (10 . 11)) ((6 . 2) (7 . 4)) ((7 . 3) (10 . 9)))
(defun get-move-pattern (board)
(let (result del to);変数３つ宣言
(dotimes (from 12 result);fromに0～11までいれて移動結果を試しresultで返す
(when (nth from board);from番目のマスにペグがあった
(dolist (pos (aref *jump-table* from));jump-table配列のfrom番目の可能な移動先を全部試す
(setq del (car pos);真中
to (cdr pos));移動先
(if (and (nth del board) (not (nth to board)));移動ができる
(push (list from del to) result)))))));リサルトに(from del to)のリストを①要素として追加する
get-move-pattern
(defvar test '(t nil t nil nil nil t t nil t nil nil))
test
(get-move-pattern test)
((9 6 3) (7 6 5) (6 7 8) (2 6 10) (0 2 5))
(defun move-peg (n board pattern)
(if board;boarが空でないなら
(cons (if (member n pattern);pattern(1 2 3)のように移動前 真中 移動先が格納されてるのでどれか一つヒットしないか試す、なにか頭悪くないかこの処理？
(not (car board));移動前と真中はペグがあるので空になり、移動先のペグが立つ、これはget-move-patternで保障される
(car board));移動と関係なかったのでそのまま
(move-peg (1+ n) (cdr board) pattern))));boardを一つ消去して次へ、何か頭が悪い処理のように思えてならない
move-peg
(defun solve-id (n jc limit board history)
(when (<= jc limit)
(if (= n 10)
(print-answer (reverse history));1手に一つずつ消えるので１０手目で終了
(dolist (pattern (get-move-pattern board));試せる次の一手を全て試す
(solve-id (1+ n)
(if (eql (third (car history)) (first pattern));前と同じペグを移動に使ったら手数を同じままにする
jc
(1+ jc))
limit
(move-peg 0 board pattern);この再帰関数実は一手しか処理してないというまぎらわしさ、一手進めたぶんだけかえってくる、
(cons pattern history))))));solve-idここまで
solve-id
(defun print-answer (history)
(let ((prev (third (car history))))
(format t "[~D,~D" (first (car history)) prev)
(dolist (pos (cdr history))
(cond ((= prev (first pos))
(setq prev (third pos))
(format t ",~D" prev));同じペグの連続移動
(t
(setq prev (third pos))
(format t "][~D, ~D" (first pos) prev))));ペグが変わった
(format t "]~%")
(incf *count*)))
print-answer
(defun solve-per12 (pos)
(let ((board (make-list 12 :initial-element t)))
(setf (nth pos board) nil
*count* 0)
(dotimes (x 10)
(format t "------~D 手を検索-------~%" (1+ x))
(solve-id 0 0 (1+ x) board nil);１手ずつ増やしながら探索
(if (plusp *count*) (return)))))
(solve-per12 0)
------1 手を検索-------
------2 手を検索-------
------3 手を検索-------
------4 手を検索-------
------5 手を検索-------
------6 手を検索-------
------7 手を検索-------
[7,0][9, 3][0, 7][8, 6][11, 9,3][5, 0,7][1, 8,6]
[7,0][5, 7][11, 3][1, 6][0, 5,7][9, 11,3][8, 1,6]
[5,0][10, 2][1, 6][11, 3][0, 5,7][8, 1,6][9, 3,11]
[5,0][10, 2][1, 6][9, 3][8, 1,6][11, 3][0, 7,5,0]
[5,0][10, 2][1, 6][9, 3][8, 1,6][11, 3][0, 5,7,0]
[5,0][4, 2][9, 3][8, 6][0, 5,7][1, 6][11, 9,3,11]
[5,0][4, 2][9, 3][8, 6][0, 5,7][1, 6][11, 3,9,11]
[5,0][4, 2][9, 3][1, 6][11, 9,3][8, 6][0, 7,5,0]
[5,0][4, 2][9, 3][1, 6][11, 9,3][8, 6][0, 5,7,0]
nil
