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

== [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¹ + 2² + ... + 1000¹⁰⁰⁰.

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>