Personal tools

Euler problems/1 to 10

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
(Added problem2_v2)
(Problem 5)
 
(44 intermediate revisions by 12 users not shown)
Line 1: Line 1:
[[Category:Programming exercise spoilers]]
+
== [http://projecteuler.net/index.php?section=problems&id=1 Problem 1] ==
== [http://projecteuler.net/index.php?section=view&id=1 Problem 1] ==
 
 
Add all the natural numbers below 1000 that are multiples of 3 or 5.
 
Add all the natural numbers below 1000 that are multiples of 3 or 5.
   
Solution:
+
Two solutions using <hask>sum</hask>:
 
<haskell>
 
<haskell>
problem_1 = sum [ x | x <- [1..999], (x `mod` 3 == 0) || (x `mod` 5 == 0)]
+
import Data.List (union)
  +
problem_1' = sum (union [3,6..999] [5,10..999])
  +
  +
problem_1 = sum [x | x <- [1..999], x `mod` 3 == 0 || x `mod` 5 == 0]
 
</haskell>
 
</haskell>
  +
  +
Another solution which uses algebraic relationships:
   
 
<haskell>
 
<haskell>
problem_1_v2 = sum $ filter (\x -> ( x `mod` 3 == 0 || x `mod` 5 == 0 ) ) [1..999]
+
problem_1 = sumStep 3 999 + sumStep 5 999 - sumStep 15 999
</haskell>
+
where
----
+
sumStep s n = s * sumOnetoN (n `div` s)
<haskell>
+
sumOnetoN n = n * (n+1) `div` 2
sum1to n = n * (n+1) `div` 2
 
 
problem_1_v3 = sumStep 3 999 + sumStep 5 999 - sumStep 15 999
 
where sumStep s n = s * sum1to (n `div` s)
 
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=2 Problem 2] ==
+
== [http://projecteuler.net/index.php?section=problems&id=2 Problem 2] ==
 
Find the sum of all the even-valued terms in the Fibonacci sequence which do not exceed one million.
 
Find the sum of all the even-valued terms in the Fibonacci sequence which do not exceed one million.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_2 = sum [ x | x <- takeWhile (<= 1000000) fibs, x `mod` 2 == 0]
+
problem_2 = sum [ x | x <- takeWhile (<= 1000000) fibs, even x]
where fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
+
where
  +
fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
 
</haskell>
 
</haskell>
----
+
  +
The following two solutions use the fact that the even-valued terms in
  +
the Fibonacci sequence themselves form a Fibonacci-like sequence
  +
that satisfies
  +
<hask>evenFib 0 = 0, evenFib 1 = 2, evenFib (n+2) = evenFib n + 4 * evenFib (n+1)</hask>.
 
<haskell>
 
<haskell>
problem_2_v2 = sumEvenFibs $ numEvenFibsLessThan 1000000
+
problem_2 = sumEvenFibs $ numEvenFibsLessThan 1000000
sumEvenFibs n = (evenFib n + evenFib (n+1) - 2) `div` 4
+
where
evenFib n = round $ (2 + sqrt 5) ** (fromIntegral n) / sqrt 5
+
sumEvenFibs n = (evenFib n + evenFib (n+1) - 2) `div` 4
numEvenFibsLessThan n =
+
evenFib n = round $ (2 + sqrt 5) ** (fromIntegral n) / sqrt 5
floor $ (log (fromIntegral n - 0.5) + 0.5*log 5) / log (2 + sqrt 5)
+
numEvenFibsLessThan n =
  +
floor $ (log (fromIntegral n - 0.5) + 0.5*log 5) / log (2 + sqrt 5)
 
</haskell>
 
</haskell>
   
This works because 10^6 is small. To work with large numbers,
+
The first two solutions work because 10^6 is small.
where using Double is not possible, you can define evenFib
+
The following solution also works for much larger numbers
and numEvenFibsLessThan by using the identities:
+
(up to at least 10^1000000 on my computer):
 
 
<haskell>
 
<haskell>
2 * evenFib (2*n+1) == evenFib n ^2 + evenFib (n+1) ^ 2
+
problem_2 = sumEvenFibsLessThan 1000000
2 * evenFib (2*n) == evenFib n * evenFib (n+1) - 2 * evenFib n ^ 2
+
  +
sumEvenFibsLessThan n = (a + b - 1) `div` 2
  +
where
  +
n2 = n `div` 2
  +
(a, b) = foldr f (0,1)
  +
. takeWhile ((<= n2) . fst)
  +
. iterate times2E $ (1, 4)
  +
f x y | fst z <= n2 = z
  +
| otherwise = y
  +
where z = x `addE` y
  +
addE (a, b) (c, d) = (a*d + b*c - 4*ac, ac + b*d)
  +
where ac=a*c
  +
  +
times2E (a, b) = addE (a, b) (a, b)
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=3 Problem 3] ==
+
== [http://projecteuler.net/index.php?section=problems&id=3 Problem 3] ==
 
Find the largest prime factor of 317584931803.
 
Find the largest prime factor of 317584931803.
   
Line 45: Line 47:
 
<haskell>
 
<haskell>
 
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]
 
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]
  +
 
primeFactors n = factor n primes
 
primeFactors n = factor n primes
where factor n (p:ps) | p*p > n = [n]
+
where
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)
+
factor n (p:ps)
| otherwise = factor n ps
+
| p*p > n = [n]
  +
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)
  +
| otherwise = factor n ps
   
 
problem_3 = last (primeFactors 317584931803)
 
problem_3 = last (primeFactors 317584931803)
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=4 Problem 4] ==
+
Another solution, not using recursion, is:
  +
<haskell>
  +
problem_3 = (m !! 0) `div` (m !! 1)
  +
where
  +
m = reverse $
  +
takeWhile (<=n) (scanl1 (*) [ x | x <- 2:[3,5..], (n `mod` x) == 0 ])
  +
n = 600851475143
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=4 Problem 4] ==
 
Find the largest palindrome made from the product of two 3-digit numbers.
 
Find the largest palindrome made from the product of two 3-digit numbers.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_4 = foldr max 0 [ x | y <- [100..999], z <- [100..999], let x = y * z, let s = show x, s == reverse s]
+
problem_4 =
</haskell>
+
maximum [x | y<-[100..999], z<-[y..999], let x=y*z, let s=show x, s==reverse s]
An alternative to avoid evaluating twice the same pair of numbers:
 
<haskell>
 
problem_4' = foldr1 max [ x | y <- [100..999], z <- [y..999], let x = y * z, let s = show x, s == reverse s]
 
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=5 Problem 5] ==
+
== [http://projecteuler.net/index.php?section=problems&id=5 Problem 5] ==
 
What is the smallest number divisible by each of the numbers 1 to 20?
 
What is the smallest number divisible by each of the numbers 1 to 20?
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_5 = head [ x | x <- [2520,5040..], all (\y -> x `mod` y == 0) [1..20]]
+
problem_5 = foldr1 lcm [1..20]
</haskell>
 
An alternative solution that takes advantage of the Prelude to avoid use of the generate and test idiom:
 
<haskell>
 
problem_5' = foldr1 lcm [1..20]
 
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=6 Problem 6] ==
+
== [http://projecteuler.net/index.php?section=problems&id=6 Problem 6] ==
 
What is the difference between the sum of the squares and the square of the sums?
 
What is the difference between the sum of the squares and the square of the sums?
   
 
Solution:
 
Solution:
  +
<!--
 
<haskell>
 
<haskell>
problem_6 = sum [ x^2 | x <- [1..100]] - (sum [1..100])^2
+
fun n = a - b
  +
where
  +
a=(n^2 * (n+1)^2) `div` 4
  +
b=(n * (n+1) * (2*n+1)) `div` 6
  +
  +
problem_6 = fun 100
 
</haskell>
 
</haskell>
  +
-->
  +
<!-- Might just be me, but I find this a LOT easier to read. Perhaps not as good mathematically, but it runs in an instant, even for n = 25000.
  +
<haskell>
  +
fun n = a - b
  +
where
  +
a = (sum [1..n])^2
  +
b = sum (map (^2) [1..n])
   
== [http://projecteuler.net/index.php?section=view&id=7 Problem 7] ==
+
problem_6 = fun 100
  +
</haskell>
  +
-->
  +
<!-- I just made it a oneliner... -->
  +
<haskell>
  +
problem_6 = (sum [1..100])^2 - sum (map (^2) [1..100])
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=7 Problem 7] ==
 
Find the 10001st prime.
 
Find the 10001st prime.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]
+
--primes in problem_3
primeFactors n = factor n primes
+
problem_7 = primes !! 10000
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_7 = head $ drop 10000 primes
 
 
</haskell>
 
