Project Euler 003 # Haskell (021 ~ 030)

e021.hs

{-
n의 약수들 중에서 자신을 제외한 것의 합을 d(n)으로 정의했을 때,
서로 다른 두 정수 a, b에 대하여 d(a) = b 이고 d(b) = a 이면 
a, b는 친화쌍이라 하고 a와 b를 각각 친화수(우애수)라고 합니다.

예를 들어 220의 약수는 자신을 제외하면 1, 2, 4, 5, 10, 11, 20, 22, 44, 55, 110 이므로 그 합은 d(220) = 284 입니다.
또 284의 약수는 자신을 제외하면 1, 2, 4, 71, 142 이므로 d(284) = 220 입니다.
따라서 220과 284는 친화쌍이 됩니다.

10000 이하의 친화수들을 모두 찾아서 그 합을 구하세요.

-}

import Euler

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

findFriendNumber :: Integer -> Maybe Integer
findFriendNumber n = let k = sumOfProperDivisors n
                      in if n == sumOfProperDivisors k then Just k
                                        else Nothing

test :: Integer -> Bool
test n = case findFriendNumber n of Just k -> k <= 10000 && k /= n
                                    Nothing -> False

main = print $ foldr1 (+) . filter test $ [2..10000]

e022.hs

{-
여기 5천개 이상의 영문 이름들이 들어있는 46KB짜리 텍스트 파일 names.txt 이 있습니다 (우클릭해서 다운로드 받으세요).
이제 각 이름에 대해서 아래와 같은 방법으로 점수를 매기고자 합니다.

먼저 모든 이름을 알파벳 순으로 정렬합니다.
각 이름에 대해서, 그 이름을 이루는 알파벳에 해당하는 숫자(A=1, B=2, ..., Z=26)를 모두 더합니다.
여기에 이 이름의 순번을 곱합니다.
예를 들어 "COLIN"의 경우, 알파벳에 해당하는 숫자는 3, 15, 12, 9, 14이므로 합이 53, 그리고 정렬했을 때 938번째에 오므로 최종 점수는 938 × 53 = 49714가 됩니다.

names.txt에 들어있는 모든 이름의 점수를 계산해서 더하면 얼마입니까?
-}


import Data.List (sort)

scores :: [(Char, Int)]
scores = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" [1..26]


calcScore :: String -> Int
calcScore l  =  foldr1 (+) . fmap getScore $ l
        where getScore c = snd . head . dropWhile (\x -> fst x /= c) $ scores


trim :: Char -> String -> String
trim c s = reverse . dropWhile (==c) . reverse . dropWhile (==c) $ s


