Personal tools

Euler problems/121 to 130

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
(add problem 128)
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=view&id=121 Problem 121] ==
+
== [http://projecteuler.net/index.php?section=problems&id=121 Problem 121] ==
 
Investigate the game of chance involving coloured discs.
 
Investigate the game of chance involving coloured discs.
   
Line 18: Line 18:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=122 Problem 122] ==
+
== [http://projecteuler.net/index.php?section=problems&id=122 Problem 122] ==
 
Finding the most efficient exponentiation method.
 
Finding the most efficient exponentiation method.
   
Line 46: Line 46:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=123 Problem 123] ==
+
== [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.
 
Determining the remainder when (pn − 1)n + (pn + 1)n is divided by pn2.
   
Line 52: Line 52:
 
<haskell>
 
<haskell>
 
problem_123 =
 
problem_123 =
head[a+1|a<-[20000,20002..22000],
+
fst . head . dropWhile (\(n,p) -> (2 + 2*n*p) < 10^10) $
let n=2*(a+1)*primes!!(fromInteger a),
+
zip [1..] primes
n>10^10
 
]
 
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=124 Problem 124] ==
+
== [http://projecteuler.net/index.php?section=problems&id=124 Problem 124] ==
 
Determining the kth element of the sorted radical function.
 
Determining the kth element of the sorted radical function.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
import List
+
import Data.List
problem_124=
+
compress [] = []
snd$(!!9999)$sort[(product$nub$primeFactors x,x)|x<-[1..100000]]
+
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>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=125 Problem 125] ==
+
== [http://projecteuler.net/index.php?section=problems&id=125 Problem 125] ==
 
Finding square sums that are palindromic.
 
Finding square sums that are palindromic.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
import Data.List
+
import Data.List as L
import Data.Map(fromList,(!))
+
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)
   
toFloat = (flip encodeFloat 0)
+
problem_125 =
digits n
+
fold (+) 0 .
{- 123->[3,2,1]
+
fromList .
-}
+
concat .
|n<10=[n]
+
L.map (L.filter ispalindrome . sumsFrom) $ [1 .. limit]
|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)
 
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=126 Problem 126] ==
+
== [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.
 
Exploring the number of cubes required to cover every visible face on a cuboid.
   
Line 90: Line 90:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=127 Problem 127] ==
+
== [http://projecteuler.net/index.php?section=problems&id=127 Problem 127] ==
 
Investigating the number of abc-hits below a given limit.
 
Investigating the number of abc-hits below a given limit.
   
Line 117: Line 117:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=128 Problem 128] ==
+
== [http://projecteuler.net/index.php?section=problems&id=128 Problem 128] ==
 
Which tiles in the hexagonal arrangement have prime differences with neighbours?
 
Which tiles in the hexagonal arrangement have prime differences with neighbours?
   
Line 138: Line 138:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=129 Problem 129] ==
+
== [http://projecteuler.net/index.php?section=problems&id=129 Problem 129] ==
 
Investigating minimal repunits that divide by n.
 
Investigating minimal repunits that divide by n.
   
Line 145: Line 145:
 
import Data.List
 
import Data.List
 
factors x=fac$fstfac x
 
factors x=fac$fstfac x
funp (p,1)=head[a|a<-sort$factors (p-1),powMod p 10 a==1]
+
funp (p,1)=
  +
head[a|
  +
a<-sort$factors (p-1),
  +
powMod p 10 a==1
  +
]
 
funp (p,s)=p^(s-1)*funp (p,1)
 
funp (p,s)=p^(s-1)*funp (p,1)
 
funn []=1
 
funn []=1
 
funn (x:xs) =lcm (funp x) (funn xs)
 
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]
+
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_129 = p129 (10^6)
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=130 Problem 130] ==
+
== [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.
 
Finding composite values, n, for which n−1 is divisible by the length of the smallest repunits that divide it.
   
Line 159: Line 159:
 
<haskell>
 
<haskell>
 
--factors powMod in p129
 
--factors powMod in p129
fun x |(not$null a)=head a
+
fun x
  +
|(not$null a)=head a
 
|otherwise=0
 
|otherwise=0
 
where
 
where

Revision as of 02:39, 27 January 2008

Contents

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

2 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

3 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

4 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

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

6 Problem 126

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

Solution:

problem_126 = undefined

7 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

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

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

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