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!