An implementation of tries and an example anagrams application relying on ispell word lists.

Tries

type Trie<'key, 'value> =  Node of ('value option * Map<'key, Trie<'key, 'value>>)
  with
    override x.ToString() =
      let buf = new System.Text.StringBuilder()
      match x with
      | Node (v, m) ->
          Printf.bprintf buf "Node( %A, { " v
          for KeyValue(k, v) in m do
            Printf.bprintf buf "%A => %A" k v
          Printf.bprintf buf " } )"
      buf.ToString()

module Trie =

  let empty = Node (None, Map.empty)

  ///Returns Some res if the path lands to a value, None otherwise.
  let rec tryFind keys trie =
    match keys, trie with
    | [], Node (v,_) -> v //Note: can be None or Some _
    | x::xs, Node(_, m) ->
        match Map.tryFind x m with
        | Some t -> tryFind xs t
        | None -> None

  ///Returns true if the path lands to a value, false otherwise.
  let rec mem keys trie =
    match keys, trie with
    | [], Node (None,_) -> false
    | [], Node (Some v, _) -> true
    | x::xs, Node(_, m) ->
        match Map.tryFind x m with
        | Some t -> mem xs t
        | None -> false

  ///Returns a new trie after adding the value at the end of the path
  ///if there is no existing value, or replacing the current one if necessary.
  let rec add keys endValue trie =
    match keys, trie with
    | [], Node(_, m) -> Node(Some endValue, m)
    | x::xs, Node(v, m) ->
        let a =
          match Map.tryFind x m with
          | Some t -> t
          | None -> empty
        let b = add xs endValue a
        Node(v, Map.add x b m)

  ///Returns a new trie after removing the current value at the end of the path.
  ///If the path extends beyond the removed value, nothing is done, otherwise, the
  ///end is deleted
  let rec remove keys trie =
    match keys, trie with
    | [], Node(_, m) -> Node(None, m)
    | x::xs, Node(v, m) ->
        match Map.tryFind x m with
        | Some t ->
            let newTrie = remove xs t
            Node(v, if newTrie = empty then Map.remove x m else Map.add x newTrie m)
        | None -> trie

  let rec map f = function
    | Node(Some v, m) -> Node(Some(f v), Map.map (fun _ t -> map f t) m)
    | Node(None, m) -> Node(None, Map.map (fun _ t -> map f t) m)

  let rec iter f = function
    | Node(Some v, m) -> f v; Map.iter (fun _ t -> iter f t) m
    | Node(None, m) -> Map.iter (fun _ t -> iter f t) m

  let rec fold f acc = function
    | Node(Some v, m) -> //we use a traditional loop to avoid tail calls
        let mutable res = f acc v
        for (KeyValue(_, t)) in m do
          res <- f res (fold f acc t)
        res
    | Node(None, m) ->
        let mutable res = acc
        for (KeyValue(_, t)) in m do
          res <- f res (fold f acc t)
        res
    

Anagrams

open System.IO

open Anagram
open Anagram.Trie

let mutable store: Trie<char,Set<string>> = Node(None, Map.empty)

let toSortedKeys (s:string) =  Seq.to_list s |> List.sort

let anagrams s =
  match tryFind (toSortedKeys s) store with
  | Some acc -> acc
  | None -> Set.empty

let addWord s =
  store <- add (toSortedKeys s) (Set.add s (anagrams s)) store

let removeWord s =
  store <- add (toSortedKeys s) (Set.remove s (anagrams s)) store
  if Set.count (anagrams s) = 0 then
    store <- remove (toSortedKeys s) store

let reader file =
  seq { use reader = new StreamReader(File.OpenRead(file))
        while not reader.EndOfStream do
          yield reader.ReadLine()
      }

do
  printfn "Loading dictionaries..."

  //source : http://sourceforge.net/projects/wordlist/files/Ispell-EnWL/3.1.20/ispell-enwl-3.1.20.zip/download
  let dir = @"C:\ispell-enwl-3.1.20"
  for file in Directory.GetFiles(dir) do
    if Path.GetFileName(file.ToLower()) <> "readme" then
      for line in reader file do
        addWord (line.ToLower())

  printfn "Type the word whose anagrams you search, and hit <ENTER>"
  let s = System.Console.ReadLine()
  anagrams s |> Seq.iter (printfn "%A")

Comments are closed.