3.9 宣教師と人食い人種問題

面倒になってきたのでコーディング部分だけまとめることにした。掃除機問題のバリエーションはいまいちなので見送り。

次は順に考えるのが面倒くさいことで有名な宣教師問題である。色々な資料を見ると細かいバリエーションがあるのがわかるが、今回はもっとも単純なタイプを考える。

問題

M人の宣教師(missionary)とC人の食人種(cannibal)が川の同じ岸にいる。その岸にはボートがあるが、最大2人までしか乗ることができない。ところで、宣教師より食人種が多くいるとき、食人種は宣教師を食べてしまう。N=3、M=3のとき、全員無事に向こう岸に渡るにはどのようにすればよいだろうか。

状態空間

このケースでは宣教師同士、食人種同士の区別がなく、人数の出入りもない。そのため、状態を記述するには、こちら岸のボートの有無、宣教師、食人種の人数を考えれば良い。向こう岸にいる人数は引き算で求められる。

それぞれの場所の人数は、宣教師、食人種それぞれ0〜合計人数だから、取りうる状態数は2MC。条件を加味すれば、状態空間はさらに狭くなる。それを求める関数とその結果は次の通り。

(defun all-state (m c &aux l)
  (nset-difference
   (dotimes (x (1+ m) l)
     (dotimes (y (1+ c))
       (when (and (or (= x 0) (>= x y))
                  (or (= x m) (>= (- m x) (- c y))))
         (setq l (cons (list t x y) (cons (list nil x y) l))))))
   (list (list t 0 0) (list nil m c)) :test 'equal))

(format t "~{|~A~%~}" (all-state 3 3))
|(t 3 3)
|(t 3 2)
|(nil 3 2)
|(t 3 1)
|(nil 3 1)
|(t 3 0)
|(nil 3 0)
|(t 2 2)
|(nil 2 2)
|(t 1 1)
|(nil 1 1)
|(t 0 3)
|(nil 0 3)
|(t 0 2)
|(nil 0 2)
|(t 0 1)
|(nil 0 1)
|(nil 0 0)

状態空間はこれだけだ。実際には初期状態から達成できない状態もあるだろうから、もう少し減るかも知れない。同じ状態を繰り返すことは無意味なので、解の手順はこの合計数以下になる。

解法

状態の遷移はボートに乗れる組合せが(1 0)(0 1)(1 1)(2 0)(0 2)だけなので、これらに対して次の状態が正当かどうかを確認すればよい。また、続けて同じ人数で動かすとすぐ元の状態に戻るので、状態の繰り返しは避けるようにする。探索方針としては、最短手を尽くし、解がなければ手数を増やして再探索する反復深化探索を行う。ということで、作ってみたコードを以下に置く。

(defun next-step (w v)
  (let ((f (if (car w) #'- #'+)))
    (cons (not (car w)) (mapcar (lambda (x y) (funcall f x y)) (cdr w) v))))

(defun mc-problem (m c)
  (let* ((states (all-state m c))
         (mover '((1 0)(0 1)(1 1)(2 0)(0 2)))
         (mnum (length mover))
         (sarg (list (list t m c)))
         (marg (list 0))
         (depth 1)
         (max 0)
         (goal '(nil 0 0)))
    (or
     (while (>= (+ max 3) depth)
       (let ((cur (next-step (car sarg) (elt mover (car marg)))))
         (if (equal goal cur) (return (cons cur sarg)))
         (if (and (< (length marg) depth)
                  (not (find cur sarg :test 'equal))
                  (find cur states :test 'equal))
             (progn (push cur sarg) (push 0 marg)
               (setq max (max max (length marg))) (do-events))
           (while (<= mnum (incf (car marg)))
             (setq sarg (cdr sarg)
                   marg (cdr marg))
             (unless (car marg)
               (incf depth 2)
               (setq sarg (list (list t m c))
                     marg (list 0))
               (return))))))
     (list nil 'impossible))))

(format t "~{~A ~A~%~}" (reverse (mc-problem 3 3)))
|(t 3 3) (nil 2 2)
|(t 3 2) (nil 3 0)
|(t 3 1) (nil 1 1)
|(t 2 2) (nil 0 2)
|(t 0 3) (nil 0 1)
|(t 1 1) (nil 0 0)