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
|
(* Copyright (C) 2007-2007 Wesley W. Terpstra
*
* MLton is released under a HPND-style license.
* See the file MLton-LICENSE for details.
*)
structure Heap:
sig
(* Sorts the provided array relative to the lessthan argument*)
val heapSort: 'a array * ('a * 'a -> bool) -> unit
(* Precondition: array is 0+ true values followed by 0+ false values *)
(* Finds the index of the first array entry where: f x = false *)
val binarySearch: 'a array * ('a -> bool) -> int
end =
struct
fun heapSort (a : 'a array, lessthan : 'a * 'a -> bool) =
let
open Array
(* Push the hole down until value > both children *)
fun pushHoleDown ( hole, end_of_heap, value ) =
let
val left_child = Int.+ (Int.* (hole, 2), 1)
val right_child = Int.+ (left_child, 1)
in
(* Recursion: two children *)
if Int.< (right_child, end_of_heap)
then let val left_value = sub (a, left_child)
val right_value = sub (a, right_child)
val (bigger_child, bigger_value) =
if lessthan (left_value, right_value)
then (right_child, right_value)
else (left_child, left_value)
in if lessthan (bigger_value, value)
then update (a, hole, value)
else (update (a, hole, bigger_value);
pushHoleDown (bigger_child, end_of_heap, value))
end
(* Base case: one child *)
else if right_child = end_of_heap
then let val left_value = sub (a, left_child)
in if lessthan (left_value, value)
then update (a, hole, value)
else (update (a, hole, left_value);
update (a, left_child, value))
end
(* Base case: no children *)
else update (a, hole, value)
end
(* Move largest element to end_of_table, then restore invariant *)
fun sortHeap end_of_heap =
let val end_of_heap = Int.- (end_of_heap, 1)
in if end_of_heap = 0 then () else
let val value = sub (a, end_of_heap)
in update (a, end_of_heap, sub (a, 0));
pushHoleDown (0, end_of_heap, value);
sortHeap end_of_heap
end end
(* Start at last node w/ parent, loop till 0: push down *)
val heapSize = Array.length a
fun heapify i =
if i = 0 then () else
let val i = Int.- (i, 1)
in pushHoleDown (i, heapSize, sub (a, i));
heapify i
end
in
if Int.<= (heapSize, 1) then () else
(heapify (Int.div (heapSize, 2)); sortHeap heapSize)
end
fun binarySearch (a : 'a array, f : 'a -> bool) =
let
fun loop (lower, upper) =
(* Base case: one element left *)
if Int.- (upper, lower) = 1
then if f (Array.sub (a, lower)) then upper else lower
(* Recursive case: check middle *)
else let val mid = Int.div (Int.+ (lower, upper), 2)
in if f (Array.sub (a, mid))
then loop (mid, upper)
else loop (lower, mid)
end
val size = Array.length a
in
if size = 0 then 0 else loop (0, size)
end
end
|
