91 lines
3.0 KiB
FSharp
91 lines
3.0 KiB
FSharp
module _98
|
|
|
|
open System.IO
|
|
open common
|
|
|
|
let anagramSquares =
|
|
|
|
let words =
|
|
File.ReadAllLines(@"98_words.txt")
|
|
|> Array.collect (fun line -> line.Split(','))
|
|
|> Array.map (fun w -> w.Replace("\"", "").ToLower())
|
|
|
|
let groupAnagrams =
|
|
let concatCharArray (cs:char array) = new string(cs)
|
|
// sort by characters in each string and then glue them back together
|
|
Seq.groupBy (Array.ofSeq >> Array.sort >> (fun cs -> new string(cs)))
|
|
>> Seq.map snd
|
|
>> Seq.filter (fun l -> Seq.length l > 1)
|
|
>> Seq.map Array.ofSeq
|
|
|
|
let pairwiseTuples =
|
|
Seq.collect (
|
|
combinations 2
|
|
>> Seq.map (fun l -> l.[0], l.[1])
|
|
)
|
|
|
|
let wordAnagrams =
|
|
words
|
|
|> groupAnagrams
|
|
|> pairwiseTuples
|
|
|
|
let squares =
|
|
allSquares
|
|
|> Seq.takeWhile (digitCount >> ((>) 10))
|
|
|> Seq.groupBy digitCount
|
|
|> Seq.map (fun (dc,sqs) -> (dc, sqs |> Seq.map string |> Array.ofSeq))
|
|
|> Map.ofSeq
|
|
|
|
let hasReplacementDictionary (s1, s2) (t1, t2) =
|
|
|
|
let rec hasReplacementDictionary (sToT, tToS) (source, target) =
|
|
match source, target with
|
|
// have already seen this exact mapping -> skip it
|
|
| s::ss, t::tt when Map.containsKey s sToT && (Map.find s sToT) = t
|
|
-> hasReplacementDictionary (sToT, tToS) (ss, tt)
|
|
// have a mapping for the source, but it's not the target -> failure
|
|
| s::_, _ when Map.containsKey s sToT
|
|
-> false
|
|
// have a mapping for the target, but it's not the source -> failure
|
|
| _::_, t::_ when Map.containsKey t tToS
|
|
-> false
|
|
// never before seen mapping -> add it
|
|
| s::ss, t::tt
|
|
-> hasReplacementDictionary (Map.add s t sToT, Map.add t s tToS) (ss, tt)
|
|
// end of the line - a successful translation!
|
|
| [], [] -> true
|
|
| _ -> raise(System.ArgumentException("words not equal length"))
|
|
|
|
let los = List.ofSeq
|
|
let s = List.append (los s1) (los s2)
|
|
let t = List.append (los t1) (los t2)
|
|
hasReplacementDictionary (Map.empty, Map.empty) (s, t)
|
|
|
|
let tupleSeqAddReverse =
|
|
Seq.collect (fun (i,j) -> seq {yield (i,j); yield (j,i)})
|
|
|
|
let squareAnagrams =
|
|
squares
|
|
|> Map.map (fun _ s ->
|
|
s
|
|
|> groupAnagrams
|
|
|> pairwiseTuples
|
|
|> tupleSeqAddReverse
|
|
)
|
|
|
|
wordAnagrams
|
|
|> Seq.collect (fun wordAnagram ->
|
|
let wordLen = wordAnagram |> fst |> String.length
|
|
|
|
Map.find wordLen squareAnagrams
|
|
|> Seq.collect (fun squareAnagram ->
|
|
seq {
|
|
if hasReplacementDictionary wordAnagram squareAnagram then
|
|
yield (wordAnagram, squareAnagram)
|
|
}
|
|
)
|
|
)
|
|
|> Seq.toArray
|
|
|> Seq.map (fun (_,(i,j)) -> System.Math.Max(int i,int j))
|
|
|> Seq.max
|