SHOW:
|
|
- or go back to the newest paste.
| 1 | open System | |
| 2 | open System.IO | |
| 3 | open System.Collections.Generic | |
| 4 | ||
| 5 | let flip f a b = f b a | |
| 6 | ||
| 7 | let rec yobaFold fa fi s = match s with | a, None -> a | |
| 8 | | a, Some(i) -> yobaFold fa fi (fa a i , fi i) | |
| 9 | ||
| 10 | let diff word1 word2 = Seq.zip word1 word2 | |
| 11 | |> Seq.filter(fun (w1,w2) -> w1 <> w2) | |
| 12 | |> Seq.length | |
| 13 | ||
| 14 | let buildMap ws = let l = Array.length ws - 1 | |
| 15 | seq{ for i in 0..l do
| |
| 16 | for j in i..l do | |
| 17 | if diff ws.[i] ws.[j] < 2 | |
| 18 | then yield i, j; yield j, i } | |
| 19 | |> Seq.groupBy(fst) | |
| 20 | |> Seq.map(fun (k,s) -> k, s |> Seq.map(snd)) | |
| 21 | |> Map.ofSeq | |
| 22 | ||
| 23 | type Transmute = {p: Transmute Option; c:int}
| |
| 24 | ||
| 25 | let transmutes (map:Map<int,_>) start = | |
| 26 | let visit = Seq.fold(fun a {c=c} -> Set.add c a)
| |
| 27 | let next vs curs = | |
| 28 | let next1 c = map.[c.c] |> Seq.filter(flip Set.contains vs >> not) | |
| 29 | |> Seq.map(fun n -> {p = Some(c); c = n})
| |
| 30 | curs |> Seq.map(next1) |> Seq.collect(fun n -> n) | |
| 31 | let rec trans vs olds = | |
| 32 | if Seq.isEmpty olds then Seq.empty | |
| 33 | else seq{ yield! olds;
| |
| 34 | - | yield! trans vs (next (visit vs olds) olds) } |
| 34 | + | let newVs = (visit vs olds) in yield! trans newVs (next newVs olds) } |
| 35 | trans Set.empty [{p=None; c=start}]
| |
| 36 | ||
| 37 | let findWay words map (start, target) = | |
| 38 | let s = Array.findIndex ((=)start) words | |
| 39 | let t = Array.findIndex ((=)target) words | |
| 40 | let way = transmutes map s |> Seq.tryFind(fun {c=c} -> c=t)
| |
| 41 | match way with | None -> [] | |
| 42 | | res -> yobaFold(fun a {c=c} -> c::a) (fun {p=p} -> p) ([], res)
| |
| 43 | |> List.map(fun i -> words.[i]) | |
| 44 | ||
| 45 | let words = File.ReadAllLines @"D:\Arc\Dropbox\Dropbox\Projects\FSharp\AprilFpContest\AprilFpContest\bin\Debug\words.txt" | |
| 46 | let wordsMap = buildMap words | |
| 47 | let pairs = ["МУХА","СЛОН"; "ДЕНЬ","НОЧЬ"; "СНЕГ","ВОДА"; "ОТЕЦ", "МАТЬ"; | |
| 48 | "РУКА","НОГА"; "ЗИМА","ЛЕТО"; "СВЕТ","ТЬМА"; "ЛИПА", "КЛЁН"] | |
| 49 | |> Seq.map(fun (s,e) -> s.ToLower(), e.ToLower()) | |
| 50 | pairs |> Seq.map(fun p -> p, findWay words wordsMap p) |> Seq.iter(printfn "%A") | |
| 51 | Console.ReadLine() |> ignore |
