Difference between revisions of "Euler problems/121 to 130"
(add problem 128) |
|||
Line 51: | Line 51: | ||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
− | primes = 2 : filter ((==1) . length . primeFactors) [3,5..] |
||
− | |||
− | primeFactors n = factor n primes |
||
− | where |
||
− | factor _ [] = [] |
||
− | factor m (p:ps) | p*p > m = [m] |
||
− | | m `mod` p == 0 = p : [m `div` p] |
||
− | | otherwise = factor m ps |
||
− | |||
− | isPrime :: Integer -> Bool |
||
− | isPrime 1 = False |
||
− | isPrime n = case (primeFactors n) of |
||
− | (_:_:_) -> False |
||
− | _ -> True |
||
− | |||
problem_123 = |
problem_123 = |
||
head[a+1|a<-[20000,20002..22000], |
head[a+1|a<-[20000,20002..22000], |
||
Line 79: | Line 64: | ||
<haskell> |
<haskell> |
||
import List |
import List |
||
+ | problem_124= |
||
− | primes :: [Integer] |
||
+ | snd$(!!9999)$sort[(product$nub$primeFactors x,x)|x<-[1..100000]] |
||
− | 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 |
||
− | problem_124=snd$(!!9999)$sort[(product$nub$primeFactors x,x)|x<-[1..100000]] |
||
</haskell> |
</haskell> |
||
Line 183: | Line 159: | ||
rads = listArray (1,n) $ map rad [1..n] |
rads = listArray (1,n) $ map rad [1..n] |
||
invrads = sort $ map (\(a,b) -> (b, a)) $ assocs rads |
invrads = sort $ map (\(a,b) -> (b, a)) $ assocs rads |
||
− | 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 |
||
− | merge xs@(x:xt) ys@(y:yt) = case compare x y of |
||
− | LT -> x : (merge xt ys) |
||
− | EQ -> x : (merge xt yt) |
||
− | GT -> y : (merge xs yt) |
||
− | |||
− | diff xs@(x:xt) ys@(y:yt) = case compare x y of |
||
− | LT -> x : (diff xt ys) |
||
− | EQ -> diff xt yt |
||
− | GT -> diff xs yt |
||
− | |||
− | primes, nonprimes :: [Integer] |
||
− | primes = [2,3,5] ++ (diff [7,9..] nonprimes) |
||
− | nonprimes = foldr1 f . map g $ tail primes |
||
− | where f (x:xt) ys = x : (merge xt ys) |
||
− | g p = [ n*p | n <- [p,p+2..]] |
||
problem_127 = main |
problem_127 = main |
||
</haskell> |
</haskell> |
||
Line 213: | Line 167: | ||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
+ | p128= |
||
− | problem_128 = undefined |
||
+ | 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> |
||
Line 222: | Line 189: | ||
<haskell> |
<haskell> |
||
import Data.List |
import Data.List |
||
− | mulMod :: Integral a => a -> a -> a -> a |
||
− | mulMod a b c= (b * c) `rem` a |
||
− | squareMod :: Integral a => a -> a -> a |
||
− | squareMod a b = (b * b) `rem` a |
||
− | 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 |
||
− | powMod :: Integral a => a -> a -> a -> a |
||
− | powMod m = pow' (mulMod m) (squareMod m) |
||
− | |||
− | merge xs@(x:xt) ys@(y:yt) = case compare x y of |
||
− | LT -> x : (merge xt ys) |
||
− | EQ -> x : (merge xt yt) |
||
− | GT -> y : (merge xs yt) |
||
− | |||
− | diff xs@(x:xt) ys@(y:yt) = case compare x y of |
||
− | LT -> x : (diff xt ys) |
||
− | EQ -> diff xt yt |
||
− | GT -> diff xs yt |
||
− | |||
− | primes, nonprimes :: [Integer] |
||
− | primes = [2,3,5] ++ (diff [7,9..] nonprimes) |
||
− | nonprimes = foldr1 f . map g $ tail primes |
||
− | where f (x:xt) ys = x : (merge xt ys) |
||
− | g p = [ n*p | n <- [p,p+2..]] |
||
− | 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 |
||
− | |||
− | fstfac x = [(head a ,length a)|a<-group$primeFactors x] |
||
− | fac [(x,y)]=[x^a|a<-[0..y]] |
||
− | fac (x:xs)=[a*b|a<-fac [x],b<-fac xs] |
||
factors x=fac$fstfac x |
factors x=fac$fstfac x |
||
funp (p,1)=head[a|a<-sort$factors (p-1),powMod p 10 a==1] |
funp (p,1)=head[a|a<-sort$factors (p-1),powMod p 10 a==1] |
Revision as of 06:37, 25 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 =
head[a+1|a<-[20000,20002..22000],
let n=2*(a+1)*primes!!(fromInteger a),
n>10^10
]
Problem 124
Determining the kth element of the sorted radical function.
Solution:
import List
problem_124=
snd$(!!9999)$sort[(product$nub$primeFactors x,x)|x<-[1..100000]]
Problem 125
Finding square sums that are palindromic.
Solution:
import Data.List
import Data.Map(fromList,(!))
toFloat = (flip encodeFloat 0)
digits n
{- 123->[3,2,1]
-}
|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)
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]