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

Marypoppins (talk | contribs) |
CaleGibbard (talk | contribs) (rv: vandalism) |
||

Line 1: | Line 1: | ||

− | + | == [http://projecteuler.net/index.php?section=problems&id=31 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. | ||

+ | <haskell> | ||

+ | problem_31 = | ||

+ | ways [1,2,5,10,20,50,100,200] !!200 | ||

+ | where | ||

+ | ways [] = 1 : repeat 0 | ||

+ | ways (coin:coins) =n | ||

+ | where | ||

+ | n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n) | ||

+ | </haskell> | ||

+ | |||

+ | 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 : | ||

+ | <haskell> | ||

+ | 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 | ||

+ | </haskell> | ||

+ | |||

+ | == [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] == | ||

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

+ | |||

+ | Solution: | ||

+ | <haskell> | ||

+ | import Control.Monad | ||

+ | combs 0 xs = [([],xs)] | ||

+ | combs n xs = [(y:ys,rest)|y<-xs, (ys,rest)<-combs (n-1) (delete y xs)] | ||

+ | |||

+ | 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) | ||

+ | |||

+ | pandigiticals = nub $ do | ||

+ | (beg,end) <- combs 5 [1..9] | ||

+ | n <- [1,2] | ||

+ | let (a,b) = splitAt n beg | ||

+ | res = l2n a * l2n b | ||

+ | guard $ sort (explode res) == end | ||

+ | return res | ||

+ | problem_32 = sum pandigiticals | ||

+ | </haskell> | ||

+ | |||

+ | == [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] == | ||

+ | Discover all the fractions with an unorthodox cancelling method. | ||

+ | |||

+ | Solution: | ||

+ | <haskell> | ||

+ | import Data.Ratio | ||

+ | problem_33 = denominator $product $ rs | ||

+ | {- | ||

+ | xy/yz = x/z | ||

+ | (10x + y)/(10y+z) = x/z | ||

+ | 9xz + yz = 10xy | ||

+ | -} | ||

+ | rs=[(10*x+y)%(10*y+z) | | ||

+ | x <- t, | ||

+ | y <- t, | ||

+ | z <- t, | ||

+ | x /= y , | ||

+ | (9*x*z) + (y*z) == (10*x*y) | ||

+ | ] | ||

+ | where | ||

+ | t=[1..9] | ||

+ | </haskell> | ||

+ | |||

+ | == [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] == | ||

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

+ | |||

+ | Solution: | ||

+ | <haskell> | ||

+ | import Data.Map (fromList ,(!)) | ||

+ | digits n | ||

+ | {- 123->[3,2,1] | ||

+ | -} | ||

+ | |n<10=[n] | ||

+ | |otherwise= y:digits x | ||

+ | where | ||

+ | (x,y)=divMod n 10 | ||

+ | -- 123 ->321 | ||

+ | problem_34 = | ||

+ | sum[ x | x <- [3..100000], x == facsum x ] | ||

+ | where | ||

+ | fact n = product [1..n] | ||

+ | fac=fromList [(a,fact a)|a<-[0..9]] | ||

+ | facsum x= sum [fac!a|a<-digits x] | ||

+ | </haskell> | ||

+ | |||

+ | Here's another (slighly simpler) way: | ||

+ | <haskell> | ||

+ | import Data.Char | ||

+ | |||

+ | fac n = product [1..n] | ||

+ | |||

+ | digits n = map digitToInt $ show n | ||

+ | |||

+ | sum_fac n = sum $ map fac $ digits n | ||

+ | |||

+ | problem_34_v2 = sum [ x | x <- [3..10^5], x == sum_fac x ] | ||

+ | </haskell> | ||

+ | |||

+ | == [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] == | ||

+ | How many circular primes are there below one million? | ||

+ | |||

+ | Solution: | ||

+ | millerRabinPrimality on the [[Prime_numbers]] page | ||

+ | <haskell> | ||

+ | isPrime x | ||

+ | |x==1=False | ||

+ | |x==2=True | ||

+ | |x==3=True | ||

+ | |otherwise=millerRabinPrimality x 2 | ||

+ | 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 | ||

+ | x=[1,3,7,9] | ||

+ | dmm=(\x y->x*10+y) | ||

+ | x3=[foldl dmm 0 [a,b,c]|a<-x,b<-x,c<-x] | ||

+ | x4=[foldl dmm 0 [a,b,c,d]|a<-x,b<-x,c<-x,d<-x] | ||

