Difference between revisions of "Euler problems/61 to 70"
Jump to navigation
Jump to search
Marypoppins (talk | contribs) |
Marypoppins (talk | contribs) |
||
| Line 1: | Line 1: | ||
| + | Do them on your own! |
||
| − | == [http://projecteuler.net/index.php?section=problems&id=61 Problem 61] == |
||
| − | Find the sum of the only set of six 4-digit figurate numbers with a cyclic property. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | 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] |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=problems&id=62 Problem 62] == |
||
| − | Find the smallest cube for which exactly five permutations of its digits are cube. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | 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 |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=problems&id=63 Problem 63] == |
||
| − | How many n-digit positive integers exist which are also an nth power? |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | problem_63=length[x^y|x<-[1..9],y<-[1..22],y==(length$show$x^y)] |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=problems&id=64 Problem 64] == |
||
| − | How many continued fractions for N ≤ 10000 have an odd period? |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | 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) |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=problems&id=65 Problem 65] == |
||
| − | Find the sum of digits in the numerator of the 100th convergent of the continued fraction for e. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | 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 |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=problems&id=66 Problem 66] == |
||
| − | Investigate the Diophantine equation x<sup>2</sup> − Dy<sup>2</sup> = 1. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | 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) |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=problems&id=67 Problem 67] == |
||
| − | Using an efficient algorithm find the maximal sum in the triangle? |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | 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) |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=problems&id=68 Problem 68] == |
||
| − | What is the maximum 16-digit string for a "magic" 5-gon ring? |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | 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 ] |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=problems&id=69 Problem 69] == |
||
| − | Find the value of n ≤ 1,000,000 for which n/φ(n) is a maximum. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | {-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 |
||
| − | ] |
||
| − | </haskell> |
||
| − | |||
| − | Note: credit for arithmetic functions is due to [http://www.polyomino.f2s.com/ David Amos]. |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=problems&id=70 Problem 70] == |
||
| − | Investigate values of n for which φ(n) is a permutation of n. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | 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) |
||
| − | </haskell> |
||
Revision as of 21:53, 29 January 2008
Do them on your own!