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

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