alphabet.ml

alphabet.ml

open Base;;

let dependencies (sorted_words: string list): (char, char Hash_set.t) Hashtbl.t =
  let
    (* For now assume Latin chars from English alphabet.
       This could certainly be more clever but isn't really the heart of the problem. *)
    graph = Hashtbl.create ~growth_allowed:true ~size:26 (module Char)
  in
  let
    same_first_char a b = String.equal (String.prefix a 1) (String.prefix b 1)
  in
  let
    insert_dep (dep: char) (deps: char Hash_set.t option): (char Hash_set.t option) =
      match deps with
        | None -> Some (Hash_set.of_list (module Char) [dep])
        | Some vs ->
          Hash_set.add vs dep;
          Some vs
  in
  let rec insert_distinct_first_chars (vs: string list) =
    match vs with
      | x1::x2::xs ->
        if not (String.is_empty x1 || String.is_empty x2 || same_first_char x1 x2) then Hashtbl.change graph (String.get x1 0) ~f:(insert_dep (String.get x2 0));
        insert_distinct_first_chars (x2::xs)
      | _ -> ()
  in let rec accumulate_dependencies (relative_sorted_words: string list) =
      let
        non_empty_rsw = List.filter ~f:(Fn.non String.is_empty) relative_sorted_words
      in
      let
        groupings: string list list = List.group non_empty_rsw ~break:(fun a b -> not (same_first_char a b))
      in
        insert_distinct_first_chars non_empty_rsw;
        groupings
          |> List.iter ~f:(fun (rsw: string list) -> rsw |> List.map ~f:(fun word -> String.drop_prefix word 1) |> accumulate_dependencies)
  in
    accumulate_dependencies sorted_words;
    graph;;

match word_list |> dependencies |> Hashtbl.to_alist |> List.map ~f:(fun (k, vs) -> (k, Hash_set.to_list vs)) |> Tsort.sort with
  | Tsort.Sorted vs ->
    vs |> List.rev |> List.iter ~f:(fun v -> Caml.Printf.printf " - %c\n" v)
  | _ ->
    Caml.Printf.printf "Cycle!";;