|
|
Line 1: |
Line 1: |
− | == [http://projecteuler.net/index.php?section=problems&id=121 Problem 121] ==
| + | Do them on your own! |
− | Investigate the game of chance involving coloured discs.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | 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>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=122 Problem 122] ==
| |
− | Finding the most efficient exponentiation method.
| |
− | | |
− | Solution using a depth first search, pretty fast :
| |
− | <haskell>
| |
− | 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>
| |
− | | |
− | == [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.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | problem_123 =
| |
− | fst . head . dropWhile (\(n,p) -> (2 + 2*n*p) < 10^10) $
| |
− | zip [1..] primes
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=124 Problem 124] ==
| |
− | Determining the kth element of the sorted radical function.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | 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
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=125 Problem 125] ==
| |
− | Finding square sums that are palindromic.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | 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>
| |
− | | |
− | == [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.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | problem_126 = undefined
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=127 Problem 127] ==
| |
− | Investigating the number of abc-hits below a given limit.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | 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>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=128 Problem 128] ==
| |
− | Which tiles in the hexagonal arrangement have prime differences with neighbours?
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | 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>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=129 Problem 129] ==
| |
− | Investigating minimal repunits that divide by n.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | 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>
| |
− | | |
− | == [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.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | --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>
| |