Project Euler

In [1]:
-- Problem 1
sum $ takeWhile (< 1000) [ k | k <- [1..], k `mod` 3 == 0 || k `mod` 5 == 0]
233168
In [2]:
-- Problem 2
fibo :: Int -> [Int]
fibo 0 = [1]
fibo 1 = [2, 1]
fibo n = a + b : a : b : xs where a:b:xs = fibo $ n-1

sum $ filter (\x -> x < 4000000 && x `mod` 2 == 0) $ fibo 32
4613732
In [3]:
-- Problem 3
factor :: Int -> [Int]
factor 1 = []
factor n = d : factor (n `quot` d) where d = head [k | k <- [2..], n `mod` k == 0]

last $ factor 600851475143
6857
In [4]:
-- Problem 4
isPalindrome :: Int -> Bool
isPalindrome n = rev == str
    where
      str = show n
      rev = reverse str
      
foldl max 0 $ filter isPalindrome [p * q | p <- [100..999], q <- [100..999]]
906609
In [5]:
-- Problem 5
foldl lcm 1 [1..20]
232792560
In [6]:
-- Problem 6
abs $ (100 * 101 * 201 `quot` 6) - (100 * 101 `quot` 2)^2
25164150
In [7]:
-- Problem 7
delmult :: Int -> [Int] -> [Int] 
delmult k = filter (\n -> n `mod` k /= 0 || k == n)

sieve xs k
    | 2 * k - 1 > (length xs) = xs
    | otherwise = sieve ys p
        where
            ys = delmult k xs
            p = head $ dropWhile (<= k) xs

sieve [2..120000] 2 !! 10000
104743
In [8]:
-- Problem 8
everySub :: [a] -> Int -> [[a]]
everySub xs k
    | length xs >= k = take k xs : everySub (tail xs) k
    | otherwise = []
    
p8number = "7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450"

foldl max 0 $ map (product . map (\x -> read [x] :: Int)) $ everySub p8number 13
23514624000
In [9]:
-- Problem 9
import Data.List
let (Just (a, b, c)) = find (\(a, b, c) -> a^2 + b^2 == c^2) [(a, b, 1000 - a - b) | a <- [1..1000], b <- [a..1000]] in a * b * c
31875000
In [10]:
-- Problem 10
minus (x:xs) (y:ys) = case (compare x y) of 
           LT -> x : minus  xs  (y:ys)
           EQ ->     minus  xs     ys 
           GT ->     minus (x:xs)  ys
minus  xs     _     = xs
primesToG m = 2 : sieve [3,5..m]
    where
    sieve (p:xs) 
       | p*p > m   = p : xs
       | otherwise = p : sieve (xs `minus` [p*p, p*p+2*p..])

sum $ primesToG 2000000
142913828922
In [11]:
-- Problem 11
matrix11 =
    [ [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]]

fourline = [[(a, c) | c <- [b..b+3]] | a <- [0..19], b <- [0..16]]
fourcolumn = map (map (\(a, b) -> (b, a))) fourline
fourdiagonal = [[(a + c, b + c) | c <- [0..3]] | a <- [0..16], b <- [0..16]]
fourdiagonal2 = [[(a - c, b + c) | c <- [0..3]] | a <- [3..19], b <- [0..16]]

fourall = fourline ++ fourcolumn ++ fourdiagonal ++ fourdiagonal2
nums = map (map (\(a, b) -> matrix11 !! a !! b)) fourall

foldl max 0 $ map product nums
70600674
In [12]:
-- Problem 12
import Data.List
triangle :: Int -> Int
triangle n = n * (n + 1) `quot` 2

div :: Int -> Int
div = product . map ((+ 1) . length) . group . factor

find ((>= 500) . div) $ map triangle [1..]
Just 76576500