「lisp勉強１２日目パズルフリップ・イット・スターを解く」の編集履歴（バックアップ）一覧に戻る
http://www.geocities.jp/m_hiroi/xyzzy_lisp/abclisp27.html
リンク先サイトのＬｉｓpによる簡易エキスパートシステムがうまく動く理由がまだよくわからないので寄り道のほうを勉強。
フリップ・イット・スターというパズルを解くコードの読解。
どれも探索の問題でバリエーションに乏しいし他人のコードを読解してるだけでは自分でコードが書けるようになるとは思えない。
自分でコードを組めるようになるにはここから先どう勉強すれば良いのだろうか？
リンク先の簡易エキスパートシステムを勉強し終えた後どうやってＬｉｓｐの勉強の続きを継続すれば良いのかも考えておかないと。
(setq *line*
#2A((0 2 5 7) ; 0
(0 3 6 10) ; 1
(7 8 9 10) ; 2
(1 2 3 4) ; 3
(1 5 8 11) ; 4
(4 6 9 11))) ; 5；コマを裏返す時に使う直線の定義
#2A((0 2 5 7) (0 3 6 10) (7 8 9 10) (1 2 3 4) (1 5 8 11) (4 6 9 11))
(setq *move-pattern-table*
#((0 5 0 7 1 6 1 10) ; 0
(3 3 3 4 4 8 4 11) ; 1
(0 7 3 4) ; 2
(1 10 3 1) ; 3
(3 1 3 2 5 9 5 11) ; 4
(0 0 4 11) ; 5
(1 0 5 11) ; 6
(0 0 0 2 2 9 2 10) ; 7
(2 10 4 1) ; 8
(2 7 5 4) ; 9
(1 0 1 3 2 7 2 8) ; 10
(4 1 4 5 5 4 5 6))) ; 11;11番マスが空きマスの時直線4上の点１を動かせる、直線4上の5を動かせる、、、
#((0 5 0 7 1 6 1 10) (3 3 3 4 4 8 4 11) (0 7 3 4) (1 10 3 1) (3 1 3 2 5 9 5 11) (0 0 4 11) (1 0 5 11) (0 0 0 2 2 9 2 10) (2 10 4 1) (2 7 5 4) (1 0 1 3 2 7 2 8) (4 1 4 5 5 4 5 6))
(defun move-piece (board line p1 p2)
(psetf (nth p1 board) (nth p2 board);boardの２か所をスワップする
(nth p2 board) (nth p1 board));スワップ関数に近い処理
(if (< p2 p1) (psetf p1 p2 p2 p1));順番のチェック
(dotimes (x 4 board)
(let ((p3 (aref *line* line x)));lineとｘは2次元配列の添え字
(if (< p1 p3 p2);p1とp2に挟まれた点p3なら
(setf (nth p3 board)
(if (eq 'B (nth p3 board)) 'W 'B))))));BかWをboard[p3]にセットする
move-piece
(defun get-lower-value (board)
(let ((value 0))
(dolist (x '(0 1 4 7 10 11) (* value 2))
(if (eq 'B (nth x board)) (incf value)))));隅の'Bの数を数え最後に２倍して返す
get-lower-value
(defun print-board (board)
(apply #'format
t
" ~S~% ~S ~S ~S ~S~% ~S ~S~% ~S ~S ~S ~S~% ~S~%~%"
board));ボードの処理
print-board
(defun print-answer (n board history)
(when history
(apply #'move-piece board (car history));逆回しでヒストリーを実行して盤面がスタートへ帰る car historyは３つの要素を返す
(print-answer (1- n) board (cdr history))
(apply #'move-piece board (car history)));スタート盤面から一手ずつ手前から実行、Ｃ++だったら考えられない不思議処理
(format t "------~D手------~%" n)
(print-board board))
print-answer
(defun solve-id (n limit space board history)
(if (= n limit)
(when (zerop (count 'B board));Bのコマが一つも残ってない
(print-answer n board history);答えの表示
(throw 'find-answer t));
(let ((pattern (aref *move-pattern-table* space)) line pos);pattern line pos 3つの変数が定義された
(while pattern;patternをpopして一つずつ試していく
(setq line (pop pattern) pos (pop pattern));直線番号と点番号を取り出す
(when (or (not (eql (first (car history)) line));一手前に戻る手になってないなら
(not (eql (second (car history)) pos)))
(move-piece board line space pos);コマを移動する
(if (<= (+ n 1 (get-lower-value board)) limit);下限枝刈
(solve-id (1+ n);枝刈を生き残ったので自分を再帰呼び出しして次の手へ進む
limit
pos;次の点番号
board;状態が
(cons (list line space pos) history)))
(move-piece board line space pos))))));コマの移動を元に戻してループの続きを実行
solve-id
(defun solve-flip-star (pos)
(let ((board (make-list 12 :initial-element 'B)));盤面の初期化
(setf (nth pos board) 'S);スペースの設定
(catch 'find-answer
(do ((limit (get-lower-value board) (1+ limit)))
((> limit 24))
(format t "-----~D 手を探索-----~%" limit)
(solve-id 0 limit pos board nil)))));探索開始
http://www.geocities.jp/m_hiroi/xyzzy_lisp/abclisp28.html
一時間ほどかけて蛙跳びゲームを解くコードを横目にみながらサイト通り打ち込む。
コメントをつけて自分なりに読解してみた。
これも探索の問題で余り芸がない。
ほぼリンク先サイトとほんの少しでの掲示板での質問だけでLispの勉強をしてるのだが、リンク先サイトでまだ勉強してないのが簡易エキスパートシステムだけになってしまった。
簡易エキスパートシステムのコードがどんな適法なデータが来ても動く理由を理解するのが難しい。
(setq *neighbor*
#((2) ; 0
(2 4) ; 1
(0 1 5) ; 2
(4) ; 3
(1 3 5) ; 4
(2 4 6 8) ; 5
(5 7 9) ; 6
(6) ; 7
(5 9 10) ; 8
(6 8) ; 9
(8))) ; 10 ;石を跳びこさずに一ますだけ移動する場合の移動可能な方向のリスト
#((2) (2 4) (0 1 5) (4) (1 3 5) (2 4 6 8) (5 7 9) (6) (5 9 10) (6 8) (8))
(setq *jump-table*
#(((5 . 2)) ; 0
nil ; 1
((8 . 5)) ; 2
((5 . 4)) ; 3
((6 . 5)) ; 4
((0 . 2) (3 . 4) (7 . 6) (10 . 8)) ; 5 マス5が開いてた場合、(移動するコマのあるマス、跳びこされるコマのあるマス)でルールを定義
((4 . 5)) ; 6
((5 . 6)) ; 7
((2 . 5)) ; 8
nil ; 9
((5 . 8)))) ; 10
(defun move-stone (board space pos)
(let ((new-board (copy-list board)));石を一つだけ動かす処理
(setf (nth space new-board) (nth pos new-board);スペースに石を移動
(nth pos new-board) 'S);石のあったマスをスペースに変更
(cons pos new-board)));スペースになった場所の情報をboardの先頭に保管
move-stone
(defun move-p (board from to)
(or (and (eq (nth from board) 'B) (< from to));白石なら左か上にのみ移動可能
(and (eq (nth from board) 'W) (< to from))));黒石なら右か下のみに移動可能
move-p
(defun make-new-board (board space)
(let (result from pos)
(dolist (x (aref *jump-table* space));空いてるマスに移動できるマスと跳びこされるマスの一覧を取得
(setq from (car x);移動するコマのあるマス
pos (cdr x));跳びこされるコマのあるマス
(when (move-p board from space);白石か黒石の移動可能方向を満たしているか
(unless (eq (nth from board) (nth pos board));違う色の石しか跳びこせないという条件を満たしているか
(push (move-stone board space from) result))));石を動かして新しい盤面を作りresultに追加する
(dolist (x (aref *neighbor* space) result);一マスだけ移動のチェック
(when (move-p board x space);石の移動方向は適正か？
(push (move-stone board space x) result)))));適正なら石を動かして新しい盤面をresultに保管
make-new-board
(defun print-board (board)
(apply #'format t " ~S ~% ~S ~S~%~S ~S ~S ~S ~S~% ~S ~S~% ~S~%~%"
board));単なる答えの標示特になし
print-board
(defun print-answer (n state prev)
(if (plusp n)
(print-answer (aref prev n) state prev));ゴール状態からは一手目まで再帰で過去にさかのぼる
(print-board (cdr (aref state n))));さかのぼった結果を逆順で実行すると一手目からゴールまでの標示となる
print-answer
(defun solve (start goal)
(let ((state (make-array 2772));盤面の状態の記録
(prev (make-array 2772));一手前がなんだったか覚えておく
(front 0);今探索中の盤面のno
(rear 1));探索中盤面の最後のno
(setf (aref state 0) (cons (position 'S start) start);スペースのある位置を追加した盤面状態をstate0に保管
(aref prev 0) -1);一手目は手前がないのでこのまま
(while (< front rear);新しい盤面が見つかる限り幅優先探索を行う
(let ((board (aref state front)));boardにこれから探索する盤面をセットする
(dolist (new-board (make-new-board (cdr board) (car board)));make-new-boardで次の盤面のリストを得る
(unless (find new-board state :end rear :test #'equal);次の盤面が探索済みでないなら
(setf (aref state rear) new-board;盤面を末尾に追加する
(aref prev rear) front);一手前の盤面を保持しておく
(when (equal goal (cdr new-board));今の盤面がゴールだった
(format t "局面数 ~D~%" (1+ rear));何個目まで盤面を生成したか
(print-answer rear state prev);答えのプリントアウト
(return-from solve t));処理の終了
(incf rear))));一つ盤面が追加されたのでrearを+1して次の探索結果盤面のチェックへ
(incf front))));frontの盤面の探索が終わったので次の盤面の探索へ移行
solve
(solve '(B B B B B S W W W W W) '(W W W W W S B B B B B))
