Project Euler 解答

Project Euler Problem 061

Project Euler Problem 061

import Data.List
import qualified Data.Map as M

-- n画数の無限リストを生成
nk :: (Enum a, Num a) => a -> [a]
nk n = tail imp where imp = 0:zipWith(+)imp[1,(n-1)..]
lists :: [[Integer]]
lists = map nk [3..8] --3-8角数の無限リストのリスト
slists :: [[Integer]]
slists = map(takeWhile (<10000).dropWhile(<1000)) lists -- 4桁に絞る
tlists :: [Integer]
tlists = sort $ concat slists -- 一つのリストにしてソート
suc :: Integral a => a -> a -> Bool
suc x y = (x`rem`100) == (y`quot`100)
mp :: M.Map Integer [Integer]
mp = foldl f M.empty tlists
  where f acc x = if x `M.member` acc then acc else M.insert x (filter (suc x) tlists) acc
-- tlistsをフィルタしたリスト
ulists :: [Integer]
ulists = map fst $ filter ((/=[]).snd) $ M.assocs mp

trycycle5 :: Integer -> [[[Integer]]]
trycycle5 n = imp (mp M.! n) [n] n where
  imp [] _ _ = []
  imp l acc start | start `elem` l = [[acc]]
  imp _ acc _ | length acc>=6 = []
  imp l acc start = concat [o | x<-l,x `notElem` acc,let m=mp M.! x,let o=imp m (acc++[x]) start,o/=[]]
list1 :: [[Integer]]
list1 = nub $ filter ((==6).length) $ map concat $ concatMap trycycle5 ulists
is6type2 :: [Integer] -> Bool
is6type2 ls = all (>=1) $ map (length . intersect ls) slists
list1_6type :: [[Integer]]
list1_6type = filter is6type2 list1
list1_6type_sorted :: [[Integer]]
list1_6type_sorted = nub $ map sort list1_6type
is6type3 :: [Integer] -> Bool
is6type3 ls = sort (map (length . intersect ls) slists) == [1,1,1,1,1,2]
list2 :: [[Integer]]
list2 = nub $ map sort $ filter is6type3 list1_6type_sorted
list3 :: [[Integer]]
list3 = filter ((/=1).length.filter (ispoly 3)) list2
ans1 :: Integer
ans1 = sum $ concat list3
--28684
main :: IO ()
main = print ans1
-- k画数かを判定する
ispoly :: Integral a => a -> a -> Bool
ispoly k n= case isSquare det of
  True ->
    let num = k - 4 + (sqrtint det) in
    let den = 2*(k-2) in
    if num `rem` den == 0 then True
    else False
  False -> False
  where
    det = (k + 8 * (n - 1)) * k - 16 * (n - 1)
    sqrtint x = round (sqrt ((fromIntegral x)+0.5::Double))
    isSquare x = x == r*r where r = sqrtint x

since 2013