# Euler problems/11 to 20

### From HaskellWiki

(Problem 11 refactored) |
(Corrected links to the Euler site; completed text of problem 19) |
||

Line 1: | Line 1: | ||

[[Category:Programming exercise spoilers]] | [[Category:Programming exercise spoilers]] | ||

− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=view&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=view&id=11 20 by 20 grid]? | ||

Line 44: | Line 44: | ||

</haskell> | </haskell> | ||

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

Line 59: | Line 59: | ||

</haskell> | </haskell> | ||

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

Line 68: | Line 68: | ||

</haskell> | </haskell> | ||

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

Line 96: | Line 96: | ||

</haskell> | </haskell> | ||

− | == [http://projecteuler.net/index.php?section= | + | == [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? | Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner? | ||

Line 104: | Line 104: | ||

</haskell> | </haskell> | ||

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

</haskell> | </haskell> | ||

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

Line 147: | Line 147: | ||

</haskell> | </haskell> | ||

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

Line 173: | Line 173: | ||

</haskell> | </haskell> | ||

− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=view&id=19 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? | How many Sundays fell on the first of the month during the twentieth century? | ||

Line 181: | Line 191: | ||

</haskell> | </haskell> | ||

− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=view&id=20 Problem 20] == |

Find the sum of digits in 100! | Find the sum of digits in 100! | ||

## Revision as of 10:21, 20 July 2007

## Contents |

## 1 Problem 11

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

Solution:

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

## 2 Problem 12

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

Solution:

problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers where triangleNumbers = scanl1 (+) [1..] nDivisors n = product $ map ((+1) . length) (group (primeFactors n)) 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

## 3 Problem 13

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

Solution:

nums = ... -- put the numbers in a list problem_13 = take 10 . show . sum $ nums

## 4 Problem 14

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

Solution:

p14s :: Integer -> [Integer] p14s n = 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 = fst $ head $ sortBy (\(_,x) (_,y) -> compare y x) [(x, length $ p14s x) | x <- [1 .. 999999]]

Alternate solution, illustrating use of strict folding:

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]

## 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:

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

## 6 Problem 16

What is the sum of the digits of the number 2^{1000}?

Solution:

problem_16 = sum.(map (read.(:[]))).show $ 2^1000

## 7 Problem 17

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

Solution:

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

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

## 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?

Solution:

problem_19 = undefined

## 10 Problem 20

Find the sum of digits in 100!

Solution:

problem_20 = let fac n = product [1..n] in foldr ((+) . Data.Char.digitToInt) 0 $ show $ fac 100

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

dsum 0 = 0 dsum n = let ( d, m ) = n `divMod` 10 in m + ( dsum d ) problem_20' = dsum . product $ [ 1 .. 100 ]