{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

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

solve :: [String] -> String
solve = dropWhile (== ' ') . solve'
 where
  solve' []                          = ""
  solve' (s : ss)
    | s `elem` [".", ",", "!", "?"] = s        ++ solve' ss
    | otherwise                     = " " ++ s ++ solve' ss

main :: IO ()
main = getLine >>= putStrLn . solve . split
 where
  split = filter (not . null) . split' []
   where
    split' ys []        = reverse ys : []
    split' ys (x : xs)
      | x == ' '        = reverse ys : split' [] xs
      | x `elem` ".,!?" = reverse ys : [x] : split' [] xs
      | otherwise       = split' (x : ys) xs

s=' '
f x a@(h:t)|x==s&&h<'A'=a|x>s&&x<'A'&&h>s=x:s:a|1>0=x:a
main=interact$foldr f"\n"

module Main where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import System.IO
import System.IO.Error

hReadMany :: (Char -> Bool) -> Handle -> IO String
hReadMany p h = do b <- (p <$> hLookAhead h) `catch` const (return False)
                   if b
                     then (:) <$> hGetChar h <*> hReadMany p h
                     else return ""

hSkipSpaces  = hReadMany isSpace
hReadNumeric = hReadMany (\c -> isDigit c || c `elem` ['.', '-', '+'])

readNum :: (Num a, Read a) => IO a
readNum = do hSkipSpaces stdin
             read <$> hReadNumeric stdin

readTerm :: IO String
readTerm = do hSkipSpaces stdin
              hReadMany (not . isSpace) stdin

isPunct '.' = True
isPunct ',' = True
isPunct '!' = True
isPunct '?' = True
isPunct _   = False

separate :: String -> [String]
separate "" = []
separate (c:cs) | isPunct c = [c] : separate cs
                | isLower c = let (tok, rest) = readOut (c:cs)
                              in tok : separate rest
                | isSpace c = separate cs
    where
      readOut (c:cs) | isLower c = let (tok, rest) = readOut cs
                                   in (c:tok, rest)
                     | otherwise = ("", c:cs)
      readOut "" = ("", "")

combine :: [String] -> String
combine (str:strings) = str ++ combine' strings
    where
      combine' [] = ""
      combine' (s:ss) | isPunct $ head s = s ++ combine' ss
                      | otherwise = " " ++ s ++ combine' ss

main = do line <- getLine
          putStrLn $ combine $ separate line

import Data.Char
import Data.List

isPunct x = x `elem` ".,!?"

solve :: String -> String
solve [] = []
solve (x:xs) | isSpace x = space xs
             | isPunct x = x : punc xs
             | otherwise = x : solve xs

-- seen a space
space [] = []
space (x:xs) | isSpace x = space xs
             | isPunct x = x : punc xs
             | otherwise = ' ' : x : solve xs

-- seen a punctuation mark
punc [] = ' ' : []
punc (x:xs) | isSpace x = punc xs
            | isPunct x = x : punc xs -- not possible
            | otherwise = ' ' : x : solve xs

main = do
  solve `fmap` getLine >>= putStrLn

dtw :: String -> String -> [String]
dtw [] akk = (reverse akk):[]
dtw (x:xs) akk | (x == ' ') = mk akk ++ dtw xs []
               | (x `elem` ",.!?") = mk akk ++ [[x]] ++ dtw xs []
               | otherwise = dtw xs (x:akk)
	where mk [] = []
	      mk a = [reverse a]

write [] = []
write (x:xs) | (x == []) = " " ++ write xs
             | ((head x) `elem` ",.!?") = "◁" ++ x ++ " " ++ write xs
             | otherwise = x ++ " " ++ write xs

cut :: String -> (Bool,String) -- Костыль 1
cut [] = (False,[])
cut (x:xs) | (x == '◁') = (True,(snd next))
           | (fst next) = (False,(snd next))
           | otherwise = (False,(x:(snd next)))
    where next = cut xs

dspase [] = [] -- Костыль 2
dspase a = reverse $ tail $ reverse $ a

main = do
			s <- getLine
			putStrLn $ dspase $ snd $ cut $ write $ dtw s []

znak = ",.!?"

solve :: String -> String
solve s = reverse (solve_ "" s)
  where
    solve_ :: String -> String -> String
    solve_ acc "" = acc
    solve_ acc (c:s)
      | c `elem` (znak ++ " ")   =  solveSpaces c acc s
      | otherwise                =  solve_ (c:acc) s

    solveSpaces :: Char -> String -> String -> String
    solveSpaces ' ' acc ""       =  acc
    solveSpaces  z  acc ""       =  z:acc
    solveSpaces  z  acc (' ':s)  =  solveSpaces z acc s
    solveSpaces ' ' acc (c:s)
      | c `elem` znak  =  solveSpaces c acc s
      | otherwise      =  solve_ (' ':acc) (c:s)
    solveSpaces  z acc (c:s)
      | c `elem` znak  =  error "SolveSpaces: '!!' or ',,' etc"
      | otherwise      =  solve_ (' ':z:acc) (c:s)

main :: IO ()
main = getLine >>= putStrLn . solve

import Data.Char
import Data.List

stick [] = []
stick (x:[a]:rest) | not $ isLetter a = (x ++ [a]):stick rest
                   | otherwise = x:stick ([a]:rest)
stick (x:rest) = x:stick rest

main = interact $ unwords . stick . (concatMap $ groupBy (\x y -> isLetter x == isLetter y)) . words

import Data.List

puncs = ".,!?"

solve :: String -> String
solve s = reverse $ f "" $ unwords $ words s
    where f s "" = s
          f s (c:c':cs) | c == ' ' && c' `elem` puncs = f s (c':cs)
                        | c' `elem` puncs = f (c:s) (c':cs)
          f s (c':c:cs) | c == ' ' && c' `elem` puncs = f (c:c':s) cs
                        | c' `elem` puncs = f (c:' ':c':s) cs
          f s (c:cs) = f (c:s) cs

main = do
    getLine >>= putStrLn . solve

main = do cs <- getLine
          putStrLn $ solve cs

solve :: String -> String
solve [] = []
solve (c:cs)
  | c == ' '  = if null cs' then  []
               else if isPunc $ head cs' then solve cs'
               else  c : solve cs'
  | isPunc c  = c : ' ' : solve cs'
  | otherwise = c : solve cs
   where cs' = dropWhile (' '==) cs

isPunc :: Char -> Bool
isPunc = flip elem ".,!?"

dtw :: String -> String -> [String]
dtw [] akk = akk:[]
dtw (x:xs) akk | (x == ' ') = mk akk ++ dtw xs []
               | (x `elem` ",.!?") = mk akk ++ [[x]] ++ dtw xs []
               | otherwise = dtw xs (x:akk)
	where mk [] = []
	      mk a = [reverse a]

write [] = []
write (x:xs) | (x == []) = " " ++ write xs
             | ((head x) `elem` ",.!?") = "\b" ++ x ++ " " ++ write xs
             | otherwise = x ++ " " ++ write xs

main = do
			s <- getLine
			putStrLn $ write $ dtw s []

dtw :: String -> String -> [String]
dtw [] akk = (reverse akk):[]
dtw (x:xs) akk | (x == ' ') = mk akk ++ dtw xs []
               | (x `elem` ",.!?") = mk akk ++ [[x]] ++ dtw xs []
               | otherwise = dtw xs (x:akk)
	where mk [] = []
	      mk a = [reverse a]

write [] = []
write (x:xs) | (x == []) = " " ++ write xs
             | ((head x) `elem` ",.!?") = "◁" ++ x ++ " " ++ write xs
             | otherwise = x ++ " " ++ write xs

cut :: String -> (Bool,String)
cut [] = (False,[])
cut (x:xs) | (x == '◁') = (True,(snd next))
           | (fst next) = (False,(snd next))
           | otherwise = (False,(x:(snd next)))
    where next = cut xs

main = do
			s <- getLine
			putStrLn $ snd $ cut $ write $ dtw s []

chakk [] = []
chakk (' ':xs) = chakk xs
chakk (x:xs) = x:(chakk xs)

parse :: String -> String -> [String]
parse [] akk = [reverse akk]
parse (' ':xs) akk = [reverse $ chakk akk] ++ parse xs []
parse (x:xs) akk = if (x `elem` ",.?!") then [reverse $ chakk akk] ++ [[x]] ++ parse xs []
                                        else parse xs (x:akk)

make [] = []
make (x:xs) | (x == []) = make xs
            | ((head x) `elem` ",.?!") = x ++ make xs
            | otherwise = (' ':x) ++ make xs

cut [] = []
cut (_:xs) = xs

main = do
         l <- getLine
         print $ cut $ make $ parse l []

-- Resubmit #1
import Data.Char
import Data.List

solve [] = []
solve (s:[x]:rest) | not $ isLetter x = s:[x]:" ":solve rest
                       | otherwise        = s:" ":[x]:" ":solve rest
solve (x:[]) = [x]
solve (x:xs) = x:" ":solve xs

main = interact $ concat . solve . (concatMap $ groupBy (\x y -> isLetter x == isLetter y)) . words

import Data.Char
import Data.List

stick [] = []
stick (x:[a]:rest) | not $ isLetter a = (x ++ [a]):stick rest
                   | otherwise = x:[a]:stick rest
stick (x:rest) = x:stick rest

main = interact $ unwords . stick . (concatMap $ groupBy (\x y -> isLetter x == isLetter y)) . words

import Data.List

solve :: String -> String
solve s = reverse $ f "" $ unwords $ words s
    where f s "" = s
          f s (c:',':cs) | c == ' ' = f s (',':cs)
                         | otherwise = f (c:s) (',':cs)
          f s (',':c:cs) | c == ' ' = f (c:',':s) cs
                         | otherwise = f (c:' ':',':s) cs
          f s (c:cs) = f (c:s) cs

main = do
    getLine >>= putStrLn . solve

import Data.List

puncs = ".,!?"

solve :: String -> String
solve s = reverse $ f "" $ unwords $ words s
    where f s "" = s
          f s (c:c':cs) | c == ' ' && c' `elem` puncs = f s (c':cs)
                        | c' `elem` puncs = f (c:s) (',':cs)
          f s (c':c:cs) | c == ' ' && c' `elem` puncs = f (c:c':s) cs
                        | c' `elem` puncs = f (c:' ':c':s) cs
          f s (c:cs) = f (c:s) cs

main = do
    getLine >>= putStrLn . solve

main = do cs <- getLine
          putStrLn $ solve cs

solve :: String -> String
solve [] = []
solve (c:cs)
  | c == ' ' = if null cs' then  []
               else if (head cs') == ',' then solve cs'
               else  c : solve cs'
  | c == ',' = c : ' ' : solve cs'
  | otherwise = c : solve cs
   where cs' = dropWhile (' '==) cs


sol :: [Int] -> Int
sol [0, 0] = 0
sol [h, m] = 24 * 60 - h * 60 - m

main = interact (unlines . map show . map (sol . map read) . map words .  tail . lines)

-- https://codeforces.com/problemset/problem/1283/A

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Char(digitToInt)

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

getInts :: Int -> IO [Int]
getInts n = fmap read <$> getLines n

getInt :: IO Int
getInt = fmap read getLine

readLine :: Read a => IO [a]
readLine = fmap (fmap read . words) getLine

solve :: [Int] -> String
solve [h, m] = show $ (23 - h) * 60 + (60 - m)

workProblem :: IO ()
workProblem = do
                n <- getInt
                input <- replicateM n (readLine :: IO [Int])
                () <- mapM_ putStrLn $ map solve input
                return ()

main :: IO ()
main = workProblem

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [h, m] <- getIntList
        print $ (23 - h) * 60 + (60 - m)

import Control.Monad

import Data.Char
import Data.List

solve :: (Int, Int) -> Int
solve (h, m) = (24 - h) * 60 - m

main :: IO ()
main = do
    input <- getContents
    putStrLn $ unlines . map (show . solve) $ zip (a input) (b input)
    where a            = map snd .filter (odd . fst) . zip [1..] . map (read :: String -> Int) . tail . words
          b            = map snd . filter (even .fst) . zip [1..] . map (read :: String -> Int) . tail . words

main = do
  firstLine <- getLine
  let n = (read::String->Int) firstLine
  mainLoop n

mainLoop :: Int -> IO ()
mainLoop n = do
  if n == 0
    then return ()
  else do
    line <- getLine
    let minutes = (show . minutesToChristmas . getTime) line
    putStrLn minutes
    mainLoop (n - 1)

getTime :: String -> (Int, Int)
getTime = (\[a,b] -> (a, b)) . map read . take 2 . words

minutesToChristmas :: (Int, Int) -> Int
minutesToChristmas (hours, minutes) = ((23 - hours) * 60) + 60 - minutes

import Control.Monad

solve :: [Int] -> Int
solve (h:m:_) = 60 * 24 - 60 * h - m

main :: IO ()
main = ids >>= mapM_ (fn >=> print)
  where ids   = enumFromTo 1 . read <$> getLine
        fn tc = solve . map read . words <$> getLine

import Control.Monad

solve :: Int -> Int -> Int
solve h m = 60*24-60*h-m

routine :: IO ()
routine = do
    [h,m] <- (map read.words) <$> getLine
    print $ solve h m

main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

main = interact $ unlines . map ((show . ((24*60) - ) . sum . zipWith (*) [60, 1]) . map (read :: String -> Int) . words )  . tail . lines

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

process (x:y:[]) = (24-x)*60-y

main::IO ()
main=do
  t<- read <$> getLine ::IO Int
  a<-  map( map read) <$> map words <$> replicateM t getLine::IO [[Int]]
  mapM_ print $ map process a

import Control.Applicative
import Control.Monad

solve h m = 24 * 60 - h * 60 - m

readInt :: String -> Integer
readInt = read

main = do
    n <- read <$> getLine
    replicateM_ n $ do
        [h, m] <- map readInt . words <$> getLine
        print $ solve h m

process :: (Int,Int) -> Int
process (h,m) = (24-h) * 60 - m

readInt :: String -> Int
readInt = read

readPair :: String -> (Int,Int)
readPair str = (a,b)
    where [a,b] = map read (words str)

main :: IO ()
main = do
    t <- fmap readInt getLine
    xs <- fmap (map readPair.lines) getContents
    putStrLn . unlines . map show $ map process xs

main :: IO ()

main = interact solve

solve :: String -> String
solve = buildup . map solver . breakdown
solver (x:y:[]) = 60 * (23 - x) + (60 - y)

breakdown :: String -> [[Int]]
breakdown = map (map readInt . words) . tail . lines

buildup :: [Int] -> String
buildup = unlines . map show

readInt :: String -> Int
readInt = read :: String -> Int

main = do
    line <- getLine
    putStrLn line


{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array (accumArray, assocs, elems, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray, STArray, runSTArray)
import Data.ByteString.Char8 (readInt, words, lines, getContents, getLine)
import Data.List (elemIndex)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
  [n, m, _] <- map readInt' . words <$> getLine
  es <- map ((\[u, v] -> (u, v + n)) . map readInt' . words) . lines <$> getContents

  let
    vs = runSTArray $ do
      let k = max n m
      vs <- newArray ((1, 1), (n+m, k)) 0 :: ST s (STArray s (Int, Int) Int)

      let
        look u = look' 1
          where
            look' i = do
              v <- readArray vs (u, i)
              if v == 0
                 then return i
                 else look' (i + 1)

      forM_ es $ \(u, v) -> do
        c <- look u
        d <- look v
        let s = c + d

        writeArray vs (u, c) v

        let
          set u v c = do
            w <- readArray vs (v, c)
            if w /= 0
              then do
                writeArray vs (v, c) u
                writeArray vs (w, c) 0
                let c' = s - c
                writeArray vs (v, c') w
                set v w c'
              else
                return (u, v, c)

        (u, v, c) <- set u v c
        writeArray vs (v, c) u

      return vs

    cs = accumArray (flip const) 0 ((0, 0), (n+m, n+m)) . map (\((v, c), u) -> ((v, u), c)) $ assocs vs

  if length es == 0
    then print 0
    else do
      let r = map (cs !) es
      print . maximum $ r
      putStr . unwords . map show $ r

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array (accumArray, assocs, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.List (elemIndex)
import Data.Maybe (fromJust)

main = do
  [n, m, _] <- map read . words <$> getLine
  es <- map ((\[u, v] -> (u, v + n)) . map read . words) . lines <$> getContents

  let
    vs = runSTArray $ do
      let k = max n m
      vs <- newArray ((1, 1), (n+m, k)) 0 :: ST s (STArray s (Int, Int) Int)

      forM_ es $ \(u, v) -> do
        let f u = (+1) . fromJust . elemIndex 0 <$> mapM (\i -> readArray vs (u, i)) [1..k]
        c <- f u
        d <- f v
        let s = c + d

        writeArray vs (u, c) v

        let
          set u v c = do
            w <- readArray vs (v, c)
            if w /= 0
              then do
                writeArray vs (v, c) u
                writeArray vs (w, c) 0
                let c' = s - c
                writeArray vs (v, c') w
                set v w c'
              else
                return (u, v, c)

        (v, u, c) <- set u v c
        writeArray vs (u, c) v

      return vs

    cs = accumArray (flip const) 0 ((0, 0), (n+m, n+m)) . map (\((v, c), u) -> ((v, u), c)) $ assocs vs

  putStr . unwords . map show $ map (cs !) es


{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    k <- readInt
    poems <- replicateM n (replicateM 4 readString)
    return (n, k, poems)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

isVowel a = a `elem` "aeiou"

checkRhyme :: Int -> ByteString -> ByteString -> Bool
checkRhyme k a b
    | length indexA < k = False
    | length indexB < k = False
    | otherwise         = suffixA == suffixB
  where
    indexA = reverse $ BS.findIndices isVowel a
    indexB = reverse $ BS.findIndices isVowel b

    suffixA = BS.drop (indexA !! (k - 1)) a
    suffixB = BS.drop (indexB !! (k - 1)) b

data Outcome = AABB
             | ABAB
             | ABBA
             | AAAA
             | NoneAbove
  deriving Eq

mergeOutcome NoneAbove _ = NoneAbove
mergeOutcome _ NoneAbove = NoneAbove
mergeOutcome AAAA x = x
mergeOutcome x AAAA = x
mergeOutcome a b | a == b    = a
                 | otherwise = NoneAbove

instance Show Outcome where
    show AABB = "aabb"
    show ABAB = "abab"
    show ABBA = "abba"
    show AAAA = "aaaa"
    show NoneAbove = "NO"

checkQuatrain k [a, b, c, d] | check a b && check a c && check a d = AAAA
                             | check a b && check c d              = AABB
                             | check a c && check b d              = ABAB
                             | check a d && check b c              = ABBA
                             | otherwise                           = NoneAbove
  where
    check = checkRhyme k

solve (n, k, poems) = foldl mergeOutcome AAAA (map (checkQuatrain k) poems)

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Data.List

isVowel 'a' = True
isVowel 'i' = True
isVowel 'u' = True
isVowel 'e' = True
isVowel 'o' = True
isVowel   _ = False

chop 0      _ = Just ""
chop _     [] = Nothing
chop k (x:xs)
   | isVowel x = fmap (x:) $ chop (k-1) xs
   | otherwise = fmap (x:) $ chop k xs

aaaa [] = Just True
aaaa ((Just a) : (Just b) : (Just c): (Just d) : es)
   | a == b && b == c && c == d = aaaa es
aaaa _ = Nothing

aabb [] = Just True
aabb ((Just a) : (Just b) : (Just c): (Just d) : es)
   | a == b && c == d = aabb es
aabb _ = Nothing

abab [] = Just True
abab ((Just a) : (Just b) : (Just c): (Just d) : es)
   | a == c && b == d = abab es
abab _ = Nothing

abba [] = Just True
abba ((Just a) : (Just b) : (Just c): (Just d) : es)
   | a == d && b == c = abba es
abba _ = Nothing

solve x
   | aaaa x == Just True = "aaaa"
   | aabb x == Just True = "aabb"
   | abab x == Just True = "abab"
   | abba x == Just True = "abba"
   | otherwise = "NO"

main = do
   [n, k] <- fmap (map read . words) getLine
   p <- mapM (fmap (chop k . reverse)) $ take (n*4) (repeat getLine)
   putStrLn $ solve p

-- vim: set expandtab:

import Data.List
import Data.Maybe
import Control.Monad

data Suffix = Suffix String
            | Invalid
            deriving Show

instance Eq Suffix where
    (Suffix a) == (Suffix b) = a == b
    _ == _ = False

type Quatrain = (Suffix, Suffix, Suffix, Suffix)

isAABB (a,b,c,d) = a == b && c == d
isABAB (a,b,c,d) = a == c && b == d
isABBA (a,b,c,d) = a == d && b == c

solve :: [Quatrain] -> String
solve list =
    let fs = [isAABB, isABAB, isABBA]
        ans  = map (flip all list) fs
        ans' = map snd $ filter fst $ zip ans ["aabb", "abab", "abba"]
    in case length ans' of
        0 -> "NO"
        1 -> head ans'
        _ -> "aaaa"

isVowel = isJust . flip elemIndex "aeiou"

suffix :: Int -> String -> Suffix
suffix k str =
    let xs   = findIndices isVowel str
        x    = drop (length xs - k) xs
    in if k > length xs
         then Invalid
         else Suffix $ drop (head x) str

main = do
    [n, k] <- (map read . words) `fmap` getLine
    list <- replicateM n $ do
        list <- replicateM 4 $ do
            [str] <- words `fmap` getLine
            return str
        let [a,b,c,d] = map (suffix k) list
        return (a,b,c,d)

    let ans = solve list
    putStrLn ans

-- lyrics
rifm = ["aabb", "abab", "abba", "aaaa"]

glasn a = (a=='a'||a=='e'||a=='i'||a=='o'||a=='u')--a=='y'

gnums [] s (a,_) = (a, read $ reverse s :: Int)
gnums (' ':xs) s _ = gnums xs [] (read $ reverse s :: Int,1)
gnums (x:xs) s a = gnums xs (x:s) a

getLyr 0 a _ = return a
getLyr i a n = do
				x <- getLine
				getLyr (i-1) ((gsfx n (reverse x) []):a) n

gsfx _ [] _ = "-"
gsfx 1 (x:xs) a = if (glasn x) then (x:a) else gsfx 1 xs (x:a)
gsfx n (x:xs) a = if (glasn x) then gsfx (n-1) xs (x:a) else gsfx n xs (x:a)

-- find type for one lir
find :: [String] -> String -> String -> String -> String
find [] _ _ akk = reverse akk
find (x:xs) a b akk | (x == "-") = "NO"
                    | (a == []) = find xs x b ('a':akk)
                    | ((x /= a) && (b == [])) = find xs a x ('b':akk)
                    | (x == a) = find xs a b ('a':akk)
                    | (x == b) = find xs a b ('b':akk)
                    | otherwise = "NO"

solve :: Int -> [String] -> [String] -> String -> String
solve 4 list lakk takk | (((takk == [])||(takk == "aaaa"))&&(foldr (||) False (map (newT==) rifm)))= solve 0 list [] newT
                       | ((takk == newT)||(newT == "aaaa")) = solve 0 list [] takk
                       | otherwise = "NO"
      where newT = (find lakk [] [] [])
solve _ [] _ t = t
solve n (x:xs) lakk t = solve (n+1) xs (x:lakk) t

main = do
			snums <- getLine
			let n = gnums snums [] (0,0) in
				do
					lyrics <- getLyr ((fst n)*4) [] (snd n)
					putStrLn $ solve 0 lyrics [] []

{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Data.Maybe

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

data RhymeScheme = None | Any | Aabb | Abba | Abab
  deriving (Eq,Show)

scheme [s1,s2,s3,s4]
  | s1 == s2 && s1 == s3 && s1 == s4 = Any
  | s1 == s2 && s3 == s4 = Aabb
  | s1 == s3 && s2 == s4 = Abab
  | s1 == s4 && s2 == s3 = Abba
  | otherwise = None

combine :: RhymeScheme -> RhymeScheme -> RhymeScheme
combine None _ = None
combine _ None = None
combine Any r  = r
combine r   Any = r
combine r   s  = if r == s then r else None

commonScheme as = go Any as
  where go r [] = r
        go r (a:as) = case combine r a of
                        None -> None
                        s    -> go s as

trimRight :: ByteString -> ByteString
trimRight bs = BS.take n bs
  where n = find (BS.length bs-1)
        find k | k < 0 = k+1
               | isSpace (BS.index bs k) = find (k-1)
               | otherwise = (k+1)

chunksOf :: Int -> [a] -> [[a]]
chunksOf n as =
  case splitAt n as of
    (bs,[]) -> [bs]
    (bs,cs) -> bs : chunksOf n cs

isVowel 'a' = True
isVowel 'e' = True
isVowel 'i' = True
isVowel 'o' = True
isVowel 'u' = True
isVowel _ = False

suffix :: Int -> ByteString -> Maybe ByteString
suffix k bs = go k (BS.length bs)
  where go 0 i = Just $ BS.drop i bs
        go _ 0 = Nothing
        go k i = if isVowel (BS.index bs (i-1))
                   then go (k-1) (i-1)
                   else go k (i-1)

solve k lines =
  if all isJust suffixes
    then commonScheme schemes
    else None
  where
    suffixes = map (suffix k) lines
    quatrains = chunksOf 4 (map fromJust suffixes)
    schemes = map scheme quatrains

main = do
  (n:k:_) <- map read <$> words <$> getLine
  lines <- replicateM (4*n) $ BS.pack <$> getLine
  let answer =
        case solve k lines of
          None -> "NO"
          Any  -> "aaaa"
          Aabb -> "aabb"
          Abba -> "abba"
          Abab -> "abab"
  putStrLn answer

import Data.List
import Data.Maybe
import Data.Bits
import qualified Data.ByteString.Char8 as BS

import Control.Monad

vowel x = x `elem` "aeiou"

combineTypes (a1, b1, c1) (a2, b2, c2) =
  (a1 && a2,
   b1 && b2,
   c1 && c2)

getType k [a, b, c, d] =
  (rhymes k a b && rhymes k c d,
   rhymes k a c && rhymes k b d,
   rhymes k a d && rhymes k b c)

rhymes k a b = let (suffixA, countA) = getSuffix a
                   (suffixB, countB) = getSuffix b
               in suffixA == suffixB && countA >= k && countB >= k
  where getSuffix x = BS.foldr collectSuffix (BS.empty, 0) x
        collectSuffix x (suffix, count) | count >= k = (suffix, count)
                                        | vowel x    = (BS.cons x suffix,
                                                        count + 1)
                                        | otherwise  = (BS.cons x suffix, count)

solve :: Int -> [[BS.ByteString]] -> String
solve k quantrains =
  case generalType of
    (True,  False, False) -> "aabb"
    (False, True,  False) -> "abab"
    (False, False, True)  -> "abba"
    (True,  True,  True)  -> "aaaa"
    _                     -> "NO"
  where generalType = foldl' combineTypes (True, True, True) types
        types = map (getType k) quantrains

main = do [n, k] <- fmap (map readInt . BS.words) BS.getLine
          quantrains <- replicateM n $ replicateM 4 BS.getLine
          putStrLn $ solve k quantrains

readInt line = fst $ fromJust $ BS.readInt line

import Control.Applicative

main = do [n,k] <- map read <$> words <$> getLine
          ss <- mapM (\i -> getLine) [1..(4*n)]
          putStrLn $ solve k n ss

solve :: Int -> Int -> [String] -> String
solve k _ ss = if any ((<k).length.filter isVowel) ss
                  then "NO"
                  else solve' $ map rhyme $ toQuat $ map (take' k.reverse) ss

solve' :: [String] -> String
solve' ss
  | null ss' = "aaaa"
  | all ((head ss') ==) (tail ss') = head ss'
  | otherwise = "NO"
   where ss' = filter (not.("aaaa"==)) ss

rhyme :: [String] -> String
rhyme (a:b:c:d:_)
  | (a==b)&&(b==c)&&(c==d) = "aaaa"
  | (a==b)&&(c==d) = "aabb"
  | (a==c)&&(b==d) = "abab"
  | (a==d)&&(b==c) = "abba"
  | otherwise = "NO"

toQuat :: [String] -> [[String]]
toQuat [] = []
toQuat (a:b:c:d:xs) = [a,b,c,d]: toQuat xs

isVowel :: Char -> Bool
isVowel c = elem c "aeiou"

take' :: Int -> String -> String
take' 0 _ = []
take' k cs = xs ++ [y] ++ (take' (k-1) ys)
   where (xs,(y:ys)) = break isVowel cs

module Main where

import Data.Array
import Data.List
import Data.Char

import Data.Time.Calendar

main = interact (solve . lines)

solve :: [String] -> String
solve lines = result where
    result = case rhyme of
        Nothing -> "NO"
        Just s  -> s
    rhyme = foldl1 (buildType) types
    types = map getType poem
    poem = quads $ tail endings
    endings = map (ending k) lines
    k = (read $ last $ words $ head lines) :: Int

buildType t (Just "aaaa")  = t
buildType (Just "aaaa") t  = t
buildType t1 t2
    | t1 == t2      = t1
    | otherwise     = Nothing

getType :: [Maybe String] -> Maybe String
getType quad@[a, b, c, d]
    | any (== Nothing) quad  = Nothing
    | all (== a) quad        = Just "aaaa"
    | a == b && c == d       = Just "aabb"
    | a == c && b == d       = Just "abab"
    | a == d && b == c       = Just "abba"
    | otherwise              = Nothing

quads :: [a] -> [[a]]
quads [] = []
quads (a : b : c : d : poem) = [a, b, c, d] : quads poem

ending :: Int -> String -> Maybe String
ending k = ending' [] k . reverse

ending' :: String -> Int -> String -> Maybe String
ending' result 0 _   = Just result
ending' result k []  = Nothing
ending' result k (c : str)
    | c `elem` "aeiou"  = ending' (c : result) (k - 1) str
    | otherwise         = ending' (c : result) k str

isVowel 'a' = True
isVowel 'i' = True
isVowel 'u' = True
isVowel 'e' = True
isVowel 'o' = True
isVowel   _ = False

chop k x
   | k > length x = ""
   | otherwise    = drop (length x - k) x

aaaa [] = True
aaaa (a:b:c:d:es)
   | a == b && b == c && c == d = aaaa es
   | otherwise = False

aabb [] = True
aabb (a:b:c:d:es)
   | a == b && c == d = aabb es
   | otherwise = False

abab [] = True
abab (a:b:c:d:es)
   | a == c && b == d = abab es
   | otherwise = False

abba [] = True
abba (a:b:c:d:es)
   | a == d && b == c = abba es
   | otherwise = False

solve x
   | aaaa x = "aaaa"
   | aabb x = "aabb"
   | abab x = "abab"
   | abba x = "abba"
   | otherwise = "NO"

main = do
   [n, k] <- fmap (map read . words) getLine
   p <- mapM (fmap (chop k . filter isVowel)) $ take (n*4) (repeat getLine)
   putStrLn $ solve p

-- vim: set expandtab:

isVowel 'a' = True
isVowel 'i' = True
isVowel 'u' = True
isVowel 'e' = True
isVowel 'o' = True
isVowel   _ = False

chop k x
   | k > length x = ""
   | otherwise    = drop (length x - k) x

aaaa [] = True
aaaa (a:b:c:d:es)
   | a == "" || b == "" || c == "" || d == "" = False
   | a == b && b == c && c == d = aaaa es
   | otherwise = False

aabb [] = True
aabb (a:b:c:d:es)
   | a == "" || b == "" || c == "" || d == "" = False
   | a == b && c == d = aabb es
   | otherwise = False

abab [] = True
abab (a:b:c:d:es)
   | a == "" || b == "" || c == "" || d == "" = False
   | a == c && b == d = abab es
   | otherwise = False

abba [] = True
abba (a:b:c:d:es)
   | a == "" || b == "" || c == "" || d == "" = False
   | a == d && b == c = abba es
   | otherwise = False

solve x
   | aaaa x = "aaaa"
   | aabb x = "aabb"
   | abab x = "abab"
   | abba x = "abba"
   | otherwise = "NO"

main = do
   [n, k] <- fmap (map read . words) getLine
   p <- mapM (fmap (chop k . filter isVowel)) $ take (n*4) (repeat getLine)
   putStrLn $ solve p

-- vim: set expandtab:

-- lyrics
rifm = ["aabb", "abab", "abba", "aaaa"]

glasn a = (a=='a'||a=='e'||a=='i'||a=='o'||a=='u')--a=='y'

gnums [] s (a,_) = (a, read $ reverse s :: Int)
gnums (' ':xs) s _ = gnums xs [] (read $ reverse s :: Int,1)
gnums (x:xs) s a = gnums xs (x:s) a

getLyr 0 a _ = return a
getLyr i a n = do
				x <- getLine
				getLyr (i-1) ((gsfx n (reverse x) []):a) n

gsfx _ [] _ = "-"
gsfx 1 (x:xs) a = if (glasn x) then (x:a) else gsfx 1 xs (x:a)
gsfx n (x:xs) a = if (glasn x) then gsfx (n-1) xs (x:a) else gsfx n xs (x:a)

-- find type for one lir
find :: [String] -> String -> String -> String -> String
find [] _ _ akk = reverse akk
find (x:xs) a b akk | (x == "-") = "NO"
                    | (a == []) = find xs x b ('a':akk)
                    | ((x /= a) && (b == [])) = find xs a x ('b':akk)
                    | (x == a) = find xs a b ('a':akk)
                    | (x == b) = find xs a b ('b':akk)
                    | otherwise = []

solve :: Int -> [String] -> [String] -> String -> String
solve 4 list lakk takk | (((takk == [])||(takk == "aaaa"))&&(foldr (||) False (map (newT==) rifm)))= solve 0 list [] newT
                       | ((takk == newT)||(newT == "aaaa")) = solve 0 list [] takk
                       | otherwise = "NO"
      where newT = (find lakk [] [] [])
solve _ [] _ t = t
solve n (x:xs) lakk t = solve (n+1) xs (x:lakk) t

main = do
			snums <- getLine
			let n = gnums snums [] (0,0) in
				do
					lyrics <- getLyr ((fst n)*4) [] (snd n)
					putStrLn $ solve 0 lyrics [] []

-- lyrics
rifm = ["aabb", "abab", "abba", "aaaa"]

glasn a = (a=='a'||a=='e'||a=='i'||a=='o'||a=='u')--a=='y'

gnums [] s (a,_) = (a, read $ reverse s :: Int)
gnums (' ':xs) s _ = gnums xs [] (read $ reverse s :: Int,1)
gnums (x:xs) s a = gnums xs (x:s) a

getLyr 0 a _ = return a
getLyr i a n = do
				x <- getLine
				getLyr (i-1) ((gsfx n (reverse x) []):a) n

gsfx _ [] a = a
gsfx 1 (x:xs) a = if (glasn x) then (x:a) else gsfx 1 xs (x:a)
gsfx n (x:xs) a = if (glasn x) then gsfx (n-1) xs (x:a) else gsfx n xs (x:a)

-- find type for one lir
find :: [String] -> String -> String -> String -> String
find [] _ _ akk = reverse akk
find (x:xs) a b akk | (a == []) = find xs x b ('a':akk)
                    | ((x /= a) && (b == [])) = find xs a x ('b':akk)
                    | (x == a) = find xs a b ('a':akk)
                    | (x == b) = find xs a b ('b':akk)
                    | otherwise = []

solve :: Int -> [String] -> [String] -> String -> String
solve 4 list lakk takk | (((takk == [])||(takk == "aaaa"))&&(foldr (||) False (map (newT==) rifm)))= solve 0 list [] newT
                       | ((takk == newT)||(newT == "aaaa")) = solve 0 list [] takk
                       | otherwise = "NO"
      where newT = (find lakk [] [] [])
solve _ [] _ t = t
solve n (x:xs) lakk t = solve (n+1) xs (x:lakk) t

main = do
			snums <- getLine
			let n = gnums snums [] (0,0) in
				do
					lyrics <- getLyr ((fst n)*4) [] (snd n)
					putStrLn $ solve 0 lyrics [] []

{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Data.Maybe

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

data RhymeScheme = None | Any | Aabb | Abba | Abab
  deriving (Eq,Show)

scheme [s1,s2,s3,s4]
  | s1 == s2 && s1 == s3 && s1 == s4 = Any
  | s1 == s2 && s3 == s4 = Aabb
  | s1 == s3 && s2 == s4 = Abab
  | s1 == s4 && s2 == s3 = Abba
  | otherwise = None

combine :: RhymeScheme -> RhymeScheme -> RhymeScheme
combine None _ = None
combine Any r  = r
combine r   s  = if r == s then r else None

commonScheme as = go Any as
  where go r [] = r
        go r (a:as) = case combine r a of
                        None -> None
                        s    -> go s as

trimRight :: ByteString -> ByteString
trimRight bs = BS.take n bs
  where n = find (BS.length bs-1)
        find k | k < 0 = k+1
               | isSpace (BS.index bs k) = find (k-1)
               | otherwise = (k+1)

chunksOf :: Int -> [a] -> [[a]]
chunksOf n as =
  case splitAt n as of
    (bs,[]) -> [bs]
    (bs,cs) -> bs : chunksOf n cs

isVowel 'a' = True
isVowel 'e' = True
isVowel 'i' = True
isVowel 'o' = True
isVowel 'u' = True
isVowel _ = False

suffix :: Int -> ByteString -> Maybe ByteString
suffix k bs = go k (BS.length bs)
  where go 0 i = Just $ BS.drop i bs
        go _ 0 = Nothing
        go k i = if isVowel (BS.index bs (i-1))
                   then go (k-1) (i-1)
                   else go k (i-1)

solve k lines =
  if all isJust suffixes
    then commonScheme schemes
    else None
  where
    suffixes = map (suffix k) lines
    quatrains = chunksOf 4 (map fromJust suffixes)
    schemes = map scheme quatrains

main = do
  (n:k:_) <- map read <$> words <$> getLine
  lines <- replicateM (4*n) $ trimRight <$> BS.getLine
  let answer =
        case solve k lines of
          None -> "NO"
          Any  -> "aaaa"
          Aabb -> "aabb"
          Abba -> "abba"
          Abab -> "abab"
  putStrLn answer

import Data.List
import Data.Maybe
import Data.Bits
import qualified Data.ByteString.Char8 as BS

import Control.Monad

vowel x = x `elem` "aeiou"

combineTypes (a1, b1, c1) (a2, b2, c2) =
  (a1 && a2,
   b1 && b2,
   c1 && c2)

getType k [a, b, c, d] =
  (rhymes k a b && rhymes k c d,
   rhymes k a c && rhymes k b d,
   rhymes k a d && rhymes k b c)

rhymes k a b = (getSuffix a) == (getSuffix b)
  where getSuffix x = fst $ BS.foldr collectSuffix (BS.empty, 0) x
        collectSuffix x (suffix, count) | count >= k = (suffix, count)
                                        | vowel x    = (BS.cons x suffix,
                                                        count + 1)
                                        | otherwise  = (BS.cons x suffix, count)

solve :: Int -> [[BS.ByteString]] -> String
solve k quantrains =
  case generalType of
    (True,  False, False) -> "aabb"
    (False, True,  False) -> "abab"
    (False, False, True)  -> "abba"
    (True,  True,  True)  -> "aaaa"
    _                     -> "NO"
  where generalType = foldl' combineTypes (True, True, True) types
        types = map (getType k) quantrains

main = do [n, k] <- fmap (map readInt . BS.words) BS.getLine
          quantrains <- replicateM n $ replicateM 4 BS.getLine
          putStrLn $ solve k quantrains

readInt line = fst $ fromJust $ BS.readInt line


{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Control.Applicative
import Control.Monad
import Data.Function (on)
import Data.List (sortBy)
import Data.Maybe
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C

readInt :: C.ByteString -> Int
readInt = fst . fromJust . C.readInt

gao :: S.Set (Int, Int) -> [((Int, Int), Int)] -> [((Int, Int), Int)]
gao _ [] = []
gao r (((c, p), i): cps) =
  case S.lookupGE (c, 0) r of
    Just k@(_, j) -> ((i, j), p): gao (S.delete k r) cps
    Nothing -> gao r cps

main :: IO ()
main = do
  n <- getInt
  cp <- replicateM n $ do
    (c:p:_) <- getInts
    return (c, p)
  _ <- getInt
  r <- S.fromList . flip zip [0..] <$> getInts
  let ans = gao r $ reverse $ sortBy (compare `on` snd . fst) $ zip cp [0 ..]
  putStrLn $ unwords $ map show [length ans, sum $ map snd ans]
  putStr $ unlines $ flip map ans $ \((i, j), _) ->
    show (i + 1) ++ " " ++ show (j + 1)
  where
  getInt = readInt <$> C.getLine
  getInts = map readInt . C.words <$> C.getLine

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
-- import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
-- import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
-- import Data.HashMap.Strict (HashMap)
-- import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  (qs, is) :: ([[Int]], [Int]) <- unzip . sort . (\l -> zip l [1..]) <$> replicateM n getInts

  k <- readLn
  (rs, js) :: ([Int], [Int]) <- unzip . sort . (\l -> zip l [1..]) <$> getInts

  cs :: IOUArray (Int, Int) Int <- newArray ((0, 0), (n, k)) 0
  ps :: IOUArray (Int, Int) Bool <- newArray ((0, 0), (n, k)) False

  forM_ (zip [1..n] qs) $ \(i, [c, p]) ->
    forM_ (zip [1..k] rs) $ \(j, r) -> do
      ci <- readArray cs (i-1, j)
      cj <- readArray cs (i, j-1)
      cij <- (p +) <$> readArray cs (i-1, j-1)

      if c <= r && cij >= ci && cij >= cj
        then do
          writeArray cs (i, j) cij
          writeArray ps (i, j) True
        else do
          writeArray cs (i, j) $ max ci cj
          writeArray ps (i, j) False

  cs' :: UArray (Int, Int) Int <- freeze cs
  ps' :: UArray (Int, Int) Bool <- freeze ps

  let
    is' :: UArray Int Int = listArray (1, n) is
    js' :: UArray Int Int = listArray (1, k) js

    restore 0 _ = []
    restore _ 0 = []

    restore i j
      | p = (is'!i, js'!j):(restore (i-1) (j-1))
      | cs'!(i-1, j) == c = restore (i-1) j
      | otherwise = restore i (j-1)
      where
        c = cs'!(i, j)
        p = ps'!(i, j)

  let
    ijs = restore n k
    c = cs'!(n, k)

  putStrLn $ show (length ijs) ++ " " ++ show c
  putStrLn $ unlines $ map (\(i, j) -> show i ++ " " ++ show j) ijs

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  n <- readLn
  rs <- fmap S.fromList . forM [1..n] $ \i -> do
    [c, p] <- map readInt.B.words <$> B.getLine
    return (p, c, i)
  _m <- getLine
  ts <- S.fromList.(`zip`[1..]).map readInt.B.words <$> B.getLine
  let (m,res,rts) = solve rs ts
  putStrLn $ shows m " " ++ show res
  putStr.unlines.map (unwords.map show) $ rts

solve :: S.Set (Int,Int,Int) -> S.Set (Int,Int) -> (Int,Int,[[Int]])
solve rs ts = go 0 0 [] rs ts
   where

     go !accept !money res !rs !ts
       | S.null rs = (accept,money,sort res)
       | ((p,c,i),rs') <-  S.deleteFindMax rs =
            case S.lookupGE (c,0) ts of
              Just (t,j) -> go (accept+1)
                               (money+p)
                               ([i,j]:res)
                               rs'
                               (S.delete (t,j) ts)
              Nothing -> go accept money res rs' ts

--{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Control.Applicative
import Control.Monad
import Data.Maybe
import Data.Function (on)
import Data.List (sortBy)
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

readInt :: C.ByteString -> Int
readInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map readInt . C.words <$> C.getLine

getInt :: IO Int
getInt = readInt <$> C.getLine

gao :: S.Set(Int, Int) -> [((Int, Int), Int)] -> [((Int, Int), Int)]
gao _ [] = []
gao set (((c, p), i) : xs) =
  case S.lookupGE (c, 0) set of
    Just k@(_, j) -> ((i, j), p) : gao (S.delete k set) xs
    Nothing -> gao set xs

main :: IO ()
main = do
  n <- getInt
  arr <- replicateM n $ do
    [c, p] <- getInts
    return (c, p)
  m <- getInt
  set <- S.fromList . flip zip [0..] <$> getInts
  let ans = gao set $ reverse . sortBy (compare `on` snd . fst) $ zip arr [0..]
  putStrLn $ unwords $ map show [length ans, sum $ map snd ans]
  putStr $ unlines . flip map ans $ \((i, j), _) -> show (i + 1) ++ " " ++ show (j + 1)


{-# LANGUAGE OverloadedStrings, BangPatterns #-}

import Data.Array
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as L

main :: IO ()
main = do
	(l:ls) <- L.lines `fmap` L.getContents
	let n = fst . fromJust . L.readInt $ l
	let strings = listArray (1, 2 * n) . concatMap L.words . init $ ls
	let nums = map (fst . fromJust . L.readInt) . L.words . last $ ls
	printResult . isLexographic strings $ nums

isLexographic :: Array Int L.ByteString -> [Int] -> Bool
isLexographic strings (ix:ixs) = foldl' process start ixs /= ""
	where
		ixMap x = let (!f, !s) = (strings ! (2 * x - 1), strings ! (2 * x)) in if f <= s then (f, s) else (s, f)
		start = fst . ixMap $ ix
		process !acc !x
			| acc == "" = ""
			| otherwise = if acc <= f
							then f
							else if acc <= s
								then s
								else ""
			where !(f, s) = ixMap x
isLexographic _ _ = True

printResult :: Bool -> IO ()
printResult b = putStrLn (if b then "YES" else "NO")

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (readLn >>= (`replicateM` B.getLine)) <*> (map (fst . fromJust . B.readInt) . B.words <$> B.getLine) >>= putStrLn . yesno

solve :: [B.ByteString] -> [Int] -> Bool
solve names hs = hs `isContainedIn` map snd (sort $ concat [ zip (B.words name) (repeat i) | (i, name) <- zip [1..] names ])

isContainedIn :: Eq a => [a] -> [a] -> Bool
isContainedIn xxs@(x:xs) (y:ys) | x == y = isContainedIn xs ys
                                | otherwise = isContainedIn xxs ys
isContainedIn [] _ = True
isContainedIn _ _ = False

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (readLn >>= (`replicateM` B.getLine)) <*> (map read . words <$> getLine) >>= putStrLn . yesno

solve :: [B.ByteString] -> [Int] -> Bool
solve names hs = hs `isContainedIn` map snd (sort $ concat [ zip (B.words name) (repeat i) | (i, name) <- zip [1..] names ])

isContainedIn :: Eq a => [a] -> [a] -> Bool
isContainedIn xxs@(x:xs) (y:ys) | x == y = isContainedIn xs ys
                                | otherwise = isContainedIn xxs ys
isContainedIn [] _ = True
isContainedIn _ _ = False

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  n <- readLn
  (names, permStrs) <- splitAt (2*n).B.words <$> B.getContents
  putStrLn.bool"YES""NO"$ solve (perse n names) $ map (subtract 1.readInt) permStrs

perse :: Int -> [B.ByteString] -> (Array Int B.ByteString, Array Int B.ByteString)
perse n bss = runST $ do
  fname <- newArray_ (0,n-1)  :: ST s (STArray s Int B.ByteString)
  sname <- newArray_ (0,n-1)  :: ST s (STArray s Int B.ByteString)
  let go !i (fn:sn:rest) = do
        unsafeWrite fname i $! fn
        unsafeWrite sname i $! sn
        go (i+1) rest
      go _ _ = (,)  <$> unsafeFreeze fname <*> unsafeFreeze sname
  go 0 bss

solve :: (Array Int B.ByteString, Array Int B.ByteString) -> [Int] -> Bool
solve (fname,sname) (p0:perm) = go (min (unsafeAt fname p0) (unsafeAt sname p0)) perm
   where
     go !cur (p:rest) = case [name | name<-[unsafeAt fname p, unsafeAt sname p],cur < name] of
                          [] -> False
                          names -> go (minimum names) rest
     go _ _ = True

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

main = do
  [n] <- getInts
  names <- Arr.listArray (0, n-1) <$> replicateM n (B.words <$> B.getLine)
  perm <- getInts
  let permed = map (\i -> names ! (i - 1)) perm
  let
    solution = go (B.pack "") permed where
      go prev [] = "YES"
      go prev (l : ls) = case sort (filter (>prev) l) of
        (h : _) -> go h ls
        [] -> "NO"
  putStrLn $ solution

-- helper functions --

readInt = fst . fromJust . B.readInt
getInts = map readInt . B.words <$> B.getLine

memoArr :: Ix i => (i, i) -> (i -> r) -> (i -> r)
memoArr range f = f' where
  f' i
    | Arr.inRange range i = arr ! i
    | otherwise = f i
  arr = Arr.listArray range (map f (Arr.range range))

dpArr :: Ix i => (i, i) -> ((i -> r) -> (i -> r)) -> (i -> r)
dpArr ixs f = fix (memoArr ixs . f)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    n <- readLn
    ss <- replicateM n $ l2p . sort . B.words <$> B.getLine
    ps <- readInts
    let a = listArray (1,n) ss :: Array Int (B.ByteString,B.ByteString)
        go [] s = True
        go ((s1,s2):ss) s | s < s1 = go ss s1
                          | s < s2 = go ss s2
                          | otherwise = False where
    putStrLn $ if (go (map (a !) ps) (B.pack "")) then "YES" else "NO"

{-# LANGUAGE OverloadedStrings, BangPatterns #-}

import Data.Array
import Data.Maybe
import Data.List
import qualified Data.ByteString.Lazy.Char8 as L

main :: IO ()
main = do
	(l:ls) <- L.lines `fmap` L.getContents
	let n = fst . fromJust . L.readInt $ l
	let strings = listArray (1, 2 * n) . concatMap L.words . init $ ls
	let nums = map (fst . fromJust . L.readInt) . L.words . last $ ls
	printResult . isLexographic strings $ nums

isLexographic :: Array Int L.ByteString -> [Int] -> Bool
isLexographic strings (ix:ixs) = foldl' process start ixs /= ""
	where
		ixMap x = let (!f, !s) = (strings ! (2 * x - 1), strings ! (2 * x)) in if f <= s then (f, s) else (s, f)
		start = fst . ixMap $ ix
		process !acc !x
			| acc == "" = ""
			| otherwise = if acc <= f
							then f
							else if acc <= s
								then s
								else ""
			where !(f, s) = ixMap x
isLexographic _ _ = True

printResult :: Bool -> IO ()
printResult b = putStrLn (if b then "YES" else "NO")

{-# LANGUAGE OverloadedStrings, BangPatterns #-}

import Data.Array
import Data.Maybe
import Data.List
import qualified Data.ByteString.Lazy.Char8 as L

main :: IO ()
main = do
	(l:ls) <- L.lines `fmap` L.getContents
	let n = fst . fromJust . L.readInt $ l
	let strings = listArray (1, 2 * n) . concatMap L.words . init $ ls
	let nums = map (fst . fromJust . L.readInt) . L.words . last $ ls
	printResult . isLexographic strings $ nums

isLexographic :: Array Int L.ByteString -> [Int] -> Bool
isLexographic strings (ix:ixs) = foldl' process start ixs /= ""
	where
		ixMap x = (strings ! (2 * x - 1), strings ! (2 * x))
		start = let (!f, !s) = ixMap ix in if f <= s then f else s
		process !acc !x
			| acc == "" = ""
			| otherwise = if acc <= f
							then f
							else if acc <= s
								then s
								else ""
			where (!f, !s) = ixMap x
isLexographic _ _ = True

printResult :: Bool -> IO ()
printResult b = putStrLn (if b then "YES" else "NO")

{-# LANGUAGE OverloadedStrings, BangPatterns #-}

import Data.Array
import Data.Maybe
import Data.List
import qualified Data.ByteString.Lazy.Char8 as L

main :: IO ()
main = do
	(l:ls) <- L.lines `fmap` L.getContents
	let n = fst . fromJust . L.readInt $ l
	let strings = listArray (1, 2 * n) . concatMap L.words . init $ ls
	let nums = map (fst . fromJust . L.readInt) . L.words . last $ ls
	printResult . isLexographic strings $ nums

isLexographic :: Array Int L.ByteString -> [Int] -> Bool
isLexographic strings ixs = foldl' process "a" ixs /= ""
	where
		 process !acc !x
		 	| acc == "" = ""
		 	| otherwise = if acc <= f
		 					then f
		 					else if acc <= s
		 						then s
		 						else ""
		 	where (!f, !s) = (strings ! (2 * x - 1), strings ! (2 * x))

printResult :: Bool -> IO ()
printResult b = putStrLn (if b then "YES" else "NO")


import Control.Monad

solve n y | y<=3 = 0
          | y>=n-1 = 0
          | otherwise = minimum [abs $ n-2-y,abs $ 2*y - n - 2, abs $ y-4]

main :: IO ()
main = do
    ts <- getLine

    replicateM (read ts) $ do
        input <- getLine
        let n = read  $ input ::Int
        putStrLn.show. maximum $ [solve n (2*div n 3), solve n (2*div n 3+1),solve n (2*div n 3+2)]

    return ()

import Data.Char

bruteForce m = (div m 3) - 1

main = do
  rawInput <- getContents
  let input = tail $ lines rawInput
  let ns = map read input :: [Int]
  let ms = map (\n -> n-3) ns
  let output = map bruteForce ms
  putStr (unlines $ map show output)

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n] <- ri
        return n
    mapM_ (putStrLn.show.solve) tcs

solve n = min (b-a) (c-b)
  where
    s = n-3
    a = 1 :: Int
    b = (s+1) `div` 3
    c = s - (a+b)

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= print . minP
minP n = let x = (div n 3) - 2 in
           max (min (x-1) (n - 4 - 2*x)) (min x (n - 4 - 2*(x+1)))

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x
--
-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: Int -> Int
solve n = maximum values
    where
        mid = n `div` 3
        values = do
            l1 <- [1 .. 10]
            l2 <- [mid - 10 .. mid + 10]
            let l3 = n - l1 - l2 - 3
            guard $ l1 > 0
            guard $ l2 > 0
            guard $ l3 > 0
            return $ minimum [abs (l1 - l2), abs (l2 - l3), abs (l3 - l1)]

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        let answer = solve n
        printf "%d\n" answer


import Control.Monad

getDiv :: Integer -> String
getDiv x = if (x <= 1399) then "Division 4" else if (x <= 1599) then "Division 3" else if (x <= 1899) then "Division 2" else "Division 1"

main :: IO ()
main = do
    t <- getLine
    nrs <- replicateM (read t) getLine
    mapM_ putStrLn $ map getDiv $ map (read :: String -> Integer) nrs

division :: Int -> String
division x | x >= 1900 = "Division 1" | x >= 1600 = "Division 2" | x >= 1400 = "Division 3" | otherwise = "Division 4"

solve :: [Int] -> [String]
solve xs = map division $ xs

main :: IO()
main = interact $ unlines . solve . tail . map read . words

parseInt :: String -> Int
parseInt s = read s :: Int

readInt :: IO Int
readInt = parseInt <$> getLine

readIntArr :: IO [Int]
readIntArr = do
  arr <- words <$> getLine
  pure $ map parseInt arr

calc :: Int -> String
calc x
  | x < 1400 = "Division 4"
  | x < 1600 = "Division 3"
  | x < 1900 = "Division 2"
  | otherwise = "Division 1"

solve :: IO ()
solve = do
  rating <- readInt
  putStrLn $ calc rating

for :: Int -> IO () -> IO ()
for 0 _ = pure ()
for i f = do
  f
  for (i - 1) f

main :: IO ()
main = do
  n <- readInt
  for n solve

main :: IO ()
main = interact $ unlines . map(f.(read::String->Int)).tail .words
f a
  |a <1400 = "Division 4"
  |a <1600 = "Division 3"
  |a <1900 = "Division 2"
  |otherwise = "Division 1"

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: Int -> Int
solve rating
    | 1_900 <= rating = 1
    | 1_600 <= rating && rating <= 1_899 = 2
    | 1_400 <= rating && rating <= 1_599 = 3
    | rating <= 1_399 = 4

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    replicateM_ n $ do
        rating <- B8.getLine <&> readIntB8
        let answer = solve rating
        printf "Division %d\n" answer

division :: Int -> String
division x | x >= 1900 = "Division 1" | x >= 1600 = "Division 2" | x >= 1400 = "Division 3" | otherwise = "Division 4"

main :: IO()
main = interact $ unlines . map show . map division . tail . map read . words

division :: Int -> String
division x | x >= 1900 = "Division 1" | x >= 1600 = "Division 2" | x >= 1400 = "Division 3" | otherwise = "Division 4"

main :: IO()
main = interact $ show . unwords . map division . tail . map read . words

division :: Int -> String
division x | x >= 1900 = "Division 1 " | x >= 1600 = "Division 2 " | x >= 1400 = "Division 3 " | otherwise = "Division 4 "

main :: IO()
main = interact $ show . unlines . map division . tail . map read . words

division :: Int -> String
division x | x >= 1900 = "Division 1" | x >= 1600 = "Division 2" | x >= 1400 = "Division 3" | otherwise = "Division 4"

main :: IO()
main = interact $ show . unlines . map division . tail . map read . words

division :: Int -> String
division x | x >= 1900 = "Division 1\n" | x >= 1600 = "Division 2\n" | x >= 1400 = "Division 3\n" | otherwise = "Division 4\n"

main :: IO()
main = interact $ unlines . map show . map division . tail . map read . words

import Control.Monad

getDiv :: Integer -> String
getDiv x = if (x <= 1399) then "Division 4" else if (x <= 1599) then "Division 3" else if (x <= 1899) then "Division 2" else "Division 1"

main :: IO ()
main = do
    t <- getLine
    nrs <- replicateM (read t) getLine
    mapM_ print $ map getDiv $ map (read :: String -> Integer) nrs

parseInt :: String -> Int
parseInt s = read s :: Int

readInt :: IO Int
readInt = parseInt <$> getLine

readIntArr :: IO [Int]
readIntArr = do
  arr <- words <$> getLine
  pure $ map parseInt arr

calc :: Int -> String
calc x
  | x < 1400 = "Division 4"
  | x < 1600 = "Division 3"
  | x < 1900 = "Division 2"
  | otherwise = "Division 1"

solve :: IO ()
solve = do
  rating <- readInt
  print $ calc rating

for :: Int -> IO () -> IO ()
for 0 _ = pure ()
for i f = do
  f
  for (i - 1) f

main :: IO ()
main = do
  n <- readInt
  for n solve


import qualified Data.List as L
getRoute a b c i = (sum (take i a)) + (sum (drop i b)) + (c !! i)
main=do
  w0 <-getLine
  let n=read w0::Int
  w1 <- getLine
  let a=[read n::Int|n<-words(w1)]
  w2 <- getLine
  let b=[read n::Int|n<-words(w2)]
  w3 <- getLine
  let c=[read n::Int|n<-words(w3)]
  let s=L.sort $ map (getRoute a b c) [0..(n-1)]
  print ((s !! 0)+(s !! 1))

import Data.List

readInts = getLine >>= (\line -> return (map read (words line) :: [Int]))

cross a1 a2 n [] 0 = []
cross a1 a2 n (r : rs) x = (sum (take c a1) + sum (drop c a2) + r) : (cross a1 a2 n rs (x - 1)) where c = n - x

main = do
  n <- (readInts >>= (\l -> return (head l)))
  a1 <- readInts
  a2 <- readInts
  s <- readInts
  let x : y : _ = sort (cross a1 a2 n s n)
  putStrLn (show (x + y))

import Data.List

main :: IO()
main = print . solve . map read . words =<< getContents

solve :: [Int] -> Int
solve a = let n = head a
              r1 = drop 1 a
              a1 = take (n - 1) r1
              r2 = drop (n - 1) r1
              a2 = take (n - 1) r2
              b = drop (n - 1) r2
          in solve' n a1 a2 b

solve' :: Int -> [Int] -> [Int] -> [Int] -> Int
solve' n a1 a2 b = let p = sort $ map (dist a1 a2 b) [0..(n-1)]
                   in (head p) + (p !! 1)

dist :: [Int] -> [Int] -> [Int] -> Int -> Int
dist a1 a2 b i = (sum (take i a1)) + (sum (drop i a2)) + (b !! i)

main = do
    n <- readLn :: IO Int
    r1 <- fmap ((map read) . words) getLine :: IO [Int]
    r2 <- fmap ((map read) . words) getLine :: IO [Int]
    imd <- fmap ((map read) . words) getLine :: IO [Int]
    let p1 = scanl (+) 0 r1
        p2 = scanr (+) 0 r2
        list = zip (go p1 p2 imd) [1..]
        ans = minimum [x+y | (x,n1) <-list , (y,n2)<-list , n1/=n2]
    print ans

go p1 p2 imd = zipWith3 (\x y z -> x+y+z) p1 p2 imd


import Control.Monad (forM_)
import Data.List (sortBy, findIndex)

-- fst of first time when snd >= fst
-- if snd never becomes >= fst, then snd of last item

solve :: [Int] -> [Int] -> Int
solve as bs = rez
  where z = zip as bs
        sf x y = compare (fst y) (fst x)
        scf x y = (fst y, snd x + snd y)
        scl = tail . scanl scf (0, 0) $ sortBy sf z
        mi = findIndex (\(x, y) -> y > x) scl
        rez = case mi of
                Just i -> rez' i
                Nothing -> snd $ last scl
        rez' i = if i == 0 then fst (head scl) else max (snd $ scl !! (i - 1)) (fst (scl !! i))

main :: IO ()
main = getLine >>= pure . read >>= \t -> forM_ [1..t] . const $ getLine >> do
         as <- pure . map read . words =<< getLine
         bs <- pure . map read . words =<< getLine
         putStrLn . show $ solve as bs

import Control.Monad (forM_)
import Data.List (sortBy, genericSplitAt)

-- * Types and utilities

-- | A splitting strategy.
data Splitter a = Splitter { delimiter        :: Delimiter a
                               -- ^ What delimiter to split on
                           , delimPolicy      :: DelimPolicy
                               -- ^ What to do with delimiters (drop
                               --   from output, keep as separate
                               --   elements in output, or merge with
                               --   previous or following chunks)
                           , condensePolicy   :: CondensePolicy
                               -- ^ What to do with multiple
                               --   consecutive delimiters
                           , initBlankPolicy  :: EndPolicy
                               -- ^ Drop an initial blank?
                           , finalBlankPolicy :: EndPolicy
                               -- ^ Drop a final blank?
                           }

-- | The default splitting strategy: keep delimiters in the output
--   as separate chunks, don't condense multiple consecutive
--   delimiters into one, keep initial and final blank chunks.
--   Default delimiter is the constantly false predicate.
--
--   Note that 'defaultSplitter' should normally not be used; use
--   'oneOf', 'onSublist', or 'whenElt' instead, which are the same as
--   the 'defaultSplitter' with just the delimiter overridden.
--
--   The 'defaultSplitter' strategy with any delimiter gives a
--   maximally information-preserving splitting strategy, in the sense
--   that (a) taking the 'concat' of the output yields the original
--   list, and (b) given only the output list, we can reconstruct a
--   'Splitter' which would produce the same output list again given
--   the original input list.  This default strategy can be overridden
--   to allow discarding various sorts of information.
defaultSplitter :: Splitter a
defaultSplitter = Splitter { delimiter        = Delimiter [const False]
                           , delimPolicy      = Keep
                           , condensePolicy   = KeepBlankFields
                           , initBlankPolicy  = KeepBlank
                           , finalBlankPolicy = KeepBlank
                           }

-- | A delimiter is a list of predicates on elements, matched by some
--   contiguous subsequence of a list.
newtype Delimiter a = Delimiter [a -> Bool]

-- | Try to match a delimiter at the start of a list, either failing
--   or decomposing the list into the portion which matched the delimiter
--   and the remainder.
matchDelim :: Delimiter a -> [a] -> Maybe ([a],[a])
matchDelim (Delimiter []) xs = Just ([],xs)
matchDelim (Delimiter _)  [] = Nothing
matchDelim (Delimiter (p:ps)) (x:xs)
  | p x       = matchDelim (Delimiter ps) xs >>= \(h,t) -> Just (x:h,t)
  | otherwise = Nothing

-- | What to do with delimiters?
data DelimPolicy = Drop      -- ^ Drop delimiters from the output.
                 | Keep      -- ^ Keep delimiters as separate chunks
                             --   of the output.
                 | KeepLeft  -- ^ Keep delimiters in the output,
                             --   prepending them to the following
                             --   chunk.
                 | KeepRight -- ^ Keep delimiters in the output,
                             --   appending them to the previous chunk.
  deriving (Eq, Show)

-- | What to do with multiple consecutive delimiters?
data CondensePolicy = Condense         -- ^ Condense into a single delimiter.
                    | DropBlankFields  -- ^ Keep consecutive
                                       --   delimiters separate, but
                                       --   don't insert blank chunks in
                                       --   between them.
                    | KeepBlankFields  -- ^ Insert blank chunks
                                       --   between consecutive
                                       --   delimiters.
  deriving (Eq, Show)

-- | What to do with a blank chunk at either end of the list
--   (/i.e./ when the list begins or ends with a delimiter).
data EndPolicy = DropBlank | KeepBlank
  deriving (Eq, Show)

-- | Tag chunks as delimiters or text.
data Chunk a = Delim [a] | Text [a]
  deriving (Show, Eq)

-- | Internal representation of a split list that tracks which pieces
--   are delimiters and which aren't.
type SplitList a = [Chunk a]

-- | Untag a 'Chunk'.
fromElem :: Chunk a -> [a]
fromElem (Text as) = as
fromElem (Delim as) = as

-- | Test whether a 'Chunk' is a delimiter.
isDelim :: Chunk a -> Bool
isDelim (Delim _) = True
isDelim _ = False

-- | Test whether a 'Chunk' is text.
isText :: Chunk a -> Bool
isText (Text _) = True
isText _ = False

-- * Implementation

-- | Given a delimiter to use, split a list into an internal
--   representation with chunks tagged as delimiters or text.  This
--   transformation is lossless; in particular,
--
-- @
--   'concatMap' 'fromElem' ('splitInternal' d l) == l.
-- @
splitInternal :: Delimiter a -> [a] -> SplitList a
splitInternal _ [] = []
splitInternal d xxs
  | null xs   = toSplitList match
  | otherwise = Text xs : toSplitList match
 where
  (xs,match) = breakDelim d xxs

  toSplitList Nothing             = []
  toSplitList (Just ([],r:rs))    = Delim [] : Text [r] : splitInternal d rs
  toSplitList (Just (delim,rest)) = Delim delim : splitInternal d rest

breakDelim :: Delimiter a -> [a] -> ([a],Maybe ([a],[a]))
breakDelim (Delimiter []) xs         = ([],Just ([],xs))
breakDelim _              []         = ([],Nothing)
breakDelim d              xxs@(x:xs) =
  case matchDelim d xxs of
      Nothing    -> let (ys,match) = breakDelim d xs in (x:ys,match)
      Just match -> ([], Just match)

-- | Given a split list in the internal tagged representation, produce
--   a new internal tagged representation corresponding to the final
--   output, according to the strategy defined by the given
--   'Splitter'.
postProcess :: Splitter a -> SplitList a -> SplitList a
postProcess s = dropFinal (finalBlankPolicy s)
              . dropInitial (initBlankPolicy s)
              . doMerge (delimPolicy s)
              . doDrop (delimPolicy s)
              . insertBlanks (condensePolicy s)
              . doCondense (condensePolicy s)

-- | Drop delimiters if the 'DelimPolicy' is 'Drop'.
doDrop :: DelimPolicy -> SplitList a -> SplitList a
doDrop Drop l = [ c | c@(Text _) <- l ]
doDrop _ l = l

-- | Condense multiple consecutive delimiters into one if the
--   'CondensePolicy' is 'Condense'.
doCondense :: CondensePolicy -> SplitList a -> SplitList a
doCondense Condense ls = condense' ls
  where condense' [] = []
        condense' (c@(Text _) : l) = c : condense' l
        condense' l = (Delim $ concatMap fromElem ds) : condense' rest
          where (ds,rest) = span isDelim l
doCondense _ ls = ls

-- | Insert blank chunks between any remaining consecutive delimiters
--   (unless the condense policy is 'DropBlankFields'), and at the
--   beginning or end if the first or last element is a delimiter.
insertBlanks :: CondensePolicy -> SplitList a -> SplitList a
insertBlanks _ [] = [Text []]
insertBlanks cp (d@(Delim _) : l) = Text [] : insertBlanks' cp (d:l)
insertBlanks cp l = insertBlanks' cp l

-- | Insert blank chunks between consecutive delimiters.
insertBlanks' :: CondensePolicy -> SplitList a -> SplitList a
insertBlanks' _ [] = []
insertBlanks' cp@DropBlankFields (d1@(Delim _) : d2@(Delim _) : l)
  = d1           : insertBlanks' cp (d2:l)
insertBlanks' cp (d1@(Delim _) : d2@(Delim _) : l)
  = d1 : Text [] : insertBlanks' cp (d2:l)
insertBlanks' _ [d@(Delim _)] = [d, Text []]
insertBlanks' cp (c : l) = c : insertBlanks' cp l

-- | Merge delimiters into adjacent chunks according to the 'DelimPolicy'.
doMerge :: DelimPolicy -> SplitList a -> SplitList a
doMerge KeepLeft = mergeLeft
doMerge KeepRight = mergeRight
doMerge _ = id

-- | Merge delimiters with adjacent chunks to the right (yes, that's
--   not a typo: the delimiters should end up on the left of the
--   chunks, so they are merged with chunks to their right).
mergeLeft :: SplitList a -> SplitList a
mergeLeft [] = []
mergeLeft ((Delim d) : (Text c) : l) = Text (d++c) : mergeLeft l
mergeLeft (c : l) = c : mergeLeft l

-- | Merge delimiters with adjacent chunks to the left.
mergeRight :: SplitList a -> SplitList a
mergeRight [] = []
-- below fanciness is with the goal of laziness: we want to start returning
-- stuff before we've necessarily discovered a delimiter, in case we're
-- processing some infinite list with no delimiter
mergeRight ((Text c) : l) = Text (c++d) : mergeRight lTail
  where (d, lTail) = case l of
                     Delim d' : l' -> (d', l')
                     _ -> ([], l)
mergeRight (c : l) = c : mergeRight l

-- | Drop an initial blank chunk according to the given 'EndPolicy'.
dropInitial :: EndPolicy -> SplitList a -> SplitList a
dropInitial DropBlank (Text [] : l) = l
dropInitial _ l = l

-- | Drop a final blank chunk according to the given 'EndPolicy'.
dropFinal :: EndPolicy -> SplitList a -> SplitList a
dropFinal _         [] = []
dropFinal DropBlank l  = dropFinal' l
  where dropFinal' []        = []
        dropFinal' [Text []] = []
        dropFinal' (x:xs)    = x:dropFinal' xs
dropFinal _         l  = l

-- * Combinators

-- | Split a list according to the given splitting strategy.  This is
--   how to \"run\" a 'Splitter' that has been built using the other
--   combinators.
split :: Splitter a -> [a] -> [[a]]
split s = map fromElem . postProcess s . splitInternal (delimiter s)

-- ** Basic strategies
--
-- $ All these basic strategies have the same parameters as the
-- 'defaultSplitter' except for the delimiters.

-- | A splitting strategy that splits on any one of the given
--   elements.  For example:
--
-- > split (oneOf "xyz") "aazbxyzcxd" == ["aa","z","b","x","","y","","z","c","x","d"]
oneOf :: Eq a => [a] -> Splitter a
oneOf elts = defaultSplitter { delimiter = Delimiter [(`elem` elts)] }

-- | A splitting strategy that splits on the given list, when it is
--   encountered as an exact subsequence.  For example:
--
-- > split (onSublist "xyz") "aazbxyzcxd" == ["aazb","xyz","cxd"]
--
--   Note that splitting on the empty list is a special case, which
--   splits just before every element of the list being split.  For example:
--
-- > split (onSublist "") "abc" == ["","","a","","b","","c"]
-- > split (dropDelims . dropBlanks $ onSublist "") "abc" == ["a","b","c"]
--
--   However, if you want to break a list into singleton elements like
--   this, you are better off using @'chunksOf' 1@, or better yet,
--   @'map' (:[])@.
onSublist :: Eq a => [a] -> Splitter a
onSublist lst = defaultSplitter { delimiter = Delimiter (map (==) lst) }

-- | A splitting strategy that splits on any elements that satisfy the
--   given predicate.  For example:
--
-- > split (whenElt (<0)) [2,4,-3,6,-9,1] == [[2,4],[-3],[6],[-9],[1]]
whenElt :: (a -> Bool) -> Splitter a
whenElt p = defaultSplitter { delimiter = Delimiter [p] }

-- ** Strategy transformers

-- | Drop delimiters from the output (the default is to keep
--   them). For example,
--
-- > split (oneOf ":") "a:b:c" == ["a", ":", "b", ":", "c"]
-- > split (dropDelims $ oneOf ":") "a:b:c" == ["a", "b", "c"]
dropDelims :: Splitter a -> Splitter a
dropDelims s = s { delimPolicy = Drop }

-- | Keep delimiters in the output by prepending them to adjacent
--   chunks.  For example:
--
-- > split (keepDelimsL $ oneOf "xyz") "aazbxyzcxd" == ["aa","zb","x","y","zc","xd"]
keepDelimsL :: Splitter a -> Splitter a
keepDelimsL s = s { delimPolicy = KeepLeft }

-- | Keep delimiters in the output by appending them to adjacent
--   chunks. For example:
--
-- > split (keepDelimsR $ oneOf "xyz") "aazbxyzcxd" == ["aaz","bx","y","z","cx","d"]
keepDelimsR :: Splitter a -> Splitter a
keepDelimsR s = s { delimPolicy = KeepRight }

-- | Condense multiple consecutive delimiters into one.  For example:
--
-- > split (condense $ oneOf "xyz") "aazbxyzcxd" == ["aa","z","b","xyz","c","x","d"]
-- > split (dropDelims $ oneOf "xyz") "aazbxyzcxd" == ["aa","b","","","c","d"]
-- > split (condense . dropDelims $ oneOf "xyz") "aazbxyzcxd" == ["aa","b","c","d"]
condense :: Splitter a -> Splitter a
condense s = s { condensePolicy = Condense }

-- | Don't generate a blank chunk if there is a delimiter at the
--   beginning.  For example:
--
-- > split (oneOf ":") ":a:b" == ["",":","a",":","b"]
-- > split (dropInitBlank $ oneOf ":") ":a:b" == [":","a",":","b"]
dropInitBlank :: Splitter a -> Splitter a
dropInitBlank s = s { initBlankPolicy = DropBlank }

-- | Don't generate a blank chunk if there is a delimiter at the end.
--   For example:
--
-- > split (oneOf ":") "a:b:" == ["a",":","b",":",""]
-- > split (dropFinalBlank $ oneOf ":") "a:b:" == ["a",":","b",":"]
dropFinalBlank :: Splitter a -> Splitter a
dropFinalBlank s = s { finalBlankPolicy = DropBlank }

-- | Don't generate blank chunks between consecutive delimiters.
--   For example:
--
-- > split (oneOf ":") "::b:::a" == ["",":","",":","b",":","",":","",":","a"]
-- > split (dropInnerBlanks $ oneOf ":") "::b:::a" == ["", ":",":","b",":",":",":","a"]
dropInnerBlanks :: Splitter a -> Splitter a
dropInnerBlanks s = s { condensePolicy = DropBlankFields }

-- ** Derived combinators

-- | Drop all blank chunks from the output, and condense consecutive
--   delimiters into one.  Equivalent to @'dropInitBlank'
--   . 'dropFinalBlank' . 'condense'@.  For example:
--
-- > split (oneOf ":") "::b:::a" == ["",":","",":","b",":","",":","",":","a"]
-- > split (dropBlanks $ oneOf ":") "::b:::a" == ["::","b",":::","a"]
dropBlanks :: Splitter a -> Splitter a
dropBlanks = dropInitBlank . dropFinalBlank . condense

-- | Make a strategy that splits a list into chunks that all start
--   with the given subsequence (except possibly the first).
--   Equivalent to @'dropInitBlank' . 'keepDelimsL' . 'onSublist'@.
--   For example:
--
-- > split (startsWith "app") "applyapplicativeapplaudapproachapple" == ["apply","applicative","applaud","approach","apple"]
startsWith :: Eq a => [a] -> Splitter a
startsWith = dropInitBlank . keepDelimsL . onSublist

-- | Make a strategy that splits a list into chunks that all start
--   with one of the given elements (except possibly the first).
--   Equivalent to @'dropInitBlank' . 'keepDelimsL' . 'oneOf'@.  For
--   example:
--
-- > split (startsWithOneOf ['A'..'Z']) "ACamelCaseIdentifier" == ["A","Camel","Case","Identifier"]
startsWithOneOf :: Eq a => [a] -> Splitter a
startsWithOneOf = dropInitBlank . keepDelimsL . oneOf

-- | Make a strategy that splits a list into chunks that all end with
--   the given subsequence, except possibly the last.  Equivalent to
--   @'dropFinalBlank' . 'keepDelimsR' . 'onSublist'@.  For example:
--
-- > split (endsWith "ly") "happilyslowlygnarlylily" == ["happily","slowly","gnarly","lily"]
endsWith :: Eq a => [a] -> Splitter a
endsWith = dropFinalBlank . keepDelimsR . onSublist

-- | Make a strategy that splits a list into chunks that all end with
--   one of the given elements, except possibly the last.  Equivalent
--   to @'dropFinalBlank' . 'keepDelimsR' . 'oneOf'@.  For example:
--
-- > split (condense $ endsWithOneOf ".,?! ") "Hi, there!  How are you?" == ["Hi, ","there!  ","How ","are ","you?"]
endsWithOneOf :: Eq a => [a] -> Splitter a
endsWithOneOf = dropFinalBlank . keepDelimsR . oneOf

-- ** Convenience functions
--
-- These functions implement some common splitting strategies.  Note
-- that all of the functions in this section drop delimiters from
-- the final output, since that is a more common use case even
-- though it is not the default.

-- | Split on any of the given elements.  Equivalent to @'split'
--   . 'dropDelims' . 'oneOf'@.  For example:
--
-- > splitOneOf ";.," "foo,bar;baz.glurk" == ["foo","bar","baz","glurk"]
splitOneOf :: Eq a => [a] -> [a] -> [[a]]
splitOneOf = split . dropDelims . oneOf

-- | Split on the given sublist.  Equivalent to @'split'
--   . 'dropDelims' . 'onSublist'@.  For example:
--
-- > splitOn ".." "a..b...c....d.." == ["a","b",".c","","d",""]
--
--   In some parsing combinator frameworks this is also known as
--   @sepBy@.
--
--   Note that this is the right inverse of the 'Data.List.intercalate' function
--   from "Data.List", that is,
--
--   > intercalate x . splitOn x === id
--
--   @'splitOn' x . 'Data.List.intercalate' x@ is the identity on
--   certain lists, but it is tricky to state the precise conditions
--   under which this holds.  (For example, it is not enough to say
--   that @x@ does not occur in any elements of the input list.
--   Working out why is left as an exercise for the reader.)
splitOn :: Eq a => [a] -> [a] -> [[a]]
splitOn   = split . dropDelims . onSublist

-- | Split on elements satisfying the given predicate.  Equivalent to
--   @'split' . 'dropDelims' . 'whenElt'@.  For example:
--
-- > splitWhen (<0) [1,3,-4,5,7,-9,0,2] == [[1,3],[5,7],[0,2]]
splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen = split . dropDelims . whenElt

{-# DEPRECATED sepBy "Use splitOn." #-}
sepBy :: Eq a => [a] -> [a] -> [[a]]
sepBy = splitOn

{-# DEPRECATED sepByOneOf "Use splitOneOf." #-}
sepByOneOf :: Eq a => [a] -> [a] -> [[a]]
sepByOneOf = splitOneOf

-- | Split into chunks terminated by the given subsequence.
--   Equivalent to @'split' . 'dropFinalBlank' . 'dropDelims'
--   . 'onSublist'@.  For example:
--
-- > endBy ";" "foo;bar;baz;" == ["foo","bar","baz"]
--
--   Note also that the 'lines' function from "Data.List" is equivalent
--   to @'endBy' \"\\n\"@.
endBy :: Eq a => [a] -> [a] -> [[a]]
endBy = split . dropFinalBlank . dropDelims . onSublist

-- | Split into chunks terminated by one of the given elements.
--   Equivalent to @'split' . 'dropFinalBlank' . 'dropDelims'
--   . 'oneOf'@. For example:
--
-- > endByOneOf ";," "foo;bar,baz;" == ["foo","bar","baz"]
endByOneOf :: Eq a => [a] -> [a] -> [[a]]
endByOneOf = split . dropFinalBlank . dropDelims . oneOf

{-# DEPRECATED unintercalate "Use splitOn." #-}
unintercalate :: Eq a => [a] -> [a] -> [[a]]
unintercalate = splitOn

-- | Split into \"words\", with word boundaries indicated by the given
--   predicate.  Satisfies @'Data.List.words' === wordsBy
--   'Data.Char.isSpace'@; equivalent to @'split' . 'dropBlanks'
--   . 'dropDelims' . 'whenElt'@.  For example:
--
-- > wordsBy (=='x') "dogxxxcatxbirdxx" == ["dog","cat","bird"]
wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy = split . dropBlanks . dropDelims . whenElt

-- | Split into \"lines\", with line boundaries indicated by the given
--   predicate. Satisfies @'lines' === linesBy (=='\n')@; equivalent to
--   @'split' . 'dropFinalBlank' . 'dropDelims' . 'whenElt'@.  For example:
--
-- > linesBy (=='x') "dogxxxcatxbirdxx" == ["dog","","","cat","bird",""]
linesBy :: (a -> Bool) -> [a] -> [[a]]
linesBy = split . dropFinalBlank . dropDelims . whenElt

-- * Other splitting methods

-- | Standard build function, specialized to building lists.
--
--   Usually build is given the rank-2 type
--
--   > build :: (forall b. (a -> b -> b) -> b -> b) -> [a]
--
--   but since we only use it when @(b ~ [a])@, we give it the more
--   restricted type signature in order to avoid needing a
--   non-Haskell2010 extension.
--
--   Note that the 0.1.4.3 release of this package did away with a
--   custom @build@ implementation in favor of importing one from
--   "GHC.Exts", which was (reportedly) faster for some applications.
--   However, in the interest of simplicity and complete Haskell2010
--   compliance as @split@ is being included in the Haskel Platform,
--   version 0.2.1.0 has gone back to defining @build@ manually.  This
--   is in line with @split@'s design philosophy of having efficiency
--   as a non-goal.
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g = g (:) []

-- | @'chunksOf' n@ splits a list into length-n pieces.  The last
--   piece will be shorter if @n@ does not evenly divide the length of
--   the list.  If @n <= 0@, @'chunksOf' n l@ returns an infinite list
--   of empty lists.  For example:
--
--   Note that @'chunksOf' n []@ is @[]@, not @[[]]@.  This is
--   intentional, and is consistent with a recursive definition of
--   'chunksOf'; it satisfies the property that
--
--   @chunksOf n xs ++ chunksOf n ys == chunksOf n (xs ++ ys)@
--
--   whenever @n@ evenly divides the length of @xs@.
chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n  = l `c` splitter (drop i l) c n

{-# DEPRECATED chunk "Use chunksOf." #-}
chunk :: Int -> [e] -> [[e]]
chunk = chunksOf

{-# DEPRECATED splitEvery "Use chunksOf." #-}
splitEvery :: Int -> [e] -> [[e]]
splitEvery = chunksOf

-- | Split a list into chunks of the given lengths. For example:
--
-- > splitPlaces [2,3,4] [1..20] == [[1,2],[3,4,5],[6,7,8,9]]
-- > splitPlaces [4,9] [1..10] == [[1,2,3,4],[5,6,7,8,9,10]]
-- > splitPlaces [4,9,3] [1..10] == [[1,2,3,4],[5,6,7,8,9,10]]
--
--   If the input list is longer than the total of the given lengths,
--   then the remaining elements are dropped. If the list is shorter
--   than the total of the given lengths, then the result may contain
--   fewer chunks than requested, and the last chunk may be shorter
--   than requested.
splitPlaces :: Integral a => [a] -> [e] -> [[e]]
splitPlaces is ys = build (splitPlacer is ys) where
  splitPlacer :: Integral i => [i] -> [b] -> ([b] -> t -> t) -> t -> t
  splitPlacer [] _ _ n      = n
  splitPlacer _ [] _ n      = n
  splitPlacer (l:ls) xs c n = let (x1, x2) = genericSplitAt l xs
                              in  x1 `c` splitPlacer ls x2 c n

-- | Split a list into chunks of the given lengths. Unlike
--   'splitPlaces', the output list will always be the same length as
--   the first input argument. If the input list is longer than the
--   total of the given lengths, then the remaining elements are
--   dropped. If the list is shorter than the total of the given
--   lengths, then the last several chunks will be shorter than
--   requested or empty. For example:
--
-- > splitPlacesBlanks [2,3,4] [1..20] == [[1,2],[3,4,5],[6,7,8,9]]
-- > splitPlacesBlanks [4,9] [1..10] == [[1,2,3,4],[5,6,7,8,9,10]]
-- > splitPlacesBlanks [4,9,3] [1..10] == [[1,2,3,4],[5,6,7,8,9,10],[]]
--
--   Notice the empty list in the output of the third example, which
--   differs from the behavior of 'splitPlaces'.
splitPlacesBlanks :: Integral a => [a] -> [e] -> [[e]]
splitPlacesBlanks is ys = build (splitPlacer is ys) where
  splitPlacer :: Integral i => [i] -> [b] -> ([b] -> t -> t) -> t -> t
  splitPlacer [] _ _ n      = n
  splitPlacer (l:ls) xs c n = let (x1, x2) = genericSplitAt l xs
                              in  x1 `c` splitPlacer ls x2 c n

-- | A useful recursion pattern for processing a list to produce a new
--   list, often used for \"chopping\" up the input list.  Typically
--   chop is called with some function that will consume an initial
--   prefix of the list and produce a value and the rest of the list.
--
--   For example, many common Prelude functions can be implemented in
--   terms of @chop@:
--
-- > group :: (Eq a) => [a] -> [[a]]
-- > group = chop (\ xs@(x:_) -> span (==x) xs)
-- >
-- > words :: String -> [String]
-- > words = filter (not . null) . chop (span (not . isSpace) . dropWhile isSpace)

chop :: ([a] -> (b, [a])) -> [a] -> [b]
chop _ [] = []
chop f as = b : chop f as'
  where (b, as') = f as

-- | Divides up an input list into a set of sublists, according to 'n' and 'm'
--   input specifications you provide. Each sublist will have 'n' items, and the
--   start of each sublist will be offset by 'm' items from the previous one.
--
-- > divvy 5 5 [1..20] == [[1,2,3,4,5],[6,7,8,9,10],[11,12,13,14,15],[16,17,18,19,20]]
--
--   In the case where a source list's trailing elements do no fill an entire
--   sublist, those trailing elements will be dropped.
--
-- > divvy 5 2 [1..10] == [[1,2,3,4,5],[3,4,5,6,7],[5,6,7,8,9]]
--
--   As an example, you can generate a moving average over a list of prices:
--
-- > type Prices = [Float]
-- > type AveragePrices = [Float]
-- >
-- > average :: [Float] -> Float
-- > average xs = sum xs / (fromIntegral $ length xs)
-- >
-- > simpleMovingAverage :: Prices -> AveragePrices
-- > simpleMovingAverage priceList =
-- >   map average divvyedPrices
-- >     where divvyedPrices = divvy 20 1 priceList

divvy :: Int -> Int -> [a] -> [[a]]
divvy _ _ [] = []
divvy n m lst = filter (\ws -> (n == length ws)) choppedl
  where choppedl = chop (\xs -> (take n xs , drop m xs)) lst

-- fst of first time when snd >= fst
-- if snd never becomes >= fst, then snd of last item

solve :: [Int] -> [Int] -> Int
solve as bs = if length spl == 1 then snd . last $ h else m
  where z = zip as bs
        sf x y = compare (fst y) (fst x)
        scf x y = (fst y, snd x + snd y)
        scl = tail . scanl scf (0, 0) $ sortBy sf z
        spl = split (keepDelimsL $ whenElt (\(f, s) -> s >= f)) scl
        m = max (if length h > 0 then snd . last $ h else 0) (fst . head . head $ tail spl)
        h = head spl

main :: IO ()
main = getLine >>= pure . read >>= \t -> forM_ [1..t] . const $ getLine >> do
         as <- pure . map read . words =<< getLine
         bs <- pure . map read . words =<< getLine
         putStrLn . show $ solve as bs

import Control.Arrow ((>>>))
import Data.List (sortBy)
import Data.Ord (comparing)

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>> map (words >>> map read) >>> process >>> map show >>> unlines

process :: [[Integer]] -> [Integer]
process [] = []
process (_:as:bs:xss) = solve as bs : process xss

solve :: [Integer] -> [Integer] -> Integer
solve as bs = minimum costs
  where
    (as', bs') = unzip . sortBy (comparing fst) $ zip as bs
    costs = zipWith max (scanl max 0 as') (scanr (+) 0 bs')

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (sortBy)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)

main :: IO ()
main =
  C.interact $
  C.lines >>>
  drop 1 >>>
  map (C.words >>> map readInt) >>>
  process >>> map (show >>> C.pack) >>> C.unlines
  where
    readInt = C.readInt >>> fromMaybe undefined >>> fst >>> fromIntegral

process :: [[Integer]] -> [Integer]
process [] = []
process (_:as:bs:xss) = solve as bs : process xss

solve :: [Integer] -> [Integer] -> Integer
solve as bs = minimum costs
  where
    (as', bs') = unzip . sortBy (comparing fst) $ zip as bs
    costs = zipWith max (scanl max 0 as') (scanr (+) 0 bs')

import Control.Arrow ((>>>))
import Data.List (sortBy)
import Data.Ord (comparing)

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>> map (words >>> map read) >>> process >>> map show >>> unlines

process :: [[Int]] -> [Int]
process [] = []
process (_:as:bs:xss) = solve as bs : process xss

solve :: [Int] -> [Int] -> Int
solve as bs = minimum costs
  where
    (as', bs') = unzip . sortBy (comparing fst) $ zip as bs
    costs = zipWith max (scanl max 0 as') (scanr (+) 0 bs')

import Control.Monad (forM_)
import Data.List (sortBy)

solve :: String -> String -> Int
solve as' bs' = if length fl == 0 then fst . head $ sc else snd . last $ fl
  where as = l as'
	bs = l bs'
	l = map read . words
	ts' = zip as bs
	ts = reverse $ sortBy sf ts'
	sf x y = compare (fst x) (fst y)
	sc = tail $ scanl (\(ox, oy) (nx, ny) -> (nx, oy + ny)) (1, 0) ts
	fl = filter (\(x, y) -> x >= y) sc

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] . const $ getLine >> getLine >>= \as -> do
	bs <- getLine
	putStrLn . show . solve as $ bs

import Control.Monad (forM_)
import Data.List (sortBy)

-- fst of first time when snd >= fst
-- if snd never becomes >= fst, then snd of last item

solve :: [Int] -> [Int] -> Int
solve as bs = if length fl == 0 then snd $ last scl else fst $ head fl
  where z = zip as bs
        sf x y = compare (fst y) (fst x)
        scf x y = (fst y, snd x + snd y)
        scl = tail . scanl scf (0, 0) $ sortBy sf z
        fl = filter (\(f, s) -> s >= f) scl

main :: IO ()
main = getLine >>= pure . read >>= \t -> forM_ [1..t] . const $ getLine >> do
         as <- pure . map read . words =<< getLine
         bs <- pure . map read . words =<< getLine
         putStrLn . show $ solve as bs