fuxino/project-euler-solutions
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix Haskell code with ormolu

Browse Source
This commit is contained in:
daniele 2024-12-15 11:31:42 +01:00
parent 6ebb82fb8c
commit 751673989c
Signed by: fuxino
GPG Key ID: 981A2B2A3BBF5514
34 changed files with 540 additions and 430 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
Haskell/ProjectEuler.hs
View File

@ -1,12 +1,13 @@
module ProjectEuler module ProjectEuler
( isPrime ( isPrime,
, primeSieve primeSieve,
, lcmm lcmm,
, digitSum digitSum,
, sumProperDivisors sumProperDivisors,
, countDivisors countDivisors,
, isPandigital isPandigital,
) where )
where
import Data.Char (digitToInt) import Data.Char (digitToInt)
import Data.List (nub) import Data.List (nub)
@ -17,29 +18,32 @@ isPrime 1 = False
isPrime 2 = True isPrime 2 = True
isPrime 3 = True isPrime 3 = True
isPrime n = isPrime n =
n > 0 && odd n && n `mod` 3 /= 0 && null [ x | x <- candidates, n `mod` x == 0 || n `mod` (x+2) == 0 ] n > 0 && odd n && n `mod` 3 /= 0 && null [x | x <- candidates, n `mod` x == 0 || n `mod` (x + 2) == 0]
where candidates = [5,11..limit] where
limit = floor(sqrt(fromIntegral n)) + 1 candidates = [5, 11 .. limit]
limit = floor (sqrt (fromIntegral n)) + 1
primeSieve :: (Integral n) => [n] primeSieve :: (Integral n) => [n]
primeSieve = 2:3:[5,7..] `minus` unionAll [[p*p, p*p+2*p..] | p <- tail primeSieve] primeSieve = 2 : 3 : [5, 7 ..] `minus` unionAll [[p * p, p * p + 2 * p ..] | p <- tail primeSieve]
lcmm :: (Integral n) => [n] -> n lcmm :: (Integral n) => [n] -> n
lcmm values lcmm values
| length values == 2 = lcm (head values) (last values) | length values == 2 = lcm (head values) (last values)
| otherwise = lcm (head values) (lcmm (tail values)) | otherwise = lcm (head values) (lcmm (tail values))
digitSum :: (Integral a, Show a) => a -> Int digitSum :: (Integral a, Show a) => a -> Int
digitSum n = sum $ map digitToInt $ show n digitSum n = sum $ map digitToInt $ show n
sumProperDivisors :: (Integral a) => a -> a sumProperDivisors :: (Integral a) => a -> a
sumProperDivisors n = sum [ if x /= y then x + y else x | x <- [2..floor $ sqrt $ fromIntegral n], let y = n `div` x, n `mod` x == 0 ] + 1 sumProperDivisors n = sum [if x /= y then x + y else x | x <- [2 .. floor $ sqrt $ fromIntegral n], let { y = n `div` x }, n `mod` x == 0] + 1
countDivisors :: (Integral a) => a -> Int countDivisors :: (Integral a) => a -> Int
countDivisors n = length $ nub $ concat [ [x, n `div` x] | x <- [1..limit], n `mod` x == 0 ] countDivisors n = length $ nub $ concat [[x, n `div` x] | x <- [1 .. limit], n `mod` x == 0]
where limit = floor $ sqrt $ fromIntegral n where
limit = floor $ sqrt $ fromIntegral n
isPandigital :: Integer -> Bool isPandigital :: Integer -> Bool
isPandigital n = n_length == length (nub n_char) && '0' `notElem` n_char && digitToInt (maximum n_char) == n_length isPandigital n = n_length == length (nub n_char) && '0' `notElem` n_char && digitToInt (maximum n_char) == n_length
where n_char = show n where
n_length = length n_char n_char = show n
n_length = length n_char

13
Haskell/p001.hs
View File

@ -3,10 +3,13 @@
-- Find the sum of all the multiples of 3 or 5 below 1000. -- Find the sum of all the multiples of 3 or 5 below 1000.
sumMultiples :: Int sumMultiples :: Int
sumMultiples = sum $ filter p [1..999] sumMultiples = sum $ filter p [1 .. 999]
where p n = n `mod` 3 == 0 || n `mod` 5 == 0 where
p n = n `mod` 3 == 0 || n `mod` 5 == 0
main = do main = do
let result = sumMultiples let result = sumMultiples
putStrLn $ "Project Euler, Problem 1\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 1\n"
++ "Answer: "
++ show result

12
Haskell/p002.hs
View File

@ -7,12 +7,14 @@
fib :: Int -> Int fib :: Int -> Int
fib 0 = 0 fib 0 = 0
fib 1 = 1 fib 1 = 1
fib n = fib (n-1) + fib(n-2) fib n = fib (n - 1) + fib (n - 2)
sumEvenFib :: Int sumEvenFib :: Int
sumEvenFib = sum $ filter even $ takeWhile (<=4000000) (map fib [0..]) sumEvenFib = sum $ filter even $ takeWhile (<= 4000000) (map fib [0 ..])
main = do main = do
let result = sumEvenFib let result = sumEvenFib
putStrLn $ "Project Euler, Problem 2\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 2\n"
++ "Answer: "
++ show result

14
Haskell/p003.hs
View File

@ -5,11 +5,13 @@ import ProjectEuler (isPrime)
maxPrimeFactor :: Int -> Int maxPrimeFactor :: Int -> Int
maxPrimeFactor n maxPrimeFactor n
| isPrime n = n | isPrime n = n
| even n = maxPrimeFactor $ n `div` 2 | even n = maxPrimeFactor $ n `div` 2
| otherwise = maxPrimeFactor $ n `div` head [i | i <- [3,5..], n `mod` i == 0 && isPrime i] | otherwise = maxPrimeFactor $ n `div` head [i | i <- [3, 5 ..], n `mod` i == 0 && isPrime i]
main = do main = do
let result = maxPrimeFactor 600851475143 let result = maxPrimeFactor 600851475143
putStrLn $ "Project Euler, Problem 3\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 3\n"
++ "Answer: "
++ show result

10
Haskell/p004.hs
View File

@ -7,9 +7,11 @@ isPalindrome n = show n == reverse (show n)
maxPalindrome :: Int maxPalindrome :: Int
maxPalindrome = maxPalindrome =
maximum . filter isPalindrome $ (*) <$> [100..999] <*> [100..999] maximum . filter isPalindrome $ (*) <$> [100 .. 999] <*> [100 .. 999]
main = do main = do
let result = maxPalindrome let result = maxPalindrome
putStrLn $ "Project Euler, Problem 4\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 4\n"
++ "Answer: "
++ show result

8
Haskell/p005.hs
View File

@ -5,6 +5,8 @@
import ProjectEuler (lcmm) import ProjectEuler (lcmm)
main = do main = do
let result = lcmm [1..20] let result = lcmm [1 .. 20]
putStrLn $ "Project Euler, Problem 5\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 5\n"
++ "Answer: "
++ show result

12
Haskell/p006.hs
View File

