Does anyone have or know of a persistent prefix trie available in F#?

Question

The performance of F#'s Map and Set are pretty lacking for my particular application. It seems a nice prefix trie would step up performance in my interpreter a good bit, especially in terms of symbol lookups by name. The only caveats are that it must be highly efficient for add and lookup operations (especially when the keys are strings), and immutable for persistence (meaning non-destructive updates).

If no such beast is available, a reference implementation from OCaml or Haskell would help me get started on one.

Thank you very kindly!

Answer 1

To close this thread (see comments on question):

Haskell implementation

OCaml implementation

Answer 2

It seems a nice prefix trie would step up performance in my interpreter a good bit, especially in terms of symbol lookups by name. The only caveats are that it must be highly efficient for add and lookup operations (especially when the keys are strings), and immutable for persistence (meaning non-destructive updates).

Your qualifiers "highly efficient" and "immutable for persistence" are mutually exclusive. Persistent data structures are (typically) inherently very inefficient, often over 10x slower than imperative data structures.

If you want a fast dictionary with keys that are symbols then you want a symbol table. Your public API uses symbols as strings but these are converted internally via hash tables to small positive integers and back. Dictionaries with symbols as keys can then be represented as arrays indexed by the integer used to represent the symbol.

I published an article on symbol tables here.

Answer 3

So, I just ported the one from OCaml. Unfortunately, it runs slower than the standard Map in terms of tryFind. I'm asking why in this thread - Why is my Trie lookup slower than that of the standard F# Map's?

Here's the code -

[<RequireQualifiedAccess>]
module Trie

type Node<'k, 'v when 'k : comparison> =
    { TrieMap : Map<'k, Node<'k, 'v>>
      TrieKvp : ('k list * 'v) option }
    member inline x.IsEmpty = x.TrieKvp.IsNone && x.TrieMap.IsEmpty

let inline make map kvp =
    { TrieMap = map
      TrieKvp = kvp }

let inline makeEmpty () : Node<'k, 'v> = make Map.empty None

let inline isEmpty (node : Node<'k, 'v>) = node.IsEmpty

let rec tryFind (key : 'k list) node =
    match key with
    | [] ->
        match node.TrieKvp with
        | Some (_, value) -> Some value
        | None -> None
    | keyHead :: keyTail ->
        let optSubNode = Map.tryFind keyHead node.TrieMap
        match optSubNode with
        | Some subNode -> tryFind keyTail subNode
        | None -> None

let inline containsKey key node =
    (tryFind key node).IsSome

let rec addInternal (key : 'k list) value node =
    match key with
    | [] -> make node.TrieMap (Some (key, value))
    | keyHead :: keyTail ->
        let newTrie =
            match Map.tryFind keyHead node.TrieMap with
            | Some subTrie -> subTrie
            | None -> makeEmpty ()
        let newTrie2 = addInternal keyTail value newTrie
        make (Map.add keyHead newTrie2 node.TrieMap) node.TrieKvp

let inline add key value node =
    addInternal key value node

let rec addMany kvps node =
    if Seq.isEmpty kvps then node
    else
        let kvpHead = Seq.head kvps
        let kvpTail = Seq.skip 1 kvps
        let newTrie = add (fst kvpHead) (snd kvpHead) node
        addMany kvpTail newTrie

let inline ofList kvps =
    addMany kvps (makeEmpty ())

let inline ofListBy by kvps =
    let pairs = List.map by kvps
    ofList pairs

let rec foldInternal folder rev node state =
    match node.TrieKvp with
    | Some (_, value) -> folder (Map.fold (fun state key value -> foldInternal folder (key :: rev) value state) state node.TrieMap) (List.rev rev) value
    | None -> Map.fold (fun state key value -> foldInternal folder (key :: rev) value state) state node.TrieMap

let inline fold folder state node =
    foldInternal folder [] node state

let rec map (mapper : 'k list -> 'v -> 'a) (node : Node<'k, 'v>) : Node<'k, 'a> =
    match node.TrieKvp with
    | Some (key, value) -> make (Map.map (fun _ value -> map mapper value) node.TrieMap) (Some (key, mapper key value))
    | None -> make (Map.map (fun _ value -> map mapper value) node.TrieMap) None

let inline toValueList node =
    fold (fun state _ value -> value :: state) [] node

let inline singleton (key, value) =
    add key value (makeEmpty ())