「HaskellでProject Euler(Problem 31～33)」ブログ用

euler31-1.hs

main = print $ length $ coinSums 200

coinSums :: Integer -> [(Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer)]
coinSums n = [ (po1, po2, po5, po10, po20, po50, pe1, pe2) |
  po1  <- [0,1..n],
  po2  <- [0,2..n-po1],
  po5  <- [0,5..n-(po1+po2)],
  po10 <- [0,10..n-(po1+po2+po5)],
  po20 <- [0,20..n-(po1+po2+po5+po10)],
  po50 <- [0,50..n-(po1+po2+po5+po10+po20)],
  pe1  <- [0,100..n-(po1+po2+po5+po10+po20+po50)],
  pe2  <- [0,200..n-(po1+po2+po5+po10+po20+po50+pe1)],
  po1 + po2 + po5 + po10 + po20 + po50 + pe1 + pe2 == n]

euler31-2.hs

main = print $ length $ coinSums 200

coinSums :: Integer -> [(Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer)]
coinSums n = [ (po1, po2, po5, po10, po20, po50, pe1, pe2) |
  pe2  <- [0,200..n],
  let n1 = n - pe2,
  pe1  <- [0,100..n1],
  let n2 = n1 - pe1,
  po50 <- [0,50..n2],
  let n3 = n2 - po50,
  po20 <- [0,20..n3],
  let n4 = n3 - po20,
  po10 <- [0,10..n4],
  let n5 = n4 - po10,
  po5  <- [0,5..n5],
  let n6 = n5 - po5,
  po2  <- [0,2..n6],
  let n7 = n6 - po2,
  po1  <- [0,1..n7],
  po1 == n7]

euler31-3.hs

main = print $ f200_100_50_20_10_5_2_1 200

f1 n = 1

f2_1 n = sum [f1 (n - x) | x <- [0,2..n]]

f5_2_1 n = sum [f2_1 (n - x) | x <- [0,5..n]]

f10_5_2_1 n = sum [f5_2_1 (n - x) | x <- [0,10..n]]

f20_10_5_2_1 n = sum [f10_5_2_1 (n - x) | x <- [0,20..n]]

f50_20_10_5_2_1 n = sum [f20_10_5_2_1 (n - x) | x <- [0,50..n]]

f100_50_20_10_5_2_1 n = sum [f50_20_10_5_2_1 (n - x) | x <- [0,100..n]]

f200_100_50_20_10_5_2_1 n = sum [f100_50_20_10_5_2_1 (n - x) | x <- [0,200..n]]

euler31-4.hs

main = print $ f [200,100,50,20,10,5,2,1] 200

f :: (Integral a, Num b) => [a] -> a -> b
f [n]    m = if m `mod` n == 0 then 1 else 0
f (n:ns) m = sum [f ns (m - x) | x <- [0,n..m]]

euler31-5.hs

main = print $ f [200,100,50,20,10,5,2,1] 200