@ -8,12 +8,14 @@
-- --
-- Hence the difference between the sum of the squares of the first ten natural numbers and the square of the sum is 3025 − 385 = 2640. -- Hence the difference between the sum of the squares of the first ten natural numbers and the square of the sum is 3025 − 385 = 2640.
-- --
--Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum. -- Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum.
sumSquareDiff :: Int -> Int sumSquareDiff :: Int -> Int
sumSquareDiff n = (sum [1..n] ^2) - sum (map (^2) [1..n]) sumSquareDiff n = (sum [1 .. n] ^ 2) - sum (map (^ 2) [1 .. n])
main = do main = do
let result = sumSquareDiff 100 let result = sumSquareDiff 100
putStrLn $ "Project Euler, Problem 6\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 6\n"
++ "Answer: "
++ show result

10
Haskell/p007.hs
View File

@ -5,9 +5,11 @@
import ProjectEuler (isPrime) import ProjectEuler (isPrime)
nthPrime :: Int -> Int nthPrime :: Int -> Int
nthPrime n = last $ take n [ x | x <- [1..], isPrime x ] nthPrime n = last $ take n [x | x <- [1 ..], isPrime x]
main = do main = do
let result = nthPrime 10001 let result = nthPrime 10001
putStrLn $ "Project Euler, Problem 7\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 7\n"
++ "Answer: "
++ show result

53
Haskell/p008.hs
View File

@ -27,30 +27,33 @@ import Data.Char (digitToInt)
nDigitProduct :: Int -> String -> Int nDigitProduct :: Int -> String -> Int
nDigitProduct n s nDigitProduct n s
| length s < n = -1 | length s < n = -1
| otherwise = max (product (map digitToInt (take n s))) (nDigitProduct n (tail s)) | otherwise = max (product (map digitToInt (take n s))) (nDigitProduct n (tail s))
main = do main = do
let s = "73167176531330624919225119674426574742355349194934" let s =
++ "96983520312774506326239578318016984801869478851843" "73167176531330624919225119674426574742355349194934"
++ "85861560789112949495459501737958331952853208805511" ++ "96983520312774506326239578318016984801869478851843"
++ "12540698747158523863050715693290963295227443043557" ++ "85861560789112949495459501737958331952853208805511"
++ "66896648950445244523161731856403098711121722383113" ++ "12540698747158523863050715693290963295227443043557"
++ "62229893423380308135336276614282806444486645238749" ++ "66896648950445244523161731856403098711121722383113"
++ "30358907296290491560440772390713810515859307960866" ++ "62229893423380308135336276614282806444486645238749"
++ "70172427121883998797908792274921901699720888093776" ++ "30358907296290491560440772390713810515859307960866"
++ "65727333001053367881220235421809751254540594752243" ++ "70172427121883998797908792274921901699720888093776"
++ "52584907711670556013604839586446706324415722155397" ++ "65727333001053367881220235421809751254540594752243"
++ "53697817977846174064955149290862569321978468622482" ++ "52584907711670556013604839586446706324415722155397"
++ "83972241375657056057490261407972968652414535100474" ++ "53697817977846174064955149290862569321978468622482"
++ "82166370484403199890008895243450658541227588666881" ++ "83972241375657056057490261407972968652414535100474"
++ "16427171479924442928230863465674813919123162824586" ++ "82166370484403199890008895243450658541227588666881"
++ "17866458359124566529476545682848912883142607690042" ++ "16427171479924442928230863465674813919123162824586"
++ "24219022671055626321111109370544217506941658960408" ++ "17866458359124566529476545682848912883142607690042"
++ "07198403850962455444362981230987879927244284909188" ++ "24219022671055626321111109370544217506941658960408"
++ "84580156166097919133875499200524063689912560717606" ++ "07198403850962455444362981230987879927244284909188"
++ "05886116467109405077541002256983155200055935729725" ++ "84580156166097919133875499200524063689912560717606"
++ "71636269561882670428252483600823257530420752963450" ++ "05886116467109405077541002256983155200055935729725"
result = nDigitProduct 13 s ++ "71636269561882670428252483600823257530420752963450"
putStrLn $ "Project Euler, Problem 8\n" result = nDigitProduct 13 s
++ "Answer: " ++ show result putStrLn $
"Project Euler, Problem 8\n"
++ "Answer: "
++ show result

10
Haskell/p009.hs
View File

@ -9,12 +9,14 @@
-- Find the product abc. -- Find the product abc.
pythagoreanTriplet :: Int -> (Int, Int, Int) pythagoreanTriplet :: Int -> (Int, Int, Int)
pythagoreanTriplet n = head [ (x, y, z) | x <- [1..n], y <- [x..n], z <- [y..n], x + y + z == n, x^2 + y^2 == z^2] pythagoreanTriplet n = head [(x, y, z) | x <- [1 .. n], y <- [x .. n], z <- [y .. n], x + y + z == n, x ^ 2 + y ^ 2 == z ^ 2]
prodTriplet :: (Int, Int, Int) -> Int prodTriplet :: (Int, Int, Int) -> Int
prodTriplet (x, y, z) = x * y * z prodTriplet (x, y, z) = x * y * z
main = do main = do
let result = prodTriplet $ pythagoreanTriplet 1000 let result = prodTriplet $ pythagoreanTriplet 1000
putStrLn $ "Project Euler, Problem 9\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 9\n"
++ "Answer: "
++ show result

8
Haskell/p010.hs
View File

@ -5,6 +5,8 @@
import ProjectEuler (primeSieve) import ProjectEuler (primeSieve)
main = do main = do
let result = sum $ takeWhile (<2000000) primeSieve let result = sum $ takeWhile (< 2000000) primeSieve
putStrLn $ "Project Euler, Problem 10\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 10\n"
++ "Answer: "
++ show result

68
Haskell/p011.hs
View File

