Project Euler 004 # haskell (031~040)

e031.hs

{-

영국의 화폐 단위는 파운드(£)와 펜스(p)이고, 동전의 종류는 아래와 같습니다.

    1p, 2p, 5p, 10p, 20p, 50p, £1 (100p), £2 (200p)

이 동전들을 가지고 2파운드를 만드는 방법은 다양할 것입니다. 예를 하나 들면 이렇습니다.

    1×£1 + 1×50p + 2×20p + 1×5p + 1×2p + 3×1p

2파운드를 만드는 서로 다른 방법은 모두 몇가지나 있습니까?-}


import Data.Array

coins = [1,2,5,10,20,50,100,200] :: [Int] -- 동전종류 정의
limit = 200 :: Int -- 최종 값 정의

{-
    동전 1종류가 추가될 때 만들 수 있는 가지수를 업데이트한다. 
-}
processCoin :: Array Int Int -> Int -> Int -> Array Int Int
processCoin m coin i
    | i > limit = m
    | otherwise = let m' = m // [(i, m!i + m!(i-coin))]
                   in processCoin m' coin (i+1)

{-
    각 동전에 대해서 가지수 업데이트를 반복 시행한다. 
-}
process :: Array Int Int -> [Int] -> Array Int Int
process m [] = m
process m (c:cs) = let m' = processCoin m c c
                    in process m' cs


main = let ways = array (0, limit) $ (0, 1):[(x, 0)| x<-[1..limit]]
        in print $ (process ways coins)!limit

e032.hs

{-1부터 n까지의 각 숫자를 한번씩만 써서 만들 수 있는 숫자를 팬디지털(pandigital)이라고 합니다.
예를 들면 15234는 1부터 5의 숫자가 한번씩만 쓰였으므로 1 ~ 5 팬디지털입니다.

7254라는 숫자는 그런 면에서 특이한데, 39 × 186 = 7254 라는 곱셈식을 만들 때 이것이 1 ~ 9 팬디지털이 되기 때문입니다.

이런 식으로 a × b = c 가 1 ~ 9 팬디지털이 되는 모든 c의 합은 얼마입니까?

(참고: 어떤 c는 두 개 이상의 (a, b)쌍에 대응될 수도 있는데, 이런 경우는 하나로 칩니다)

----
1자리 * 4자리 = 4자리
2자리 * 3자리 = 4자리

의 경우만 살펴보면 된다.

-}

import Euler
import Data.List (sort, nub)
test :: Int -> Int -> Bool
test a b = let sc = show $ a * b
               sa = show a
               sb = show b
               ss = sa ++ sb ++ sc
            in sort ss == take (length ss) "123456789"

g14 = [a*b | a <- [1..9], b<-[1234..9999], test a b]
g23 = [a*b | a <- [12..99], b<-[123..999], test a b]

main = print $ foldr1 (+) . nub $ g14 ++ g23

e033.hs

{-
분수 49/98에는 재미있는 성질이 있습니다. 수학을 잘 모르는 사람이 분모와 분자에서 9를 각각 지워서 간단히 하려고 49/98 = 4/8 처럼 계산해도 올바른 결과가 됩니다.
이에 비해 30/50 = 3/5 같은 경우는 다소 진부한 예라고 볼 수 있습니다.
위와 같은 성질을 가지면서 '진부하지 않은' 분수는, 값이 1보다 작고 분자와 분모가 2자리 정수인 경우 모두 4개가 있습니다.
이 4개의 분수를 곱해서 약분했을 때 분모는 얼마입니까?-}

type Frac = (Int, Int)

deduce :: Frac -> Frac
deduce (_, 0) = (0, 0)
deduce (0, _) = (0, 1)
deduce (a, b) = let g = gcd a b
                 in (div a g, div b g)

eq' :: Frac -> Frac -> Bool
eq' i j = let (a, b) = deduce i
              (x, y) = deduce j
           in a == x && b == y
        
break :: Int -> (Int, Int)
break x = let a = div x 10
              b = mod x 10
           in (a, b)

weiredDeduce :: Frac -> Frac -> Frac
weiredDeduce (a,b) (x,y)
    | b == 0 || y == 0 = (0, 0)
    | a == x = (b, y)
    | b == x = (a, y)
    | a == y = (b, x)
    | b == y = (a, x)
    | otherwise = (0, 0)


test :: Frac -> Bool
test x = eq' x $ weiredDeduce (Main.break . fst  $ x) (Main.break . snd $ x)


main :: IO ()
main = let k = [(a, b)| a<-[10..99], b<-[10..99], a < b, test (a, b)]
           q = product . fmap fst $ k
           r = product . fmap snd $ k
        in print $ div r q

e034.hs

