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!