Personal tools

Euler problems/11 to 20

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=problems&id=11 Problem 11] ==
+
Do them on your own!
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:
 
using Array and Arrows, for fun :
 
<haskell>
 
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 = getContents >>= print . maximum . prods . input
 
</haskell>
 
 
== [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] ==
 
What is the first triangle number to have over five-hundred divisors?
 
 
Solution:
 
<haskell>
 
--primeFactors in problem_3
 
problem_12 =
 
head $ filter ((> 500) . nDivisors) triangleNumbers
 
where
 
triangleNumbers = scanl1 (+) [1..]
 
nDivisors n =
 
product $ map ((+1) . length) (group (primeFactors n))
 
</haskell>
 
 
== [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.
 
 
Solution:
 
<haskell>
 
sToInt =(+0).read
 
main=do
 
a<-readFile "p13.log"
 
let b=map sToInt $lines a
 
let c=take 10 $ show $ sum b
 
print c
 
</haskell>
 
 
== [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] ==
 
Find the longest sequence using a starting number under one million.
 
 
Solution:
 
Faster solution, using an Array to memoize length of sequences :
 
<haskell>
 
import Data.Array
 
import Data.List
 
 
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 $ foldl' maxBySnd (0,0) $ assocs $ syrs 1000000
 
where
 
maxBySnd x@(_,a) y@(_,b) = if a > b then x else y
 
</haskell>
 
 
== [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:
 
Here is a bit of explanation, and a few more solutions:
 
 
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>
 
problem_15 =
 
product [21..40] `div` product [2..20]
 
</haskell>
 
 
The first solution calculates this using the clever trick of contructing
 
[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_v2 =
 
iterate (\r -> zipWith (+) (0:r) (r++[0])) [1] !! 40 !! 20
 
</haskell>
 
 
== [http://projecteuler.net/index.php?section=problems&id=16 Problem 16] ==
 
What is the sum of the digits of the number 2<sup>1000</sup>?
 
 
Solution:
 
<haskell>
 
import Data.Char
 
problem_16 = sum k
 
where
 
s=show $2^1000
 
k=map digitToInt s
 
</haskell>
 
 
== [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?
 
 
Solution:
 
<haskell>
 
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$concat (map decompose [1..1000])
 
</haskell>
 
 
== [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.
 
 
Solution:
 
<haskell>
 
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]]
 
</haskell>
 
 
== [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.
 
* 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:
 
<haskell>
 
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
 
</haskell>
 
 
Here is an alternative that is simpler, but it is cheating a bit:
 
 
<haskell>
 
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
 
]
 
</haskell>
 
 
== [http://projecteuler.net/index.php?section=problems&id=20 Problem 20] ==
 
Find the sum of digits in 100!
 
 
Solution:
 
<haskell>
 
numPrime x p=takeWhile(>0) [div x (p^a)|a<-[1..]]
 
fastFactorial n=
 
product[a^x|
 
a<-takeWhile(<n) primes,
 
let x=sum$numPrime n a
 
]
 
digits n
 
|n<10=[n]
 
|otherwise= y:digits x
 
where
 
(x,y)=divMod n 10
 
problem_20= sum $ digits $fastFactorial 100
 
</haskell>
 

Revision as of 21:39, 29 January 2008

Do them on your own!