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

From HaskellWiki
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!