Difference between revisions of "Euler problems/61 to 70"
Line 83: | Line 83: | ||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
+ | import Data.List (findIndex) |
||
− | problem_64 = undefined |
||
+ | |||
+ | fraction n = (a0, 1, (-a0)) : nextDigits n 1 (-a0) |
||
+ | where |
||
+ | a0 = firstDigit n |
||
+ | |||
+ | nextDigits n num den |
||
+ | | n - (den^2) == 0 = [] |
||
+ | | otherwise = (an, den', num') : nextDigits n den' num' |
||
+ | where |
||
+ | a0 = firstDigit n |
||
+ | den' = (n - (den^2)) `div` num |
||
+ | an = (a0 + abs den) `div` den' |
||
+ | num' = abs den - (an * den') |
||
+ | |||
+ | firstDigit n = floor $ sqrt $ fromInteger n |
||
+ | |||
+ | period [] = 0 |
||
+ | period xs = period' [] xs |
||
+ | where |
||
+ | period' _ [] = 0 |
||
+ | period' acc (x:xs) = case findIndex (x==) acc of |
||
+ | Just i -> toInteger(length acc - i) |
||
+ | Nothing -> period' (acc ++ [x]) xs |
||
+ | |||
+ | problem_64 = length $ filter odd $ map (period . fraction) [1..10000] |
||
</haskell> |
</haskell> |
||
Revision as of 16:03, 16 August 2007
Problem 61
Find the sum of the only set of six 4-digit figurate numbers with a cyclic property.
Solution:
import Data.List
triangle = [n*(n+1)`div`2 | n <- [1..]]
square = [n^2 | n <- [1..]]
pentagonal = [n*(3*n-1)`div`2 | n <- [1..]]
hexagonal = [n*(2*n-1) | n <- [1..]]
heptagonal = [n*(5*n-3)`div`2 | n <- [1..]]
octagonal = [n*(3*n-2) | n <- [1..]]
triangle4 = fourDigs triangle
square4 = fourDigs square
pentagonal4 = fourDigs pentagonal
hexagonal4 = fourDigs hexagonal
heptagonal4 = fourDigs heptagonal
octagonal4 = fourDigs octagonal
fourDigs = takeWhile (<10000) . dropWhile (<1000)
solve = do
(l1:l2:l3:l4:l5:l6:_) <- permute [triangle4, square4, pentagonal4, hexagonal4, heptagonal4, octagonal4]
a <- l1
let m = filter (g a) l2
b <- m
let n = filter (g b) l3
c <- n
let o = filter (g c) l4
d <- o
let p = filter (g d) l5
e <- p
let q = filter (g e) l6
f <- q
if g f a then return (sum [a,b,c,d,e,f]) else fail "burp"
where
g x y = x `mod` 100 == y `div` 100
permute :: [a] -> [[a]]
permute [] = [[]]
permute list = concat $ map (\(x:xs) -> map (x:) (permute xs)) (take (length list) (unfoldr (\x -> Just (x, tail x ++ [head x])) list))
problem_61 = head $ solve
Problem 62
Find the smallest cube for which exactly five permutations of its digits are cube.
Solution:
import Data.List
cubes = [(x, show $ x^3) | x <- [1..100000]]
problem_62 = f3 $ head $ head $ sortBy shf $ filter l5 $ groupBy g $ sortBy ss $ map sd cubes
where
sd (a, b) = (a, sort b)
shf a b = compare (fst $ head a) (fst $ head b)
ss a b = compare (snd a) (snd b)
g a b = (snd a) == (snd b)
l5 a = length a == 5
f3 a = (fst a)^3
Problem 63
How many n-digit positive integers exist which are also an nth power?
Solution: Since dn has at least n+1 digits for any d≥10, we need only consider 1 through 9. If dn has fewer than n digits, every higher power of d will also be too small since d < 10. We will also never have n+1 digits for our nth powers. All we have to do is check dn for each d in {1,...,9}, trying n=1,2,... and stopping when dn has fewer than n digits.
problem_63 = length . concatMap (takeWhile (\(n,p) -> n == nDigits p))
$ [powers d | d <- [1..9]]
where powers d = [(n, d^n) | n <- [1..]]
nDigits n = length (show n)
Problem 64
How many continued fractions for N ≤ 10000 have an odd period?
Solution:
import Data.List (findIndex)
fraction n = (a0, 1, (-a0)) : nextDigits n 1 (-a0)
where
a0 = firstDigit n
nextDigits n num den
| n - (den^2) == 0 = []
| otherwise = (an, den', num') : nextDigits n den' num'
where
a0 = firstDigit n
den' = (n - (den^2)) `div` num
an = (a0 + abs den) `div` den'
num' = abs den - (an * den')
firstDigit n = floor $ sqrt $ fromInteger n
period [] = 0
period xs = period' [] xs
where
period' _ [] = 0
period' acc (x:xs) = case findIndex (x==) acc of
Just i -> toInteger(length acc - i)
Nothing -> period' (acc ++ [x]) xs
problem_64 = length $ filter odd $ map (period . fraction) [1..10000]
Problem 65
Find the sum of digits in the numerator of the 100th convergent of the continued fraction for e.
Solution:
import Data.Ratio
problem_65 = dsum . numerator . contFrac . take 100 $ e
where dsum 0 = 0
dsum n = let ( d, m ) = n `divMod` 10 in m + ( dsum d )
contFrac = foldr1 (\x y -> x + 1/y)
e = 2 : 1 : insOnes [2,4..]
insOnes (x:xs) = x : 1 : 1 : insOnes xs
Problem 66
Investigate the Diophantine equation x2 − Dy2 = 1.
Solution:
problem_66 = undefined
Problem 67
Using an efficient algorithm find the maximal sum in the triangle?
Solution:
import System.Process
import IO
slurpURL url = do
(_,out,_,_) <- runInteractiveCommand $ "curl " ++ url
hGetContents out
problem_67 = do
src <- slurpURL "http://projecteuler.net/project/triangle.txt"
print $ head $ foldr1 g $ parse src
where
parse :: String -> [[Int]]
parse s = map ((map read).words) $ lines s
f x y z = x + max y z
g xs ys = zipWith3 f xs ys $ tail ys
Problem 68
What is the maximum 16-digit string for a "magic" 5-gon ring?
Solution:
problem_68 = undefined
Problem 69
Find the value of n ≤ 1,000,000 for which n/φ(n) is a maximum.
Solution:
import Data.Ratio
import Data.List
primePowerFactors n = rle (takeFactors n primes)
where rle = map (\xs -> (head xs, length xs)) . group
takeFactors n (p:ps)
| n == 1 = []
| p * p > n = [n]
| n `mod` p == 0 = p : takeFactors (n `div` p) (p:ps)
| otherwise = takeFactors n ps
eulerTotient n = product (map (\(p,i) -> p^(i-1) * (p-1)) factors)
where factors = primePowerFactors n
problem_69 = snd . maximum . map (\n -> (n % eulerTotient n, n)) $ [1..1000000]
Note: credit for arithmetic functions is due to David Amos.
Problem 70
Investigate values of n for which φ(n) is a permutation of n.
Solution:
problem_70 = undefined