Difference between revisions of "Euler problems/1 to 10"

From HaskellWiki
Jump to: navigation, search
(Added solution to problem 2)
 
(45 intermediate revisions by 13 users not shown)
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=view&id=1 Problem 1] ==
+
== [http://projecteuler.net/index.php?section=problems&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 =
 
  +
import Data.List (union)
sum [ x |
 
  +
problem_1' = sum (union [3,6..999] [5,10..999])
x <- [1..999],
 
  +
(x `mod` 3 == 0) || (x `mod` 5 == 0)
+
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 =
 
  +
problem_1 = sumStep 3 999 + sumStep 5 999 - sumStep 15 999
sum $ filter (\x -> ( x `mod` 3 == 0 || x `mod` 5 == 0 ) ) [1..999]
 
  +
where
</haskell>
 
----
 
<haskell>
 
sumOnetoN n = n * (n+1) `div` 2
 
 
problem_1 =
 
sumStep 3 999 + sumStep 5 999 - sumStep 15 999
 
where
 
 
sumStep s n = s * sumOnetoN (n `div` s)
 
sumStep s n = s * sumOnetoN (n `div` s)
 
  +
sumOnetoN n = n * (n+1) `div` 2
 
</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 =
 
  +
problem_2 = sum [ x | x <- takeWhile (<= 1000000) fibs, even x]
sum [ x |
 
  +
where
x <- takeWhile (<= 1000000) fibs,
 
x `mod` 2 == 0
 
]
 
where
 
 
fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
 
fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
 
</haskell>
 
</haskell>
Line 44: Line 34:
 
<hask>evenFib 0 = 0, evenFib 1 = 2, evenFib (n+2) = evenFib n + 4 * evenFib (n+1)</hask>.
 
<hask>evenFib 0 = 0, evenFib 1 = 2, evenFib (n+2) = evenFib n + 4 * evenFib (n+1)</hask>.
 
<haskell>
 
<haskell>
problem_2_v2 =
 
  +
problem_2 = sumEvenFibs $ numEvenFibsLessThan 1000000
sumEvenFibs $ numEvenFibsLessThan 1000000
 
  +
where
sumEvenFibs n =
+
sumEvenFibs n = (evenFib n + evenFib (n+1) - 2) `div` 4
(evenFib n + evenFib (n+1) - 2) `div` 4
+
evenFib n = round $ (2 + sqrt 5) ** (fromIntegral n) / sqrt 5
evenFib n =
+
numEvenFibsLessThan 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>
   
Line 58: Line 48:
 
problem_2 = sumEvenFibsLessThan 1000000
 
problem_2 = sumEvenFibsLessThan 1000000
   
sumEvenFibsLessThan n =
+
sumEvenFibsLessThan n = (a + b - 1) `div` 2
(a + b - 1) `div` 2
+
where
where
 
 
n2 = n `div` 2
 
n2 = n `div` 2
(a, b) =
+
(a, b) = foldr f (0,1)
foldr f (0,1) $
+
. takeWhile ((<= n2) . fst)
takeWhile ((<= n2) . fst) $
+
. iterate times2E $ (1, 4)
iterate times2E (1, 4)
+
f x y | fst z <= n2 = z
f x y
+
| otherwise = y
| fst z <= n2 = z
+
where z = x `addE` y
| otherwise = y
+
addE (a, b) (c, d) = (a*d + b*c - 4*ac, ac + b*d)
where z = x `addE` y
+
where ac=a*c
addE (a, b) (c, d) =
+
(a*d + b*c - 4*ac, ac + b*d)
+
times2E (a, b) = addE (a, b) (a, b)
where
+
ac=a*c
+
</haskell>
times2E (a, b) =
+
addE (a, b) (a, b)
+
  +
Another elegant, quick solution, based on some background mathematics as in comments:
  +
  +
<haskell>
  +
-- Every third term is even, and every third term beautifully follows:
  +
-- fib n = 4*fib n-3 + fib n-6
  +
evenFibs = 2 : 8 : zipWith (+) (map (4*) (tail evenFibs)) evenFibs
  +
  +
-- So, evenFibs are: e(n) = 4*e(n-1) + e(n-2)
  +
-- [there4]:4e(n) = e(n+1) - e(n-1)
  +
-- 4e(n-1) = e(n) - e(n-2)
  +
-- 4e(n-2) = e(n-1) - e(n-3)
  +
-- ...
  +
-- 4e(3) = e(4) - e(2)
  +
-- 4e(2) = e(3) - e(1)
  +
-- 4e(1) = e(2) - e(0)
  +
-- -------------------------------
  +
-- Total: 4([sum] e(k) - e(0)) = e(n+1) + e(n) - e(1) - e(0)
  +
-- => [sum] e(k) = (e(n+1) + e(n) - e(1) + 3e(0))/4 = 1089154 for
  +
-- first 10 terms
  +
  +
sumEvenFibsBelow :: Int -> Int
  +
sumEvenFibsBelow n = ((last $ take (x+1) evenFibs) +
  +
(last $ take x evenFibs) -
  +
8 + 6) `div` 4
  +
where x = length (takeWhile (<= n) evenFibs)
  +
 
</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 600851475143.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
primes =
 
  +
primes = 2 : filter (null . tail . primeFactors) [3,5..]
2 : filter ((==1) . length . primeFactors) [3,5..]
 
  +
primeFactors n =
+
primeFactors n = factor n primes
factor n primes
+
where
where
 
 
factor n (p:ps)
 
factor n (p:ps)
 
| p*p > n = [n]
 
| p*p > n = [n]
 
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)
 
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)
| otherwise = factor n ps
+
| otherwise = factor n ps
   