f :: (Integral a, Num b) => [a] -> a -> b
f ns m = let ns' = zip ns $ scanr1 gcd ns in f' ns' m
  where
    f' :: (Integral a, Num b) => [(a, a)] -> a -> b
    f' ((n, d):ns) m
      | m `mod` d /= 0 = 0
      | null ns        = 1
      | otherwise      = sum [f' ns (m - x) | x <- [0,n..m]]

euler32-1.hs

import Data.Char (digitToInt)
import Data.List (nub, sort)

main = print $ sum $ pandigitals

pandigitals :: [Integer]
pandigitals = nub [ z |
  let limit = 9876,
  x <- [2..limit], isUnique x,
  y <- [(x+1)..limit], isUnique y,
  let z = x * y, isUnique z, isPandigital 9 $ [x, y, z]]
    where isUnique xs = let xs' = show xs in xs' == (nub $ xs')

isPandigital :: Show a => Int -> [a] -> Bool
isPandigital limit nums
  | length numStr /= limit = False
  | otherwise              = [1..limit] == (sort $ map digitToInt $ numStr)
    where numStr = foldl1 (++) $ map show nums

euler32-2.hs

import Data.Char (digitToInt)
import Data.List (nub, sort)

main = print $ sum $ pandigitals

pandigitals :: [Integer]
pandigitals = nub [ z |
  x <- [2..9876],
  let (lLimit, uLimit) = multiplyLimit x,
  y <- [lLimit..uLimit],
  let z = x * y,
  isPandigital [x, y, z]]

isPandigital :: Show a => [a] -> Bool
isPandigital ns = [1..9] == (sort $ map digitToInt $ numsToStr ns)
  where numsToStr = foldl1 (++) . map show

-- x*y が9桁になるためには xの桁数+yの桁数 = 5 である必要があるため、x の桁数から y の下限値,上限値を出す.
-- x が2桁の場合、y は3桁なので下限値は 100, 上限値は 999.
multiplyLimit :: (Num a, Show a) => a -> (a, a)
multiplyLimit x = (10^(numOfDigits - 1), (10^numOfDigits) - 1)
  where numOfDigits = 5 - (length $ show x)

euler32-3.hs

import Data.Array ((!), Array, listArray)
import Data.List (nub, sort)

main = print $ sum $ pandigitals

pandigitals :: [Integer]
pandigitals = nub [ z |
  x <- [2..9876],
  let (lLimit, uLimit) = multiplyLimit ! (length $ show x),
  y <- [lLimit..uLimit],
  let z = x * y,
  isPandigital [x, y, z]]

isPandigital :: Show a => [a] -> Bool
isPandigital ns = ['1'..'9'] == (sort $ ns >>= show)

-- x*y が9桁になるためには xの桁数+yの桁数 = 5 である必要があるため、x の桁数から y の下限値,上限値を出す.
-- x が2桁の場合、y は3桁なので下限値は 100, 上限値は 999.
multiplyLimit :: Array Int (Integer, Integer)
multiplyLimit = listArray (1, 4) $ map (\n -> let n' = 5 - n in (10^(n' - 1), (10^n') - 1)) [1..4]

euler32-4.hs

import Data.List (nub, sort)

main = print $ sum $ pandigitals

pandigitals :: [Integer]
pandigitals = nub [ z | x <- [2..98], y <- [(1234 `div` x)..(9876 `div` x)], let z = x * y, isPandigital [x, y, z]]

isPandigital :: Show a => [a] -> Bool
isPandigital ns = ['1'..'9'] == (sort $ concatMap show ns)

euler33-1.hs

import Data.Char (digitToInt)
import Data.List (delete, find, foldl1')
import Data.Maybe (isJust)
import Data.Ratio ((%), denominator, Ratio)

main = print $ denominator $ product dcFractions

fractions :: [(Int, Int, Maybe Int)]
fractions = [(n, d, e) | n <- list, d <- list, n < d, let e = sameElem n d, isJust e]
  where list = [x | x <- [11..99], x `mod` 10 /= 0]

dcFractions :: [Ratio Int]
dcFractions = map (\(n, d, e) -> (n % d)) $ filter (\(n, d, e) -> (n % d) == ((delElem n e) % (delElem d e))) fractions

sameElem :: Int -> Int -> Maybe Int
sameElem n m = let n' = numToList n
                   m' = numToList m in
               find (\e -> elem e m') n'

delElem :: Int -> Maybe Int -> Int
delElem n (Just e) = listToNum $ delete e $ numToList n
delElem n _        = n

numToList :: (Num a, Show a) => a -> [Int]
numToList = map digitToInt . show

listToNum :: Num a => [a] -> a
listToNum = foldl1' (\a b -> a * 10 + b)

euler33-2.hs

import Data.Char (digitToInt)
import Data.List (delete, find, foldl1')
import Data.Ratio ((%), denominator, Ratio)

main = print $ denominator $ product fractions

fractions :: [Ratio Int]
fractions = [n % d | n <- list, d <- list, n < d, eqDCFraction n d]
  where list = [x | x <- [11..99], x `mod` 10 /= 0]

eqDCFraction :: Int -> Int -> Bool
eqDCFraction n d = eq n d $ sameElem n d
  where
    eq n d (Just e) = (n % d) == ((delElem n e) % (delElem d e))
    eq _ _ _        = False

sameElem :: (Num a, Num b, Show a, Show b) => a -> b -> Maybe Int
sameElem n m = let n' = numToList n
                   m' = numToList m in
               find (\e -> elem e m') n'

delElem :: (Num a, Show a) => a -> Int -> Int
delElem n e = listToNum $ delete e $ numToList n

numToList :: (Num a, Show a) => a -> [Int]
numToList = map digitToInt . show

listToNum :: Num a => [a] -> a
listToNum = foldl1' (\a b -> a * 10 + b)