Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defstruct treaps :key :prio :value :left :right)
- (defn less? [a b] (neg? (compare a b)))
- (defn greater? [a b] (pos? (compare a b)))
- (defn eql? [a b] (zero? (compare a b)))
- (defn insert [k p v treap]
- (cond
- (nil? treap) (struct-map treaps :key k :prio p :value v)
- (less? k (:key treap))
- (let [tr (assoc treap :left (insert k p v (:left treap)))]
- (if (> (:prio (:left tr)) (:prio tr)) (rotate-right tr) tr))
- (greater? k (:key treap))
- (let [tr (assoc treap :right (insert k p v (:right treap)))]
- (if (> (:prio (:right tr)) (:prio tr)) (rotate-left tr) tr))
- :else treap))
- (defn delete [k treap]
- (cond
- (nil? treap) nil
- (less? k (:key treap)) (assoc treap :left (delete k (:left treap)))
- (greater? k (:key treap)) (assoc treap :right (delete k (:right treap)))
- :else (root-delete treap)))
- (defn root-delete [treap]
- (cond
- (and (nil? (:left treap)) (nil? (:right treap))) nil
- (nil? (:left treap)) (:right treap)
- (nil? (:right treap)) (:left treap)
- :else (if (> (:prio (:left treap))
- (:prio (:right treap))) (let [tr (rotate-right treap)]
- (assoc tr :right (root-delete (:right tr))))
- (let [tr (rotate-left treap)]
- (assoc tr :left (root-delete (:left tr)))))))
- (defn look-up [k treap]
- (cond
- (nil? treap) nil
- (less? k (:key treap)) (look-up k (:left treap))
- (greater? k (:key treap)) (look-up k (:right treap))
- :else (:value treap)))
- (defn enlist [treap]
- (if (nil? treap) '()
- (concat (enlist (:left treap))
- (list (str (:key treap)) (:prio treap))
- (enlist (:right treap)))))
- (defn update [k v treap]
- (cond
- (nil? treap) nil
- (less? k (:key treap)) (assoc treap :left (update k v (:left treap)))
- (greater? k (:key treap)) (assoc treap :right (update k v (:right treap)))
- :else (assoc treap :value v)))
- (defn rotate-right [a-tree]
- (assoc (:left a-tree) :right (assoc a-tree :left (:right (:left a-tree)))))
- (defn rotate-left [a-tree]
- (assoc (:right a-tree) :left (assoc a-tree :right (:left (:right a-tree)))))
- (def lst '((80 \v) (60 \g) (63 \z) (37 \a) (57 \s) (47 \x)
- (31 \d) (53 \k) (39 \u) (22 \w) (36 \y)
- (15 \j) (48 \p) (21 \t) (17 \m) (34 \q) ))
- (def tree (reduce
- (fn [a b] (insert (second b) (first b) (first b) a)) nil lst))
- (def tree2 (reduce
- (fn [a b] (insert (second b) (rand) (first b) a)) nil lst))
- (= (delete \l (insert \l 69 69 tree)) tree)
- (= (delete \l (insert \l (rand) "L" tree)) tree)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement