Personal tools

Euler problems/11 to 20

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
(Fix error in problem_19.)
(Problem 14: fourth solution does not memoize)
 
(23 intermediate revisions by 10 users not shown)
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=view&id=11 Problem 11] ==
+
== [http://projecteuler.net/index.php?section=problems&id=11 Problem 11] ==
What is the greatest product of four numbers on the same straight line in the [http://projecteuler.net/index.php?section=view&id=11 20 by 20 grid]?
+
What is the greatest product of four numbers on the same straight line in the [http://projecteuler.net/index.php?section=problems&id=11 20 by 20 grid]?
   
 
Solution:
 
Solution:
<haskell>
+
using Array and Arrows, for fun :
import System.Process
 
import IO
 
import List
 
 
slurpURL url = do
 
(_,out,_,_) <- runInteractiveCommand $ "curl " ++ url
 
hGetContents out
 
 
parse_11 src =
 
let npre p = or.(zipWith (/=) p)
 
clip p q xs = takeWhile (npre q) $ dropWhile (npre p) xs
 
trim s =
 
let (x,y) = break (== '<') s
 
(_,z) = break (== '>') y
 
in if null z then x else x ++ trim (tail z)
 
in map ((map read).words.trim) $ clip "08" "</p>" $ lines src
 
 
solve_11 xss =
 
let mult w x y z = w*x*y*z
 
zipf f (w,x,y,z) = zipWith4 f w x y z
 
zifm = zipf mult
 
zifz = zipf (zipWith4 mult)
 
tupl = zipf (\w x y z -> (w,x,y,z))
 
skew (w,x,y,z) = (w, drop 1 x, drop 2 y, drop 3 z)
 
sker (w,x,y,z) = skew (z,y,x,w)
 
skex x = skew (x,x,x,x)
 
maxl = foldr1 max
 
maxf f g = maxl $ map (maxl.f) $ g xss
 
in maxl
 
[ maxf (zifm.skex) id
 
, maxf id (zifz.skex)
 
, maxf (zifm.skew) (tupl.skex)
 
, maxf (zifm.sker) (tupl.skex) ]
 
 
problem_11 = do
 
src <- slurpURL "http://projecteuler.net/print.php?id=11"
 
print $ solve_11 $ parse_11 src
 
</haskell>
 
 
Alternative, slightly easier to comprehend:
 
<haskell>
 
import Data.List (transpose)
 
import Data.List (tails, inits, maximumBy)
 
 
num = undefined --list of lists of numbers, one list per row
 
 
rows = num
 
cols = transpose rows
 
 
diag b = [b !! n !! n | n <- [0 .. length b - 1], n < (length (transpose b))]
 
 
diagLs = diag rows : diagup ++ diagdown
 
where diagup = getAllDiags diag rows
 
diagdown = getAllDiags diag cols
 
 
diagRs = diag (reverse rows) : diagup ++ diagdown
 
where diagup = getAllDiags diag (reverse num)
 
diagdown = getAllDiags diag (transpose $ reverse num)
 
 
getAllDiags f g = map f [drop n . take (length g) $ g | n <- [1.. (length g - 1)]]
 
 
allposs = rows ++ cols ++ diagLs ++ diagRs
 
allfours = [x | xss <- allposs, xs <- inits xss, x <- tails xs, length x == 4]
 
 
answer = maximumBy (\(x, _) (y, _) -> compare x y) (zip (map product allfours) allfours)
 
</haskell>
 
 
Second alternative, using Array and Arrows, for fun :
 
 
<haskell>
 
<haskell>
 
import Control.Arrow
 
import Control.Arrow
Line 16: Line 16:
   
 
prods :: Array (Int, Int) Int -> [Int]
 
prods :: Array (Int, Int) Int -> [Int]
prods a = [product xs |
+
prods a = [product xs | i <- range $ bounds a,
i <- range $ bounds a
+
s <- senses,
, s <- senses
+
let is = take 4 $ iterate s i,
, let is = take 4 $ iterate s i
+
all (inArray a) is,
, all (inArray a) is
+
let xs = map (a!) is]
, let xs = map (a!) is
+
main = print . maximum . prods . input =<< getContents
]
 
 
main = getContents >>= print . maximum . prods . input
 
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=12 Problem 12] ==
+
== [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] ==
 
What is the first triangle number to have over five-hundred divisors?
 
What is the first triangle number to have over five-hundred divisors?
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
  +
--primeFactors in problem_3
 
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers
 
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers
where triangleNumbers = scanl1 (+) [1..]
+
where nDivisors n = product $ map ((+1) . length) (group (primeFactors n))
nDivisors n = product $ map ((+1) . length) (group (primeFactors n))
+
triangleNumbers = scanl1 (+) [1..]
primes = 2 : filter ((== 1) . length . primeFactors) [3,5..]
 
primeFactors n = factor n primes
 
where factor n (p:ps) | p*p > n = [n]
 
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)
 
| otherwise = factor n ps
 
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=13 Problem 13] ==
+
== [http://projecteuler.net/index.php?section=problems&id=13 Problem 13] ==
 
Find the first ten digits of the sum of one-hundred 50-digit numbers.
 
Find the first ten digits of the sum of one-hundred 50-digit numbers.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
nums = ... -- put the numbers in a list
+
problem_13 = take 10 . show . sum $ nums
+
main = do xs <- fmap (map read . lines) (readFile "p13.log")
  +
print . take 10 . show . sum $ xs
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=14 Problem 14] ==
+
== [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] ==
 
