Skip to content

Instantly share code, notes, and snippets.

@zaneli

zaneli/euler10.hs

Last active December 24, 2015 05:28
Show Gist options
  • Save zaneli/6750343 to your computer and use it in GitHub Desktop.
Save zaneli/6750343 to your computer and use it in GitHub Desktop.
Download ZIP
「HaskellでProject Euler(Problem 10～12)」ブログ用
Raw
euler10.hs
main = print $ sum $ primes 2000000
primes :: Integral a => a -> [a]
primes n
| n < 2 = []
| otherwise = primes' 3 [2] []
where
primes' m list list'
| m > n = list
| isPrime list' = primes' (m + 2) (m:list) (list' ++ [m])
| otherwise = primes' (m + 2) list list'
where
isPrime = all (\x -> m `mod` x /= 0) . takeWhile (\x -> x ^ 2 <= m)
Raw
euler11-1.hs
import Control.Applicative
import Data.List
main = print $ maximum [maxLineProd, maxRowProd, maxDiagonalProd]
-- 横一列の連続する4つの数字の積の最大値を取得
maxLineProd :: Integer
maxLineProd = maximum $ map (\line -> prod4 0 line) grid
where
prod4 maxProd list@(n1:n2:n3:n4:_) = let p = n1 * n2 * n3 * n4 in prod4 (max maxProd p) $ tail list
prod4 maxProd _ = maxProd
-- 縦一列の連続する4つの数字の積の最大値を取得
maxRowProd :: Integer
maxRowProd = prod4 0 grid
where
prod4 maxProd list@(line1:line2:line3:line4:_) =
let quartet = zip4 line1 line2 line3 line4
p = maximum $ map (\(n1, n2, n3, n4) -> n1 * n2 * n3 * n4) quartet
in prod4 (max maxProd p) $ tail list
prod4 maxProd _ = maxProd
-- 斜めに連続する4つの数字の積の最大値を取得
maxDiagonalProd :: Integer
maxDiagonalProd = prod4 Nothing grid
where
prod4 (Just n) [] = n
prod4 _ [] = 0
prod4 maxProd list =
let p1 = diagonalProd Nothing list
p2 = diagonalProd Nothing $ reverse $ take 4 list
in prod4 (maximum [maxProd, p1, p2]) $ tail list
diagonalProd :: (Num a, Ord a) => Maybe a -> [[a]] -> Maybe a
diagonalProd maxProd list@(l1:l2:l3:l4:_) | not $ any null list =
let n1 = return l1 >>= tailMaybe >>= tailMaybe >>= tailMaybe >>= headMaybe
n2 = return l2 >>= tailMaybe >>= tailMaybe >>= headMaybe
n3 = return l3 >>= tailMaybe >>= headMaybe
n4 = return l4 >>= headMaybe
p = foldl1 (\x y -> (*) <$> x <*> y) [n1, n2, n3, n4]
in diagonalProd (max maxProd p) $ map tail list
where
headMaybe [] = Nothing
headMaybe xs = Just $ head xs
tailMaybe [] = Nothing
tailMaybe xs = Just $ tail xs
diagonalProd maxProd _ = maxProd
grid = [[08, 02, 22, 97, 38, 15, 00, 40, 00, 75, 04, 05, 07, 78, 52, 12, 50, 77, 91, 08],
[49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 04, 56, 62, 00],
[81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 03, 49, 13, 36, 65],
[52, 70, 95, 23, 04, 60, 11, 42, 69, 24, 68, 56, 01, 32, 56, 71, 37, 02, 36, 91],
[22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80],
[24, 47, 32, 60, 99, 03, 45, 02, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50],
[32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70],
[67, 26, 20, 68, 02, 62, 12, 20, 95, 63, 94, 39, 63, 08, 40, 91, 66, 49, 94, 21],
[24, 55, 58, 05, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72],
[21, 36, 23, 09, 75, 00, 76, 44, 20, 45, 35, 14, 00, 61, 33, 97, 34, 31, 33, 95],
[78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 03, 80, 04, 62, 16, 14, 09, 53, 56, 92],
[16, 39, 05, 42, 96, 35, 31, 47, 55, 58, 88, 24, 00, 17, 54, 24, 36, 29, 85, 57],
[86, 56, 00, 48, 35, 71, 89, 07, 05, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58],
[19, 80, 81, 68, 05, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 04, 89, 55, 40],
[04, 52, 08, 83, 97, 35, 99, 16, 07, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66],
[88, 36, 68, 87, 57, 62, 20, 72, 03, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69],
[04, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 08, 46, 29, 32, 40, 62, 76, 36],
[20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 04, 36, 16],
[20, 73, 35, 29, 78, 31, 90, 01, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 05, 54],
[01, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 01, 89, 19, 67, 48]]
Raw
euler11-2.hs
import Data.List
import Data.Maybe
main = print $ maximum [maxLineProd, maxRowProd, maxDiagonalProd]
-- 横一列の連続する4つの数字の積の最大値を取得
maxLineProd :: Integer
maxLineProd = maxAdjacent grid 4 product
-- 縦一列の連続する4つの数字の積の最大値を取得
maxRowProd :: Integer
maxRowProd = maxAdjacent (transpose grid) 4 product
-- 行列matrixの中から、連続するn個にf関数を適用した最大値を返す
maxAdjacent :: Ord b => [[a]] -> Int -> ([a] -> b) -> b
maxAdjacent matrix n f = maximum $ map f . (!! n) . transpose . map inits . tails =<< matrix
-- 斜めに連続する4つの数字の積の最大値を取得(diagonals id　で一方の対角線、diagonals reverse で反対の対角線の斜めのリストを作る)
maxDiagonalProd :: Integer
maxDiagonalProd =
maximum $ map (prod4 0) =<< [diagonals id, diagonals reverse]
where
prod4 maxProd diagonal
| length diagonal >= 4 = let p = product $ take 4 diagonal in prod4 (max maxProd p) $ tail diagonal
| otherwise = maxProd
diagonals f = (map catMaybes . transpose . zipWith (++) (iterate (Nothing:) []) . map (map Just) . f) grid
grid = [[08, 02, 22, 97, 38, 15, 00, 40, 00, 75, 04, 05, 07, 78, 52, 12, 50, 77, 91, 08],
[49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 04, 56, 62, 00],
[81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 03, 49, 13, 36, 65],
[52, 70, 95, 23, 04, 60, 11, 42, 69, 24, 68, 56, 01, 32, 56, 71, 37, 02, 36, 91],
[22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80],
[24, 47, 32, 60, 99, 03, 45, 02, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50],
[32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70],
[67, 26, 20, 68, 02, 62, 12, 20, 95, 63, 94, 39, 63, 08, 40, 91, 66, 49, 94, 21],
[24, 55, 58, 05, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72],
[21, 36, 23, 09, 75, 00, 76, 44, 20, 45, 35, 14, 00, 61, 33, 97, 34, 31, 33, 95],
[78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 03, 80, 04, 62, 16, 14, 09, 53, 56, 92],
[16, 39, 05, 42, 96, 35, 31, 47, 55, 58, 88, 24, 00, 17, 54, 24, 36, 29, 85, 57],
[86, 56, 00, 48, 35, 71, 89, 07, 05, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58],
[19, 80, 81, 68, 05, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 04, 89, 55, 40],
[04, 52, 08, 83, 97, 35, 99, 16, 07, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66],
[88, 36, 68, 87, 57, 62, 20, 72, 03, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69],
[04, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 08, 46, 29, 32, 40, 62, 76, 36],
[20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 04, 36, 16],
[20, 73, 35, 29, 78, 31, 90, 01, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 05, 54],
[01, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 01, 89, 19, 67, 48]]
Raw
euler11-3.hs
import Data.List
import Data.Maybe
main = print $ maximum [maxLineProd, maxRowProd, maxDiagonalProd]
-- 横一列の連続する4つの数字の積の最大値を取得
maxLineProd :: Integer
maxLineProd = maxProd4 grid
-- 縦一列の連続する4つの数字の積の最大値を取得
maxRowProd :: Integer
maxRowProd = maxProd4 $ transpose grid
-- 斜めに連続する4つの数字の積の最大値を取得(diagonals id　で一方の対角線、diagonals reverse で反対の対角線の斜めのリストを作る)
maxDiagonalProd :: Integer
maxDiagonalProd = maximum [maxProd4 $ diagonals id, maxProd4 $ diagonals reverse]
where
diagonals f = (map catMaybes . transpose . zipWith (++) (iterate (Nothing:) []) . map (map Just) . f) grid
-- 行列matrixの中から、連続する4要素の積の最大値を返す
maxProd4 :: (Num a, Ord a) => [[a]] -> a
maxProd4 matrix = maxAdjacent matrix 4 product
-- 行列matrixの中から、連続するn要素にf関数を適用した最大値を返す
maxAdjacent :: Ord b => [[a]] -> Int -> ([a] -> b) -> b
maxAdjacent matrix n f = maximum $ map f . (!! n) . (++ repeat []) . transpose . map inits . tails =<< matrix
grid = [[08, 02, 22, 97, 38, 15, 00, 40, 00, 75, 04, 05, 07, 78, 52, 12, 50, 77, 91, 08],
[49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 04, 56, 62, 00],
[81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 03, 49, 13, 36, 65],
[52, 70, 95, 23, 04, 60, 11, 42, 69, 24, 68, 56, 01, 32, 56, 71, 37, 02, 36, 91],
[22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80],
[24, 47, 32, 60, 99, 03, 45, 02, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50],
[32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70],
[67, 26, 20, 68, 02, 62, 12, 20, 95, 63, 94, 39, 63, 08, 40, 91, 66, 49, 94, 21],
[24, 55, 58, 05, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72],
[21, 36, 23, 09, 75, 00, 76, 44, 20, 45, 35, 14, 00, 61, 33, 97, 34, 31, 33, 95],
[78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 03, 80, 04, 62, 16, 14, 09, 53, 56, 92],
[16, 39, 05, 42, 96, 35, 31, 47, 55, 58, 88, 24, 00, 17, 54, 24, 36, 29, 85, 57],
[86, 56, 00, 48, 35, 71, 89, 07, 05, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58],
[19, 80, 81, 68, 05, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 04, 89, 55, 40],
[04, 52, 08, 83, 97, 35, 99, 16, 07, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66],
[88, 36, 68, 87, 57, 62, 20, 72, 03, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69],
[04, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 08, 46, 29, 32, 40, 62, 76, 36],
[20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 04, 36, 16],
[20, 73, 35, 29, 78, 31, 90, 01, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 05, 54],
[01, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 01, 89, 19, 67, 48]]
Raw
euler12-1.hs
import Data.List
main = print $ searchAnswer 500
searchAnswer :: Integral a => Int -> a
searchAnswer n = searchAnswer' 1 1
where
searchAnswer' idx triNum | isAnswer = triNum
| otherwise = let next = idx + 1 in searchAnswer' next (triNum + next)
where isAnswer = n <= (divCnt $ primeFactors triNum)
-- 約数の個数(素因数分解の結果の全ての組み合わせ)
divCnt :: (Eq a, Num a) => [a] -> Int
divCnt xs = length $ nub $ foldl (\n m -> (map (\x -> m:x) n) ++ n) [[1]] xs
-- 素因数分解(正確には 1 を除いた素因数分解の結果)
primeFactors :: Integral a => a -> [a]
primeFactors n = primeFactors' n 2 []
where
primeFactors' n m list
| n < m ^ 2 = n:list
| isPrimeFactor =
let (next, cnt) = divide n m 0 in
primeFactors' next (m + 1) ((replicate cnt m) ++ list)
| otherwise = primeFactors' n (m + 1) list
where
isPrimeFactor = all (\x -> m `mod` x /= 0) list && n `mod` m == 0
divide n m cnt | r == 0 && q /= 1 = divide q m (cnt + 1)
| otherwise = (n, cnt)
where (q, r) = n `divMod` m
Raw
euler12-2.hs
main = print $ answer 500
answer :: (Num a, Ord a, Integral b) => a -> b
answer limit = answer' 1
where answer' n | divsCount < limit = answer' (n + 1)
| otherwise = triNum
where triNum = triangleNumber n
divsCount = product . map ((+1).snd) $ primeFactors triNum
-- n(n+1)/2 で三角数を求める
triangleNumber :: Integral a => a -> a
triangleNumber n = n * (n + 1) `div` 2
-- 因数分解した結果を(基数, 指数)のタプルのリストとして返す
primeFactors :: (Integral a, Num b) => a -> [(a, b)]
primeFactors n = primeFactors' n 2 []
where
primeFactors' n m list
| n < m ^ 2 = updateList
| isPrimeFactor =
let (next, cnt) = divide n m 0 in
primeFactors' next (m + 1) ((m, cnt):list)
| otherwise = primeFactors' n (m + 1) list
where
isPrimeFactor = all (\(p, _) -> m `mod` p /= 0) list && n `mod` m == 0
divide n m cnt | r == 0 && q /= 1 = divide q m (cnt + 1)
| otherwise = (n, cnt)
where (q, r) = n `divMod` m
updateList | any (\(p, _) -> p == n) list = map (\(p, a) -> (p, if p == n then a + 1 else a)) list
| otherwise = (n, 1):list
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment