Personal tools

Euler problems/41 to 50

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
(rv: vandalism)
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,
+
elem (wordscore a) trilist ]
elem (wordscore a) trilist
+
main = do f <- readFile "words.txt"
]
+
let words = read $"["++f++"]"
main=do
+
print $ problem_42 words
f<-readFile "words.txt"
 
let words=read $"["++f++"]"
 
print $problem_42 words
 
 
</haskell>
 
</haskell>
   
Line 51: 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) $ dropWhile (<mi) $ iterate (+n) n
+
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 57: 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)
(filter (not . doub)
+
. map (addZ 3 . reverse . explode)
$ map (addZ 3 . reverse . explode) $ mults 9 1000 x)
+
$ mults 9 1000 x)
xs
+
xs
 
genSeq ys (x:xs) =
 
genSeq ys (x:xs) =
genSeq (do
+
genSeq (do m <- mults 9 1000 x
m <- mults 9 1000 x
+
let s = addZ 3 . reverse . explode $ m
let s = addZ 3 . reverse . explode $ m
+
y <- filter (sequ s . take 3) $ filter (not . elem (head s)) ys
y <- filter (sequ s . take 3) $ filter (not . elem (head s)) ys
+
return (head s:y))
return (head s:y)
+
xs
) xs
 
 
genSeq ys [] = ys
 
genSeq ys [] = ys
   
Line 78: Line 78:
 
<haskell>
 
<haskell>
 
import Data.Set
 
import Data.Set
problem_44 =
+
problem_44 = head solutions
head solutions
+
where solutions = [a-b | a <- penta,
where
+
b <- takeWhile (<a) penta,
solutions =
+
isPenta (a-b),
[a-b |
+
isPenta (b+a) ]
a <- penta,
 
b <- takeWhile (<a) penta,
 
isPenta (a-b),
 
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 92: Line 92:
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
isPent n =
+
isPent n = (af == 0) && ai `mod` 6 == 5
(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 109: Line 109:
 
<haskell>
 
<haskell>
 
import Data.List
 
import Data.List
isPrime x
+
isPrime x | x==3 = True
|x==3=True
+
| otherwise = millerRabinPrimality x 2
|otherwise=millerRabinPrimality x 2
+
problem_46 = find (\x -> not (isPrime x) && check x) [3,5..]
problem_46 =
+
where
find (\x -> not (isPrime x) && check x) [3,5..]
+
check x = not . any isPrime
where
+
. takeWhile (>0)
check x =
+
. map (\y -> x - 2 * y * y) $ [1..]
not $ any isPrime $takeWhile (>0) $ map (\y -> x - 2 * y * y) [1..]
 
 
</haskell>
 
</haskell>
   
Line 126: 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
+
where factor _ [] = []
factor _ [] = []
 
 
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 148: 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 162: 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
a <- primes4
+
b <- dropWhile (<= a) primes4
b <- dropWhile (<= a) primes4
+
guard (sort $ show a == sort $ show b)
guard ((sort $ show a) == (sort $ show b))
+
let c = 2 * b - a
let c = 2 * b - a
+
guard (c < 10000)
guard (c < 10000)
+
guard (sort $ show a == sort $ show c)
guard ((sort $ show a) == (sort $ show c))
+
guard $ isPrime c
guard $ isPrime c
+
return (a, b, c)
return (a, b, c)
 
 
 
 
primes = 2 : filter (\x -> isPrime x ) [3..]
 
primes = 2 : filter (\x -> isPrime x ) [3..]

Revision as of 20:32, 21 February 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