Personal tools

Euler problems/41 to 50

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
(rv: vandalism)
Line 1: Line 1:
Do them on your own!
+
== [http://projecteuler.net/index.php?section=problems&id=41 Problem 41] ==
  +
What is the largest n-digit pandigital prime that exists?
  +
  +
Solution:
  +
<haskell>
  +
import Data.List
  +
isprime a = isprimehelper a primes
  +
isprimehelper a (p:ps)
  +
| a == 1 = False
  +
| p*p > a = True
  +
| a `mod` p == 0 = False
  +
| otherwise = isprimehelper a ps
  +
primes = 2 : filter isprime [3,5..]
  +
problem_41 =
  +
head.filter isprime.filter fun $ [7654321,7654320..]
  +
where
  +
fun =(=="1234567").sort.show
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=42 Problem 42] ==
  +
How many triangle words can you make using the list of common English words?
  +
  +
Solution:
  +
<haskell>
  +
import Data.Char
  +
trilist = takeWhile (<300) (scanl1 (+) [1..])
  +
wordscore xs = sum $ map (subtract 64 . ord) xs
  +
problem_42 megalist=
  +
length [ wordscore a |
  +
a <- megalist,
  +
elem (wordscore a) trilist
  +
]
  +
main=do
  +
f<-readFile "words.txt"
  +
let words=read $"["++f++"]"
  +
print $problem_42 words
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=43 Problem 43] ==
  +
Find the sum of all pandigital numbers with an unusual sub-string divisibility property.
  +
  +
Solution:
  +
<haskell>
  +
import Data.List
  +
l2n :: (Integral a) => [a] -> a
  +
l2n = foldl' (\a b -> 10*a+b) 0
  +
  +
swap (a,b) = (b,a)
  +
  +
explode :: (Integral a) => a -> [a]
  +
explode =
  +
unfoldr (\a -> if a==0 then Nothing else Just $ swap $ quotRem a 10)
  +
problem_43 = sum . map l2n . map (\s -> head ([0..9] \\ s):s)
  +
. filter (elem 0) . genSeq [] $ [17,13,11,7,5,3,2]
  +
  +
mults mi ma n = takeWhile (< ma) $ dropWhile (<mi) $ iterate (+n) n
  +
  +
sequ xs ys = tail xs == init ys
  +
  +
addZ n xs = replicate (n - length xs) 0 ++ xs
  +
  +
genSeq [] (x:xs) = genSeq
  +
(filter (not . doub)
  +
$ map (addZ 3 . reverse . explode) $ mults 9 1000 x)
  +
xs
  +
genSeq ys (x:xs) =
  +
genSeq (do
  +
m <- mults 9 1000 x
  +
let s = addZ 3 . reverse . explode $ m
  +
y <- filter (sequ s . take 3) $ filter (not . elem (head s)) ys
  +
return (head s:y)
  +
) xs
  +
genSeq ys [] = ys
  +
  +
doub xs = nub xs /= xs
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=44 Problem 44] ==
  +
Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.
  +
  +
Solution:
  +
<haskell>
  +
import Data.Set
  +
problem_44 =
  +
head solutions
  +
where
  +
solutions =
  +
[a-b |
  +
a <- penta,
  +
b <- takeWhile (<a) penta,
  +
isPenta (a-b),
  +
isPenta (b+a)
  +
]
  +
isPenta = (`member` fromList penta)
  +
penta = [(n * (3*n-1)) `div` 2 | n <- [1..5000]]
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=45 Problem 45] ==
  +
After 40755, what is the next triangle number that is also pentagonal and hexagonal?
  +
  +
Solution:
  +
<haskell>
  +
isPent n =
  +
(af == 0) && ai `mod` 6 == 5
  +
where
  +
(ai, af) = properFraction $ sqrt $ 1 + 24 * (fromInteger n)
  +
  +
problem_45 = head [x | x <- scanl (+) 1 [5,9..], x > 40755, isPent x]
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=46 Problem 46] ==
  +
What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?
  +
  +
Solution:
  +
  +
This solution is inspired by exercise 3.70 in ''Structure and Interpretation of Computer Programs'', (2nd ed.).
  +
  +
millerRabinPrimality on the [[Prime_numbers]] page
  +
  +
<haskell>
  +
import Data.List
  +
isPrime x
  +
|x==3=True
  +
|otherwise=millerRabinPrimality x 2
  +
problem_46 =
  +
