Created
March 1, 2014 22:00
-
-
Save si14/9298158 to your computer and use it in GitHub Desktop.
Visualizing "Missionaries and cannibals" problem
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| (ns mercanviz.core | |
| (:require | |
| [clojure.string :as s] | |
| [hiccup.core :as h] | |
| [clojure.data.priority-map :as pm]) | |
| (:gen-class)) | |
| (defn update-state [state & updates] | |
| (reduce (fn [acc [key op]] | |
| (update-in acc [key] op)) | |
| state (partition 2 updates))) | |
| (def actions | |
| #{{:name "transfer 1 missionary from the left bank to the right" | |
| :id 1 | |
| :applicable? #(and (>= (:left-m %) 1) | |
| (= (:boat %) :left)) | |
| :transition #(update-state % | |
| :left-m dec | |
| :right-m inc | |
| :boat (constantly :right))} | |
| {:name "transfer 2 missionaries from the left bank to the right" | |
| :id 2 | |
| :applicable? #(and (>= (:left-m %) 2) | |
| (= (:boat %) :left)) | |
| :transition #(update-state % | |
| :left-m (partial + -2) | |
| :right-m (partial + 2) | |
| :boat (constantly :right))} | |
| {:name "transfer 1 cannibal from the left bank to the right" | |
| :id 3 | |
| :applicable? #(and (>= (:left-c %) 1) | |
| (= (:boat %) :left)) | |
| :transition #(update-state % | |
| :left-c dec | |
| :right-c inc | |
| :boat (constantly :right))} | |
| {:name "transfer 2 cannibals from the left bank to the right" | |
| :id 4 | |
| :applicable? #(and (>= (:left-c %) 2) | |
| (= (:boat %) :left)) | |
| :transition #(update-state % | |
| :left-c (partial + -2) | |
| :right-c (partial + 2) | |
| :boat (constantly :right))} | |
| {:name (str "transfer 1 missionary and 1 cannibal " | |
| "from the left bank to the right") | |
| :id 5 | |
| :applicable? #(and (>= (:left-m %) 1) | |
| (>= (:left-c %) 1) | |
| (= (:boat %) :left)) | |
| :transition #(update-state % | |
| :left-m dec | |
| :right-m inc | |
| :left-c dec | |
| :right-c inc | |
| :boat (constantly :right))} | |
| {:name "transfer 1 missionary from the right bank to the left" | |
| :id 6 | |
| :applicable? #(and (>= (:right-m %) 1) | |
| (= (:boat %) :right)) | |
| :transition #(update-state % | |
| :left-m inc | |
| :right-m dec | |
| :boat (constantly :left))} | |
| {:name "transfer 2 missionaries from the right bank to the left" | |
| :id 7 | |
| :applicable? #(and (>= (:right-m %) 2) | |
| (= (:boat %) :right)) | |
| :transition #(update-state % | |
| :left-m (partial + 2) | |
| :right-m (partial + -2) | |
| :boat (constantly :left))} | |
| {:name "transfer 1 cannibal from the right bank to the left" | |
| :id 8 | |
| :applicable? #(and (>= (:right-c %) 1) | |
| (= (:boat %) :right)) | |
| :transition #(update-state % | |
| :left-c inc | |
| :right-c dec | |
| :boat (constantly :left))} | |
| {:name "transfer 2 cannibals from the right bank to the left" | |
| :id 9 | |
| :applicable? #(and (>= (:right-c %) 2) | |
| (= (:boat %) :right)) | |
| :transition #(update-state % | |
| :left-c (partial + 2) | |
| :right-c (partial + -2) | |
| :boat (constantly :left))} | |
| {:name (str "transfer 1 missionary and 1 cannibal " | |
| "from the right bank to the left") | |
| :id 10 | |
| :applicable? #(and (>= (:right-m %) 1) | |
| (>= (:right-c %) 1) | |
| (= (:boat %) :right)) | |
| :transition #(update-state % | |
| :left-m inc | |
| :right-m dec | |
| :left-c inc | |
| :right-c dec | |
| :boat (constantly :left))}}) | |
| (defn valid-state? [state] | |
| (and (or (>= (:left-m state) | |
| (:left-c state)) | |
| (= (:left-m state) 0)) | |
| (or (>= (:right-m state) | |
| (:right-c state)) | |
| (= (:right-m state) 0)))) | |
| (defn final-state? [state] | |
| (and (= (:right-m state) 3) | |
| (= (:right-c state) 3))) | |
| (def initial-state {:left-m 3 | |
| :left-c 3 | |
| :boat :left | |
| :right-m 0 | |
| :right-c 0}) | |
| (defn render-gexf [nodes edges] | |
| (str "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" | |
| (h/html [:gexf {:xmlns "http://www.gexf.net/1.2draft" | |
| :xmlns:xsi "http://www.w3.org/2001/XMLSchema-instance" | |
| :xsi:schemaLocation "http://www.gexf.net/1.2draft http://www.gexf.net/1.2draft/gexf.xsd" | |
| :version "1.2"} | |
| [:graph {:defaultedgetype "undirected" | |
| :mode "static"} | |
| [:attributes {:class "node"} | |
| [:attribute {:id 0 :title "type" :type "integer"}]] | |
| [:attributes {:class "edge"} | |
| [:attribute {:id 0 :title "n" :type "integer"}]] | |
| (for [node nodes] | |
| [:node {:id (:id node) | |
| :label (:label node)} | |
| [:attvalues | |
| [:attvalue {:for "0" :value (:type node)}]]]) | |
| (for [edge edges] | |
| [:edge {:id (:id edge) | |
| :source (:source edge) | |
| :target (:target edge)} | |
| [:attvalues | |
| [:attvalue {:for "0" :value (:n edge)}]]])]]))) | |
| (def possible-states | |
| (for [left-m (range 0 4) | |
| left-c (range 0 4) | |
| boat [:left :right]] | |
| {:left-m left-m | |
| :left-c left-c | |
| :boat boat | |
| :right-m (- 3 left-m) | |
| :right-c (- 3 left-c)})) | |
| (def indexed-nodes | |
| (->> possible-states | |
| (map-indexed (fn [idx x] [x idx])) | |
| (into {}))) | |
| (def edges | |
| (->> (for [[state a-idx] indexed-nodes] | |
| (for [b-idx (->> actions | |
| (filter #((:applicable? %) state)) | |
| (map #((:transition %) state)) | |
| (map indexed-nodes))] | |
| {:source (min a-idx b-idx) | |
| :target (max a-idx b-idx)})) | |
| (apply concat) | |
| (into #{}))) | |
| (defn make-edge [state-a state-b] | |
| (let [a-idx (indexed-nodes state-a) | |
| b-idx (indexed-nodes state-b)] | |
| {:source (min a-idx b-idx) | |
| :target (max a-idx b-idx)})) | |
| (defn bfs-search [] | |
| (loop [fringe (conj (clojure.lang.PersistentQueue/EMPTY) | |
| [initial-state initial-state]) | |
| seen-states #{(dissoc initial-state :states)} | |
| explored-edges []] | |
| (if (empty? fringe) | |
| :no-solution | |
| (let [[prev-state current-state] (peek fringe)] | |
| (if (final-state? current-state) | |
| (conj explored-edges (make-edge prev-state current-state)) | |
| (let [new-states | |
| (keep #(when ((:applicable? %) current-state) | |
| (let [new-state ((:transition %) current-state)] | |
| (when | |
| (and (valid-state? new-state) | |
| (not (seen-states new-state))) | |
| new-state))) | |
| actions)] | |
| (recur (into (pop fringe) (map vector | |
| (repeat current-state) | |
| new-states)) | |
| (into seen-states new-states) | |
| (conj explored-edges (make-edge prev-state current-state))))))))) | |
| (defn gengraph [] | |
| (let [breadth-first-edges (bfs-search) | |
| astar-edges | |
| edges-gexf (map-indexed | |
| (fn [idx x] (assoc x | |
| :id idx | |
| :n (let [n (.indexOf breadth-first-edges x)] | |
| (when (>= n 0) | |
| n)))) | |
| edges) | |
| nodes-gexf (for [[state idx] indexed-nodes] | |
| {:id idx | |
| :label (str (:left-m state) | |
| (:left-c state) | |
| (case (:boat state) | |
| :left "L" | |
| :right "R")) | |
| :type (cond | |
| (= initial-state state) 0 | |
| (final-state? state) 1 | |
| (valid-state? state) 2 | |
| (not (valid-state? state)) 3)})] | |
| (spit "graph.gexf" (render-gexf nodes-gexf edges-gexf)))) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| <?xml version="1.0" encoding="UTF-8"?><gexf version="1.2" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://www.gexf.net/1.2draft" xsi:schemaLocation="http://www.gexf.net/1.2draft http://www.gexf.net/1.2draft/gexf.xsd"><graph defaultedgetype="undirected" mode="static"><attributes class="node"><attribute id="0" title="type" type="integer"></attribute></attributes><attributes class="edge"><attribute id="0" title="n" type="integer"></attribute></attributes><node id="20" label="22L"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="22" label="23L"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="28" label="32L"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="30" label="33L"><attvalues><attvalue for="0" value="0"></attvalue></attvalues></node><node id="21" label="22R"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="23" label="23R"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="4" label="02L"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="6" label="03L"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="16" label="20L"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="18" label="21L"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="29" label="32R"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="31" label="33R"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="12" label="12L"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="14" label="13L"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="24" label="30L"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="26" label="31L"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="5" label="02R"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="7" label="03R"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="17" label="20R"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="19" label="21R"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="0" label="00L"><attvalues><attvalue for="0" value="1"></attvalue></attvalues></node><node id="2" label="01L"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="13" label="12R"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="15" label="13R"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="25" label="30R"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="27" label="31R"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="8" label="10L"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="10" label="11L"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="1" label="00R"><attvalues><attvalue for="0" value="1"></attvalue></attvalues></node><node id="3" label="01R"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><node id="9" label="10R"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></node><node id="11" label="11R"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></node><edge id="0" source="13" target="20"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="1" source="19" target="22"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="2" source="21" target="28"><attvalues><attvalue for="0" value="4"></attvalue></attvalues></edge><edge id="3" source="27" target="30"><attvalues><attvalue for="0" value="3"></attvalue></attvalues></edge><edge id="4" source="3" target="6"><attvalues><attvalue for="0" value="11"></attvalue></attvalues></edge><edge id="5" source="5" target="12"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="6" source="11" target="14"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="7" source="13" target="22"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="8" source="21" target="30"><attvalues><attvalue for="0" value="2"></attvalue></attvalues></edge><edge id="9" source="17" target="18"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="10" source="5" target="14"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="11" source="25" target="26"><attvalues><attvalue for="0" value="6"></attvalue></attvalues></edge><edge id="12" source="1" target="2"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="13" source="9" target="10"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="14" source="15" target="22"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="15" source="23" target="30"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="16" source="7" target="14"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="17" source="11" target="20"><attvalues><attvalue for="0" value="8"></attvalue></attvalues></edge><edge id="18" source="19" target="28"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="19" source="3" target="12"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="20" source="5" target="20"><attvalues><attvalue for="0" value="9"></attvalue></attvalues></edge><edge id="21" source="13" target="28"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="22" source="9" target="16"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="23" source="17" target="24"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="24" source="1" target="8"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="25" source="9" target="18"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="26" source="17" target="26"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="27" source="1" target="10"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="28" source="7" target="22"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="29" source="15" target="30"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="30" source="11" target="18"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="31" source="19" target="26"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="32" source="3" target="10"><attvalues><attvalue for="0" value="13"></attvalue></attvalues></edge><edge id="33" source="1" target="16"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="34" source="9" target="24"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="35" source="3" target="18"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="36" source="11" target="26"><attvalues><attvalue for="0" value="7"></attvalue></attvalues></edge><edge id="37" source="21" target="22"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="38" source="29" target="30"><attvalues><attvalue for="0" value="1"></attvalue></attvalues></edge><edge id="39" source="5" target="6"><attvalues><attvalue for="0" value="10"></attvalue></attvalues></edge><edge id="40" source="13" target="14"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="41" source="17" target="20"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="42" source="25" target="28"><attvalues><attvalue for="0" value="5"></attvalue></attvalues></edge><edge id="43" source="1" target="4"><attvalues><attvalue for="0" value="14"></attvalue></attvalues></edge><edge id="44" source="9" target="12"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="45" source="19" target="20"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="46" source="27" target="28"><attvalues><attvalue for="0"></attvalue></attvalues></edge><edge id="47" source="3" target="4"><attvalues><attvalue for="0" value="12"></attvalue></attvalues></edge><edge id="48" source="11" target="12"><attvalues><attvalue for="0"></attvalue></attvalues></edge></graph></gexf> |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment