Clojureで農夫と狼とヤギとキャベツ問題

これも「関数型オブジェクト指向AIプログラミング」から。

宣教師と食人鬼に続き、同じような川渡りロジック問題の農夫と狼とヤギとキャベツを解いてみる。

前回のコードをほぼ流用。元の本では差分プログラミング的にWolfGoatCabbageクラスをMissionariesAndCannibalsクラスを継承して作っているが、さすがにそんなことはしない。

データ構造もほぼ同じで、以下のようになる：

[{:farmer 1 :wolf 1 :goat 1 :cabbage 1} 
 {:farmer 0 :wolf 0 :goat 0 :cabbage 0} 
 :left]

左岸、右岸、ボートの位置。

それを踏まえ、「宣教師と食人鬼」コードで書き換えないといけないのは、ある状態から移行可能な次の状態のリストを作成するnext-states、solve関数の真ん中の部分であるダメな状態の定義、そして初期値と目的値。

とりあえず宣教師のやつをなるべく流用したnext-states：

(defn next-states [[left right boat-pos]]
  (let [options (for [w (range 2)
                      g (range 2)
                      c (range 2) :when (< (+ w g c) 2)]
                  {:farmer 1 :wolf w :goat g :cabbage c})]
    (if (= boat-pos :left)
      (map #(identity [(subtract-movers left %) (add-movers right %) :right]) options)
      (map #(identity [(add-movers left %) (subtract-movers right %) :left]) options))))

農夫は毎回ボートに乗り、それ以外で0~1要素が乗る。forループで回しても間違いではないが、この場合だと非効率そう。より自然に書き直すならこうだろうか：

(defn next-states [[left right boat-pos]]
  (let [options (cons {:farmer 1} 
                      (map #(identity {:farmer 1 % 1}) [:wolf :goat :cabbage]))]
    (if (= boat-pos :left)
      (map #(identity [(subtract-movers left %) (add-movers right %) :right]) options)
      (map #(identity [(add-movers left %) (subtract-movers right %) :left]) options))))

solve関数は真ん中のところだけ変える：

(defn solve [[history visited] current-state]
  (let [new-history (conj history current-state)
        new-visited (conj visited current-state)]
    (cond
      (= current-state end-state)
      (reduced [new-history new-visited])
    
      (let [[left right _] current-state]
        (or
          (contains? visited current-state)
          (some neg? (map second (concat left right)))
          (some
            #(and 
              (zero? (:farmer %))
              (pos? (:wolf %))
              (pos? (:goat %)))
            [left right])
          (some
            #(and 
              (zero? (:farmer %))
              (pos? (:goat %))
              (pos? (:cabbage %)))
            [left right])))
      [history new-visited]
      
      :else
      (let [[updated-history updated-visited]
            (reduce solve 
                    [new-history new-visited] 
                    (next-states current-state))]
        (if (= updated-history new-history)
          [history updated-visited]
          (reduced [updated-history updated-visited]))))))

宣教師より食人鬼の数が多いという条件を削除し、農夫がいない岸に狼とヤギがいる、農夫がいない岸にヤギとキャベツがある、という二条件を追加しただけ。本当はここだけなんとか入れ替え可能にできればより汎用性の高い川渡り問題ソルバーが出来上がるのだが。

あとは初期値と目的値：

(def initial-state [{:farmer 1 :wolf 1 :goat 1 :cabbage 1} 
                    {:farmer 0 :wolf 0 :goat 0 :cabbage 0} 
                    :left])
(def end-state [{:farmer 0 :wolf 0 :goat 0 :cabbage 0} 
                {:farmer 1 :wolf 1 :goat 1 :cabbage 1} 
                :right])

走らせるとこうなる：

[{:farmer 1, :wolf 1, :goat 1, :cabbage 1} 
 {:farmer 0, :wolf 0, :goat 0, :cabbage 0} 
 :left]
[{:farmer 0, :wolf 1, :goat 0, :cabbage 1} 
 {:farmer 1, :wolf 0, :goat 1, :cabbage 0} 
 :right]
[{:farmer 1, :wolf 1, :goat 0, :cabbage 1} 
 {:farmer 0, :wolf 0, :goat 1, :cabbage 0} 
 :left]
[{:farmer 0, :wolf 1, :goat 0, :cabbage 0} 
 {:farmer 1, :wolf 0, :goat 1, :cabbage 1} 
 :right]
[{:farmer 1, :wolf 1, :goat 1, :cabbage 0} 
 {:farmer 0, :wolf 0, :goat 0, :cabbage 1} 
 :left]
[{:farmer 0, :wolf 0, :goat 1, :cabbage 0} 
 {:farmer 1, :wolf 1, :goat 0, :cabbage 1} 
 :right]
[{:farmer 1, :wolf 0, :goat 1, :cabbage 0} 
 {:farmer 0, :wolf 1, :goat 0, :cabbage 1} 
 :left]
[{:farmer 0, :wolf 0, :goat 0, :cabbage 0} 
 {:farmer 1, :wolf 1, :goat 1, :cabbage 1} 
 :right]