Difference between revisions of "Euler problems/31 to 40"

From HaskellWiki
Jump to: navigation, search
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 = ways [1,2,5,10,20,50,100,200] !!200
−
ways [1,2,5,10,20,50,100,200] !!200
 +
where ways [] = 1 : repeat 0
−
where
+
ways (coin:coins) =n
−
ways [] = 1 : repeat 0
 +
where n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)
−
ways (coin:coins) =n
 
−
where
  
−
n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)
  
 
</haskell>
  
</haskell>
   
Line 18: Line 18:
 
combinations = foldl (\without p ->
  
combinations = foldl (\without p ->
 
let (poor,rich) = splitAt p without
  
let (poor,rich) = splitAt p without
−
with = poor ++
+
with = poor ++ zipWith (++) (map (map (p:)) with)
−
zipWith (++) (map (map (p:)) with)
 +
rich
−
rich
  
 
in with
  
in with
 
) ([[]] : repeat [])
  
) ([[]] : repeat [])
   
−
problem_31 =
+
problem_31 = length $ combinations coins !! 200
−
length $ combinations coins !! 200
  
 
</haskell>
  
</haskell>
   
Line 32: Line 32:
 
<haskell>
  
<haskell>
 
import Control.Monad
  
import Control.Monad
  +
 
combs 0 xs = [([],xs)]
  
combs 0 xs = [([],xs)]
−
combs n xs = [(y:ys,rest)|y<-xs, (ys,rest)<-combs (n-1) (delete y xs)]
 +
combs n xs = [(y:ys,rest) | y <- xs, (ys,rest) <- combs (n-1) (delete y xs)]
   
 
l2n :: (Integral a) => [a] -> a
  
l2n :: (Integral a) => [a] -> a
Line 41: Line 42:
   
 
explode :: (Integral a) => a -> [a]
  
explode :: (Integral a) => a -> [a]
−
explode =
 
  ⚫
explode = unfoldr (\a -> if a==0 then Nothing else Just . swap $ quotRem a 10)
⚫
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
   
⚫
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_32 = sum pandigiticals
 
</haskell>
  
</haskell>
Line 60: Line 61:
 
<haskell>
  
<haskell>
 
import Data.Ratio
  
import Data.Ratio
−
problem_33 = denominator $product $ rs
 +
problem_33 = denominator . product $ rs
 
{-
  
{-
 
xy/yz = x/z
  
xy/yz = x/z
Line 66: Line 67:
 
9xz + yz = 10xy
  
9xz + yz = 10xy
 
-}
  
-}
−
rs=[(10*x+y)%(10*y+z) |
 +
rs = [(10*x+y)%(10*y+z) | x <- t,
−
x <- t,
+
y <- t,
−
y <- t,
+
z <- t,
−
z <- t,
 +
x /= y ,
−
x /= y ,
 +
(9*x*z) + (y*z) == (10*x*y)]
−
(9*x*z) + (y*z) == (10*x*y)
 +
where t = [1..9]
−
]
  
−
where
  
−
t=[1..9]
  
 
</haskell>
  
</haskell>
   
Line 80: Line 81:
 
<haskell>
  
<haskell>
 
--http://www.research.att.com/~njas/sequences/A014080
  
--http://www.research.att.com/~njas/sequences/A014080
−
problem_34 = sum[145, 40585]
 +
problem_34 = sum [145, 40585]
 
</haskell>
  
</haskell>
   
Line 91: Line 92:
 
--http://www.research.att.com/~njas/sequences/A068652
  
--http://www.research.att.com/~njas/sequences/A068652
 
isPrime x
  
isPrime x
−
|x==1=False
 +
| x==1 = False
−
|x==2=True
 +
| x==2 = True
−
|x==3=True
 +
| x==3 = True
−
|otherwise=millerRabinPrimality x 2
 +
| otherwise = millerRabinPrimality x 2
−
permutations n =
+
−
take l $ map (read . take l) $
+
permutations n = take l
−
tails $ take (2*l -1) $ cycle s
 +
. map (read . take l)
−
where
 +
. tails
−
s = show n
 +
. take (2*l-1)
−
l = length s
 +
. cycle $ s
  +
where s = show n
  +
l = length s
  +
 
circular_primes [] = []
  
circular_primes [] = []
 
circular_primes (x:xs)
  
circular_primes (x:xs)
 
| all isPrime p = x : circular_primes xs
  
| all isPrime p = x : circular_primes xs
 
| otherwise = circular_primes xs
  
