Personal tools

Euler problems/41 to 50

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=problems&id=41 Problem 41] ==
+
Do them on your own!
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!