Project Euler 解答

Project Euler Problem 042

Project Euler Problem 042

import Data.Char
import Data.List

tril :: [Int]
tril= map (\x -> quot (x*(x+1)) 2) [1..]
tri :: Int -> Int
tri n = tril!!n
oa :: Int
oa = ord 'A'
str :: [Char] -> Int
str s = foldl (\a x -> (ord x)-oa+1+a) 0 s
alh :: [Char]
alh = map chr [oa..oa+25]
sol :: [[Char]] -> IO ()
sol strs= print $ sum $ map length $ filter (\(x:_) -> elem x list) $ group $ sort cnts where
  cnts = map str strs
  maxv = maximum cnts
  list = takeWhile (<=maxv) tril

m :: ([String] -> IO b) -> IO b
m solver= do{ s <- readFile "042words.txt";
        let strs = read ("["++s++"]") :: [String] in
        solver strs}
ans1 :: IO ()
ans1 = m sol

-- 別解：三角数の逆数は(Sqrt(1+8n)-1)/2
rev :: Integer -> Bool
rev n = r - (fromIntegral $ floor r) < 1e-5 where
  r :: Float
  r = ((sqrt(1.0+8.0*(fromIntegral n))-1.0)/2.0)
sol2 :: [[Char]] -> IO ()
sol2 strs= print $ length $ filter rev $ map (fromIntegral.str) strs
ans2 :: IO ()
ans2 = m sol2

-- 162
main :: IO ()
main = ans1

-- おまけ
triangles :: [Integer]
triangles = 1 : zipWith (+) triangles [2..]
triangles2 :: [Integer]
triangles2 = scanl1(+)[1..]

since 2013