Find the longest sequence using a starting number under one million.
 
Find the longest sequence using a starting number under one million.
   
 
Solution:
 
Solution:
  +
<haskell>
  +
import Data.List
  +
  +
problem_14 = j 1000000 where
  +
f :: Int -> Integer -> Int
  +
f k 1 = k
  +
f k n = f (k+1) $ if even n then div n 2 else 3*n + 1
  +
g x y = if snd x < snd y then y else x
  +
h x n = g x (n, f 1 n)
  +
j n = fst $ foldl' h (1,1) [2..n-1]
  +
</haskell>
  +
  +
Faster solution, using unboxed types and parallel computation:
 
<haskell>
 
<haskell>
p14s :: Integer -> [Integer]
+
import Control.Parallel
p14s n = n : p14s' n
+
import Data.Word
where p14s' n = if n' == 1 then [1] else n' : p14s' n'
 
where n' = if even n then n `div` 2 else (3*n)+1
 
   
problem_14 = fst $ head $ sortBy (\(_,x) (_,y) -> compare y x) [(x, length $ p14s x) | x <- [1 .. 999999]]
+
collatzLen :: Int -> Word32 -> Int
</haskell>
+
collatzLen c 1 = c
  +
collatzLen c n = collatzLen (c+1) $ if n `mod` 2 == 0 then n `div` 2 else 3*n+1
   
Alternate solution, illustrating use of strict folding:
+
pmax x n = x `max` (collatzLen 1 n, n)
   
  +
solve xs = foldl pmax (1,1) xs
  +
  +
main = print soln
  +
where
  +
s1 = solve [2..500000]
  +
s2 = solve [500001..1000000]
  +
soln = s2 `par` (s1 `pseq` max s1 s2)
  +
</haskell>
  +
  +
Even faster solution, using an Array to memoize length of sequences :
 
<haskell>
 
<haskell>
  +
import Data.Array
 
import Data.List
 
import Data.List
  +
import Data.Ord (comparing)
   
problem_14 = j 1000000 where
+
syrs n =
f :: Int -> Integer -> Int
+
a
f k 1 = k
+
where
f k n = f (k+1) $ if even n then div n 2 else 3*n + 1
+
a = listArray (1,n) $ 0:[1 + syr n x | x <- [2..n]]
g x y = if snd x < snd y then y else x
+
syr n x =
h x n = g x (n, f 1 n)
+
if x' <= n then a ! x' else 1 + syr n x'
j n = fst $ foldl' h (1,1) [2..n-1]
+
where
  +
