Created
January 22, 2014 15:28
-
-
Save eraserhd/8560700 to your computer and use it in GitHub Desktop.
A rope implementation using splay trees.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment