gistfile1.clj

(ns bktree)

(defn root [distance-fn] {:distance-fn distance-fn :children {} :matches []})
(defn new-node [term] {:term term :children {} :matches []})

(defn insert
  ([element node]
    (insert element node (:distance-fn node)))

  ([element node distance-fn]
    (if (:term node)
      (let [dist (distance-fn (:term node) element)
            children (:children node)
            child (get children dist)]
        (if (= 0 dist)
          (assoc node :matches (cons element (:matches node)))
          (if child
            (assoc node :children (assoc children dist (insert element child distance-fn)))
            (assoc node :children (assoc children dist (new-node element))))))
      (assoc node :term element))))

(defn tail-recurring-insert
  ([element node]
    (tail-recurring-insert element node (:distance-fn node)))

  ([element root-node distance-fn]
   (loop [path   []
          node   root-node
          result root-node]
    (if (:term node)
      (let [dist (distance-fn (:term node) element)
            children (:children node)
            child (get children dist)]
        (if (= 0 dist)
          (assoc-in result
                    (conj path :matches)
                    (cons element
                          (:matches (get-in root-node path))))
          (if child
            (let [dist-path (-> path (conj :children) (conj dist))]
              (recur dist-path
                     child
                     result))
            (assoc-in result
                      (conj path :children)
                      (assoc children dist (new-node element))))))
      (assoc-in result (conj path :term) element)))))

(defmacro test-it [& elements]
  (let [insertions (map list (repeat 'insert) elements)
        tail-recurring-insertions (map list (repeat 'tail-recurring-insert) elements)]
    `(let [slow# (->> (root hamming-distance)
                      ~@insertions)
           maybe-fast# (->> (root hamming-distance)
                            ~@tail-recurring-insertions)]
       (if (= maybe-fast# slow#)
         (do (println "PASSED!") (prn maybe-fast#))
         (do (println "failed.") (prn maybe-fast#) (prn slow#))))))

(defn walk [a-fn node]
  (a-fn node)
  (doall (map (fn [n] (walk a-fn n)) (vals (:children node)))))

; Tree ends here, below is a sample distance fn to use
;
; "distance" is some fn that takes two strings and returns an integer
; (insert "b" (insert "b" (insert "a" (root hamming-distance))))

;Sample hamming distance fn, lifted from incanter
(defn- tree-comp-each [root branch & leaves]
 (apply
  root (map branch leaves)))

(defn- bool-to-binary [pred] (if pred 1 0))

(defn hamming-distance
  [a b]
  (if (and (integer? a) (integer? b))
    (hamming-distance (str a) (str b))
  (let [_ (assert (= (count a) (count b)))]
  (apply
   tree-comp-each
    +
    #(bool-to-binary (not (apply = %)))
    (map vector a b)))))