Project Euler 005 # haskell (041~050)

e041.hs

{-

1부터 n까지의 숫자를 하나씩만 써서 만든 n자리 숫자를 팬디지털(pandigital)이라고 부릅니다.
2143은 4자리 팬디지털인데, 이 수는 동시에 소수이기도 합니다.

n자리 팬디지털 소수 중에서 가장 큰 수는 무엇입니까?

::::

8, 9 자리 팬디지털 수 중에서는 소수가 없으므로 7자리부터 시작해서 찾아본다. 
모든 수를 내려가면서 검사하기보다는 순열 함수를 이용해서
팬디지털 숫자만 검사한다. 


-}

import Euler (perms, isPrime, factorial)

panValue :: String
panValue = "7654321"

limit :: Integer
limit = factorial 7

test :: Integer -> Integer
test n 
    | n < limit = let d = read . perms n $ panValue :: Integer
                   in if isPrime d then d else test (n+1)
    | otherwise = 0

main = print $ test 0
    



{-
7652413                     
                            
real    0m1.190s            
user    0m0.031s            
sys     0m0.031s
-}

e042.hs

{-

n번째 삼각수는 tn = ½ n (n + 1) 이라는 식으로 구할 수 있는데, 처음 10개는 아래와 같습니다.

1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

어떤 영어 단어에 대해서, 각 철자의 알파벳 순서(A=1, B=2, ..., Z=26)를 모두 더한 값을 '단어값'이라 부르기로 합니다. 예를 들어 'SKY'의 단어값은 19 + 11 + 25 = 55가 되는데, 이것은 우연히도 t10과 같습니다.
이렇게 어떤 단어의 단어값이 삼각수일 경우에는 이 단어를 '삼각단어'라 부르기로 합니다.

약 16KB의 텍스트 파일 words.txt에는 2000개 정도의 영어 단어가 수록되어 있습니다. 이 중에서 삼각단어는 모두 몇 개입니까?

::::

단어가 길어봐야 삼각수값으로 크게 나오는 일은 적을 것이므로, 
100개의 삼각수를 만들어서 체크한다. 

가장 어려운 부분은 파일을 읽어서 컴마로 자르고 따옴표를 없애는 부분. 
-}

module Main where

import Data.Char(ord)


charValue :: Char -> Int
charValue c = ord c - 64

wordValue :: String -> Int
wordValue = sum . fmap charValue

isTri :: Int -> Bool
isTri n = n `elem` [div (x*x + x) 2 | x <- [1..100]]

checkword :: String -> Bool
checkword = isTri . wordValue


splitOn :: String -> String -> [String]
splitOn _ "" = []
splitOn as xs = case dropWhile (`elem` as) xs of
                  "" -> []
                  s' -> w: splitOn as s''
                      where (w, s'') = break (`elem` as) s'

removeQuotes :: String -> String
removeQuotes = filter (not . (`elem` "\"'"))



main :: IO ()
main = do
    f <- readFile "words.txt"
    let result = length . filter id . fmap (checkword . removeQuotes) . splitOn "," $ f
    print result

e043.hs

{-

숫자 1406357289은 0 ~ 9 팬디지털인데, 부분열에 관련된 재미있는 성질을 가지고 있습니다.

d1을 첫째 자리수, d2를 둘째 자리수...라고 했을 때, 다음과 같은 사실을 발견할 수 있습니다.

    d2 d3 d4 = 406 → 2로 나누어 떨어짐
    d3 d4 d5 = 063 → 3으로 나누어 떨어짐
    d4 d5 d6 = 635 → 5로 나누어 떨어짐
    d5 d6 d7 = 357 → 7로 나누어 떨어짐
    d6 d7 d8 = 572 → 11로 나누어 떨어짐
    d7 d8 d9 = 728 → 13으로 나누어 떨어짐
    d8 d9 d10 = 289 → 17로 나누어 떨어짐

위와 같은 성질을 갖는 0 ~ 9 팬디지털을 모두 찾아서 그 합을 구하면 얼마입니까?-}


{- 조건 제시법으로 각 위치에 해당하는 숫자를 찾아서 그 리스트를 만든다. 
두 리스트에서 차이를 구하는 함수는 (\\)으로 (xs ++ ys) \\ xs == ys 이다. -}