@ -29,38 +29,44 @@ import Data.List (transpose)
diagonals :: [[Int]] -> [[Int]] diagonals :: [[Int]] -> [[Int]]
diagonals xs = diagonals' xs ++ diagonals' ((transpose . reverse) xs) diagonals xs = diagonals' xs ++ diagonals' ((transpose . reverse) xs)
where diagonals' xs = transpose (zipWith drop [0..] xs) where
++ transpose (zipWith drop [1..] (transpose xs)) diagonals' xs =
transpose (zipWith drop [0 ..] xs)
++ transpose (zipWith drop [1 ..] (transpose xs))
maxProd4 :: [Int] -> Int maxProd4 :: [Int] -> Int
maxProd4 [x, y, z] = 0 maxProd4 [x, y, z] = 0
maxProd4 (w:x:y:z:xs) = max (w * x * y * z) (maxProd4 (x:y:z:xs)) maxProd4 (w : x : y : z : xs) = max (w * x * y * z) (maxProd4 (x : y : z : xs))
main = do main = do
let grid = [[ 8, 2, 22, 97, 38, 15, 0, 40, 0, 75, 4, 5, 7, 78, 52, 12, 50, 77, 91, 8] let grid =
,[49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 4, 56, 62, 0] [ [8, 2, 22, 97, 38, 15, 0, 40, 0, 75, 4, 5, 7, 78, 52, 12, 50, 77, 91, 8],
,[81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 3, 49, 13, 36, 65] [49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 4, 56, 62, 0],
,[52, 70, 95, 23, 4, 60, 11, 42, 69, 24, 68, 56, 1, 32, 56, 71, 37, 2, 36, 91] [81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 3, 49, 13, 36, 65],
,[22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80] [52, 70, 95, 23, 4, 60, 11, 42, 69, 24, 68, 56, 1, 32, 56, 71, 37, 2, 36, 91],
,[24, 47, 32, 60, 99, 3, 45, 2, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50] [22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80],
,[32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70] [24, 47, 32, 60, 99, 3, 45, 2, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50],
,[67, 26, 20, 68, 2, 62, 12, 20, 95, 63, 94, 39, 63, 8, 40, 91, 66, 49, 94, 21] [32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70],
,[24, 55, 58, 5, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72] [67, 26, 20, 68, 2, 62, 12, 20, 95, 63, 94, 39, 63, 8, 40, 91, 66, 49, 94, 21],
,[21, 36, 23, 9, 75, 0, 76, 44, 20, 45, 35, 14, 0, 61, 33, 97, 34, 31, 33, 95] [24, 55, 58, 5, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72],
,[78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 3, 80, 4, 62, 16, 14, 9, 53, 56, 92] [21, 36, 23, 9, 75, 0, 76, 44, 20, 45, 35, 14, 0, 61, 33, 97, 34, 31, 33, 95],
,[16, 39, 5, 42, 96, 35, 31, 47, 55, 58, 88, 24, 0, 17, 54, 24, 36, 29, 85, 57] [78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 3, 80, 4, 62, 16, 14, 9, 53, 56, 92],
,[86, 56, 0, 48, 35, 71, 89, 7, 5, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58] [16, 39, 5, 42, 96, 35, 31, 47, 55, 58, 88, 24, 0, 17, 54, 24, 36, 29, 85, 57],
,[19, 80, 81, 68, 5, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 4, 89, 55, 40] [86, 56, 0, 48, 35, 71, 89, 7, 5, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58],
,[ 4, 52, 8, 83, 97, 35, 99, 16, 7, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66] [19, 80, 81, 68, 5, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 4, 89, 55, 40],
,[88, 36, 68, 87, 57, 62, 20, 72, 3, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69] [4, 52, 8, 83, 97, 35, 99, 16, 7, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66],
,[ 4, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 8, 46, 29, 32, 40, 62, 76, 36] [88, 36, 68, 87, 57, 62, 20, 72, 3, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69],
,[20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 4, 36, 16] [4, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 8, 46, 29, 32, 40, 62, 76, 36],
,[20, 73, 35, 29, 78, 31, 90, 1, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 5, 54] [20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 4, 36, 16],
,[ 1, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 1, 89, 19, 67, 48]] [20, 73, 35, 29, 78, 31, 90, 1, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 5, 54],
diags = filter (\x -> length x >= 4) $ diagonals grid [1, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 1, 89, 19, 67, 48]
maxRow = maximum $ map maxProd4 grid ]
maxCol = maximum . map maxProd4 $ transpose grid diags = filter (\x -> length x >= 4) $ diagonals grid
maxDiag = maximum $ map maxProd4 diags maxRow = maximum $ map maxProd4 grid
result = maximum [maxRow, maxCol, maxDiag] maxCol = maximum . map maxProd4 $ transpose grid
putStrLn $ "Project Euler, Problem 11\n" maxDiag = maximum $ map maxProd4 diags
++ "Answer: " ++ show result result = maximum [maxRow, maxCol, maxDiag]
putStrLn $
"Project Euler, Problem 11\n"
++ "Answer: "
++ show result

12
Haskell/p012.hs
View File

@ -21,12 +21,14 @@ import Data.List (nub)
import ProjectEuler (countDivisors) import ProjectEuler (countDivisors)
triangNumbers :: [Int] triangNumbers :: [Int]
triangNumbers = scanl1 (+) [1..] triangNumbers = scanl1 (+) [1 ..]
triang500 :: Int triang500 :: Int
triang500 = head [ x | x <- triangNumbers, countDivisors x > 500 ] triang500 = head [x | x <- triangNumbers, countDivisors x > 500]
main = do main = do
let result = triang500 let result = triang500
putStrLn $ "Project Euler, Problem 12\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 12\n"
++ "Answer: "
++ show result

211
Haskell/p013.hs
View File

