# Project Euler 解答

## Project Euler Problem 098

Project Euler Problem 098

```import Data.List
import Data.Ord
import Data.Char
import System.IO.Unsafe

-- 回文判定
isparin :: Eq a => [a] -> Bool
isparin n = n == reverse n

-- length=14については、6C2=15回呼ばれる
d2n :: String -> Integer
d2n = foldl ((+).(*10)) 0 . map (fromIntegral . digitToInt)

permOf :: Eq a => [a] -> [a] -> [Int]
permOf [] _ = []
permOf (x:xs) ys =
case findIndex (==x) ys of
Just i -> i:permOf xs ys
Nothing -> []

permBy :: [Int] -> [a] -> [a]
permBy [] _ = []
permBy (x:xs) ys = (ys!!x):permBy xs ys

wordsUnsafe :: [String]
wordsUnsafe = unsafePerformIO \$ readFile "098words.txt" >>= return . (\s -> filter (not.isparin) \$ sort (read ("[" ++ s ++ "]") :: [String]))
-- 回文は除外
notPalindromicWords :: [[Char]]
notPalindromicWords = filter (not.isparin) \$ wordsUnsafe
-- permOfを借りた
wgroups :: [[[Char]]]
wgroups = sortBy (comparing (length.head)) \$ map (map snd) \$ filter ((>=2).length) \$ sort \$ groupBy (\x y -> fst x == fst y) \$ sort \$ zip (map sort notPalindromicWords) notPalindromicWords
-- これがuniqueなpermutationの一覧
wordperms :: [[Int]]
wordperms = nub \$ sortBy (flip \$ comparing length) \$ [permOf l r| (l:r:_)<-wgroups]
-- permutationの最大長までしかチェック不要
maxlen :: Int
maxlen = length \$ head wordperms
sqrs :: [Integer]
sqrs = takeWhile (<(10^maxlen)) \$ map (^(2::Integer)) [1..]
sqrsl :: [[Integer]]
sqrsl = groupBy (\x y-> length (show x) == length (show y)) sqrs

ans1imp :: [[Char]]
ans1imp=[max l ss | p<-wordperms,let pool=sqrsl!!(length p-1),s<-pool,let ss=show s,dd p==dd ss,let l=permBy p ss,(d2n l)`elem`pool]
where
-- different digits
dd n = length \$ nub \$ sort n
ans1 :: [Char]
-- 18769
main :: IO ()
main = print ans1
```
• はじめに
• プロジェクトオイラー問題
• リンク等