x' = if even x then x `div` 2 else 3 * x + 1
  +
  +
main =
  +
print $ maximumBy (comparing snd) $ assocs $ syrs 1000000
 
</haskell>
 
</haskell>
   
Faster solution, using an Array to memoize length of sequences :
+
<!--
  +
This is a trivial solution without any memoization, right?
  +
  +
Using a list to memoize the lengths
  +
 
<haskell>
 
<haskell>
import Data.Array
 
 
import Data.List
 
import Data.List
   
syrs n = a
+
-- computes the sequence for a given n
where a = listArray (1,n) $ 0:[1 + syr n x | x <- [2..n]]
+
l n = n:unfoldr f n where
syr n x = if x' <= n then a ! x' else 1 + syr n x'
+
f 1 = Nothing -- we're done here
where x' = if even x then x `div` 2 else 3 * x + 1
+
-- for reasons of speed we do div and mod in one go
  +
f n = let (d,m)=divMod n 2 in case m of
  +
0 -> Just (d,d) -- n was even
  +
otherwise -> let k = 3*n+1 in Just (k,k) -- n was odd
   
main = print $ foldl' maxBySnd (0,0) $ assocs $ syrs 1000000
+
where maxBySnd x@(_,a) y@(_,b) = if a > b then x else y
+
answer = foldl1' f $ -- computes the maximum of a list of tuples
  +
-- save the length of the sequence and the number generating it in a tuple
  +
[(length $! l x, x) | x <- [1..1000000]] where
  +
f (a,c) (b,d) -- one tuple is greater than other if the first component (=sequence-length) is greater
  +
| a > b = (a,c)
  +
| otherwise = (b,d)
  +
  +
main = print answer
 
</haskell>
 
</haskell>
  +
-->
   
