Difference between revisions of "Euler problems/111 to 120"

From HaskellWiki
Jump to navigation Jump to search
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 62: Line 62:
 
</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 95: Line 95:
 
problem_113=sum[binomial (8+a) a+binomial (9+a) a-10|a<-[1..100]]
  
problem_113=sum[binomial (8+a) a+binomial (9+a) a-10|a<-[1..100]]
 
</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.
   
Line 104: Line 104:
 
</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.
   
Line 115: Line 115:
 
</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.
   
Line 127: Line 127:
 
</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.
   
Line 141: Line 141:
 
</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>
−
find2km :: Integral a => a -> (a,a)
  
−
find2km n = f 0 n
  
−
where
 
−
f k m
  
−
| r == 1 = (k,m)
  
−
| otherwise = f (k+1) q
  
−
where (q,r) = quotRem m 2
 
−
 
−
millerRabinPrimality :: Integer -> Integer -> Bool
  
−
millerRabinPrimality n a
  
−
| a <= 1 || a >= n-1 =
 
−
error $ "millerRabinPrimality: a out of range ("
 
−
++ show a ++ " for "++ show n ++ ")"
 
−
| n < 2 = False
  
−
| even n = False
  
−
| b0 == 1 || b0 == n' = True
  
−
| otherwise = iter (tail b)
  
−
where
  
−
n' = n-1
  
−
(k,m) = find2km n'
  
−
b0 = powMod n a m
  
−
b = take (fromIntegral k) $ iterate (squareMod n) b0
  
−
iter [] = False
  
−
iter (x:xs)
  
−
| x == 1 = False
  
−
| x == n' = True
  
−
| otherwise = iter xs
  
−
 
−
pow' :: (Num a, Integral b) => (a -> a -> a) -> (a -> a) -> a -> b -> a
  
−
pow' _ _ _ 0 = 1
  
−
pow' mul sq x' n' = f x' n' 1
  
−
where
 
−
f x n y
  
−
| n == 1 = x `mul` y
  
−
| r == 0 = f x2 q y
  
−
| otherwise = f x2 q (x `mul` y)
  
−
where
  
−
(q,r) = quotRem n 2
  
−
x2 = sq x
  
−
 
−
mulMod :: Integral a => a -> a -> a -> a
  
−
mulMod a b c = (b * c) `mod` a
  
−
squareMod :: Integral a => a -> a -> a
  
−
squareMod a b = (b * b) `rem` a
  
−
powMod :: Integral a => a -> a -> a -> a
  
−
powMod m = pow' (mulMod m) (squareMod m)
  
−
--isPrime x=millerRabinPrimality x 2
  
 
isPrime x
  
isPrime x
 
|x<100=isPrime' x
  
|x<100=isPrime' x
−
|otherwise=foldl (&& )True [millerRabinPrimality x y|y<-[2,3,7,61]]
 +
|otherwise=foldl (&& )True [millerRabinPrimality x y|y<-[2,7,61]]
−
primes :: [Integer]
  
−
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]
  
−
 
−
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
  
−
 
 
getprimes ""= [[]]
  
getprimes ""= [[]]
 
getprimes s1=
 
getprimes s1=
Line 248: Line 184:
 
</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 269: Line 205:
 
</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)n + (a + 1)n is divided by a2.
   
 
Solution:
  
Solution:
 
<haskell>
  
<haskell>
  +
fun m=div (m*(8*m^2-3*m-5)) 3
−
import List
  
  ⚫
problem_120 = fun 500
−
primes :: [Integer]
  
−
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]
  
−
 
−
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]]
  
 
</haskell>
  
</haskell>

Revision as of 14:43, 26 January 2008

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"

Problem 112

Investigating the density of "bouncy" numbers.

Solution: 

isIncreasing' n p
    | n == 0 = True
    | p >= p1 = isIncreasing' (n `div` 10) p1
    | otherwise = False
    where
    p1 = n `mod` 10

isIncreasing :: Int -> Bool
isIncreasing n = isIncreasing' (n `div` 10) (n `mod` 10)

isDecreasing' n p
    | n == 0 = True
    | p <= p1 = isDecreasing' (n `div` 10) p1
    | otherwise = False
    where
    p1 = n `mod` 10

isDecreasing :: Int -> Bool
isDecreasing n = isDecreasing' (n `div` 10) (n `mod` 10)

isBouncy n = not (isIncreasing n) && not (isDecreasing n)
nnn=1500000
num150 =length [x|x<-[1..nnn],isBouncy x]
p112 n nb
    | fromIntegral nnb / fromIntegral n >= 0.99 = n
    | otherwise = prob112' (n+1) nnb
    where 
    nnb = if isBouncy n then nb + 1 else nb

problem_112=p112 (nnn+1) num150

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

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

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

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

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

Problem 118

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

Solution: 

isPrime x
    |x<100=isPrime' x
    |otherwise=foldl   (&& )True [millerRabinPrimality x y|y<-[2,7,61]]
getprimes ""= [[]]
getprimes s1= 
    [n:f|
    let len=length s1,
    a<-[1..len],
    let b=take a s1,
    let n=read b::Integer,
    isPrime n,
    let k=getprimes $drop a s1,
    f<-k,
    a==len|| n<head f
    ]
perms :: [a] -> [[a]]
perms [] = [ [] ]
perms (x:xs) = 
    concat (map (between x) (perms xs))
    where 
    between e [] = [ [e] ]
    between e (y:ys) = (e:y:ys) : map (y:) (between e ys)  
fun x=do
    let cs=length$getprimes x
    if (cs/=0) then
        appendFile "p118.log"$(++"\n")$show cs
        else
        return ()
sToInt =(+0).read 
problem_118a=do
    s<-readFile "p118.log"
    print$sum$map sToInt$lines s
main=do
    mapM_ fun $perms ['1'..'9']
    problem_118a
problem_118 = main

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

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
Retrieved from "https://wiki.haskell.org/index.php?title=Euler_problems/111_to_120&oldid=18685"