Set ADT in OCaml

In chapter 2 of Okasaki’s book, ML’s module system is used to implement an abstract polymorphic Set datatype. We parameterize our set implementation over a “comparable” interface that the set elements must implement.

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
(* "comparable" interface *)
module type Ord =
sig
  type t
  val lt : t -> t -> bool
  val lte : t -> t -> bool
  val eq : t -> t -> bool
end
 
(* implementation of Ord for integers *)
module IntOrd : Ord with type t = int =
struct
  type t = int
  let lt = (<)
  let lte = (<=)
  let eq = (=)
end
 
(* Set interface *)
module type Set =
sig
  (* abstract element and set type *)         
  type elem 
  type set  
  (* set operations *)
  val empty : set
  val insert : elem -> set -> set
  val member : elem -> set -> bool
end
 
(* implementation of a set paramterized over Ord *)
module UnbalSet(Elt : Ord) : Set with type elem = Elt.t =
struct
  type elem = Elt.t
  type 'a tree = 
      Leaf 
    | Node of 'a tree * 'a * 'a tree
  type set = elem tree 
 
  let empty = Leaf
  let rec insert x = function
      Leaf -> Node (Leaf, x, Leaf)
    | Node (a, y, b) as s -> 
        if Elt.lt x y then Node (insert x a, y, b)
        else if Elt.lt y x then Node (a, y, insert x b) 
        else s
 
  let rec member x = function
      Leaf -> false
    | Node (a, y, b) ->
        if Elt.lt x y then member x a               (* two comparisons *)
        else if Elt.lt y x then member x b
        else true
end
 
(* instanciation of a set of comparable integers *)
module IntSet = UnbalSet(IntOrd)

Exercise 2.1 asks to optimize the member operation, by assuming that equality is uncommon we can mostly get away with only one comparison, comparing for equality only when we reached the end of a branch (worst case is now d+1 instead of 2*d comparisons, where d is the depth of the tree):

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
module type Ord =
sig
  type t
  val lt : t -> t -> bool
  val lte : t -> t -> bool
  val eq : t -> t -> bool
end
 
module IntOrd : Ord with type t = int =
struct
  type t = int
  let lt = (<)
  let lte = (<=)
  let eq = (=)
end
 
module type Set =
sig
  type elem
  type set
  val empty : set
  val insert : elem -> set -> set
  val member : elem -> set -> bool
end
 
module UnbalSet(Elt : Ord) : Set with type elem = Elt.t =
struct
  type elem = Elt.t
  type 'a tree = 
      Leaf 
    | Node of 'a tree * 'a * 'a tree
  type set = elem tree 
 
  let empty = Leaf
  let rec insert x = function
      Leaf -> Node (Leaf, x, Leaf)
    | Node (a, y, b) as s -> 
        if Elt.lt x y then Node (insert x a, y, b)
        else if Elt.lt y x then Node (a, y, insert x b) 
        else s
 
  let member x s = 
    let rec member_aux x s z =
      match s with
          Leaf -> x = z  (* comparing for equality when reaching a leaf *)
        | Node(a, y, b) -> 
            if Elt.lt x y then member_aux x a z   (* only one comparison *)
            else member_aux x b y
    in
      match s with
          Leaf -> false
        | Node(_, y, _) -> member_aux x s y             
end
 
module IntSet = UnbalSet(IntOrd)

Les commentaires sont fermés.