# Difference between revisions of "Euler problems/11 to 20"

Jim Burton (talk | contribs) (Added solution for problem 14) |
Jim Burton (talk | contribs) m |
||

Line 42: | Line 42: | ||

where n' = if even n then n `div` 2 else (3*n)+1 |
where n' = if even n then n `div` 2 else (3*n)+1 |
||

− | problem_14 = fst $ head $ |
+ | problem_14 = fst $ head $ sortBy (\(_,x) (_,y) -> compare y x) [(x, length $ p14s x) | x <- [1 .. 999999]] |

− | + | ||

− | qsort (x:xs) = qsort left ++ [x] ++ qsort right |
||

− | where left = filter ((>(snd x)) . snd) xs |
||

− | right = filter ((<=(snd x)) . snd) xs |
||

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

## Revision as of 14:40, 2 July 2007

## Contents

## Problem 11

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

Solution:

```
problem_11 = undefined
```

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

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

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

## 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 = undefined
```

## Problem 16

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

Solution:

```
dsum 0 = 0
dsum n = let ( d, m ) = n `divMod` 10 in m + ( dsum d )
problem_16 = dsum ( 2^1000 )
```

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

## Problem 18

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

Solution:

```
problem_18 = undefined
```

## Problem 19

How many Sundays fell on the first of the month during the twentieth century?

Solution:

```
problem_19 = undefined
```

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