Difference between revisions of "Euler problems/31 to 40"
Line 6: | Line 6: | ||
This is the naive doubly recursive solution. Speed would be greatly improved by use of [[memoization]], dynamic programming, or the closed form. |
This is the naive doubly recursive solution. Speed would be greatly improved by use of [[memoization]], dynamic programming, or the closed form. |
||
<haskell> |
<haskell> |
||
− | problem_31 = |
+ | problem_31 = |
− | + | pence 200 [1,2,5,10,20,50,100,200] |
|
⚫ | |||
⚫ | |||
+ | pence 0 _ = 1 |
||
⚫ | |||
− | + | pence n [] = 0 |
|
⚫ | |||
⚫ | |||
− | + | | n < d = 0 |
|
⚫ | |||
</haskell> |
</haskell> |
||
Line 27: | Line 28: | ||
) ([[]] : repeat []) |
) ([[]] : repeat []) |
||
− | problem_31 = |
+ | problem_31 = |
+ | length $ combinations coins !! 200 |
||
</haskell> |
</haskell> |
||
Line 35: | Line 37: | ||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
− | problem_32 = |
+ | problem_32 = |
+ | sum $ nub $ map (\(a, b) -> a * b) multiplicands |
||
where |
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 |
|
</haskell> |
</haskell> |
||
Line 72: | Line 75: | ||
] |
] |
||
+ | rs' = |
||
− | + | filter (<1) $ map (\x -> denominator x % numerator x) rs |
|
</haskell> |
</haskell> |
||
Line 81: | Line 85: | ||
<haskell> |
<haskell> |
||
import Data.Char |
import Data.Char |
||
− | problem_34 = |
+ | problem_34 = |
+ | sum [ x | x <- [3..100000], x == facsum x ] |
||
⚫ | |||
+ | where |
||
⚫ | |||
</haskell> |
</haskell> |
||
Line 92: | Line 98: | ||
import Data.List (tails, (\\)) |
import Data.List (tails, (\\)) |
||
− | primes |
+ | primes = |
− | + | 2 : filter ((==1) . length . primeFactors) [3,5..] |
|
⚫ | |||
− | |||
⚫ | |||
− | primeFactors :: Integer -> [Integer] |
||
⚫ | |||
where |
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 :: Integer -> Bool |
||
+ | |otherwise= |
||
⚫ | |||
− | + | case (primeFactors n) of |
|
− | + | (_:_:_) -> False |
|
− | + | _ -> True |
|
⚫ | |||
− | |||
+ | take l $ map (read . take l) $ |
||
⚫ | |||
− | + | tails $ take (2*l -1) $ cycle s |
|
where |
where |
||
− | + | s = show n |
|
− | + | l = length s |
|
− | |||
− | circular_primes :: [Integer] -> [Integer] |
||
circular_primes [] = [] |
circular_primes [] = [] |
||
circular_primes (x:xs) |
circular_primes (x:xs) |
||
Line 121: | Line 124: | ||
| otherwise = circular_primes xs |
| otherwise = circular_primes xs |
||
where |
where |
||
− | + | p = permutations x |
|
− | problem_35 |
+ | problem_35 = |
− | + | length $ circular_primes $ takeWhile (<1000000) primes |
|
</haskell> |
</haskell> |
||
Line 135: | Line 138: | ||
import Data.Char |
import Data.Char |
||
− | showBin = |
+ | showBin = |
+ | flip (showIntAtBase 2 intToDigit) "" |
||
− | isPalindrome x = |
+ | isPalindrome x = |
+ | x == reverse x |
||
− | problem_36 = |
+ | problem_36 = |
+ | sum [x | |
||
x <- [1,3..1000000], |
x <- [1,3..1000000], |
||
isPalindrome (show x), |
isPalindrome (show x), |
||
Line 153: | Line 159: | ||
import Data.List (tails, inits, nub) |
import Data.List (tails, inits, nub) |
||
⚫ | |||
− | primes :: [Integer] |
||
+ | nub . map read $ |
||
− | primes = 2 : filter ((==1) . length . primeFactors) [3,5..] |
||
− | |||
− | primeFactors :: Integer -> [Integer] |
||
⚫ | |||
⚫ | |||
⚫ | |||
− | factor m (p:ps) | p*p > m = [m] |
||
− | | m `mod` p == 0 = p : factor (m `div` p) (p:ps) |
||
⚫ | |||
− | |||
− | isPrime :: Integer -> Bool |
||
⚫ | |||
− | isPrime n = case (primeFactors n) of |
||
− | (_:_:_) -> False |
||
− | _ -> True |
||
− | |||
− | truncs :: Integer -> [Integer] |
||
⚫ | |||
(take l . tail . tails) s ++ (take l . tail . inits) s |
(take l . tail . tails) s ++ (take l . tail . inits) s |
||
where |
where |
||
Line 177: | Line 166: | ||
s = show n |
s = show n |
||
− | problem_37 = |
+ | problem_37 = |
+ | sum $ take 11 [x | |
||
x <- dropWhile (<=9) primes, |
x <- dropWhile (<=9) primes, |
||
all isPrime (truncs x) |
all isPrime (truncs x) |
||
Line 189: | Line 179: | ||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
− | problem_38 = |
+ | 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 p2 = Just p2 |
|
− | + | | isPan p3 = Just p3 |
|
− | + | | isPan p4 = Just p4 |
|
− | + | | isPan p5 = Just p5 |
|
⚫ | |||
⚫ | |||
+ | ] |
||
+ | where |
||
⚫ | |||
</haskell> |
</haskell> |
||
Line 207: | Line 200: | ||
import Data.List |
import Data.List |
||
− | mult n i vs |
+ | mult n i vs |
+ | | length (concat vs) >= 9 = concat vs |
||
− | | otherwise = mult n (i+1) (vs ++ [show (n * i)]) |
||
⚫ | |||
− | problem_38 |
+ | problem_38 = |
− | + | maximum $ map read $ filter |
|
((['1'..'9'] ==) .sort) $ |
((['1'..'9'] ==) .sort) $ |
||
[ mult n 1 [] | n <- [2..9999] ] |
[ mult n 1 [] | n <- [2..9999] ] |
||
Line 222: | Line 216: | ||
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. |
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> |
<haskell> |
||
− | problem_39 = |
+ | 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 = |
|
− | n <- [1..floor (sqrt 1000)], |
||
⚫ | |||
− | m <- [n+1..floor (sqrt 1000)], |
||
− | + | 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, |
|
⚫ | |||
+ | p < 1000 |
||
+ | ] |
||
</haskell> |
</haskell> |
||
Revision as of 00:44, 17 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 =
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 =
nub . map read $
(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 =
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:
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))