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

```primes = 2 : filter ((==1) . length . primeFactors) [3,5..]

primeFactors n = factor n primes
where
factor _ [] = []
factor m (p:ps) | p*p > m        = [m]
| m `mod` p == 0 = p : [m `div` p]
| otherwise      = factor m ps

isPrime :: Integer -> Bool
isPrime 1 = False
isPrime n = case (primeFactors n) of
(_:_:_)   -> False
_         -> True

problem_123 =
let n=2*(a+1)*primes!!(fromInteger a),
n>10^10
]
```

## Problem 124

Determining the kth element of the sorted radical function.

Solution:

```import List
primes :: [Integer]
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]

primeFactors :: Integer -> [Integer]
primeFactors n = factor n primes
where
factor _ [] = []
factor m (p:ps) | p*p > m        = [m]
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)
| otherwise      = factor m ps
problem_124=snd\$(!!9999)\$sort[(product\$nub\$primeFactors x,x)|x<-[1..100000]]
```

## Problem 125

Finding square sums that are palindromic.

Solution:

```import Data.List
import Data.Map(fromList,(!))

toFloat = (flip encodeFloat 0)
digits n
{-  123->[3,2,1]
-}
|n<10=[n]
|otherwise= y:digits x
where
(x,y)=divMod n 10

palind n=foldl dmm 0 (digits n)
-- 123 ->321
dmm=(\x y->x*10+y)

makepalind n=(n*d+p):[c+b*d|b<-[0..9]]
where
a=(+1)\$floor\$logBase 10\$fromInteger n
d=10^a
p=palind n
c=n*10*d+p

twomakep n=(n*d+p)
where
a=(+1)\$floor\$logBase 10\$fromInteger n
d=10^a
p=palind n

p125=sum[b|a<-[1..999], b<-makepalind a,not\$null\$ funa b]
p125a=sum[b|a<-[1000..9999], let b=twomakep a,not\$null\$ funa b]
p125b=sum[a|a<-[1..9], not\$null\$ funa a]

findmap=fromList[(a,2*fill_map a)|a<-[0..737]]
fill_map x
|odd x=fastsum \$div (x-1) 2
|otherwise=fastsumodd (x-1)
where
fastsum  y=div (y*(y+1)*(2*y+1)) 6
fastsumodd  y=let n=div (y+1) 2 in div (n*(4*n*n-1)) 3

funa x=[(a,x)|a<-takeWhile (\a->a*a*a<4*x) [2..],funb a x]
funb x n
|odd x=d2==0 && 4*d1>=(x+1)^2 && isSq d1
|otherwise=d4==0 && odd d3 && d3>=(x+1)^2 && isSq d3
where
x1=fromInteger x
(d1,d2)=divMod ((n-findmap! x1)) (x)
(d3,d4)=divMod ((4*n-findmap!x1)) (x)
isSq x=(floor\$sqrt\$toFloat x)^2==x
problem_125 = (p125+p125a+p125b)
```

## Problem 126

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

Solution:

```problem_126 = undefined
```

## 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
primeFactors :: Integer -> [Integer]
primeFactors n = factor n primes
where
factor _ [] = []
factor m (p:ps) | p*p > m        = [m]
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)
| otherwise      = factor m ps
merge xs@(x:xt) ys@(y:yt) = case compare x y of
LT -> x : (merge xt ys)
EQ -> x : (merge xt yt)
GT -> y : (merge xs yt)

diff  xs@(x:xt) ys@(y:yt) = case compare x y of
LT -> x : (diff xt ys)
EQ -> diff xt yt
GT -> diff xs yt

primes, nonprimes :: [Integer]
primes    = [2,3,5] ++ (diff [7,9..] nonprimes)
nonprimes = foldr1 f . map g \$ tail primes
where f (x:xt) ys = x : (merge xt ys)
g p = [ n*p | n <- [p,p+2..]]
problem_127 = main
```

## Problem 128

Which tiles in the hexagonal arrangement have prime differences with neighbours?

Solution:

```problem_128 = undefined
```

## Problem 129

Investigating minimal repunits that divide by n.

Solution:

```import Data.List
mulMod :: Integral a => a -> a -> a -> a
mulMod a b c= (b * c) `rem` a
squareMod :: Integral a => a -> a -> a
squareMod a b = (b * b) `rem` a
pow' :: (Num a, Integral b) => (a -> a -> a) -> (a -> a) -> a -> b -> a
pow' _ _ _ 0 = 1
pow' mul sq x' n' = f x' n' 1
where
f x n y
| n == 1 = x `mul` y
| r == 0 = f x2 q y
| otherwise = f x2 q (x `mul` y)
where
(q,r) = quotRem n 2
x2 = sq x
powMod :: Integral a => a -> a -> a -> a
powMod m = pow' (mulMod m) (squareMod m)

merge xs@(x:xt) ys@(y:yt) = case compare x y of
LT -> x : (merge xt ys)
EQ -> x : (merge xt yt)
GT -> y : (merge xs yt)

diff  xs@(x:xt) ys@(y:yt) = case compare x y of
LT -> x : (diff xt ys)
EQ -> diff xt yt
GT -> diff xs yt

primes, nonprimes :: [Integer]
primes    = [2,3,5] ++ (diff [7,9..] nonprimes)
nonprimes = foldr1 f . map g \$ tail primes
where f (x:xt) ys = x : (merge xt ys)
g p = [ n*p | n <- [p,p+2..]]
primeFactors :: Integer -> [Integer]
primeFactors n = factor n primes
where
factor _ [] = []
factor m (p:ps) | p*p > m        = [m]
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)
| otherwise      = factor m ps

fstfac x = [(head a ,length a)|a<-group\$primeFactors x]
fac [(x,y)]=[x^a|a<-[0..y]]
fac (x:xs)=[a*b|a<-fac [x],b<-fac xs]
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)
```

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