Difference between revisions of "Euler problems/121 to 130"

== [http://projecteuler.net/index.php?section=problems&id=121 Problem 121] ==

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>