|
|
| 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>
| |