Personal tools

Euler problems/121 to 130

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
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>
 

Revision as of 21:44, 29 January 2008

Do them on your own!