Skip to content

Instantly share code, notes, and snippets.

@si14

si14/core.clj

Created March 1, 2014 22:00
Show Gist options
  • Save si14/9298158 to your computer and use it in GitHub Desktop.
Save si14/9298158 to your computer and use it in GitHub Desktop.
Download ZIP
Visualizing "Missionaries and cannibals" problem
Raw
core.clj
(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))))
Raw
graph.gexf
<?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