Difference between revisions of "Euler problems/11 to 20"
(→Problem 14: streamline code) 

(18 intermediate revisions by 10 users not shown)  
Line 1:  Line 1:  
−  == [http://projecteuler.net/index.php?section= 
+  == [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= 
+  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 

−  
−  diag b = [b !! n !! n  

−  n < [0 .. length b  1], 

−  (>n)$length $transpose b 

−  ] 

−  getAllDiags f g = map f 

−  [drop n . take (length g) $ g  

−  n < [1.. (length g  1)] 

−  ] 

−  problem_11 num= 

−  maximumBy (\(x, _) (y, _) > compare x y) 

−  $zip (map product allfours) allfours 

−  where 

−  rows = num 

−  cols = transpose rows 

−  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) 

−  allposs = rows ++ cols ++ diagLs ++ diagRs 

−  allfours = [x  

−  xss < allposs, 

−  xs < inits xss, 

−  x < tails xs, 

−  length x == 4 

−  ] 

−  sToInt x=map ((+0).read) $words x 

−  main=do 

−  a<readFile "p11.log" 

−  let b=map sToInt $lines a 

−  print $problem_11 b 

−  </haskell> 

−  
−  Second alternative, using Array and Arrows, for fun : 

<haskell> 
<haskell> 

import Control.Arrow 
import Control.Arrow 

Line 98:  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, 
−  +  s < senses, 

−  +  let is = take 4 $ iterate s i, 

−  +  all (inArray 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= 
+  == [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] == 
What is the first triangle number to have over fivehundred divisors? 
What is the first triangle number to have over fivehundred divisors? 

Line 112:  Line 30:  
<haskell> 
<haskell> 

primeFactors in problem_3 
primeFactors in problem_3 

−  problem_12 = 

+  problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers 

−  head $ filter ((> 500) . nDivisors) triangleNumbers 

+  where nDivisors n = product $ map ((+1) . length) (group (primeFactors n)) 

−  where 

+  triangleNumbers = scanl1 (+) [1..] 

−  triangleNumbers = scanl1 (+) [1..] 

−  nDivisors n = 

−  product $ map ((+1) . length) (group (primeFactors n)) 

</haskell> 
</haskell> 

−  == [http://projecteuler.net/index.php?section= 
+  == [http://projecteuler.net/index.php?section=problems&id=13 Problem 13] == 
Find the first ten digits of the sum of onehundred 50digit numbers. 
Find the first ten digits of the sum of onehundred 50digit numbers. 

Solution: 
Solution: 

<haskell> 
<haskell> 

−  sToInt =(+0).read 

+  
−  main=do 

+  main = do xs < fmap (map read . lines) (readFile "p13.log") 

−  a<readFile "p13.log" 

+  print . take 10 . show . sum $ xs 

−  let b=map sToInt $lines a 

−  let c=take 10 $ show $ sum b 

−  print c 

</haskell> 
</haskell> 

−  == [http://projecteuler.net/index.php?section= 
+  == [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> 
+  <haskell> 
−  +  import Data.List 

−  n : p14s' n 

−  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 = 
+  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..n1] 

</haskell> 
</haskell> 

−  Alternate solution, illustrating use of strict folding: 

+  Faster solution, using unboxed types and parallel computation: 

−  
<haskell> 
<haskell> 

−  import 
+  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 

−  problem_14 = 

+  main = print soln 

−  j 1000000 

where 
where 

−  +  s1 = solve [2..500000] 

−  +  s2 = solve [500001..1000000] 

−  +  soln = s2 `par` (s1 `pseq` max s1 s2) 

−  h x n = g x (n, f 1 n) 

−  j n = fst $ foldl' h (1,1) [2..n1] 

</haskell> 
</haskell> 

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

<haskell> 
<haskell> 

import Data.Array 
import Data.Array 

import Data.List 
import Data.List 

+  import Data.Ord (comparing) 

syrs n = 
syrs n = 

a 
a 

where 
where 

−  a = listArray (1,n) $ 0: 
+  a = listArray (1,n) $ 0 : map syr [2..n] 
−  syr 
+  syr x = 
−  if 
+  if y <= n then 1 + a ! y else 1 + syr y 
where 
where 

−  +  y = if even x then x `div` 2 else 3 * x + 1 

main = 
main = 

−  print 
+  print . maximumBy (comparing snd) . assocs . syrs $ 1000000 
−  where 

−  maxBySnd x@(_,a) y@(_,b) = if a > b then x else y 

</haskell> 
</haskell> 

−  == [http://projecteuler.net/index.php?section=view&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? 

+  This is a trivial solution without any memoization, right? 

+  
+  Using a list to memoize the lengths 

−  Solution: 

<haskell> 
<haskell> 

−  problem_15 = 

+  import Data.List 

−  iterate (scanl1 (+)) (repeat 1) !! 20 !! 20 

+  
+   computes the sequence for a given n 

+  l n = n:unfoldr f n where 

+  f 1 = Nothing  we're done here 

+   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 

+  
+  
+  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 (=sequencelength) is greater 

+   a > b = (a,c) 

+   otherwise = (b,d) 

+  
+  main = print answer 

</haskell> 
</haskell> 

+  > 

−  Here is a bit of explanation, and a few more solutions: 

+  == [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? 

+  
+  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 
Each route has exactly 40 steps, with 20 of them horizontal and 20 of 

Line 194:  Line 133:  
<haskell> 
<haskell> 

−  problem_15_v2 = 

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

−  product [21..40] `div` product [2..20] 

</haskell> 
</haskell> 

−  The first solution calculates this using the clever trick of contructing 

+  == [http://projecteuler.net/index.php?section=problems&id=16 Problem 16] == 

−  [http://en.wikipedia.org/wiki/Pascal's_triangle Pascal's triangle] 

−  along its diagonals. 

−  
−  Here is another solution that constructs Pascal's triangle in the usual way, 

−  row by row: 

−  
−  <haskell> 

−  problem_15_v3 = 

−  iterate (\r > zipWith (+) (0:r) (r++[0])) [1] !! 40 !! 20 

−  </haskell> 

−  
−  == [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>? 

Line 217:  Line 143:  
import Data.Char 
import Data.Char 

problem_16 = sum k 
problem_16 = sum k 

−  where 

+  where s = show (2^1000) 

−  s=show $2^1000 

+  k = map digitToInt s 

−  k=map digitToInt s 

</haskell> 
</haskell> 

−  == [http://projecteuler.net/index.php?section= 
+  == [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> 

−   not a very concise or beautiful solution, but food for improvements :) 

−  
−  names = concat $ 

−  [zip [(0, n)  n < [0..19]] 

−  ["", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight" 

−  ,"Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen" 

−  ,"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 

−  
−  spell n = unwords $ if last s == "and" then init s else s 

−  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 

−  </haskell> 

−  
−  This is another solution. I think it is much cleaner than the one above. 

<haskell> 
<haskell> 

import Char 
import Char 

Line 277:  Line 170:  
 x == 1000 = "onethousand" 
 x == 1000 = "onethousand" 

−  where 

+  where firstDigit x = digitToInt . head . show $ x 

−  firstDigit x = digitToInt$head (show x) 

−  problem_17 = 

+  problem_17 = length . concatMap decompose $ [1..1000] 

−  length$concat (map decompose [1..1000]) 

</haskell> 
</haskell> 

−  == [http://projecteuler.net/index.php?section= 
+  == [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 = 
+  problem_18 = head $ foldr1 g tri 
−  +  where 

−  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 311:  Line 202:  
</haskell> 
</haskell> 

−  == [http://projecteuler.net/index.php?section= 
+  == [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 327:  Line 218:  
Solution: 
Solution: 

<haskell> 
<haskell> 

−  problem_19 = 

+  problem_19 = length . filter (== sunday) . drop 12 . take 1212 $ since1900 

−  length $ filter (== sunday) $ drop 12 $ take 1212 since1900 

+  since1900 = scanl nextMonth monday . concat $ 

−  since1900 = 

+  replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap) 

−  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] 

−  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 

Line 348:  Line 238:  
import Data.Time.Calendar.WeekDate 
import Data.Time.Calendar.WeekDate 

−  problem_19_v2 = 
+  problem_19_v2 = length [()  y < [1901..2000], 
−  +  m < [1..12], 

−  +  let (_, _, d) = toWeekDate $ fromGregorian y m 1, 

−  +  d == 7] 

−  let (_, _, d) = toWeekDate $ fromGregorian y m 1, 

−  d == 7 

−  ] 

</haskell> 
</haskell> 

−  == [http://projecteuler.net/index.php?section= 
+  == [http://projecteuler.net/index.php?section=problems&id=20 Problem 20] == 
Find the sum of digits in 100! 
Find the sum of digits in 100! 

Solution: 
Solution: 

<haskell> 
<haskell> 

−  problem_20 = 

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

−  foldr ((+) . Data.Char.digitToInt) 0 $ show $ fac 100 

−  where 

−  fac n = product [1..n] 

−  
−  </haskell> 

−  
−  Alternate solution, summing digits directly, which is faster than the show, digitToInt route. 

−  
−  <haskell> 

−  dsum 0 = 0 

−  dsum n = 

−  m + ( dsum d ) 

−  where 

−  ( d, m ) = n `divMod` 10 

−  
−  problem_20' = 

−  dsum . product $ [ 1 .. 100 ] 

−  </haskell> 

−  Alternate solution, fast Factorial, which is faster than the another two. 

−  <haskell> 

−  numPrime x p=takeWhile(>0) [div x (p^a)a<[1..]] 

−  merge xs@(x:xt) ys@(y:yt) = case compare x y of 

−  LT > x : (merge xt ys) 

−  EQ > x : (merge xt yt) 

−  GT > y : (merge xs yt) 

−  
−  diff xs@(x:xt) ys@(y:yt) = case compare x y of 

−  LT > x : (diff xt ys) 

−  EQ > diff xt yt 

−  GT > diff xs yt 

−  
−  primes = [2,3,5] ++ (diff [7,9..] nonprimes) 

−  nonprimes = foldr1 f . map g $ tail primes 

−  where f (x:xt) ys = x : (merge xt ys) 

−  g p = [ n*p  n < [p,p+2..]] 

−  fastFactorial n= 

−  product[a^x 

−  a<takeWhile(<n) primes, 

−  let x=sum$numPrime n a 

−  ] 

−  digits n 

−  { change 123 to [3,2,1] 

−  } 

−  n<10=[n] 

−  otherwise= y:digits x 

−  where 

−  (x,y)=divMod n 10 

−  problem_20= sum $ digits $fastFactorial 100 

−  
</haskell> 
</haskell> 
Latest revision as of 15:16, 16 September 2015
Contents
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
Problem 12
What is the first triangle number to have over fivehundred 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..]
Problem 13
Find the first ten digits of the sum of onehundred 50digit numbers.
Solution:
main = do xs < fmap (map read . lines) (readFile "p13.log")
print . take 10 . show . sum $ xs
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..n1]
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 : map syr [2..n]
syr x =
if y <= n then 1 + a ! y else 1 + syr y
where
y = if even x then x `div` 2 else 3 * x + 1
main =
print . maximumBy (comparing snd) . assocs . syrs $ 1000000
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]
Problem 16
What is the sum of the digits of the number 2^{1000}?
Solution:
import Data.Char
problem_16 = sum k
where s = show (2^1000)
k = map digitToInt s
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 !! (x1)
 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]
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]]
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 thirtyone,
 Saving February alone,
Which has twentyeight, rain or shine. And on leap years, twentynine.
 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]
Problem 20
Find the sum of digits in 100!
Solution:
problem_20 = sum $ map Char.digitToInt $ show $ product [1..100]