@ -105,107 +105,112 @@ firstDigitsSum :: Int -> [Integer] -> Int
firstDigitsSum n xs = read . take n . show $ sum xs firstDigitsSum n xs = read . take n . show $ sum xs
main = do main = do
let result = firstDigitsSum 10 [37107287533902102798797998220837590246510135740250 let result =
, 46376937677490009712648124896970078050417018260538 firstDigitsSum
, 74324986199524741059474233309513058123726617309629 10
, 91942213363574161572522430563301811072406154908250 [ 37107287533902102798797998220837590246510135740250,
, 23067588207539346171171980310421047513778063246676 46376937677490009712648124896970078050417018260538,
, 89261670696623633820136378418383684178734361726757 74324986199524741059474233309513058123726617309629,
, 28112879812849979408065481931592621691275889832738 91942213363574161572522430563301811072406154908250,
, 44274228917432520321923589422876796487670272189318 23067588207539346171171980310421047513778063246676,
, 47451445736001306439091167216856844588711603153276 89261670696623633820136378418383684178734361726757,
, 70386486105843025439939619828917593665686757934951 28112879812849979408065481931592621691275889832738,
, 62176457141856560629502157223196586755079324193331 44274228917432520321923589422876796487670272189318,
, 64906352462741904929101432445813822663347944758178 47451445736001306439091167216856844588711603153276,
, 92575867718337217661963751590579239728245598838407 70386486105843025439939619828917593665686757934951,
, 58203565325359399008402633568948830189458628227828 62176457141856560629502157223196586755079324193331,
, 80181199384826282014278194139940567587151170094390 64906352462741904929101432445813822663347944758178,
, 35398664372827112653829987240784473053190104293586 92575867718337217661963751590579239728245598838407,
, 86515506006295864861532075273371959191420517255829 58203565325359399008402633568948830189458628227828,
, 71693888707715466499115593487603532921714970056938 80181199384826282014278194139940567587151170094390,
, 54370070576826684624621495650076471787294438377604 35398664372827112653829987240784473053190104293586,
, 53282654108756828443191190634694037855217779295145 86515506006295864861532075273371959191420517255829,
, 36123272525000296071075082563815656710885258350721 71693888707715466499115593487603532921714970056938,
, 45876576172410976447339110607218265236877223636045 54370070576826684624621495650076471787294438377604,
, 17423706905851860660448207621209813287860733969412 53282654108756828443191190634694037855217779295145,
, 81142660418086830619328460811191061556940512689692 36123272525000296071075082563815656710885258350721,
, 51934325451728388641918047049293215058642563049483 45876576172410976447339110607218265236877223636045,
, 62467221648435076201727918039944693004732956340691 17423706905851860660448207621209813287860733969412,
, 15732444386908125794514089057706229429197107928209 81142660418086830619328460811191061556940512689692,
, 55037687525678773091862540744969844508330393682126 51934325451728388641918047049293215058642563049483,
, 18336384825330154686196124348767681297534375946515 62467221648435076201727918039944693004732956340691,
, 80386287592878490201521685554828717201219257766954 15732444386908125794514089057706229429197107928209,
, 78182833757993103614740356856449095527097864797581 55037687525678773091862540744969844508330393682126,
, 16726320100436897842553539920931837441497806860984 18336384825330154686196124348767681297534375946515,
, 48403098129077791799088218795327364475675590848030 80386287592878490201521685554828717201219257766954,
, 87086987551392711854517078544161852424320693150332 78182833757993103614740356856449095527097864797581,
, 59959406895756536782107074926966537676326235447210 16726320100436897842553539920931837441497806860984,
, 69793950679652694742597709739166693763042633987085 48403098129077791799088218795327364475675590848030,
, 41052684708299085211399427365734116182760315001271 87086987551392711854517078544161852424320693150332,
, 65378607361501080857009149939512557028198746004375 59959406895756536782107074926966537676326235447210,
, 35829035317434717326932123578154982629742552737307 69793950679652694742597709739166693763042633987085,
, 94953759765105305946966067683156574377167401875275 41052684708299085211399427365734116182760315001271,
, 88902802571733229619176668713819931811048770190271 65378607361501080857009149939512557028198746004375,
, 25267680276078003013678680992525463401061632866526 35829035317434717326932123578154982629742552737307,
, 36270218540497705585629946580636237993140746255962 94953759765105305946966067683156574377167401875275,
, 24074486908231174977792365466257246923322810917141 88902802571733229619176668713819931811048770190271,
, 91430288197103288597806669760892938638285025333403 25267680276078003013678680992525463401061632866526,
, 34413065578016127815921815005561868836468420090470 36270218540497705585629946580636237993140746255962,
, 23053081172816430487623791969842487255036638784583 24074486908231174977792365466257246923322810917141,
, 11487696932154902810424020138335124462181441773470 91430288197103288597806669760892938638285025333403,
, 63783299490636259666498587618221225225512486764533 34413065578016127815921815005561868836468420090470,
, 67720186971698544312419572409913959008952310058822 23053081172816430487623791969842487255036638784583,
, 95548255300263520781532296796249481641953868218774 11487696932154902810424020138335124462181441773470,
, 76085327132285723110424803456124867697064507995236 63783299490636259666498587618221225225512486764533,
, 37774242535411291684276865538926205024910326572967 67720186971698544312419572409913959008952310058822,
, 23701913275725675285653248258265463092207058596522 95548255300263520781532296796249481641953868218774,
, 29798860272258331913126375147341994889534765745501 76085327132285723110424803456124867697064507995236,
, 18495701454879288984856827726077713721403798879715 37774242535411291684276865538926205024910326572967,
, 38298203783031473527721580348144513491373226651381 23701913275725675285653248258265463092207058596522,
, 34829543829199918180278916522431027392251122869539 29798860272258331913126375147341994889534765745501,
, 40957953066405232632538044100059654939159879593635 18495701454879288984856827726077713721403798879715,
, 29746152185502371307642255121183693803580388584903 38298203783031473527721580348144513491373226651381,
, 41698116222072977186158236678424689157993532961922 34829543829199918180278916522431027392251122869539,
, 62467957194401269043877107275048102390895523597457 40957953066405232632538044100059654939159879593635,
, 23189706772547915061505504953922979530901129967519 29746152185502371307642255121183693803580388584903,
, 86188088225875314529584099251203829009407770775672 41698116222072977186158236678424689157993532961922,
, 11306739708304724483816533873502340845647058077308 62467957194401269043877107275048102390895523597457,
, 82959174767140363198008187129011875491310547126581 23189706772547915061505504953922979530901129967519,
, 97623331044818386269515456334926366572897563400500 86188088225875314529584099251203829009407770775672,
, 42846280183517070527831839425882145521227251250327 11306739708304724483816533873502340845647058077308,
, 55121603546981200581762165212827652751691296897789 82959174767140363198008187129011875491310547126581,
, 32238195734329339946437501907836945765883352399886 97623331044818386269515456334926366572897563400500,
, 75506164965184775180738168837861091527357929701337 42846280183517070527831839425882145521227251250327,
, 62177842752192623401942399639168044983993173312731 55121603546981200581762165212827652751691296897789,
, 32924185707147349566916674687634660915035914677504 32238195734329339946437501907836945765883352399886,
, 99518671430235219628894890102423325116913619626622 75506164965184775180738168837861091527357929701337,
, 73267460800591547471830798392868535206946944540724 62177842752192623401942399639168044983993173312731,
, 76841822524674417161514036427982273348055556214818 32924185707147349566916674687634660915035914677504,
, 97142617910342598647204516893989422179826088076852 99518671430235219628894890102423325116913619626622,
, 87783646182799346313767754307809363333018982642090 73267460800591547471830798392868535206946944540724,
, 10848802521674670883215120185883543223812876952786 76841822524674417161514036427982273348055556214818,
, 71329612474782464538636993009049310363619763878039 97142617910342598647204516893989422179826088076852,
, 62184073572399794223406235393808339651327408011116 87783646182799346313767754307809363333018982642090,
, 66627891981488087797941876876144230030984490851411 10848802521674670883215120185883543223812876952786,
, 60661826293682836764744779239180335110989069790714 71329612474782464538636993009049310363619763878039,
, 85786944089552990653640447425576083659976645795096 62184073572399794223406235393808339651327408011116,
, 66024396409905389607120198219976047599490197230297 66627891981488087797941876876144230030984490851411,
, 64913982680032973156037120041377903785566085089252 60661826293682836764744779239180335110989069790714,
, 16730939319872750275468906903707539413042652315011 85786944089552990653640447425576083659976645795096,
, 94809377245048795150954100921645863754710598436791 66024396409905389607120198219976047599490197230297,
, 78639167021187492431995700641917969777599028300699 64913982680032973156037120041377903785566085089252,
, 15368713711936614952811305876380278410754449733078 16730939319872750275468906903707539413042652315011,
, 40789923115535562561142322423255033685442488917353 94809377245048795150954100921645863754710598436791,
, 44889911501440648020369068063960672322193204149535 78639167021187492431995700641917969777599028300699,
, 41503128880339536053299340368006977710650566631954 15368713711936614952811305876380278410754449733078,
, 81234880673210146739058568557934581403627822703280 40789923115535562561142322423255033685442488917353,
, 82616570773948327592232845941706525094512325230608 44889911501440648020369068063960672322193204149535,
, 22918802058777319719839450180888072429661980811197 41503128880339536053299340368006977710650566631954,
, 77158542502016545090413245809786882778948721859617 81234880673210146739058568557934581403627822703280,
, 72107838435069186155435662884062257473692284509516 82616570773948327592232845941706525094512325230608,
, 20849603980134001723930671666823555245252804609722 22918802058777319719839450180888072429661980811197,
, 53503534226472524250874054075591789781264330331690 77158542502016545090413245809786882778948721859617,
] 72107838435069186155435662884062257473692284509516,
20849603980134001723930671666823555245252804609722,
53503534226472524250874054075591789781264330331690
]
putStrLn $ "Project Euler, Problem 13\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 13\n"
++ "Answer: "
++ show result

14
Haskell/p014.hs
View File

@ -17,13 +17,15 @@
collatz :: Int -> [Int] collatz :: Int -> [Int]
collatz 1 = [1] collatz 1 = [1]
collatz n collatz n
| even n = n:collatz (n `div` 2) | even n = n : collatz (n `div` 2)
| odd n = n:collatz (3 * n + 1) | odd n = n : collatz (3 * n + 1)
maxCollatzLength :: Int -> Int maxCollatzLength :: Int -> Int
maxCollatzLength n = snd $ maximum $ zip [ length (collatz x) | x <- [1..n-1] ] [1..n-1] maxCollatzLength n = snd $ maximum $ zip [length (collatz x) | x <- [1 .. n - 1]] [1 .. n - 1]
main = do main = do
let result = maxCollatzLength 1000000 let result = maxCollatzLength 1000000
putStrLn $ "Project Euler, Problem 14\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 14\n"
++ "Answer: "
++ show result

