# Euler problems/61 to 70

### From HaskellWiki

## 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 permute [] = [[]] permute xs = concatMap (\x -> map (x:) $ permute $ delete x xs) xs figurates n xs = extract $ concatMap (gather (map poly xs)) $ map (:[]) $ poly n where gather [xs] (v:vs) = let v' = match xs v in if v' == [] then [] else map (:v:vs) v' gather (xs:xss) (v:vs) = let v' = match xs v in if v' == [] then [] else concatMap (gather xss) $ map (:v:vs) v' match xs (_,v) = let p = (v `mod` 100)*100 in sublist (p+10,p+100) xs sublist (s,e) = takeWhile (\(_,x) -> x<e) . dropWhile (\(_,x) -> x<s) link ((_,x):xs) = x `mod` 100 == (snd $ last xs) `div` 100 diff (x:y:xs) = if fst x /= fst y then diff (y:xs) else False diff [x] = True extract = filter diff . filter link poly m = [(n, x) | (n, x) <- zip [1..] $ takeWhile (<10000) $ scanl (+) 1 [m-1,2*m-3..], 1010 < x, x `mod` 100 > 9] problem_61 = sum $ map snd $ head $ concatMap (figurates 3) $ permute [4..8]

## 2 Problem 62

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

Solution:

import Data.List import Data.Maybe a = map (^3) [0..10000] b = map (sort . show) a c = (filter ((==5) . length) . group . sort) b d = findIndex (==(head (head c))) b problem_62 = (toInteger (fromJust d))^3

## 3 Problem 63

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

Solution:

problem_63=length[x^y|x<-[1..9],y<-[1..22],y==(length$show$x^y)]

## 4 Problem 64

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

Solution:

import Data.List problem_64 =length $ filter id $ map solve $ [2..9999] \\ (map (^2) [2..100]) solve n = even $ length $ cont n 0 1 cont :: Int -> Int -> Int -> [Int] cont r n d = m : rest where m = truncate ((sqrt (fromIntegral r) + fromIntegral n ) / fromIntegral d) a = n - d * m rest = if d == 1 && n /= 0 then [] else cont r (-a) ((r - a ^ 2) `div` d)

## 5 Problem 65

Find the sum of digits in the numerator of the 100th convergent of the continued fraction for e.

Solution:

import Data.Char import Data.Ratio e = [2] ++ concat [ [1, 2*i, 1] | i <- [1..] ] fraction [x] = x%1 fraction (x:xs) = x%1 + 1/(fraction xs) problem_65 = sum $ map digitToInt $ show $ numerator $ fraction $ take 100 e

## 6 Problem 66

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

Solution:

intSqrt :: Integral a => a -> a intSqrt n | n < 0 = error "intSqrt: negative n" | otherwise = f n where f x = if y < x then f y else x where y = (x + (n `quot` x)) `quot` 2 problem_66 = snd$maximum [ (x,d) | d <- [1..1000], let b = intSqrt d, b*b /= d, -- d can't be a perfect square let (x,_) = pell d b b ] pell d wd b = piter d wd b 0 1 0 1 1 0 piter d wd b i c l k m n | cn == 1 = (x, y) | otherwise = piter d wd bn (i+1) cn k u n v where yb = (wd+b) `div` c bn = yb*c-b cn = (d-(bn*bn)) `div` c yn | i == 0 = wd | otherwise = yb u = k*yn+l -- u/v is the i-th convergent of sqrt(d) v = n*yn+m (x,y) | odd (i+1) = (u*u+d*v*v, 2*u*v) | otherwise = (u,v)

## 7 Problem 67

Using an efficient algorithm find the maximal sum in the triangle?

Solution:

problem_67 = readFile "triangle.txt" >>= print . solve . parse parse = map (map read . words) . lines solve = head . foldr1 step step [] [z] = [z] step (x:xs) (y:z:zs) = x + max y z : step xs (z:zs)

## 8 Problem 68

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

Solution:

import Data.List permute [] = [[]] permute list = concat $ map (\(x:xs) -> map (x:) (permute xs)) (take (length list) (unfoldr (\x -> Just (x, tail x ++ [head x])) list)) problem_68 = maximum $ map (concat . map show) poel where gon68 = [1..10] knip = (length gon68) `div` 2 (is,es) = splitAt knip gon68 extnodes = map (\x -> [head es]++x) $ permute $ tail es intnodes = map (\(p:ps) -> zipWith (\ x y -> [x]++[y]) (p:ps) (ps++[p])) $ permute is poel = [ concat hs | hs <- [ zipWith (\x y -> [x]++y) uitsteeksels organen | uitsteeksels <- extnodes, organen <- intnodes ], let subsom = map (sum) hs, length (nub subsom) == 1 ]

## 9 Problem 69

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

Solution:

{-phi(n) = n*(1-1/p1)*(1-1/p2)*...*(1-1/pn) n/phi(n) = 1/(1-1/p1)*(1-1/p2)*...*(1-1/pn) (1-1/p) will be minimal for a small p and 1/(1-1/p) will then be maximal -} primes=[2,3,5,7,11,13,17,19,23] problem_69= maximum [c| a<-[1..length primes], let b=take a primes, let c=product b, c<10^6 ]

Note: credit for arithmetic functions is due to David Amos.

## 10 Problem 70

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

Solution:

import Data.List isPerm a b = (show a) \\ (show b)==[] flsqr n x=x<(floor.sqrt.fromInteger) n pairs n1 = maximum[m|a<-gena ,b<-genb,let m=a*b,n>m,isPerm m$ m-a-b+1] where n=fromInteger n1 gena = dropWhile (flsqr n)$ takeWhile (flsqr (2*n)) primes genb = dropWhile (flsqr (div n 2))$ takeWhile (flsqr n) primes problem_70= pairs (10^7)