Difference between revisions of "Euler problems/31 to 40"
Jump to navigation
Jump to search
Marypoppins (talk | contribs) |
|||
Line 1: | Line 1: | ||
+ | Do them on your own! |
||
− | == [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 21:43, 29 January 2008
Do them on your own!