open ExtString;; 
let (|>) x f = f x;; 
 
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) *) 
  let h = Hashtbl.create 10 in 
  ws |> List.iter (fun w-> Hashtbl.add h w (List.filter (fun w2-> dist w w2 = 1) ws));  
  h;;  
 
let find_path g w1 w2 = (* Поиск кратчайшего пути в графе *) 
  let used = Hashtbl.create 10 in (* множество посещенных вершин *) 
  let que = Queue.create () in (* очередь обработки. содержит списки - пути от начального до данного *) 
  Queue.add [w1] que; (* помещаем в нее начальное слово *) 
  let rec loop () =  
    if Queue.is_empty que then None else (* если очередь кончилась, значит решение не найдено *) 
    let path = Queue.take que in (* взять путь к очередному слову *) 
    let neighbours = Hashtbl.find g (List.hd path) in (* найти соседей этого слова *) 
    if List.exists ((=) w2) neighbours then Some (w2::path) else (* если среди них есть искомое, ответ найден *) 
    (*иначе добавить непосещенные слова из спика в очередь и пометить как посещенные *) 
    (List.iter (fun w-> if not (Hashtbl.mem used w) then (Hashtbl.add used w (); Queue.add (w::path) que)) neighbours; 
    loop ()) in 
  loop ();; 
     
let words = [ 
  "мука"; "рука"; "руна"; "луна"; "лупа"; "липа"; "лира"; "вира"; 
  "вера"; "вена"; "вина"; "вино"; "кино"; "кило"; "килт"; "киот"; 
  "крот"; "кром"; "крем"; "крен"; "клен"; "плен"; "план"; "клан"; 
  "клон"; "гром"; "срам"; "кран"; "муха"; "слон"];; 
 
match find_path (make_graph words) "муха" "слон" with 
| None -> print_endline "path not found" 
| Some path -> List.rev path |> String.join "->" |> print_endline;;