Sample of Huffman encoding of strings

Huffman.fs

module Huffman

// ref: http://cs.hubfs.net/topic/None/56608
open BinomialHeap

type private Tree = Leaf of char | Branch of Tree*Tree

let private initialForest (stringData : string) = 
    // ref: http://www.fssnip.net/n5
    let createHistogram =
        Seq.fold (fun acc key ->
            if Map.containsKey key acc
            then Map.add key (acc.[key] + 1) acc
            else Map.add key 1 acc
        ) Map.empty
        >> Seq.sortBy (fun kvp -> -kvp.Value)
    let emptyHeap = empty_custom (fun a b -> basic_compare (fst a) (fst b))
    let histogram = createHistogram stringData
    histogram |> Seq.fold (fun heap kvp -> BinomialHeap.insert (kvp.Value, Leaf kvp.Key) heap) emptyHeap

let rec private buildTree heap =
    if isEmpty heap then 
        raise(new System.Exception())
    let (p,t), heap2 = removeMin heap
    if isEmpty heap2 then
        t
    else
        let (p2,t2), heap3 = removeMin heap2
        let heap4 = insert (p+p2,Branch (t, t2)) heap3
        buildTree heap4

let rec private treeToTable path tree =
    match tree with
    | Leaf ch -> [(path, ch)]
    | Branch (tl, tr) -> treeToTable (path+"0") tl @ treeToTable (path+"1") tr  

let createCodeTable (stringData : string) =
    stringData |>
    initialForest |>
    buildTree |>
    treeToTable "" |> 
    List.sortBy (fun (path,ch) -> String.length path)