initial commit

98.fs

@@ -0,0 +1,90 @@
+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