# Euler problems/31 to 40

### From HaskellWiki

Line 167: | Line 167: | ||

problem_36= |
problem_36= |
||

sum $ filter isbothPalin $ filter (not.even) [1..1000000] |
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> |
</haskell> |
||

## Revision as of 19:48, 28 January 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:

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]

Here's another (slighly simpler) way:

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 ]

## 5 Problem 35

How many circular primes are there below one million?

Solution: millerRabinPrimality on the Prime_numbers page

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]

## 6 Problem 36

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

Solution:

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]

Alternate Solution:

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

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

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

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 ]

## 10 Problem 40

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

Solution:

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

Here's how I did it, I think this is much easier to read:

num = concatMap show [1..] problem_40_v2 = product $ map (\x -> digitToInt (num !! (10^x-1))) [0..6]