Euler problems/121 to 130
From HaskellWiki
Contents |
1 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 ]
2 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
3 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 ]
4 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]]
5 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)
6 Problem 126
Exploring the number of cubes required to cover every visible face on a cuboid.
Solution:
problem_126 = undefined
7 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
8 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]
9 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)
10 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]
