Union Find algorithm in Clojure using the state-m Monad for keeping track of state. Monad code found at https://github.com/clojure/algo.monads Good explanation of Monads and state monad http://www.intensivesystems.net/tutorials/monads_101.html

uf.clj

(ns euler.algo.uf
  (:use clojure.algo.monads))

(with-monad state-m
  (defn get-or-add [key]
    (fn [s]
      (if-let [v (get s key)]
        [v s]
        [[key 1] (assoc s key [key 1])])))


  (defn root [key]
    (domonad
      [[r c :as res] (get-or-add key)
       :if (= r key)
       :then [ret (m-result res)]
       :else [ret (root r)
              _ (set-val key [(first ret) -1])]]
      ret))

  (defn- join [[childKey childCount :as c] [parentKey parentCount :as p]]
    (fn [s]
      (let [newParent [parentKey (+ parentCount childCount)]
            newChild [parentKey -1]]
        [newParent (assoc s childKey newChild parentKey newParent)])))

  (defn union [a b]
    (domonad
      [[ra ca :as rootA] (root a)
       [rb cb :as rootB] (root b)
       :if (= ra rb)
       :then [res (m-result nil)]
       :else [
        :if (<= ca cb)
        :then [res (join rootA rootB)]
        :else [res (join rootB rootA)]]]
      res))

  (defn connected? [a b]
    (domonad
      [[ra _] (root a)
       [rb _] (root b)]
      (= ra rb)))

  (defn component-size [a]
    (domonad [[ra ca] (root a)] ca))

  )

uf_test.clj

(ns euler.algo.uf-test
  (:use clojure.test
        clojure.algo.monads
        euler.algo.uf))

(with-monad state-m

  (deftest nav-ops
    (testing "getting non-existing elt"
      (let [uf (domonad [a (get-or-add :a )] a)]
        (is (= '([:a 1] {:a [:a 1]}) (uf {})))
        )
      )
    (testing "getting existing elt"
      (let [uf (domonad [a (get-or-add :a )] a)]
        (is (= '([:b 2] {:a [:b 2]}) (uf {:a [:b 2]})))
        )
      )
    (testing "root non-existing elt"
      (let [uf (domonad [a (root :a )] a)]
        (println "uf: " uf)
        (println "invoke uf: " (uf {}))
        (is (= '([:a 1] {:a [:a 1]}) (uf {})))
        )
      )
    (testing "root existing elt"
      (let [m {:a [:a 3]}
            uf (domonad [a (root :a )] a)]
        (is (= [[:a 3] m] (uf m)))
        )
      )
    (testing "child and parent exist elts"
      (let [m {:a [:b -1], :b [:b 2]}
            uf (domonad [a (root :a )] a)]
        (is (= [[:b 2] m] (uf m)))
        )
      )
    (testing "reading grandchild reparents to root"
      (let [m {:a [:b -1], :b [:c -1], :c [:d -1], :d [:d 4]}
            uf (domonad [a (root :a )] a)]
        (is (= [[:d 4] {:a [:d -1], :b [:d -1], :c [:d -1], :d [:d 4]}] (uf m)))
        )
      )
    (testing "component size"
      (let [m {:a [:b -1], :b [:b 2]}
            uf (domonad [a (component-size :a )] a)]
        (is (= [2 m] (uf m)))
        )
      )
    )

  (deftest union-ops
    (testing "union two non existant elts"
      (let [uf (domonad [u (union :a :b )] u)]
        (is (= [[:b 2] {:a [:b -1], :b [:b 2]}] (uf {})))
        )
      )
    (testing "union one non existant elt"
      (println "START")
      (let [uf (domonad [u (union :a :a )] u)]
        (is (= [nil {:a [:a 1]}] (uf {})))
        )
      )
    (testing "union two children common parent"
      (println "START")
      (let [uf (domonad [ac (union :a :c ) bc (union :b :c ) ab (union :a :b )] ab)]
        (is (= [nil {:a [:c -1] :b [:c -1] :c [:c 3]}] (uf {})))
        )
      )
    (testing "connected two children common parent"
      (let [uf (domonad [ac (union :a :c ) bc (union :b :c ) ab (connected? :a :b )] ab)]
        (is (= [true {:a [:c -1] :b [:c -1] :c [:c 3]}] (uf {})))
        )
      )
    (testing "connected two non-existant elts"
      (let [uf (domonad [ab (connected? :a :b )] ab)]
        (is (= [false {:a [:a 1] :b [:b 1]}] (uf {})))
        )
      )
    )

  )

;(defn test-ns-hook []
;  (foo))

(run-tests)