open ExtLib;; let (|>) x f = f x;; let flip f x y = f y x;; module M = Map.Make(String);; module S = Set.Make(String);; let dist s1 s2 = (* определяет расстояние между словами - число различных букв *) List.map2 (fun a b -> if a=b then 0 else 1) (String.explode s1) (String.explode s2) |> List.fold_left (+) 0;; let make_graph ws = (* из списка слов строит таблицу слово -> список соседей (на расстоянии 1) *) List.fold_left (fun m w -> M.add w (List.filter (fun w2-> dist w w2 = 1) ws) m) M.empty ws;; let find_path g w1 w2 = (* Поиск кратчайшего пути в графе *) let rec loop e used = (* в цикле идем по последовательности слов, точнее путей до них от начального *) match Enum.get e with | None -> None (* если она пуста, значит решение не найдено *) | Some path -> (* получен путь к очередному слову *) let neighbours = M.find (List.hd path) g in (* найти его соседей *) if List.exists ((=) w2) neighbours then Some (w2::path) else (* если среди них есть искомое, ответ найден *) let new_words = List.filter (fun w-> not (S.mem w used)) neighbours in (* выбираем из соседей те, что еще не использовались *) let used' = List.fold_left (flip S.add) used new_words in (* добавляем ко множеству использованных слов *) (* добавляем пути к ним в хвост последовательности, переходим к следующему *) loop (Enum.append e (List.enum new_words |> Enum.map (fun w-> w::path))) used' in loop (List.enum [[w1]]) S.empty;; let words = [ "мука"; "рука"; "руна"; "луна"; "лупа"; "липа"; "лира"; "вира"; "вера"; "вена"; "вина"; "вино"; "кино"; "кило"; "килт"; "киот"; "крот"; "кром"; "крем"; "крен"; "клен"; "плен"; "план"; "клан"; "клон"; "гром"; "срам"; "кран"; "муха"; "слон"];; match find_path (make_graph words) "муха" "слон" with | None -> print_endline "path not found" | Some path -> List.rev path |> String.join "->" |> print_endline;;