Project Euler in Haskell #001 (001 ~ 010)

e001.hs

{-
10보다 작은 자연수 중에서 3 또는 5의 배수는 3, 5, 6, 9 이고, 이것을 모두 더하면 23입니다.

1000보다 작은 자연수 중에서 3 또는 5의 배수를 모두 더하면 얼마일까요?-}

main = print $ sum [x|x<-[1..999], x `mod` 3 == 0 || x `mod` 5 == 0]
-- 233168
-- 1.145s

e002.hs

{-피보나치 수열의 각 항은 바로 앞의 항 두 개를 더한 것이 됩니다. 1과 2로 시작하는 경우 이 수열은 아래와 같습니다.

1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
짝수이면서 4백만 이하인 모든 항을 더하면 얼마가 됩니까?-}

main = print $ sum . filter even . takeWhile (<=4000000) $ fibs 1 1
    where fibs x y = y:(fibs y (x+y))

-- 4613732
-- real    0m1.142s

e003.hs

{-어떤 수를 소수의 곱으로만 나타내는 것을 소인수분해라 하고, 이 소수들을 그 수의 소인수라고 합니다.
예를 들면 13195의 소인수는 5, 7, 13, 29 입니다.

600851475143의 소인수 중에서 가장 큰 수를 구하세요.-}

import Euler

n :: Integer
n = 600851475143

test x a
    |x `mod` a == 0 = let q = x `div` a in
                         if isPrime q then q
                         else test q a
    |otherwise = test x (a+1)

main = print $ test n 2

-- 6857
-- real    0m1.193s

e004.hs

{-앞에서부터 읽을 때나 뒤에서부터 읽을 때나 모양이 같은 수를 대칭수(palindrome)라고 부릅니다.

두 자리 수를 곱해 만들 수 있는 대칭수 중 가장 큰 수는 9009 (= 91 × 99) 입니다.

세 자리 수를 곱해 만들 수 있는 가장 큰 대칭수는 얼마입니까?-}

isPalindrome :: Integer -> Bool
isPalindrome x = let s = show x
                     r = reverse s
                in
                    s == r

main = print $ foldr1 max  [x * y | x<-range, y<-range, isPalindrome (x*y)]
    where range = [100..999]


-- 906609
-- real    0m2.367s

e005.hs

{-1 ~ 10 사이의 어떤 수로도 나누어 떨어지는 가장 작은 수는 2520입니다.

그러면 1 ~ 20 사이의 어떤 수로도 나누어 떨어지는 가장 작은 수는 얼마입니까?-}

main = print $ foldr1 lcm [1..20]
-- 232792560
-- real    0m1.339s

e006.hs

{-1부터 10까지 자연수를 각각 제곱해 더하면 다음과 같습니다 (제곱의 합).

12 + 22 + ... + 102 = 385
1부터 10을 먼저 더한 다음에 그 결과를 제곱하면 다음과 같습니다 (합의 제곱).

(1 + 2 + ... + 10)2 = 552 = 3025
따라서 1부터 10까지 자연수에 대해 "합의 제곱"과 "제곱의 합" 의 차이는 3025 - 385 = 2640 이 됩니다.

그러면 1부터 100까지 자연수에 대해 "합의 제곱"과 "제곱의 합"의 차이는 얼마입니까?-}


main = let w = foldr1 (+) [1..100]
           h = foldr1 (+) [x*x | x<-[1..100]]
       in
       print $ w*w - h


-- 25164150
-- real    0m1.097s

e007.hs

{-소수를 크기 순으로 나열하면 2, 3, 5, 7, 11, 13, ... 과 같이 됩니다.

이 때 10,001번째의 소수를 구하세요.-}

isPrime :: (Integral a) => a -> Bool 
isPrime 2 = True
isPrime 3 = True
isPrime n
    |n < 2 = False
    |n `mod` 2 == 0 = False
    |n `mod` 3 == 0 = False
    |n < 19 = True
    |otherwise = let limit = floor . sqrt $ (fromIntegral n) in
                     isPrimeHelper n 5 limit


