Difference between revisions of "Euler problems/121 to 130"
m (Corrected the links to the Euler project) |
m |
||
(16 intermediate revisions by 6 users not shown) | |||
Line 1: | Line 1: | ||
− | + | == [http://projecteuler.net/index.php?section=problems&id=121 Problem 121] == | |
− | == [http://projecteuler.net/index.php?section= | ||
Investigate the game of chance involving coloured discs. | Investigate the game of chance involving coloured discs. | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
− | problem_121 = | + | import Data.List |
+ | problem_121 = possibleGames `div` winningGames | ||
+ | where | ||
+ | possibleGames = product [1..16] | ||
+ | winningGames = | ||
+ | (1+) $ sum $ map product $ chooseUpTo 7 [1..15] | ||
+ | chooseUpTo 0 _ = [] | ||
+ | chooseUpTo (n+1) x = | ||
+ | [y:z | | ||
+ | (y:ys) <- tails x, | ||
+ | z <- []: chooseUpTo n ys | ||
+ | ] | ||
</haskell> | </haskell> | ||
− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=problems&id=122 Problem 122] == |
Finding the most efficient exponentiation method. | Finding the most efficient exponentiation method. | ||
− | Solution: | + | Solution using a depth first search, pretty fast : |
<haskell> | <haskell> | ||
− | problem_122 = | + | import Data.List |
+ | import Data.Array.Diff | ||
+ | import Control.Monad | ||
+ | |||
+ | depthAddChain 12 branch mins = mins | ||
+ | depthAddChain d branch mins = foldl' step mins $ nub $ filter (> head branch) | ||
+ | $ liftM2 (+) branch branch | ||
+ | where | ||
+ | step da e | e > 200 = da | ||
+ | | otherwise = | ||
+ | case compare (da ! e) d of | ||
+ | GT -> depthAddChain (d+1) (e:branch) $ da // [(e,d)] | ||
+ | EQ -> depthAddChain (d+1) (e:branch) da | ||
+ | LT -> da | ||
+ | |||
+ | baseBranch = [2,1] | ||
+ | |||
+ | baseMins :: DiffUArray Int Int | ||
+ | baseMins = listArray (1,200) $ 0:1: repeat maxBound | ||
+ | |||
+ | problem_122 = sum . elems $ depthAddChain 2 baseBranch baseMins | ||
</haskell> | </haskell> | ||
− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=problems&id=123 Problem 123] == |
Determining the remainder when (pn − 1)n + (pn + 1)n is divided by pn2. | Determining the remainder when (pn − 1)n + (pn + 1)n is divided by pn2. | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
− | problem_123 = | + | problem_123 = |
+ | fst . head . dropWhile (\(n,p) -> (2 + 2*n*p) < 10^10) $ | ||
+ | zip [1..] primes | ||
</haskell> | </haskell> | ||
− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=problems&id=124 Problem 124] == |
Determining the kth element of the sorted radical function. | Determining the kth element of the sorted radical function. | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
− | problem_124 = | + | import Data.List |
+ | import Data.Ord (comparing) | ||
+ | |||
+ | compress = map head . group | ||
+ | |||
+ | rad = product . compress . primeFactors | ||
+ | |||
+ | radfax = (1,1) : zip [2..] (map rad [2..]) | ||
+ | |||
+ | sortRadfax n = sortBy (comparing snd) $ take n radfax | ||
+ | problem_124=fst$sortRadfax 100000!!9999 | ||
</haskell> | </haskell> | ||
− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=problems&id=125 Problem 125] == |
Finding square sums that are palindromic. | Finding square sums that are palindromic. | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
− | problem_125 = | + | import Data.List as L |
+ | import Data.Set as S | ||
+ | |||
+ | hi = 100000000 | ||
+ | |||
+ | ispalindrome n = (show n) == reverse (show n) | ||
+ | |||
+ | -- the "drop 2" ensures all sums use at least two terms | ||
+ | -- by ignoring the 0- and 1-term "sums" | ||
+ | sumsFrom i = | ||
+ | takeWhile (<hi) . | ||
+ | drop 2 . | ||
+ | scanl (\s n -> s + n^2) 0 $ [i..] | ||
+ | |||
+ | limit = | ||
+ | truncate . sqrt . fromIntegral $ (hi `div` 2) | ||
+ | |||
+ | problem_125 = | ||
+ | fold (+) 0 . | ||
+ | fromList . | ||
+ | concat . | ||
+ | L.map (L.filter ispalindrome . sumsFrom) $ [1 .. limit] | ||
</haskell> | </haskell> | ||
− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=problems&id=126 Problem 126] == |
Exploring the number of cubes required to cover every visible face on a cuboid. | Exploring the number of cubes required to cover every visible face on a cuboid. | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
− | + | import Data.Array.ST | |
+ | import Control.Monad (when) | ||
+ | import Control.Monad.ST | ||
+ | |||
+ | limit = 20000 | ||
+ | layer x y z n = 4*(x+y+z+n-2)*(n-1) + 2*x*y + 2*x*z + 2*y*z | ||
+ | |||
+ | solutions :: STUArray s Int Int -> Int -> ST s () | ||
+ | solutions a n = | ||
+ | when (layer 1 1 1 n <= limit) $ | ||
+ | do solutions a (n+1) | ||
+ | solutions' a 1 n | ||
+ | |||
+ | solutions' :: STUArray s Int Int -> Int -> Int -> ST s () | ||
+ | solutions' a x n = | ||
+ | when (layer x x x n <= limit) $ | ||
+ | do solutions' a (x+1) n | ||
+ | solutions'' a x x n | ||
+ | |||
+ | solutions'' :: STUArray s Int Int -> Int -> Int -> Int -> ST s () | ||
+ | solutions'' a x y n = | ||
+ | when (layer x y y n <= limit) $ | ||
+ | do solutions'' a x (y+1) n | ||
+ | solutions''' a x y y n | ||
+ | |||
+ | solutions''' :: STUArray s Int Int -> Int -> Int -> Int -> Int -> ST s () | ||
+ | solutions''' a x y z n = | ||
+ | when (layer x y z n <= limit) $ | ||
+ | do readArray a (layer x y z n) >>= return.(+1) >>= writeArray a (layer x y z n) | ||
+ | solutions''' a x y (z+1) n | ||
+ | |||
+ | findSolution :: STUArray s Int Int -> Int -> ST s (Maybe Int) | ||
+ | findSolution a n | ||
+ | | n == limit = return Nothing | ||
+ | | otherwise = do | ||
+ | v <- readArray a n | ||
+ | if v == 1000 | ||
+ | then return (Just n) | ||
+ | else findSolution a (n+1) | ||
+ | |||
+ | main :: IO () | ||
+ | main = print foo | ||
+ | where foo = runST $ | ||
+ | do cn <- newArray (0,limit+1) 0 :: ST s (STUArray s Int Int) | ||
+ | solutions cn 1 | ||
+ | findSolution cn 154 | ||
</haskell> | </haskell> | ||
− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=problems&id=127 Problem 127] == |
Investigating the number of abc-hits below a given limit. | Investigating the number of abc-hits below a given limit. | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
− | problem_127 = | + | import Data.List |
+ | import Data.Array.IArray | ||
+ | import Data.Array.Unboxed | ||
+ | |||
+ | main = appendFile "p127.log" $show$ solve 99999 | ||
+ | |||
+ | rad x = fromIntegral $ product $ map fst $ primePowerFactors $ fromIntegral x | ||
+ | primePowerFactors x = [(head a ,length a)|a<-group$primeFactors x] | ||
+ | solve :: Int -> Int | ||
+ | solve n = sum [ c | (rc,c) <- invrads | ||
+ | , 2 * rc < c | ||
+ | , (ra, a) <- takeWhile (\(a,_)->(c > 2*rc*a)) invrads | ||
+ | , a < c `div` 2 | ||
+ | , gcd ra rc == 1 | ||
+ | , ra * rads ! (c - a) < c `div` rc] | ||
+ | where | ||
+ | rads :: UArray Int Int | ||
+ | rads = listArray (1,n) $ map rad [1..n] | ||
+ | invrads = sort $ map (\(a,b) -> (b, a)) $ assocs rads | ||
+ | problem_127 = main | ||
</haskell> | </haskell> | ||
− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=problems&id=128 Problem 128] == |
Which tiles in the hexagonal arrangement have prime differences with neighbours? | Which tiles in the hexagonal arrangement have prime differences with neighbours? | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
− | problem_128 = | + | p128= |
+ | concat[m|a<-[0..70000],let m=middle a++right a,not$null m] | ||
+ | where | ||
+ | middle n | ||
+ | |all isPrime [11+6*n,13+6*n,29+12*n]=[2+3*(n+1)*(n+2)] | ||
+ | |otherwise=[] | ||
+ | right n | ||
+ | |all isPrime [11+6*n,17+6*n,17+12*n]=[1+3*(n+2)*(n+3)] | ||
+ | |otherwise=[] | ||
+ | problem_128=do | ||
+ | print(p128!!1997) | ||
+ | isPrime x | ||
+ | |x<100=isPrime' x | ||
+ | |otherwise=all (millerRabinPrimality x )[2,7,61] | ||
</haskell> | </haskell> | ||
− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=problems&id=129 Problem 129] == |
Investigating minimal repunits that divide by n. | Investigating minimal repunits that divide by n. | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
− | problem_129 = | + | import Data.List |
+ | factors x=fac$fstfac x | ||
+ | funp (p,1)= | ||
+ | head[a| | ||
+ | a<-sort$factors (p-1), | ||
+ | powMod p 10 a==1 | ||
+ | ] | ||
+ | funp (p,s)=p^(s-1)*funp (p,1) | ||
+ | funn []=1 | ||
+ | funn (x:xs) =lcm (funp x) (funn xs) | ||
+ | p129 q= | ||
+ | head[a| | ||
+ | a<-[q..], | ||
+ | gcd a 10==1, | ||
+ | let s=funn$fstfac$(*9) a, | ||
+ | s>q, | ||
+ | s>a | ||
+ | ] | ||
+ | problem_129 = p129 (10^6) | ||
</haskell> | </haskell> | ||
− | == [http://projecteuler.net/index.php?section= | + | == [http://projecteuler.net/index.php?section=problems&id=130 Problem 130] == |
Finding composite values, n, for which n−1 is divisible by the length of the smallest repunits that divide it. | Finding composite values, n, for which n−1 is divisible by the length of the smallest repunits that divide it. | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
− | problem_130 = | + | --factors powMod in p129 |
+ | fun x | ||
+ | |(not$null a)=head a | ||
+ | |otherwise=0 | ||
+ | where | ||
+ | a=take 1 [n|n<-sort$factors (x-1),(powMod x 10 n)==1] | ||
+ | problem_130 =sum$take 25[a|a<-[1..], | ||
+ | not$isPrime a, | ||
+ | let b=fun a, | ||
+ | b/=0, | ||
+ | mod (a-1) b==0, | ||
+ | mod a 3 /=0] | ||
</haskell> | </haskell> | ||
− | |||
− | |||
− |
Latest revision as of 18:29, 21 February 2010
Contents
Problem 121
Investigate the game of chance involving coloured discs.
Solution:
import Data.List
problem_121 = possibleGames `div` winningGames
where
possibleGames = product [1..16]
winningGames =
(1+) $ sum $ map product $ chooseUpTo 7 [1..15]
chooseUpTo 0 _ = []
chooseUpTo (n+1) x =
[y:z |
(y:ys) <- tails x,
z <- []: chooseUpTo n ys
]
Problem 122
Finding the most efficient exponentiation method.
Solution using a depth first search, pretty fast :
import Data.List
import Data.Array.Diff
import Control.Monad
depthAddChain 12 branch mins = mins
depthAddChain d branch mins = foldl' step mins $ nub $ filter (> head branch)
$ liftM2 (+) branch branch
where
step da e | e > 200 = da
| otherwise =
case compare (da ! e) d of
GT -> depthAddChain (d+1) (e:branch) $ da // [(e,d)]
EQ -> depthAddChain (d+1) (e:branch) da
LT -> da
baseBranch = [2,1]
baseMins :: DiffUArray Int Int
baseMins = listArray (1,200) $ 0:1: repeat maxBound
problem_122 = sum . elems $ depthAddChain 2 baseBranch baseMins
Problem 123
Determining the remainder when (pn − 1)n + (pn + 1)n is divided by pn2.
Solution:
problem_123 =
fst . head . dropWhile (\(n,p) -> (2 + 2*n*p) < 10^10) $
zip [1..] primes
Problem 124
Determining the kth element of the sorted radical function.
Solution:
import Data.List
import Data.Ord (comparing)
compress = map head . group
rad = product . compress . primeFactors
radfax = (1,1) : zip [2..] (map rad [2..])
sortRadfax n = sortBy (comparing snd) $ take n radfax
problem_124=fst$sortRadfax 100000!!9999
Problem 125
Finding square sums that are palindromic.
Solution:
import Data.List as L
import Data.Set as S
hi = 100000000
ispalindrome n = (show n) == reverse (show n)
-- the "drop 2" ensures all sums use at least two terms
-- by ignoring the 0- and 1-term "sums"
sumsFrom i =
takeWhile (<hi) .
drop 2 .
scanl (\s n -> s + n^2) 0 $ [i..]
limit =
truncate . sqrt . fromIntegral $ (hi `div` 2)
problem_125 =
fold (+) 0 .
fromList .
concat .
L.map (L.filter ispalindrome . sumsFrom) $ [1 .. limit]
Problem 126
Exploring the number of cubes required to cover every visible face on a cuboid.
Solution:
import Data.Array.ST
import Control.Monad (when)
import Control.Monad.ST
limit = 20000
layer x y z n = 4*(x+y+z+n-2)*(n-1) + 2*x*y + 2*x*z + 2*y*z
solutions :: STUArray s Int Int -> Int -> ST s ()
solutions a n =
when (layer 1 1 1 n <= limit) $
do solutions a (n+1)
solutions' a 1 n
solutions' :: STUArray s Int Int -> Int -> Int -> ST s ()
solutions' a x n =
when (layer x x x n <= limit) $
do solutions' a (x+1) n
solutions'' a x x n
solutions'' :: STUArray s Int Int -> Int -> Int -> Int -> ST s ()
solutions'' a x y n =
when (layer x y y n <= limit) $
do solutions'' a x (y+1) n
solutions''' a x y y n
solutions''' :: STUArray s Int Int -> Int -> Int -> Int -> Int -> ST s ()
solutions''' a x y z n =
when (layer x y z n <= limit) $
do readArray a (layer x y z n) >>= return.(+1) >>= writeArray a (layer x y z n)
solutions''' a x y (z+1) n
findSolution :: STUArray s Int Int -> Int -> ST s (Maybe Int)
findSolution a n
| n == limit = return Nothing
| otherwise = do
v <- readArray a n
if v == 1000
then return (Just n)
else findSolution a (n+1)
main :: IO ()
main = print foo
where foo = runST $
do cn <- newArray (0,limit+1) 0 :: ST s (STUArray s Int Int)
solutions cn 1
findSolution cn 154
Problem 127
Investigating the number of abc-hits below a given limit.
Solution:
import Data.List
import Data.Array.IArray
import Data.Array.Unboxed
main = appendFile "p127.log" $show$ solve 99999
rad x = fromIntegral $ product $ map fst $ primePowerFactors $ fromIntegral x
primePowerFactors x = [(head a ,length a)|a<-group$primeFactors x]
solve :: Int -> Int
solve n = sum [ c | (rc,c) <- invrads
, 2 * rc < c
, (ra, a) <- takeWhile (\(a,_)->(c > 2*rc*a)) invrads
, a < c `div` 2
, gcd ra rc == 1
, ra * rads ! (c - a) < c `div` rc]
where
rads :: UArray Int Int
rads = listArray (1,n) $ map rad [1..n]
invrads = sort $ map (\(a,b) -> (b, a)) $ assocs rads
problem_127 = main
Problem 128
Which tiles in the hexagonal arrangement have prime differences with neighbours?
Solution:
p128=
concat[m|a<-[0..70000],let m=middle a++right a,not$null m]
where
middle n
|all isPrime [11+6*n,13+6*n,29+12*n]=[2+3*(n+1)*(n+2)]
|otherwise=[]
right n
|all isPrime [11+6*n,17+6*n,17+12*n]=[1+3*(n+2)*(n+3)]
|otherwise=[]
problem_128=do
print(p128!!1997)
isPrime x
|x<100=isPrime' x
|otherwise=all (millerRabinPrimality x )[2,7,61]
Problem 129
Investigating minimal repunits that divide by n.
Solution:
import Data.List
factors x=fac$fstfac x
funp (p,1)=
head[a|
a<-sort$factors (p-1),
powMod p 10 a==1
]
funp (p,s)=p^(s-1)*funp (p,1)
funn []=1
funn (x:xs) =lcm (funp x) (funn xs)
p129 q=
head[a|
a<-[q..],
gcd a 10==1,
let s=funn$fstfac$(*9) a,
s>q,
s>a
]
problem_129 = p129 (10^6)
Problem 130
Finding composite values, n, for which n−1 is divisible by the length of the smallest repunits that divide it.
Solution:
--factors powMod in p129
fun x
|(not$null a)=head a
|otherwise=0
where
a=take 1 [n|n<-sort$factors (x-1),(powMod x 10 n)==1]
problem_130 =sum$take 25[a|a<-[1..],
not$isPrime a,
let b=fun a,
b/=0,
mod (a-1) b==0,
mod a 3 /=0]