find (\x -> not (isPrime x) && check x) [3,5..]
  +
where
  +
check x =
  +
not $ any isPrime $takeWhile (>0) $ map (\y -> x - 2 * y * y) [1..]
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=47 Problem 47] ==
  +
Find the first four consecutive integers to have four distinct primes factors.
  +
  +
Solution:
  +
<haskell>
  +
import Data.List
  +
problem_47 = find (all ((==4).snd)) . map (take 4) . tails
  +
. zip [1..] . map (length . factors) $ [1..]
  +
fstfac x = [(head a ,length a)|a<-group$primeFactors x]
  +
fac [(x,y)]=[x^a|a<-[0..y]]
  +
fac (x:xs)=[a*b|a<-fac [x],b<-fac xs]
  +
factors x=fac$fstfac x
  +
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]
  +
  +
primeFactors n = factor n primes
  +
where
  +
factor _ [] = []
  +
factor m (p:ps) | p*p > m = [m]
  +
| m `mod` p == 0 = p : [m `div` p]
  +
| otherwise = factor m ps
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=48 Problem 48] ==
  +
Find the last ten digits of 1<sup>1</sup> + 2<sup>2</sup> + ... + 1000<sup>1000</sup>.
  +
  +
Solution:
  +
If the problem were more computationally intensive, [http://en.wikipedia.org/wiki/Modular_exponentiation modular exponentiation] might be appropriate. With this problem size the naive approach is sufficient.
  +
  +
powMod on the [[Prime_numbers]] page
  +
  +
<haskell>
  +
problem_48 = flip mod limit$sum [powMod limit n n | n <- [1..1000]]
  +
where
  +
limit=10^10
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=49 Problem 49] ==
  +
Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.
  +
  +
Solution:
  +
millerRabinPrimality on the [[Prime_numbers]] page
  +
  +
<haskell>
  +
import Control.Monad
  +
import Data.List
  +
isPrime x
  +
|x==3=True
  +
|otherwise=millerRabinPrimality x 2
  +
  +
primes4 = takeWhile (<10000) $ dropWhile (<1000) primes
  +
  +
problem_49 = do
  +
a <- primes4
  +
b <- dropWhile (<= a) primes4
  +
guard ((sort $ show a) == (sort $ show b))
  +
let c = 2 * b - a
  +
guard (c < 10000)
  +
guard ((sort $ show a) == (sort $ show c))
  +
guard $ isPrime c
  +
return (a, b, c)
  +
  +
primes = 2 : filter (\x -> isPrime x ) [3..]
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=50 Problem 50] ==
  +
Which prime, below one-million, can be written as the sum of the most consecutive primes?
  +
  +
Solution:
  +
(prime and isPrime not included)
  +
  +
<haskell>
  +
import Control.Monad
  +
findPrimeSum ps
  +
| isPrime sumps = Just sumps
  +
| otherwise = findPrimeSum (tail ps) `mplus` findPrimeSum (init ps)
  +
where
  +
sumps = sum ps
  +
  +
problem_50 = findPrimeSum $ take 546 primes
  +
</haskell>

Revision as of 04:57, 30 January 2008

Contents

1 Problem 41

What is the largest n-digit pandigital prime that exists?

Solution:

import Data.List
isprime a = isprimehelper a primes
isprimehelper a (p:ps)
    | a == 1 = False
    | p*p > a = True
    | a `mod` p == 0 = False
    | otherwise = isprimehelper a ps
primes = 2 : filter isprime [3,5..]
problem_41 = 
    head.filter isprime.filter fun $ [7654321,7654320..]
    where
    fun =(=="1234567").sort.show

2 Problem 42

How many triangle words can you make using the list of common English words?

Solution:

import Data.Char
trilist = takeWhile (<300) (scanl1 (+) [1..])
wordscore xs = sum $ map (subtract 64 . ord) xs
problem_42 megalist= 
    length [ wordscore a |
    a <- megalist,
    elem (wordscore a) trilist
    ]
main=do
    f<-readFile "words.txt"
    let words=read $"["++f++"]"
    print $problem_42 words

3 Problem 43

Find the sum of all pandigital numbers with an unusual sub-string divisibility property.

Solution:

import Data.List
l2n :: (Integral a) => [a] -> a
l2n = foldl' (\a b -> 10*a+b) 0
 
swap (a,b) = (b,a)
 
explode :: (Integral a) => a -> [a]
explode = 
    unfoldr (\a -> if a==0 then Nothing else Just $ swap $ quotRem a 10)