problem_3 =
+
problem_3 = last (primeFactors 600851475143)
last (primeFactors 317584931803)
 
 
</haskell>
 
</haskell>
   
This can be improved by using
 
  +
== [http://projecteuler.net/index.php?section=problems&id=4 Problem 4] ==
<hask>null . tail</hask>
 
instead of
 
<hask>(== 1) . length</hask>.
 
 
== [http://projecteuler.net/index.php?section=view&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 =
+
problem_4 =
foldr max 0 [ x |
+
maximum [x | y<-[100..999], z<-[y..999], let x=y*z, let s=show x, s==reverse s]
y <- [100..999],
 
z <- [100..999],
 
let x = y * z,
 
let s = show x,
 
s == reverse s
 
]
 
</haskell>
 
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 =
+
problem_5 = foldr1 lcm [1..20]
head [ x |
 
x <- [2520,5040..],
 
all (\y -> x `mod` y == 0) [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] ==
 
  +
Another solution: <code>16*9*5*7*11*13*17*19</code>. Product of maximal powers of primes in the range.
  +
  +
== [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 =
 
  +
fun n = a - b
sum [ x^2 | x <- [1..100]] - (sum [1..100])^2
 
  +
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.
   
Line 131: Line 138:
 
<haskell>
 
<haskell>
 
--primes in problem_3
 
--primes in problem_3
problem_7 =
+
problem_7 = primes !! 10000
head $ drop 10000 primes
 
 
</haskell>
 
</haskell>
 
  +
== [http://projecteuler.net/index.php?section=problems&id=8 Problem 8] ==
As above, this can be improved by using
 
  +
Discover the largest product of thirteen consecutive digits in the 1000-digit number.
<hask>null . tail</hask>
 
instead of
 
<hask>(== 1) . length</hask>.
 
 
Here is an alternative that uses a
 
[http://www.haskell.org/pipermail/haskell-cafe/2007-February/022854.html sieve of Eratosthenes]:
 
 
<haskell>
 
primes' =
 
2 : 3 : sieve (tail primes') [5,7..]
 
where
 
sieve (p:ps) x =
 
h ++ sieve ps (filter (\q -> q `mod` p /= 0) t
 
where
 
(h, _:t) = span (p*p <) x
 
problem_7_v2 = primes' !! 10000
 
</haskell>
 
 
== [http://projecteuler.net/index.php?section=view&id=8 Problem 8] ==
 
Discover the largest product of five consecutive digits in the 1000-digit number.
 
   
 
Solution:
 
Solution:
  +
<!--
 
<haskell>
 
<haskell>
 
import Data.Char
 
import Data.Char
groupsOf _ [] = []
+
groupsOf _ [] = [] -- incorrect, overall: last
groupsOf n xs =
+
groupsOf n xs = -- subsequences will be shorter than n!!
 
take n xs : groupsOf n ( tail xs )
 
take n xs : groupsOf n ( tail xs )
 
 
problem_8 x=
 
  +
problem_8 x = maximum . map product . groupsOf 5 $ x
maximum . map product . groupsOf 5 $ x
 
  +
main = do t <- readFile "p8.log"
main=do
 
  +
let digits = map digitToInt $concat $ lines t
t<-readFile "p8.log"
 
  +
print $ problem_8 digits
let digits = map digitToInt $foldl (++) "" $ lines t
 
print $ problem_8 digits
 
 
</haskell>
 
</haskell>
  +
-->
  +
<haskell>
  +
import Data.Char
  +
import Data.List
   
== [http://projecteuler.net/index.php?section=view&id=9 Problem 9] ==
 
  +
euler_8 = do
  +
str <- readFile "number.txt"
  +
print . maximum . map product
  +
. foldr (zipWith (:)) (repeat [])
  +
. take 13 . tails . map (fromIntegral . digitToInt)
  +
. concat . lines $ str
  +
</haskell>
  +
  +
== [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 =
 
  +
triplets l = [[a,b,c] | m <- [2..limit],
head [a*b*c |
 
  +
n <- [1..(m-1)],
a <- [1..500],
 
  +
let a = m^2 - n^2,
b <- [a..500],
 
  +
let b = 2*m*n,
let c = 1000-a-b,
+
let c = m^2 + n^2,
a^2 + b^2 == c^2
+
a+b+c==l]
]
+
where limit = floor . sqrt . fromIntegral $ l
</haskell>
 
   
Another solution using Pythagorean Triplets generation:
 
  +
problem_9 = product . head . triplets $ 1000
<haskell>
 
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
 
 
</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>
problem_10 =
 
  +
--primes in problem_3
sum (takeWhile (< 1000000) primes)
+
problem_10 = sum (takeWhile (< 1000000) primes)
 
</haskell>
 
</haskell>

Latest revision as of 02:31, 8 May 2016

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

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)


Another elegant, quick solution, based on some background mathematics as in comments:

-- Every third term is even, and every third term beautifully follows:
-- fib n = 4*fib n-3 + fib n-6
evenFibs = 2 : 8 : zipWith (+) (map (4*) (tail evenFibs)) evenFibs

-- So, evenFibs are: e(n) = 4*e(n-1) + e(n-2)
-- [there4]:4e(n)   = e(n+1) - e(n-1)
--          4e(n-1) = e(n)   - e(n-2)
--          4e(n-2) = e(n-1) - e(n-3)
--          ...
--          4e(3)   = e(4)   - e(2)
--          4e(2)   = e(3)   - e(1)
--          4e(1)   = e(2)   - e(0)
--         -------------------------------
-- Total: 4([sum] e(k) - e(0)) = e(n+1) + e(n) - e(1) - e(0)
-- => [sum] e(k) = (e(n+1) + e(n) - e(1) + 3e(0))/4 = 1089154 for
-- first 10 terms

sumEvenFibsBelow :: Int -> Int
sumEvenFibsBelow n = ((last $ take (x+1) evenFibs) +
                      (last $ take x evenFibs) -
                      8 + 6) `div` 4
  where x = length (takeWhile (<= n) evenFibs)

Problem 3

Find the largest prime factor of 600851475143.

Solution:

primes = 2 : filter (null . tail . 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 600851475143)

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]

Problem 5

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

Solution:

problem_5 = foldr1 lcm [1..20]

Another solution: 16*9*5*7*11*13*17*19. Product of maximal powers of primes in the range.

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])

Problem 7

Find the 10001st prime.

Solution:

--primes in problem_3
problem_7 = primes !! 10000

Problem 8

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

Solution:

import Data.Char 
import Data.List 

euler_8 = do
   str <- readFile "number.txt"
   print . maximum . map product
         . foldr (zipWith (:)) (repeat [])
         . take 13 . tails . map (fromIntegral . digitToInt)
         . concat . lines $ str

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

Problem 10

Calculate the sum of all the primes below one million.

Solution:

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