| otherwise = circular_primes xs
−
where
  
  ⚫
where p = permutations x
⚫
p = permutations x
  
  +
−
x=[1,3,7,9]
+
x = [1,3,7,9]
−
dmm=(\x y->x*10+y)
 +
−
x3=[foldl dmm 0 [a,b,c]|a<-x,b<-x,c<-x]
 +
dmm = foldl (\x y->x*10+y) 0
−
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]
 +
xx n = map dmm (replicateM n 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 =
+
problem_35 = (+13) . length . circular_primes
−
(+13)$length $ circular_primes $ [a|a<-foldl (++) [] [x3,x4,x5,x6],isPrime a]
 +
$ [a | a <- concat [xx 3,xx 4,xx 5,xx 6], isPrime a]
 
</haskell>
  
</haskell>
   
Line 123: Line 124:
 
<haskell>
  
<haskell>
 
--http://www.research.att.com/~njas/sequences/A007632
  
--http://www.research.att.com/~njas/sequences/A007632
−
problem_36=
 
  +
problem_36 = sum [0, 1, 3, 5, 7, 9, 33, 99, 313, 585, 717,
−
sum [0, 1, 3, 5, 7, 9, 33, 99, 313, 585, 717,
 +
7447, 9009, 15351, 32223, 39993, 53235,
−
7447, 9009, 15351, 32223, 39993, 53235,
 +
53835, 73737, 585585]
−
53835, 73737, 585585]
  
 
</haskell>
  
</haskell>
   
Line 135: Line 136:
 
-- isPrime in p35
  
-- isPrime in p35
 
-- http://www.research.att.com/~njas/sequences/A020994
  
-- http://www.research.att.com/~njas/sequences/A020994
−
problem_37 =sum [23, 37, 53, 73, 313, 317, 373, 797, 3137, 3797, 739397]
 +
problem_37 = sum [23, 37, 53, 73, 313, 317, 373, 797, 3137, 3797, 739397]
 
</haskell>
  
</haskell>
   
Line 149: Line 150:
 
| otherwise = mult n (i+1) (vs ++ [show (n * i)])
  
| otherwise = mult n (i+1) (vs ++ [show (n * i)])
   
−
problem_38 =
 
  ⚫
problem_38 = maximum . map read . filter ((['1'..'9'] ==) .sort)
−
maximum $ map read $ filter
  
  ⚫
$ [mult n 1 [] | n <- [2..9999]]
⚫
((['1'..'9'] ==) .sort) $
  
⚫
[ mult n 1 [] | n <- [2..9999] ]
  
 
</haskell>
  
</haskell>
   
Line 162: Line 161:
 
<haskell>
  
<haskell>
 
--http://www.research.att.com/~njas/sequences/A046079
  
--http://www.research.att.com/~njas/sequences/A046079
−
problem_39 =let t=3*5*7 in floor(2^floor(log(1000/t)/log(2))*t)
 +
problem_39 = let t = 3*5*7
  +
in floor(2^floor(log(1000/t)/log 2)*t)
 
</haskell>
  
</haskell>
   

Revision as of 19:35, 19 February 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: 

--http://www.research.att.com/~njas/sequences/A014080
problem_34 = sum [145, 40585]

Problem 35

How many circular primes are there below one million?

Solution: millerRabinPrimality on the Prime_numbers page 

--http://www.research.att.com/~njas/sequences/A068652
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 = foldl (\x y->x*10+y) 0

xx n = map dmm (replicateM n x)

problem_35 = (+13) . length . circular_primes 
               $ [a | a <- concat [xx 3,xx 4,xx 5,xx 6], isPrime a]

Problem 36

Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.

Solution: 

--http://www.research.att.com/~njas/sequences/A007632
problem_36 = sum [0, 1, 3, 5, 7, 9, 33, 99, 313, 585, 717,
                  7447, 9009, 15351, 32223, 39993, 53235,
                  53835, 73737, 585585]

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
-- http://www.research.att.com/~njas/sequences/A020994
problem_37 = sum [23, 37, 53, 73, 313, 317, 373, 797, 3137, 3797, 739397]

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. 

--http://www.research.att.com/~njas/sequences/A046079
problem_39 = let t = 3*5*7
             in floor(2^floor(log(1000/t)/log 2)*t)

Problem 40

Finding the nth digit of the fractional part of the irrational number.

Solution: 

--http://www.research.att.com/~njas/sequences/A023103
problem_40 = product  [1, 1, 5, 3, 7, 2, 1]
Retrieved from "https://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&oldid=19213"