Difference between revisions of "Euler problems/121 to 130"
(add problem 128) |
|||
Line 1: | Line 1: | ||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=121 Problem 121] == |
Investigate the game of chance involving coloured discs. |
Investigate the game of chance involving coloured discs. |
||
Line 18: | Line 18: | ||
</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. |
||
Line 46: | Line 46: | ||
</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. |
||
Line 52: | Line 52: | ||
<haskell> |
<haskell> |
||
problem_123 = |
problem_123 = |
||
+ | fst . head . dropWhile (\(n,p) -> (2 + 2*n*p) < 10^10) $ |
||
− | head[a+1|a<-[20000,20002..22000], |
||
+ | zip [1..] primes |
||
− | let n=2*(a+1)*primes!!(fromInteger a), |
||
− | n>10^10 |
||
− | ] |
||
</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> |
||
− | import List |
+ | import Data.List |
+ | compress [] = [] |
||
− | problem_124= |
||
+ | compress (x:[]) = [x] |
||
− | snd$(!!9999)$sort[(product$nub$primeFactors x,x)|x<-[1..100000]] |
||
+ | compress (x:y:xs) | x == y = compress (y:xs) |
||
− | |||
+ | | otherwise = x : compress (y:xs) |
||
+ | |||
+ | rad = product . compress . primeFactors |
||
+ | |||
+ | radfax = (1,1) : zip [2..] (map rad [2..]) |
||
+ | |||
+ | sortRadfax n = sortBy (\ (_,x) (_,y) -> compare x y) $ 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> |
||
− | import Data.List |
+ | import Data.List as L |
− | import Data. |
+ | 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 = |
||
− | toFloat = (flip encodeFloat 0) |
||
+ | fold (+) 0 . |
||
− | digits n |
||
+ | fromList . |
||
− | {- 123->[3,2,1] |
||
+ | concat . |
||
− | -} |
||
+ | L.map (L.filter ispalindrome . sumsFrom) $ [1 .. limit] |
||
− | |n<10=[n] |
||
− | |otherwise= y:digits x |
||
− | where |
||
− | (x,y)=divMod n 10 |
||
− | |||
− | palind n=foldl dmm 0 (digits n) |
||
− | -- 123 ->321 |
||
− | dmm=(\x y->x*10+y) |
||
− | |||
− | makepalind n=(n*d+p):[c+b*d|b<-[0..9]] |
||
− | where |
||
− | a=(+1)$floor$logBase 10$fromInteger n |
||
− | d=10^a |
||
− | p=palind n |
||
− | c=n*10*d+p |
||
− | |||
− | twomakep n=(n*d+p) |
||
− | where |
||
− | a=(+1)$floor$logBase 10$fromInteger n |
||
− | d=10^a |
||
− | p=palind n |
||
− | |||
− | p125=sum[b|a<-[1..999], b<-makepalind a,not$null$ funa b] |
||
− | p125a=sum[b|a<-[1000..9999], let b=twomakep a,not$null$ funa b] |
||
− | p125b=sum[a|a<-[1..9], not$null$ funa a] |
||
− | |||
− | findmap=fromList[(a,2*fill_map a)|a<-[0..737]] |
||
− | fill_map x |
||
− | |odd x=fastsum $div (x-1) 2 |
||
− | |otherwise=fastsumodd (x-1) |
||
− | where |
||
− | fastsum y=div (y*(y+1)*(2*y+1)) 6 |
||
− | fastsumodd y=let n=div (y+1) 2 in div (n*(4*n*n-1)) 3 |
||
− | |||
− | funa x=[(a,x)|a<-takeWhile (\a->a*a*a<4*x) [2..],funb a x] |
||
− | funb x n |
||
− | |odd x=d2==0 && 4*d1>=(x+1)^2 && isSq d1 |
||
− | |otherwise=d4==0 && odd d3 && d3>=(x+1)^2 && isSq d3 |
||
− | where |
||
− | x1=fromInteger x |
||
− | (d1,d2)=divMod ((n-findmap! x1)) (x) |
||
− | (d3,d4)=divMod ((4*n-findmap!x1)) (x) |
||
− | isSq x=(floor$sqrt$toFloat x)^2==x |
||
− | problem_125 = (p125+p125a+p125b) |
||
</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. |
||
Line 135: | Line 112: | ||
</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. |
||
Line 162: | Line 139: | ||
</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? |
||
Line 183: | Line 160: | ||
</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. |
||
Line 190: | Line 167: | ||
import Data.List |
import Data.List |
||
factors x=fac$fstfac x |
factors x=fac$fstfac x |
||
+ | funp (p,1)= |
||
− | funp (p,1)=head[a|a<-sort$factors (p-1),powMod p 10 a==1] |
||
+ | head[a| |
||
+ | a<-sort$factors (p-1), |
||
+ | powMod p 10 a==1 |
||
+ | ] |
||
funp (p,s)=p^(s-1)*funp (p,1) |
funp (p,s)=p^(s-1)*funp (p,1) |
||
funn []=1 |
funn []=1 |
||
funn (x:xs) =lcm (funp x) (funn xs) |
funn (x:xs) =lcm (funp x) (funn xs) |
||
+ | p129 q= |
||
− | p129 q=head[a|a<-[q..],gcd a 10==1,let s=funn$fstfac$(*9) a,s>q,s>a] |
||
+ | head[a| |
||
+ | a<-[q..], |
||
+ | gcd a 10==1, |
||
+ | let s=funn$fstfac$(*9) a, |
||
+ | s>q, |
||
+ | s>a |
||
+ | ] |
||
problem_129 = p129 (10^6) |
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. |
||
Line 204: | Line 192: | ||
<haskell> |
<haskell> |
||
--factors powMod in p129 |
--factors powMod in p129 |
||
− | fun x |
+ | fun x |
+ | |(not$null a)=head a |
||
|otherwise=0 |
|otherwise=0 |
||
where |
where |
Revision as of 02:39, 27 January 2008
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
compress [] = []
compress (x:[]) = [x]
compress (x:y:xs) | x == y = compress (y:xs)
| otherwise = x : compress (y:xs)
rad = product . compress . primeFactors
radfax = (1,1) : zip [2..] (map rad [2..])
sortRadfax n = sortBy (\ (_,x) (_,y) -> compare x y) $ 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:
problem_126 = undefined
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]