Persistent Deque in Clojure

deque.clj

; see http://blogs.msdn.com/ericlippert/archive/2008/02/12/immutability-in-c-part-eleven-a-working-double-ended-queue.aspx

(defn- inner-pop [i end]
  (condp = end 
    :left  (subvec i 1)
    :right (pop i)))

(defn- inner-peek [i end]   
  (condp = end
    :left  (first i)
    :right (peek i)))

(defn- inner-push [i x end]
  (condp = end
    :left  (vec (cons x i))
    :right (conj i x)))

(def empty-deque {})

(defn dpeek [d end]
  (cond (empty? d)  nil
        (:single d) (:single d)
        :else       (inner-peek (end d) end)))

(defn dpush [d x end]
  (let [order     ({:left identity, :right reverse} end)
        other-end ({:left :right :right :left} end)]
    (cond 
      (empty? d)            {:single x}
      (:single d)           {end [x], :middle empty-deque, other-end [(:single d)]}
      (< (count (end d)) 4) (assoc d end (inner-push (end d) x end))
      :else                 (assoc d
                              end     (vec (order [x (inner-peek (end d) end)]))
                              :middle (dpush (:middle d) (inner-pop (end d) end) end)))))

(defn dpop [d end]
  (let [other-end ({:left :right :right :left} end)]
    (cond 
      (empty? d)                  d
      (:single d)                 empty-deque
      (> (count (end d)) 1)       (assoc d end (inner-pop (end d) end))
      (not (empty? (:middle d)))  (assoc d
                                    end     (dpeek (:middle d) end)
                                    :middle (dpop (:middle d) end))
      (> (count (other-end d)) 1) (assoc d
                                    end       [(inner-peek (other-end d) end)]
                                    other-end (inner-pop (other-end d) end))
      :else                       {:single (inner-peek (other-end d) end)})))

(defn dseq [d]
  (lazy-seq 
    (when-not (empty? d)
      (cons (dpeek d :left) (dseq (dpop d :left))))))


(comment

user>  empty-deque
{}
user> (dpush *1 1 :right)
{:single 1}
user> (dpush *1 2 :left)
{:left [2], :middle {}, :right [1]}
user> (dpush *1 3 :right)
{:left [2], :middle {}, :right [1 3]}
user> (dpush *1 4 :right)
{:left [2], :middle {}, :right [1 3 4]}
user> (dpush *1 5 :right)
{:left [2], :middle {}, :right [1 3 4 5]}
user> (dpush *1 6 :left)
{:left [6 2], :middle {}, :right [1 3 4 5]}
user> (dpush *1 7 :right)
{:left [6 2], :middle {:single [1 3 4]}, :right [5 7]}
user> (dseq *1)
(6 2 1 3 4 5 7)
user> (dpop *2 :right)
{:left [6 2], :middle {:single [1 3 4]}, :right [5]}
user> (dpop *1 :right)
{:left [6 2], :middle {}, :right [1 3 4]}
user> (dpop *1 :left)
{:left [2], :middle {}, :right [1 3 4]}
user> (dpop *1 :left)
{:left [1], :middle {}, :right [3 4]}
user> (dpop *1 :left)
{:left [3], :middle {}, :right [4]}
user> (dpop *1 :left)
{:single 4}
user> (dpop *1 :left)
{}

)