8
Haskell/p015.hs
View File

@ -6,6 +6,8 @@ factorial 0 = 1
factorial n = n * factorial (n - 1) factorial n = n * factorial (n - 1)
main = do main = do
let result = factorial 40 `div` factorial 20 ^ 2 let result = factorial 40 `div` factorial 20 ^ 2
putStrLn $ "Project Euler, Problem 15\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 15\n"
++ "Answer: "
++ show result

8
Haskell/p016.hs
View File

@ -5,6 +5,8 @@
import ProjectEuler (digitSum) import ProjectEuler (digitSum)
main = do main = do
let result = digitSum $ 2 ^ 1000 let result = digitSum $ 2 ^ 1000
putStrLn $ "Project Euler, Problem 16\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 16\n"
++ "Answer: "
++ show result

19
Haskell/p019.hs
View File

@ -11,15 +11,18 @@
-- --
-- How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)? -- How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?
import Data.Time.Calendar (Day, DayOfWeek(Sunday), dayOfWeek, fromGregorian) import Data.Time.Calendar (Day, DayOfWeek (Sunday), dayOfWeek, fromGregorian)
countSundaysFirst :: Day -> Day -> Int countSundaysFirst :: Day -> Day -> Int
countSundaysFirst start end = let days = [start .. end] countSundaysFirst start end =
in length $ filter (\x -> dayOfWeek x == Sunday && [last (init (show x)), last (show x)] == "01") days let days = [start .. end]
in length $ filter (\x -> dayOfWeek x == Sunday && [last (init (show x)), last (show x)] == "01") days
main = do main = do
let startDate = fromGregorian 1901 1 1 let startDate = fromGregorian 1901 1 1
endDate = fromGregorian 2000 12 31 endDate = fromGregorian 2000 12 31
result = countSundaysFirst startDate endDate result = countSundaysFirst startDate endDate
putStrLn $ "Project Euler, Problem 19\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 19\n"
++ "Answer: "
++ show result

8
Haskell/p020.hs
View File

@ -12,6 +12,8 @@ factorial 0 = 1
factorial n = n * factorial (n - 1) factorial n = n * factorial (n - 1)
main = do main = do
let result = digitSum $ factorial 100 let result = digitSum $ factorial 100
putStrLn $ "Project Euler, Problem 20\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 20\n"
++ "Answer: "
++ show result

12
Haskell/p021.hs
View File

@ -9,15 +9,17 @@
import ProjectEuler (sumProperDivisors) import ProjectEuler (sumProperDivisors)
properDivisors :: (Integral a) => a -> [a] properDivisors :: (Integral a) => a -> [a]
properDivisors n = [ x | x <- [1..n-1], n `mod` x == 0] properDivisors n = [x | x <- [1 .. n - 1], n `mod` x == 0]
amicable :: (Integral a) => a -> a -> Bool amicable :: (Integral a) => a -> a -> Bool
amicable x y = x /= y && sumProperDivisors x == y && sumProperDivisors y == x amicable x y = x /= y && sumProperDivisors x == y && sumProperDivisors y == x
sumAmicable :: (Integral a) => a -> a sumAmicable :: (Integral a) => a -> a
sumAmicable n = sum [ x | x <- [1..n-1], amicable x $ sumProperDivisors x ] sumAmicable n = sum [x | x <- [1 .. n - 1], amicable x $ sumProperDivisors x]
main = do main = do
let result = sumAmicable 10000 let result = sumAmicable 10000
putStrLn $ "Project Euler, Problem 21\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 21\n"
++ "Answer: "
++ show result

17
Haskell/p022.hs
View File

@ -11,12 +11,15 @@ import Data.List (sort)
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
nameScore :: String -> Int nameScore :: String -> Int
nameScore s = let a = ord 'A' - 1 nameScore s =
in sum $ map ((\x -> x - a) . ord) s let a = ord 'A' - 1
in sum $ map ((\x -> x - a) . ord) s
main = do main = do
contents <- readFile "p022_names.txt" contents <- readFile "p022_names.txt"
let name_scores = map nameScore . sort . splitOn "," $ filter (/= '"') contents let name_scores = map nameScore . sort . splitOn "," $ filter (/= '"') contents
result = sum $ zipWith (*) name_scores [1..] result = sum $ zipWith (*) name_scores [1 ..]
putStrLn $ "Project Euler, Problem 22\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 22\n"
++ "Answer: "
++ show result

16
Haskell/p023.hs
View File

@ -11,20 +11,22 @@
-- Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers. -- Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.
import Data.List ((\\)) import Data.List ((\\))
import qualified Data.Set as Set import qualified Data.Set as Set
import ProjectEuler (sumProperDivisors) import ProjectEuler (sumProperDivisors)
isAbundant :: (Integral a) => a -> Bool isAbundant :: (Integral a) => a -> Bool
isAbundant n = sumProperDivisors n > n isAbundant n = sumProperDivisors n > n
abundantSums :: (Integral a) => [a] abundantSums :: (Integral a) => [a]
abundantSums = Set.toList $ Set.fromList [ x + y | x <- abundantList, y <- abundantList, x + y <= 28123, y >= x ] abundantSums = Set.toList $ Set.fromList [x + y | x <- abundantList, y <- abundantList, x + y <= 28123, y >= x]
where abundantList = [ x | x <- [12..28123], isAbundant x ] where
abundantList = [x | x <- [12 .. 28123], isAbundant x]
sumNotAbundant :: (Integral a) => a sumNotAbundant :: (Integral a) => a
sumNotAbundant = sum $ [1..28123] \\ abundantSums sumNotAbundant = sum $ [1 .. 28123] \\ abundantSums
main = do main = do
let result = sumNotAbundant let result = sumNotAbundant
putStrLn $ "Project Euler, Problem 23\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 23\n"
++ "Answer: "
++ show result

10
Haskell/p024.hs
View File

@ -5,9 +5,11 @@
-- --
-- What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9? -- What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?
import Data.List (sort, permutations) import Data.List (permutations, sort)
main = do main = do
let result = sort (permutations "0123456789") !! 999999 let result = sort (permutations "0123456789") !! 999999
putStrLn $ "Project Euler, Problem 24\n" putStrLn $
++ "Answer: " ++ result "Project Euler, Problem 24\n"
++ "Answer: "
++ result

12
Haskell/p025.hs
View File

@ -20,11 +20,13 @@
-- What is the index of the first term in the Fibonacci sequence to contain 1000 digits? -- What is the index of the first term in the Fibonacci sequence to contain 1000 digits?
fibs :: [Integer] fibs :: [Integer]
fibs = 0:1:zipWith (+) fibs (tail fibs) fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
thousandDigitFib = length $ takeWhile (\x -> length (show x) < 1000) fibs thousandDigitFib = length $ takeWhile (\x -> length (show x) < 1000) fibs
main = do main = do
let result = thousandDigitFib let result = thousandDigitFib
putStrLn $ "Project Euler, Problem 25\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 25\n"
++ "Answer: "
++ show result

