Life Goes On

まあまあだけど楽しんでる方です

98問目

CARE という単語の各文字を 1, 2, 9, 6 の各数字で置換すると 1296 = 362 という平方数になる。文字の順番を入れ替えた RACE という単語も 9216 = 962 で平方数になる。与えられた単語の中からこのような単語の組を全て見つけ出し、平方数の最大値を求める。
まず文字の順番を入れ替えて等しくなるような単語の組を抽出してから、同じ桁数の平方数の組と比較し、平方数で表現できるか調べてます。
on は覚えたてです。無名関数追放キャンペーン実施中。

import Data.Function
import Data.List

main = print . maximum . euler098 . read . ("[" ++) . (++ "]") =<< readFile "words.txt"

euler098 :: [String] -> [Integer]
euler098 s = concat [ ys |
    ss <- anagrams, xs <- sq,
    on (==) (length . head) ss (map show xs) &&
    on (==) (length . nub . head) ss (map show xs),
    ys <- perm 2 xs, isPair ss ys ]
    where anagrams = anagram s
          sq = squares $ maximum $ map (length . head) anagrams

anagram :: [String] -> [[String]]
anagram = concat . map (comb 2) . sortBy (on compare (length . head))
    . filter ((> 1) . length) . groupBy (on (==) sort) . sortBy (on compare sort)

squares :: Int -> [[Integer]]
squares m = filter ((> 1) . length) $ groupBy (on (==) key) $ sortBy (on compare key)
    $ takeWhile (< (10^m)) $ dropWhile (< 10) $ map (^ 2) [1..]
    where key = sort . show

isPair :: [String] -> [Integer] -> Bool
isPair [a, b] [na, nb] =
    on (==) (length . group . sort) (zip a a) (zip a $ show na) &&
    on (==) (map snd . sort) (zip a $ show na) (zip b $ show nb)

comb :: Ord a => Int -> [a] -> [[a]]
comb 0 _ = [[]]
comb n as = [ a : as' | a <- as, as' <- comb (n - 1) $ filter (> a) as ]

perm :: Ord a => Int -> [a] -> [[a]]
perm 0 _ = [[]]
perm n as = [ a : as' | a <- as, as' <- comb (n - 1) $ filter (/= a) as ]