Euler problems/71 to 80
Listing reduced proper fractions in ascending order of size.
import Data.Ratio (Ratio, (%), numerator) fractions :: [Ratio Integer] fractions = [f | d <- [1..1000000], let n = (d * 3) `div` 7, let f = n%d, f /= 3%7] problem_71 :: Integer problem_71 = numerator $ maximum $ fractions
How many elements would be contained in the set of reduced proper fractions for d ≤ 1,000,000?
Using the Farey Sequence method, the solution is the sum of phi (n) from 1 to 1000000.
See problem 69 for phi function
problem_72 = sum [phi x|x <- [1..1000000]]
How many fractions lie between 1/3 and 1/2 in a sorted set of reduced proper fractions?
import Data.Ratio (Ratio, (%), numerator, denominator) median :: Ratio Int -> Ratio Int -> Ratio Int median a b = ((numerator a) + (numerator b)) % ((denominator a) + (denominator b)) count :: Ratio Int -> Ratio Int -> Int count a b | d > 10000 = 1 | otherwise = count a m + count m b where m = median a b d = denominator m problem_73 :: Int problem_73 = (count (1%3) (1%2)) - 1
Determine the number of factorial chains that contain exactly sixty non-repeating terms.
import Data.Array (Array, array, (!), elems) import Data.Char (ord) import Data.List (foldl1') import Prelude hiding (cycle) fact :: Integer -> Integer fact 0 = 1 fact n = foldl1' (*) [1..n] factorDigits :: Array Integer Integer factorDigits = array (0,2177281) [(x,n)|x <- [0..2177281], let n = sum $ map (\y -> fact (toInteger $ ord y - 48)) $ show x] cycle :: Integer -> Integer cycle 145 = 1 cycle 169 = 3 cycle 363601 = 3 cycle 1454 = 3 cycle 871 = 2 cycle 45361 = 2 cycle 872 = 2 cycle 45362 = 2 cycle _ = 0 isChainLength :: Integer -> Integer -> Bool isChainLength len n | len < 0 = False | t = isChainLength (len-1) n' | otherwise = (len - c) == 0 where c = cycle n t = c == 0 n' = factorDigits ! n -- | strict version of the maximum function maximum' :: (Ord a) => [a] -> a maximum'  = undefined maximum' [x] = x maximum' (a:b:xs) = let m = max a b in m `seq` maximum' (m : xs) problem_74 :: Int problem_74 = length $ filter (\(_,b) -> isChainLength 59 b) $ zip ([0..] :: [Integer]) $ take 1000000 $ elems factorDigits
Find the number of different lengths of wire can that can form a right angle triangle in only one way.
Solution: This is only slightly harder than problem 39. The search condition is simpler but the search space is larger.
problem_75 = length . filter ((== 1) . length) $ group perims where perims = sort [scale*p | p <- pTriples, scale <- [1..10^6 `div` p]] pTriples = [p | n <- [1..1000], m <- [n+1..1000], even n || even m, gcd n m == 1, let a = m^2 - n^2, let b = 2*m*n, let c = m^2 + n^2, let p = a + b + c, p <= 10^6]
How many different ways can one hundred be written as a sum of at least two positive integers?
Calculated using Euler's pentagonal formula and a list for memoization.
partitions = 1 : [sum [s * partitions !! p| (s,p) <- zip signs $ parts n]| n <- [1..]] where signs = cycle [1,1,(-1),(-1)] suite = map penta $ concat [[n,(-n)]|n <- [1..]] penta n = n*(3*n - 1) `div` 2 parts n = takeWhile (>= 0) [n-x| x <- suite] problem_76 = partitions !! 100 - 1
What is the first value which can be written as the sum of primes in over five thousand different ways?
Brute force but still finds the solution in less than one second.
combinations acc 0 _ = [acc] combinations acc _  =  combinations acc value prim@(x:xs) = combinations (acc ++ [x]) value' prim' ++ combinations acc value xs where value' = value - x prim' = dropWhile (>value') prim problem_77 :: Integer problem_77 = head $ filter f [1..] where f n = (length $ combinations  n $ takeWhile (<n) primes) > 5000
Investigating the number of ways in which coins can be separated into piles.
Same as problem 76 but using array instead of lists to speedup things.
import Data.Array partitions :: Array Int Integer partitions = array (0,1000000) $ (0,1) : [(n,sum [s * partitions ! p| (s,p) <- zip signs $ parts n])| n <- [1..1000000]] where signs = cycle [1,1,(-1),(-1)] suite = map penta $ concat [[n,(-n)]|n <- [1..]] penta n = n*(3*n - 1) `div` 2 parts n = takeWhile (>= 0) [n-x| x <- suite] problem_78 :: Int problem_78 = head $ filter (\x -> (partitions ! x) `mod` 1000000 == 0) [1..]
By analysing a user's login attempts, can you determine the secret numeric passcode?
A bit ugly but works fine
import Data.List problem_79 :: String -> String problem_79 file = map fst $ sortBy (\(_,a) (_,b) -> compare (length b) (length a)) $ zip digs order where nums = lines file digs = map head $ group $ sort $ filter (\c -> c >= '0' && c <= '9') file prec = concatMap (\(x:y:z:_) -> [[x,y],[y,z],[x,z]]) nums order = map (\n -> map head $ group $ sort $ map (\(_:x:_) -> x) $ filter (\(x:_) -> x == n) prec) digs
10 Problem 80
Calculating the digital sum of the decimal digits of irrational square roots.
problem_80 = undefined