leftist heap

heap.clj

(declare insert)
(declare find-min)
(declare delete-min)
(declare empty-heap)
(declare is-empty?)
(declare heap-seq)

(deftype LeftistHeap [^Integer rank ^Integer elem left right]
  clojure.lang.IPersistentStack
  (peek [this]
    (find-min this))
  (pop [this]
    (delete-min this))  
  (cons [this e]
    (insert e this))
  (count [this]
    (count (seq this)))
  (empty [this]
    (empty-heap))
  (equiv [this o]
    (= (seq this) (seq o)))
  clojure.lang.Seqable
  (seq [this]
    (when-not (is-empty? this)
      (heap-seq this)))
  Object
  (toString [this]
    (clojure.string/join " " (seq this)))
  (hashCode [this]
    (if (nil? this) 1
      (+ (.hashCode elem) (.hashCode rank) (.hashCode left) (.hashCode right))))
  (equals [this o]
    (or
     (identical? this o)
     (and (instance? LeftistHeap o)
          (= (.hashCode this) (.hashCode o))))))

(defn is-empty? [h]
  (nil? (.elem h)))

(defn rank [h]
  (.rank h))

(defn make-node [e h1 h2]
  (if (>= (rank h1) (rank h2))
    (->LeftistHeap (inc (rank h2)) e h1 h2)
    (->LeftistHeap (inc (rank h1)) e h2 h1)))

(defn empty-heap []
  (->LeftistHeap 0 nil nil nil))

(defn heap-merge [h1 h2]
  (cond (is-empty? h1) h2
        (is-empty? h2) h1
        :else (let [x (.elem h1)
                    a1 (.left h1)
                    b1 (.right h1)
                    y (.elem h2)                    
                    a2 (.left h2)
                    b2 (.right h2)]
                (if (<= x y)
                  (make-node x a1 (heap-merge b1 h2))
                  (make-node y a2 (heap-merge h1 b2))))))

(defn insert [e h]
  (heap-merge (->LeftistHeap 1 e (empty-heap) (empty-heap)) h))

(defn find-min [h]
  (when-not (is-empty? h)
    (.elem h)))

(defn delete-min [h]
  (when-not (is-empty? h)
    (heap-merge (.left h) (.right h))))

(defn leftist-heap [& xs]
  (reduce conj (empty-heap) xs))

(defn heap-seq [h]
  (lazy-seq
   (when-not (is-empty? h)
     (cons (find-min h) (heap-seq (delete-min h))))))