let of_string x = Re.Str.(split (regexp " *> *")) (String.trim x) let topic x = let path = of_string x in try List.nth path (List.length path - 1) with _ -> "" module Map = Map.Make(String) let edges x map = try Map.find x map with Not_found -> (String_set.empty, String_set.empty) let edges_with_context context (contexts, subtopics) = (String_set.add context contexts, subtopics) let edges_with_subtopic subtopic (contexts, subtopics) = (contexts, String_set.add subtopic subtopics) let rec list_to_map map = function | [] -> map | [topic] -> let edges = edges topic map in Map.add topic edges map | context :: topic :: tail -> let context_edges = edges context map in let topic_edges = edges topic map in let map = map |> Map.add context (edges_with_subtopic topic context_edges) |> Map.add topic (edges_with_context context topic_edges) in list_to_map map (topic :: tail) let to_map map set = List.fold_left (fun acc elt -> list_to_map acc (of_string elt)) map @@ String_set.elements set let roots map = let root_keys acc (key, (contexts, _topics)) = if String_set.is_empty contexts then key :: acc else acc in List.fold_left root_keys [] @@ Map.bindings map