== [http://projecteuler.net/index.php?section=view&id=15 Problem 15] ==
+
== [http://projecteuler.net/index.php?section=problems&id=15 Problem 15] ==
 
Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?
 
Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?
   
 
Solution:
 
Solution:
  +
A direct computation:
  +
<haskell>
  +
problem_15 = iterate (scanl1 (+)) (repeat 1) !! 20 !! 20
  +
</haskell>
  +
  +
Thinking about it as a problem in combinatorics:
  +
  +
Each route has exactly 40 steps, with 20 of them horizontal and 20 of
  +
them vertical. We need to count how many different ways there are of
  +
choosing which steps are horizontal and which are vertical. So we have:
  +
 
<haskell>
 
<haskell>
problem_15 = iterate (scanl1 (+)) (repeat 1) !! 20 !! 20
+
problem_15 = product [21..40] `div` product [2..20]
 
</haskell>
 
</haskell>
   
+
== [http://projecteuler.net/index.php?section=problems&id=16 Problem 16] ==
== [http://projecteuler.net/index.php?section=view&id=16 Problem 16] ==
 
 
What is the sum of the digits of the number 2<sup>1000</sup>?
 
What is the sum of the digits of the number 2<sup>1000</sup>?
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_16 = sum.(map (read.(:[]))).show $ 2^1000
+
import Data.Char
  +
problem_16 = sum k
  +
where s = show (2^1000)
  +
k = map digitToInt s
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=17 Problem 17] ==
+
== [http://projecteuler.net/index.php?section=problems&id=17 Problem 17] ==
 
How many letters would be needed to write all the numbers in words from 1 to 1000?
 
How many letters would be needed to write all the numbers in words from 1 to 1000?
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
-- not a very concise or beautiful solution, but food for improvements :)
+
import Char
   
names = concat $
+
one = ["one","two","three","four","five","six","seven","eight",
[zip [(0, n) | n <- [0..19]]
+
"nine","ten","eleven","twelve","thirteen","fourteen","fifteen",
["", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight"
+
"sixteen","seventeen","eighteen", "nineteen"]
,"Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen"
+
ty = ["twenty","thirty","forty","fifty","sixty","seventy","eighty","ninety"]
,"Sixteen", "Seventeen", "Eighteen", "Nineteen"]
 
,zip [(1, n) | n <- [0..9]]
 
["", "Ten", "Twenty", "Thirty", "Fourty", "Fifty", "Sixty", "Seventy"
 
,"Eighty", "Ninety"]
 
,[((2,0), "")]
 
,[((2, n), look (0,n) ++ " Hundred and") | n <- [1..9]]
 
,[((3,0), "")]
 
,[((3, n), look (0,n) ++ " Thousand") | n <- [1..9]]]
 
   
look n = fromJust . lookup n $ names
+
decompose x
  +
| x == 0 = []
  +
| x < 20 = one !! (x-1)
  +
| x >= 20 && x < 100 =
  +
ty !! (firstDigit (x) - 2) ++ decompose ( x - firstDigit (x) * 10)
  +
| x < 1000 && x `mod` 100 ==0 =
  +
one !! (firstDigit (x)-1) ++ "hundred"
  +
| x > 100 && x <= 999 =
  +
one !! (firstDigit (x)-1) ++ "hundredand" ++decompose ( x - firstDigit (x) * 100)
  +
| x == 1000 = "onethousand"
   
spell n = unwords $ if last s == "and" then init s else s
+
where firstDigit x = digitToInt . head . show $ x
where
 
s = words . unwords $ map look digs'
 
digs = reverse . zip [0..] . reverse . map digitToInt . show $ n
 
digs' = case lookup 1 digs of
 
Just 1 ->
 
let [ten,one] = filter (\(a,_) -> a<=1) digs in
 
(digs \\ [ten,one]) ++ [(0,(snd ten)*10+(snd one))]
 
otherwise -> digs
 
   
problem_17 xs = sum . map (length . filter (`notElem` " -") . spell) $ xs
+
problem_17 = length . concatMap decompose $ [1..1000]
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=18 Problem 18] ==
+
== [http://projecteuler.net/index.php?section=problems&id=18 Problem 18] ==
 
Find the maximum sum travelling from the top of the triangle to the base.
 
Find the maximum sum travelling from the top of the triangle to the base.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_18 = head $ foldr1 g tri where
+
problem_18 = head $ foldr1 g tri
  +
where
 
f x y z = x + max y z
 
f x y z = x + max y z
 
g xs ys = zipWith3 f xs ys $ tail ys
 
g xs ys = zipWith3 f xs ys $ tail ys
Line 143: Line 180:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=19 Problem 19] ==
+
== [http://projecteuler.net/index.php?section=problems&id=19 Problem 19] ==
 
You are given the following information, but you may prefer to do some research for yourself.
 
You are given the following information, but you may prefer to do some research for yourself.
 
* 1 Jan 1900 was a Monday.
 
* 1 Jan 1900 was a Monday.
Line 154: Line 191:
 
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.
 
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.
   
How many Sundays fell on the first of the month during the twentieth century?
+
How many Sundays fell on the first of the month during the twentieth century
  +
(1 Jan 1901 to 31 Dec 2000)?
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_19 = length $ filter (== sunday) $ drop 12 $ take 1212 since1900
+
problem_19 = length . filter (== sunday) . drop 12 . take 1212 $ since1900
since1900 = scanl nextMonth monday $ concat $
+
since1900 = scanl nextMonth monday . concat $
replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)
+
replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)
  +
 
nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
 
nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
  +
 
leap = 31 : 29 : drop 2 nonLeap
 
leap = 31 : 29 : drop 2 nonLeap
  +
 
nextMonth x y = (x + y) `mod` 7
 
nextMonth x y = (x + y) `mod` 7
  +
 
sunday = 0
 
sunday = 0
 
monday = 1
 
monday = 1
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=20 Problem 20] ==
+
Here is an alternative that is simpler, but it is cheating a bit:
Find the sum of digits in 100!
 
   
Solution:
 
 
<haskell>
 