</haskell>
+
== [http://projecteuler.net/index.php?section=problems&id=8 Problem 8] ==
== [http://projecteuler.net/index.php?section=view&id=8 Problem 8] ==
 
 
Discover the largest product of five consecutive digits in the 1000-digit number.
 
Discover the largest product of five consecutive digits in the 1000-digit number.
   
 
Solution:
 
Solution:
  +
<!--
 
<haskell>
 
<haskell>
num = ... -- 1000 digit number as a string
+
import Data.Char
digits = map digitToInt num
 
 
 
groupsOf _ [] = []
 
groupsOf _ [] = []
groupsOf n xs = take n xs : groupsOf n ( tail xs )
+
groupsOf n xs =
+
take n xs : groupsOf n ( tail xs )
problem_8 = maximum . map product . groupsOf 5 $ digits
+
  +
problem_8 x = maximum . map product . groupsOf 5 $ x
  +
main = do t <- readFile "p8.log"
  +
let digits = map digitToInt $concat $ lines t
  +
print $ problem_8 digits
  +
</haskell>
  +
-->
  +
<!-- I just cleaned up a little. -->
  +
<haskell>
  +
import Data.Char (digitToInt)
  +
import Data.List (tails)
  +
  +
problem_8 = do str <- readFile "number.txt"
  +
-- This line just converts our str(ing) to a list of 1000 Ints
  +
let number = map digitToInt (concat $ lines str)
  +
print $ maximum $ map (product . take 5) (tails number)
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=9 Problem 9] ==
+
== [http://projecteuler.net/index.php?section=problems&id=9 Problem 9] ==
 
There is only one Pythagorean triplet, {''a'', ''b'', ''c''}, for which ''a'' + ''b'' + ''c'' = 1000. Find the product ''abc''.
 
There is only one Pythagorean triplet, {''a'', ''b'', ''c''}, for which ''a'' + ''b'' + ''c'' = 1000. Find the product ''abc''.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_9 = head [a*b*c | a <- [1..500], b <- [a..500], let c = 1000-a-b, a^2 + b^2 == c^2]
+
triplets l = [[a,b,c] | m <- [2..limit],
</haskell>
+
n <- [1..(m-1)],
  +
let a = m^2 - n^2,
  +
let b = 2*m*n,
  +
let c = m^2 + n^2,
  +
a+b+c==l]
  +
where limit = floor . sqrt . fromIntegral $ l
   
Another solution using Pythagorean Triplets generation:
+
problem_9 = product . head . triplets $ 1000
<haskell>
 
triplets :: Int -> [(Int, Int, Int)]
 
triplets l = [(a,b,c)|m <- [2..limit], n <- [1..(m-1)], let a = m^2 - n^2, let b = 2*m*n, let c = m^2 + n^2]
 
where limit = floor $ sqrt $ fromIntegral l
 
 
tripletWithLength :: Int -> [(Int, Int, Int)]
 
tripletWithLength n = filter ((==n) . f) $ triplets n
 
where
 
f (a,b,c) = a+b+c
 
 
problem_9 :: Int
 
problem_9 = prod3 $ head $ tripletWithLength 1000
 
where
 
prod3 (a,b,c) = a*b*c
 
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=10 Problem 10] ==
+
== [http://projecteuler.net/index.php?section=problems&id=10 Problem 10] ==
 
Calculate the sum of all the primes below one million.
 
Calculate the sum of all the primes below one million.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
  +
--primes in problem_3
 
problem_10 = sum (takeWhile (< 1000000) primes)
 
problem_10 = sum (takeWhile (< 1000000) primes)
 
</haskell>
 
</haskell>
 
 
[[Category:Tutorials]]
 
[[Category:Code]]
 

Latest revision as of 14:17, 22 October 2012

Contents

[edit] 1 Problem 1

Add all the natural numbers below 1000 that are multiples of 3 or 5.

Two solutions using
sum
:
import Data.List (union)
problem_1' = sum (union [3,6..999] [5,10..999])
 
problem_1  = sum [x | x <- [1..999], x `mod` 3 == 0 || x `mod` 5 == 0]

Another solution which uses algebraic relationships:

problem_1 = sumStep 3 999 + sumStep 5 999 - sumStep 15 999
  where
    sumStep s n = s * sumOnetoN (n `div` s)
    sumOnetoN n = n * (n+1) `div` 2

[edit] 2 Problem 2

Find the sum of all the even-valued terms in the Fibonacci sequence which do not exceed one million.

Solution:

problem_2 = sum [ x | x <- takeWhile (<= 1000000) fibs, even x]
  where
    fibs = 1 : 1 : zipWith (+) fibs (tail fibs)

The following two solutions use the fact that the even-valued terms in the Fibonacci sequence themselves form a Fibonacci-like sequence that satisfies

evenFib 0 = 0, evenFib 1 = 2, evenFib (n+2) = evenFib n + 4 * evenFib (n+1)
.
problem_2 = sumEvenFibs $ numEvenFibsLessThan 1000000
  where
    sumEvenFibs n = (evenFib n + evenFib (n+1) - 2) `div` 4
    evenFib n = round $ (2 + sqrt 5) ** (fromIntegral n) / sqrt 5
    numEvenFibsLessThan n =
              floor $ (log (fromIntegral n - 0.5) + 0.5*log 5) / log (2 + sqrt 5)

The first two solutions work because 10^6 is small. The following solution also works for much larger numbers (up to at least 10^1000000 on my computer):

problem_2 = sumEvenFibsLessThan 1000000
 
sumEvenFibsLessThan n = (a + b - 1) `div` 2
  where
    n2 = n `div` 2
    (a, b) = foldr f (0,1)
             . takeWhile ((<= n2) . fst)
             . iterate times2E $ (1, 4)
    f x y | fst z <= n2 = z
          | otherwise   = y
      where z = x `addE` y
addE (a, b) (c, d) = (a*d + b*c - 4*ac, ac + b*d)
  where ac=a*c
 
times2E (a, b) = addE (a, b) (a, b)

[edit] 3 Problem 3

Find the largest prime factor of 317584931803.

Solution:

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_3 = last (primeFactors 317584931803)

Another solution, not using recursion, is:

problem_3 = (m !! 0) `div` (m !! 1)
  where
    m = reverse $
        takeWhile (<=n) (scanl1 (*) [ x | x <- 2:[3,5..], (n `mod` x) == 0 ])
    n = 600851475143

[edit] 4 Problem 4

Find the largest palindrome made from the product of two 3-digit numbers.

Solution:

problem_4 =
  maximum [x | y<-[100..999], z<-[y..999], let x=y*z, let s=show x, s==reverse s]

[edit] 5 Problem 5

What is the smallest number divisible by each of the numbers 1 to 20?

Solution:

problem_5 = foldr1 lcm [1..20]

[edit] 6 Problem 6

What is the difference between the sum of the squares and the square of the sums?

Solution:

problem_6 = (sum [1..100])^2 - sum (map (^2) [1..100])

[edit] 7 Problem 7

Find the 10001st prime.

Solution:

--primes in problem_3
problem_7 = primes !! 10000

[edit] 8 Problem 8

Discover the largest product of five consecutive digits in the 1000-digit number.

Solution:

import Data.Char (digitToInt)
import Data.List (tails)
 
problem_8 = do str <- readFile "number.txt"
               -- This line just converts our str(ing) to a list of 1000 Ints
               let number = map digitToInt (concat $ lines str)
               print $ maximum $ map (product . take 5) (tails number)

[edit] 9 Problem 9

There is only one Pythagorean triplet, {a, b, c}, for which a + b + c = 1000. Find the product abc.

Solution:

triplets l = [[a,b,c] | m <- [2..limit],
                        n <- [1..(m-1)], 
                        let a = m^2 - n^2, 
                        let b = 2*m*n, 
                        let c = m^2 + n^2,
                        a+b+c==l]
    where limit = floor . sqrt . fromIntegral $ l
 
problem_9 = product . head . triplets $ 1000

[edit] 10 Problem 10

Calculate the sum of all the primes below one million.

Solution:

--primes in problem_3
problem_10 = sum (takeWhile (< 1000000) primes)