Euler problems/11 to 20

(Difference between revisions)

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

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