-
-
Notifications
You must be signed in to change notification settings - Fork 22
/
pairing.cljc
145 lines (127 loc) · 4.33 KB
/
pairing.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
;;
;; Copyright (c) Huahai Yang. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file LICENSE at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
;;
(ns editscript.util.pairing
#?(:clj
(:import [clojure.lang IPersistentStack IPersistentMap IPersistentCollection]
[java.io Writer])))
#?(:clj (set! *warn-on-reflection* true))
(defprotocol IHeapNode
(get-left [this] "Get the left child node")
(get-right [this] "Get the right sibling node")
(set-right [this right] "Set the right sibling")
(add-child [this node] "Add a child to a node"))
(deftype HeapNode [item
priority
^:unsynchronized-mutable left
^:unsynchronized-mutable right]
IHeapNode
(get-left [_] left)
(get-right [_] right)
(set-right [_ r] (set! right r))
(add-child [this node]
(when left (set-right node left))
(set! left node)
this))
#?(:clj (defmethod print-method HeapNode
[x ^Writer writer]
(print-method {:item (.-item ^HeapNode x)
:priority (.-priority ^HeapNode x)
:left (get-left x)
:right (get-right x)}
writer)))
(defn merge-nodes
[^HeapNode a ^HeapNode b]
(cond
(nil? a) b
(nil? b) a
(< (.-priority a) (.-priority b)) (add-child a b)
:else (add-child b a)))
(defn insert
[^HeapNode node item priority]
(merge-nodes node (->HeapNode item priority nil nil)))
(defn two-pass
[^HeapNode node]
(if (or (nil? node) (nil? (get-right node)))
node
(let [a node
b (get-right node)
n (get-right b)]
(set-right a nil)
(set-right b nil)
(merge-nodes (merge-nodes a b) (two-pass n)))))
#?(:clj
(deftype PriorityMap [^:unsynchronized-mutable ^HeapNode heap
^:unsynchronized-mutable map]
IPersistentCollection
(count [_] (count map))
(cons [this e]
(let [[item priority] e]
(set! map (assoc map item priority))
(set! heap (insert heap item priority))
this))
(empty [this]
(set! heap nil)
(set! map {})
this)
(equiv [this o] (identical? this o))
IPersistentMap
(assoc [this item priority]
(set! map (assoc map item priority))
(set! heap (insert heap item priority))
this)
(hashCode [_] (hash map))
(equals [this o] (identical? this o))
(containsKey [_ item] (contains? map item))
(entryAt [_ k] (find map k))
(seq [_] (seq map))
(without [this item] (dissoc map item) this)
IPersistentStack
(peek [_] [(.-item heap) (.-priority heap)])
(pop [this]
(let [n (two-pass (get-left heap))]
(set! map (dissoc map (.-item heap)))
(set! heap n)
this)))
:cljs
(deftype PriorityMap [^:mutable ^HeapNode heap
^:mutable map]
ISeqable
(-seq [_] (seq map))
ICollection
(-conj [this e]
(let [[item priority] e]
(set! map (assoc map item priority))
(set! heap (insert heap item priority))
this))
IAssociative
(-assoc [this item priority]
(set! map (assoc map item priority))
(set! heap (insert heap item priority))
this)
(-contains-key? [_ item] (contains? map item))
IMap
(-dissoc [this item] (dissoc map item) this)
IStack
(-peek [_] [(.-item heap) (.-priority heap)])
(-pop [this]
(let [n (two-pass (get-left heap))]
(set! map (dissoc map (.-item heap)))
(set! heap n)
this))))
(defn priority-map
"A priority queue that also functions as a map.
Backed by a pairing heap implementation, and a regular map.
NB. We do not implement `decrease-key` for the pairing heap,
instead just insert the item again with a new priority."
([]
(->PriorityMap nil {}))
([& keyvals]
{:pre [(even? (count keyvals))]}
(reduce conj (priority-map) (partition 2 keyvals))))