# Difference between revisions of "Euler problems/41 to 50"

Marypoppins (talk | contribs) |
CaleGibbard (talk | contribs) (rv: vandalism) |
||

Line 1: | Line 1: | ||

− | + | == [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

## 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
```

## 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
```

## 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
```

## 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]]
```

## 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]
```

## 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..]
```

## 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
```

## Problem 48

Find the last ten digits of 1^{1} + 2^{2} + ... + 1000^{1000}.

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
```

## 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..]
```

## 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
```