Difference between revisions of "Euler problems/61 to 70"
m (Corrected the links to the Euler project) |
|||
Line 5: | Line 5: | ||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
+ | 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) |
||
+ | |||
+ | filterCommon _ [] = [] |
||
+ | filterCommon [] _ = [] |
||
+ | filterCommon a@(x:xs) b@(y:ys) |
||
+ | | x == y = x : filterCommon xs ys |
||
+ | | x > y = filterCommon a (dropWhile (<x) ys) |
||
+ | | otherwise = filterCommon (dropWhile (<y) xs) b |
||
+ | |||
+ | 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)) |
||
+ | |||
⚫ | |||
</haskell> |
</haskell> |
||
Revision as of 14:10, 13 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)
filterCommon _ [] = []
filterCommon [] _ = []
filterCommon a@(x:xs) b@(y:ys)
| x == y = x : filterCommon xs ys
| x > y = filterCommon a (dropWhile (<x) ys)
| otherwise = filterCommon (dropWhile (<y) xs) b
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:
problem_62 = undefined
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:
problem_64 = undefined
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:
problem_69 = undefined
Problem 70
Investigate values of n for which φ(n) is a permutation of n.
Solution:
problem_70 = undefined