Difference between revisions of "Euler problems/11 to 20"
CaleGibbard (talk  contribs) (Fix layout.) 

Line 16:  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> 

Line 35:  Line 35:  
76576500, 236215980,7534947420] 
76576500, 236215980,7534947420] 

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 

−  nDivisors n = 

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

</haskell> 
</haskell> 

Line 47:  Line 44:  
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> 

Line 76:  Line 70:  
<haskell> 
<haskell> 

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

</haskell> 
</haskell> 

Line 86:  Line 80:  
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> 

Line 114:  Line 107:  
 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> 

Line 126:  Line 117:  
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 164:  Line 155:  
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 185:  Line 175:  
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> 

Line 196:  Line 186:  
Solution: 
Solution: 

<haskell> 
<haskell> 

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

−  a<takeWhile(<n) primes, 
+  product[a^x  a < takeWhile(<n) primes, 
−  let x=sum$numPrime n a 
+  let x = sum $ numPrime n a ] 
−  ] 

digits n 
digits n 

−  +   n<10 = [n] 

−  +   otherwise = y:digits x 

−  +  where (x,y) = divMod n 10 

−  +  
−  problem_20= sum 
+  problem_20 = sum . digits . fastFactorial $ 100 
</haskell> 
</haskell> 
Revision as of 19:19, 19 February 2008
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:
http://www.research.att.com/~njas/sequences/A084260
triangleNumbers =
[630, 5460, 25200, 73920, 97020, 157080,
1185030, 2031120, 2162160, 17907120,
76576500, 236215980,7534947420]
primeFactors in problem_3
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers
where nDivisors n = product $ map ((+1) . length) (group (primeFactors n))
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: Faster solution, using an Array to memoize length of sequences :
http://www.research.att.com/~njas/sequences/A033958
problem_14=837799
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:
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:
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