Difference between revisions of "Euler problems/41 to 50"
CaleGibbard (talk | contribs) (rv: vandalism) |
CaleGibbard (talk | contribs) |
||
Line 7: | Line 7: | ||
isprime a = isprimehelper a primes |
isprime a = isprimehelper a primes |
||
isprimehelper a (p:ps) |
isprimehelper a (p:ps) |
||
− | | a == 1 = False |
+ | | a == 1 = False |
− | | p*p > a = True |
+ | | p*p > a = True |
| a `mod` p == 0 = False |
| a `mod` p == 0 = False |
||
− | | otherwise = isprimehelper a ps |
+ | | otherwise = isprimehelper a ps |
primes = 2 : filter isprime [3,5..] |
primes = 2 : filter isprime [3,5..] |
||
problem_41 = |
problem_41 = |
||
− | head.filter isprime.filter fun $ [7654321,7654320..] |
+ | head . filter isprime . filter fun $ [7654321,7654320..] |
where |
where |
||
− | fun =(=="1234567").sort.show |
+ | fun = (=="1234567") . sort . show |
</haskell> |
</haskell> |
||
Line 26: | Line 26: | ||
trilist = takeWhile (<300) (scanl1 (+) [1..]) |
trilist = takeWhile (<300) (scanl1 (+) [1..]) |
||
wordscore xs = sum $ map (subtract 64 . ord) xs |
wordscore xs = sum $ map (subtract 64 . ord) xs |
||
− | problem_42 megalist= |
+ | problem_42 megalist = |
− | length [ wordscore a | |
+ | length [ wordscore a | a <- megalist, |
⚫ | |||
− | a <- megalist, |
||
⚫ | |||
⚫ | |||
⚫ | |||
− | ] |
||
⚫ | |||
− | main=do |
||
⚫ | |||
⚫ | |||
⚫ | |||
</haskell> |
</haskell> |
||
Line 54: | Line 51: | ||
. filter (elem 0) . genSeq [] $ [17,13,11,7,5,3,2] |
. filter (elem 0) . genSeq [] $ [17,13,11,7,5,3,2] |
||
− | mults mi ma n = takeWhile (< ma) |
+ | mults mi ma n = takeWhile (< ma) . dropWhile (<mi) . iterate (+n) $ n |
sequ xs ys = tail xs == init ys |
sequ xs ys = tail xs == init ys |
||
Line 60: | Line 57: | ||
addZ n xs = replicate (n - length xs) 0 ++ xs |
addZ n xs = replicate (n - length xs) 0 ++ xs |
||
− | genSeq [] (x:xs) = genSeq |
+ | genSeq [] (x:xs) = genSeq (filter (not . doub) |
− | + | . map (addZ 3 . reverse . explode) |
|
− | + | $ mults 9 1000 x) |
|
− | xs |
+ | xs |
genSeq ys (x:xs) = |
genSeq ys (x:xs) = |
||
− | genSeq (do |
+ | 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 |
|
− | ) xs |
||
genSeq ys [] = ys |
genSeq ys [] = ys |
||
Line 82: | Line 78: | ||
<haskell> |
<haskell> |
||
import Data.Set |
import Data.Set |
||
− | problem_44 = |
+ | problem_44 = head solutions |
⚫ | |||
− | head solutions |
||
⚫ | |||
⚫ | |||
⚫ | |||
− | solutions = |
||
− | + | isPenta (b+a) ] |
|
⚫ | |||
⚫ | |||
⚫ | |||
− | isPenta (b+a) |
||
− | ] |
||
isPenta = (`member` fromList penta) |
isPenta = (`member` fromList penta) |
||
penta = [(n * (3*n-1)) `div` 2 | n <- [1..5000]] |
penta = [(n * (3*n-1)) `div` 2 | n <- [1..5000]] |
||
Line 101: | Line 92: | ||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
− | isPent n = |
+ | isPent n = (af == 0) && ai `mod` 6 == 5 |
− | + | where (ai, af) = properFraction . sqrt $ 1 + 24 * (fromInteger n) |
|
− | where |
||
− | (ai, af) = properFraction $ sqrt $ 1 + 24 * (fromInteger n) |
||
problem_45 = head [x | x <- scanl (+) 1 [5,9..], x > 40755, isPent x] |
problem_45 = head [x | x <- scanl (+) 1 [5,9..], x > 40755, isPent x] |
||
Line 120: | Line 109: | ||
<haskell> |
<haskell> |
||
import Data.List |
import Data.List |
||
− | isPrime x |
+ | isPrime x | x==3 = True |
⚫ | |||
− | |x==3=True |
||
+ | problem_46 = find (\x -> not (isPrime x) && check x) [3,5..] |
||
⚫ | |||
⚫ | |||
− | problem_46 = |
||
− | + | check x = not . any isPrime |
|
+ | . takeWhile (>0) |
||
− | where |
||
⚫ | |||
− | check x = |
||
⚫ | |||
</haskell> |
</haskell> |
||
Line 138: | Line 126: | ||
problem_47 = find (all ((==4).snd)) . map (take 4) . tails |
problem_47 = find (all ((==4).snd)) . map (take 4) . tails |
||
. zip [1..] . map (length . factors) $ [1..] |
. zip [1..] . map (length . factors) $ [1..] |
||
− | fstfac x = [(head a ,length a)|a<-group$primeFactors x] |
+ | fstfac x = [(head a ,length a) | a <- group $ primeFactors x] |
− | fac [(x,y)]=[x^a|a<-[0..y]] |
+ | fac [(x,y)] = [x^a | a <- [0..y]] |
− | fac (x:xs)=[a*b|a<-fac [x],b<-fac xs] |
+ | fac (x:xs) = [a*b | a <- fac [x], b <- fac xs] |
− | factors x=fac$fstfac x |
+ | factors x = fac $ fstfac x |
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 m (p:ps) | p*p > m = [m] |
factor m (p:ps) | p*p > m = [m] |
||
| m `mod` p == 0 = p : [m `div` p] |
| m `mod` p == 0 = p : [m `div` p] |
||
Line 161: | Line 148: | ||
<haskell> |
<haskell> |
||
− | problem_48 = flip mod limit$sum [powMod limit n n | n <- [1..1000]] |
+ | problem_48 = flip mod limit $ sum [powMod limit n n | n <- [1..1000]] |
− | where |
+ | where limit=10^10 |
− | limit=10^10 |
||
</haskell> |
</haskell> |
||
Line 176: | Line 162: | ||
import Data.List |
import Data.List |
||
isPrime x |
isPrime x |
||
− | |x==3=True |
+ | | x==3 = True |
− | |otherwise=millerRabinPrimality x 2 |
+ | | otherwise = millerRabinPrimality x 2 |
primes4 = takeWhile (<10000) $ dropWhile (<1000) primes |
primes4 = takeWhile (<10000) $ dropWhile (<1000) primes |
||
− | problem_49 = do |
+ | problem_49 = do a <- primes4 |
− | + | b <- dropWhile (<= a) primes4 |
|
+ | guard (sort $ show a == sort $ show b) |
||
− | b <- dropWhile (<= a) primes4 |
||
− | + | let c = 2 * b - a |
|
− | + | guard (c < 10000) |
|
− | guard ( |
+ | guard (sort $ show a == sort $ show c) |
− | + | guard $ isPrime c |
|
⚫ | |||
− | guard $ isPrime c |
||
⚫ | |||
primes = 2 : filter (\x -> isPrime x ) [3..] |
primes = 2 : filter (\x -> isPrime x ) [3..] |
Revision as of 20:32, 21 February 2008
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 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
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