Personal tools

Euler problems/121 to 130

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
Line 68: Line 68:
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_125 = undefined
+
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)
 
</haskell>
 
</haskell>
   

Revision as of 06:31, 13 December 2007

Contents

1 Problem 121

Investigate the game of chance involving coloured discs.

Solution:

problem_121 = undefined

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

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

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

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:

problem_127 = undefined

8 Problem 128

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

Solution:

problem_128 = undefined

9 Problem 129

Investigating minimal repunits that divide by n.

Solution:

problem_129 = undefined

10 Problem 130

Finding composite values, n, for which n−1 is divisible by the length of the smallest repunits that divide it.

Solution:

problem_130 = undefined