# Euler problems/61 to 70

### From HaskellWiki

m (Corrected the links to the Euler project) |
|||

Line 5: | Line 5: | ||

Solution: | Solution: | ||

<haskell> | <haskell> | ||

− | problem_61 = | + | 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 | ||

</haskell> | </haskell> | ||

## Revision as of 14:10, 13 August 2007

## Contents |

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

## 2 Problem 62

Find the smallest cube for which exactly five permutations of its digits are cube.

Solution:

problem_62 = undefined

## 3 Problem 63

How many n-digit positive integers exist which are also an nth power?

Solution:
Since d^{n} has at least n+1 digits for any d≥10, we need only consider 1 through 9. If d^{n} 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 d^{n} for each d in {1,...,9}, trying n=1,2,... and stopping when d^{n} 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)

## 4 Problem 64

How many continued fractions for N ≤ 10000 have an odd period?

Solution:

problem_64 = undefined

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

## 6 Problem 66

Investigate the Diophantine equation x^{2} − Dy^{2} = 1.

Solution:

problem_66 = undefined

## 7 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

## 8 Problem 68

What is the maximum 16-digit string for a "magic" 5-gon ring?

Solution:

problem_68 = undefined

## 9 Problem 69

Find the value of n ≤ 1,000,000 for which n/φ(n) is a maximum.

Solution:

problem_69 = undefined

## 10 Problem 70

Investigate values of n for which φ(n) is a permutation of n.

Solution:

problem_70 = undefined