Personal tools

Euler problems/21 to 30

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=view&id=21 Problem 21] ==
+
== [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] ==
 
Evaluate the sum of all amicable pairs under 10000.
 
Evaluate the sum of all amicable pairs under 10000.
   
Line 14: Line 14:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=22 Problem 22] ==
+
== [http://projecteuler.net/index.php?section=problems&id=22 Problem 22] ==
 
What is the total of all the name scores in the file of first names?
 
What is the total of all the name scores in the file of first names?
   
Line 30: Line 30:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=23 Problem 23] ==
+
== [http://projecteuler.net/index.php?section=problems&id=23 Problem 23] ==
 
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.
 
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.
   
Line 47: Line 47:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=24 Problem 24] ==
+
== [http://projecteuler.net/index.php?section=problems&id=24 Problem 24] ==
 
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?
 
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?
   
Line 67: Line 67:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=25 Problem 25] ==
+
== [http://projecteuler.net/index.php?section=problems&id=25 Problem 25] ==
 
What is the first term in the Fibonacci sequence to contain 1000 digits?
 
What is the first term in the Fibonacci sequence to contain 1000 digits?
   
Line 91: Line 91:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=26 Problem 26] ==
+
== [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] ==
 
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.
 
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.
   
Line 113: Line 113:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=27 Problem 27] ==
+
== [http://projecteuler.net/index.php?section=problems&id=27 Problem 27] ==
 
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.
 
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.
   
Line 127: Line 127:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=28 Problem 28] ==
+
== [http://projecteuler.net/index.php?section=problems&id=28 Problem 28] ==
 
What is the sum of both diagonals in a 1001 by 1001 spiral?
 
What is the sum of both diagonals in a 1001 by 1001 spiral?
   
Line 135: Line 135:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=29 Problem 29] ==
+
== [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] ==
 
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?
 
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?
   
Line 144: Line 144:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=30 Problem 30] ==
+
== [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] ==
 
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.
 
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.
   

Revision as of 13:46, 22 January 2008

Contents

1 Problem 21

Evaluate the sum of all amicable pairs under 10000.

Solution:

problem_21 = 
    sum [n |
    n <- [2..9999],
    let m = eulerTotient  n,
    m > 1,
    m < 10000,
    n ==  eulerTotient  m
    ]

2 Problem 22

What is the total of all the name scores in the file of first names?

Solution:

import Data.List
import Data.Char
problem_22 = do
    input <- readFile "names.txt"
    let names = sort $ read$"["++ input++"]"
    let scores = zipWith score names [1..]
    print $ show $ sum $ scores
    where
    score w i = (i *) $ sum $ map (\c -> ord c - ord 'A' + 1) w

3 Problem 23

Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.

Solution:

import Data.Array 
n = 28124
abundant n = eulerTotient n - n > n
abunds_array = listArray (1,n) $ map abundant [1..n]
abunds = filter (abunds_array !) [1..n]
 
rests x = map (x-) $ takeWhile (<= x `div` 2) abunds
isSum = any (abunds_array !) . rests
 
problem_23 = putStrLn $ show $ foldl1 (+) $ filter (not . isSum) [1..n]

4 Problem 24

What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?

Solution:

import Data.List 
 
fac 0 = 1
fac n = n * fac (n - 1)
perms [] _= []
perms xs n=
    x:( perms ( delete x $ xs ) (mod n m))
    where
    m=fac$(length(xs) -1)
    y=div n m
    x = xs!!y
 
problem_24 =  perms "0123456789"  999999

5 Problem 25

What is the first term in the Fibonacci sequence to contain 1000 digits?

Solution:

import Data.List
fib x
    |x==0=0
    |x==1=1
    |x==2=1
    |odd x=(fib (d+1))^2+(fib d)^2
    |otherwise=(fib (d+1))^2-(fib (d-1))^2
    where
    d=div x 2
 
phi=(1+sqrt 5)/2
dig x=floor( (fromInteger x-1) * log 10 /log phi)
problem_25 = 
    head[a|a<-[dig num..],(>=limit)$fib a]
    where
    num=1000
    limit=10^(num-1)

6 Problem 26

Find the value of d < 1000 for which 1/d contains the longest recurring cycle.

Solution:

next n d = (n `mod` d):next (10*n`mod`d) d
 
idigs n = tail $ take (1+n) $ next 1 n
 
pos x = map fst . filter ((==x) . snd) . zip [1..]
 
periods n = let d = idigs n in pos (head d) (tail d)
 
problem_26 = 
    snd$maximum [(m,a)|
    a<-[800..1000] ,
    let k=periods a,
    not$null k,
    let m=head k
    ]

7 Problem 27

Find a quadratic formula that produces the maximum number of primes for consecutive values of n.

Solution:

eulerCoefficients n 
  = [((len, a*b), (a, b)) 
      | b <- takeWhile (<n) primes, a <- [-b+1..n-1],
        let len = length $ takeWhile (isPrime . (\x -> x^2 + a*x + b)) [0..],
        if b == 2 then even a else odd a, len > 39]
 
problem_27 = snd . fst . maximum . eulerCoefficients $ 1000

8 Problem 28

What is the sum of both diagonals in a 1001 by 1001 spiral?

Solution:

problem_28 = sum (map (\n -> 4*(n-2)^2+10*(n-1)) [3,5..1001]) + 1

9 Problem 29

How many distinct terms are in the sequence generated by ab for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?

Solution:

import Control.Monad
problem_29 = length . group . sort $ liftM2 (^) [2..100] [2..100]

10 Problem 30

Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.

Solution:

import Data.Array
import Data.Char
 
p = listArray (0,9) $ map (^5) [0..9]
 
upperLimit = 295277
 
candidates = 
    [ n |
    n <- [10..upperLimit],
    (sum $ digits n) `mod` 10 == last(digits n),
    powersum n == n
    ]
    where 
    digits n = map digitToInt $ show n
    powersum n = sum $ map (p!) $ digits n
 
problem_30 = sum candidates