Personal tools

Euler problems/61 to 70

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
Line 144: Line 144:
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_69 = undefined
+
import Data.Ratio
  +
import Data.List
  +
  +
primePowerFactors n = rle (takeFactors n primes)
  +
where rle = map (\xs -> (head xs, length xs)) . group
  +
takeFactors n (p:ps)
  +
| n == 1 = []
  +
| p * p > n = [n]
  +
| n `mod` p == 0 = p : takeFactors (n `div` p) (p:ps)
  +
| otherwise = takeFactors n ps
  +
  +
eulerTotient n = product (map (\(p,i) -> p^(i-1) * (p-1)) factors)
  +
where factors = primePowerFactors n
  +
  +
problem_69 = snd . maximum . map (\n -> (n % eulerTotient n, n)) $ [1..1000000]
 
</haskell>
 
</haskell>
  +
  +
Note: credit for arithmetic functions is due to [http://www.polyomino.f2s.com/ David Amos].
   
 
== [http://projecteuler.net/index.php?section=view&id=70 Problem 70] ==
 
== [http://projecteuler.net/index.php?section=view&id=70 Problem 70] ==

Revision as of 22:06, 15 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)
 
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:

import Data.List
 
cubes = [(x, show $ x^3) | x <- [1..100000]]
 
problem_62 = f3 $ head $ head $ sortBy shf $ filter l5 $ groupBy g $ sortBy ss $ map sd cubes
    where
        sd (a, b) = (a, sort b)
        shf a b = compare (fst $ head a) (fst $ head b)
        ss a b = compare (snd a) (snd b)
        g a b = (snd a) == (snd b)
        l5 a = length a == 5
        f3 a = (fst a)^3

3 Problem 63

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

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

import Data.Ratio
import Data.List
 
primePowerFactors n = rle (takeFactors n primes)
    where rle = map (\xs -> (head xs, length xs)) . group
          takeFactors n (p:ps)
            | n == 1         = []
            | p * p > n      = [n]
            | n `mod` p == 0 = p : takeFactors (n `div` p) (p:ps)
            | otherwise      = takeFactors n ps
 
eulerTotient n = product (map (\(p,i) -> p^(i-1) * (p-1)) factors)
    where factors = primePowerFactors n
 
problem_69 = snd . maximum . map (\n -> (n % eulerTotient n, n)) $ [1..1000000]

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:

problem_70 = undefined