+ | x5=[foldl dmm 0 [a,b,c,d,e]|a<-x,b<-x,c<-x,d<-x,e<-x] | ||

+ | x6=[foldl dmm 0 [a,b,c,d,e,f]|a<-x,b<-x,c<-x,d<-x,e<-x,f<-x] | ||

+ | problem_35 = | ||

+ | (+13)$length $ circular_primes $ [a|a<-foldl (++) [] [x3,x4,x5,x6],isPrime a] | ||

+ | </haskell> | ||

+ | |||

+ | == [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] == | ||

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

+ | |||

+ | Solution: | ||

+ | <haskell> | ||

+ | isPalin [] = True | ||

+ | isPalin [a] = True | ||

+ | isPalin (x:xs) = | ||

+ | if x == last xs then isPalin $ sansLast xs else False | ||

+ | where | ||

+ | sansLast xs = reverse $ tail $ reverse xs | ||

+ | toBase2 0 = [] | ||

+ | toBase2 x = (show $ mod x 2) : toBase2 (div x 2) | ||

+ | isbothPalin x = | ||

+ | isPalin (show x) && isPalin (toBase2 x) | ||

+ | problem_36= | ||

+ | sum $ filter isbothPalin $ filter (not.even) [1..1000000] | ||

+ | </haskell> | ||

+ | |||

+ | Alternate Solution: | ||

+ | <haskell> | ||

+ | import Numeric | ||

+ | import Data.Char | ||

+ | |||

+ | isPalindrome x = x == reverse x | ||

+ | |||

+ | showBin n = showIntAtBase 2 intToDigit n "" | ||

+ | |||

+ | problem_36_v2 = sum [ n | n <- [1,3..10^6-1], | ||

+ | isPalindrome (show n) && | ||

+ | isPalindrome (showBin n)] | ||

+ | </haskell> | ||

+ | |||

+ | == [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] == | ||

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

+ | |||

+ | Solution: | ||

+ | <haskell> | ||

+ | -- isPrime in p35 | ||

+ | clist n = | ||

+ | filter isLeftTruncatable $ if isPrime n then n:ns else [] | ||

+ | where | ||

+ | ns = concatMap (clist . ((10*n) +)) [1,3,7,9] | ||

+ | |||

+ | isLeftTruncatable = | ||

+ | all isPrime . map read . init . tail . tails . show | ||

+ | problem_37 = | ||

+ | sum $ filter (>=10) $ concatMap clist [2,3,5,7] | ||

+ | </haskell> | ||

+ | |||

+ | == [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] == | ||

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

+ | |||

+ | Solution: | ||

+ | <haskell> | ||

+ | 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] ] | ||

+ | </haskell> | ||

+ | |||

+ | == [http://projecteuler.net/index.php?section=problems&id=39 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. | ||

+ | <haskell> | ||

+ | problem_39 = | ||

+ | head $ perims !! indexMax | ||

+ | 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 | ||

+ | ] | ||

+ | </haskell> | ||

+ | |||

+ | == [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] == | ||

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

+ | |||

+ | Solution: | ||

+ | <haskell> | ||

+ | takeLots :: [Int] -> [a] -> [a] | ||

+ | takeLots = | ||

+ | t 1 | ||

+ | where | ||

+ | t i [] _ = [] | ||

+ | t i jj@(j:js) (x:xs) | ||

+ | | i == j = x : t (i+1) js xs | ||

+ | | otherwise = t (i+1) jj xs | ||

+ | |||

+ | digitos :: [Int] | ||

+ | digitos = | ||

+ | d [1] | ||

+ | where | ||

+ | d k = reverse k ++ d (mais k) | ||

+ | mais (9:is) = 0 : mais is | ||

+ | mais (i:is) = (i+1) : is | ||

+ | mais [] = [1] | ||

+ | |||

+ | problem_40 = | ||

+ | product $ takeLots [10^n | n <- [0..6]] digitos | ||

+ | </haskell> | ||

+ | |||

+ | Here's how I did it, I think this is much easier to read: | ||

+ | |||

+ | <haskell> | ||

+ | num = concatMap show [1..] | ||

+ | |||

+ | problem_40_v2 = product $ map (\x -> digitToInt (num !! (10^x-1))) [0..6] | ||

+ | </haskell> |

## Revision as of 04:56, 30 January 2008

## Contents

