You are given a text that consists of lowercase Latin letters, spaces and punctuation marks (dot, comma, exclamation mark and question mark). A word is defined as a sequence of consecutive Latin letters.Your task is to add spaces to the text by the following rules:  if there is no punctuation mark between two words, then they should be separated by exactly one space  there should be no spaces before each punctuation mark  there should be exactly one space after each punctuation mark It is guaranteed that there is at least one word between any two punctuation marks. The text begins and ends with a Latin letter.

The input data contains of a single non-empty line — the text whose length is no more than 10000 characters.

Print the text, edited according to the rules. In this problem you should follow the output format very strictly. For example, extra space at the end of the output line is considered as wrong answer. Note that a newline character at the end of the line doesn't matter.

galileo galilei was an   italian physicist  ,mathematician,astronomer

galileo galilei was an italian physicist, mathematician, astronomer

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 ".,!?"

{-# 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"

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


New Year is coming and you are excited to know how many minutes remain before the New Year. You know that currently the clock shows $$$h$$$ hours and $$$m$$$ minutes, where $$$0 \le hh < 24$$$ and $$$0 \le mm < 60$$$. We use 24-hour time format!Your task is to find the number of minutes before the New Year. You know that New Year comes when the clock shows $$$0$$$ hours and $$$0$$$ minutes.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 1439$$$) — the number of test cases. The following $$$t$$$ lines describe test cases. The $$$i$$$-th line contains the time as two integers $$$h$$$ and $$$m$$$ ($$$0 \le h < 24$$$, $$$0 \le m < 60$$$). It is guaranteed that this time is not a midnight, i.e. the following two conditions can't be met at the same time: $$$h=0$$$ and $$$m=0$$$. It is guaranteed that both $$$h$$$ and $$$m$$$ are given without leading zeros.

For each test case, print the answer on it — the number of minutes before the New Year.

-- 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

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)

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


You are given an undirected bipartite graph without multiple edges. You should paint the edges of graph to minimal number of colours, so that no two adjacent edges have the same colour.

The first line contains three integers a, b, m (1 ≤ a, b ≤ 1000, 0 ≤ m ≤ 105), a is the size of the first part, b is the size of the second part, m is the number of edges in the graph. Each of the next m lines contains two integers x, y (1 ≤ x ≤ a, 1 ≤ y ≤ b), where x is the number of the vertex in the first part and y is the number of the vertex in the second part. It is guaranteed that there are no multiple edges.

In the first line print integer c — the minimal number of colours. The second line should contain m integers from 1 to c — the colours of the edges (in the order they appear in the input). If there are several solutions, you can print any one of them.

{-# 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


Mike and Joe are playing a game with some stones. Specifically, they have $$$n$$$ piles of stones of sizes $$$a_1, a_2, \ldots, a_n$$$. These piles are arranged in a circle.The game goes as follows. Players take turns removing some positive number of stones from a pile in clockwise order starting from pile $$$1$$$. Formally, if a player removed stones from pile $$$i$$$ on a turn, the other player removes stones from pile $$$((i\bmod n) + 1)$$$ on the next turn.If a player cannot remove any stones on their turn (because the pile is empty), they lose. Mike goes first.If Mike and Joe play optimally, who will win?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1000$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 50$$$)  — the number of piles. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$)  — the size of the piles.

For each test case print the winner of the game, either "Mike" or "Joe" on its own line (without quotes).

NoteIn the first test case, Mike just takes all $$$37$$$ stones on his first turn.In the second test case, Joe can just copy Mike's moves every time. Since Mike went first, he will hit $$$0$$$ on the first pile one move before Joe does so on the second pile.

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Data.List

solve :: IO ()
solve = do
  n :: Int <- read <$> getLine
  xs :: [Int] <- map read . words <$> getLine
  let Just i = elemIndex (minimum xs) xs
  putStrLn $ if odd n || odd i then "Mike" else "Joe"

main :: IO ()
main = do
  tc <- readLn
  replicateM_ tc solve

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad

solve :: IO ()
solve = do
  n :: Int <- read <$> getLine
  xs :: [Int] <- map read . words <$> getLine
  let s = sum $ zipWith (*) xs (cycle [1,-1])
  putStrLn $ if odd n || s > 0 then "Mike" else "Joe"

main :: IO ()
main = do
  tc <- readLn
  replicateM_ tc solve


Vasya plays the LionAge II. He was bored of playing with a stupid computer, so he installed this popular MMORPG, to fight with his friends. Vasya came up with the name of his character — non-empty string s, consisting of a lowercase Latin letters. However, in order not to put up a front of friends, Vasya has decided to change no more than k letters of the character name so that the new name sounded as good as possible. Euphony of the line is defined as follows: for each pair of adjacent letters x and y (x immediately precedes y) the bonus c(x, y) is added to the result. Your task is to determine what the greatest Euphony can be obtained by changing at most k letters in the name of the Vasya's character.

The first line contains character's name s and an integer number k (0 ≤ k ≤ 100). The length of the nonempty string s does not exceed 100. The second line contains an integer number n (0 ≤ n ≤ 676) — amount of pairs of letters, giving bonus to the euphony. The next n lines contain description of these pairs «x y c», which means that sequence xy gives bonus c (x, y — lowercase Latin letters,  - 1000 ≤ c ≤ 1000). It is guaranteed that no pair x y mentioned twice in the input data.

Output the only number — maximum possible euphony оf the new character's name.

abcdef 1
5
a b -10
b c 5
c d 5
d e 5
e f 5

NoteIn the first example the most euphony name will be looser. It is easy to calculate that its euphony is 36.

