Personal tools

Euler problems/31 to 40

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
(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!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>
 
</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^6-1],
 
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^x-1))) [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 (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=(\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:

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