「HaskellでProject Euler(Problem 16～18)」ブログ用

euler16.hs

import Data.Char

main = print $ digitSum 1000

digitSum :: Integral a => a -> Int
digitSum n = sum $ map digitToInt $ show $ 2 ^ n

euler17-1.hs

main = print $ numLetterCounts 1000

numLetterCounts :: (Enum a, Num a, Show a) => a -> Int
numLetterCounts n = sum $ map (length . filter (/= ' ') . toWord . (padding '0' 4)) [1..n]

toWord :: String -> String
toWord ('1':_)         = "one thousand"
toWord (_:n3:n2:n1:[]) = catNums (fmap (++ " hundred") (word n3)) (wordTens n2 n1)
  where
    catNums (Just n3) (Just n21) = n3 ++ " and " ++ n21
    catNums (Just n3) _          = n3
    catNums _         (Just n21) = n21

word :: Char -> Maybe String
word '0' = Nothing
word '1' = Just "one"
word '2' = Just "two"
word '3' = Just "three"
word '4' = Just "four"
word '5' = Just "five"
word '6' = Just "six"
word '7' = Just "seven"
word '8' = Just "eight"
word '9' = Just "nine"

wordTens :: Char -> Char -> Maybe String
wordTens '0' n   = word n
wordTens '1' '0' = Just "ten"
wordTens '1' '1' = Just "eleven"
wordTens '1' '2' = Just "twelve"
wordTens '1' '3' = Just "thirteen"
wordTens '1' '4' = Just "fourteen"
wordTens '1' '5' = Just "fifteen"
wordTens '1' '6' = Just "sixteen"
wordTens '1' '7' = Just "seventeen"
wordTens '1' '8' = Just "eighteen"
wordTens '1' '9' = Just "nineteen"
wordTens n2 n1   = catNums n2 $ word n1
  where
    catNums n2 (Just n1) = Just $ (wordTens' n2) ++ " " ++ n1
    catNums n2 _         = Just $ wordTens' n2
    wordTens' '2' = "twenty"
    wordTens' '3' = "thirty"
    wordTens' '4' = "forty" 
    wordTens' '5' = "fifty" 
    wordTens' '6' = "sixty" 
    wordTens' '7' = "seventy"
    wordTens' '8' = "eighty"
    wordTens' '9' = "ninety"

padding :: Show a => Char -> Int -> a -> String
padding p l n = padding' $ show n
  where padding' s | length s < l = padding' (p:s)
                   | otherwise    = s

euler17-2.hs

main = print $ sum $ map (length . filter (/= ' ') . convert) [1..1000]

convert :: Int -> String
convert 1000 = "one thousand"
convert n    = convert3 n

convert3 :: Int -> String
convert3 = combine3 . digit3
  where
    combine3 (0, t) = convert2 t
    combine3 (h, 0) = units !! (h - 1) ++ " hundred"
    combine3 (h, t) = units !! (h - 1) ++ " hundred and " ++ (convert2 t)

    digit3 n = (n `div` 100, n `mod` 100)

convert2 :: Int -> String
convert2 = combine2 . digit2
  where
    combine2 (0, u) = units !! (u - 1)
    combine2 (1, u) = teens !! u
    combine2 (t, 0) = tens !! (t - 2)
    combine2 (t, u) = tens !! (t - 2) ++ " " ++ units !! (u - 1)

    digit2 n = (n `div` 10, n `mod` 10)

units, teens, tens :: [String]
units = ["one", "two", "three", "four", "five", "six", "seven", "eight", "nine"]
teens = ["ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"]
tens = ["twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety"]

euler18-1.hs

main = print $ head $ foldl1 (zipWith (+) . largerList) $ reverse route

largerList :: Ord b => [b] -> [b]
largerList l = zipWith max l $ tail l

route :: [[Integer]]
route = [
  [75],
  [95, 64],
  [17, 47, 82],
  [18, 35, 87, 10],
  [20, 04, 82, 47, 65],
  [19, 01, 23, 75, 03, 34],
  [88, 02, 77, 73, 07, 63, 67],
  [99, 65, 04, 28, 06, 16, 70, 92],
  [41, 41, 26, 56, 83, 40, 80, 70, 33],
  [41, 48, 72, 33, 47, 32, 37, 16, 94, 29],
  [53, 71, 44, 65, 25, 43, 91, 52, 97, 51, 14],
  [70, 11, 33, 28, 77, 73, 17, 78, 39, 68, 17, 57],
  [91, 71, 52, 38, 17, 14, 91, 43, 58, 50, 27, 29, 48],
  [63, 66, 04, 68, 89, 53, 67, 30, 73, 16, 69, 87, 40, 31],
  [04, 62, 98, 27, 23, 09, 70, 98, 73, 93, 38, 53, 60, 04, 23]
 ]

euler18-2.hs

import Data.Maybe

main = print $ maximum $ concat $ foldl pathSum [(head route)] (tail route)

pathSum :: Num a => [[a]] -> [a] -> [[a]]
pathSum x y = zipWith (\a b -> map (+ b) a) (list x) y
  where list x = let x' = map Just x in zipWith (\a b -> concat $ catMaybes [a, b]) (Nothing:x') (reverse $ Nothing:(reverse x'))

route :: [[Integer]]
route = [
  [75],
  [95, 64],
  [17, 47, 82],
  [18, 35, 87, 10],
  [20, 04, 82, 47, 65],
  [19, 01, 23, 75, 03, 34],
  [88, 02, 77, 73, 07, 63, 67],
  [99, 65, 04, 28, 06, 16, 70, 92],
  [41, 41, 26, 56, 83, 40, 80, 70, 33],
  [41, 48, 72, 33, 47, 32, 37, 16, 94, 29],
  [53, 71, 44, 65, 25, 43, 91, 52, 97, 51, 14],
  [70, 11, 33, 28, 77, 73, 17, 78, 39, 68, 17, 57],
  [91, 71, 52, 38, 17, 14, 91, 43, 58, 50, 27, 29, 48],
  [63, 66, 04, 68, 89, 53, 67, 30, 73, 16, 69, 87, 40, 31],
  [04, 62, 98, 27, 23, 09, 70, 98, 73, 93, 38, 53, 60, 04, 23]
 ]