splitString :: Char -> String -> [String]
splitString _ [] = []
splitString c s = let remain = dropWhile (/=c) s
                      remain' = if remain == [] then [] else tail remain
                   in takeWhile (/=c) s : (splitString c remain')


main = do
    d <- readFile "names.txt"
    let names = sort . fmap (trim '"') . splitString ',' $ d
        l = length names
        wordsPoints = fmap calcScore names
        result = foldr1 (+) . zipWith (*) wordsPoints $ [1..l]
    print result

e023.hs

{-
자신을 제외한 약수(진약수)를 모두 더하면 자기 자신이 되는 수를 완전수라고 합니다.
예를 들어 28은 1 + 2 + 4 + 7 + 14 = 28 이므로 완전수입니다.
또, 진약수의 합이 자신보다 작으면 부족수, 자신보다 클 때는 초과수라고 합니다.

12는 1 + 2 + 3 + 4 + 6 = 16 > 12 로서 초과수 중에서는 가장 작습니다.
따라서 초과수 두 개의 합으로 나타낼 수 있는 수 중 가장 작은 수는 24 (= 12 + 12) 입니다.

해석학적인 방법을 사용하면, 28123을 넘는 모든 정수는 두 초과수의 합으로 표현 가능함을 보일 수가 있습니다.
두 초과수의 합으로 나타낼 수 없는 가장 큰 수는 실제로는 이 한계값보다 작지만, 해석학적인 방법으로는 더 이상 이 한계값을 낮출 수 없다고 합니다.

그렇다면, 초과수 두 개의 합으로 나타낼 수 없는 모든 양의 정수의 합은 얼마입니까?
-}


import Euler

isOverNum :: Integer -> Bool
isOverNum n = sumOfDivisors n > 2 * n

limit = 28123

overnums = filter isOverNum [12..limit] :: [Integer]

test :: Integer -> [Integer] -> Bool
test _ [] = False
test n (x:xs) 
    | n < x = test n xs
    | elem (n - x) overnums = True
    | otherwise = test n xs

main = print $ foldr1 (+) . filter (\x -> not . test x $ takeWhile (<=x) overnums) $ [1..limit]

e024.hs

{-
어떤 대상을 순서에 따라 배열한 것을 순열이라고 합니다. 예를 들어 3124는 숫자 1, 2, 3, 4로 만들 수 있는 순열 중 하나입니다.

이렇게 만들 수 있는 모든 순열을 숫자나 문자 순으로 늘어놓은 것을 사전식(lexicographic) 순서라고 합니다.
0, 1, 2로 만들 수 있는 사전식 순열은 다음과 같습니다.

012   021   102   120   201   210
0, 1, 2, 3, 4, 5, 6, 7, 8, 9로 만들 수 있는 사전식 순열에서 1,000,000번째는 무엇입니까?
-}

import Euler
main = print $ perms 999999 "0123456789"

e025.hs

{-
피보나치 수열은 아래와 같은 점화식으로 정의됩니다.

Fn = Fn-1 + Fn-2  (단, F1 = 1, F2 = 1).
이에 따라 수열을 12번째 항까지 차례대로 계산하면 다음과 같습니다.

F1 = 1
F2 = 1
F3 = 2
F4 = 3
F5 = 5
F6 = 8
F7 = 13
F8 = 21
F9 = 34
F10 = 55
F11 = 89
F12 = 144
수열의 값은 F12에서 처음으로 3자리가 됩니다.

피보나치 수열에서 값이 처음으로 1000자리가 되는 것은 몇번째 항입니까?
-}

main = print $ (length . takeWhile (\x->(<1000) . length . show $ x) $ fib) + 1
        where fib = let fib' x y = x:(fib' y (x+y)) in fib' 1 1 

e026.hs

{-분자가 1인 분수를 단위분수라고 합니다. 분모가 2에서 10까지의 단위분수는 아래와 같습니다.


숫자 위에 찍힌 점은 순환마디를 나타내는데, 1/6의 경우 순환마디는 "6"으로 0.166666...처럼 6이 무한히 반복됨을 뜻합니다. 같은 식으로 1/7은 6자리의 순환마디(142857)를 가집니다.

d 를 1000 이하의 정수라고 할 때, 단위분수 1/d 의 순환마디가 가장 긴 수는 무엇입니까?-}

import Data.Function (on)

ldiv :: Int -> Int -> [Int] -> Int
ldiv a b ds = let i = 10 * a
                  j = i `div` b
                  r = i `mod` b
                  m = 10 * r
               in if elem m ds then length ds
                               else ldiv r b (m:ds)

test n = ldiv 1 n []

main = print $ foldr1 comp $ fmap (\x -> (x, test x)) [1..1000]
    where comp a b = if ((>) `on` snd) a b then a else b

e027.hs

{-
오일러는 다음과 같은 멋진 2차식을 제시했습니다.

n2 + n + 41
이 식의 n에다 0부터 39 사이의 숫자를 넣으면, 그 결과는 모두 소수가 됩니다.
하지만 n = 40일 때의 값 402 + 40 + 41 은 40×(40 + 1) + 41 이므로 41로 나누어지고, n = 41일 때 역시 412 + 41 + 41 이므로 소수가 아닙니다.

컴퓨터의 발전에 힘입어 n2 − 79n + 1601 이라는 엄청난 2차식이 발견되었는데, 이것은 n이 0에서 79 사이일 때 모두 80개의 소수를 만들어냅니다. 이 식의 계수의 곱은 -79 × 1601 = -126479가 됩니다.

아래와 같은 모양의 2차식이 있다고 가정했을 때,

n2 + an + b   (단 | a | < 1000, | b | < 1000)
0부터 시작하는 연속된 n에 대해 가장 많은 소수를 만들어내는 2차식을 찾아서, 그 계수 a와 b의 곱을 구하세요
-}


