Here is a F# implementation of a purely functional binomial heap. It is an adaptation of the strict BinomialHeap implentation on page 24 of Chris Okasaki's book "Purely Functional Data Structures".
I must admit, not having ml's functors or haskell's type classes makes implementing data structures a tad painful.
My first draft was a simple literal translation of the book's code using the structural comparision operators (<) (<=). I then changed it to have the heap type carry around it's comparision function.
(As mentioned in the Red-Black tree thread) I agree that the attempt at faking a functor by generating a collection of closures, (Set.make) is not as good as passing around the comparator.
Am I correct in thinking that the structural comparision operators are a very thin layer over the IL and there would be no way to custom implement the structural comparision function for user defined f# types (other than using a class)?
"Primitives.CompilerSpecific.StructuralCompareFast" is the comparator for something like
type ('a,'b) either = Left of 'a | Right of 'a
And provides the comparision for any type defined like this? (gives slightly interesting behaviour at times).
While i'm getting things off my chest... a pet peive of mine is comparision functions returning int's. It drives me nuts in Java, it's just not declarative enough or clear about the comparision. Maybe someone can show me a way decent way to use it. My solution.. use the SML way
Anyway here is the code :
module BinomialHeap
type ord = LT | EQ | GT
type 'a comparer = 'a -> 'a -> ord
type 'a tree = Node of int * 'a * 'a tree list
type 'a heap = { cf : 'a comparer ;
heap : 'a tree list }
let basic_compare x1 x2 =
let a = Pervasives.compare x1 x2 in
if a < 0 then LT
else if a > 0 then GT
else EQ
let empty_custom cf = { cf = cf ; heap = [] }
let empty = {cf=basic_compare; heap = []}
let isEmpty {heap=heap} = heap = []
let rank (Node (r,_,_)) = r
let root (Node (_,x,_)) = x
let link cf (Node (r, x1, c1) as t1) (Node (_, x2, c2) as t2) =
match cf x1 x2 with
| GT -> Node (r+1, x2, t1 :: c2)
| _ -> Node (r+1, x1, t2 :: c1)
let rec insTree cf (t: 'a tree) ts =
match ts with
| [] -> [t]
| t'::ts' ->
match basic_compare (rank t) (rank t') with
| LT -> t::ts
| _ -> insTree cf (link cf t t') ts'
let insert x {cf=cf;heap=heap} =
let newheap = insTree cf (Node (0, x, [])) heap in
{cf=cf; heap=newheap}
let rec merge' cf treepair =
match treepair with
| (ts1, []) -> ts1
| ([], ts2) -> ts2
| ((t1::ts1' as ts1), (t2::ts2' as ts2)) ->
match basic_compare (rank t1) (rank t2) with
| LT -> t1 :: (merge' cf (ts1', ts2))
| GT -> t2 :: (merge' cf (ts1, ts2'))
| EQ -> insTree cf (link cf t1 t2) (merge' cf (ts1', ts2'))
let merge {cf=cf;heap=heap1} {heap=heap2} =
let newheap = merge' cf (heap1, heap2) in
{cf=cf;heap=newheap}
exception Empty_Heap
let rec removeMinTree cf heap =
match heap with
| [] -> raise Empty_Heap
| [t] -> (t, [])
| (t::ts) ->
let (t', ts') = removeMinTree cf ts in
match cf (root t) (root t') with
| LT | EQ -> (t, ts)
| _ -> (t', t::ts')
let findMin {cf=cf;heap=heap} =
let (t, _) = removeMinTree cf heap in
root t
let removeMin {cf=cf;heap=heap} =
let (Node (_, x, ts1), ts2) = removeMinTree cf heap in
(x, {cf=cf; heap=(merge' cf ((List.rev ts1), ts2))})
let deleteMin heap = snd (removeMin heap)
isEmpty = O(1)
insert = O(1) amortized (O(log n) worst case)
merge = O(log n)
findMin, removeMin, deleteMin = O(log n)
findMin can be O(1) if we store the smallest element separately
Chris Okasaki goes into great depth about variations of binomial heaps, using lazyness to give better guarentees about amortized time bounds, and a variation that gives merge in O(1) !.
Binomial heaps improve over vanilla heaps on insert and merge operations. O(1) rather than O(log n) and O(log n) rather than O(n) respectively.
Fibonacci Heaps sound like a good topic to continue with another time ;).