397 - PurelyFunctional.tv Newsletter

00 Wolf Sheep Cabbage.md

Wolf, sheep, cabbage

There's a really common problem called "Wolf, sheep, cabbage". (There are other names for it as well). The problem goes like this:

You own a wolf, a sheep, and a cabbage. You need to cross a river and you only have a boat big enough for you plus one other passenger (your wolf, sheep, or cabbage). The trouble is, the animals are hungry. If you leave the wolf with the sheep, the wolf will eat it. If you leave the sheep with the cabbage, it will eat it. The wolf, being a carnivore, will not eat the cabbage. How do you move them safely to the other side with nothing being eaten?

It's a fun problem and I suggest you give it a try on paper if you don't know the solution. If you can't figure it out, search for it online and you'll find solutions.

Your task is to write a function that generates solutions to this puzzle, in the form of boat crossings. Each crossing should state:

• the direction you are going
• the passenger in your boat

(defn wolf-sheep-cabbage []) => ([...
                                  {:direction :across
                                   :passenger :cabbage}
                                  {:direction :return
                                   :passenger :sheep}]
                                 ...)

Bonus

Write a function that validates a solution.

Please submit your solutions as comments to this gist. Discussion is welcome.

After a bit of sweat and getting tired of yet again having to work on the traversal and backtracking mechanics of depth first search, I wrote a pluggable DFS shell, and named it shellfish: check it out here. To use it, simply drop the release jar into your project's lib directory, and link to it by adding :source-paths ["src" "lib/shellfish-0.5-ALPHA.jar"] to your project.clj

The dfs function yields a lazy seq of all solutions for its problem argument (see below). It seems to work well with the Knight's Tour and Queens chess problems (for small sizes, since they are NP-complete using DFS), and just added, a sudoku solver (using Peter Norvig's algorithm).

Thanks to the magic of zippers, the mechanics of backtracking were surprisingly simple, and I gained a deep appreciation of zipper/next as a result.

Here is my clumsy solution for this puzzle using shellfish - comments and criticisms welcome!

(require '[shellfish.dfs.core :as algo])

(def passengers [:wolf :sheep :cabbage])
(def loss-groups #{#{:wolf :sheep} #{:sheep :cabbage}})
(def directions #{:across :return})

(defn lossy? [group]
  (some (fn [xy]
          (every? group (seq xy)))
        (seq loss-groups)))

(defn src+dst [{:keys [from to]} direction]
  (let [[src-k src dst-k dst] (if (= :across direction)
                                [:from from :to to]
                                [:to to :from from])]
    {:src src, :src-k src-k, 
     :dst dst, :dst-k dst-k}))

(defn valid-move? [{:keys [after] :as state} passenger direction]
  (let [{:keys [src dst]} (src+dst state direction)]
    (and (directions direction)
         (not= after direction)
         (if-not passenger
           (not (lossy? src))
           (and (src passenger)
                (not (lossy? (disj src passenger))))))))

(defn trip-candidates [{:keys [after] :as state}]
  (let [d (if (#{:init :return} after) :across :return)
        {pool :src} (src+dst state d)]
    (->> pool 
         (cons nil)
         (filter #(valid-move? state % d))
         (map #(hash-map :passenger % :direction d)))))

(defn goal-reached? [{:keys [from to]}]
  (and (= nil (seq from)) 
       (= (set passengers) to)))

(defn update-state [state
                    {:keys [passenger direction] :as trip}]
  (let [{:keys [src src-k dst dst-k]} (src+dst state direction)]
    (merge (if passenger
             {src-k (disj src passenger)
              dst-k (conj dst passenger)}
             state)
           {:after direction})))

(def init-state {:from (set passengers), :to #{} :after :init})

(defn wolf-sheep-cabbage []
  (algo/dfs {:init-state init-state
             :generate trip-candidates
             :goal? goal-reached?
             :update update-state}))

(defn valid-solution? [solution]
  (->> solution
       (reduce (fn [{:keys [from to after] :as state} 
                    {dir :direction p :passenger :as trip}]
                 (cond 
                   (not (valid-move? state p dir))
                   (reduced false)
                   :else
                   (update-state state trip)))
               init-state)
       goal-reached?))

(let [sols (wolf-sheep-cabbage)] 
  (and (= 2 (count (set sols))) 
       (every? #(not (empty? %)) sols)
       (every? valid-solution? sols)))
;; => true

Since part one doesn't specify correct solutions, here's a way of generating random 'solutions' with clojure.spec:

(ns challenges.wolf
  (:require [clojure.spec.alpha :as s]
            [clojure.spec.gen.alpha :as gen]))

(s/def ::passenger #{:wolf :sheep :cabbage})
(s/def ::direction #{:across :return})
(s/def ::round (s/keys :req-un [::direction ::passenger]))
(s/def ::solut (s/* ::round))

(defn wolf-sheep-cabbage []
  (into [] (gen/generate (s/gen ::solut))))

;; example run
(wolf-sheep-cabbage)
;; [{:direction :across, :passenger :wolf}
;;  {:direction :return, :passenger :wolf}
;;  {:direction :across, :passenger :sheep}
;;  {:direction :return, :passenger :cabbage}
;;  {:direction :across, :passenger :wolf}
;;  {:direction :return, :passenger :sheep}
;;  {:direction :across, :passenger :sheep}
;;  {:direction :across, :passenger :cabbage}
;;  {:direction :across, :passentger :wolf}
;;  {:direction :across, :passenger :sheep}]

Given enough time, this would stumble on a correct solution. :)
Yes, I know, this is not what was intended, but it was a good excuse to practice with clojure.spec and test.check. It would also be useful for generating test cases for a solution validator!