# 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
```
• はじめに
• プロジェクトオイラー問題
• リンク等