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")