problem_43 = sum . map l2n . map (\s -> head ([0..9] \\ s):s) 
                 . filter (elem 0) . genSeq [] $ [17,13,11,7,5,3,2]
 
mults mi ma n = takeWhile (< ma) $ dropWhile (<mi) $ iterate (+n) n
 
sequ xs ys = tail xs == init ys
 
addZ n xs = replicate (n - length xs) 0 ++ xs
 
genSeq [] (x:xs) = genSeq 
                   (filter (not . doub) 
                   $ map (addZ 3 . reverse . explode) $ mults 9 1000 x)
                   xs
genSeq ys (x:xs) = 
    genSeq (do
             m <- mults 9 1000 x
             let s = addZ 3 . reverse . explode $ m
             y <- filter (sequ s . take 3) $ filter (not . elem (head s)) ys
             return (head s:y)
           ) xs
genSeq ys [] = ys
 
doub xs = nub xs /= xs

4 Problem 44

Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.

Solution:

import Data.Set
problem_44 = 
    head solutions
    where 
    solutions = 
        [a-b |
        a <- penta,
        b <- takeWhile (<a) penta,
        isPenta (a-b),
        isPenta (b+a)
        ]
    isPenta = (`member` fromList  penta)
    penta = [(n * (3*n-1)) `div` 2 | n <- [1..5000]]

5 Problem 45

After 40755, what is the next triangle number that is also pentagonal and hexagonal?

Solution:

isPent n = 
    (af == 0) && ai `mod` 6 == 5
    where
    (ai, af) = properFraction $ sqrt $ 1 + 24 * (fromInteger n)
 
problem_45 = head [x | x <- scanl (+) 1 [5,9..], x > 40755, isPent x]

6 Problem 46

What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?

Solution:

This solution is inspired by exercise 3.70 in Structure and Interpretation of Computer Programs, (2nd ed.).

millerRabinPrimality on the Prime_numbers page

import Data.List
isPrime x
    |x==3=True
    |otherwise=millerRabinPrimality x 2
problem_46 = 
    find (\x -> not (isPrime x) && check x) [3,5..]
    where
    check x = 
        not $ any isPrime $takeWhile (>0) $ map (\y -> x - 2 * y * y) [1..]

7 Problem 47

Find the first four consecutive integers to have four distinct primes factors.

Solution:

import Data.List
problem_47 = find (all ((==4).snd)) . map (take 4) . tails 
                 . zip [1..] . map (length . factors) $ [1..]
fstfac x = [(head a ,length a)|a<-group$primeFactors x]
fac [(x,y)]=[x^a|a<-[0..y]]
fac (x:xs)=[a*b|a<-fac [x],b<-fac xs]
factors x=fac$fstfac x
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]
 
primeFactors n = factor n primes
    where
        factor _ [] = []
        factor m (p:ps) | p*p > m        = [m]
                        | m `mod` p == 0 = p : [m `div` p]
                        | otherwise      = factor m ps

8 Problem 48

Find the last ten digits of 11 + 22 + ... + 10001000.

Solution: If the problem were more computationally intensive, modular exponentiation might be appropriate. With this problem size the naive approach is sufficient.

powMod on the Prime_numbers page

problem_48 = flip mod limit$sum [powMod limit n n | n <- [1..1000]]
    where
    limit=10^10

9 Problem 49

Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.

Solution: millerRabinPrimality on the Prime_numbers page

import Control.Monad
import Data.List
isPrime x
    |x==3=True
    |otherwise=millerRabinPrimality x 2
 
primes4 = takeWhile (<10000) $ dropWhile (<1000) primes
 
problem_49 = do 
    a <- primes4
    b <- dropWhile (<= a) primes4
    guard ((sort $ show a) == (sort $ show b))
    let c = 2 * b - a
    guard (c < 10000)
    guard ((sort $ show a) == (sort $ show c))
    guard $ isPrime c 
    return (a, b, c)
 
primes = 2 : filter (\x -> isPrime x ) [3..]

10 Problem 50

Which prime, below one-million, can be written as the sum of the most consecutive primes?

Solution: (prime and isPrime not included)

import Control.Monad
findPrimeSum ps 
    | isPrime sumps = Just sumps
    | otherwise     = findPrimeSum (tail ps) `mplus` findPrimeSum (init ps)
    where
    sumps = sum ps
 
problem_50 = findPrimeSum $ take 546 primes