# Euler problems/31 to 40

### From HaskellWiki

CaleGibbard (Talk | contribs) |
|||

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

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

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

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

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

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

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

| 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 160: | Line 154: | ||

<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

## Contents |

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

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

## 3 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]

## 4 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]

## 5 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]

## 6 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]

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

## 8 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]]

## 9 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)

## 10 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]