Personal tools

Euler problems/31 to 40

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
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 21:43, 29 January 2008

Do them on your own!