# Euler problems/41 to 50

### From HaskellWiki

## 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 1^{1} + 2^{2} + ... + 1000^{1000}.

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