Advertisement
Guest User

veer

a guest
Jun 27th, 2009
152
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.53 KB | None | 0 0
  1. (defstruct treaps :key :prio :value :left :right)
  2.  
  3. (defn less? [a b] (neg? (compare a b)))
  4. (defn greater? [a b] (pos? (compare a b)))
  5. (defn eql? [a b] (zero? (compare a b)))
  6.  
  7. (defn insert [k p v treap]
  8. (cond
  9. (nil? treap) (struct-map treaps :key k :prio p :value v)
  10. (less? k (:key treap))
  11. (let [tr (assoc treap :left (insert k p v (:left treap)))]
  12. (if (> (:prio (:left tr)) (:prio tr)) (rotate-right tr) tr))
  13. (greater? k (:key treap))
  14. (let [tr (assoc treap :right (insert k p v (:right treap)))]
  15. (if (> (:prio (:right tr)) (:prio tr)) (rotate-left tr) tr))
  16. :else treap))
  17.  
  18.  
  19. (defn delete [k treap]
  20. (cond
  21. (nil? treap) nil
  22. (less? k (:key treap)) (assoc treap :left (delete k (:left treap)))
  23. (greater? k (:key treap)) (assoc treap :right (delete k (:right treap)))
  24. :else (root-delete treap)))
  25.  
  26. (defn root-delete [treap]
  27. (cond
  28. (and (nil? (:left treap)) (nil? (:right treap))) nil
  29. (nil? (:left treap)) (:right treap)
  30. (nil? (:right treap)) (:left treap)
  31. :else (if (> (:prio (:left treap))
  32. (:prio (:right treap))) (let [tr (rotate-right treap)]
  33. (assoc tr :right (root-delete (:right tr))))
  34. (let [tr (rotate-left treap)]
  35. (assoc tr :left (root-delete (:left tr)))))))
  36.  
  37.  
  38. (defn look-up [k treap]
  39. (cond
  40. (nil? treap) nil
  41. (less? k (:key treap)) (look-up k (:left treap))
  42. (greater? k (:key treap)) (look-up k (:right treap))
  43. :else (:value treap)))
  44.  
  45.  
  46. (defn enlist [treap]
  47. (if (nil? treap) '()
  48. (concat (enlist (:left treap))
  49. (list (str (:key treap)) (:prio treap))
  50. (enlist (:right treap)))))
  51.  
  52.  
  53. (defn update [k v treap]
  54. (cond
  55. (nil? treap) nil
  56. (less? k (:key treap)) (assoc treap :left (update k v (:left treap)))
  57. (greater? k (:key treap)) (assoc treap :right (update k v (:right treap)))
  58. :else (assoc treap :value v)))
  59.  
  60.  
  61. (defn rotate-right [a-tree]
  62. (assoc (:left a-tree) :right (assoc a-tree :left (:right (:left a-tree)))))
  63.  
  64. (defn rotate-left [a-tree]
  65. (assoc (:right a-tree) :left (assoc a-tree :right (:left (:right a-tree)))))
  66.  
  67.  
  68. (def lst '((80 \v) (60 \g) (63 \z) (37 \a) (57 \s) (47 \x)
  69. (31 \d) (53 \k) (39 \u) (22 \w) (36 \y)
  70. (15 \j) (48 \p) (21 \t) (17 \m) (34 \q) ))
  71.  
  72. (def tree (reduce
  73. (fn [a b] (insert (second b) (first b) (first b) a)) nil lst))
  74.  
  75. (def tree2 (reduce
  76. (fn [a b] (insert (second b) (rand) (first b) a)) nil lst))
  77.  
  78. (= (delete \l (insert \l 69 69 tree)) tree)
  79. (= (delete \l (insert \l (rand) "L" tree)) tree)
  80.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement