Personal tools

Euler problems/111 to 120

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
m
 
(13 intermediate revisions by 7 users not shown)
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=view&id=111 Problem 111] ==
+
== [http://projecteuler.net/index.php?section=problems&id=111 Problem 111] ==
 
Search for 10-digit primes containing the maximum number of repeated digits.
 
Search for 10-digit primes containing the maximum number of repeated digits.
   
Line 25: Line 25:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=112 Problem 112] ==
+
== [http://projecteuler.net/index.php?section=problems&id=112 Problem 112] ==
 
Investigating the density of "bouncy" numbers.
 
Investigating the density of "bouncy" numbers.
   
Line 31: Line 31:
 
<haskell>
 
<haskell>
 
import Data.List
 
import Data.List
digits n
 
{- change 123 to [3,2,1]
 
-}
 
|n<10=[n]
 
|otherwise= y:digits x
 
where
 
(x,y)=divMod n 10
 
isdecr x=
 
null$filter (\(x, y)->x-y<0)$zip di k
 
where
 
di=digits x
 
k=0:di
 
isincr x=
 
null$filter (\(x, y)->x-y<0)$zip di k
 
where
 
di=digits x
 
k=tail$di++[0]
 
nnn=1500000
 
num150 =length [x|x<-[1..nnn],isdecr x||isincr x]
 
istwo x|isdecr x||isincr x=1
 
|otherwise=0
 
problem_112 n1 n2=
 
if (div n1 n2==100)
 
then do appendFile "file.log" ((show n1) ++" "++ (show n2)++"\n")
 
return()
 
else problem_112 (n1+1) (n2+istwo (n1+1))
 
main= problem_112 nnn num150
 
   
  +
isIncreasing x = show x == sort (show x)
  +
isDecreasing x = reverse (show x) == sort (show x)
  +
isBouncy x = not (isIncreasing x) && not (isDecreasing x)
  +
  +
findProportion prop = snd . head . filter condition . zip [1..]
  +
where condition (a,b) = a >= prop * fromIntegral b
  +
  +
problem_112 = findProportion 0.99 $ filter isBouncy [1..]
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=113 Problem 113] ==
+
== [http://projecteuler.net/index.php?section=problems&id=113 Problem 113] ==
 
How many numbers below a googol (10100) are not "bouncy"?
 
How many numbers below a googol (10100) are not "bouncy"?
   
Line 90: Line 71:
 
it is another way to solution this problem:
 
it is another way to solution this problem:
 
<haskell>
 
<haskell>
import List
+
binomial x y =div (prodxy (y+1) x) (prodxy 1 (x-y))
series 2 =replicate 10 1
+
prodxy x y=product[x..y]
series n=sumkey$map (\(x, y)->map (*y) x)$zip key (series (n-1))
+
problem_113=sum[binomial (8+a) a+binomial (9+a) a-10|a<-[1..100]]
key =[replicate (a+1) 1++replicate (9-a) 0|a<-[0..9]]
 
sumkey k=[sum [a!!m|a<-k]|m<-[0..9]]
 
fun x= sum [(sum$series i)-1|i<-[2..x]]-(x-1)*9-1+(sum$series x)
 
problem_113 =fun 101
 
 
</haskell>
 
</haskell>
== [http://projecteuler.net/index.php?section=view&id=114 Problem 114] ==
+
== [http://projecteuler.net/index.php?section=problems&id=114 Problem 114] ==
 
Investigating the number of ways to fill a row with separated blocks that are at least three units long.
 
Investigating the number of ways to fill a row with separated blocks that are at least three units long.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_114 = undefined
+
-- fun in p115
  +
problem_114=fun 3 50
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=115 Problem 115] ==
+
== [http://projecteuler.net/index.php?section=problems&id=115 Problem 115] ==
 
Finding a generalisation for the number of ways to fill a row with separated blocks.
 
Finding a generalisation for the number of ways to fill a row with separated blocks.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_115 = undefined
+
binomial x y =div (prodxy (y+1) x) (prodxy 1 (x-y))
  +
prodxy x y=product[x..y]
  +
fun m n=sum[binomial (k+a) (k-a)|a<-[0..div (n+1) (m+1)],let k=1-a*m+n]
  +
problem_115 = (+1)$length$takeWhile (<10^6) [fun 50 i|i<-[1..]]
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=116 Problem 116] ==
+
== [http://projecteuler.net/index.php?section=problems&id=116 Problem 116] ==
 
Investigating the number of ways of replacing square tiles with one of three coloured tiles.
 
Investigating the number of ways of replacing square tiles with one of three coloured tiles.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_116 = undefined
+
binomial x y =div (prodxy (y+1) x) (prodxy 1 (x-y))
  +
prodxy x y=product[x..y]
  +
f116 n x=sum[binomial (a+b) a|a<-[1..div n x],let b=n-a*x]
  +
p116 x=sum[f116 x a|a<-[2..4]]
  +
problem_116 = p116 50
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=117 Problem 117] ==
+
== [http://projecteuler.net/index.php?section=problems&id=117 Problem 117] ==
 
Investigating the number of ways of tiling a row using different-sized tiles.
 
Investigating the number of ways of tiling a row using different-sized tiles.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_117 = undefined
+
fibs5 = 0 : 0 :1: 1:zipWith4 (\a b c d->a+b+c+d) fibs5 a1 a2 a3
  +
where
  +
a1=tail fibs5
  +
a2=tail a1
  +
a3=tail a2
  +
p117 x=fibs5!!(x+2)
  +
problem_117 = p117 50
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=118 Problem 118] ==
+
== [http://projecteuler.net/index.php?section=problems&id=118 Problem 118] ==
 
Exploring the number of ways in which sets containing prime elements can be made.
 
Exploring the number of ways in which sets containing prime elements can be made.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_118 = undefined
+
digits = ['1'..'9']
  +
  +
-- possible partitions voor prime number sets
  +
-- leave out patitions with more than 4 1's
  +
-- because only {2,3,5,7,..} is possible
  +
-- and the [9]-partition because every permutation of all
  +
-- nine digits is divisable by 3
  +
test xs
  +
|len>4=False
  +
|xs==[9]=False
  +
|otherwise=True
  +
where
  +
len=length $filter (==1) xs
  +
parts = filter test $partitions 9
  +
permutationsOf [] = [[]]
  +
permutationsOf xs = [x:xs' | x <- xs, xs' <- permutationsOf (delete x xs)]
  +
combinationsOf 0 _ = [[]]
  +
combinationsOf _ [] = []
  +
combinationsOf k (x:xs) =
  +
map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs
  +
  +
priemPerms [] = 0
  +
priemPerms ds =
  +
fromIntegral . length . filter (isPrime . read) . permutationsOf $ ds
  +
setsums [] 0 = [[]]
  +
setsums [] _ = []
  +
setsums (x:xs) n
  +
| x > n = setsums xs n
  +
| otherwise = map (x:) (setsums (x:xs) (n-x)) ++ setsums xs n
  +
  +
partitions n = setsums (reverse [1..n]) n
  +
  +
fc :: [Integer] -> [Char] -> Integer
  +
fc (p:[]) ds = priemPerms ds
  +
fc (p:ps) ds =
  +
sum [np y * fc ps (ds \\ y) | y <- combinationsOf p ds, np y /= 0]
  +
where
  +
np = priemPerms
  +
-- here is the 'imperfection' correction method:
  +
-- make use of duplicate reducing factors for partitions
  +
-- with repeating factors, f.i. [1,1,1,1,2,3]:
  +
-- in this case 4 1's -> factor = 4!
  +
-- or for [1,1,1,3,3] : factor = 3! * 2!
  +
dupF :: [Integer] -> Integer
  +
dupF = product . map (product . enumFromTo 1 . fromIntegral . length) . group
  +
  +
main = do
  +
print . sum . map (\x -> fc x digits `div` dupF x) $ parts
  +
problem_118 = main
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=119 Problem 119] ==
+
== [http://projecteuler.net/index.php?section=problems&id=119 Problem 119] ==
 
Investigating the numbers which are equal to sum of their digits raised to some power.
 
Investigating the numbers which are equal to sum of their digits raised to some power.
   
Line 155: Line 136:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=120 Problem 120] ==
+
== [http://projecteuler.net/index.php?section=problems&id=120 Problem 120] ==
Finding the maximum remainder when (a − 1)n + (a + 1)n is divided by a2.
+
Finding the maximum remainder when (a − 1)<sup>n</sup> + (a + 1)<sup>n</sup> is divided by a<sup>2</sup>.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
import List
+
fun m=div (m*(8*m^2-3*m-5)) 3
primes :: [Integer]
+
problem_120 = fun 500
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]
+
</haskell>
 
primeFactors :: Integer -> [Integer]
 
primeFactors n = factor n primes
 
where
 
factor _ [] = []
 
factor m (p:ps) | p*p > m = [m]
 
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)
 
| otherwise = factor m ps
 
 
isPrime :: Integer -> Bool
 
isPrime 1 = False
 
isPrime n = case (primeFactors n) of
 
(_:_:_) -> False
 
_ -> True
 
fun x
 
|even x=x*(x-2)
 
|not$null$funb x=head$funb x
 
|odd e=x*(x-1)
 
|otherwise=2*x*(e-1)
 
where
 
e=div x 2
 
   
funb x=take 1 [nn*x|
 
a<-[1,3..x],
 
let n=div (x-1) 2,
 
let p=x*a+n,
 
isPrime p,
 
let nn=mod (2*(x*a+n)) x
 
]
 
   
problem_120 = sum [fun a|a<-[3..1000]]
+
I have no idea what the above solution has to do with this
  +
problem, even though it produces the correct answer. I suspect
  +
it is some kind of red herring. Below you will find a more holy
  +
mackerel approach, based on the observation that:
  +
  +
1. (a-1)<sup>n</sup> + (a+1)<sup>n</sup> = 2 if n is odd, and 2an if n is even (mod a<sup>2</sup>)
  +
  +
2. the maximum of 2an mod a<sup>2</sup> occurs when n = (a-1)/2
  +
  +
I hope this is a little more transparent than the solution
  +
proposed above. Henrylaxen Mar 5, 2008
  +
  +
<haskell>
  +
maxRemainder n = 2 * n * ((n-1) `div` 2)
  +
problem_120 = sum $ map maxRemainder [3..1000]
 
</haskell>
 
</haskell>

Latest revision as of 08:07, 23 February 2010

Contents

[edit] 1 Problem 111

Search for 10-digit primes containing the maximum number of repeated digits.

Solution:

import Control.Monad (replicateM)
 
-- All ways of interspersing n copies of x into a list
intr :: Int -> a -> [a] -> [[a]]
intr 0 _ y      = [y]
intr n x (y:ys) = concat
                  [map ((replicate i x ++) . (y :)) $ intr (n-i) x ys
                       | i <- [0..n]]
intr n x _      = [replicate n x]
 
-- All 10-digit primes containing the maximal number of the digit d
maxDigits :: Char -> [Integer]
maxDigits d = head $ dropWhile null
              [filter isPrime $ map read $ filter ((/='0') . head) $
               concatMap (intr (10-n) d) $
               replicateM n $ delete d "0123456789"
                   | n <- [1..9]]
 
problem_111 = sum $ concatMap maxDigits "0123456789"

[edit] 2 Problem 112

Investigating the density of "bouncy" numbers.

Solution:

import Data.List
 
isIncreasing x = show x == sort (show x)
isDecreasing x = reverse (show x) == sort (show x)
isBouncy x = not (isIncreasing x) && not (isDecreasing x)
 
findProportion prop = snd . head . filter condition . zip [1..]
  where condition (a,b) = a >= prop * fromIntegral b
 
problem_112 = findProportion 0.99 $ filter isBouncy [1..]

[edit] 3 Problem 113

How many numbers below a googol (10100) are not "bouncy"?

Solution:

import Array
 
mkArray b f = listArray b $ map f (range b)
 
digits = 100
 
inc = mkArray ((1, 0), (digits, 9)) ninc
dec = mkArray ((1, 0), (digits, 9)) ndec
 
ninc (1, _) = 1
ninc (l, d) = sum [inc ! (l-1, i) | i <- [d..9]]
 
ndec (1, _) = 1
ndec (l, d) = sum [dec ! (l-1, i) | i <- [0..d]]
 
problem_113 = sum [inc ! i | i <- range ((digits, 0), (digits, 9))]
               + sum [dec ! i | i <- range ((1, 1), (digits, 9))]
               - digits*9 -- numbers like 11111 are counted in both inc and dec 
               - 1 -- 0 is included in the increasing numbers

Note: inc and dec contain the same data, but it seems clearer to duplicate them.

it is another way to solution this problem:

binomial x y =div (prodxy (y+1) x) (prodxy 1 (x-y))
prodxy x y=product[x..y]
problem_113=sum[binomial (8+a) a+binomial (9+a) a-10|a<-[1..100]]

[edit] 4 Problem 114

Investigating the number of ways to fill a row with separated blocks that are at least three units long.

Solution:

-- fun in p115
problem_114=fun 3 50

[edit] 5 Problem 115

Finding a generalisation for the number of ways to fill a row with separated blocks.

Solution:

binomial x y =div (prodxy (y+1) x) (prodxy 1 (x-y))
prodxy x y=product[x..y]
fun m n=sum[binomial (k+a) (k-a)|a<-[0..div (n+1) (m+1)],let k=1-a*m+n]
problem_115 = (+1)$length$takeWhile (<10^6) [fun 50 i|i<-[1..]]

[edit] 6 Problem 116

Investigating the number of ways of replacing square tiles with one of three coloured tiles.

Solution:

binomial x y =div (prodxy (y+1) x) (prodxy 1 (x-y))
prodxy x y=product[x..y]
f116 n x=sum[binomial (a+b) a|a<-[1..div n x],let b=n-a*x]
p116 x=sum[f116 x a|a<-[2..4]]
problem_116 = p116 50

[edit] 7 Problem 117

Investigating the number of ways of tiling a row using different-sized tiles.

Solution:

fibs5 = 0 : 0 :1: 1:zipWith4 (\a b c d->a+b+c+d) fibs5 a1 a2 a3 
    where
    a1=tail fibs5
    a2=tail a1
    a3=tail a2
p117 x=fibs5!!(x+2)
problem_117 = p117 50

[edit] 8 Problem 118

Exploring the number of ways in which sets containing prime elements can be made.

Solution:

digits = ['1'..'9']
 
-- possible partitions voor prime number sets
-- leave out patitions with more than 4 1's 
-- because only {2,3,5,7,..} is possible
-- and the [9]-partition because every permutation of all
-- nine digits is divisable by 3
test xs
    |len>4=False
    |xs==[9]=False
    |otherwise=True
    where
    len=length $filter (==1) xs
parts = filter test $partitions  9
permutationsOf [] = [[]]
permutationsOf xs = [x:xs' | x <- xs, xs' <- permutationsOf (delete x xs)]
combinationsOf  0 _ = [[]]
combinationsOf  _ [] = []
combinationsOf  k (x:xs) =
    map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs
 
priemPerms [] = 0
priemPerms ds = 
    fromIntegral . length . filter (isPrime . read) . permutationsOf $ ds
setsums [] 0 = [[]]
setsums [] _ = []
setsums (x:xs) n 
    | x > n     = setsums xs n
    | otherwise = map (x:) (setsums (x:xs) (n-x)) ++ setsums xs n
 
partitions n = setsums (reverse [1..n]) n
 
fc :: [Integer] -> [Char] -> Integer
fc (p:[]) ds = priemPerms ds
fc (p:ps) ds = 
    sum [np y * fc ps (ds \\ y) | y <- combinationsOf p ds, np y /= 0]
        where
        np = priemPerms 
-- here is the 'imperfection' correction method:
-- make use of duplicate reducing factors for partitions
-- with repeating factors, f.i. [1,1,1,1,2,3]: 
-- in this case 4 1's -> factor = 4!
-- or for [1,1,1,3,3] : factor = 3! * 2!
dupF :: [Integer] -> Integer
dupF = product . map (product . enumFromTo 1 . fromIntegral . length) . group
 
main = do
    print . sum . map (\x -> fc x digits `div` dupF x) $ parts 
problem_118 = main

[edit] 9 Problem 119

Investigating the numbers which are equal to sum of their digits raised to some power.

Solution:

import Data.List
digits n 
{-  123->[3,2,1]
 -}
    |n<10=[n]
    |otherwise= y:digits x 
    where
    (x,y)=divMod n 10
problem_119 =sort [(a^b)|
    a<-[2..200],
    b<-[2..9],
    let m=a^b,
    let n=sum$digits m,
    n==a]!!29

[edit] 10 Problem 120

Finding the maximum remainder when (a − 1)n + (a + 1)n is divided by a2.

Solution:

fun m=div (m*(8*m^2-3*m-5)) 3
problem_120 = fun 500


I have no idea what the above solution has to do with this problem, even though it produces the correct answer. I suspect it is some kind of red herring. Below you will find a more holy mackerel approach, based on the observation that:

1. (a-1)n + (a+1)n = 2 if n is odd, and 2an if n is even (mod a2)

2. the maximum of 2an mod a2 occurs when n = (a-1)/2

I hope this is a little more transparent than the solution proposed above. Henrylaxen Mar 5, 2008

maxRemainder n = 2 * n * ((n-1) `div` 2)
problem_120 = sum $ map maxRemainder [3..1000]