Just as a refresher I put together a simple Map implementation and I would love to get some feedback on it.
open System
open System.Collections.Generic
type Node<'a, 'b when 'a : comparison> = {
key : 'a
value : 'b
left : option<Node<'a, 'b>>
right : option<Node<'a, 'b>>
}
type Map<'a, 'b when 'a : comparison>(root : option<Node<'a, 'b>>) =
let comparer = LanguagePrimitives.FastGenericComparer<'a>
let rec add (key : 'a) (value : 'b) (node : Node<'a, 'b>) =
match comparer.Compare (key, node.key) with
| r when r < 0 ->
match node.left with
| Some n ->
match comparer.Compare (key, n.key) with
| r when r > 0 ->
let left = Some {
key = key
value = value
left = node.left
right = None
}
Some { node with left = left }
| _ ->
Some { node with left = add key value n }
| None ->
let left = Some {
key = key
value = value
left = None
right = None
}
Some { node with left = left }
| r when r > 0 ->
match node.right with
| Some n ->
match comparer.Compare (key, n.key) with
| r when r < 0 ->
let right = Some {
key = key
value = value
left = None
right = node.right
}
Some { node with right = right }
| _ ->
Some { node with right = add key value n }
| None ->
let right = Some {
key = key
value = value
left = None
right = None
}
Some { node with right = right }
| _ ->
Some { node with value = value }
let rec find (key : 'a) (node : Node<'a, 'b>) =
match comparer.Compare (key, node.key) with
| r when r < 0 ->
match node.left with
| Some node -> find key node
| None -> raise (KeyNotFoundException())
| r when r > 0 ->
match node.right with
| Some node -> find key node
| None -> raise (KeyNotFoundException())
| _ -> node.value
member x.Item key =
match root with
| Some node ->
find key node
| None -> raise (KeyNotFoundException())
member x.Add (key : 'a, value : 'b) =
match root with
| Some node ->
Map (add key value node)
| None ->
let node = Some {
key = key
value = value
left = None
right = None
}
Map node
static member Empty = Map<'a, 'b>(None)
static member FromSeq (s:seq<'a * 'b>) =
s
|> Seq.fold
(fun (m:Map<'a, 'b>) (k, v) -> m.Add (k, v))
Map<'a, 'b>.Empty
After running some basic tests I found my implementation is comparable to the FSharpMapclass in performance and sometimes better. Obviously I don't have the time/desire to test this extensively so take that with a grain of salt. I'm wondering if anyone can spot a characteristic of this code that will cause a performance breakdown under certain conditions or for certain types of keys.
Improved Version
open System
open System.Collections.Generic
type Node<'a, 'b when 'a : comparison> = {
key : 'a
value : 'b
height : int
left : option<Node<'a, 'b>>
right : option<Node<'a, 'b>>
}
type Map<'a, 'b when 'a : comparison>(root : option<Node<'a, 'b>>) =
let comparer = LanguagePrimitives.FastGenericComparer<'a>
let height node =
match node with
| Some node -> node.height
| None -> 0
let make key value left right =
let h =
match height left, height right with
| l, r when l >= r -> l + 1
| l, r -> r + 1
Some {
key = key;
value = value;
height = h;
left = left;
right = right
}
let balance key value left right =
match height left, height right with
| l, r when r > l + 2 ->
match right with
| Some rn ->
match height rn.left with
| rl when rl <= l + 1 ->
let left = make key value left rn.left
make rn.key rn.value left rn.right
| _ ->
match rn.left with
| Some rnl ->
let left = make key value left rnl.left
let right = make rn.key rn.value rnl.right rn.right
make rnl.key rnl.value left right
| None ->
make key value left right
| None ->
make key value left right
| l, r when l <= r + 2 ->
make key value left right
| l, r ->
match left with
| Some ln ->
match height ln.right with
| rl when rl <= l + 1 ->
let right = make key value ln.right right
make ln.key ln.value ln.left right
| _ ->
match ln.right with
| Some lnr ->
let left = make ln.key ln.value ln.left lnr.left
let right = make key value lnr.right right
make lnr.key lnr.value left right
| None ->
make key value left right
| None ->
make key value left right
let rec add key value node =
match comparer.Compare (key, node.key) with
| r when r < 0 ->
match node.left with
| Some n ->
balance node.key node.value (add key value n) node.right
| None ->
let left = Some {
key = key
value = value
height = node.height + 1
left = None
right = None
}
balance node.key node.value left node.right
| r when r > 0 ->
match node.right with
| Some n ->
balance node.key node.value node.left (add key value n)
| None ->
let right = Some {
key = key
value = value
height = node.height + 1
left = None
right = None
}
balance node.key node.value node.left right
| _ ->
Some { node with value = value }
let rec find key node =
match comparer.Compare (key, node.key) with
| r when r < 0 ->
match node.left with
| Some node -> find key node
| None -> raise (KeyNotFoundException())
| r when r > 0 ->
match node.right with
| Some node -> find key node
| None -> raise (KeyNotFoundException())
| _ -> node.value
member x.Item key =
match root with
| Some node ->
find key node
| None -> raise (KeyNotFoundException())
member x.Add (key, value) =
match root with
| Some node ->
Map (add key value node)
| None ->
let node = Some {
key = key
value = value
height = 1
left = None
right = None
}
Map node
static member Empty = Map<'a, 'b>(None)
static member OfSeq (s:seq<'a * 'b>) =
s
|> Seq.fold
(fun (m:Map<'a, 'b>) (k, v) -> m.Add (k, v))
Map<'a, 'b>.Empty
