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

## 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
]
```

## Problem 122

Finding the most efficient exponentiation method.

Solution using a depth first search, pretty fast :

```import Data.List
import Data.Array.Diff

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

## Problem 123

Determining the remainder when (pn − 1)n + (pn + 1)n is divided by pn2.

Solution:

```problem_123 =
fst . head . dropWhile (\(n,p) -> (2 + 2*n*p) < 10^10) \$
zip [1..] primes
```

## Problem 124

Determining the kth element of the sorted radical function.

Solution:

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

sortRadfax n = sortBy (\ (_,x) (_,y) -> compare x y) \$ take n radfax
```

## Problem 125

Finding square sums that are palindromic.

Solution:

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

## Problem 126

Exploring the number of cubes required to cover every visible face on a cuboid.

Solution:

```import Data.Array.IO
import Data.Array.Base

limit = 20000
layer x y z n = 4*(x+y+z+n-2)*(n-1) + 2*x*y + 2*x*z + 2*y*z

solutions :: IOUArray Int Int -> Int -> IO ()
solutions a n = do
if layer 1 1 1 n <= limit
then do solutions a (n+1)
solutions' a 1 n
else do return ()

solutions' :: IOUArray Int Int -> Int -> Int -> IO ()
solutions' a x n = do
if layer x x x n <= limit
then do solutions' a (x+1) n
solutions'' a x x n
else do return ()

solutions'' :: IOUArray Int Int -> Int -> Int -> Int -> IO ()
solutions'' a x y n = do
if layer x y y n <= limit
then do solutions'' a x (y+1) n
solutions''' a x y y n
else do return ()

solutions''' :: IOUArray Int Int -> Int -> Int -> Int -> Int -> IO ()
solutions''' a x y z n = do
if layer x y z n <= limit
then do unsafeRead a (layer x y z n) >>= return.(+1) >>= unsafeWrite a (layer x y z n)
solutions''' a x y (z+1) n
else do return ()

findSolution :: IOUArray Int Int -> Int -> IO (Maybe Int)
findSolution a n
| n == limit = do return Nothing
| otherwise = do
if v == 1000
then do return (Just n)
else do findSolution a (n+1)

main = do
cn <- newArray (0,limit+1) 0 :: IO (IOUArray Int Int)
solutions cn 1
findSolution cn 154 >>=print
problem_126 = main
```

## 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
invrads = sort \$ map (\(a,b) -> (b, a)) \$ assocs rads
problem_127 = main
```

## 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]
```

## Problem 129

Investigating minimal repunits that divide by n.

Solution:

```import Data.List
factors x=fac\$fstfac x
funp (p,1)=
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=
a<-[q..],
gcd a 10==1,
let s=funn\$fstfac\$(*9) a,
s>q,
s>a
]
problem_129 = p129 (10^6)
```

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