A functional binary heap implementation

I've implemented a binary heap in F#. It's pure and uses zippers for tree modification.
To test it out I have implemented heap sort using it but it takes 10 seconds to sort a list of 100 000. Regular List.sort is instant and since heap sort should have the same complexity I'm wondering what I can do to improve my implementation.

Profiling revealed most of the time (above 50%) is spent in the bubble down, which is to be expected since sort is basically just don't a bunch of removes but nothing in the method is really exceptionally slow (that I can see).

```
#nowarn "25"

namespace FSharpExt

module Heap =
type HeapNode =
| Full of 'a 'b HeapNode * HeapNode
| Half of 'a 'b HeapNode
| Leaf of 'a * 'b
| Empty

let (|KeyValue|) zipper =
match zipper with
| Full(k, v, _, _) | Half(k, v, _) | Leaf(k, v) -> (k, v)
| Empty -> failwith "List is empty"

let cut node =
match node with
| Leaf(k, v) -> Empty
| Half(k, v, _) -> Leaf(k, v)
| Full(k, v, left, _) -> Half(k, v, left)

type Direction = Left | Right
type Pointer = Direction list

let rec next pointer =
match pointer with
| [] -> [Left]
| x :: xs when x = Left -> Right :: xs
| x :: xs -> Left :: next xs

let rec previous pointer =
match pointer with
| [Left] -> []
| x :: xs when x = Right -> Left :: xs
| x :: xs -> Right :: previous xs

type Zipper = Zipper of HeapNode (HeapNode Direction) list

let moveLeftZipper (Zipper((Full(_, _, left, _) | Half(_, _, left)) as node, path)) = Zipper(left, (node, Left) :: path)

let moveRightZipper (Zipper(Full(_, _, _, right) as node, path)) = Zipper(right, (node, Right) :: path)

let moveDirectionZipper direction zipper =
match direction with
| Left -> moveLeftZipper zipper

First of all I'm not surprised that your algorithm is significantly slower than List.sort:

• List.sort is implemented using Array.Sort, which uses introsort. Normal (array-based) heapsort is one of the slower sorting algorithms.

• When compared with normal heapsort, you're using a separate object for each item in the collection.

• When compared with mutable tree-based heapsort, you're also creating garbage when "mutating" the tree.

All these put together mean that functional heapsort is never going to be anywhere near List.sort in terms of performance.

I don't see why you're using zippers here at all. After each operation, the zipper is positioned at the root of the tree, so you might as well use just the binary tree (plus a pointer to the next leaf position). All it does is to make your code more complicated (and probably less efficient).

type HeapNode =

'a and 'b are pretty bad names. All names you use should be meaningful.

| Full of 'a * 'b * HeapNode * HeapNode
| Half of 'a * 'b * HeapNode
| Leaf of 'a * 'b
| Empty

I don't understand why do you have both Empty and a special case for inner node with one child empty.

let (|KeyValue|) zipper =

This is very confusing, since zipper is not a Zipper, it's a HeapNode.

let rec next pointer =
    match pointer with
    | []                    -> [Left]
    | x :: xs when x = Left -> Right :: xs
    | x :: xs               -> Left :: next xs

I don't see any reason to use when here, you could write this as:

let rec next pointer =
    match pointer with
    | []          -> [Left]
    | Left :: xs  -> Right :: xs
    | Right :: xs -> Left :: next xs

Or even (if you're okay with not naming the parameter):

let rec next =
    function
    | []          -> [Left]
    | Left :: xs  -> Right :: xs
    | Right :: xs -> Left :: next xs

let rec toRootZipper (Zipper(current, path) as zipper) =
    match path with
    | []      -> zipper
    | x :: xs -> zipper |> moveUpZipper |> toRootZipper

You don't need to name variables you're not going to use. Here, you could just write _ instead of x :: xs.

let ofList list = 
    match list with
    | []            -> empty
    | first :: tail -> List.fold (fun h x -> insert x h) (singleton first) tail

You could start folding from empty instead of singleton first. That way, you wouldn't even need a special case for the empty list:

let ofList list = List.fold (fun h x -> insert x h) empty list

StackExchange Code Review Q#56255, answer score: 2