{-
숫자 145에는 신기한 성질이 있습니다. 각 자릿수의 팩토리얼(계승)을 더하면  1! + 4! + 5! = 1 + 24 + 120 = 145 처럼 자기 자신이 됩니다.
이렇게 각 자릿수의 팩토리얼을 더하면 자기 자신이 되는 모든 수의 합을 구하세요.
단, 1! = 1 과 2! = 2 의 경우는 덧셈이 아니므로 제외합니다.-}

factorial :: Int -> Integer
factorial n
    | n < 2 = 1
    | otherwise = product [1..(toInteger n)]

check :: Int -> Bool
check n = let e = fmap (factorial . read . (:[])) $ show n :: [Integer]
           in (toInteger n) == sum e

main = print $ sum . filter check $ [3..1000000]

e035.hs

{-
소수 중에서 각 자리의 숫자들을 순환시켜도 여전히 소수인 것을 circular prime이라고 합니다. 예를 들어 197은 971, 719가 모두 소수이므로 여기에 해당합니다.
이런 소수는 100 밑으로 2, 3, 5, 7, 11, 13, 17, 31, 37, 71, 73, 79, 97 처럼 13개가 있습니다.
그러면 1,000,000 밑으로는 모두 몇 개나 있을까요?-}


import Euler (isPrime)
import Control.Applicative

checkCircularPrime :: String -> Bool
checkCircularPrime m 
    | any (\x->x) $ (fmap (==) "024568") <*> m = False
    |otherwise = checkCircularPrimeHelper m (length m)

checkCircularPrimeHelper :: String -> Int -> Bool
checkCircularPrimeHelper _ 0 = True
checkCircularPrimeHelper m@(x:xs) n 
    | isPrime . read $ m = checkCircularPrimeHelper (xs++[x]) (n-1)
    | otherwise = False

main = print $ 4 + (length . filter checkCircularPrime . fmap show $ [10..1000000])

e036.hs

{-

대칭수(palindrome)인 585는 2진수로 나타내도 10010010012가 되어 여전히 대칭수입니다.

10진법과 2진법으로 모두 대칭수인 1,000,000 이하 숫자의 합을 구하세요.

(주의: 첫번째 자리가 0이면 대칭수가 아님)

::: 문제에서 친절하게 짝수는 안된다고 했으니 홀수만 대상으로 검사한다. 
2진수로 변환하여 대칭수인지 검사하는 것은 제법 귀찮으므로, 우선 10진수가 대칭수인지를
먼저 검사하면 검사 시간이 1/10로 줄어든다.-}

import Euler

bin x = foldr1 (++) . fmap show . reverse . binHelper $ x

binHelper x
    |x == 1 = [1]
    |x == 0 = [0]
    |otherwise = (mod x 2):(binHelper (div x 2))

test x = let s = binHelper x 
          in isPalindrome x && reverse s == s

main = print $ sum . filter test $ [x*2-1 | x <-[1..500000]] 

e037.hs

{-

소수 3797에는 왼쪽부터 자리수를 하나씩 없애거나 (3797, 797, 97, 7) 오른쪽부터 없애도 (3797, 379, 37, 3) 모두 소수가 되는 성질이 있습니다.

이런 성질을 가진 소수는 단 11개만이 존재합니다. 이것을 모두 찾아서 합을 구하세요.

(참고: 2, 3, 5, 7은 제외합니다)-}

import Control.Applicative
import Euler

-- should not have digit 0, 4, 6, 8
-- last digit is must be 3, 7
valid :: Integer -> Bool
valid x 
    | mod x 10 == 3 || mod x 10 == 7 = let s = fmap (==) "0468"
           in not . any (\a->a) $ s <*> (show x)
    | otherwise = False


removeRear :: Integer -> Integer
removeRear x = div x 10


removeFront :: Integer -> Integer
removeFront n = let c = toInteger . floor $ logBase 10 (fromIntegral n) :: Integer
                 in mod n (10 ^ c)


hasAll :: [Bool] -> Bool
hasAll xs = all (\x->x) xs

check :: Integer -> Bool
check n
    | valid n = let rs = takeWhile (>0) . iterate removeRear $ n
                    fs = takeWhile (>0) . iterate removeFront $ n
                 in (hasAll . fmap isPrime $ rs) && (hasAll . fmap isPrime $ fs)
    | otherwise = False
                 
main = let s = take 11 [2*x + 1| x <- [5..], check (2*x+1)]
        in print $ sum s

e038.hs

