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] == |
||
− | Do them on your own! |
||
+ | 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
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]