Euler problems/31 to 40
From HaskellWiki
CaleGibbard (Talk  contribs) (rv: vandalism) 

Line 87:  Line 87:  
Solution: 
Solution: 

<haskell> 
<haskell> 

−  import Data.Map (fromList ,(!)) 
+  http://www.research.att.com/~njas/sequences/A014080 
−  digits n 
+  problem_34 = sum[145, 40585] 
−  { 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!aa<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> 
</haskell> 

Line 97:  Line 97:  
millerRabinPrimality on the [[Prime_numbers]] page 
millerRabinPrimality on the [[Prime_numbers]] page 

<haskell> 
<haskell> 

+  http://www.research.att.com/~njas/sequences/A068652 

isPrime x 
isPrime x 

x==1=False 
x==1=False 

Line 129:  Line 130:  
Solution: 
Solution: 

<haskell> 
<haskell> 

−  isPalin [] = True 
+  http://www.research.att.com/~njas/sequences/A007632 
−  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= 
problem_36= 

−  sum $ filter isbothPalin $ filter (not.even) [1..1000000] 
+  sum [0, 1, 3, 5, 7, 9, 33, 99, 313, 585, 717, 
−  </haskell> 
+  7447, 9009, 15351, 32223, 39993, 53235, 
−  +  53835, 73737, 585585] 

−  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^61], 

−  isPalindrome (show n) && 

−  isPalindrome (showBin n)] 

</haskell> 
</haskell> 

Line 142:  Line 143:  
<haskell> 
<haskell> 

 isPrime in p35 
 isPrime in p35 

−  clist n = 
+   http://www.research.att.com/~njas/sequences/A020994 
−  filter isLeftTruncatable $ if isPrime n then n:ns else [] 
+  problem_37 =sum [23, 37, 53, 73, 313, 317, 373, 797, 3137, 3797, 739397] 
−  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> 
</haskell> 

Line 169:  Line 170:  
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. 
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> 
<haskell> 

−  problem_39 = 
+  http://www.research.att.com/~njas/sequences/A046079 
−  head $ perims !! indexMax 
+  problem_39 =let t=3*5*7 in floor(2^floor(log(1000/t)/log(2))*t) 
−  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> 
</haskell> 

Line 178:  Line 179:  
Solution: 
Solution: 

<haskell> 
<haskell> 

−  takeLots :: [Int] > [a] > [a] 
+  http://www.research.att.com/~njas/sequences/A023103 
−  takeLots = 
+  problem_40 = product [1, 1, 5, 3, 7, 2, 1] 
−  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^x1))) [0..6] 

</haskell> 
</haskell> 
Revision as of 11:50, 18 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 (n1) (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=(\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 $ [aa<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:
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]