Difference between revisions of "Euler problems/71 to 80"

From HaskellWiki
Jump to: navigation, search
(rv: vandalism)
Line 38: Line 38:
   
 
Solution:
 
Solution:
<haskell>
 
  +
This was my code, published here without my permission nor any attribution, shame on whoever put it here. [[User:Daniel.is.fischer|Daniel.is.fischer]]
import Data.Array
 
twix k = crude k - fd2 - sum [ar!(k `div` m) | m <- [3 .. k `div` 5], odd m]
 
where
 
fd2 = crude (k `div` 2)
 
ar = array (5,k `div` 3) $
 
((5,1):[(j, crude j - sum [ar!(j `div` m) | m <- [2 .. j `div` 5]])
 
| j <- [6 .. k `div` 3]])
 
crude j =
 
m*(3*m+r-2) + s
 
where
 
(m,r) = j `divMod` 6
 
s = case r of
 
5 -> 1
 
_ -> 0
 
 
problem_73 = twix 10000
 
</haskell>
 
   
 
== [http://projecteuler.net/index.php?section=view&id=74 Problem 74] ==
 
== [http://projecteuler.net/index.php?section=view&id=74 Problem 74] ==

Revision as of 23:05, 23 February 2008

Problem 71

Listing reduced proper fractions in ascending order of size.

Solution:

-- 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)

Problem 72

How many elements would be contained in the set of reduced proper fractions for d ≤ 1,000,000?

Solution:

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]]

Problem 73

How many fractions lie between 1/3 and 1/2 in a sorted set of reduced proper fractions?

Solution: This was my code, published here without my permission nor any attribution, shame on whoever put it here. Daniel.is.fischer

Problem 74

Determine the number of factorial chains that contain exactly sixty non-repeating terms.

Solution:

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]

Problem 75

Find the number of different lengths of wire can that can form a right angle triangle in only one way.

Solution:

import Data.Array
 
triplets = 
    [p | 
    n <- [2..706],
    m <- [1..n-1],
    gcd m n == 1, 
    let p = 2 * (n^2 + m*n),
    odd (m + n),
    p <= 10^6
    ]
 
hist bnds ns = 
    accumArray (+) 0 bnds [(n, 1) |
        n <- ns,
        inRange bnds n
        ]
 
problem_75 = 
    length $ filter (\(_,b) -> b == 1) $ assocs arr
    where
    arr = hist (12,10^6) $ concatMap multiples triplets
    multiples n = takeWhile (<=10^6) [n, 2*n..]

Problem 76

How many different ways can one hundred be written as a sum of at least two positive integers?

Solution:

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) ++ [1]) : x
problem_76 = (sum $ head $ iterate build [] !! 100) - 1

Problem 77

What is the first value which can be written as the sum of primes in over five thousand different ways?

Solution:

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

Problem 78

Investigating the number of ways in which coins can be separated into piles.

Solution:

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..]

Problem 79

By analysing a user's login attempts, can you determine the secret numeric passcode?

Solution:

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

Problem 80

Calculating the digital sum of the decimal digits of irrational square roots.

Solution:

import Data.Char
problem_80=
    sum [f x |
    a <- [1..100],
    x <- [intSqrt $ a * t],
    x * x /= a * t
    ]
    where
    t=10^202
    f = (sum . take 100 . map (flip (-) (ord '0') .ord) . show)