27
Haskell/p026.hs
View File

@ -16,23 +16,26 @@
removeFactor :: (Integral a) => a -> a -> a removeFactor :: (Integral a) => a -> a -> a
removeFactor f n removeFactor f n
| n `mod` f /= 0 = n | n `mod` f /= 0 = n
| otherwise = removeFactor f (n `div` f) | otherwise = removeFactor f (n `div` f)
findCycleLengthRecursive :: (Integral a) => a -> a -> a -> a findCycleLengthRecursive :: (Integral a) => a -> a -> a -> a
findCycleLengthRecursive n j k findCycleLengthRecursive n j k
| n == 1 = 0 | n == 1 = 0
| k `mod` n == 0 = j | k `mod` n == 0 = j
| otherwise = findCycleLengthRecursive n (j+1) (k * 10 + 9) | otherwise = findCycleLengthRecursive n (j + 1) (k * 10 + 9)
findCycleLength :: (Integral a) => a -> a findCycleLength :: (Integral a) => a -> a
findCycleLength n = findCycleLengthRecursive ((removeFactor 2 . removeFactor 5) n) 1 9 findCycleLength n = findCycleLengthRecursive ((removeFactor 2 . removeFactor 5) n) 1 9
maxRepeatingCycle :: (Integral a) => a -> a -> a maxRepeatingCycle :: (Integral a) => a -> a -> a
maxRepeatingCycle a b = snd . maximum $ zip xs [1..] maxRepeatingCycle a b = snd . maximum $ zip xs [1 ..]
where xs = map findCycleLength [a..b] where
xs = map findCycleLength [a .. b]
main = do main = do
let result = maxRepeatingCycle 1 999 let result = maxRepeatingCycle 1 999
putStrLn $ "Project Euler, Problem 26\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 26\n"
++ "Answer: "
++ show result

23
Haskell/p027.hs
View File

@ -18,20 +18,23 @@
-- Find the product of the coefficients, a and b, for the quadratic expression that produces the maximum number of primes for consecutive values of n, -- Find the product of the coefficients, a and b, for the quadratic expression that produces the maximum number of primes for consecutive values of n,
-- starting with n=0. -- starting with n=0.
import Data.List (maximumBy)
import Data.Function (on) import Data.Function (on)
import Data.List (maximumBy)
import ProjectEuler (isPrime) import ProjectEuler (isPrime)
findLengthPrimeSequence :: Int -> Int -> Int findLengthPrimeSequence :: Int -> Int -> Int
findLengthPrimeSequence a b = length $ takeWhile isPrime [ n*n + a*n + b | n <- [0..] ] findLengthPrimeSequence a b = length $ takeWhile isPrime [n * n + a * n + b | n <- [0 ..]]
findCoefficients = let as = [-999..999] findCoefficients =
bs = filter isPrime [2..1000] let as = [-999 .. 999]
cs = [ (a, b) | a <- as, b <- bs ] bs = filter isPrime [2 .. 1000]
in fst $ maximumBy (compare `on` snd) [ (c, l) | c <- cs, let l = uncurry findLengthPrimeSequence c ] cs = [(a, b) | a <- as, b <- bs]
in fst $ maximumBy (compare `on` snd) [(c, l) | c <- cs, let l = uncurry findLengthPrimeSequence c]
main = do main = do
let coefficients = findCoefficients let coefficients = findCoefficients
result = uncurry (*) coefficients result = uncurry (*) coefficients
putStrLn $ "Project Euler, Problem 27\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 27\n"
++ "Answer: "
++ show result

10
Haskell/p029.hs
View File

@ -13,9 +13,11 @@
import Data.List (nub) import Data.List (nub)
powerCombinations :: (Integral a) => a -> [a] powerCombinations :: (Integral a) => a -> [a]
powerCombinations n = nub [ x^y | x <- [2..n], y <- [2..n] ] powerCombinations n = nub [x ^ y | x <- [2 .. n], y <- [2 .. n]]
main = do main = do
let result = length $ powerCombinations 100 let result = length $ powerCombinations 100
putStrLn $ "Project Euler, Problem 29\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 29\n"
++ "Answer: "
++ show result

10
Haskell/p030.hs
View File

@ -13,12 +13,14 @@
import Data.Char (digitToInt) import Data.Char (digitToInt)
sumNthPowerDigit :: Int -> Int -> Int sumNthPowerDigit :: Int -> Int -> Int
sumNthPowerDigit p n = sum [ x^p | x <- map digitToInt (show n) ] sumNthPowerDigit p n = sum [x ^ p | x <- map digitToInt (show n)]
equalsSumNthPowerDigit :: Int -> Int -> Bool equalsSumNthPowerDigit :: Int -> Int -> Bool
equalsSumNthPowerDigit p n = n == sumNthPowerDigit p n equalsSumNthPowerDigit p n = n == sumNthPowerDigit p n
main = do main = do
let result = sum $ filter (equalsSumNthPowerDigit 5) [10..354295] let result = sum $ filter (equalsSumNthPowerDigit 5) [10 .. 354295]
putStrLn $ "Project Euler, Problem 30\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 30\n"
++ "Answer: "
++ show result

15
Haskell/p034.hs
View File

@ -11,13 +11,16 @@ factorial 0 = 1
factorial n = n * factorial (n - 1) factorial n = n * factorial (n - 1)
factDigits :: [Int] factDigits :: [Int]
factDigits = map factorial [0..9] factDigits = map factorial [0 .. 9]
equalsDigitFactorial :: Int -> Bool equalsDigitFactorial :: Int -> Bool
equalsDigitFactorial n = let fact_digit_sum = sum $ [ factDigits !! x | x <- map digitToInt (show n) ] equalsDigitFactorial n =
in fact_digit_sum == n let fact_digit_sum = sum $ [factDigits !! x | x <- map digitToInt (show n)]
in fact_digit_sum == n
main = do main = do
let result = sum $ filter equalsDigitFactorial [10..9999999] let result = sum $ filter equalsDigitFactorial [10 .. 9999999]
putStrLn $ "Project Euler, Problem 34\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 34\n"
++ "Answer: "
++ show result

21
Haskell/p035.hs
View File

@ -9,15 +9,16 @@ import ProjectEuler (isPrime, primeSieve)
isCircularPrime :: Int -> Bool isCircularPrime :: Int -> Bool
isCircularPrime n isCircularPrime n
| n == 2 = True | n == 2 = True
| any (`elem` ['0','2'..'8']) (show n) = False | any (`elem` ['0', '2' .. '8']) (show n) = False
| all (isPrime . read) rotations = True | all (isPrime . read) rotations = True
| otherwise = False | otherwise = False
where rotations = zipWith (++) (tails (show n)) (init (inits (show n))) where
--isCircularPrime n = let rotations = zipWith (++) (tails (show n)) (init (inits (show n))) rotations = zipWith (++) (tails (show n)) (init (inits (show n)))
-- in all (isPrime . read) rotations
main = do main = do
let result = length $ filter isCircularPrime (takeWhile (<1000000) primeSieve) let result = length $ filter isCircularPrime (takeWhile (< 1000000) primeSieve)
putStrLn $ "Project Euler, Problem 35\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 35\n"
++ "Answer: "
++ show result

8
Haskell/p036.hs
View File

