Difference between revisions of "Euler problems/41 to 50"
Jump to navigation
Jump to search
Marypoppins (talk | contribs) |
|||
| 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 21:46, 29 January 2008
Do them on your own!