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

From HaskellWiki
Jump to: navigation, search
(rv: vandalism)
Line 1: Line 1:
−
Do them on your own!
  
  +
== [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>

Revision as of 04:59, 30 January 2008

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

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

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: 

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
     rads :: UArray Int Int
     rads = listArray (1,n) $ map rad [1..n]
     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)=
    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
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]
Retrieved from "https://wiki.haskell.org/index.php?title=Euler_problems/121_to_130&oldid=18802"