@ -13,6 +13,8 @@ doublePalindrome :: Int -> Bool
doublePalindrome n = show n == reverse (show n) && toBinary n == reverse (toBinary n) doublePalindrome n = show n == reverse (show n) && toBinary n == reverse (toBinary n)
main = do main = do
let result = sum $ filter doublePalindrome [1..999999] let result = sum $ filter doublePalindrome [1 .. 999999]
putStrLn $ "Project Euler, Problem 36\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 36\n"
++ "Answer: "
++ show result

12
Haskell/p041.hs
View File

@ -3,12 +3,14 @@
-- --
-- What is the largest n-digit pandigital prime that exists? -- What is the largest n-digit pandigital prime that exists?
import ProjectEuler (isPrime, isPandigital) import ProjectEuler (isPandigital, isPrime)
maxPandigitalPrime :: Integer maxPandigitalPrime :: Integer
maxPandigitalPrime = head $ filter isPrime (filter isPandigital [7654321,7654319..]) maxPandigitalPrime = head $ filter isPrime (filter isPandigital [7654321, 7654319 ..])
main = do main = do
let result = maxPandigitalPrime let result = maxPandigitalPrime
putStrLn $ "Project Euler, Problem 41\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 41\n"
++ "Answer: "
++ show result

10
Haskell/p052.hs
View File

@ -4,9 +4,11 @@
import Data.List (sort) import Data.List (sort)
smallestPermutedMultiples :: Integer smallestPermutedMultiples :: Integer
smallestPermutedMultiples = head [ x | x <- [1..], sort (show x) == sort (show (2 * x)), sort (show x) == sort (show (3 * x)), sort (show x) == sort (show (4 * x)), sort (show x) == sort (show (5 * x)), sort (show x) == sort (show (6 * x)) ] smallestPermutedMultiples = head [x | x <- [1 ..], sort (show x) == sort (show (2 * x)), sort (show x) == sort (show (3 * x)), sort (show x) == sort (show (4 * x)), sort (show x) == sort (show (5 * x)), sort (show x) == sort (show (6 * x))]
main = do main = do
let result = smallestPermutedMultiples let result = smallestPermutedMultiples
putStrLn $ "Project Euler, Problem 52\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 52\n"
++ "Answer: "
++ show result

227
Haskell/p054.hs
View File

