勉強３日目宣教師と原始人をLispで解くコード - c21coterie @ ウィキ

リンク先ページを見てLispの勉強。
パズルで練習。
http://www.geocities.jp/m_hiroi/xyzzy_lisp/abclisp19.html#answer2
１日目二日目は基本構文の勉強に費やした。
流石に勉強３日目では自分でコードを書いて解くことは出来なかったので、答えのコードを読んで真似して書いてみて意味を自分で理解した範囲でコメント追加してみた。
まあ３日目ではこんなものだろう。

(defun safep (state)
 (let ((female (intersection state '(Wa Wb Wc)));今いる岸の女性の集合を得る
(male   (intersection state '(Ha Hb Hc))));今いる岸の男性の集合を得る
   (if (and female male);女性のみ男性のみかならifは実行されずｔを返す
(dolist (w female t);//女性のリストを一つずつ調べ全員Okならｔがかえる
  (unless (member (cdr (assoc w '((Wa . Ha) (Wb . Hb) (Wc . Hc)))) male);その女性の夫がこの岸の男性リストのメンバにいるか調べる
    (return nil)));いなかったらnilを返す
     t)))
safep
safep
(defun get-boat-pattern (state)
 (let ((result (mapcar #'(lambda (x) (list x)) state));ラムダ関数にstateの要素を一つずつlistになおして入れてこれをつなげresultに返す
boat a);ボート変数とa変数を定義
   (while (cdr state);stateの要素が空になる前まで回す
     (setq a (pop state));可能な二人のボートの組み合わせの一人目をポップする
     (dolist (b state);２人目の組を求める
(setq boat (list a b));二人組をリストにする
(if (safep boat);この二人組はルール違反でないか調べる
    (push boat result))));この二人組はOKなのでBoatのパタンに入れる
   result))
get-boat-pattern
(defun move-boat (n limit from to)
 (if (= n limit);ターン数を超えた
     (if (null (cdar to));対岸に誰もおらずゴール出来てるか
  (print-answer (reverse to) (reverse from)));答えの表示
   (dolist (boat (get-boat-pattern (cdar from)));今ボートのある岸で可能な移動のパタンを一つずつ試す
     (let ((new-from (cdar from));fromの先頭リストを取り出し、先頭のtかnulを削除
    (new-to   (cdar to)));同じく
(dolist (a boat);可能なボートの組み合わせを一つずつ試す
  (setq new-to   (add-person a new-to);新しく反対の岸に移動した人を追加する
	new-from (remove a new-from)));今いた岸からaの人を削除する
(push t new-to);よくわからないが先頭にｔを追加する
(push nil new-from);同じく、これいらない気もするけど何故いるのだろうか？
(if (and (safep (cdr new-from));nilを削除した今いる岸の組みあわせは安全か？
	 (safep (cdr new-to));ｔを削除した今いる岸は安全か？
	 (not (member new-from from :test #'equal)));ここまでのfromのリストに今までの状態がないか
    (move-boat (1+ n) limit (cons new-to to) (cons new-from from)))))));fromとtoを交換して次へ
move-boat
(defun add-person (a state)
 (cond ((endp state) (list a));stateが空になったのでaを後ろにつける
 ((string< a (car state));手前から削除していったstateの最初のシンボルがaより大きくなった
  (cons a state));この位置にaを追加して返す
 (t (cons (car state) (add-person a (cdr state))))));stateの手前を一つ短くして次へ
add-person
(defun print-answer (from to)
 (let ((n 0));nを定義
   (while from
     (format t "~D : ~S ~S~%" n (pop from) (pop to));逆転した操作結果履歴を順番に表示
     (incf n));nを１増加
   (throw 'find-answer t)))
print-answer
(defun solve ()
 (catch 'find-answer
   (do ((limit 9 (+ limit 2)));9手以内でクリアできるか11手以内でクリアできるか少しずつ手を増やして試していく
((> limit 20));流石に２０を超えたらプログラムミスだろう
     (format t "---- ~D手を探索 -----~%" limit)
     (move-boat 1 limit '((t Ha Wa) (nil)) '((nil Hb Hc Wb Wc) (t Ha Hb Hc Wa Wb Wc))))));この手数ちょうどでクリアできるかのチェック
solve
(solve)

• • • • 9手を探索 -----
      • 11手を探索 -----

0 : (t Ha Hb Hc Wa Wb Wc) (nil)
1 : (nil Hb Hc Wb Wc) (t Ha Wa)
2 : (t Ha Hb Hc Wb Wc) (nil Wa)
3 : (nil Ha Hb Hc) (t Wa Wb Wc)
4 : (t Ha Hb Hc Wa) (nil Wb Wc)
5 : (nil Ha Wa) (t Hb Hc Wb Wc)
6 : (t Ha Hc Wa Wc) (nil Hb Wb)
7 : (nil Wa Wc) (t Ha Hb Hc Wb)
8 : (t Wa Wb Wc) (nil Ha Hb Hc)
9 : (nil Wa) (t Ha Hb Hc Wb Wc)
10 : (t Ha Wa) (nil Hb Hc Wb Wc)
11 : (nil) (t Ha Hb Hc Wa Wb Wc)
t