module Main where

import Data.List ((\\))

list :: [Integer]
list = fmap listToInteger [ [d1, d2, d3, d4, d5, d6, d7, d8, d9, d10] |
          d10 <- [0..9]
        , d9 <- [0..9] \\ [d10]
        , d8 <- [0..9] \\ [d9, d10]
        , (100*d8 + 10*d9 + d10) `mod` 17 == 0
        , d7 <- [0..9] \\ [d8, d9, d10]
        , (100*d7 + 10*d8 + d9) `mod` 13 == 0
        , d6 <- [0..9] \\ [d7, d8, d9, d10]
        , (100*d6 + 10*d7 + d8) `mod` 11 == 0
        , d5 <- [0..9] \\ [d6, d7, d8, d9, d10]
        , (100*d5 + 10*d6 + d7) `mod` 7 == 0
        , d4 <- [0..9] \\ [d5, d6, d7, d8, d9, d10]
        , (100*d4 + 10*d5 + d6) `mod` 5 == 0
        , d3 <- [0..9] \\ [d4, d5, d6, d7, d8, d9, d10]
        , (100*d3 + 10*d4 + d5) `mod` 3 == 0
        , d2 <- [0..9] \\ [d3, d4, d5, d6, d7, d8, d9, d10]
        , (100*d2 + 10*d3 + d4) `mod` 2 == 0
        , d1 <- [1..9] \\ [d2, d3, d4, d5, d6, d7, d8, d9, d10]
        , d1 /= 0
        ]

listToInteger :: [Int] -> Integer
listToInteger xs = foldl (\x y -> 10*x + y) 0 . fmap toInteger $ xs

main :: IO ()
main = print $ sum list

e044.hs

{-오각수는 Pn = n (3n − 1)/2 라는 공식으로 구할 수 있고, 처음 10개의 오각수는 다음과 같습니다.

1, 5, 12, 22, 35, 51, 70, 92, 117, 145, ...

위에서 P4 + P7 = 22 + 70 = 92 = P8이 됨을 볼 수 있습니다. 하지만 두 값의 차인 70 − 22 = 48 은 오각수가 아닙니다.

합과 차도 모두 오각수인 두 오각수 Pj, Pk 에 대해서, 그 차이 D = | Pk − Pj | 는 가장 작을 때 얼마입니까?

::::

5각수는 2차곡선을 따라 증가하므로 큰 값으로 나갈 수록 점점 더 커진다. 
1. 오각수가 순서대로 있는 리스트를 준비한다. 
2. 다음 오각수를 만든다. 이를 s라 한다.
3. 오각수 리스트에서 가장 큰수를 a라 한다. 
4. 만약 s -a 가 오각수라면 a, (s-a)는 합이 오각수인 두 오각수이다. 
5. a - (s-a)가 역시 오각수라면 (2*a - s)가 그 차이가 된다. 
6. 이는 가장 작은 결과부터 체크하기 때문에 첫번째로 찾은 값이 정답이된다.


이미 현재까지의 모든 오각수를 리스트에 찾아두었지만, 탐색에 걸리는 시간은 O(n)으로 증가하므로
O(1)에서 찾을 수 있는 오각수 판별함수가 있으면 유리하다. 
오각수는 2차식으로 생성되므로, 2차식을 역으로 정리하여 오각수 판별식을 만들 수 있다. 

컴파일했을 때 0.1s
인터랙티브모드에서 17초 소요.
-}

pn :: Int -> Integer
pn n = toInteger $ (3*n*n - n) `div` 2


