AOJ

q0000.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import Control.Applicative

qq :: Int -> Int -> String
qq x y = show x ++ "x" ++ show y ++ "=" ++ show (x * y)

main :: IO ()
main = mapM_ putStrLn $ qq <$> [1..9] <*> [1..9]

q0001.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import Control.Monad
import Data.List

readInt :: IO Int
readInt = readLn

main :: IO ()
main = do
  input <- replicateM 10 readInt
  mapM_ print $ take 3 $ sortBy (\x y -> compare y x) input

q0002.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import System.IO

main :: IO ()
main = do
  end <- isEOF
  if end then return ()
         else do
           input <- getLine
           let a:b:_ = map read $ words input :: [Int]
           print $ length $ show $ a + b
           main

q0003.hs

import Control.Monad
import Data.List

main :: IO ()
main = do
  n <- (readLn :: IO Int)
  replicateM_ n $ do
    input <- getLine
    let a:b:c:[] = sort $ map read $ words input :: [Int]
    putStrLn $ if (c ^ 2) == (a ^ 2) + (b ^ 2)
                  then "YES"
                  else "NO"

q0004.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import Text.Printf
import System.IO

fixZero :: Float -> Float
fixZero x = if x == 0 then 0.0 else x

main :: IO ()
main = do
  end <- isEOF
  if end then return ()
         else do
           input <- getLine
           let a:b:c:d:e:f:_ = map read $ words input :: [Float]
               det = (a * e - d * b)
               x = fixZero $ (c * e - f * b) / det
               y = fixZero $ (a * f - d * c) / det
           printf "%.3f %.3f\n" x y
           main

q0005.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import System.IO

main :: IO ()
main = do
  end <- isEOF
  if end
     then return ()
     else do
      input <- getLine
      let a:b:_ = map read $ words input :: [Int]
          g = show $ gcd a b
          l = show $ lcm a b
      putStrLn $ g ++ " " ++ l
      main

q0006.hs

