### Depth first search

Depth first search is an 'elementary graph algorithm'. This is a purely functional formulation.

(*depth-first-search "Introduction to Algorithms" - Cormen et. al., 1994 *) module Char_map = Map.Make (Char) type graph = (char list) Char_map.t module type S = sig type state val string_of_state : state -> string val depth_first_search : graph -> state end module Dfs : S = struct type colors = White|Gray|Black type state = { d : int Char_map.t ; (*discovery time*) f : int Char_map.t ; (*finishing time*) pred : char Char_map.t ; (*predecessor*) color : colors Char_map.t ; (*vertex colors*) } let string_of_state {d; f; pred; color} = let open Printf in let bindings m fmt = let b = Char_map.bindings m in String.concat ", " (List.map (fun (x,y) -> sprintf fmt x y) b) in sprintf " d = {%s}\n f = {%s}\n pred = {%s}\n" (bindings d "'%c':'%d'") (bindings f "'%c':'%d'") (bindings pred "'%c':'%c'") let depth_first_search g = let node u (t, {d; f; pred; color}) = let rec dfs_visit t u {d; f; pred; color} = let edge (t, {d; f; pred; color}) v = if Char_map.find v color = White then dfs_visit t v {d; f; pred=(Char_map.add v u pred); color} else (t, {d; f; pred; color}) in let t, {d; f; pred; color} = let t = t + 1 in List.fold_left edge (t, {d=Char_map.add u t d; f; pred; color=Char_map.add u Gray color}) (Char_map.find u g) in let t = t + 1 in t , {d; f=(Char_map.add u t f); pred; color=Char_map.add u Black color} in if Char_map.find u color = White then dfs_visit t u {d; f; pred; color} else (t, {d; f; pred; color}) in let v = List.fold_left (fun acc (x, _) -> x::acc) [] (Char_map.bindings g) in let initial_state= {d=Char_map.empty; f=Char_map.empty; pred=Char_map.empty; color=List.fold_right (fun x->Char_map.add x White) v Char_map.empty} in snd (List.fold_right node v (0, initial_state)) end (* Test *) let () = let g = List.fold_right (fun (x, y) -> Char_map.add x y) ['u', ['v'; 'x'] ; 'v', ['y'] ; 'w', ['z'; 'y'] ; 'x', ['v'] ; 'y', ['x'] ; 'z', ['z'] ; ] Char_map.empty in let s = Dfs.depth_first_search g in Printf.printf "%s\n" (Dfs.string_of_state s)