<haskell>
problem_20 = let fac n = product [1..n] in
+
import Data.Time.Calendar
foldr ((+) . Data.Char.digitToInt) 0 $ show $ fac 100
+
import Data.Time.Calendar.WeekDate
  +
  +
problem_19_v2 = length [() | y <- [1901..2000],
  +
m <- [1..12],
  +
let (_, _, d) = toWeekDate $ fromGregorian y m 1,
  +
d == 7]
 
</haskell>
 
</haskell>
   
Alternate solution, summing digits directly, which is faster than the show, digitToInt route.
+
== [http://projecteuler.net/index.php?section=problems&id=20 Problem 20] ==
  +
Find the sum of digits in 100!
   
  +
Solution:
 
<haskell>
 
<haskell>
dsum 0 = 0
+
problem_20 = sum $ map Char.digitToInt $ show $ product [1..100]
dsum n = let ( d, m ) = n `divMod` 10 in m + ( dsum d )
 
 
problem_20' = dsum . product $ [ 1 .. 100 ]
 
 
</haskell>
 
</haskell>

Latest revision as of 14:07, 2 December 2011

Contents

[edit] 1 Problem 11

What is the greatest product of four numbers on the same straight line in the 20 by 20 grid?

Solution: using Array and Arrows, for fun :

import Control.Arrow
import Data.Array
 
input :: String -> Array (Int,Int) Int
input = listArray ((1,1),(20,20)) . map read . words
 
senses = [(+1) *** id,(+1) *** (+1), id *** (+1), (+1) *** (\n -> n - 1)]
 
inArray a i = inRange (bounds a) i
 
prods :: Array (Int, Int) Int -> [Int]
prods a = [product xs | i <- range $ bounds a,
                        s <- senses,
                        let is = take 4 $ iterate s i,
                        all (inArray a) is,
                        let xs = map (a!) is]
main = print . maximum . prods . input =<< getContents

[edit] 2 Problem 12

What is the first triangle number to have over five-hundred divisors?

Solution:

--primeFactors in problem_3
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers
  where nDivisors n = product $ map ((+1) . length) (group (primeFactors n))    
        triangleNumbers = scanl1 (+) [1..]

[edit] 3 Problem 13

Find the first ten digits of the sum of one-hundred 50-digit numbers.

Solution:

main = do xs <- fmap (map read . lines) (readFile "p13.log")
          print . take 10 . show . sum $ xs

[edit] 4 Problem 14

Find the longest sequence using a starting number under one million.

Solution:

 
import Data.List   
 
problem_14 = j 1000000 where   
f :: Int -> Integer -> Int   
f k 1 = k   
f k n = f (k+1) $ if even n then div n 2 else 3*n + 1   
g x y = if snd x < snd y then y else x   
h x n = g x (n, f 1 n)   
j n = fst $ foldl' h (1,1) [2..n-1]

Faster solution, using unboxed types and parallel computation:

import Control.Parallel
import Data.Word
 
collatzLen :: Int -> Word32 -> Int
collatzLen c 1 = c
collatzLen c n = collatzLen (c+1) $ if n `mod` 2 == 0 then n `div` 2 else 3*n+1
 
pmax x n = x `max` (collatzLen 1 n, n)
 
solve xs = foldl pmax (1,1) xs
 
main = print soln
    where
        s1 = solve [2..500000]
        s2 = solve [500001..1000000]
        soln = s2 `par` (s1 `pseq` max s1 s2)

Even faster solution, using an Array to memoize length of sequences :

import Data.Array
import Data.List
import Data.Ord (comparing)
 
syrs n = 
    a
    where 
    a = listArray (1,n) $ 0:[1 + syr n x | x <- [2..n]]
    syr n x = 
        if x' <= n then a ! x' else 1 + syr n x'
        where 
        x' = if even x then x `div` 2 else 3 * x + 1
 
main = 
    print $ maximumBy (comparing snd) $ assocs $ syrs 1000000


[edit] 5 Problem 15

Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?

Solution: A direct computation:

 
problem_15 = iterate (scanl1 (+)) (repeat 1) !! 20 !! 20

Thinking about it as a problem in combinatorics:

Each route has exactly 40 steps, with 20 of them horizontal and 20 of them vertical. We need to count how many different ways there are of choosing which steps are horizontal and which are vertical. So we have:

problem_15 = product [21..40] `div` product [2..20]

[edit] 6 Problem 16

What is the sum of the digits of the number 21000?

Solution:

import Data.Char
problem_16 = sum k
  where s = show (2^1000)
        k = map digitToInt s

[edit] 7 Problem 17

How many letters would be needed to write all the numbers in words from 1 to 1000?

Solution:

import Char
 
one = ["one","two","three","four","five","six","seven","eight",
     "nine","ten","eleven","twelve","thirteen","fourteen","fifteen",
     "sixteen","seventeen","eighteen", "nineteen"]
ty = ["twenty","thirty","forty","fifty","sixty","seventy","eighty","ninety"]
 
decompose x 
    | x == 0                       = []
    | x < 20                       = one !! (x-1)
    | x >= 20 && x < 100           = 
        ty !! (firstDigit (x) - 2) ++ decompose ( x - firstDigit (x) * 10)
    | x < 1000 && x `mod` 100 ==0  = 
        one !! (firstDigit (x)-1) ++ "hundred"
    | x > 100 && x <= 999          = 
        one !! (firstDigit (x)-1) ++ "hundredand" ++decompose ( x - firstDigit (x) * 100)
    | x == 1000                    = "onethousand"
 
  where firstDigit x = digitToInt . head . show $ x
 
problem_17 = length . concatMap decompose $ [1..1000]

[edit] 8 Problem 18

Find the maximum sum travelling from the top of the triangle to the base.

Solution:

problem_18 = head $ foldr1 g tri 
  where
    f x y z = x + max y z
    g xs ys = zipWith3 f xs ys $ tail ys
    tri = [
        [75],
        [95,64],
        [17,47,82],
        [18,35,87,10],
        [20,04,82,47,65],
        [19,01,23,75,03,34],
        [88,02,77,73,07,63,67],
        [99,65,04,28,06,16,70,92],
        [41,41,26,56,83,40,80,70,33],
        [41,48,72,33,47,32,37,16,94,29],
        [53,71,44,65,25,43,91,52,97,51,14],
        [70,11,33,28,77,73,17,78,39,68,17,57],
        [91,71,52,38,17,14,91,43,58,50,27,29,48],
        [63,66,04,68,89,53,67,30,73,16,69,87,40,31],
        [04,62,98,27,23,09,70,98,73,93,38,53,60,04,23]]

[edit] 9 Problem 19

You are given the following information, but you may prefer to do some research for yourself.

  • 1 Jan 1900 was a Monday.
  • Thirty days has September,
  • April, June and November.
  • All the rest have thirty-one,
  • Saving February alone,

Which has twenty-eight, rain or shine. And on leap years, twenty-nine.

  • A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.

How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?

Solution:

problem_19 =  length . filter (== sunday) . drop 12 . take 1212 $ since1900
since1900 = scanl nextMonth monday . concat $
              replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)
 
nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
 
leap = 31 : 29 : drop 2 nonLeap
 
nextMonth x y = (x + y) `mod` 7
 
sunday = 0
monday = 1

Here is an alternative that is simpler, but it is cheating a bit:

import Data.Time.Calendar
import Data.Time.Calendar.WeekDate
 
problem_19_v2 = length [() | y <- [1901..2000], 
                             m <- [1..12],
                             let (_, _, d) = toWeekDate $ fromGregorian y m 1,
                             d == 7]

[edit] 10 Problem 20

Find the sum of digits in 100!

Solution:

problem_20 = sum $ map Char.digitToInt $ show $ product [1..100]