{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as String
import qualified Data.ByteString.Builder.Prim as Prim
import Data.ByteString.Builder
import Control.Monad
import Control.Monad.ST
--import Control.Monad.Trans.State
import Data.Array.Base
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.MArray as Vector
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import Data.Function
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe
import System.Exit

import Data.IORef
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Fail
import Control.Applicative
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (msum)
import Data.Char (isNumber, isPunctuation)

import Control.Monad.Identity (Identity(..))

printLog :: Show a => a -> a
printLog a = unsafePerformIO $ do putStrLn $ "{отладка[ "++show a ++ " ]отладка}"
                                  pure a

binSearch :: Integral i => (i -> Bool) -> i -> i -> i
binSearch f = go where
    go l h
        | l > h     = l
        | f m       = go l (m - 1)
        | otherwise = go (m + 1) h
        where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l h where (l, h) = bounds a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

readInts :: IO [Int]
readInts = map (fst . fromJust . String.readInt) . String.words <$> String.getLine

fita :: IO ()
fita = do
  ~[a,b] <- readInts
  print $ min ((a+b) `div` 4) (min a b)

main :: IO ()
main = flip replicateM_ fita =<< readLn

{-# LANGUAGE MultiWayIf #-}

import Control.Monad

main = do
  n <- readLn
  replicateM_ n $ do
    [p, m] <- fmap read . words <$> getLine
    print $ minimum [p, m, (p + m) `div` 4]

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC { a :: Int, b :: Int }

input :: Scanner TC
input = do
  a <- int
  b <- int
  return TC {..}

type Output = Int

output :: Output -> C.ByteString
output = showB

solve :: TC -> Output
solve TC {..} = minimum [a, b, (a + b) `div` 4]

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as String
import qualified Data.ByteString.Builder.Prim as Prim
import Data.ByteString.Builder
import Control.Monad
import Control.Monad.ST
--import Control.Monad.Trans.State
import Data.Array.Base
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.MArray as Vector
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import Data.Function
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe
import System.Exit

import Data.IORef
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Fail
import Control.Applicative
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (msum)
import Data.Char (isNumber, isPunctuation)

import Control.Monad.Identity (Identity(..))

printLog :: Show a => a -> a
printLog a = unsafePerformIO $ do putStrLn $ "{отладка[ "++show a ++ " ]отладка}"
                                  pure a

binSearch :: Integral i => (i -> Bool) -> i -> i -> i
binSearch f = go where
    go l h
        | l > h     = l
        | f m       = go l (m - 1)
        | otherwise = go (m + 1) h
        where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l h where (l, h) = bounds a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

readInts :: IO [Int]
readInts = map (fst . fromJust . String.readInt) . String.words <$> String.getLine

fita :: IO ()
fita = do
  ~[a,b] <- readInts
  let fun x = if x > min a b then True else (a+b-2*x) `div` 2 < x
  print $ (binSearch fun (0::Int) (1000000001::Int)) - 1

main :: IO ()
main = flip replicateM_ fita =<< readLn


import Data.Maybe (fromJust)
import qualified Data.Map as M
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, singleton, lookupGT, delete, insert, lookupLT)
-- import Debug.Trace (traceShow)

type Roll = Map Int Int -> [Int]

solve :: [Int] -> Int
solve a = maximum . foldr loop (`seq` []) a $ singleton minBound 0
    where
    loop :: Int -> Roll -> Roll
    loop i f m = r:f m''
        where
        r = (+1) . snd . fromJust $ i `lookupLT` m
        m' = insert i r m
        m'' = case i `lookupGT` m' of
            Nothing -> m'
            Just (k, r') -> if r < r' then m' else k `delete` m'

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = parse <$> B.getLine >>= \[n] -> parse <$> B.getLine >>= \a ->
    print $ solve a

import Data.Maybe (fromJust)
import qualified Data.Map as M
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, singleton, lookupGT, delete, insert, lookupLT)

-- longest increasing sequence (strictly so)
lis :: (Num a, Ord a, Bounded a) => [a] -> [Int]
lis a = foldr loop (`seq` []) a $ singleton minBound 0
    where
    loop :: (Num a, Ord a) => a -> (Map a Int -> [Int]) -> Map a Int -> [Int]
    loop i f m = (r:) . f $ case i `lookupGT` m' of
        Nothing -> m'
        Just (k, r') -> if r < r' then m' else k `delete` m'
        where
        r = (+1) . snd . fromJust $ i `lookupLT` m
        m' = insert i r m

solve :: [Int] -> Int
solve = maximum . lis

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = B.getLine >> parse <$> B.getLine >>= \a -> print $ solve a

import Data.Maybe (fromJust)
import qualified Data.Map as M
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, singleton, lookupGT, delete, insert, lookupLT)
-- import Debug.Trace (traceShow)

type Roll = Map Int Int -> [Int]

solve :: [Int] -> Int
solve a = maximum . foldr loop (`seq` []) a $ singleton maxBound 0
    where
    loop :: Int -> Roll -> Roll
    loop i f m = r:f m''
        where
        r = (+1) . snd . fromJust $ i `lookupGT` m
        m' = insert i r m
        m'' = case i `lookupLT` m' of
            Nothing -> m'
            Just (k, r') -> if r < r' then k `delete` m' else m'

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = parse <$> B.getLine >>= \[n] -> parse <$> B.getLine >>= \a ->
    print $ solve a


import Data.Function (on)
import Data.List

yesNo False = "NO"
yesNo True = "YES"

readInt :: String -> Int
readInt = read

solve_task :: String -> String
solve_task line = let votes = map readInt $ words line
                      maxs = map (\x -> maximum $ delete x votes) votes
                      in unwords . map show $ zipWith (\m v -> max 0 (m-v+1)) maxs votes

solve_tasks (t:tasks) = map solve_task tasks

solve = unlines . solve_tasks . lines

main = interact solve

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC { xs :: [Int] }

input :: Scanner TC
input = do
  xs <- 3 >< int
  return TC{..}

output = map show >>> unwords >>> C.pack

solve :: TC -> [Int]
solve TC{..} = zipWith extra xs [max b c, max a c, max a b]
  where
    [a, b, c] = xs
    extra u v = max (v + 1 - u) 0

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

import Control.Monad

calc :: Int -> Int -> Int -> Int
calc max_votes extra curr = if curr < max_votes then max_votes - curr + 1 else extra

calcVotes :: (Int, Int, Int) -> (Int, Int, Int)
calcVotes (a, b, c) =
    let max_votes = a `max` b `max` c
        l = [a, b, c]
        is_maxs = map (== max_votes) l
        counts = foldr (\b -> \i -> if b then i + 1 else i) 0 is_maxs
        extra = if counts > 1 then 1 else 0
        calc' = calc max_votes extra
     in (calc' a, calc' b, calc' c)

getInputs :: IO (Int, Int, Int)
getInputs = do
    inputLine <- getLine
    let inputs = words inputLine
        a = read (inputs !! 0) :: Int
        b = read (inputs !! 1) :: Int
        c = read (inputs !! 2) :: Int
     in return (a, b, c)

output :: (Int, Int, Int) -> IO()
output (a, b, c) = do
    putStrLn (show a ++ " " ++ show b ++ " " ++ show c)

main :: IO [()]
main = do
    num_of_inputs <- getLine
    list_of_inputs <- replicateM (read (num_of_inputs) :: Int) getInputs
    let ans = map calcVotes list_of_inputs
     in traverse output ans

main = do
    t <- read <$> getLine :: IO Int
    mapM_ solve [1..t]

solve :: Int -> IO ()
solve _ = do
    [a, b, c] <- map read . words <$> getLine :: IO [Int]
    putStrLn $ let x = max 0 (max b c + 1 - a)
                   y = max 0 (max a c + 1 - b)
                   z = max 0 (max a b + 1 - c)
                in show x ++ " " ++ show y ++ " " ++ show z

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    nums@[_a,_b,_c] <- map read <$> words <$> getLine   :: IO [Int]
    return nums

solve xs = intercalate " " . map show . map (f is) $ is
  where
    is = zip [1::Int ..] xs

f is (i,v) = uncurry extra . (,) v . (+1) . maximum . map snd . filter ((/=i).fst) $ is

extra have need | (have < need) = need - have | otherwise = 0

import Control.Monad (replicateM_, forM_, forM)
import Control.Applicative ()

nextList :: IO [Int]
nextList = map read.words <$> getLine

solve = do
    [a, b, c] <- nextList
    let ans = show <$> [max 0 $ (max b c + 1) - a, max 0 $ (max a c + 1) - b, max 0 $ (max a b + 1) - c]
    putStrLn $ unwords ans
    return ()

main = do
    [t] <- nextList
    replicateM_ t solve


{-# language TupleSections #-}

module Main where

import Control.Monad
import Data.Array

import Debug.Trace

m = 100

type A = Array (Int,Int) Int
type Pos = (Int,Int)

decompose :: Int -> [Int]
decompose 0 = []
decompose n = x : decompose (n - pyth x)
  where
    x = opt pyth n

opt f x = length $ takeWhile (<=x) $ map f [1..]

pyth x = (x*(x-1))       `div` 2
ntr  x = ((x-2)*(x-1)*x) `div` 6

connectionEdges nfill nedges level
  | nfill < nedges = error "Not enought"
  | otherwise      = rev $
                     take nedges $
                     zip [1..] (repeat level)
  where
    rev l = l ++ map (\(x,y) -> (y,x)) l

solve :: Int -> Array (Int,Int) Int
solve n = arr'
  where
    nfill = opt ntr n
    rest  = n - ntr nfill
    arr   = array ((1,1),(m,m)) $
            [((i,j),0) | i <- [1..m], j <- [1..m]]
    fillEdges = map (,1)
                [ (x,y) | x <- [1..nfill], y <- [1..nfill], x/=y ]
    restEdges = map (,1) $
                concatMap (uncurry $ connectionEdges nfill) $
                zip (decompose rest) [m,m-1..0]
    arr' = arr // (fillEdges ++ restEdges)

showArr arr = unlines $ map row rows
  where
    ((i,j),(a,b)) = bounds arr
    rows = [i..a]
    cols = [j..b]
    row i = concat $ map show [arr ! (i,v) | v <- cols]

main = do
  n <- readLn
  print m
  putStrLn $ showArr (solve n)

import Control.Applicative
import Data.List

full2 :: Int -> Int
full2 x = (x * (x - 1)) `div` 2

full3 :: Int -> Int
full3 x = (x * (x - 1) * (x - 2)) `div` 6

findBase :: Int -> Int
findBase n = (head $ dropWhile (\x -> full3 x <= n) [1..]) - 1

toP2SumGreedy :: Int -> Int -> [Int]
toP2SumGreedy b n = toP2SumGreedy' n [b, b-1 .. 2]  where
    toP2SumGreedy' 0 _ = []
    toP2SumGreedy' n arr@(x:xs) = let f2x = full2 x in if n >= f2x
        then x:toP2SumGreedy' (n - f2x) arr
        else toP2SumGreedy' n xs

clique :: Int -> [(Int, Int)]
clique n = [(i, j) | i <- [0..n-1], j <- [i+1..n-1]]

newVertex :: Int -> Int -> [(Int, Int)]
newVertex id cnt = [(i, id) | i <- [0..cnt-1]]

toString :: Int -> Int -> [Int] -> String
toString n now xs
        | n == now = []
        | null xs = '0':toString n (now+1) []
        | head xs == now = '1':(toString n (now + 1) $ tail xs)
        | head xs > now = '0':toString n (now + 1) xs
        | head xs < now = toString n now $ tail xs

verticesFrom :: [(Int, Int)] -> Int -> [Int]
--verticesFrom edges v = [i | (v, i) <- edges] ++ [i | (i, v) <- edges]
verticesFrom [] v = []
verticesFrom ((x,y):xs) v
    | x == v = y:verticesFrom xs v
    | y == v = x:verticesFrom xs v
    | otherwise = verticesFrom xs v

buildRow :: Int -> [(Int, Int)] -> Int -> String
buildRow n edges v = toString n 0 $ sort $ verticesFrom edges v

toAdgMatrix :: [(Int, Int)] -> [String]
toAdgMatrix edges = res where
    n = 1 + max (maximum $ map fst edges) (maximum $ map snd edges)
    res = [buildRow n edges i | i <- [0..n-1]]

solve :: Int -> [String]
solve n = toAdgMatrix edges where
    b = findBase n
    restCnts = toP2SumGreedy b $ n - full3 b
    edges :: [(Int, Int)]
    edges = clique b ++ (concat $ map (\(id, cnt) -> newVertex id cnt) $ zip [b..] restCnts)

main = do
    n <- read <$> getLine
    let ans = solve n
    print $ length ans
    putStrLn $ concatMap (++"\n") ans


{-# LANGUAGE BangPatterns #-}
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe

solve [_] = []
solve ([a,b]:x@[c,d]:xs) = y : rest
    where
        rest = solve $ x : xs
        e = min c d
        y = if a == b then e - a
            else if a < b && b <= e then e - b + 1
            else if a > b && a <= e then e - a + 1
            else 0

readInts = map (fst . fromJust . B.readInt) . B.words <$> B.getLine

main = do
    n <- readLn
    xs <- replicateM n $ readInts
    print . (+1) . sum . solve $ [0,0] : xs

{-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE BinaryLiterals #-}
-- {-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE NumDecimals #-}
-- {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
-- import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

-- import Data.Array.ST.Safe
-- import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	n <- readInt
	[ as, bs ] <- transpose <$> replicateM n readInts
	print $ sum $ map ( uncurry subtract ) $ merge $ solve (0:as) (0:bs)

solve [_] _ = []
solve (a1:a2:as) (b1:b2:bs) = if p < q then ( p, q ) : r else r
	where
		p = max a1 b1
		q = min a2 b2 + 1
		r = solve (a2:as) (b2:bs)

merge [] = []
merge [a] = [a]
merge ( (a1,b1) : ( a2, b2 ) : rest )
	| a2 <= b1 = merge ( ( a1, b2 ) :  rest )
	| otherwise = ( a1, b1 ) : merge ( ( a2, b2 ) : rest )

import Control.Monad

solve [_] = []
solve ([a,b]:x@[c,d]:xs) = y : rest
    where
        rest = solve $ x : xs
        e = min c d
        y = if a == b then e - a
            else if a < b && b <= e then e - b + 1
            else if a > b && a <= e then e - a + 1
            else 0

--readInts = do
--    [a,b] <- (map read . words) <$> getLine
--    return (a,b)

main = do
    n <- readLn
    xs <- replicateM n $ (map read . words) <$> getLine
    print . (+1) . sum . solve $ [0,0] : xs

import Control.Monad

solve [_] = []
solve ((a,b):(c,d):xs) = x : rest
    where
        rest = solve $ (c,d) : xs
        e = min c d
        x = if a == b then e - a
            else if a < b && b <= e then e - b + 1
            else if a > b && a <= e then e - a + 1
            else 0

readInts :: IO ((Int,Int))
readInts = do
    [a,b] <- (map read . words) <$> getLine
    return (a,b)

main = do
    n <- readLn
    xs <- (:) (0,0) <$> replicateM n readInts
    print . (+1) . sum $ solve xs

calculate :: Int -> Int -> Int -> [[Int]] -> Int
calculate ans c d ([a,b]:xs)
    | c == d = calculate (ans + e - c) a b xs
    | c <  d && d <= e = calculate (ans + e - d + 1) a b xs
    | c >  d && c <= e = calculate (ans + e - c + 1) a b xs
    | otherwise = calculate ans a b xs
        where e = min a b
calculate ans c d [] = ans
main = do
    _ <- getLine
    interact $ show . calculate 1 0 0 . map (map read . words) . lines

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import qualified Data.ByteString.Char8 as B

import Data.Maybe
import Data.List

solve [_] _ = []
solve (a:c:xs) (b:d:ys) = ans : rest
    where
        rest = solve (c:xs) (d:ys)
        e = min c d
        ans = if a == b then e - a
              else if a < b && b <= e then e - b + 1
              else if a > b && a <= e then e - a + 1
              else 0

readInts = map (fst . fromJust . B.readInt) . B.words <$> B.getLine

main = do
    n <- readLn
    [as,bs] <- transpose <$> replicateM n readInts
    print . (+1) . sum $ solve (0:as) (0:bs)

{-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE BinaryLiterals #-}
-- {-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE NumDecimals #-}
-- {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
-- import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

-- import Data.Array.ST.Safe
-- import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	n <- readInt
	[ as, bs ] <- transpose . map head . group <$> replicateM n readInts
	print $ sum $ map ( uncurry subtract ) $ merge $ solve (0:as) (0:bs)
	print $ solve (0:as) (0:bs)

solve [_] _ = []
solve (a1:a2:as) (b1:b2:bs) = if p <= q then ( p, q ) : r else r
	where
		p = max a1 b1
		q = min a2 b2 + 1
		r = solve (a2:as) (b2:bs)

merge [] = []
merge [a] = [a]
merge ( (a1,b1) : ( a2, b2 ) : rest )
	| a2 <= b1 = ( a1, b2 ) : merge  rest
	| otherwise = ( a1, b1 ) : merge ( ( a2, b2 ) : rest )

{-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE BinaryLiterals #-}
-- {-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE NumDecimals #-}
-- {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
-- import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

-- import Data.Array.ST.Safe
-- import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	n <- readInt
	[ as, bs ] <- transpose . map head . group <$> replicateM n readInts
	print $ sum $ map ( uncurry subtract ) $ merge $ solve (0:as) (0:bs)

solve [_] _ = []
solve (a1:a2:as) (b1:b2:bs) = ( max a1 b1, min a2 b2 + 1 ) : solve (a2:as) (b2:bs)

merge [] = []
merge [a] = [a]
merge ( (a1,b1) : ( a2, b2 ) : rest )
	| a2 <= b1 = ( a1, b2 ) : merge  rest
	| otherwise = ( a1, b1 ) : merge ( ( a2, b2 ) : rest )

{-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE BinaryLiterals #-}
-- {-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE NumDecimals #-}
-- {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
-- import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

-- import Data.Array.ST.Safe
-- import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	n <- readInt
	[ as, bs ] <- transpose . map head . group <$> replicateM n readInts
	print $ solve (0:as) (0:bs)

solve [_] _ = 0
solve (a1:a2:as) (b1:b2:bs) = let d = min a2 b2 - max a1 b1 in max 0 ( d + 1 ) + solve (a2:as) (b2:bs)

{-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE BinaryLiterals #-}
-- {-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE NumDecimals #-}
-- {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
-- import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

-- import Data.Array.ST.Safe
-- import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	n <- readInt
	[ as, bs ] <- transpose . map head . group <$> replicateM n readInts
	print $ sum $ map ( uncurry subtract ) $ merge $ solve (0:as) (0:bs)

solve [_] _ = []
solve (a1:a2:as) (b1:b2:bs) = if p <= q then ( p, q ) : r else r
	where
		p = max a1 b1
		q = min a2 b2 + 1
		r = solve (a2:as) (b2:bs)

merge [] = []
merge [a] = [a]
merge ( (a1,b1) : ( a2, b2 ) : rest )
	| a2 <= b1 = ( a1, b2 ) : merge  rest
	| otherwise = ( a1, b1 ) : merge ( ( a2, b2 ) : rest )


import Prelude hiding (Left, Right)
import Data.List (transpose)
import Control.Monad

data Pipe = Straight | Bent
  deriving (Show, Eq)

data Direction = Up | Left | Right
  deriving (Show, Eq)
data Pos = Lefty | Righty
  deriving (Show, Eq)

numToPipe :: Int -> Pipe
numToPipe x
  | x `elem` [1..2] = Straight
  | x `elem` [3..6] = Bent

canReach :: [[Pipe]] -> Bool
canReach pipes = solve Up Lefty pipes
  where
    solve :: Direction -> Pos -> [[Pipe]] -> Bool
    solve from currPos [] = currPos == Righty
    solve from currPos allPipes@([left, right]:rest)
      | from /= Up && currPipe == Straight = False
      | from /= Up && currPipe == Bent =
          solve Up currPos rest
      | from == Up = if currPipe == Straight then
          solve Up currPos rest
        else
          let comingFrom = if currPos == Lefty then Left else Right in
            solve comingFrom otherPipe allPipes
      where currPipe = if currPos == Lefty then left else right
            otherPipe = if currPos == Lefty then Righty else Lefty

main = do
  q <- read <$> getLine
  replicateM q $ do
    numPipes <- read <$> getLine :: IO Int
    rows <- transpose <$> replicateM 2 (fmap (numToPipe . read . (:[])) <$> getLine)
    putStrLn $
      if canReach rows then
        "YES"
      else
        "NO"
    return ()

import Data.List
import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    getLine
    [r1,r2] <- replicateM 2 getLine
    putStrLn $ if snd (foldl' adv (True,False) (zip r1 r2))
               then "YES"
               else "NO"
adv (fu,fd) (pu,pd) = (pu',pd') where
  pu' = fu && straight pu || fd && bent pu && bent pd
  pd' = fd && straight pd || fu && bent pu && bent pd
straight x = x <= '2'
bent x = x >= '3'

import Data.List

boolToAns :: Bool -> String
boolToAns x = if (x == True) then "YES" else "NO"

getPipeType :: Integer -> Integer
getPipeType x = if (x < 3) then 1 else 2

getAnswer :: Integer -> Integer -> String -> String -> Bool
getAnswer n position string1 string2 =
    do
        if (n == 0 && position == 2) then True
        else if (n == 0) then False
        else if (position == 1 && (getPipeType (read [head string1] :: Integer)) == 1)
            then getAnswer (n - 1) position (drop 1 string1) (drop 1 string2)
        else if (position == 1 && (getPipeType (read [head string1] :: Integer)) == 2)
            then if ((getPipeType (read [head string2] :: Integer)) == 2) then getAnswer (n - 1) 2 (drop 1 string1) (drop 1 string2)
                                                                          else False
        else if (position == 2 && (getPipeType (read [head string2] :: Integer)) == 1)
            then getAnswer (n - 1) position (drop 1 string1) (drop 1 string2)
        else if (position == 2 && (getPipeType (read [head string2] :: Integer)) == 2)
            then if ((getPipeType (read [head string1] :: Integer)) == 2) then getAnswer (n - 1) 1 (drop 1 string1) (drop 1 string2)
                                                                          else False
        else True -- Theoretically it never enters in this else

--solver :: Integer
solver 0 = return ()
solver t =
    do
        line <- getLine
        let n = read line :: Integer
        string1 <- getLine
        string2 <- getLine
        --let ans = getAnswer n 1 string1 string2
        putStrLn (boolToAns (getAnswer n 1 string1 string2))
        solver (t-1)

main = do
    line <- getLine
    let t = read line :: Integer
    solver t

import Data.Char (isDigit)
import Data.Set (Set)
import qualified Data.Set as Set

inputNum = do
  line <- getLine
  return ((read line) :: Int)

inputArr = do
  line <- getLine
  let ar = ((map (\x -> read [x]) line) :: [Int])
  return ar

solve3 (_, b) [] [] = b
solve3 (p1, p2) (a:r1) (b:r2) = solve3 (newp1, newp2) r1 r2
  where newp1 = (p1 && (a==1)) || (p2 && (a==2) && (b==2))
        newp2 = (p2 && (b==1)) || (p1 && (a==2) && (b==2))

solve = do
  n <- inputNum
  r1 <- inputArr
  r2 <- inputArr
  let f x = map (\z -> if z<3 then 1 else 2) x
  let pos = solve3 (True, False) (f r1) (f r2)
  putStrLn (if pos then "YES" else "NO")

solveCases 0 = return ()
solveCases q = do
  solve
  solveCases (q-1)

main = do
  q <- inputNum
  solveCases q

import Data.Char (isDigit)
import Data.Set (Set)
import qualified Data.Set as Set

inputNum = do
  line <- getLine
  return (read line)

inputArr = do
  line <- getLine
  let newL = filter isDigit line
  let ar = ((map (\x -> read [x]) newL) :: [Int])
  return ar

solve3 (_, b) [] [] = b
solve3 (p1, p2) (a:r1) (b:r2) = solve3 (newp1, newp2) r1 r2
  where newp1 = (p1 && (a==1)) || (p2 && (a==2) && (b==2))
        newp2 = (p2 && (a==1)) || (p1 && (a==2) && (b==2))

solve = do
  n <- inputNum
  r1 <- inputArr
  r2 <- inputArr
  let f x = map (\z -> if z<3 then 1 else 2) x
  let pos = solve3 (True, False) (f r1) (f r2)
  putStrLn (if pos then "YES" else "NO")

solveCases 0 = return ()
solveCases q = do
  solve
  solveCases (q-1)

main = do
  q <- inputNum
  solveCases q


import Data.Array (listArray, (!))

process :: [[Char]] -> Int
process mat = sum [check (i,j) | i <- [2..(n-1)], j <- [2..(n-1)]]
    where
        n = length mat
        mat' = listArray ((1,1),(n,n)) $ concat mat
        check (i,j)
            | mat' ! (i,j) == 'X'
            && mat' ! (i-1,j-1) == 'X'
            && mat' ! (i-1,j+1) == 'X'
            && mat' ! (i+1,j-1) == 'X'
            && mat' ! (i+1,j+1) == 'X'= 1
            | otherwise = 0

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    mat <- fmap lines getContents
    print $ process mat

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

onecase n a (a1,a2)  		| a1==1 || a1==x || a2==1 || a2==x =0
                                | all (== 'X') [a!(a1,a2),a!(a1-1,a2-1),a!(a1-1,a2+1),a!(a1+1,a2-1),a!(a1+1,a2+1)]=1
                   	| otherwise =0
	where ((x1,y1),(x,y)) = bounds a
main = do
		n<- read<$> getLine ::IO Int
		a1<- concat <$> replicateM n getLine::IO [Char]
		let a = listArray ((1,1),(n,n)) a1
		print $ sum $ map (onecase n a)  [( a1,a2)|a1<-[1..n],a2<-[1..n]]

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

main :: IO ()
main = do
  k <- read <$> getLine
  cs <- take (k*k) . map (=='X') . filter (`elem` ".X") <$> getContents
  let arr = A.listArray ((1,1),(k,k)) cs :: UArray (Int,Int) Bool
  print $ length $ [() | i <- [2..k-1], j <- [2..k-1],
                         and $ map (arr A.!)
                          $ (i,j):[(i+u,j+v)| u<-[1,-1], v<-[1,-1]]]

import Data.Array
main = do
  n <- readLn
  g <- listArray ((1,1),(n,n)) . concat . lines <$> getContents
  let cross (i,j) = i > 1 && i < n && j > 1 && j < n &&
        map (g!) [(i-1,j-1),(i-1,j+1),(i,j),(i+1,j-1),(i+1,j+1)] == "XXXXX"
  print $ length $ filter cross $ indices g

import Data.Array
main = do
  n <- readLn
  g <- listArray ((1,1),(n,n)) . concat . lines <$> getContents
  let cross (i,j) = i > 1 && i < n && j > 1 && j < n &&
        map (g!) [(i-1,j-1),(i-1,j+1),(i,j),(i+1,j-1),(i+1,j+1)] == "xxxxx"
  print $ length $ filter cross $ indices g

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

onecase n a i  		| any (<x)  [i-n-1,i-n+1]=0
			| any (>y)  [i+n+1,i+n-1]=0
                        | all (== 'X') [a!i,a!(i-n-1),a!(i-n+1),a!(i+n+1),a!(i+n-1)]=1
                   	| otherwise =0
	where (x,y) = bounds a
main = do
		n<- read<$> getLine ::IO Int
		a1<- concat <$> replicateM n getLine::IO [Char]
		let a = listArray (1,n*n) a1
		print $ sum $ map (onecase n a)  [0..(n*n)-1]


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

process su d x | x==[] = su
	       | d< z = su
	       | y==0 = process su d (tail x)
	       | otherwise = process (su + su1)  ( d-su1*z) (tail x)

	where 	(y,z)  = head x
             	dz = div d z
		su1 = min dz y

onecase = do
		[n,d]<-map read <$> words <$> getLine ::IO [Integer]
		s<-map read <$> words <$> getLine ::IO [Integer]
		let x = zip s [0..]
		print $ process (head s) d (tail x)
main = do
		n<-read<$> getLine ::IO Int
		replicateM_ n onecase

process :: Int -> [Int] -> Int
process d xs = fst $ foldl f (head xs,d) (zip (tail xs) [1..])
    where
        f :: (Int, Int) -> (Int, Int) -> (Int, Int)
        f acc@(s,n) (x,i)
            | n <= 0 = acc
            | n <= i*x = (s+(n`div`i),0)
            | otherwise = (s+x,n-i*x)

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    [n,d] <- fmap (map readInt.words) getLine
    a <- fmap (map readInt.words) getLine
    print $ process d a
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

main = getLine >>= test.read
test :: Integer -> IO ()
test 0 = return ()
test t = do
  (n:d:_) <- map read.words <$> getLine
  (a:as) <- map read.words <$> getLine
  print $ a + solve d as 1
  test (t - 1)

solve d _ _ | d <= 0 = 0
solve _ [] _ = 0
solve d (a:as) n = let v = min a (div d n) in v + solve (d - v * n) as (n + 1)

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (n, d) <- liftM2 (,) get get
    as <- replicateM n get
    putln $ f2 as n d

f2 :: [Int] -> Int -> Int -> Int
f2 [] n d = 0
f2 (x : l) n d = f3 l d x 1

f3 :: [Int] -> Int -> Int -> Int -> Int
f3 [] d s i = s
f3 (y : l) d s i = if y < (div d i) then
                        f3 l (d - (y * i)) (s + y) (i + 1)
                    else
                        s + (div d i)

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

process su d x | x==[] = su
	       | d< y = su
	       | y==0 = process su d (tail x)
	       | otherwise = process (su + su1)  ( d-su1*z) (tail x)

	where 	(y,z)  = head x
             	dz = div d z
		su1 = min dz y

onecase = do
		[n,d]<-map read <$> words <$> getLine ::IO [Integer]
		s<-map read <$> words <$> getLine ::IO [Integer]
		let x = zip s [0..]
		print $ process (head s) d (tail x)
main = do
		n<-read<$> getLine ::IO Int
		replicateM_ n onecase


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: ByteString -> Int
solve line = case C.foldl' loop (1, 1, 0) line of
        (i, _, j) -> i +: j
    where
    (+:) !a !b = (a + b) `mod` 1000000007
    aggr (!a, !b, !c) (!i, !j, !k) = (a +: i, b +: j, c +: k)

    -- (0, 2, *)
    loop :: (Int, Int, Int) -> Char -> (Int, Int, Int)
    loop (!i, _, _)  '0' = (i, 0, 0)
    loop (!i, _, !k) '1' = (k, i, 0)
    loop (_,  _, !k) '2' = (0, k, 0)
    loop (_, !j, !k) '*' = (0, 0, j +: k)
    loop !acc        '?' = foldr1 aggr $ fmap (loop acc) "012*"

main = B.init <$> B.getLine >>= print . solve

{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: ByteString -> Int
solve line = case C.foldl' loop (1, 1, 0) line of
        (i, _, j) -> i +: j
    where
    a +: b = (a + b) `mod` 1000000007
    aggr (a, b, c) (i, j, k) = (a +: i, b +: j, c +: k)

    -- (0, 2, *)
    loop :: (Int, Int, Int) -> Char -> (Int, Int, Int)
    loop (i, _, _) '0' = (i, 0, 0)
    loop (i, _, k) '1' = (k, i, 0)
    loop (_, _, k) '2' = (0, k, 0)
    loop (_, j, k) '*' = (0, 0, (j + k) `mod` 1000000007)
    loop acc       '?' = foldr1 aggr $ fmap (loop acc) "012*"

main = B.init <$> B.getLine >>= print . solve

{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: ByteString -> Int
solve line = case C.foldl loop (1, 1, 0) line of
        (i, _, j) -> i +: j
    where
    a +: b = (a + b) `mod` 1000000007
    aggr (a, b, c) (i, j, k) = (a +: i, b +: j, c +: k)

    -- (0, 2, *)
    loop :: (Int, Int, Int) -> Char -> (Int, Int, Int)
    loop (i, _, _) '0' = (i, 0, 0)
    loop (i, _, k) '1' = (k, i, 0)
    loop (_, _, k) '2' = (0, k, 0)
    loop (_, j, k) '*' = (0, 0, j +: k)
    loop acc       '?' = foldr1 aggr $ fmap (loop acc) "012*"

main = B.init <$> B.getLine >>= print . solve


main :: IO ()
main = getLine >>=
        \x -> putStrLn $ x ++ (reverse x)

main = putStrLn . (flip (++) =<< reverse) =<< getLine

main = do
    name <- getLine
    putStrLn (name ++ (reverse name))

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

main = do
  n <- getLine
  putStrLn $ n ++ reverse n

main = do
    n <- getLine
    putStr $ n++(reverse n)

main = interact $ (\s -> s ++ reverse s) . head . words

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

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

main = interact $ (\x -> x ++ (reverse x)).init

main = interact $ (\x -> (++) x.reverse $ x).head.lines

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
-- Meat
solve :: String-> String
solve s= s ++ reverse s

-- Shit
main :: IO ()
main = do
        [s]  <- readShit
        printShit [solve s]

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

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

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

main :: IO()
main = do
  s <- getLine
  putStrLn (s ++ reverse s)

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

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

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

  putStrLn $ s ++ reverse s

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = (solve.C.init.head=<<forM [1..1] (\i->C.getLine) )
solve xs = C.putStr $ C.append xs (C.reverse xs)

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C

main=do

    q<-     getLine
    putStrLn $ q  ++ (reverse q)

main = print . (flip (++) =<< reverse) =<< getLine

main = interact (\x -> (++) x.reverse $ x)

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = (solve.head=<<forM [1..1] (\i->C.getLine) )
solve xs = C.putStr $ C.append xs (C.reverse xs)

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C

main=do

    q<-     C.getLine
    putStrLn ""
    C.putStrLn $ C.append q   (C.reverse q)
    putStrLn ""

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C

main=do

    q<-     C.getLine
    C.putStrLn $ C.append q   (C.reverse q)
    putStrLn ""

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C

main=do

    q<-     C.getLine
    putStrLn $ C.unpack $ C.append q   (C.reverse q)


import Data.Char(digitToInt)

f :: String -> Int

f "" = 0
f s = do
    (f (take ((length s)-1) (drop 1 s))) + (digitToInt (head s))

solve 0 = return ()
solve t = do
    s <- getLine
    let v1 = take 3 s
    let v2 = take 3 (drop 3 s)
    let x = f v1
    let y = f v2
    if x==y then putStrLn "YES" else putStrLn "NO"
    solve (t-1)

main :: IO()
main = do
    line <- getLine
    let t = (read (takeWhile (/= ' ') line) :: Int)
    solve t

module Main where

import Data.List
import Data.Maybe

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let sols = map (format . solve . parse) $ take t $ sep $ lines input
  mapM_ putStrLn sols

sep = id

parse :: String -> [Int]
parse = map (read . singleton)

singleton a = [a]

format b
  | b = "YES"
  | otherwise = "NO"

solve xs = sum head == sum tail
  where (head,tail) = splitAt 3 xs

--
{-# 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.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 :: String -> Bool
solve str = L.sum (L.take 3 digits) == L.sum (L.take 3 $ L.reverse digits)
    where
        digits = L.map (\c -> ord c - ord '0') str

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        s <- B8.getLine <&> L.head . B8.words
        let answer = solve $ B8.unpack s
        putsYesNo answer

import Data.List
import Data.Char

main :: IO ()
main = do
	n <- getLine
	let number = read n :: Int
	solve number number

solve :: Int -> Int -> IO ()
solve number 0 = return ()
solve number current = 	do
				l <- getLine
				if isHappy l then putStrLn "YES" else putStrLn "NO"
				solve number (current - 1)

isHappy :: String -> Bool
isHappy line = let
					digits = map digitToInt line
					left = foldr (+) 0 $ take 3 digits
					right = foldr (+) 0 $ drop 3 digits
					in left == right

import Control.Monad (replicateM)
import Data.List (intercalate)
import Data.Char (digitToInt)

sum' :: String -> Int
sum' = sum . map digitToInt

isLucky :: String -> Bool
isLucky s = sum' (take 3 s) == sum' (drop 3 s)

sol :: [String] -> String
sol = intercalate "\n" . map (\x -> if isLucky x then "yes" else "no")

readStrs :: IO [String]
readStrs = do
  n <- read <$> getLine
  replicateM n getLine

main :: IO ()
main = do
  inp <- readStrs
  putStrLn $ sol inp

import Control.Monad
main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    (n1:n2:n3:n4:n5:n6:[]) <- fmap (fmap read)
                         . fmap (fmap (\x -> [x]))
                         $ getLine
    if sum [n1,n2,n3] == sum [n4,n5,n6]
    then putStrLn "YES"
    else putStrLn "NO"

import Control.Arrow ((>>>))

solve :: [Int] -> String
solve [a,b,c,d,e,f] = if (a+b+c) == (d+e+f) then "YES" else "NO"

main =
  interact $
    lines >>>
    drop 1 >>>
    map (solve . map (read . pure :: Char -> Int)) >>>
    unlines

import Control.Monad (replicateM_, replicateM)

main :: IO ()
main = read <$> getLine >>= flip replicateM_ singleCase

singleCase :: IO ()
singleCase = read <$> getLine >>= \n -> if lucky n
                                        then putStrLn "YES"
                                        else putStrLn "NO"

lucky :: Int -> Bool
lucky n = let n1 = div n 1000
              n2 = mod n 1000
          in sumDigits n1 0 == sumDigits n2 0

sumDigits :: Int -> Int -> Int
sumDigits n acc = let nd = div n 10
                      nm = mod n 10
                  in if nd == 0
                     then acc + nm
                     else sumDigits nd (acc+nm)

for :: Int -> IO ()
for 0 = pure ()
for i = do
  s <- getLine
  let arr = map (\c -> read [c] :: Int) s
  if arr !! 0 + arr !! 1 + arr !! 2 == arr !! 3 + arr !! 4 + arr !! 5
    then putStrLn "YES"
    else putStrLn "NO"
  for $ i - 1

main = do
  t <- readLn :: IO Int
  for t


import Data.List (partition)
solve :: [Int] -> [[Int]]
solve (k:p:xs)
    | det < 0 = []
    | odd det = []
    | length evens + div det 2 < p = []
    | otherwise = (h ++ junk ++ junk') : t
    where (odds, evens) = partition odd xs
          det = length odds - k + p
          (useodd, rest) = splitAt (k - p) odds
          (paired, junk) = splitAt (p * 2) rest
          (useeven, junk') = splitAt req evens
          req = p - div (length paired) 2
          (h:t) = makeListed useodd ++ pairChunks paired ++ makeListed useeven
pairChunks [] = []
pairChunks (x:y:s) = [x,y] : pairChunks s
makeListed = map (:[])
output xs = if null xs then "NO\n" else unlines ("YES" : map parted xs)
    where parted ps = (unwords . map show) (length ps : ps)
main = interact $ output.solve.map read.tail.words

import Data.List
import Data.Function

main = interact $ maybe "NO" (("YES\n" ++ ) . unlines . map (unwords . map show)) . getAns . map read . words

getAns :: [Int] -> Maybe [[Int]]
getAns (_:k:p:xs) = getGroup (k - p) k $ partition even xs

getGroup :: Int -> Int -> ([Int], [Int]) -> Maybe [[Int]]
getGroup _ n ([], []) | n > 0 = Nothing
getGroup t _ (_, []) | t > 0 = Nothing
getGroup t 1 (es, os) =
	if (odd $ length os + t) then Nothing
	else Just [(length es + length os):(es ++ os)]
getGroup 0 n ([], o1:o2:os) = fmap ([2, o1, o2] :) $ getGroup 0 (n - 1) ([], os)
getGroup 0 n (e:es, os) = fmap ([1, e] :) $ getGroup 0 (n - 1) (es, os)
getGroup t n (es, o:os) = fmap ([1, o] :) $ getGroup (t - 1) (n - 1) (es, os)

import Data.List
import Data.Function

main = interact $ maybe "NO" (("YES\n" ++ ) . unlines . map (unwords . map show . addLength)) . getAns . map read . words

addLength :: [Int] -> [Int]
addLength a = (length a) : a

getAns :: [Int] -> Maybe [[Int]]
getAns (_:k:p:xs) = getGroup (k - p) k $ partition even xs

getGroup :: Int -> Int -> ([Int], [Int]) -> Maybe [[Int]]
getGroup _ n ([], []) | n > 0 = Nothing
getGroup t _ (_, []) | t > 0 = Nothing
getGroup t 1 (es, os) =
	if (odd $ length os + t) then Nothing
	else Just [es ++ os]
getGroup 0 n ([], o1:o2:os) = fmap ([o1, o2] :) $ getGroup 0 (n - 1) ([], os)
getGroup 0 n (e:es, os) = fmap ([e] :) $ getGroup 0 (n - 1) (es, os)
getGroup t n (es, o:os) = fmap ([o] :) $ getGroup (t - 1) (n - 1) (es, os)

import Data.List
import Data.Function

main = interact $ maybe "NO" (("YES\n" ++ ) . unlines . map (unwords . map show)) . getAns . map read . words

getAns :: [Int] -> Maybe [[Int]]
getAns (_:k:p:xs) = getGroup (k - p) k $ partition even xs

getGroup :: Int -> Int -> ([Int], [Int]) -> Maybe [[Int]]
getGroup _ n ([], []) | n > 0 = Nothing
getGroup t _ (_, []) | t > 0 = Nothing
getGroup t 1 (es, os) =
	if (odd $ sum os + sum es + t) then Nothing
	else Just [(length es + length os):(es ++ os)]
getGroup 0 n ([], o1:o2:os) = fmap ([2, o1, o2] :) $ getGroup 0 (n - 1) ([], os)
getGroup 0 n (e:es, os) = fmap ([1, e] :) $ getGroup 0 (n - 1) (es, os)
getGroup t n (es, o:os) = fmap ([1, o] :) $ getGroup (t - 1) (n - 1) (es, os)

{-# 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,k,p] <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getContents
  case solve n k p xs of
    Nothing -> putStrLn "NO"
    Just xss
      | length xss /= k -> putStrLn "NO"
      | otherwise -> do
          putStrLn "YES"
          putStr.unlines $ map (\xs-> unwords.map show$length xs:xs) xss

solve :: Int -> Int -> Int -> [Int] -> Maybe [[Int]]
solve n k p xs
  | 0<=q && q <= k && q<= numOdd && even (numOdd - q) = Just $ f (map return ys ++ rest) (concat rest')
  | otherwise = Nothing
   where
     !q = k - p
     (evens, odds) = partition even xs
     !numEven = length evens
     !numOdd  = n - numEven
     (ys, zs) = splitAt q odds
     (rest, rest') = splitAt (k-q) $ chunksOf 2 zs ++ map return evens
     f (xs:xss) ys = (xs++ys) : xss

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = map(take n).takeWhile(not.null).iterate(drop n)

import Data.List
import Control.Monad
q l=unwords$map show$length l:l
pairs(a:b:l)=[a,b]:pairs l
pairs[]=[]

solve l needOdds needEvens = do
    guard (length oddsNeeded == needOdds)
    guard (even $ length oddsSpare)
    guard (length evensNeeded == needEvens)
    return result
  where
  (odds, evens) = partition odd l
  (oddsNeeded, oddsSpare) = splitAt needOdds odds
  oddPairs = pairs oddsSpare
  evenGroups = oddPairs ++ map (:[]) evens
  spareEvens = concat (drop needEvens evenGroups)
  evensNeeded = take needEvens evenGroups
  resultsNeeded = map (:[]) oddsNeeded ++ evensNeeded
  result = init resultsNeeded ++ [last resultsNeeded ++ spareEvens]

s(_:k:p:l) = case solve l (k - p) p of
  Nothing -> ["NO"]
  Just l -> "YES" : map q l

main=interact$unlines.s.map read.words

import Data.List (partition)
solve :: [Int] -> [[Int]]
solve (k:p:xs)
    | det < 0 = []
    | odd det = []
    | length evens + div det 2 < p = []
    | otherwise = (h ++ junk ++ junk') : t
    where (odds, evens) = partition odd xs
          det = length odds - k + p
          (useodd, rest) = splitAt (k - p) odds
          (paired, junk) = splitAt (det * 2) rest
          (useeven, junk') = splitAt (p - det * 2) evens
          (h:t) = makeListed useodd ++ pairChunks paired ++ makeListed useeven
pairChunks [] = []
pairChunks (x:y:s) = [x,y] : pairChunks s
makeListed = map (:[])
output xs = if null xs then "NO\n" else unlines ("YES" : map parted xs)
    where parted ps = (unwords . map show) (length ps : ps)
main = interact $ output.solve.map read.tail.words

import Data.List
q l=unwords$map show$length l:l
pairs(a:b:l)=[a,b]:pairs l
pairs[]=[]
s(_:k:p:l)|length x<z||odd(length y)||length w+length e<p=["NO"]|1>0="YES":(map q$map(:[])x++take(p-1)w++[concat$drop(p-1)w])where z=k-p;(o,e)=partition odd l;(x,y)=splitAt z o;w=pairs y++map(:[])e
main=interact$unlines.s.map read.words

import Data.List
q l=unwords$map show$length l:l
pairs(a:b:l)=[a,b]:pairs l
pairs[]=[]
s(_:k:p:l)|length x<z||odd(length y)||length w<p=["NO"]|1>0="YES":(map q$map(:[])x++take(p-1)w++[concat$drop(p-1)w])where z=k-p;(o,e)=partition odd l;(x,y)=splitAt z o;w=pairs y++map(:[])e
main=interact$unlines.s.map read.words


import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    let
      y = minimum a
      ans = take (quot n 2) [[x, y] | x <- a, y /= x]
    pure $ foldMap putInts ans

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO
import Text.Printf

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    as <- getInts
    let x = minimum as
        ys = take (n `div` 2) $ filter (/= x) as
    return $ mconcat $ map (\y -> string7 $ printf "%d %d\n" y x) ys
  hPutBuilder stdout output


import Control.Monad
main :: IO ()
main = do
  n <- readLn
  print (4+3*n)
  forM_ (solve n) (putStrLn.unwords.map show)

f :: Int -> [[Int]]
f n = [[n,n],[n-1,n],[n,n-1]]

solve :: Int -> [[Int]]
solve n = [0,0]: concatMap f [1..n+1]

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Tuple

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

(|>) = flip ($)

main = do
  input <- getLine
  let n = read input :: Int
      func i = [(i, i), (i, i-1), (i-1, i)]
      res = ([(0, 0)] : (func <$> [1..n+1])) >>= id
  putStrLn $ show $ length res
  sequence_ $ putStrLn <$> (\(a, b) -> show a ++ " " ++ show b) <$> res


main :: IO ()
main = solve . parse =<< getContents

parse :: String -> (Double, Double, Double)
parse line = (a, b, c) where [a, b, c] = map read . words $ line

solve :: (Double, Double, Double) -> IO ()
solve (a, b, c)
    | a < 0 = solve (-a, -b, -c)
    | otherwise = do { let delta = sqrt $ b * b - 4 * a * c
                     ; print $ (-b + delta) / (2 * a)
                     ; print $ (-b - delta) / (2 * a)
                     }

module Main where

readInts :: IO [Int]
readInts = fmap (map read.words) getLine

--main--
main::IO()
main = do
        line <- readInts
        let a = line !! 0
        let b = line !! 1
        let c = line !! 2
        let delta = b ^ 2 - 4*a*c
        let x_1 = (fromIntegral(-b) - sqrt(fromIntegral delta))/ fromIntegral(2*a)
        let x_2 = (fromIntegral(-b) + sqrt(fromIntegral delta))/ fromIntegral(2*a)

        if x_1 > x_2
	   then do print x_1;
	           print x_2;
           else do print x_2;
                   print x_1

import Control.Monad
import Numeric

main = do
    [a,b,c] <- liftM (map read . words) (getLine) :: IO [Double]
    let d = sqrt $ b*b - 4*a*c
    let x1 = (-b+d)/(2*a)
    let x2 = (-b-d)/(2*a)
    putStrLn $ formatFloatN 15 $ max x1 x2
    putStrLn $ formatFloatN 15 $ min x1 x2
formatFloatN numOfDecimals floatNum= showFFloat (Just numOfDecimals) floatNum ""

import Control.Applicative
import Data.Char

main= do
	[a,b,c]<- map read.words <$>     getLine ::IO [Int]
	let p1 = (sqrt (fromIntegral (b*b-4*a*c))) / 2.0 / (fromIntegral a)
	let p2= (-(fromIntegral b))/2.0 / (fromIntegral a)
	let r1= p2-p1
	let r2= p2+p1
	print $ max r1 r2
	print $ min r1 r2

module Main where

main :: IO ()
main = getLine >>= \x -> f . map read . words $ x
  where f a = let solv = g (a !! 0) (a !! 1) (a !! 2) in (putStrLn.show.fst$solv) >> (putStrLn.show.snd$solv)
        g a b c = let delta = b ^ 2 - 4 * a * c in ((-b + (sgn a) * sqrt delta) / 2 / a, (-b - (sgn a) * sqrt delta) / 2 / a)
        sgn x | x < 0 = -1 | x > 0 = 1 | otherwise = 0

module Main where

main :: IO ()
main = getLine >>= \x -> f . map read . words $ x
  where f a = let solv = g (a !! 0) (a !! 1) (a !! 2) in (putStrLn.show.fst$solv) >> (putStrLn.show.snd$solv)
        g a b c = let delta = b ^ 2 - 4 * a * c in ((-b + sqrt delta) / 2 / a, (-b - sqrt delta) / 2 / a)

module Main where

readInts :: IO [Int]
readInts = fmap (map read.words) getLine

--main--
main::IO()
main = do
        line <- readInts
        let a = line !! 0
        let b = line !! 1
        let c = line !! 2
        let delta = b ^ 2 - 4*a*c
        let x_1 = (fromIntegral(b) + sqrt(fromIntegral delta))/ fromIntegral(2*a)
        let x_2 = (fromIntegral(-b) + sqrt(fromIntegral delta))/ fromIntegral(2*a)
        print x_1
        print x_2

module Main where

readInts :: IO [Int]
readInts = fmap (map read.words) getLine

--main--
main::IO()
main = do
        line <- readInts
        if length(line) < 3 && length(line) >= 4
             then putStr "3 parameters please, a, b and c \n"
             else putStr "correct input \n";
                  putStr "well \n"
        let a = line !! 0
        let b = line !! 1
        let c = line !! 2
        let delta = b ^ 2 - 4*a*c
        if delta >= 0
             then putStr "real roots! \n"
             else putStr "bad input, complex roots \n"
        let x_1 = (fromIntegral(b) + sqrt(fromIntegral delta))/ fromIntegral(2*a)
        let x_2 = (fromIntegral(-b) + sqrt(fromIntegral delta))/ fromIntegral(2*a)
        print x_1
        print x_2

import Control.Monad
main = do
    [a,b,c] <- liftM (map read . words) (getLine) :: IO [Double]
    let d = sqrt $ b*b - 4*a*c
    putStrLn $ show $ (-b+d)/(2*a)
    putStrLn $ show $ (-b-d)/(2*a)

main :: IO ()
main = solve . parse =<< getContents

parse :: String -> (Double, Double, Double)
parse line = (a, b, c) where [a, b, c] = map read . words $ line

solve :: (Double, Double, Double) -> IO ()
solve (a, b, c)
    | a < 0 = solve (-a, -b, -c)
    | otherwise = do { let delta = sqrt $ b * b - 4 * a * c
                     ; print $ (-b - delta) / (2 * a)
                     ; print $ (-b + delta) / (2 * a)
                     }


import Data.Int
import Data.Char
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as C

fst' :: (a, b, c) -> a
fst' (x,_,_) = x

snd' :: (a, b, c) -> b
snd' (_,x,_) = x

trd' :: (a, b, c) -> c
trd' (_,_,x) = x

f2read' :: Int64 -> Char -> Int64
f2read' x y = 10 * x + fromIntegral(ord y - ord '0')

f2read :: C.ByteString -> Int64
f2read x = C.foldl' f2read' 0 x

f2show :: Int64 -> C.ByteString
f2show x = C.reverse $ C.cons '\n' $ fst $ C.unfoldrN 20 (\x -> if x /= 0 then Just (chr $ ((fromIntegral (rem x 10)) :: Int) + ord '0', div x 10) else Nothing) x

f2lines :: C.ByteString -> [C.ByteString]
f2lines x = map (\x -> if (C.last x == '\r') then (C.init x) else x) (C.lines x)

tuple3 :: [a] -> (a, a, a)
tuple3 [x, y, z] = (x, y, z)

readP :: [C.ByteString] -> [(Int64, Int64, Int64)]
readP [] = []
readP (x:xs) = (tuple3 $ map f2read $ C.words x) : (readP xs)

allEq :: (Eq a) => [a] -> Bool
allEq ls = and $ map (== (head ls)) ls

divByGCD :: [Int64] -> [Int64]
divByGCD ls = map (`div` g) ls where g = foldl1' (gcd) ls

divisors :: Int64 -> Int64
divisors n = foldl1' (+) $ map (\x -> if x * x == n then 1 else 2) $ filter (\x -> rem n x == 0) $ takeWhile(\x -> x * x <= n) [1..]

solve' :: [[Int64]] -> Int64
solve' ls = if allEq (map divByGCD ls) then divisors (foldl1' (gcd) (map (foldl1' gcd) ls)) else 0

solve :: [(Int64, Int64, Int64)] -> Int64
solve p =
  let n = length p
      sp = sort p
      m = length $ takeWhile (\x -> (fst' $ head sp) == (fst' x)) sp
      csp = chunksOf m sp
  in if (rem n m == 0) && (allEq $ map (map snd') csp) then solve' (map (map trd') csp) else 0

main :: IO ()
main = do dat <- C.getContents
          print $ solve $ readP $ tail $ f2lines dat

import Data.Int
import Data.Char
import Data.List
import qualified Data.ByteString.Char8 as C

fst' :: (a, b, c) -> a
fst' (x,_,_) = x

snd' :: (a, b, c) -> b
snd' (_,x,_) = x

trd' :: (a, b, c) -> c
trd' (_,_,x) = x

f2read' :: Int64 -> Char -> Int64
f2read' x y = 10 * x + fromIntegral(ord y - ord '0')

f2read :: C.ByteString -> Int64
f2read x = C.foldl' f2read' 0 x

f2show :: Int64 -> C.ByteString
f2show x = C.reverse $ C.cons '\n' $ fst $ C.unfoldrN 20 (\x -> if x /= 0 then Just (chr $ ((fromIntegral (rem x 10)) :: Int) + ord '0', div x 10) else Nothing) x

f2lines :: C.ByteString -> [C.ByteString]
f2lines x = map (\x -> if (C.last x == '\r') then (C.init x) else x) (C.lines x)

tuple3 :: [a] -> (a, a, a)
tuple3 [x, y, z] = (x, y, z)

readP :: [C.ByteString] -> [(Int64, Int64, Int64)]
readP [] = []
readP (x:xs) = (tuple3 $ map f2read $ C.words x) : (readP xs)

allEq :: (Eq a) => [a] -> Bool
allEq ls = and $ map (== (head ls)) ls

divByGCD :: [Int64] -> [Int64]
divByGCD ls = map (`div` g) ls where g = foldl1' (gcd) ls

divisors :: Int64 -> Int64
divisors n = foldl1' (+) $ map (\x -> if x * x == n then 1 else 2) $ filter (\x -> rem n x == 0) $ takeWhile(\x -> x * x <= n) [1..]

solve' :: [[Int64]] -> Int64
solve' ls = if allEq (map divByGCD ls) then divisors (foldl1' (gcd) (map (foldl1' gcd) ls)) else 0

build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g = g (:) []

chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n  = l `c` splitter (drop i l) c n

solve :: [(Int64, Int64, Int64)] -> Int64
solve p =
  let n = length p
      sp = sort p
      m = length $ takeWhile (\x -> (fst' $ head sp) == (fst' x)) sp
      csp = chunksOf m sp
  in if (rem n m == 0) && (allEq $ map (map snd') csp) then solve' (map (map trd') csp) else 0

main :: IO ()
main = do dat <- C.getContents
          print $ solve $ readP $ tail $ f2lines dat


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

process a  = (min ao ae)
	where ae = length $ filter (even) a
	      ao = (length a)-ae

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

import Data.List (partition)

process :: [Int] -> Int
process xs = min (length es) (length os)
    where
        (es,os) = partition odd xs

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    xs <- fmap (map readInt.words) getLine
    print $ process xs

module Main where

toOnePoint :: [Int] -> Int -> Int
toOnePoint t point = sum (map (\x -> abs (point - x) `mod` 2) t)

main :: IO ()
main = do
  f <- getLine
  let n = read f :: Int
  list <- fmap (\i -> read i :: Int) . words <$> getLine
  print $ minimum (map (toOnePoint list) list)

(...) = (.).(.)
countIf = length...filter
solve = min <$> countIf even <*> countIf odd
main = print . solve . map read . words . last . lines =<< getContents

solve xs = min (length . filter even $ xs) (length . filter odd $ xs)

main = interact $ show . solve . map read . words . last . lines

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  xs <- map read . words <$> getLine :: IO [Int]
  print $ min (countOdd xs) (countEven xs)
  where
    countEven xs = length $ filter (\x -> mod x 2 == 0) xs
    countOdd xs = length (filter (\x -> mod x 2 == 1) xs)

getD::Int->Int->Int
getD m z=(max m z) - (min m z)

getOst::Int->Int->Int
getOst to p=mod (getD to p) 2

getOstL::Int->[Int]->Int
getOstL n lst=sum $ map (getOst n) lst

getMinL::[Int]->Int
getMinL lst=minimum $ map (flip getOstL lst) lst

main::IO()
main=do
   n <- getLine
   m <- getLine
   let lst = map read $ words m
   print $ getMinL lst
--ss

import Control.Monad ( void )

main = do
  void getLine
  arr <- fmap (fmap read . words) getLine
  let count = (length . ) . filter
      oddCount = count odd arr
      evenCount = count even arr
  print $ min evenCount oddCount

main = do
  n <- readLn
  arr <- fmap (fmap read . words) getLine
  let count = (length . ) . filter
      oddCount = count odd arr
      evenCount = n - oddCount
  print $ min evenCount oddCount

import Data.List (sort, partition)

process :: [Int] -> Int
process xs = d * min (length es) (length os)
    where
        (es,os) = partition odd xs
        xs' = sort xs
        ds = filter odd $ zipWith (-) (tail xs') xs'
        d = if null ds then 0 else minimum ds

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    xs <- fmap (map readInt.words) getLine
    print $ process xs

import Data.List (nub, partition)

process :: [Int] -> Int
process xs = minimum ds * min (length es) (length os)
    where
        (es,os) = partition odd xs
        xs' = nub xs
        ds = zipWith (-) (tail xs') xs'

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    xs <- fmap (map readInt.words) getLine
    print $ process xs

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  xs <- map read . words <$> getLine :: IO [Int]
  print $ max (countOdd xs) (countEven xs)
  where
    countEven xs = length $ filter (\x -> mod x 2 == 0) xs
    countOdd xs = length (filter (\x -> mod x 2 == 1) xs)


{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

import Data.List as L
import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

color _ _ _ _ _ [] = []
color k col e ecnt total (x:xs)
  | total == 0 = (fst x, 0) : color k 0 0 0 0 xs
  | e == snd x = if ecnt >= k then (fst x, 0) : color k col e ecnt total xs else
                   (fst x, col) : color k next_col e (ecnt+1) (total-1) xs
  | otherwise = (fst x, col) : color k next_col (snd x) 1 (total-1) xs
  where next_col = if col == k then 1 else col+1

solve :: IO ()
solve = do
  [n,k] <- readInts :: IO [Int]
  a <- readInts :: IO [Int]
  let b = sortBy (\x y -> compare (snd x) (snd y)) $ zip [0..] a
      grp = groupBy (\x y -> snd x == snd y) b
      tot = foldl (\acc xs -> acc + min (length xs) k) 0 grp
      total = tot - (rem tot k)
      res = map snd $ sortBy (\x y -> compare (fst x) (fst y)) $ color k 1 0 0 total b
   in putStrLn $ intercalate " " $ map show res

main = do
  t <- readLn :: IO Int
  replicateM_ t $ solve

----------------------------------------------------------------------------------------
readrows :: (Integral a, Integral b) => b -> IO [[a]]
readrows 0 = return []
readrows n = do
  row <- readInts
  l <- readrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs

{-# LANGUAGE TupleSections #-}
import Data.List (intercalate, sort, group, groupBy)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

type Color = Int
type Letter = Int
type AssignmentLC = Map Letter [Color]
type AssignmentCL = Map Color [Letter]
type Input = (Int, Int, [Int])
type Output = [Int]

type Queue a = ([a], [a])

queueToList :: Queue a -> [a]
queueToList (fstQ, sndQ) = fstQ ++ reverse sndQ

queueFromList :: [a] -> Queue a
queueFromList ls = (ls, [])

queueFix :: Queue a -> Queue a
queueFix (fstQ, sndQ) = if null fstQ then (reverse sndQ, []) else (fstQ, sndQ)

queuePush :: Queue a -> a -> Queue a
queuePush q0 x = (fst q1, x : snd q1) where
    q1 = queueFix q0

queuePop :: Queue a -> Queue a
queuePop q0 = (tail $ fst q1, snd q1) where
    q1 = queueFix q0

queueFront :: Queue a -> a
queueFront = head . fst . queueFix

queueSize :: Queue a -> Int
queueSize (fstQ, sndQ) = length fstQ + length sndQ

queueNull :: Queue a -> Bool
queueNull (fstQ, sndQ) = null fstQ && null sndQ

parseOut :: [Output] -> String
parseOut []     = ""
parseOut (o:os) = unwords (map show o) ++ "\n" ++ parseOut os

parseIn :: String -> [Input]
parseIn str = let
    inLines = tail $ lines str
    res [] = []
    res [x] = undefined
    res (nk:s:rest) = (n, k, l) : res rest where
        (n, k) = (read . (!!0) $ words nk, read . (!!1) $ words nk)
        l = map (read :: String -> Int) $ words s
    in res inLines

nTimes :: Int -> (a -> a) -> (a -> a)
nTimes 0 _ = id
nTimes n f = f . nTimes (n - 1) f

invert :: (Ord k, Ord b) => Map k [b] -> Map b [k]
invert mp = Map.fromList
          $ map (\l -> (fst $ head l, map snd l))
          $ groupBy (\x y -> fst x == fst y)
          $ sort
          $ Map.toList mp >>= (\(k, vs) -> map (, k) vs)

solve :: Input -> Output
solve (n, k, l) = res where
    freq = map (\g -> (head g, length g)) $ group $ sort l
    cl0 = Map.fromList
        $ queueToList
        $ foldr append initQueue freq where
            initQueue = queueFromList $ zip [1..k] (repeat [])
            append :: (Int, Int) -> Queue (Color, [Letter]) -> Queue (Color, [Letter])
            append (ch, frq) q = nTimes (min k frq) f q where
                f q = let (col, ls) = queueFront q
                          newAssign = (col, ch:ls)
                          in queuePop $ queuePush q newAssign

    assignLength = foldr (min . length) n cl0
    cl1 = Map.map (take assignLength) cl0
    lc = invert cl1

    res = snd $ foldr f (lc, []) l where
        f :: Letter -> (AssignmentLC, [Color]) -> (AssignmentLC, [Color])
        f ch (as, l) = case Map.lookup ch as of Nothing   -> (as, 0:l)
                                                Just []   -> (as, 0:l)
                                                Just cols -> (Map.adjust tail ch as, head cols : l)

main :: IO ()
main = interact $ parseOut . map solve . parseIn
--main = interact (intercalate "\n------\n" . map solve . parseIn)

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out)

-- (ghc -Werror -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  printf '%s\n' 1 '12 3' '3 1 1 1 1 10 3 10 10 2 8 7' | ./a.out)
-- 2 1 2 3 0 3 3 0 0 1 2 1

import Prelude
import Control.Monad
import Data.List
import Data.Function

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    [_n, k] <- getInts
    nums   <- getInts

    return (k, nums)

solve (k, xs) = intercalate " " . map show $ answer
  where
    grouped = groupOn fst . sort . (`zip` [1000::Int ..]) $ xs
    answer = solveColored k . solveUncolored k $ grouped

solveUncolored k gs = (map (addColor col0) . concat $ ts,
                        concat hs)
  where
    (hs, ts) = unzip . map (splitAt k) $ gs

solveColored k (ps, xs) = map getColor . sortOn getPos $ coloring
  where
    coloring = ps ++ map (addColor col0) ts ++ zipWith addColor cols hs

    wdt = length xs `div` k
    (hs, ts) = splitAt (k*wdt) xs
    cols = (concat.repeat) [col0+1..col0+k]

addColor c (v,i) = (v, i, c::Int)
getPos (_v, i, _c) = i
-- getVal (v, _i, _c) = v
getColor (_v, _i, c) = c

col0 = 0::Int

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

getInts = map read <$> words <$> getLine :: IO [Int]

groupOn f = groupBy ((==) `on` f)

import Control.Arrow ((>>>))
import Data.List (group, sort, groupBy, sortBy)
import Data.Ord (comparing)
import Data.Bifunctor (bimap)
import Debug.Trace (trace)

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> chunksOf 2
      >>> map (map words >>> concat >>> map read >>> solve >>> map show >>> unwords)
      >>> unlines

type Col = (Int, Maybe Int)

debug a = trace (show a) a

solve :: [Int] -> [Int]
solve (n : k : as) =
  map (maybe 0 ((1 +) . (`mod` k)) . snd)
    . sortOn fst
    . uncurry (++)
    . bimap (`zip` (Just <$> [1..])) (`zip` repeat Nothing)
    . (\(cs, ws) -> let (ws', cs') = splitAt (length cs `mod` k) cs in (cs', ws' ++ ws))
    . bimap' concat
    . unzip
    . map (splitAt k . map snd)
    . groupOn fst
    . sortOn fst
    $ as `zip` [0 ..]

-- Template
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

groupOn :: (Eq b) => (a -> b) -> [a] -> [[a]]
groupOn p = groupBy (\x y -> p x == p y)

sortOn :: (Ord b) => (a -> b) -> [a] -> [a]
sortOn = sortBy . comparing

bimap' f = bimap f f

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE BangPatterns #-}

import Control.Monad (forM_)
import qualified Data.Array.Unboxed as A
import Data.Foldable (foldl')
import Data.IntMap (IntMap)
import qualified Data.IntMap as M
import qualified Data.Text as T
import qualified Data.Text.IO as T

indexed :: [a] -> [(Int, a)]
indexed = zip [0 ..]

-- | Take a sequence of elements and convert into frequency mapping
collect :: [Int] -> IntMap [Int]
collect xs = foldl' ins_ M.empty $ indexed xs
  where
    ins_ m (i, n) = M.alter (Just . maybe [i] (i :)) n m

-- | Take off elements from a list so that length is multiple of k
shave :: Int -> [a] -> [a]
shave k xs = drop (l `mod` k) xs
  where
    l = length xs

-- | Perform coloring
coloring :: Int -> [Int] -> [Int]
coloring k xs = A.elems $ empty (length xs) A.// ind
  where
    m = collect xs
    (ltk, gtk) = M.partition (\v -> length v < k) m

    indLtk = zip (shave k $ concat $ M.elems ltk) (cycle [1 .. k])
    indGtk = (`zip` [1 .. k]) . take k =<< M.elems gtk
    ind = indLtk ++ indGtk

    empty :: Int -> A.UArray Int Int
    empty n = A.array (0, n - 1) (take n $ indexed $ repeat 0)

main :: IO ()
main = do
  testCases <- read <$> getLine
  forM_ [1 .. testCases] $ \_ -> do
    l1 <- T.getLine
    l2 <- T.getLine
    let [_, k] = read . T.unpack <$> T.splitOn " " l1
    let xs = read . T.unpack <$> T.splitOn " " l2
    putStrLn $ unwords $ show <$> coloring k xs

import Control.Monad (replicateM_)
import Data.List ((\\), foldl')
import qualified Data.Array.Unboxed as A
import qualified Data.IntMap as M

getIndices :: Int -> [Int] -> (M.IntMap [Int], [Int])
getIndices cap xs = (M.map snd withSizes, remaining) where
  insert (k, idx) (mp, remaining) = case M.lookup k mp of
    Just (size, idxs) -> if size + 1 <= cap
      then (M.insert k (size + 1, idx : idxs) mp, remaining)
      else (M.insert k (size, idxs) mp, idx : remaining)
    Nothing   -> (M.insert k (1, [idx]) mp, remaining)
  (withSizes, remaining) = foldr insert (M.empty, []) $ zip xs [1..]

solve :: (Int, Int) -> [Int] -> M.IntMap Int
solve (n, k) xs = M.fromList (ans ++ [(i, 0) | i <- remaining]) where
  (indexMap, remaining) = getIndices k xs
  indices = M.toList indexMap >>= snd
  l = n - length remaining
  nextColor color = if color + 1 <= k then color + 1 else 1
  next (color, coloring, remaining) idx = let c = nextColor color in
    if remaining > 0 then (c, (idx, c) : coloring, remaining - 1)
    else (0, (idx, 0) : coloring, remaining)
  (_, ans, _) = foldl' next (0, [], l - l `rem` k) indices

readInts :: IO [Int]
readInts = map read . words <$> getLine

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    [n, k] <- readInts
    ans <- map show . M.elems . solve (n, k) <$> readInts
    putStrLn $ unwords ans

import Control.Monad (replicateM_)
import Data.List ((\\), foldl')
import qualified Data.Array.Unboxed as A
import qualified Data.IntMap as M
import qualified Data.IntSet as S

type IntArray = A.UArray Int Int

getIndices :: Int -> [Int] -> M.IntMap [Int]
getIndices cap xs = M.map snd withSizes where
  insert (k, idx) mp = case M.lookup k mp of
    Just (size, idxs) -> if size + 1 <= cap
      then M.insert k (size + 1, idx : idxs) mp
      else M.insert k (size, idxs) mp
    Nothing   -> M.insert k (1, [idx]) mp
  withSizes = foldr insert M.empty $ zip xs [1..]

solve :: (Int, Int) -> [Int] -> IntArray
solve (n, k) xs = A.array (1,n) (ans ++ [(i, 0) | i <- missing]) where
  indices = M.toList (getIndices k xs) >>= snd
  indexSet = S.fromList indices
  l = S.size indexSet
  nextColor color = if color + 1 <= k then color + 1 else 1
  next (color, coloring, remaining) idx = let c = nextColor color in
    if remaining > 0 then (c, (idx, c) : coloring, remaining - 1)
    else (0, (idx, 0) : coloring, remaining)
  (_, ans, _) = S.foldl' next (0, [], l - l `rem` k) indexSet
  missing = S.toList $ S.difference (S.fromList [1..n]) indexSet

readInts :: IO [Int]
readInts = map read . words <$> getLine

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    [n, k] <- readInts
    ans <- map show . A.elems . solve (n, k) <$> readInts
    putStrLn $ unwords ans

{-# LANGUAGE TupleSections #-}
import Data.List (intercalate, sort, group, groupBy)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

type Color = Int
type Letter = Int
type AssignmentLC = Map Letter [Color]
type AssignmentCL = Map Color [Letter]
type Input = (Int, Int, [Int])
type Output = [Int]

type Queue a = ([a], [a])

queueToList :: Queue a -> [a]
queueToList (fstQ, sndQ) = fstQ ++ reverse sndQ

queueFromList :: [a] -> Queue a
queueFromList ls = (ls, [])

queueFix :: Queue a -> Queue a
queueFix (fstQ, sndQ) = if null fstQ then (reverse sndQ, []) else (fstQ, sndQ)

queuePush :: Queue a -> a -> Queue a
queuePush q0 x = (fst q1, x : snd q1) where
    q1 = queueFix q0

queuePop :: Queue a -> Queue a
queuePop q0 = (tail $ fst q1, snd q1) where
    q1 = queueFix q0

queueFront :: Queue a -> a
queueFront = head . fst . queueFix

queueSize :: Queue a -> Int
queueSize (fstQ, sndQ) = length fstQ + length sndQ

queueNull :: Queue a -> Bool
queueNull (fstQ, sndQ) = null fstQ && null sndQ

parseOut :: [Output] -> String
parseOut []     = ""
parseOut (o:os) = unwords (map show o) ++ "\n" ++ parseOut os

parseIn :: String -> [Input]
parseIn str = let
    inLines = tail $ lines str
    res [] = []
    res [x] = undefined
    res (nk:s:rest) = (n, k, l) : res rest where
        (n, k) = (read . (!!0) $ words nk, read . (!!1) $ words nk)
        l = map (read :: String -> Int) $ words s
    in res inLines

nTimes :: Int -> (a -> a) -> (a -> a)
nTimes 0 _ = id
nTimes n f = f . nTimes (n - 1) f

invert :: (Ord k, Ord b) => Map k [b] -> Map b [k]
invert mp = Map.fromList
          $ map (\l -> (fst $ head l, map snd l))
          $ groupBy (\x y -> fst x == fst y)
          $ sort
          $ Map.toList mp >>= (\(k, vs) -> map (, k) vs)

solve :: Input -> Output
solve (n, k, l) = res where
    freq = map (\g -> (head g, length g)) $ group $ sort l
    cl = Map.fromList
       $ queueToList
       $ foldr append initQueue freq where
        initQueue = queueFromList $ zip [1..k] (repeat [])
        append :: (Int, Int) -> Queue (Color, [Letter]) -> Queue (Color, [Letter])
        append (ch, frq) q = nTimes (min k frq) f q where
            f q = let (col, ls) = queueFront q
                      newAssign = (col, ch:ls)
                      in queuePop $ queuePush q newAssign

    lc0 = invert cl
    assignLength = foldr (min . length) n lc0
    lc1 = Map.map (take assignLength) lc0

    res = snd $ foldr f (lc1, []) l where
        f :: Letter -> (AssignmentLC, [Color]) -> (AssignmentLC, [Color])
        f ch (as, l) = case Map.lookup ch as of Nothing   -> (as, 0:l)
                                                Just []   -> (as, 0:l)
                                                Just cols -> (Map.adjust tail ch as, head cols : l)

main :: IO ()
main = interact $ parseOut . map solve . parseIn
--main = interact (intercalate "\n------\n" . map solve . parseIn)

import Data.List (intersperse, intercalate, sort, group)

parseOut :: [Int] -> String
parseOut = intercalate "\n" . map show

parseIn :: String -> [String]
parseIn = tail . words

solve :: String -> Int
solve str = gtOne + div one 2 where
    frequencies = map length $ group $ sort str
    gtOne = length $ filter (>1) frequencies
    one = length $ filter (==1) frequencies

main :: IO ()
main = interact $ parseOut . map solve . parseIn

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > tmp.txt  &&  diff -sdu -- output.txt tmp.txt  &&  cat -- tmp.txt)

import Prelude
import Control.Monad
import Data.List
import Data.Function

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    [_n, k] <- getInts
    nums   <- getInts

    return (k, nums)

getInts = map read <$> words <$> getLine :: IO [Int]

-- solve (k, xs) = show (k, xs, sortGroupOn snd $ indexed, intercalate " " . map show $ answer)
solve (k, xs) = intercalate " " . map show $ answer
  where
    indexed = zip [0..] xs :: [(Int,Int)]

    grouped = fixGroups . sortGroupOn snd $ indexed

    colored = concat . map (addColor k) $ grouped

    getPos ((p,_x), _i) = p

    answer = map snd . sortOn getPos $ colored

fixGroups gs = filter (not.allowJoin) gs ++ [(concat . filter allowJoin) gs]
  where
    allowJoin g = length g == 1

addColor k pairs | (length pairs >= k) = zip pairs ([1..k] ++ [0,0..])
                 | otherwise           = zip pairs [0,0..]

sortGroupOn f = groupBy ((==) `on` f) . sortOn f

import Control.Arrow ((>>>))
import Data.List (group, sort, groupBy, sortBy)
import Data.Ord (comparing)

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> chunksOf 2
      >>> map (map words >>> concat >>> map read >>> solve >>> map show >>> unwords)
      >>> unlines

type Col = (Int, Maybe Int)

solve :: [Int] -> [Int]
solve (n : k : as) =
  map (maybe 0 ((1 +) . (`mod` k)) . snd)
    . sortOn fst
    . concatMap fst
    . scanr (color . map snd) ([], 0)
    . groupOn fst
    . sortOn fst
    $ as `zip` [0 ..]
  where
    color :: [Int] -> ([Col], Int) -> ([Col], Int)
    color ixs (_, c) =
      let (cixs, wixs) = splitAt k ixs
       in (zip cixs (Just <$> [c ..]) ++ zip wixs (repeat Nothing), c + length cixs)

-- Template
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

groupOn :: (Eq b) => (a -> b) -> [a] -> [[a]]
groupOn p = groupBy (\x y -> p x == p y)

sortOn :: (Ord b) => (a -> b) -> [a] -> [a]
sortOn = sortBy . comparing

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

import Data.List as L
import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

color _ _ _ _ _ [] = []
color k col e ecnt total (x:xs)
  | total == 0 = (fst x, 0) : color k 0 0 0 0 xs
  | e == snd x = if ecnt >= k then (fst x, 0) : color k col e ecnt total xs else
                   (fst x, col) : color k next_col e (ecnt+1) (total-1) xs
  | otherwise = (fst x, col) : color k next_col (snd x) 1 (total-1) xs
  where next_col = if col == k then 1 else col+1

solve :: IO ()
solve = do
  [n,k] <- readInts :: IO [Int]
  a <- readInts :: IO [Int]
  let b = sortBy (\x y -> compare (snd x) (snd y)) $ zip [0..] a
      grp = groupBy (\x y -> snd x == snd y) b
      total = foldl (\acc xs -> acc + min (length xs) k) 0 grp
      res = map snd $ sortBy (\x y -> compare (fst x) (fst y)) $ color k 1 0 0 total b
   in putStrLn $ intercalate " " $ map show res

main = do
  t <- readLn :: IO Int
  replicateM_ t $ solve

----------------------------------------------------------------------------------------
readrows :: (Integral a, Integral b) => b -> IO [[a]]
readrows 0 = return []
readrows n = do
  row <- readInts
  l <- readrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs