Personal tools

Euler problems/61 to 70

From HaskellWiki

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

Revision as of 13:52, 22 January 2008

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 x2 − Dy2 = 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)