isPrimeHelper :: (Integral a) => a -> a -> a -> Bool
isPrimeHelper n k l
    | k > l = True
    | n `mod` k == 0 = False
    | n `mod` (k+2) == 0 = False
    | otherwise = isPrimeHelper n (k+6) l

main = print $ last . take 10001 . filter isPrime $ [2..]

-- 104743
-- real    0m3.938s

e008.hs

{-다음은 연속된 1000자리 숫자입니다 (읽기 좋게 50자리씩 잘라놓음).

73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450

여기서 붉게 표시된 71112의 경우 7, 1, 1, 1, 2 각 숫자를 모두 곱하면 14가 됩니다.

이런 식으로 맨 처음 (7 × 3 × 1 × 6 × 7 = 882) 부터 맨 끝 (6 × 3 × 4 × 5 × 0 = 0) 까지 5자리 숫자들의 곱을 구할 수 있습니다.
이렇게 구할 수 있는 5자리 숫자의 곱 중에서 가장 큰 값은 얼마입니까?-}


string :: String
string = "7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450"

parseString :: [String] -> [Char] -> [String]
parseString xs ys
    | length ys < 5 = xs
    | otherwise = parseString ((take 5 ys):xs) (tail ys)

process :: String -> Int
process xs = foldr1 (*) . map (read . (:"")) $ xs

main = print $ foldr1 max . map process . parseString [] $ string

-- 40824
-- real    0m1.245s

e009.hs

{-세 자연수 a, b, c 가 피타고라스 정리 a2 + b2 = c2 를 만족하면 피타고라스 수라고 부릅니다 (여기서 a < b < c ).
예를 들면 32 + 42 = 9 + 16 = 25 = 52이므로 3, 4, 5는 피타고라스 수입니다.

a + b + c = 1000 인 피타고라스 수 a, b, c는 한 가지 뿐입니다. 이 때, a × b × c 는 얼마입니까?-}


d :: [(Int, Int)]
d = [(a, b) | a<-[1..999], b<-[2..1000], a < b]

test :: (Int, Int) -> Bool
test (a, b) = let c = 1000 - a - b in
                  c*c == a*a + b*b

main = print $ result . head . filter test $ d
    where result (a,b) = a * b * (1000 - a - b)

-- 31875000
-- real    0m1.727s

e010.hs

{-10 이하의 소수를 모두 더하면 2 + 3 + 5 + 7 = 17 이 됩니다.

이백만(2,000,000) 이하 소수의 합은 얼마입니까?-}


import Euler
main = print $ foldr1 (+) . takeWhile (<=2000000) . filter isPrime $ [1..]

-- 142913828922 (by wolframalpha)

-- 142913828922
-- real    1m23.006s

-- 142913828922
-- real    0m5.418s when compiled.

Euler.hs

module Euler (
    isPrime,
    isPalindrome,
    isPalindromeString,
    reversedNumber,
    numberOfDivisors,
    numberOfDivisors',
    sumOfDivisors,
    sumOfProperDivisors,
    factorize,
    factorial,
    perms,
    isPerms,
    split
) where 


import qualified Data.List as L (sort)

-- prime number check
isPrime :: Integer -> Bool
isPrime 2 = True
isPrime 3 = True
isPrime n 
    | n < 2 = False
    | mod n 2 == 0 = False
    | mod n 3 == 0 = False
    | n < 9 = True
    | otherwise = let k = 5
                      l = floor . sqrt . fromIntegral $ n
                   in
                    isPrimeHelper n k l


isPrimeHelper :: Integer -> Integer -> Integer -> Bool
isPrimeHelper n k l 
    | k >= l = True
    | mod n k == 0 = False
    | mod n (k + 2) == 0 = False
    | otherwise = isPrimeHelper n (k+6) l


isPalindrome :: Integer -> Bool
-- This needs revered number
isPalindrome n = n == (reversedNumber n)


isPalindromeString :: String -> Bool
isPalindromeString s = s == reverse s


