Difference between revisions of "Euler problems/31 to 40"

Problem 31

Investigating combinations of English currency denominations.

Solution:

This is the naive doubly recursive solution. Speed would be greatly improved by use of memoization, dynamic programming, or the closed form.

```problem_31 =
pence 200 [1,2,5,10,20,50,100,200]
where
pence 0 _  = 1
pence n [] = 0
pence n denominations@(d:ds)
| n < d     = 0
| otherwise = pence (n - d) denominations + pence n ds
```

A beautiful solution, making usage of laziness and recursion to implement a dynamic programming scheme, blazingly fast despite actually generating the combinations and not only counting them :

```coins = [1,2,5,10,20,50,100,200]

combinations = foldl (\without p ->
let (poor,rich) = splitAt p without
with = poor ++
zipWith (++) (map (map (p:)) with)
rich
in with
) ([[]] : repeat [])

problem_31 =
length \$ combinations coins !! 200
```

Problem 32

Find the sum of all numbers that can be written as pandigital products.

Solution:

```problem_32 =
sum \$ nub \$  map (\(a, b) -> a * b) multiplicands
where
multiplicands =
[(a,b)| a <- [2..5000], b <- [a..(9999 `div` a)], check a b]
check a b =
no_zero s
&& (length ss) == 9
&& foldr (\x y -> length x == 1 && y) True ss
where
s = show a ++ show b ++ show (a*b)
ss = group \$ sort s
no_zero (x:xs)
| x == '0'  = False
| null xs   = True
| otherwise = no_zero xs
```

Problem 33

Discover all the fractions with an unorthodox cancelling method.

Solution:

```import Ratio

problem_33 = denominator (product \$ rs ++ rs')

rs = [(x%y) |
a <- [0..9],
b <- [1..9],
c <- [1..9],
let x = 10*a + c,
let y = 10*c + b,
x /= y,
x%y < 1,
x%y == a%b
]

rs' =
filter (<1) \$ map (\x -> denominator x % numerator x) rs
```

Problem 34

Find the sum of all numbers which are equal to the sum of the factorial of their digits.

Solution:

```import Data.Char
problem_34 =
sum [ x | x <- [3..100000], x == facsum x ]
where
facsum = sum . map (product . enumFromTo 1 . digitToInt) . show
```

Problem 35

How many circular primes are there below one million?

Solution:

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

primes =
2 : filter ((==1) . length . primeFactors) [3,5..]
primeFactors n =
factor n primes
where
factor n (p:ps)
| p*p > n        = [n]
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)
| otherwise      = factor n ps
isPrime
|1 = False
|otherwise=
case (primeFactors n) of
(_:_:_)   -> False
_         -> True
permutations n =
take l \$ map (read . take l) \$
tails \$ take (2*l -1) \$ cycle s
where
s = show n
l = length s
circular_primes []     = []
circular_primes (x:xs)
| all isPrime p = x :  circular_primes xs
| otherwise     = circular_primes xs
where
p = permutations x

problem_35 =
length \$ circular_primes \$ takeWhile (<1000000) primes
```

Problem 36

Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.

Solution:

```import Numeric
import Data.Char

showBin =
flip (showIntAtBase 2 intToDigit) ""

isPalindrome x =
x == reverse x

problem_36 =
sum [x |
x <- [1,3..1000000],
isPalindrome (show x),
isPalindrome (showBin x)
]
```

Problem 37

Find the sum of all eleven primes that are both truncatable from left to right and right to left.

Solution:

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

truncs n =
(take l . tail . tails) s ++ (take l . tail . inits) s
where
l = length s - 1
s = show n

problem_37 =
sum \$ take 11 [x |
x <- dropWhile (<=9) primes,
all isPrime (truncs x)
]
```

Problem 38

What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?

Solution:

```problem_38 =
maximum \$ catMaybes [result | j <- [1..9999],
let p2 = show j ++ show (2*j),
let p3 = p2 ++ show (3*j),
let p4 = p3 ++ show (4*j),
let p5 = p4 ++ show (5*j),
let result
| isPan p2 = Just p2
| isPan p3 = Just p3
| isPan p4 = Just p4
| isPan p5 = Just p5
| otherwise = Nothing
]
where
isPan s = sort s == "123456789"
```

Other solution:

```import Data.List

mult n i vs
| length (concat vs) >= 9 = concat vs
| otherwise               = mult n (i+1) (vs ++ [show (n * i)])

problem_38 =
maximum \$ map read \$ filter
((['1'..'9'] ==) .sort) \$
[ mult n 1 [] | n <- [2..9999] ]
```

Problem 39

If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?

Solution: We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.

```problem_39 =
where
perims = group \$ sort [n*p | p <- pTriples, n <- [1..1000 `div` p]]
counts = map length perims
Just indexMax = findIndex (== (maximum counts)) \$ counts
pTriples =
[p |
n <- [1..floor (sqrt 1000)],
m <- [n+1..floor (sqrt 1000)],
even n || even m,
gcd n m == 1,
let a = m^2 - n^2,
let b = 2*m*n,
let c = m^2 + n^2,
let p = a + b + c,
p < 1000
]
```

Problem 40

Finding the nth digit of the fractional part of the irrational number.

Solution:

```problem_40 =
(d 1)*(d 10)*(d 100)*(d 1000)*(d 10000)*(d 100000)*(d 1000000)
where
n = concat [show n | n <- [1..]]
d j = Data.Char.digitToInt (n !! (j-1))
```