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=problems&id=61 Problem 61] ==
+
Do them on your own!
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!