reversedNumber :: Integer -> Integer
reversedNumber n = read . reverse . show $ n


square :: Integer -> Integer
square n = toInteger . floor . sqrt . fromIntegral $ n


numberOfDivisors :: Integer -> Integer
numberOfDivisors n  = numberOfDivisorsHelper 0 1 n
numberOfDivisorsHelper c k n 
    |k > square n = let l = square n in if l * l == n then c - 1 else c  
    |otherwise = if (mod n k) == 0 then numberOfDivisorsHelper (c+1) (k+1) n else numberOfDivisorsHelper c (k+1) n

empty :: [a] -> Bool
empty [] = True
empty _ = False

numberOfDivisors' :: Integer -> Integer
numberOfDivisors' x = let ys = factorize x
                       in case empty ys of True -> 0
                                           _ -> foldr1 (*) . fmap ((+1) . snd) $ ys




sumOfProperDivisors :: Integer -> Integer
sumOfProperDivisors n = sumOfDivisors n - n



sumOfDivisors :: Integer -> Integer
sumOfDivisors n = let s = 1 + n 
                      l = toInteger . floor . sqrt . fromIntegral $ n
                  in sumOfDivisorsHelper n s 2 



sumOfDivisorsHelper :: Integer -> Integer -> Integer -> Integer
sumOfDivisorsHelper n s k
    | k > l = if l * l == n then s - n else s
    | otherwise = if mod n k == 0 then sumOfDivisorsHelper n (s + k + (div n k)) (k + 1)
                                  else sumOfDivisorsHelper n s (k + 1)
        where l = square n


primeDivisors :: Integer -> [Integer]
primeDivisors n = reverse . fmap fst $ factorize n


type Pair = (Integer, Integer)
type Pairs = [Euler.Pair]

factorize :: Integer -> Pairs
factorize n
    | n < 2 = []
    | otherwise = factorizeHelper [] n


factorizeHelper :: Pairs -> Integer -> Pairs
factorizeHelper xs 1 = xs
factorizeHelper (x:xs) n =  let k = tryDivide n in
                                if (fst x) == k
                                then factorizeHelper ((k, (snd x) + 1):xs) (div n k)
                                else factorizeHelper ((k, 1):x:xs) (div n k)
factorizeHelper [] n = let k = tryDivide n in factorizeHelper [(k, 1)] (div n k)
 

tryDivide :: Integer -> Integer
tryDivide n
    | n `mod` 2 == 0 = 2
    | n `mod` 3 == 0 = 3
    | otherwise = tryDivideHelper 5 n 


tryDivideHelper ::  Integer -> Integer -> Integer
tryDivideHelper k n     
    | let l = floor . sqrt . fromIntegral $ n in k > l = n     
    | mod n k == 0 = k
    | mod n (k + 2) == 0 = k + 2
    | otherwise = tryDivideHelper (k+6) n



isPerms :: Integer -> Integer -> Bool
isPerms a b = let s = show a
                  t = show b
               in L.sort s == L.sort t


factorial :: Integer -> Integer
factorial n = if n < 2 then 1 else foldr (*) 1 [1..n]


perms :: Integer -> [a] -> [a]
perms 0 xs = xs
perms _ [] = []
perms _ (x:[]) = [x]
perms n xs = let c = toInteger $ length xs
                 k = mod n $ factorial c
                 m = factorial (c - 1)
                 q = div k $ m
                 r = mod k $ m
                 d = split q xs
              in case d of Just (a, b) -> [a] ++ (perms r b)
                           Nothing -> []


-- split function is used for perms
split :: Integer -> [a] -> Maybe (a, [a])
split _ [] = Nothing
split n (x:xs) 
    | n < 0 = Nothing
    | n >= (toInteger $ length (x:xs)) = Nothing
    | otherwise = let l = x:xs 
                      heading = take (fromIntegral n) $ l
                      e = head . drop (fromIntegral n) $ l
                      remaining = heading ++ (tail . drop (fromIntegral n) $ l)
                   in Just (e, remaining)