## 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 =
ways [1,2,5,10,20,50,100,200] !!200
where
ways [] = 1 : repeat 0
ways (coin:coins) =n
where
n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)
```

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:

```
import Control.Monad
combs 0 xs = [([],xs)]
combs n xs = [(y:ys,rest)|y<-xs, (ys,rest)<-combs (n-1) (delete y xs)]
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)
pandigiticals = nub $ do
(beg,end) <- combs 5 [1..9]
n <- [1,2]
let (a,b) = splitAt n beg
res = l2n a * l2n b
guard $ sort (explode res) == end
return res
problem_32 = sum pandigiticals
```

## Problem 33

Discover all the fractions with an unorthodox cancelling method.

Solution:

```
import Data.Ratio
problem_33 = denominator $product $ rs
{-
xy/yz = x/z
(10x + y)/(10y+z) = x/z
9xz + yz = 10xy
-}
rs=[(10*x+y)%(10*y+z) |
x <- t,
y <- t,
z <- t,
x /= y ,
(9*x*z) + (y*z) == (10*x*y)
]
where
t=[1..9]
```

## Problem 34

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

Solution:

```
import Data.Map (fromList ,(!))
digits n
{- 123->[3,2,1]
-}
|n<10=[n]
|otherwise= y:digits x
where
(x,y)=divMod n 10
-- 123 ->321
problem_34 =
sum[ x | x <- [3..100000], x == facsum x ]
where
fact n = product [1..n]
fac=fromList [(a,fact a)|a<-[0..9]]
facsum x= sum [fac!a|a<-digits x]
```

Here's another (slighly simpler) way:

```
import Data.Char
fac n = product [1..n]
digits n = map digitToInt $ show n
sum_fac n = sum $ map fac $ digits n
problem_34_v2 = sum [ x | x <- [3..10^5], x == sum_fac x ]
```

## Problem 35

How many circular primes are there below one million?

Solution: millerRabinPrimality on the Prime_numbers page

```
isPrime x
|x==1=False
|x==2=True
|x==3=True
|otherwise=millerRabinPrimality x 2
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
x=[1,3,7,9]
dmm=(\x y->x*10+y)
x3=[foldl dmm 0 [a,b,c]|a<-x,b<-x,c<-x]
x4=[foldl dmm 0 [a,b,c,d]|a<-x,b<-x,c<-x,d<-x]
x5=[foldl dmm 0 [a,b,c,d,e]|a<-x,b<-x,c<-x,d<-x,e<-x]
x6=[foldl dmm 0 [a,b,c,d,e,f]|a<-x,b<-x,c<-x,d<-x,e<-x,f<-x]
problem_35 =
(+13)$length $ circular_primes $ [a|a<-foldl (++) [] [x3,x4,x5,x6],isPrime a]
```

## Problem 36

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

Solution:

```
isPalin [] = True
isPalin [a] = True
isPalin (x:xs) =
if x == last xs then isPalin $ sansLast xs else False
where
sansLast xs = reverse $ tail $ reverse xs
toBase2 0 = []
toBase2 x = (show $ mod x 2) : toBase2 (div x 2)
isbothPalin x =
isPalin (show x) && isPalin (toBase2 x)
problem_36=
sum $ filter isbothPalin $ filter (not.even) [1..1000000]
```

Alternate Solution:

```
import Numeric
import Data.Char
isPalindrome x = x == reverse x
showBin n = showIntAtBase 2 intToDigit n ""
problem_36_v2 = sum [ n | n <- [1,3..10^6-1],
isPalindrome (show n) &&
isPalindrome (showBin n)]
```

## Problem 37

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

Solution:

```
-- isPrime in p35
clist n =
filter isLeftTruncatable $ if isPrime n then n:ns else []
where
ns = concatMap (clist . ((10*n) +)) [1,3,7,9]
isLeftTruncatable =
all isPrime . map read . init . tail . tails . show
problem_37 =
sum $ filter (>=10) $ concatMap clist [2,3,5,7]
```

## Problem 38

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

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 =
head $ perims !! indexMax
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:

```
takeLots :: [Int] -> [a] -> [a]
takeLots =
t 1
where
t i [] _ = []
t i jj@(j:js) (x:xs)
| i == j = x : t (i+1) js xs
| otherwise = t (i+1) jj xs
digitos :: [Int]
digitos =
d [1]
where
d k = reverse k ++ d (mais k)
mais (9:is) = 0 : mais is
mais (i:is) = (i+1) : is
mais [] = [1]
problem_40 =
product $ takeLots [10^n | n <- [0..6]] digitos
```

Here's how I did it, I think this is much easier to read:

```
num = concatMap show [1..]
problem_40_v2 = product $ map (\x -> digitToInt (num !! (10^x-1))) [0..6]
```