Euler problems/71 to 80
(Solution to prob75 was wrong. Replaced it.)
(replaced solution to problem 80 with one that a) is complete, b) works, c) doesn't look dreadful)
Revision as of 13:37, 22 July 2008
Listing reduced proper fractions in ascending order of size.
-- http://mathworld.wolfram.com/FareySequence.html import Data.Ratio ((%), numerator,denominator) fareySeq a b |da2<=10^6=fareySeq a1 b |otherwise=na where na=numerator a nb=numerator b da=denominator a db=denominator b a1=(na+nb)%(da+db) da2=denominator a1 problem_71=fareySeq (0%1) (3%7)
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.
groups=1000 eulerTotient n = product (map (\(p,i) -> p^(i-1) * (p-1)) factors) where factors = fstfac n fstfac x = [(head a ,length a)|a<-group$primeFactors x] p72 n= sum [eulerTotient x|x <- [groups*n+1..groups*(n+1)]] problem_72 = sum [p72 x|x <- [0..999]]
How many fractions lie between 1/3 and 1/2 in a sorted set of reduced proper fractions?
If you haven't done so already, read about Farey sequences in Wikipedia http://en.wikipedia.org/wiki/Farey_sequence, where you will learn about mediants. Then divide and conquer. The number of Farey ratios between (a, b) is 1 + the number between (a, mediant a b) + the number between (mediant a b, b). Henrylaxen 2008-03-04
import Data.Ratio mediant :: (Integral a) => Ratio a -> Ratio a -> Ratio a mediant f1 f2 = (numerator f1 + numerator f2) % (denominator f1 + denominator f2) fareyCount :: (Integral a, Num t) => a -> (Ratio a, Ratio a) -> t fareyCount n (a,b) = let c = mediant a b in if (denominator c > n) then 0 else 1 + (fareyCount n (a,c)) + (fareyCount n (c,b)) problem_73 :: Integer problem_73 = fareyCount 10000 (1%3,1%2)
Determine the number of factorial chains that contain exactly sixty non-repeating terms.
import Data.List explode 0 =  explode n = n `mod` 10 : explode (n `quot` 10) chain 2 = 1 chain 1 = 1 chain 145 = 1 chain 40585 = 1 chain 169 = 3 chain 363601 = 3 chain 1454 = 3 chain 871 = 2 chain 45361 = 2 chain 872 = 2 chain 45362 = 2 chain x = 1 + chain (sumFactDigits x) makeIncreas 1 minnum = [[a]|a<-[minnum..9]] makeIncreas digits minnum = [a:b|a<-[minnum ..9],b<-makeIncreas (digits-1) a] p74= sum[div p6 $countNum a| a<-tail$makeIncreas 6 1, let k=digitToN a, chain k==60 ] where p6=facts!! 6 sumFactDigits = foldl' (\a b -> a + facts !! b) 0 . explode factorial n = if n == 0 then 1 else n * factorial (n - 1) digitToN = foldl' (\a b -> 10*a + b) 0 .dropWhile (==0) facts = scanl (*) 1 [1..9] countNum xs=ys where ys=product$map (factorial.length)$group xs problem_74= length[k|k<-[1..9999],chain k==60]+p74 test = print $ [a|a<-tail$makeIncreas 6 0,let k=digitToN a,chain k==60]
Find the number of different lengths of wire can that can form a right angle triangle in only one way.
import Data.Array triangs :: [Int] triangs = [p | n <- [2..1000], m <- [1..n-1], gcd m n == 1, odd (m+n), let p = 2 * (n^2 + m*n), p <= 2*10^6] problem_75 :: Int problem_75 = length $ filter (\(_, c) -> c == 1) $ assocs $ (\ns -> accumArray (+) 0 (1, 2*10^6) [(n, 1) | n <- ns, inRange (1, 2*10^6) n]) $ concatMap (\n -> takeWhile (<=2*10^6) [n,2*n..]) triangs
How many different ways can one hundred be written as a sum of at least two positive integers?
Here is a simpler solution: For each n, we create the list of the number of partitions of n whose lowest number is i, for i=1..n. We build up the list of these lists for n=0..100.
build x = (map sum (zipWith drop [0..] x) ++ ) : x problem_76 = (sum $ head $ iterate build  !! 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.
counter = foldl (\without p -> let (poor,rich) = splitAt p without with = poor ++ zipWith (+) with rich in with ) (1 : repeat 0) problem_77 = find ((>5000) . (ways !!)) $ [1..] where ways = counter $ take 100 primes
Investigating the number of ways in which coins can be separated into piles.
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?
import Data.Char (digitToInt, intToDigit) import Data.Graph (buildG, topSort) import Data.List (intersect) p79 file= (+0)$read . intersect graphWalk $ usedDigits where usedDigits = intersect "0123456789" $ file edges = concat . map (edgePair . map digitToInt) . words $ file graphWalk = map intToDigit . topSort . buildG (0, 9) $ edges edgePair [x, y, z] = [(x, y), (y, z)] edgePair _ = undefined problem_79 = do f<-readFile "keylog.txt" print $p79 f
10 Problem 80
Calculating the digital sum of the decimal digits of irrational square roots.
This solution uses binary search to find the square root of a large Integer:
import Data.Char (digitToInt) intSqrt :: Integer -> Integer intSqrt n = bsearch 1 n where bsearch l u = let m = (l+u) `div` 2 m2 = m^2 in if u <= l then m else if m2 < n then bsearch (m+1) u else bsearch l m problem_80 :: Int problem_80 = sum [f r | a <- [1..100], let x = a * e, let r = intSqrt x, r*r /= x] where e = 10^202 f = sum . take 100 . map digitToInt . show