import Data.List (sort)
{-
숫자 192에 1, 2, 3을 각각 곱합니다.

    192 × 1 = 192
    192 × 2 = 384
    192 × 3 = 576 

곱한 결과를 모두 이어보면 192384576 이고, 이것은 1 ~ 9 팬디지털(pandigital)인 숫자입니다. 이런 과정을 편의상 '곱해서 이어붙이기'라고 부르기로 합니다.
같은 식으로 9와 (1, 2, 3, 4, 5)를 곱해서 이어붙이면 918273645 라는 1 ~ 9 팬디지털 숫자를 얻습니다.
어떤 정수와 (1, 2, ... , n)을 곱해서 이어붙였을 때 얻을 수 있는 가장 큰 아홉자리의 1 ~ 9 팬디지털 숫자는 무엇입니까? (단 n > 1)

::::

문제에서 적어도 2번 이상은 이어붙어야 하므로 1~9999 사이의 값에 대해 조사해보면 된다.
-}


isPandigital:: String -> Bool
isPandigital x = sort x == "123456789"

make n = makeX "" n 1

makeX :: String -> Int -> Int -> String
makeX xs n a = let xs' = xs ++ (show $ n * a)
                in if length xs' > 9 then xs
                                     else makeX xs' n (a+1)

main = print $ foldr1 max . filter isPandigital . fmap make  $ [1..9999]

e039.hs

{-

세 변의 길이가 모두 자연수 {a, b, c}인 직각삼각형의 둘레를 p 로 둘 때, p = 120 을 만족하는 직각삼각형은 아래와 같이 세 개가 있습니다.
    {20, 48, 52}, {24, 45, 51}, {30, 40, 50} 
1000 이하의 둘레 p에 대해서, 직각삼각형이 가장 많이 만들어지는 p의 값은 얼마입니까?-}

import Data.Function (on)

maxWith :: (Ord b) => (a -> b) -> a -> a -> a
maxWith f x y = let comp = (>) `on` f
                 in if comp x y then x else y

main = let ls n = [(a, b)| a<-[1..(div n 3)], b<-[a..(div (n-a) 2)], let c = n-a-b in c^2 == a^2 + b^2]
           numberOfTriangles = fmap (\x-> (x, (length . ls $ x))) [12..1000]
        in print $ foldr1 (maxWith snd) numberOfTriangles

{- 컴파일했을 때 약 2.2초, runhaskell 로 실행시 약 57초 -}

e040.hs

{-
소수점 뒤에 양의 정수를 차례대로 붙여 나가면 아래와 같은 무리수를 만들 수 있습니다.

0.123456789101112131415161718192021...

이 무리수의 소수점 아래 12번째 자리에는 1이 옵니다 (위에서 붉게 표시된 숫자).

소수점 아래 n번째 숫자를 dn이라고 했을 때, 아래 식의 값은 얼마입니까?

d1 × d10 × d100 × d1000 × d10000 × d100000 × d1000000 -}


numbers :: Int -> String
numbers a = (show a) ++ numbers (a+1)

main = print $ let s = take 1000001 $ numbers 0 
                in foldr1 (*) . fmap (read . (:[]) . (s!!)) . fmap (10^) $ [0..6]

(Haskell) Array

Array는 인덱스되는 배열로 리스트와는 다소 차이가 있다. (리스트는 연결리스트에 가까운 구조) 인덱스르를 이용한 랜덤 액세스를 보다 효율적으로 만들어주는 자료구조이다. Array는 Data.Array 모듈 내에 정의되어 있으며, 인덱스는 Ix라는 타입 클래스의 인스턴스인데, 이는 Data.Ix에 포함되어 있으나, Data.Array는 이 내용을 같이 export하고 있으므로 별도로 반입할 필요는 없다.

array 
    :: Ix i
    => (i, i)
    -> [(i, e)]
    -> Array i e

이 함수는 시작, 끝 인덱스 범위와 (인덱스,값)의 리스트를 이용해서 배열값을 생성해낸다. 연산자 (!)를 이용해서 특정한 위치의 값을 얻을 수 있다.

연산자 (//)는 [(인덱스, 값)] 을 이용해서 배열의 일부를 치환한 새로운 배열을 만들어 낸다.

그외에 몇가지 함수는 다음과 같다.

• listArray :: Ix i => (i, i) -> [e] -> Array i e : 바운더리값을 이용해서 리스트를 배열로 변경
• accumArray :: Ix i => (e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e : 초기값, 바운더리, 리스트를 이용해서 특정한 값이 누적 계산되는 배열을 만들어낸다.
• bounds :: Ix i => Array i e -> (i, i) : 바운더리를 구한다.
• indices :: 인덱스의 리스트를 구한다.
• elems :: 값의 리스트를 구한다.
• assocs :: (인덱스, 값)의 리스트를 구한다.
• ixmap :: (Ix i, Ix j) => (i, i) -> (i -> j) -> Array j e -> Array i e : 배열의 인덱스를 맵오버하여 변경한다.