{-# OPTIONS_GHC -Wall -Werror #-}

main :: IO ()
main = do
  input <- getLine
  putStrLn $ reverse input

q0007.hs

solve :: Int -> Double -> Int
solve 0 x = ceiling x
solve n x = solve (n - 1) $ fromIntegral $ ceiling $ x * 1.05

main :: IO ()
main = do
  n <- (readLn :: IO Int)
  print $ (solve n 100.0) * 1000

q0008.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import System.IO

main :: IO ()
main = do
  end <- isEOF
  if end
     then return ()
     else do
       n <- getLine
       print $ length [(a, b, c, d) | a <- [0..9], b <- [0..9], c <- [0..9], d <- [0..9], a + b + c + d == (read n :: Int)]
       main

q0009.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import Control.Applicative ((<$>))

main :: IO ()
main = do
  nums <- map read <$> words <$> getContents
  mapM_ (\n -> print $ length $ takeWhile (<= n) primes) nums

-- http://itchyny.hatenablog.com/entry/2016/01/17/120000
primes :: [Integer]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integer -> Bool
isPrime n = n > 1 && foldr (\x acc -> x * x > n || (n `mod` x /= 0 && acc)) True primes

q0011.hs

import           Control.Applicative
import           Control.Monad
import           Data.List

swapElem :: Int -> Int -> [a] -> [a]
swapElem i j xs = let xi = xs !! i
                      xj = xs !! j
                      left  = take i xs
                      mid   = take (j - i - 1) (drop (i + 1) xs)
                      right = drop (j + 1) xs
                  in  left ++ [xj] ++ mid ++ [xi] ++ right

solve :: Int -> [(Int, Int)] -> [Int]
solve w = foldl (\acc (a, b) -> swapElem (a - 1) (b - 1) acc) [1..w]

nyan :: String -> (Int, Int)
nyan = tup . words . map c2s
  where c2s c = if c == ',' then ' ' else c
        tup (a:b:_) = (read a, read b)

main :: IO ()
main = do
  w <- readLn
  n <- readLn
  xs <- map nyan <$> replicateM n getLine
  mapM_ print $ solve w xs

q0013.hs

{-# OPTIONS_GHC -Wall -Werror #-}

solve :: [Int] -> [Int]
solve = snd . foldl foldFunc ([], [])
  where foldFunc (x:xs, ys) 0 = (xs, ys ++ [x])
        foldFunc (xs, ys)   n = (n:xs, ys)

main :: IO ()
main = getContents >>= mapM_ (putStrLn . show) . solve . map read . words

q0014.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import System.IO

solve :: Int -> Int -> Int -> Int
solve _ 0 s = s
solve d n s = solve d next (s + ds)
  where next = n - d
        ds = d * next * next

main :: IO ()
main = do
  end <- isEOF
  if end
     then return ()
     else do
       d <- (readLn :: IO Int)
       print $ solve d 600 0
       main

q0015.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import Control.Monad

main :: IO ()
main = do
  n <- readLn :: IO Int
  replicateM_ n $ do
    [a, b] <- replicateM 2 readLn :: IO [Integer]
    let answer = show $ a + b
        digits = length answer
    putStrLn $ if digits > 80 then "overflow"
                              else answer

q0016.hs

import           Control.Applicative
import           Control.Monad
import           Data.List

toRadians :: Float -> Float
toRadians deg = deg * (pi / 180)

solve :: [(Float, Float)] -> (Float, Float)
solve = fst . foldl f ((0, 0), toRadians 90)
  where f ((x, y), r) (l, nd) = ((x + l * cos r, y + l * sin r), r - toRadians nd)

main :: IO ()
main = getContents >>= printResult . solve . parseInput
  where printResult (x, y) = let x' = truncate x
                                 y' = truncate y
                             in  print x' >> print y'

parseInput :: Read a => String -> [(a, a)]
parseInput = map (l2t . words) . lines . map c2s
  where c2s ',' = ' '
        c2s c   = c
        l2t (x:y:_) = (read x, read y)

example :: String
example = intercalate "\n"
          [ "56,65"
          , "97,54"
          , "64,-4"
          , "55,76"
          , "42,-27"
          , "43,80"
          , "87,-86"
          , "55,-6"
          , "89,34"
          , "95,5"
          , "0,0"
          ]

q0017.hs

import Data.Char

rotate :: Int -> [a] -> [a]
rotate _ [] = []
rotate n xs = zipWith const (drop n (cycle xs)) xs

caesar :: Int -> Char -> Char
caesar n c
  | isAsciiLower c = cs !! (ord c - ord 'a')
  | otherwise      = c
  where cs = rotate n ['a'..'z']

solver :: String -> String
solver xs = head $ dropWhile f [map (caesar i) xs | i <- [0..(ord 'z' - ord 'a')]]
  where f s = let ws = words s
              in  not $ "the" `elem` ws || "this" `elem` ws || "that" `elem` ws

main :: IO ()
main = getContents >>= mapM_ (putStrLn . solver) . lines

q0018.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import Data.List

parse :: String -> [Int]
parse = map read . words

main :: IO ()
main = getLine >>= putStrLn . intercalate " " . map show . reverse . sort . parse

q0019.hs

{-# OPTIONS_GHC -Wall -Werror #-}

fact :: Int -> Int
fact n = foldl1 (*) [1..n]

main :: IO ()
main = readLn >>= print . fact

q0020.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import Data.Char

main :: IO ()
main = getLine >>= putStrLn . map toUpper

q0021.hs

{-# OPTIONS_GHC -Wall -Werror #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM_)

isParallel ::(Eq a, Num a) => (a, a) -> (a, a) -> String
isParallel (ax, ay) (bx, by) = if ax * by - ay * bx == 0
                                  then "YES"
                                  else "NO"

solve :: (Eq a, Num a) => [a] -> String
solve xs = isParallel a b
  where x1:y1:x2:y2:x3:y3:x4:y4:_ = xs
        a = (x2 - x1, y2 - y1)
        b = (x4 - x3, y4 - y3)

main :: IO ()
main = do
  n <- readLn
  replicateM_ n $ do
    x <- (map read) <$> words <$> getLine :: IO [Float]
    putStrLn $ solve x

q0022.hs

import           Control.Applicative
import           Control.Monad
import           Data.Array
import           Data.List

solve :: [Int] -> Int
solve = maximum . scanl1 (\a b -> max (a + b) b)

main :: IO ()
main = getContents >>= loop . map read . lines
  where
    loop (0:_)  = return ()
    loop (x:xs) = let (as, rs) = splitAt x xs
                  in  print (solve as) >> loop rs

-- solve :: [Int] -> Int
-- solve as = maximum dp
--   where
--     dp = array (0, lns) [(i, f i) | i <- [0..lns]]
--
--     -- 0 ~ i 番目の間での部分和の最大値
--     f 0 = head as
--     f i = let ai = as !! i in  max ai (ai + dp ! (i - 1))
--
--     lns = length as - 1

q0024.hs

main :: IO ()
main = getContents >>= mapM_ (print . solve . read) . lines

solve :: Float -> Int
solve v = let t = v / 9.8
              y = 4.9 * (t ^ 2)
          in  1 + ceiling (y / 5.0)

q0025.hs

main :: IO ()
main = getContents >>= loop . map (map read . words) . lines
  where loop [] = return ()
        loop (as:bs:rs) = do
          printResult $ solve as bs
          loop rs

        printResult (h, b) = putStrLn $ show h ++ " " ++ show b

solve :: [Int] -> [Int] -> (Int, Int)
solve as bs = foldl f (0, 0) $ zip as bs
  where f hb@(h, b) (ai, bi)
          | ai == bi      = (h + 1, b)
          | bi `elem` as  = (h, b + 1)
          | otherwise     = hb

q0028.hs

import           Control.Arrow ((&&&))
import           Data.List

solve :: [Int] -> [Int]
solve xs = let nl  = map (head &&& length) $ group $ sort xs
               nl' = sortBy (\a b -> compare (snd b) (snd a)) nl
               lm  = snd $ head nl'
               nlm = map fst $ takeWhile (\(_, l) -> l == lm) nl'
           in  nlm

main :: IO ()
main = getContents >>= mapM_ print . solve . map read . lines

q0029.hs

import           Data.List

longest :: [[a]] -> [a]
longest = maximumBy (\a b -> compare (length a) (length b))

mrw :: String -> String
mrw = head . longest . group . sort . words

mlw :: String -> String
mlw = longest . words

main :: IO ()
main = getContents >>= mapM_ f . lines
  where f s = putStrLn $ mrw s ++ " " ++ mlw s

q0031.hs

import           Data.Bits

solve :: Int -> [Int]
solve x = let bits = filter (testBit x) [0..9] in map (2^) bits

main :: IO ()
main = getContents >>= mapM_ (printResult . solve . read) . lines
  where printResult = putStrLn . unwords . map show

q0032.hs

solve :: [[Float]] -> (Int, Int)
solve = foldl f (0, 0)
  where
    f r@(r1, r2) (ai:bi:ci:_)
      | ai == bi                = (r1, r2 + 1) -- ひし形
      | ai^2 + bi^2 == ci ^ 2   = (r1 + 1, r2) -- 長方形
      | otherwise               = r            -- その他

main :: IO ()
main = getContents >>= printResult . solve . parseInput
  where
    parseInput = map (map read . words) . lines . map c2s
    c2s ',' = ' '
    c2s c   = c
    printResult (r1, r2) = print r1 >> print r2

q0033.hs

import           Control.Monad
import           Data.Maybe

main :: IO ()
main = do
  n <- readLn
  replicateM_ n $ getLine >>= printResult . solve . map read . words
  where
    printResult True  = putStrLn "YES"
    printResult False = putStrLn "NO"

solve :: [Int] -> Bool
solve = isJust . foldM f (0, 0)
  where
    f (l, r) i
      | l < i     = Just (i, r)
      | r < i     = Just (l, i)
      | otherwise = Nothing

q0039.hs

import           Control.Applicative
import           Data.Char
import           Data.List

main :: IO ()
main = getContents >>= mapM_ (print . toArabic) . lines

toArabic :: String -> Int
toArabic = snd . foldl f (0, 0)
  where f (prev, sum) c
          | prev < toArabic' c = (toArabic' c, sum + toArabic' c - 2 * prev)
          | otherwise          = (toArabic' c, sum + toArabic' c)

        toArabic' 'M' = 1000
        toArabic' 'D' = 500
        toArabic' 'C' = 100
        toArabic' 'L' = 50
        toArabic' 'X' = 10
        toArabic' 'V' = 5
        toArabic' 'I' = 1
        toArabic' _   = 0

q0042.cc

#include <algorithm>
#include <array>
#include <iostream>
#include <tuple>
#include <vector>

using treasure_type = std::tuple<int, int>;

treasure_type maximum(const treasure_type& a, const treasure_type& b) {
  if (std::get<0>(a) == std::get<0>(b)) {
    return treasure_type{std::get<0>(a), std::min(std::get<1>(a), std::get<1>(b))};
  } else if (std::get<0>(a) > std::get<0>(b)) {
    return a;
  } else {
    return b;
  }
}

treasure_type solve(int wmax, const std::vector<treasure_type>& ts) {
  std::array<std::vector<treasure_type>, 2> dp{};
  dp[0].resize(wmax + 1);
  dp[1].resize(wmax + 1);
  for (auto i = 0u; i <= wmax; ++i) {
    dp[0][i] = treasure_type{0, 0};
  }

  for (auto i = 0u; i < ts.size(); ++i) {
    const auto& ti  = ts.at(i);
    const auto& dpp = dp.at(i % 2);
    auto& dpn       = dp.at((i + 1) % 2);
    for (auto j = 0u; j <= wmax; ++j) {
      if (j >= std::get<1>(ti)) {
        const auto& dppi2 = dpp[j - std::get<1>(ti)];

        dpn[j] = maximum(dpp.at(j), treasure_type{std::get<0>(ti) + std::get<0>(dppi2),
                                                  std::get<1>(ti) + std::get<1>(dppi2)});
      } else {
        dpn[j] = dpp.at(j);
      }
    }
  }

  return dp.at(ts.size() % 2).at(wmax);
}

auto main() -> int {
  for (int c = 1;; ++c) {
    int w;
    std::cin >> w;
    if (w == 0) break;

    int n;
    std::cin >> n;
    std::vector<treasure_type> ts{};
    for (int i = 0; i < n; ++i) {
      int vi, wi;
      std::scanf("%d,%d", &vi, &wi);
      ts.push_back(treasure_type{vi, wi});
    }

    const auto ans = solve(w, ts);
    std::cout << "Case " << c << ":\n"
              << std::get<0>(ans) << "\n"
              << std::get<1>(ans) << std::endl;
  }
}

q0044.hs

primes :: [Integer]
primes = 2 : filter isPrime [3,5..]
  where isPrime n = n > 1 && foldr (\x acc -> x * x > n || (n `mod` x /= 0 && acc)) True primes

solve :: Integer -> (Integer, Integer)
solve n = let (ps1, ps2) = span (<n) primes
              ps3        = dropWhile (<=n) ps2
          in  (last ps1, head ps3)

main :: IO ()
main = getContents >>= mapM_ (printResult . solve . read) . lines
  where printResult (a, b) = putStrLn $ show a ++ " " ++ show b

q0045.hs

round' :: (RealFrac a, Integral b) => a -> b
round' x
  | f <= -0.5 = n - 1
  | f >= 0.5  = n + 1
  | otherwise = n
  where (n, f) = properFraction x

solve :: [(Int, Int)] -> (Int, Int)
solve xs = let (tp, tn) = foldl f (0, 0) xs
               f (tp, tn) (p, n) = (tp + p * n, tn + n)
            in (tp, round' (fromIntegral tn / fromIntegral (length xs)))

main :: IO ()
main = getContents >>= printResult . solve . input
  where input = map (tup . words) . lines . map c2s
        c2s c = if c == ',' then ' ' else c
        tup (a:b:_) = (read a, read b)
        printResult (a, b) = print a >> print b

q0046.hs

import           Data.List

solve :: [Float] -> Float
solve xs = let xs' = sort xs in last xs' - head xs'

main :: IO ()
main = getContents >>= print . solve . map read . lines

q0047.hs

solve :: [(Char, Char)] -> Char
solve = foldl f 'A'
  where f c (a, b) | a == c    = b
                   | b == c    = a
                   | otherwise = c

main :: IO ()
main = getContents >>= putStrLn . return . solve . input
  where input = map tup . lines
        tup (a:',':b:_) = (a, b)

q0048.hs

solve :: Float -> String
solve w
  | w <= 48.0 = "light fly"
  | w <= 51.0 = "fly"
  | w <= 54.0 = "bantam"
  | w <= 57.0 = "feather"
  | w <= 60.0 = "light"
  | w <= 64.0 = "light welter"
  | w <= 69.0 = "welter"
  | w <= 75.0 = "light middle"
  | w <= 81.0 = "middle"
  | w <= 91.0 = "light heavy"
  | otherwise = "heavy"

main :: IO ()
main = getContents >>= mapM_ (putStrLn . solve . read) . lines

q0049.hs

import           Data.List

solve :: [String] -> (Int, Int, Int, Int)
solve = foldl f (0, 0, 0, 0)
  where f (a, b, ab, o) s
          | "AB" `isSuffixOf` s = (a, b, ab + 1, o)
          | "B"  `isSuffixOf` s = (a, b + 1, ab, o)
          | "A"  `isSuffixOf` s = (a + 1, b, ab, o)
          | "O"  `isSuffixOf` s = (a, b, ab, o + 1)
          | otherwise           = (a, b, ab, o)

main :: IO ()
main = getContents >>= printResult . solve . lines
  where printResult (a, b, ab, o) = do
          print a
          print b
          print ab
          print o

q0051.hs

import           Data.List

solve :: String -> Int
solve s = let ss  = sort s
              rss = reverse ss
          in  abs $ read ss - read rss

main :: IO ()
main = getLine >> getContents >>= mapM_ (print . solve) . lines

q0052.hs

countZero :: Integer -> Int
countZero n = length $ takeWhile (==0) [n `mod` (10 ^ i) | i <- [1..]]

main :: IO ()
main = getContents >>= mapM_ (print . f . read) . takeWhile (/="0") . lines
  where f n = countZero $ product [1..n]

q0053.hs

primes :: [Integer]
primes = 2 : filter isPrime [3,5..]
  where isPrime n = n > 1 && foldr (\x acc -> x * x > n || (n `mod` x /= 0 && acc)) True primes

solve :: Int -> Integer
solve n = sum $ take n primes

main :: IO ()
main = getContents >>= mapM_ (print . solve . read) . takeWhile (/="0") . lines

q0055.hs

import           Data.List

fs :: Double -> [Double]
fs a0 = concat $ iterate f [a0, a0 * 2]
  where f (_:an:_) = let an1 = an / 3
                         an2 = an1 * 2
                     in  [an1, an2]

s10 :: Double -> Double
s10 = sum . take 10 . fs

main :: IO ()
main = getContents >>= mapM_ (print . s10 . read) . lines

q0062.hs

import           Data.Char (ord)
import           Data.List (unfoldr)

solve :: [Int] -> Int
solve [] = 0
solve xs = head $ last $ unfoldr f xs
  where f [] = Nothing
        f xs = Just (xs, g [] xs)
        g ans [_]        = reverse ans
        g ans (x1:x2:xs) = g (((x1 + x2) `mod` 10):ans) (x2:xs)

main :: IO ()
main = getContents >>= mapM_ (print . solve . map (\c -> ord c - 0x30)) . lines

q0063.hs

isPalindrome :: String -> Bool
isPalindrome s = s == reverse s

main :: IO ()
main = getContents >>= print . length . filter isPalindrome . lines

q0073.hs

area :: Double -> Double -> Double
area x h = x * x + 2 * x * sqrt (halfx * halfx + h * h)
  where halfx = x / 2

main :: IO ()
main = getContents >>= f . map read . lines
  where f []       = return ()
        f [_]      = return ()
        f (0:0:_)  = return ()
        f (x:h:xs) = print (area x h) >> f xs

q0075.hs

bmi :: Float -> Float -> Float
bmi w h = w / (h ^ 2)

isFat :: Float -> Bool
isFat = (>=25.0)

solve :: [(Int, Float, Float)] -> [(Int, Float, Float)]
solve = filter f
  where f (_, w, h) = isFat $ bmi w h

main :: IO ()
main = getContents >>= mapM_ printResult . solve . input
  where input = map (tup . words) . lines . map c2s
        printResult (i, _, _) = print i
        tup (i:w:h:_) = (read i, read w, read h)
        c2s ',' = ' '
        c2s c   = c

q0077.hs

import           Data.Char (ord)

solve :: String -> String
solve = solve' []
  where solve' s []           = s
        solve' s ('@':n:c:xs) = solve' (s ++ replicate (ord n - 0x30) c) xs
        solve' s (x:xs)       = solve' (s ++ [x]) xs

main :: IO ()
main = getContents >>= mapM_ (putStrLn . solve) . lines

q0101.hs

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.Text.Lazy    as T
import qualified Data.Text.Lazy.IO as T

main :: IO ()
main = getLine >>
       T.getContents >>= mapM_ T.putStrLn . map (T.replace "Hoshino" "Hoshina") . T.lines