open System
open System.IO
open Microsoft.FSharp.Collections

let flip f a b = f b a

let diff word1 word2 = Seq.zip word1 word2
                      |> Seq.filter(fun (w1,w2) -> w1 <> w2)
                      |> Seq.length

let buildMap ws = let l = Array.length ws - 1
                  seq{ for i in 0..l do
                       for j in i..l do
                       if diff ws.[i] ws.[j] < 2
                       then yield i, j; yield j, i }
                  |> Seq.groupBy(fst)
                  |> Seq.map(fun (k,s) -> k, s |> Seq.map(snd))
                  |> Map.ofSeq

type Transmute = {s:int;c:int; h:int list}

let transmutes (map:Map<int,_>) start =
    let visit   = Seq.fold(fun a {c=c} -> Set.add c a)
    let next vs curs =
        let nxt c = map.[c.c]
                    |> Seq.filter(flip Set.contains vs >> not)
                    |> Seq.map(fun n -> {s=start;h = c.c::c.h; c = n})
        curs |> Seq.map(nxt) |> Seq.collect(fun n -> n)
    let rec trans vs olds = seq{ yield! olds;
                                 let nvs  = visit vs olds
                                 let news = next nvs olds
                                 if Seq.isEmpty news |> not
                                 then yield! trans nvs news }
    trans Set.empty [{s=start;c=start; h=[]}]

let findWay words map (start, target) =
    let s = Array.findIndex ((=)start) words
    let t = Array.findIndex ((=)target) words
    let way = transmutes map s |> Seq.tryFind(fun {c=c} -> c=t)
    match way with | None    -> [] | Some(r) -> r.h

let words    = File.ReadAllLines @"C:\words.txt"
let wordsMap = buildMap words
let printWay way = way |> Seq.map(fun i -> words.[i]) |> List.ofSeq

//ОРИГИНАЛЬНОЕ ЗАДАНИЕ
["МУХА","СЛОН"; "ДЕНЬ","НОЧЬ"; "СНЕГ","ВОДА"; "ОТЕЦ", "МАТЬ";
 "РУКА","НОГА"; "ЗИМА","ЛЕТО"; "СВЕТ","ТЬМА"; "ЛИПА", "КЛЁН"]
|> Seq.map(fun (s,e) -> s.ToLower(), e.ToLower())
|> Seq.map(fun p -> p, findWay words wordsMap p |> printWay)
|> Seq.iter(printfn "%A")


//ДОПОЛНИТЕЛЬНОЕ ЗАДАНИЕ
let mt  = wordsMap |> PSeq.map(fun k -> k.Key)
                   |> PSeq.map(transmutes wordsMap)
                   |> PSeq.collect(fun x -> x)
                   |> PSeq.maxBy(fun x -> x.h.Length)
Console.WriteLine("{0} - {1}: {2} \n", words.[mt.s], words.[mt.c], mt.h.Length)
Console.WriteLine(Seq.reduce(fun a s -> a + " " + s) (printWay mt.h))

Console.ReadLine()