@ -44,26 +44,31 @@
-- --
-- How many hands does Player 1 win? -- How many hands does Player 1 win?
import Data.List (sort, sortBy, groupBy, minimumBy, maximumBy)
import Data.Function (on) import Data.Function (on)
import Data.List (groupBy, maximumBy, minimumBy, sort, sortBy)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
data Value = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace data Value = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace
deriving (Eq, Ord, Show, Bounded, Enum) deriving (Eq, Ord, Show, Bounded, Enum)
data Suit = Hearts | Diamonds | Clubs | Spades deriving (Eq, Show) data Suit = Hearts | Diamonds | Clubs | Spades deriving (Eq, Show)
data Card = Card { value :: Maybe Value data Card = Card
, suit :: Maybe Suit { value :: Maybe Value,
} deriving (Eq, Show) suit :: Maybe Suit
}
deriving (Eq, Show)
instance Ord Card where instance Ord Card where
(Card v1 _) `compare` (Card v2 _) = v1 `compare` v2 (Card v1 _) `compare` (Card v2 _) = v1 `compare` v2
type Hand = [Card] type Hand = [Card]
data PokerGame = PokerGame { player1 :: Hand data PokerGame = PokerGame
, player2 :: Hand { player1 :: Hand,
} deriving (Eq, Show) player2 :: Hand
}
deriving (Eq, Show)
getValue :: Char -> Maybe Value getValue :: Char -> Maybe Value
getValue '2' = Just Two getValue '2' = Just Two
@ -89,129 +94,153 @@ getSuit 'S' = Just Spades
getSuit _ = Nothing getSuit _ = Nothing
readCard :: String -> Card readCard :: String -> Card
readCard (v:s:_) = Card{value=getValue v,suit=getSuit s} readCard (v : s : _) = Card {value = getValue v, suit = getSuit s}
readGame :: String -> PokerGame readGame :: String -> PokerGame
readGame g = PokerGame{player1=map readCard (take 5 (words g)), player2=map readCard (take 5 (reverse (words g)))} readGame g = PokerGame {player1 = map readCard (take 5 (words g)), player2 = map readCard (take 5 (reverse (words g)))}
royalFlush :: Hand -> Bool royalFlush :: Hand -> Bool
royalFlush h = royalFlush h =
let hs = sort h let hs = sort h
in length (head (groupBy ((==) `on` suit) hs)) == 5 && [Ten .. Ace] == map (fromJust . value) hs in length (head (groupBy ((==) `on` suit) hs)) == 5 && [Ten .. Ace] == map (fromJust . value) hs
straightFlush :: Hand -> Bool straightFlush :: Hand -> Bool
straightFlush h = straightFlush h =
let hs@(x:_) = sort h let hs@(x : _) = sort h
start = fromJust . value $ x start = fromJust . value $ x
in length (head (groupBy ((==) `on` suit) hs)) == 5 && in length (head (groupBy ((==) `on` suit) hs)) == 5
take 5 [start..] == map (fromJust . value) hs && take 5 [start ..] == map (fromJust . value) hs
fourOfAKind :: Hand -> Bool fourOfAKind :: Hand -> Bool
fourOfAKind h = fourOfAKind h =
length (maximumBy (compare `on` length) (groupBy ((==) `on` value) (sort h))) == 4 length (maximumBy (compare `on` length) (groupBy ((==) `on` value) (sort h))) == 4
fullHouse :: Hand -> Bool fullHouse :: Hand -> Bool
fullHouse h = fullHouse h =
let hs = sort h let hs = sort h
in length (minimumBy (compare `on` length) (groupBy ((==) `on` value) hs)) == 2 && in length (minimumBy (compare `on` length) (groupBy ((==) `on` value) hs)) == 2
length (maximumBy (compare `on` length) (groupBy ((==) `on` value) hs)) == 3 && length (maximumBy (compare `on` length) (groupBy ((==) `on` value) hs)) == 3
flush :: Hand -> Bool flush :: Hand -> Bool
flush h = flush h =
length (groupBy ((==) `on` suit) h) == 1 length (groupBy ((==) `on` suit) h) == 1
straight :: Hand -> Bool straight :: Hand -> Bool
straight h = straight h =
let hs@(x:_) = sort h let hs@(x : _) = sort h
start = fromJust . value $ x start = fromJust . value $ x
in take 5 [start..] == map (fromJust . value) hs in take 5 [start ..] == map (fromJust . value) hs
three :: Hand -> Bool three :: Hand -> Bool
three h = three h =
length (maximumBy (compare `on` length) (groupBy ((==) `on` value) (sort h))) == 3 length (maximumBy (compare `on` length) (groupBy ((==) `on` value) (sort h))) == 3
twoPairs :: Hand -> Bool twoPairs :: Hand -> Bool
twoPairs h = twoPairs h =
let hs = sort h let hs = sort h
g_hs = sortBy (flip compare `on` length) (groupBy ((==) `on` value) hs) g_hs = sortBy (flip compare `on` length) (groupBy ((==) `on` value) hs)
in length (head g_hs) == 2 && length (head (tail g_hs)) == 2 in length (head g_hs) == 2 && length (head (tail g_hs)) == 2
pair :: Hand -> Bool pair :: Hand -> Bool
pair h = pair h =
length (maximumBy (compare `on` length) (groupBy ((==) `on` value) (sort h))) == 2 length (maximumBy (compare `on` length) (groupBy ((==) `on` value) (sort h))) == 2
findPairVal :: Hand -> Card findPairVal :: Hand -> Card
findPairVal h = findPairVal h =
head $ concat $ sortBy (flip compare `on` length) (groupBy ((==) `on` value) (sort h)) head $ concat $ sortBy (flip compare `on` length) (groupBy ((==) `on` value) (sort h))
playGame :: PokerGame -> Int playGame :: PokerGame -> Int
playGame g playGame g
| royalFlush $ player1 g = 1 | royalFlush $ player1 g = 1
| royalFlush $ player2 g = -1 | royalFlush $ player2 g = -1
| straightFlush (player1 g) && not (straightFlush (player2 g)) = 1 | straightFlush (player1 g) && not (straightFlush (player2 g)) = 1
| straightFlush (player2 g) && not (straightFlush (player1 g)) = -1 | straightFlush (player2 g) && not (straightFlush (player1 g)) = -1
| straightFlush (player1 g) && straightFlush (player2 g) = | straightFlush (player1 g) && straightFlush (player2 g) =
if minimum (player1 g) > minimum (player2 g) then 1 else -1 if minimum (player1 g) > minimum (player2 g) then 1 else -1
| fourOfAKind (player1 g) && not (fourOfAKind (player2 g)) = 1 | fourOfAKind (player1 g) && not (fourOfAKind (player2 g)) = 1
| fourOfAKind (player2 g) && not (fourOfAKind (player1 g)) = -1 | fourOfAKind (player2 g) && not (fourOfAKind (player1 g)) = -1
| fourOfAKind (player1 g) && fourOfAKind (player2 g) = | fourOfAKind (player1 g) && fourOfAKind (player2 g) =
let (_:x:_) = sort $ player1 g let (_ : x : _) = sort $ player1 g
(_:y:_) = sort $ player2 g (_ : y : _) = sort $ player2 g
in if value x > value y then 1 else -1 in if value x > value y then 1 else -1
| fullHouse (player1 g) && not (fullHouse (player2 g)) = 1 | fullHouse (player1 g) && not (fullHouse (player2 g)) = 1
| fullHouse (player2 g) && not (fullHouse (player1 g)) = -1 | fullHouse (player2 g) && not (fullHouse (player1 g)) = -1
| fullHouse (player1 g) && fullHouse (player2 g) = | fullHouse (player1 g) && fullHouse (player2 g) =
let (_:_:x:_) = sort $ player1 g let (_ : _ : x : _) = sort $ player1 g
(_:_:y:_) = sort $ player2 g (_ : _ : y : _) = sort $ player2 g
in if value x > value y then 1 else -1 in if value x > value y then 1 else -1
| flush (player1 g) && not (flush (player2 g)) = 1 | flush (player1 g) && not (flush (player2 g)) = 1
| flush (player2 g) && not (flush (player1 g)) = -1 | flush (player2 g) && not (flush (player1 g)) = -1
| flush (player1 g) && flush (player2 g) = | flush (player1 g) && flush (player2 g) =
if maximum (player1 g) > maximum (player2 g) then 1 else -1 if maximum (player1 g) > maximum (player2 g) then 1 else -1
| straight (player1 g) && not (straight (player2 g)) = 1 | straight (player1 g) && not (straight (player2 g)) = 1
| straight (player2 g) && not (straight (player1 g)) = -1 | straight (player2 g) && not (straight (player1 g)) = -1
| straight (player1 g) && straight (player2 g) = | straight (player1 g) && straight (player2 g) =
if minimum (player1 g) > minimum (player2 g) then 1 else -1 if minimum (player1 g) > minimum (player2 g) then 1 else -1
| three (player1 g) && not (three (player2 g)) = 1 | three (player1 g) && not (three (player2 g)) = 1
| three (player2 g) && not (three (player1 g)) = -1 | three (player2 g) && not (three (player1 g)) = -1
| three (player1 g) && three (player2 g) = | three (player1 g) && three (player2 g) =
let (_:_:x:_) = sort $ player1 g let (_ : _ : x : _) = sort $ player1 g
(_:_:y:_) = sort $ player2 g (_ : _ : y : _) = sort $ player2 g
in if value x > value y then 1 else -1 in if value x > value y then 1 else -1
| twoPairs (player1 g) && not (twoPairs (player2 g)) = 1 | twoPairs (player1 g) && not (twoPairs (player2 g)) = 1
| twoPairs (player2 g) && not (twoPairs (player1 g)) = -1 | twoPairs (player2 g) && not (twoPairs (player1 g)) = -1
| twoPairs (player1 g) && twoPairs (player2 g) = | twoPairs (player1 g) && twoPairs (player2 g) =
let (v:w:x:y:z:_) = sort $ player1 g let (v : w : x : y : z : _) = sort $ player1 g
(a:b:c:d:e:_) = sort $ player2 g (a : b : c : d : e : _) = sort $ player2 g
in if value y > value d then 1 in if value y > value d
else if value y < value d then -1 then 1
else if value w > value b then 1 else
else if value w < value b then -1 if value y < value d
else if value z > value e then 1 then -1
else if value z < value e then -1 else
else if value x > value c then 1 if value w > value b
else if value x < value c then -1 then 1
else if value v > value a then 1 else
else -1 if value w < value b
| pair (player1 g) && not (pair (player2 g)) = 1 then -1
| pair (player2 g) && not (pair (player1 g)) = -1 else
| pair (player1 g) && pair (player2 g) = if value z > value e
let p1 = findPairVal (player1 g) then 1
p2 = findPairVal (player2 g) else
xs = reverse . sort $ player1 g if value z < value e
ys = reverse . sort $ player2 g then -1
in if p1 > p2 then 1 else
else if p2 > p1 then -1 if value x > value c
else if xs > ys then 1 then 1
else -1 else
| otherwise = if value x < value c
let xs = reverse . sort $ player1 g then -1
ys = reverse . sort $ player2 g else
in if xs > ys then 1 else -1 if value v > value a
then 1
else -1
| pair (player1 g) && not (pair (player2 g)) = 1
| pair (player2 g) && not (pair (player1 g)) = -1
| pair (player1 g) && pair (player2 g) =
let p1 = findPairVal (player1 g)
p2 = findPairVal (player2 g)
xs = reverse . sort $ player1 g
ys = reverse . sort $ player2 g
in if p1 > p2
then 1
else
if p2 > p1
then -1
else
if xs > ys
then 1
else -1
| otherwise =
let xs = reverse . sort $ player1 g
ys = reverse . sort $ player2 g
in if xs > ys then 1 else -1
main = do main = do
contents <- readFile "p054_poker.txt" contents <- readFile "p054_poker.txt"
let games = map readGame (lines contents) let games = map readGame (lines contents)
result = sum $ filter (==1) $ map playGame games result = sum $ filter (== 1) $ map playGame games
putStrLn $ "Project Euler, Problem 54\n" putStrLn $
++ "Answer: " ++ show result "Project Euler, Problem 54\n"
++ "Answer: "
++ show result