A rope implementation using splay trees.

splay-rope.clj

(ns splay-rope.core)

(declare traverse)

(deftype Node [^int offset
               ^String data
               left
               right]
  Object
  (toString [node]
    (->> node
         traverse
         (map #(.data %))
         (apply str))))

(defn ^:private traverse
  [rope]
  (if rope
    (concat
      (traverse (.left rope))
      [rope]
      (traverse (.right rope)))))

(defn ^:private node
  [data left right]
  (Node. (if left
           (+ (.offset left) (count (.data left)))
           0)
         data
         left
         right))

(defn rope
  [initial-value]
  (node initial-value nil nil))

(defn ^:private has-offset?
  [node offset]
  (and node
       (>= offset (.offset node))
       (let [end (+ (.offset node) (count (.data node)))]
         (or (< offset end)
             (and (= offset end)
                  (not (.right node)))))))

(defn ^:private zip
  [rope]
  (list rope))

(defn ^:private zip-left
  [[current & path]]
  (conj path [:left current] (.left current)))

(defn ^:private zip-right
  [[current & path]]
  (conj path [:right current] (.right current)))

(defn ^:private zip-up
  [[current [direction previous] & remaining-path]]
  (conj remaining-path
        (case direction
          :left
          (node (.data previous) current (.right previous))

          :right
          (node (.data previous) (.left previous) current))))

(defn ^:private zip-top
  [zipper]
  (if (second zipper)
    (recur (zip-up zipper))
    zipper))

(defn ^:private zip-downto
  [zipper offset]
  (cond
    (has-offset? (first zipper) offset)
    zipper

    (< offset (.offset (first zipper)))
    (recur (zip-left zipper) offset)

    :else
    (recur (zip-right zipper) offset)))

(defn ^:private insert-left-child
  [rope data]
  (node (.data rope)
        (node data
              (.left rope)
              nil)
        (.right rope)))

(defn ^:private split-node
  [rope split-offset]
  (let [data-offset (- split-offset (.offset rope))]
    (node (.substring (.data rope) data-offset)
          (node (.substring (.data rope) 0 data-offset)
                (.left rope)
                nil)
          (.right rope))))

(defn ^:private rotate-right
  [rope]
  {:pre [(.left rope)]}
  (node (.data (.left rope))
        (.left (.left rope))
        (node (.data rope)
              (.right (.left rope))
              (.right rope))))

(defn ^:private rotate-left
  [rope]
  {:pre [(.right rope)]}
  (node (.data (.right rope))
        (node (.data rope)
              (.left (.right rope))
              (.left rope))
        (.right (.right rope))))

(defn ^:private zip-update
  [[current & path] update-fn & more-args]
  (conj path (apply update-fn current more-args)))

(defn ^:private zip-insert
  [[current & path :as zipper] offset data]
  (cond
    (= offset (.offset current))
    (-> zipper
        (zip-update insert-left-child data)
        (zip-left))

    (= offset (+ (.offset current) (count (.data current))))
    (zip-update zipper (constantly (node data current nil)))

    :else
    (-> zipper
        (zip-update split-node offset)
        (zip-update insert-left-child data)
        (zip-left))))

(defn ^:private splay
  [zipper]
  (case (map first (take 2 (drop 1 zipper)))
    []
    zipper

    [:left]
    (-> zipper
        zip-up
        (zip-update rotate-right))

    [:right]
    (-> zipper
        zip-up
        (zip-update rotate-left))

    [:left :left]
    (recur (-> zipper
               zip-up
               zip-up
               (zip-update rotate-right)
               (zip-update rotate-right)))

    [:right :right]
    (recur (-> zipper
               zip-up
               zip-up
               (zip-update rotate-left)
               (zip-update rotate-left)))

    [:left :right]
    (recur (-> zipper
               zip-up
               (zip-update rotate-right)
               zip-up
               (zip-update rotate-left)))

    [:right :left]
    (recur (-> zipper
               zip-up
               (zip-update rotate-left)
               zip-up
               (zip-update rotate-right)))))

(defn splice
  [rope start end data]
  {:pre [(>= end start)]}
  (-> (zip rope)
      (zip-downto start)
      (zip-insert start data)
      splay
      first))