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
|
(*
* Priority queues implemented as leftist trees
*
* -- Allen
*)
structure PriorityQueue :> PRIORITY_QUEUE =
struct
(* A leftist tree is a binary tree with priority ordering
* with the invariant that the left branch is always the taller one
*)
datatype 'a leftist = NODE of 'a * int * 'a leftist * 'a leftist
| EMPTY
datatype 'a priority_queue = PQ of { less : 'a * 'a -> bool,
root : 'a leftist ref
}
exception EmptyPriorityQueue
(* assume a is smaller than b *)
fun mergeTrees less (a,b) =
let fun dist EMPTY = 0
| dist (NODE(_,d,_,_)) = d
fun m (EMPTY,a) = a
| m (a, EMPTY) = a
| m (a as NODE(x,d,l,r), b as NODE(y,d',l',r')) =
let val (root,l,r) =
if less(x,y) then (x,l,m(r,b)) else (y,l',m(r',a))
val d_l = dist l
val d_r = dist r
val (l,r) = if d_l >= d_r then (l,r) else (r,l)
in
NODE(root,1+Int.max(d_l,d_r),l,r)
end
in m (a, b)
end
fun create less = PQ { less = less, root = ref EMPTY }
fun createN (less,_,_) = create less
fun min (PQ { root = ref(NODE(x,_,_,_)), ... }) = x
| min _ = raise EmptyPriorityQueue
fun isEmpty (PQ { root = ref EMPTY, ... }) = true
| isEmpty _ = false
fun clear (PQ { root, ... }) = root := EMPTY
fun deleteMin (PQ { root = root as ref(NODE(x,_,l,r)), less }) =
(root := mergeTrees less (l,r); x)
| deleteMin _ = raise EmptyPriorityQueue
fun merge (PQ { root = r1, less }, PQ { root = r2, ...}) =
PQ { root = ref(mergeTrees less (!r1,!r2)), less = less }
fun mergeInto { src = PQ { root = ref t1, less },
dst = PQ { root = r as ref t2, ...} } =
r := mergeTrees less (t1,t2)
fun mergeElems (less, q, elements) =
let fun m (q,[]) = q
| m (q,e::es) = m(mergeTrees less (q, NODE(e,1,EMPTY,EMPTY)), es)
in m(q, elements)
end
fun insert (PQ { root = r as ref t1, less}) x =
r := mergeTrees less (t1,NODE(x,1,EMPTY,EMPTY))
fun fromList less list =
PQ { root = ref(mergeElems(less, EMPTY, list)), less = less }
fun collect (EMPTY, e) = e
| collect (NODE(x,_,l,r),e) = collect(l,collect(r,x::e))
fun toList (PQ { root = ref t, ... }) = collect (t, [])
end
|