isPentagonal :: Integer -> Bool
isPentagonal n = let n' = fromIntegral n :: Double
                     k = (1 + (sqrt (24 * n' + 1))) / 6 :: Double
                  in k == (fromIntegral . floor $ k)


check :: Int -> [Integer] -> Integer
check _ [] = 0
check n a = 
    let s = pn n
     in case checkHelper s a of
          Nothing -> check (n+1) (s:a)
          Just d  -> d


checkHelper :: Integer -> [Integer] -> Maybe Integer
checkHelper _ [] = Nothing
checkHelper s (x:xs) = 
        let y = s - x
            d = abs (x-y)
         in if isPentagonal y && isPentagonal d then Just d
                                    else checkHelper s xs


p44 :: Integer
p44 = check 2 [1]



main = print  p44

e045.hs

{-


삼각수, 오각수, 육각수는 아래 식으로 구할 수 있습니다.
삼각수 	  	Tn = n (n + 1) / 2 	  	1, 3, 6, 10, 15, ...
오각수 	  	Pn = n (3n − 1) / 2 	  	1, 5, 12, 22, 35, ...
육각수 	  	Hn = n (2n − 1) 	  	1, 6, 15, 28, 45, ...

여기서 T285 = P165 = H143 = 40755 가 됩니다.

오각수와 육각수도 되는, 그 다음으로 큰 삼각수를 구하세요.

::::

모든 육각수는 삼각수가 되므로...
-}
isPentagonal :: Integer -> Bool
isPentagonal n = let n' = fromIntegral n :: Double
                     k = (1 + (sqrt (24 * n' + 1))) / 6 :: Double
                  in k == (fromIntegral . floor $ k)

tn :: Int -> Integer
tn n = toInteger $ (2 * n * n - n )

p45 = head . dropWhile (not . isPentagonal) $ [tn x| x <- [286..]]

main = print p45

e046.hs

{-크리스티안 골드바흐는 모든 홀수인 합성수를 (소수 + 2×제곱수)로 나타낼 수 있다고 주장했습니다.

9 = 7 + 2×12
15 = 7 + 2×22
21 = 3 + 2×32
25 = 7 + 2×32
27 = 19 + 2×22
33 = 31 + 2×12

이 추측은 잘못되었음이 밝혀졌습니다.

위와 같은 방법으로 나타낼 수 없는 가장 작은 홀수 합성수는 얼마입니까?

:: 
문제그대로를 푼다.
집합을 만들 때 다 만들고 length를 세는 것보다, [] 인지 아닌지를 판단하도록 하는 것이 
좀 더 빨라진다.
-}

import Euler

squares :: [Integer]
squares = [x*x | x<-[1..]]

primes :: [Integer]
primes = [x| x<-[2..], isPrime x]

empty xs = length xs == 0


-- square number less than..
check n = let lessSquares = takeWhile (<n) squares
              lessPrimes = reverse . takeWhile (<n) $ primes
              targets = [a+b| a <- lessSquares , b <- lessPrimes , b + 2 * a == n] 
           in case targets of [] -> True
                              x:_ -> False

p46 = head . filter check $ [x| x<-[3, 5..], not . isPrime $ x]
main = print p46

e047.hs

{-서로 다른 두 개의 소인수를 갖는 수들이 처음으로 두 번 연달아 나오는 경우는 다음과 같습니다.

14 = 2 × 7
15 = 3 × 5

서로 다른 세 개의 소인수를 갖는 수들이 처음으로 세 번 연속되는 경우는 다음과 같습니다.

644 = 2² × 7 × 23
645 = 3 × 5 × 43
646 = 2 × 17 × 19

서로 다른 네 개의 소인수를 갖는 수들이 처음으로 네 번 연속되는 경우를 찾으세요. 그 첫번째 숫자는 얼마입니까?


::::

이 문제 역시 특별한 꼼수 없이 하나하나 구해나가는 수 밖에 없다. 
4개의 소인수를 가진 가장 작은 수는 2*3*5*7 이고 각 수에 대해서 소인수의 개수를 구하는 효율적인 
방법을 찾는 것이 관건이다. -}

removeFactor :: Integer -> Integer -> Integer
removeFactor n d
    | mod n d /= 0 = n
    | otherwise = removeFactor (div n d) d

findDivisor :: Integer -> Integer
findDivisor n
    | mod n 2 == 0 = 2
    | mod n 3 == 0 = 3
    | otherwise = divideHelper n 5

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


pfactors :: Integer -> [Integer] -> [Integer]
pfactors 1 _ = []
pfactors n xs = let d = findDivisor n
              in d:(pfactors (removeFactor n d) xs)

factors :: Integer -> [Integer]
factors x = pfactors x []

start = 2 * 3 * 5 * 6 :: Integer

p407 :: Integer -> Int -> Integer
p407 n 4 = n - 4
p407 n count'
    | (length . factors $ n) == 4 = p407 (n+1) (count' + 1)
    | otherwise = p407 (n+1) 0

main = print $ p407 start 0

e048.hs

{-11 + 22 + 33 + ... + 1010 = 10405071317 입니다.

11 + 22 + 33 + ... + 10001000 의 마지막 10자리 숫자는 무엇입니까?-}

main :: IO ()
main = print $ reverse . take 10 . reverse . show. sum $ [x^x | x <- [1..1000]] 

e049.hs

{-1487, 4817, 8147은 3330씩 늘어나는 등차수열입니다. 이 수열에는 특이한 점이 두 가지 있습니다.

세 수는 모두 소수입니다.
세 수는 각각 다른 수의 자릿수를 바꿔서 만들 수 있는 순열(permutation)입니다.
1자리, 2자리, 3자리의 소수 중에서는 위와 같은 성질을 갖는 수열이 존재하지 않습니다. 하지만 4자리라면 위엣것 말고도 또 다른 수열이 존재합니다.

그 수열의 세 항을 이었을 때 만들어지는 12자리 숫자는 무엇입니까?

::::

haskell 의 조건제시법으로 집합을 만드는 부분은 매우 강력하다.
Set을 쓰면 더 빨라질 수 있겠으나, 4자리 소수가 그리 큰 리스트는 아니어서 elem으로 충분.
-}


import Euler
import Data.List (sort)

primes4 :: [Integer]
primes4 = [x|x<-[1000..9999], isPrime x]

ss :: (Show a) => a -> String
ss = sort . show

p049 :: [String]
p049 = [show a ++ show b ++ show ( 2 * b - a) 
        | a <- primes4
        , b <- dropWhile (<=a) primes4
        , ss a == ss b
        , let c = 2 * b - a in ss c == ss a && elem c primes4
        ]

main :: IO ()
main = print p049

e050.hs

{-41은 소수이면서 다음과 같은 6개의 연속된 소수의 합으로도 나타낼 수 있습니다.

41 = 2 + 3 + 5 + 7 + 11 + 13
이것은 100 이하에서는 가장 길게 연속된 소수의 합으로 이루어진 소수입니다.

1000 이하에서는 953이 연속된 소수 21개의 합으로 가장 깁니다.

1백만 이하에서는 어떤 소수가 가장 길게 연속되는 소수의 합으로 표현될 수 있습니까?

:::::::::::

소수의 리스르를 만들어 놓고 l 만큼의 길이에서 좌우로 옮겨가면서
문제의 조건을 만족하는 l 이 있는지를 살펴봐서 찾으면 될 것 같은데, 
1백만까지는 78000 여개의 소수가 있고, 최장 길이는 548이기 때문에
이게 금방 나오지 않는다. 계산의 수를 줄이기 위해서는
연속된 소수의 합의 리스트를 만들고 이 리스트에서 l!!j - l!!i 한 값이 소수인지를
보는 식으로 검사하는 것이 더 빠르다. 

첫번째 로직으로 구현했을 때 약 17분 가량 걸렸고, 
아래 코드는 47초 가량 걸린다. (컴파일 시 20초 남짓)

-}


module Main where
import Euler

limit :: Integer
limit = 1000000

len :: Int
len = length primes

primes :: [Integer]
primes = 2:[x|x<-[3,5..limit], isPrime x]


acc_primes :: [Integer]
acc_primes = tail $ scanl (+) 0 primes

sum_range :: Int -> Int -> Integer
sum_range i j = acc_primes !! j - acc_primes !! i

sum_slice_length :: Int -> (Integer, Int)
sum_slice_length o = let n = len - o -1 --i -> [0..n]
                         sums = filter isPrime . takeWhile (<limit) . fmap (\x -> sum_range  x (x+n)) $ [0..n]
                      in case sums of [] -> sum_slice_length (o+1)
                                      (x:_) -> (x, n)


p50 :: (Integer, Int)
p50 = sum_slice_length 0

main :: IO ()
main = print p50

e042.hs

문자열을 특정 문자열에 들어있는 글자를 기준으로 split 하는 함수가 없어서 따로 만들었다.
break 함수를 이용하면 특정 조건을 기준으로 만족하는 지점을 기준으로 (앞, 뒤)의 튜플로 만들 수 있으므로, 특정 조건을 만족하는 곳까지 반복해서 잘라나간다.