Want more features on Pastebin? Sign Up, it's FREE!
Guest

veer

By: a guest on Jun 27th, 2009  |  syntax: None  |  size: 2.53 KB  |  views: 108  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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)
clone this paste RAW Paste Data