open System
open System.IO
open System.Collections.Generic

let flip f a b = f b a

let rec yobaFold fa fi s  = match s with | a, None    -> a
                                         | a, Some(i) -> yobaFold fa fi (fa a i , fi i)

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 = {p: Transmute Option; c:int}

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

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 -> []
                   | res  -> yobaFold(fun a {c=c} -> c::a) (fun {p=p} -> p) ([], res)
                             |> List.map(fun i -> words.[i])

let words    = File.ReadAllLines @"D:\Arc\Dropbox\Dropbox\Projects\FSharp\AprilFpContest\AprilFpContest\bin\Debug\words.txt"
let wordsMap = buildMap words
let pairs    = ["МУХА","СЛОН"; "ДЕНЬ","НОЧЬ"; "СНЕГ","ВОДА"; "ОТЕЦ", "МАТЬ";
                "РУКА","НОГА"; "ЗИМА","ЛЕТО"; "СВЕТ","ТЬМА"; "ЛИПА", "КЛЁН"]
               |> Seq.map(fun (s,e) -> s.ToLower(), e.ToLower())
pairs |> Seq.map(fun p -> p, findWay words wordsMap p) |> Seq.iter(printfn "%A")