import Euler

type TPair = (Integer, Integer, Integer)

checkAB :: Integer -> Integer -> TPair
checkAB a b = let f x = x*x + a*x + b
               in (a, b, checkABHelper f 0)

checkABHelper :: (Integer -> Integer) -> Integer -> Integer
checkABHelper f n
    | isPrime . f $ n = checkABHelper f (n+1)
    | otherwise = n - 1

compareTPair :: TPair -> TPair -> TPair
compareTPair a@(_, _, x) b@(_,_,y) = if x > y then a else b 

checkA :: Integer -> TPair
checkA a 
    | a < 0 = let bs = [(-a)..1000]
               in foldr1 compareTPair . fmap (checkAB a) $ bs
    | otherwise = (a,0,-1)

main = let x@(a, b, _) = foldr1 compareTPair . fmap checkA $ [-1000..0]
        in 
            do 
                print x
                print $ a * b

e028.hs

{-숫자 1부터 시작해서 우측으로부터 시계방향으로 감아 5×5 행렬을 만들면 아래와 같이 됩니다.

21 22 23 24 25
20  7  8  9 10
19  6  1  2 11
18  5  4  3 12
17 16 15 14 13

여기서 대각선상의 숫자를 모두 더한 값은 101 입니다.

같은 방식으로 1001×1001 행렬을 만들었을 때, 대각선상의 숫자를 더하면 얼마가 됩니까?

----
N 번째 항은 1,2,2,2,2,4,4,4,4,6,6,6,6.... 으로 이어지는 수열의 합과 같다.
이 수열의 500번째 항까지의 합을 구한다.

-}


getN :: Integer -> Integer
getN n
    |n == 0 = 1
    |otherwise = ((div (n-1) 4) + 1) * 2 + getN (n - 1)

main = print $ foldr1 (+) . fmap getN $ [0..(4*500)]

e029.hs

{-2 ≤ a ≤ 5 이고 2 ≤ b ≤ 5인 두 정수 a, b로 만들 수 있는 ab의 모든 조합을 구하면 다음과 같습니다.

22=4,  23=8,  24=16,  25=32
32=9,  33=27,  34=81,  35=243
42=16,  43=64,  44=256,  45=1024
52=25,  53=125,  54=625,  55=3125
여기서 중복된 것을 빼고 크기 순으로 나열하면 아래와 같은 15개의 숫자가 됩니다.

4,  8,  9,  16,  25,  27,  32,  64,  81,  125,  243,  256,  625,  1024,  3125

그러면, 2 ≤ a ≤ 100 이고 2 ≤ b ≤ 100인 a, b를 가지고 만들 수 있는 ab는 중복을 제외하면 모두 몇 개입니까?-}

import Data.List (nub)
main = print $ length . nub $ [x^y | x <- [2..100], y<-[2..100]]

e030.hs

{-각 자리의 숫자를 4제곱해서 더했을 때 자기 자신이 되는 수는 놀랍게도 단 세 개밖에 없습니다.

1634 = 14 + 64 + 34 + 44
8208 = 84 + 24 + 04 + 84
9474 = 94 + 44 + 74 + 44
(1 = 14의 경우는 엄밀히 말해 합이 아니므로 제외합니다)

위의 세 숫자를 모두 더하면 1634 + 8208 + 9474 = 19316 입니다.

그렇다면, 각 자리 숫자를 5제곱해서 더했을 때 자기 자신이 되는 수들의 합은 얼마입니까?-}

{-
999999 의 경우, 각 자리 숫자를 5제곱해도 원래 값보다 작아진다. 결국 999999가 종료조건이 된다.
-}
transform :: Int -> Int -> Int
transform 0 a = a
transform n a = let x = mod n 10
                    y = div n 10
                 in transform y (a + x ^ 5)

main = print $ foldr1 (+) [x | x<-[2..999999], transform x 0 == x]

e021

Euler 모듈은 https://gist.github.com/sooop/9d57a4c275618cb0ee1f#file-e001-hs 에서 정의했음