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