{-# OPTIONS_GHC -O2 #-}

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

inf = 10^9

getId :: Char -> Int
getId ch = ord ch - ord 'a'

trans :: UArray (Int,Int) Int -> Int -> UArray (Int,Int) Int -> UArray (Int,Int) Int
trans dict ch arr = accumArray max (negate inf) bnds arrList
  where
    bnds = bounds arr
    arrList = [ ((lastCh, used), prevValue + deltaValue)
              | (lastCh, used) <- range bnds
              , let used' = used - if lastCh == ch then 0 else 1
              , used' >= 0
              , prevCh <- [0..25]
              , let prevValue  = arr  ! (prevCh, used')
                    deltaValue = dict ! (prevCh, lastCh)
              ]

solve :: [Int] -> Int -> UArray (Int,Int) Int -> Int
solve s k dict = rec initArray (tail s)
  where
    bnds = ((0,0), (25, k))
    initArray = array bnds [ ((ch, used), if used == used' then 0 else negate inf)
                           | (ch, used) <- range bnds
                           , let used' = if ch == head s then 0 else 1
                           ]
    rec arr (x:xs) = rec (trans dict x arr) xs
    rec arr [] = maximum [arr ! ind | ind <- range bnds]

parse :: [String] -> ((Int,Int),Int)
parse [x,y,c] = ((getId $ head x, getId $ head y), read c)

main = do
    [s,kS] <- words <$> getLine
    let k = read kS :: Int
    n <- read <$> getLine :: IO Int
    dict <- accumArray (flip const) 0 ((0,0),(25,25)) <$> replicateM n (parse.words <$> getLine)
    print $ solve (map getId s) k dict

{-# OPTIONS_GHC -O2 #-}

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

inf = 10^9

getId :: Char -> Int
getId ch = ord ch - ord 'a'

trans :: Array (Int,Int) Int -> Int -> Array (Int,Int) Int -> Array (Int,Int) Int
trans dict ch arr = accumArray max (negate inf) bnds arrList
  where
    bnds = bounds arr
    arrList = [ ((lastCh, used), if used' >= 0 then prevValue + deltaValue else negate inf)
              | (lastCh, used) <- range bnds
              , let used' = used - if lastCh == ch then 0 else 1
              , prevCh <- [0..25]
              , let prevValue  = arr  ! (prevCh, used')
                    deltaValue = dict ! (prevCh, lastCh)
              ]

solve :: [Int] -> Int -> Array (Int,Int) Int -> Int
solve s k dict = rec initArray (tail s)
  where
    bnds = ((0,0), (25, max k 2))
    initArray = array bnds [((ch, used), if used == used' then 0 else negate inf)
                           | (ch, used) <- range bnds
                           , let used' = if ch == head s then 0 else 1
                           ]
    rec arr (x:xs) = rec (trans dict x arr) xs
    rec arr [] = maximum [arr ! ind | ind <- range bnds]

parse :: [String] -> ((Int,Int),Int)
parse [x,y,c] = ((getId $ head x, getId $ head y), read c)

main = do
    [s,kS] <- words <$> getLine
    let k = read kS :: Int
    n <- read <$> getLine :: IO Int
    dict <- accumArray (flip const) 0 ((0,0),(25,25)) <$> replicateM n (parse.words <$> getLine)
    print $ solve (map getId s) k dict


Spongebob is already tired trying to reason his weird actions and calculations, so he simply asked you to find all pairs of n and m, such that there are exactly x distinct squares in the table consisting of n rows and m columns. For example, in a 3 × 5 table there are 15 squares with side one, 8 squares with side two and 3 squares with side three. The total number of distinct squares in a 3 × 5 table is 15 + 8 + 3 = 26.

The first line of the input contains a single integer x (1 ≤ x ≤ 1018) — the number of squares inside the tables Spongebob is interested in.

First print a single integer k — the number of tables with exactly x distinct squares inside. Then print k pairs of integers describing the tables. Print the pairs in the order of increasing n, and in case of equality — in the order of increasing m.

NoteIn a 1 × 2 table there are 2 1 × 1 squares. So, 2 distinct squares in total.  In a 2 × 3 table there are 6 1 × 1 squares and 2 2 × 2 squares. That is equal to 8 squares in total.

import Control.Applicative
import Data.Tuple
import Data.Maybe

computeM x n | tmp `mod` divisor == 0 && n <= result = Just ( n, result )
             | otherwise = Nothing
             where tmp = 6*x + n^3 - n
                   divisor = 3*(n^2 + n)
                   result = tmp `quot` divisor

proposals limit = takeWhile (check limit) [1..]
  where check value n = n^3 <= 3 * value

solution x = result ++ if last result == head rest then drop 1 rest else rest
  where result = fromJust <$> filter isJust ( computeM x <$> proposals x )
        rest = (swap <$> reverse result)

main = do
    squares <- readLn :: IO Integer
    let s = solution squares
    print $ length s
    sequence_ $ (\(a, b) -> putStrLn $ show a ++ " " ++ show b) <$> s

import Control.Applicative
import Data.Tuple
import Data.Maybe

computeM x n | tmp `mod` divisor == 0 && n <= result = Just ( n, result )
             | otherwise = Nothing
             where tmp = 6*x + n^3 - n
                   divisor = 3*(n^2 + n)
                   result = tmp `quot` divisor

proposals limit = takeWhile (check limit) [1..]
  where check value n = n^3 <= 3 * value

solution x = result ++ if drop 1 result == [] then [] else (swap <$> reverse result)
  where result = fromJust <$> filter isJust ( computeM x <$> proposals x )

main = do
    squares <- readLn :: IO Integer
    let s = solution squares
    print $ length s
    sequence_ $ (\(a, b) -> putStrLn $ show a ++ " " ++ show b) <$> s

import Control.Applicative
import Data.Tuple
import Data.Maybe

computeM x n | tmp `mod` divisor == 0 && n <= result = Just ( n, result )
             | otherwise = Nothing
             where tmp = 6*x + n^3 - n
                   divisor = 3*(n^2 + n)
                   result = tmp `quot` divisor

proposals limit = takeWhile (check limit) [1..]
  where check value n = n^3 <= 3 * value

solution x = result ++ if sameResult result then [] else (swap <$> reverse result)
  where result = fromJust <$> filter isJust ( computeM x <$> proposals x )
        sameResult [(a, b)] | a == b = True
        sameResult _ = False

main = do
    squares <- readLn :: IO Integer
    let s = solution squares
    print $ length s
    sequence_ $ (\(a, b) -> putStrLn $ show a ++ " " ++ show b) <$> s


Vera adores poems. All the poems Vera knows are divided into quatrains (groups of four lines) and in each quatrain some lines contain rhymes.Let's consider that all lines in the poems consist of lowercase Latin letters (without spaces). Letters "a", "e", "i", "o", "u" are considered vowels.Two lines rhyme if their suffixes that start from the k-th vowels (counting from the end) match. If a line has less than k vowels, then such line can't rhyme with any other line. For example, if k = 1, lines commit and hermit rhyme (the corresponding suffixes equal it), and if k = 2, they do not rhyme (ommit ≠ ermit).Today on a literature lesson Vera learned that quatrains can contain four different schemes of rhymes, namely the following ones (the same letters stand for rhyming lines):   Clerihew (aabb);  Alternating (abab);  Enclosed (abba). If all lines of a quatrain pairwise rhyme, then the quatrain can belong to any rhyme scheme (this situation is represented by aaaa).If all quatrains of a poem belong to the same rhyme scheme, then we can assume that the whole poem belongs to this rhyme scheme. If in each quatrain all lines pairwise rhyme, then the rhyme scheme of the poem is aaaa. Let us note that it doesn't matter whether lines from different quatrains rhyme with each other or not. In other words, it is possible that different quatrains aren't connected by a rhyme.Vera got a long poem as a home task. The girl has to analyse it and find the poem rhyme scheme. Help Vera cope with the task.

The first line contains two integers n and k (1 ≤ n ≤ 2500, 1 ≤ k ≤ 5) — the number of quatrains in the poem and the vowel's number, correspondingly. Next 4n lines contain the poem. Each line is not empty and only consists of small Latin letters. The total length of the lines does not exceed 104. If we assume that the lines are numbered starting from 1, then the first quatrain contains lines number 1, 2, 3, 4; the second one contains lines number 5, 6, 7, 8; and so on.

Print the rhyme scheme of the poem as "aabb", "abab", "abba", "aaaa"; or "NO" if the poem does not belong to any of the above mentioned schemes.

2 1
day
may
sun
fun
test
hill
fest
thrill

NoteIn the last sample both quatrains have rhymes but finding the common scheme is impossible, so the answer is "NO".

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

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:

-- 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 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

{-# 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

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

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


Innovation technologies are on a victorious march around the planet. They integrate into all spheres of human activity!A restaurant called "Dijkstra's Place" has started thinking about optimizing the booking system. There are n booking requests received by now. Each request is characterized by two numbers: ci and pi — the size of the group of visitors who will come via this request and the total sum of money they will spend in the restaurant, correspondingly.We know that for each request, all ci people want to sit at the same table and are going to spend the whole evening in the restaurant, from the opening moment at 18:00 to the closing moment.Unfortunately, there only are k tables in the restaurant. For each table, we know ri — the maximum number of people who can sit at it. A table can have only people from the same group sitting at it. If you cannot find a large enough table for the whole group, then all visitors leave and naturally, pay nothing.Your task is: given the tables and the requests, decide which requests to accept and which requests to decline so that the money paid by the happy and full visitors was maximum.

The first line of the input contains integer n (1 ≤ n ≤ 1000) — the number of requests from visitors. Then n lines follow. Each line contains two integers: ci, pi (1 ≤ ci, pi ≤ 1000) — the size of the group of visitors who will come by the i-th request and the total sum of money they will pay when they visit the restaurant, correspondingly. The next line contains integer k (1 ≤ k ≤ 1000) — the number of tables in the restaurant. The last line contains k space-separated integers: r1, r2, ..., rk (1 ≤ ri ≤ 1000) — the maximum number of people that can sit at each table.

In the first line print two integers: m, s — the number of accepted requests and the total money you get from these requests, correspondingly. Then print m lines — each line must contain two space-separated integers: the number of the accepted request and the number of the table to seat people who come via this request. The requests and the tables are consecutively numbered starting from 1 in the order in which they are given in the input. If there are multiple optimal answers, print any of them.

{-# 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)


A way to make a new task is to make it nondeterministic or probabilistic. For example, the hard task of Topcoder SRM 595, Constellation, is the probabilistic version of a convex hull.Let's try to make a new task. Firstly we will use the following task. There are n people, sort them by their name. It is just an ordinary sorting problem, but we can make it more interesting by adding nondeterministic element. There are n people, each person will use either his/her first name or last name as a handle. Can the lexicographical order of the handles be exactly equal to the given permutation p?More formally, if we denote the handle of the i-th person as hi, then the following condition must hold: .

The first line contains an integer n (1 ≤ n ≤ 105) — the number of people. The next n lines each contains two strings. The i-th line contains strings fi and si (1 ≤ |fi|, |si| ≤ 50) — the first name and last name of the i-th person. Each string consists only of lowercase English letters. All of the given 2n strings will be distinct. The next line contains n distinct integers: p1, p2, ..., pn (1 ≤ pi ≤ n).

If it is possible, output "YES", otherwise output "NO".

3
gennady korotkevich
petr mitrichev
gaoyuan chen
1 2 3

3
gennady korotkevich
petr mitrichev
gaoyuan chen
3 1 2

2
galileo galilei
nicolaus copernicus
2 1

10
rean schwarzer
fei claussell
alisa reinford
eliot craig
laura arseid
jusis albarea
machias regnitz
sara valestin
emma millstein
gaius worzel
1 2 3 4 5 6 7 8 9 10

10
rean schwarzer
fei claussell
alisa reinford
eliot craig
laura arseid
jusis albarea
machias regnitz
sara valestin
emma millstein
gaius worzel
2 4 9 6 5 7 1 3 8 10

NoteIn example 1 and 2, we have 3 people: tourist, Petr and me (cgy4ever). You can see that whatever handle is chosen, I must be the first, then tourist and Petr must be the last.In example 3, if Copernicus uses "copernicus" as his handle, everything will be alright.

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 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")

{-# 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")


Your working week consists of $$$n$$$ days numbered from $$$1$$$ to $$$n$$$, after day $$$n$$$ goes day $$$1$$$ again. And $$$3$$$ of them are days off. One of the days off is the last day, day $$$n$$$. You have to decide when the other two are.Choosing days off, you pursue two goals:   No two days should go one after the other. Note that you can't make day $$$1$$$ a day off because it follows day $$$n$$$.  Working segments framed by days off should be as dissimilar as possible in duration. More specifically, if the segments are of size $$$l_1$$$, $$$l_2$$$, and $$$l_3$$$ days long, you want to maximize $$$\min(|l_1 - l_2|, |l_2 - l_3|, |l_3 - l_1|)$$$. Output the maximum value of $$$\min(|l_1 - l_2|, |l_2 - l_3|, |l_3 - l_1|)$$$ that can be obtained.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The description of test cases follows. The only line of each test case contains the integer $$$n$$$ ($$$6 \le n \le 10^9$$$).

For each test case, output one integer — the maximum possible obtained value.

NoteIn the image below you can see the example solutions for the first two test cases. Chosen days off are shown in purple. Working segments are underlined in green.In test case $$$1$$$, the only options for days off are days $$$2$$$, $$$3$$$, and $$$4$$$ (because $$$1$$$ and $$$5$$$ are next to day $$$n$$$). So the only way to place them without selecting neighboring days is to choose days $$$2$$$ and $$$4$$$. Thus, $$$l_1 = l_2 = l_3 = 1$$$, and the answer $$$\min(|l_1 - l_2|, |l_2 - l_3|, |l_3 - l_1|) = 0$$$.   For test case $$$2$$$, one possible way to choose days off is shown. The working segments have the lengths of $$$2$$$, $$$1$$$, and $$$4$$$ days. So the minimum difference is $$$1 = \min(1, 3, 2) = \min(|2 - 1|, |1 - 4|, |4 - 2|)$$$. It can be shown that there is no way to make it larger.

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)

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 ()

--
-- 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


Codeforces separates its users into $$$4$$$ divisions by their rating:  For Division 1: $$$1900 \leq \mathrm{rating}$$$  For Division 2: $$$1600 \leq \mathrm{rating} \leq 1899$$$  For Division 3: $$$1400 \leq \mathrm{rating} \leq 1599$$$  For Division 4: $$$\mathrm{rating} \leq 1399$$$ Given a $$$\mathrm{rating}$$$, print in which division the $$$\mathrm{rating}$$$ belongs.

The first line of the input contains an integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of testcases. The description of each test consists of one line containing one integer $$$\mathrm{rating}$$$ ($$$-5000 \leq \mathrm{rating} \leq 5000$$$).

For each test case, output a single line containing the correct division in the format "Division X", where $$$X$$$ is an integer between $$$1$$$ and $$$4$$$ representing the division for the corresponding rating.

Division 4
Division 4
Division 4
Division 4
Division 3
Division 2
Division 1

NoteFor test cases $$$1-4$$$, the corresponding ratings are $$$-789$$$, $$$1299$$$, $$$1300$$$, $$$1399$$$, so all of them are in division $$$4$$$.For the fifth test case, the corresponding rating is $$$1400$$$, so it is in division $$$3$$$.For the sixth test case, the corresponding rating is $$$1679$$$, so it is in division $$$2$$$.For the seventh test case, the corresponding rating is $$$2300$$$, so it is in division $$$1$$$.

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

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

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


You are given an array $$$a_1, a_2, \dots , a_n$$$ and two integers $$$m$$$ and $$$k$$$.You can choose some subarray $$$a_l, a_{l+1}, \dots, a_{r-1}, a_r$$$. The cost of subarray $$$a_l, a_{l+1}, \dots, a_{r-1}, a_r$$$ is equal to $$$\sum\limits_{i=l}^{r} a_i - k \lceil \frac{r - l + 1}{m} \rceil$$$, where $$$\lceil x \rceil$$$ is the least integer greater than or equal to $$$x$$$. The cost of empty subarray is equal to zero.For example, if $$$m = 3$$$, $$$k = 10$$$ and $$$a = [2, -4, 15, -3, 4, 8, 3]$$$, then the cost of some subarrays are:  $$$a_3 \dots a_3: 15 - k \lceil \frac{1}{3} \rceil = 15 - 10 = 5$$$;  $$$a_3 \dots a_4: (15 - 3) - k \lceil \frac{2}{3} \rceil = 12 - 10 = 2$$$;  $$$a_3 \dots a_5: (15 - 3 + 4) - k \lceil \frac{3}{3} \rceil = 16 - 10 = 6$$$;  $$$a_3 \dots a_6: (15 - 3 + 4 + 8) - k \lceil \frac{4}{3} \rceil = 24 - 20 = 4$$$;  $$$a_3 \dots a_7: (15 - 3 + 4 + 8 + 3) - k \lceil \frac{5}{3} \rceil = 27 - 20 = 7$$$. Your task is to find the maximum cost of some subarray (possibly empty) of array $$$a$$$.

The first line contains three integers $$$n$$$, $$$m$$$, and $$$k$$$ ($$$1 \le n \le 3 \cdot 10^5, 1 \le m \le 10, 1 \le k \le 10^9$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$).

Print the maximum cost of some subarray of array $$$a$$$.

{-# OPTIONS_GHC -O2 #-}

import Control.Monad.State.Strict (State, evalState, get, modify, put)
import Data.Char (ord)
import Data.Sequence
  ( Seq
  , Seq(Empty)
  , Seq((:<|))
  , Seq((:|>))
  , (!?)
  , adjust'
  , fromList
  )
import qualified Data.Sequence as S (replicate)

parseInt ('-' : as) = negate (foldl (\acc c -> acc * 10 + ord c - 48) 0 as)
parseInt as = foldl (\acc c -> acc * 10 + ord c - 48) 0 as

parseInts = fmap parseInt . words

type Stack = Maybe (Int, Integer)

ceilInt :: Int -> Int -> Integer
ceilInt a b = toInteger (q + c)
  where
    (q, r) = a `quotRem` b
    c = signum r

solve :: (Int, Int) -> (Int, Integer) -> State (Seq Stack) Integer
solve (m, k) = step
  where
    query _ Nothing = 0
    query (i, v) (Just (i', v')) =
      (v - v') - ((i - i') `ceilInt` m) * toInteger k
    push p@(i, v) q =
      case q of
        Nothing -> Just p
        Just _ ->
          if query p q < 0
            then Just p
            else q
    step :: (Int, Integer) -> State (Seq Stack) Integer
    step (i, v) = do
      mem <- get
      let im = i `mod` m
          best = maximum (fmap (query (i, v)) mem)
      modify (adjust' (push (i, v)) im)
      return best

main = do
  [n, m, k] <- fmap parseInts getLine
  a <- fmap parseInts getLine
  let s = scanl (+) 0 . fmap toInteger $ a
      initial = S.replicate m Nothing
      st = fmap maximum . mapM (solve (m, k)) . zip [0 ..] $ s
  print (evalState st initial)


A little boy Laurenty has been playing his favourite game Nota for quite a while and is now very hungry. The boy wants to make sausage and cheese sandwiches, but first, he needs to buy a sausage and some cheese.The town where Laurenty lives in is not large. The houses in it are located in two rows, n houses in each row. Laurenty lives in the very last house of the second row. The only shop in town is placed in the first house of the first row.The first and second rows are separated with the main avenue of the city. The adjacent houses of one row are separated by streets.Each crosswalk of a street or an avenue has some traffic lights. In order to cross the street, you need to press a button on the traffic light, wait for a while for the green light and cross the street. Different traffic lights can have different waiting time.The traffic light on the crosswalk from the j-th house of the i-th row to the (j + 1)-th house of the same row has waiting time equal to aij (1 ≤ i ≤ 2, 1 ≤ j ≤ n - 1). For the traffic light on the crossing from the j-th house of one row to the j-th house of another row the waiting time equals bj (1 ≤ j ≤ n). The city doesn't have any other crossings.The boy wants to get to the store, buy the products and go back. The main avenue of the city is wide enough, so the boy wants to cross it exactly once on the way to the store and exactly once on the way back home. The boy would get bored if he had to walk the same way again, so he wants the way home to be different from the way to the store in at least one crossing.    Figure to the first sample. Help Laurenty determine the minimum total time he needs to wait at the crossroads.

The first line of the input contains integer n (2 ≤ n ≤ 50) — the number of houses in each row.  Each of the next two lines contains n - 1 space-separated integer — values aij (1 ≤ aij ≤ 100).  The last line contains n space-separated integers bj (1 ≤ bj ≤ 100).

Print a single integer — the least total time Laurenty needs to wait at the crossroads, given that he crosses the avenue only once both on his way to the store and on his way back home.

NoteThe first sample is shown on the figure above. In the second sample, Laurenty's path can look as follows:   Laurenty crosses the avenue, the waiting time is 3;  Laurenty uses the second crossing in the first row, the waiting time is 2;  Laurenty uses the first crossing in the first row, the waiting time is 1;  Laurenty uses the first crossing in the first row, the waiting time is 1;  Laurenty crosses the avenue, the waiting time is 1;  Laurenty uses the second crossing in the second row, the waiting time is 3.  In total we get that the answer equals 11.In the last sample Laurenty visits all the crossings, so the answer is 4.

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 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))