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

## Problem 41

What is the largest n-digit pandigital prime that exists?

Solution:

```problem_41 = head [p | n <- init (tails "987654321"),
p <- perms n, isPrime (read p)]
where perms [] = [[]]
perms xs = [x:ps | x <- xs, ps <- perms (delete x xs)]
isPrime n = n > 1 && smallestDivisor n == n
smallestDivisor n = findDivisor n (2:[3,5..])
findDivisor n (testDivisor:rest)
| n `mod` testDivisor == 0      = testDivisor
| testDivisor*testDivisor >= n  = n
| otherwise                     = findDivisor n rest
```

## Problem 42

How many triangle words can you make using the list of common English words?

Solution:

```score :: String -> Int
score = sum . map ((subtract 64) . ord . toUpper)

istrig :: Int -> Bool
istrig n = istrig' n trigs

istrig' :: Int -> [Int] -> Bool
istrig' n (t:ts) | n == t    = True
| otherwise = if t < n && head ts > n then False else  istrig' n ts

trigs = map (\n -> n*(n+1) `div` 2) [1..]
--get ws from the Euler site
ws = ["A","ABILITY" ... "YOURSELF","YOUTH"]

problem_42 = length \$ filter id \$ map (istrig . score) ws
```

## Problem 43

Find the sum of all pandigital numbers with an unusual sub-string divisibility property.

Solution:

```import Data.List (inits, tails)

perms :: [a] -> [[a]]
perms [] = [[]]
perms (x:xs) = [ p ++ [x] ++ s | xs' <- perms xs
, (p, s) <- zip (inits xs') (tails xs') ]

check :: String -> Bool
check n = all (\x -> (read \$ fst x) `mod` snd x == 0) \$ zip (map (take 3) \$ tail \$ tails n) [2,3,5,7,11,13,17]

problem_43 :: Integer
problem_43 = foldr (\x y -> read x + y) 0 \$ filter check \$ perms "0123456789"
```

## Problem 44

Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.

Solution:

```problem_44 = undefined
```

## Problem 45

After 40755, what is the next triangle number that is also pentagonal and hexagonal?

Solution:

```problem_45 =  head . dropWhile (<= 40755) \$ match tries (match pents hexes)
where match (x:xs) (y:ys)
| x < y  = match xs (y:ys)
| y < x  = match (x:xs) ys
| otherwise = x : match xs ys
tries = [n*(n+1) `div` 2   | n <- [1..]]
pents = [n*(3*n-1) `div` 2 | n <- [1..]]
hexes = [n*(2*n-1)         | n <- [1..]]
```

## 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.).

```problem_46 = head \$ oddComposites `orderedDiff` gbSums

oddComposites = filter ((>1) . length . primeFactors) [3,5..]

gbSums = map gbWeight \$ weightedPairs gbWeight primes [2*n*n | n <- [1..]]
gbWeight (a,b) = a + b

weightedPairs w (x:xs) (y:ys) =
(x,y) : mergeWeighted w (map ((,)x) ys) (weightedPairs w xs (y:ys))

mergeWeighted w (x:xs)  (y:ys)
| w x <= w y  = x : mergeWeighted w xs (y:ys)
| otherwise   = y : mergeWeighted w (x:xs) ys

x `orderedDiff` [] = x
[] `orderedDiff` y = []
(x:xs) `orderedDiff` (y:ys)
| x < y     = x : xs `orderedDiff` (y:ys)
| x > y     = (x:xs) `orderedDiff` ys
| otherwise = xs `orderedDiff` ys
```

## Problem 47

Find the first four consecutive integers to have four distinct primes factors.

Solution:

```problem_47 = undefined
```

## 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.

```problem_48 = sum [n^n | n <- [1..1000]] `mod` 10^10
```

## Problem 49

Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.

Solution:

I'm new to haskell, improve here :-)

I tidied up your solution a bit, mostly by using and composing library functions where possible...makes it faster on my system. Jim Burton 10:02, 9 July 2007 (UTC)

```import Data.List

isprime :: (Integral a) => a -> Bool
isprime n = isprime2 2
where isprime2 x | x < n     = if n `mod` x == 0 then False else isprime2 (x+1)
| otherwise = True

-- 'each' works like this: each (4,1234) => [1,2,3,4]
each :: (Int, Int) -> [Int]
each = unfoldr (\(o,y) -> let x = 10 ^ (o-1)
(d,m) = y `divMod` x in
if o == 0 then Nothing else Just (d,(o-1,m)))

ispermut :: Int -> Int -> Bool
ispermut = let f = (sort . each . (,) 4) in (. f) . (==) . f

isin :: (Eq a) => a -> [[a]] -> Bool
isin = any . elem

problem_49_1 :: [Int] -> [[Int]] -> [[Int]]
problem_49_1 [] res = res
problem_49_1 (pr:prims) res = problem_49_1 prims res'
where res' = if pr `isin` res then res else res ++ [pr:(filter (ispermut pr) (pr:prims))]

problem_49 :: [[Int]]
problem_49 = problem_49_1 [n | n <- [1000..9999], isprime n] []
```

## Problem 50

Which prime, below one-million, can be written as the sum of the most consecutive primes?

Solution: (prime and isPrime not included)

```findPrimeSum ps | isPrime sumps = Just sumps
| otherwise     = findPrimeSum (tail ps) `mplus` findPrimeSum (init ps)
where sumps = sum ps

problem_50 = findPrimeSum \$ take 546 primes
```