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

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
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))

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

{- aux -}
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

{- solution -}

type SolutionState = (IM.IntMap (Int, Int64))

mergeX :: (Int, Int64) -> (Int, Int64) -> (Int, Int64)
mergeX (cnt1, s1) (cnt2, s2) = (cnt1 + cnt2, s1 + s2)

preSolve :: Int -> [Int] -> SolutionState
preSolve n as = L.foldr (\x mp -> IM.insertWith mergeX (x `mod` 2) (1, fromIntegral x) mp) emptyState as
    where
        emptyState :: SolutionState
        emptyState = IM.fromList [(0, (0, 0)), (1, (0, 0))]

query :: (Monad m) => Int -> Int -> MS.StateT SolutionState m Int64
query mod2 x = do
    (cnt, s) <- MS.gets (IM.! mod2)

    let newMod2 = (mod2 + x) `mod` 2
    MS.modify (IM.insertWith mergeX mod2 (-cnt, -s))
    MS.modify (IM.insertWith mergeX newMod2 (cnt, s))
    MS.modify (IM.insertWith mergeX newMod2 (0, fromIntegral $ x * cnt))

    tracingM "mod2" mod2
    tracingM "x" x

    (_, s0) <- MS.gets (IM.! 0)
    (_, s1) <- MS.gets (IM.! 1)
    return $ s0 + s1

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, q] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        let state = preSolve n as
        flip MS.evalStateT state . M.replicateM_ q $ do
            [mod2, x] <- MT.lift $ B8.getLine <&> readIntB8s
            tracingM "mod2" mod2
            tracingM "x" x
            answer <- query mod2 x
            MT.lift $ printf "%lld\n" answer

{-# LANGUAGE RecordWildCards #-}
module Main where

import Control.Monad (replicateM, replicateM_)
import Data.List (intercalate)

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B

data Values = Values
  { valuesSum :: Int
  , numberEven :: Int
  , numberOdd :: Int
  }

data Query = Query
  { onEven :: Bool
  , summand :: Int
  }

toValues vs = Values
  { valuesSum = sum vs
  , numberEven = length $ filter even vs
  , numberOdd = length $ filter odd vs
  }

processQuery :: Values -> Query -> Values
processQuery Values{..} Query{..}
  | onEven      = Values{ valuesSum = valuesSum + summand * numberEven
                        , numberEven = if even summand then numberEven else 0
                        , numberOdd = if even summand then numberOdd else numberEven + numberOdd
                        }
  | otherwise   = Values{ valuesSum = valuesSum + summand * numberOdd
                        , numberEven = if even summand then numberEven else numberEven + numberOdd
                        , numberOdd = if even summand then numberOdd else 0
                        }

processQueries :: Values -> [Query] -> [Values]
processQueries vs qs = drop 1 $ scanl processQuery vs qs

parseQuery :: IO Query
parseQuery = do
  [e, s] <- map parseInt . B.words <$> B.getLine
  pure $ Query (e == 0) s

handleProblem :: IO ()
handleProblem = do
  [n, q] <- map parseInt . B.words <$> B.getLine
  vs <- toValues . map parseInt . B.words <$> B.getLine
  qs <- replicateM q parseQuery
  putStrLn $ intercalate "\n" $ map (show . valuesSum) $ processQueries vs qs

main :: IO ()
main = do
  numberProblems <- read <$> getLine
  replicateM_ numberProblems handleProblem

parseInt :: B.ByteString -> Int
parseInt = maybe 0 fst . B.readInt


module Main where

import Control.Monad
import Control.Monad.State
import Data.List (group, sort)
import Data.Maybe (fromJust)
import Debug.Trace (trace)
import Data.Word (Word64)
import Text.Printf (printf)
import qualified Data.ByteString.Lazy.Char8 as L

modulo, moduloM1 :: Word64
modulo = 1000000000 + 7
moduloM1 = modulo - 1

getLambda :: [Word64] -> [(Int, Word64)]
getLambda = map toPair . group . sort
    where toPair ps = (length ps, head ps)

prefixModulo, suffixModulo :: [(Int, Word64)] -> [Word64]
prefixModulo = scanl update 1
    where update pl (pr, _) = (pl * (fromIntegral $ pr + 1)) `mod` moduloM1
suffixModulo = scanr update 1
    where update (pl, _) pr = ((fromIntegral $ pl + 1) * pr) `mod` moduloM1

modPow, modMul :: Word64 -> Word64 -> Word64
modPow a 0 = 1
modPow a n | even n    = c
           | otherwise = a `modMul` c
           where b = a `modPow` (n `div` 2)
                 c = b `modMul` b
modMul a b = (a * b) `mod` modulo

solve :: [Word64] -> Word64
solve ps = foldr modMul 1 $ zipWith3 calc ls pm sm
    where ls = getLambda ps
          pm = prefixModulo ls
          sm = tail $ suffixModulo ls

          calc :: (Int, Word64) -> Word64 -> Word64 -> Word64
          calc (l, p) pref suff = foldr modMul 1 powers
              where s = (pref * suff) `mod` moduloM1
                    m = modPow p s
                    powers = take (l + 1) $ iterate (`modMul` m) 1

type Tokenizer = State [Int]

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

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> (s, ss)

nextWord64 :: Tokenizer Word64
nextWord64 = state $ \(s:ss) -> (fromIntegral s, ss)

go :: Tokenizer Word64
go = do
  n <-  nextInt
  ps <- replicateM n nextWord64
  return $ solve ps

main :: IO ()
main = do
  input <- liftM (map parseInt . L.words) L.getContents
  print $ evalState go input

module Main where

import Control.Monad
import Control.Monad.State
import Data.List (group, sort)
import Data.Maybe (fromJust)
import Debug.Trace (trace)
import Text.Printf (printf)
import qualified Data.ByteString.Lazy.Char8 as L

modulo, moduloM1 :: Integer
modulo = 1000000000 + 7
moduloM1 = modulo - 1

getLambda :: [Integer] -> [(Int, Integer)]
getLambda = map toPair . group . sort
    where toPair ps = (length ps, head ps)

prefixModulo, suffixModulo :: [(Int, Integer)] -> [Integer]
prefixModulo = scanl update 1
    where update pl (pr, _) = (pl * (fromIntegral $ pr + 1)) `mod` moduloM1
suffixModulo = scanr update 1
    where update (pl, _) pr = ((fromIntegral $ pl + 1) * pr) `mod` moduloM1

modPow, modMul :: Integer -> Integer -> Integer
modPow a 0 = 1
modPow a n | even n    = c
           | otherwise = a `modMul` c
           where b = a `modPow` (n `div` 2)
                 c = b `modMul` b
modMul a b = (a * b) `mod` modulo

solve :: [Integer] -> Integer
solve ps = foldr modMul 1 $ zipWith3 calc ls pm sm
    where ls = getLambda ps
          pm = prefixModulo ls
          sm = tail $ suffixModulo ls

          calc :: (Int, Integer) -> Integer -> Integer -> Integer
          calc (l, p) pref suff = foldr modMul 1 powers
              where s = (pref * suff) `mod` moduloM1
                    m = modPow p s
                    powers = take (l + 1) $ iterate (`modMul` m) 1

type Tokenizer = State [Int]

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

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> (s, ss)

nextInteger :: Tokenizer Integer
nextInteger = state $ \(s:ss) -> (fromIntegral s, ss)

go :: Tokenizer Integer
go = do
  n <-  nextInt
  ps <- replicateM n nextInteger
  return $ solve ps

main :: IO ()
main = do
  input <- liftM (map parseInt . L.words) L.getContents
  print $ evalState go input

module Main where

import Control.Monad
import Control.Monad.State
import Data.List (group, sort)
import Data.Maybe (fromJust)
import Debug.Trace (trace)
import Text.Printf (printf)
import qualified Data.ByteString.Lazy.Char8 as L

modulo, moduloM1 :: Int
modulo = 1000000000 + 7
moduloM1 = modulo - 1

getLambda :: [Int] -> [(Int, Int)]
getLambda = map toPair . group . sort
    where toPair ps = (length ps, head ps)

prefixModulo, suffixModulo :: [(Int, Int)] -> [Int]
prefixModulo = scanl update 1
    where update pl (pr, _) = (pl * (pr + 1)) `mod` moduloM1
suffixModulo = scanr update 1
    where update (pl, _) pr = ((pl + 1) * pr) `mod` moduloM1

modPow, modMul :: Int -> Int -> Int
modPow a 0 = 1
modPow a n | even n    = c
           | otherwise = a `modMul` c
           where b = a `modPow` (n `div` 2)
                 c = b `modMul` b
modMul a b = (a * b) `mod` modulo

solve :: [Int] -> Int
solve ps = foldr modMul 1 $ zipWith3 calc ls pm sm
    where ls = getLambda ps
          pm = prefixModulo ls
          sm = tail $ suffixModulo ls

          calc :: (Int, Int) -> Int -> Int -> Int
          calc (l, p) pref suff = foldr modMul 1 powers
              where s = (pref * suff) `mod` moduloM1
                    m = modPow p s
                    powers = take (l + 1) $ iterate (`modMul` m) 1

type Tokenizer = State [Int]

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

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> (s, ss)

go :: Tokenizer Int
go = do
  n <-  nextInt
  ps <- replicateM n nextInt
  return $ solve ps

main :: IO ()
main = do
  input <- liftM (map parseInt . L.words) L.getContents
  print $ evalState go input


import Array
import Data.Set
import Monad (liftM)
import Prelude hiding (filter)

parseFirstLine :: String -> (Int, Int, Char)
parseFirstLine line  =  case words line of
    [w1, w2, w3]  ->  (read w1, read w2, head w3)

parsePlane :: (Int, Int) -> [String] -> Array (Int, Int) Char
parsePlane (n, m) lines  =  accumArray (flip const) '.' ((0, 0), (n+1, m+1))
    [((i,j), lines !! (i-1) !! (j-1)) | i <- [1..n], j <- [1..m]]

solve :: (Int, Int) -> Char -> Array (Int, Int) Char -> Int
solve (n, m) c array  =  size . fromList $ list
  where
    list  =  [array ! (i, j) | i <- [1..n], j <- [1..m],
        array ! (i,j) /= '.',
        array ! (i,j) /= c,
        any (\(di, dj) -> array ! (i+di,j+dj) == c) [(0,1),(1,0),(0,-1),(-1,0)]]

main :: IO ()
main  =  do
    (n, m, c)  <-  liftM parseFirstLine getLine
    plane  <-  liftM (parsePlane (n, m) . take n . lines) getContents
    print $ solve (n, m) c plane

import Data.Char
import Data.List
import Data.Array.Unboxed
main = do
    [n', m', l'] <- words `fmap` getLine
    let color = head l'
        [n, m] = map read [n', m']
    строки <- mapM (\_ -> (\s' -> let s = take m s' in (any (==color) s, s))
                `fmap` getLine) [1..n]
    let строкиБосса = map fst $ filter snd $ zip [1..] $ map fst строки
        матр = listArray ((1,1),(n, m)) $ concat $ map snd строки :: UArray (Int, Int) Char
        (минХ, максХ) = (minimum строкиБосса, maximum строкиБосса)
        (минУ, максУ) = (minimum a, maximum a) where
            a = filter (\i->(==color) $ (матр!(минХ, i))) [1..m]
        allx = [минХ..максХ]
        ally = [минУ..максУ]
        all = (if минХ > 1  then [(минХ  - 1, i) | i <- ally] else []) ++
              (if максХ < n then [(максХ + 1, i) | i <- ally] else []) ++
              (if минУ > 1  then [(i, минУ  - 1) | i <- allx] else []) ++
              (if максУ < m then [(i, максУ + 1) | i <- allx] else [])
        границы = map (матр!) all
    putStrLn $ show $ length $ nub $ filter isUpper границы

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

count :: Array (Int, Int) Char -> Char -> String
count a c = show . length . group . sort $ do
      let b = bounds a
      (x, y) <- range b
      guard $ a ! (x, y) == c
      idx' <- [(x+1, y), (x-1, y), (x, y-1), (x, y+1)]
      guard $ inRange b idx'
      let c' = a ! idx'
      guard $ c' /= '.' && c' /= c
      return c'

solve :: [String] -> [String]
solve = fmap return $ do
      [nn, mm, cc] <- words . head
      let n = read nn; m = read mm; c = head cc
      xs <- concat . take n . tail
      let a = listArray ((1,1), (n,m)) xs
      return $ count a c

main = interact $ unlines . solve . lines

module Main where

import Data.Array.IArray (listArray, (!), bounds, indices)
import Data.Array.Unboxed (UArray)
import Data.List (sort, group)
import Data.Ix (inRange)
import Control.Monad (replicateM)

type Grid = UArray (Int, Int) Char

solve :: Grid -> Char -> Int
solve gr c = count . filter isViceTable $ concatMap around tablePos
  where
    tablePos = filter (\i -> gr ! i == c) (indices gr)
    isViceTable cc = cc /= c && cc /= '.'
    count = length . group . sort
    around (x, y) = map (gr !) $ filter (inRange $ bounds gr) [ (x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1) ]

getGrid :: (Int, Int) -> IO Grid
getGrid (n, m) = do
  lines <- replicateM n getLine
  pure $ listArray ((1,1), (n, m)) (concat lines)

main :: IO ()
main = do
  [n, m, c] <- words <$> getLine
  grid <- getGrid (read n, read m)
  print $ solve grid (head c)

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

count :: Array (Int, Int) Char -> Char -> String
count a c = show . length . group . sort $ do
  let b = bounds a
  idx@(y, x) <- range b
  guard $ a ! idx == c
  idx' <- [(y + 1, x), (y - 1,x), (y, x + 1), (y, x - 1)]
  guard $ b `inRange` idx'
  let c' = a ! idx'
  guard $ c' /= '.'
  guard $ c' /= c
  return c'

solve :: [String] -> [String]
solve = fmap return $ do
  [as, bs, cs] <- words . head
  let n = read as ; m = read bs ; c = head cs
  xs <- concat . take n . drop 1
  let a = listArray ((1, 1), (n, m)) xs
  return $ count a c

main = interact $ unlines . solve . lines

module Main where

import Control.Monad
import Data.Array.Unboxed
import Data.Ix
import Data.List
import qualified Data.Set as Set

main = do
    (n, m, ch) <- do
        [n, m, ch] <- words `liftM` getLine
        return (read n, read m, head ch)

    board <- ( listArray ((1,1), (n,m)) . join ) `liftM` replicateM n getLine :: IO (UArray (Int,Int) Char)

    let set = foldl' (\set (r,c) ->
                foldl' (\set (r1,c1,r2,c2) ->
                        let put r1 c1 r2 c2 set =
                                if board ! (r1,c1) == ch
                                    then Set.insert ( board ! (r2,c2) ) set
                                    else set
                        in if valid r1 c1 && valid r2 c2
                            then put r1 c1 r2 c2 $ put r2 c2 r1 c1 set
                            else set
                    ) set [(r,c,r,c+1),(r,c,r+1,c)]
            ) Set.empty $ range ((1,1),(n,m))
        set' = Set.delete '.' $ Set.delete ch set
        valid r c = 1 <= r && r <= n && 1 <= c && c <= m

    --putStrLn $ show board
    --putStrLn $ show set
    putStrLn $ show $ Set.size set'

import Data.Array
import Data.List
import Data.Functor
import Control.Monad

type Room = Array (Int, Int) Color
type Color = Char

countDepties :: Color -> Room -> Int -> Int -> Int
countDepties c room mx my = length $ adjacentTo c room mx my

adjacentTo :: Color -> Room -> Int -> Int -> [Color]
adjacentTo c m mx my = nub $ concatMap f [(x, y) | x <- [0..mx], y <- [0..my]]
  where
    f (x, y) | m ! (x, y) /= c = []
             | otherwise = filter (\d -> d /='.' && d /= c) $ map (m !) $
                up ++ down ++ left ++ right
      where
        up = if y > 0 then [(x, y - 1)] else []
        down = if y < my then [(x, y + 1)] else []
        left = if x > 0 then [(x - 1, y)] else []
        right = if x < mx then [(x + 1, y)] else []

main = do
    n':m':c':_ <- words <$> getLine
    let n = read n' - 1
        m = read m' - 1
        c = head c'
    is <- fmap concat $ forM [0..n] $ \y -> do
            s <- getLine :: IO [Char]
            return $ zip [(x, y) | x <- [0..m]] s
    let arr = array ((0, 0), (m, n)) is
    print $ countDepties c arr m n

import Data.Set (Set, (\\))
import qualified Data.Set as Set
import Control.Monad
import Data.Array.IArray

neighbors ::  Array (Int, Int) Char -> (Int, Int) -> [(Int, Int)]
neighbors arr (r, c) = let try = [(r+1, c), (r-1, c), (r, c+1), (r, c-1)] in
  filter (inRange $ bounds arr) try

solve :: Array (Int, Int) Char -> Char -> Int
solve arr boss = Set.size . (\\ Set.fromList ['.', boss]) . Set.fromList . map (arr!) . concatMap (neighbors arr) . filter ((== boss) . (arr !)) . range $ bounds arr

main = do
  [r, _, color] <- words <$> getLine
  let numRows = read r
  grid <- replicateM numRows getLine
  let arr = listArray ((0, 0), (pred numRows, pred . length $ head grid)) $ join grid

  print $ solve arr (head color)
  return ()

module Main where

import Control.Monad
import Data.Array.Unboxed
import Data.Ix
import Data.List
import qualified Data.Set as Set

main = do
    (n, m, ch) <- do
        [n, m, ch] <- words `liftM` getLine
        return (read n, read m, head ch)

    board <- ( listArray ((1,1), (n,m)) . join ) `liftM` replicateM n getLine :: IO (UArray (Int,Int) Char)

    let set = foldl' (\set (r,c) ->
                foldl' (\set (r1,c1,r2,c2) ->
                        let put r1 c1 r2 c2 set =
                                if board ! (r1,c1) == ch
                                    then Set.insert ( board ! (r2,c2) ) set
                                    else set
                        in put r1 c1 r2 c2 $ put r2 c2 r1 c1 set
                    ) set [(r-1,c-1,r-1,c)
                    ,(r-1,c,r,c)
                    ,(r,c,r,c-1)
                    ,(r,c-1,r-1,c-1)
                    ]
            ) Set.empty $ range ((2,2),(n,m))
        set' = Set.delete '.' $ Set.delete ch set

    --putStrLn $ show board
    --putStrLn $ show set
    putStrLn $ show $ Set.size set'

import Data.Char
import Data.List
import Data.Array.Unboxed
main = do
    [n', m', l'] <- words `fmap` getLine
    let color = head l'
        [n, m] = map read [n', m']
    строки <- mapM (\_ -> (\s' -> let s = take m s' in (any (==color) s, s))
                `fmap` getLine) [1..n]
    let строкиБосса = map fst $ filter snd $ zip [1..] $ map fst строки
        матр = listArray ((1,1),(n, m)) $ concat $ map snd строки :: UArray (Int, Int) Char
        (минХ, максХ) = (minimum строкиБосса, maximum строкиБосса)
        (минУ, максУ) = (minimum a, maximum a) where
            a = filter (\i->(==color) $ (матр!(минХ, i))) [1..m]
        allx = [минХ..максХ]
        ally = [минУ..максУ]
        all = (if минХ > 1  then [(минХ  - 1, i) | i <- ally] else []) ++
              (if максХ < n then [(максХ + 1, i) | i <- ally] else []) ++
              (if минУ < 1  then [(i, минУ  - 1) | i <- allx] else []) ++
              (if максУ < m then [(i, максУ + 1) | i <- allx] else [])
        границы = map (матр!) all
    putStrLn $ show $ length $ nub $ filter isUpper границы

module Main where

import Data.Array.IArray (listArray, (!), bounds, indices)
import Data.Array.Unboxed (UArray)
import Data.List (sort, group)
import Data.Ix (inRange)

type Grid = UArray (Int, Int) Char

solve :: Grid -> Char -> Int
solve gr c = count . filter isViceTable $ concatMap around tablePos
  where
    tablePos = filter (\i -> gr ! i == c) (indices gr)
    isViceTable cc = cc /= c && cc /= '.'
    count = length . group . sort
    around (x, y) = map (gr !) $ filter (inRange $ bounds gr) [ (x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1) ]

main :: IO ()
main = do
  [n, m, c] <- words <$> getLine
  grid <- listArray ((1, 1), (read n, read m)) <$> getContents :: IO Grid
  print $ solve grid (head c)


--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import qualified Data.Array.Unboxed as UA

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

solve :: [Int] -> Builder
solve (n:a) = intDec (C.length ans) <> char7 '\n' <>  byteString ans <> char7 '\n'
  where
    b = take n a
    x = UA.listArray (1, n) b :: UA.UArray Int Int
    loop i j last r
      | i > j = r
      | null l = r
      | d == 'L' = loop (succ i) j v (d:r)
      | d == 'R' = loop i (pred j) v (d:r)
      where
        xi = x UA.! i
        xj = x UA.! j
        l = filter ( (last <  ) . fst) [(xi, 'L'), (xj, 'R')]
        (v, d) = minimum l
    ans = C.reverse $ C.pack $ loop 1 n minBound []

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents

import qualified Data.Sequence as S
import Data.Maybe
import Data.Monoid

sHead :: S.Seq a -> Maybe a
sHead s =case S.viewl s of
	((S.:<) n _) -> Just n
	_-> Nothing

sLast :: S.Seq a -> Maybe a
sLast s =case S.viewr s of
	((S.:>) _ n ) -> Just n
	_-> Nothing

sTail :: S.Seq a -> S.Seq a
sTail s = case S.viewl s of
	((S.:<) _ n) -> n
	_ -> S.empty

sInit :: S.Seq a -> S.Seq a
sInit s = case S.viewr s of
	((S.:>) n _) -> n
	_ -> S.empty

sHeadUnsafe :: S.Seq a ->  a
sHeadUnsafe s = fromMaybe undefined $ sHead s

sLastUnsafe :: S.Seq a ->  a
sLastUnsafe s = fromMaybe undefined $ sLast s

type Status a = (a,[Char])
type Situation a = (Status a,S.Seq a)

step :: Ord a => Situation a -> Either ([Char]) (Situation a)
step ((curr,directions),S.Empty) = Left directions
step ((curr,directions),seq)
	|curr < seqHead && curr < seqLast =
	if seqHead <= seqLast
	then
		l
	else
		r
	|curr < seqHead = l
	|curr < seqLast = r
	|otherwise = Left directions
	where
		seqHead= sHeadUnsafe seq
		seqLast= sLastUnsafe seq
		l = Right ((seqHead, ('L': directions)), sTail seq)
		r = Right ((seqLast, ('R':directions) ), sInit seq)

steps ::Ord a => Situation a -> [Char]
steps sit =
	case step sit of
		Left dl -> reverse dl
		Right s -> steps s

main = do
	n <- getLine
	l <- fmap ((map read).words) getLine
	let sol = steps $ ((0,""),S.fromList l)
	putStrLn $ show $ length sol
	putStrLn sol

import Data.Sequence as S
import Data.Maybe
sHead :: Seq a -> Maybe a
sHead s =case viewl s of
	(n :< _) -> Just n
	_-> Nothing

sLast :: Seq a -> Maybe a
sLast s =case viewr s of
	(_ :> n) -> Just n
	_-> Nothing

sTail :: Seq a -> Seq a
sTail s = case viewl s of
	(_ :< n) -> n
	_ -> empty

sInit :: Seq a -> Seq a
sInit s = case viewr s of
	(n :> _) -> n
	_ -> empty

sHeadUnsafe :: Seq a ->  a
sHeadUnsafe s = fromMaybe undefined $ sHead s

sLastUnsafe :: Seq a ->  a
sLastUnsafe s = fromMaybe undefined $ sLast s

type Status a = (a,[Char])
type Situation a = (Status a,Seq a)

step :: Ord a => Situation a -> Either [Char] (Situation a)
step ((curr,directions),Empty) = Left directions
step ((curr,directions),seq)
	|curr < seqHead && curr < seqLast =
	if seqHead <= seqLast
	then
		Right ((seqHead, directions ++ "L" ), sTail seq)
	else
		Right ((seqLast, directions ++ "R" ), sInit seq)
	|curr < seqHead = Right ((seqHead, directions ++ "L" ), sTail seq)
	|curr < seqLast = Right ((seqLast, directions ++ "R" ), sInit seq)
	|otherwise = Left directions
	where
		seqHead= sHeadUnsafe seq
		seqLast= sLastUnsafe seq

steps ::Ord a => Situation a -> [Char]
steps sit =
	case step sit of
		Left l -> l
		Right s -> steps s

main = do
	n <- getLine
	l <- fmap ((map read).words) getLine
	putStrLn $ steps $ ((0,""),S.fromList l)


import Control.Monad
import Data.Int

step :: [(Int64, Int64)] -> [Int64] -> [(Int64, Int64)]
step ps ws = let
  rs = do
    ((pL, pR), w) <- zip ps ws
    let
      npL = w * pL
      npR = w * pR
    pure (min npL npR, max npL npR)
  rangeUnion (p, q) (x, y) = (min p x, max q y)
  in  tail $ scanl rangeUnion (maxBound, minBound) rs

solve :: [Int64] -> Int -> Int64
solve _ 0 = 1
solve a k = go (repeat (1, 1)) a k  where
  go sc _ 0 = snd $ last sc
  go sc at kr = go (step sc at) (tail at) (kr - 1)

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    a <- map read . words <$> getLine
    print $ solve a 5

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Control.Applicative
import Data.Int
import Data.Maybe
import Data.List
import Data.Functor
import Data.Bool
import Data.Array.Unboxed as UA
import qualified Data.ByteString.Char8 as B8
import Text.Printf

-- import Debug.Trace

-- debug = flip trace

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

readInt64B8 :: B8.ByteString -> Int64
readInt64B8 = fromIntegral . fst . fromJust . B8.readInteger

cases :: [(Int, Int, String)]
cases = [
    (0, 5, "max"),
    (1, 4, "min"),
    (2, 3, "max"),
    (3, 2, "min"),
    (4, 1, "max"),
    (5, 0, "min")]

solve :: Int -> [Int64] -> Int64
solve n as = foldr1 max $ solvedCases
--        `debug` (show solvedCases)
    where
        solvedCases = catMaybes $ map solveCase cases

        positiveAs = sort $ filter (> 0) as
        negativeAs = reverse . sort $ filter (< 0) as
        zeros = filter (== 0) as

        solveCase (minCnt, maxCnt, ordString)
            | ((length negativeAs < minCnt) || (length positiveAs < maxCnt)) && (length zeros > 0) = Just 0
            | (length negativeAs < minCnt) || (length positiveAs < maxCnt) = Nothing
            | ordString == "max" = Just . foldr1 (*) $ ((take minCnt $ reverse negativeAs) ++ (take maxCnt $ reverse positiveAs))
            | ordString == "min" = Just . foldr1 (*) $ ((take minCnt negativeAs) ++ (take maxCnt positiveAs))
            | otherwise = Nothing

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> B8.words <&> map readInt64B8
        let answer = solve n as
        printf "%s\n" $ show answer

import Control.Monad
import Data.Maybe
import Data.List
import Text.Printf
import qualified Data.ByteString.Char8 as C

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

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . C.readInteger) . C.words <$> C.getLine

main :: IO ()
main = do
  [caseNum] <- getInts
  forM_ [1..caseNum] $ \_ -> do
    _ <- getInts
    as <- getIntegers
    let nz = length $ filter (==0) as
        (ps', ns') = partition (>0) $ filter (/=0) as
        [ps, ns] = [reverse $ sort ps', sort ns']
        [lp, ln] = map length [ps, ns]
        f1 = if lp + ln < 5 then 0 else f2
        f2 = if lp == 0 || lp + ln == 5 && even lp then (if nz > 0 then 0 else product $ take 5 $ reverse $ sort $ map negate ps ++ ns) else f3
        f3 = maximum $ map (\xs -> if length xs < 5 then 0 else product xs) [take 5 ps, take 3 ps ++ take 2 ns, head ps : take 4 ns]
    printf "%d\n" f1


{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

main :: IO ()
main = do
    line <- getLine >> getLine
    let nums :: [Int] = sortBy (flip compare) . map read . words $ line
    putStrLn . unwords . map show . S.toDescList . solve . S.fromDescList $ nums

-- possibilities :: Int -> [Int]
-- possibilities = possibilities' []

-- possibilities' :: [Int] -> Int-> [Int]
-- possibilities' acc n | n == 1    = reverse acc
--                      | even n    = possibilities' (n `div` 2 : acc) (n `div` 2)
--                      | otherwise = possibilities' ((n-1) `div` 2 : acc) ((n-1) `div` 2)
possibilities :: Int -> [Int]
possibilities n | n == 1    = [1]
                | even n    = n : possibilities (n     `div` 2)
                | otherwise = n : possibilities ((n-1) `div` 2)

reduce :: S.Set Int -> Maybe (S.Set Int)
-- reduce xs = case maxNonMember of
--     Nothing -> Nothing
--     Just e -> Just $ S.insert e $ S.delete maxElem xs
reduce xs = maxNonMember >>= (\e -> Just . S.insert e $ S.delete maxElem xs)
    where
        maxElem = S.findMax xs
        maxNonMember = find (`S.notMember` xs) $ possibilities maxElem

solve :: S.Set Int -> S.Set Int
solve xs = case reduce xs of
    Nothing -> xs
    Just ys -> solve ys

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

main :: IO ()
main = do
    line2 <- getLine >> getLine
    let nums :: [Int] = sortBy (flip compare) $ map read $ words line2
    putStrLn $ unwords $ map show $ S.toDescList $ solve $ S.fromDescList nums

possibilities :: Int -> [Int]
possibilities = possibilities' []

possibilities' :: [Int] -> Int-> [Int]
possibilities' acc n | n == 1    = reverse acc
                     | even n    = possibilities' (n `div` 2 : acc) (n `div` 2)
                     | otherwise = possibilities' ((n-1) `div` 2 : acc) ((n-1) `div` 2)

reduce :: S.Set Int -> Maybe (S.Set Int)
reduce xs = case maxNonMember of
    Nothing -> Nothing
    Just e -> Just $ S.insert e $ S.delete maxElem xs
    where
        maxElem = S.findMax xs
        maxNonMember = find (\x -> x `S.notMember` xs) $ possibilities maxElem

solve :: S.Set Int -> S.Set Int
solve xs = case reduce xs of
    Nothing -> xs
    Just ys -> solve ys

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as B
import qualified Data.IntSet           as IS

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  putStrLn.unwords.map show $ solve xs

solve :: [Int] -> [Int]
solve xs = go $ IS.fromList xs
  where
    go set = case filter (`IS.notMember`set') ms of
        (y:_) -> go $ IS.insert y set'
        [] -> IS.toList set
      where
        (m, set') = IS.deleteFindMax set
        ms = tail.takeWhile (>0) $ iterate (`quot`2) m

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}

import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S

readInt s = let Just (a, _) = BS.readInt s in a

main = BS.interact $ BS.unwords . map (BS.pack . show) . solve . map readInt . BS.words

solve (n:rest) = S.toList $ relax_all $ S.fromList $ take n rest
  where relax_all s = let rv = relax s in
          if rv > 0 then relax_all $ S.insert rv $ S.deleteMax s
          else s

relax s = relax_ $ S.findMax s
  where relax_ v = if S.notMember v s then v else relax_ $ v `div` 2

{-
██╗  ██╗ █████╗ ███████╗██╗  ██╗███████╗██╗     ██╗         ███████╗████████╗██╗    ██╗
██║  ██║██╔══██╗██╔════╝██║ ██╔╝██╔════╝██║     ██║         ██╔════╝╚══██╔══╝██║    ██║
███████║███████║███████╗█████╔╝ █████╗  ██║     ██║         █████╗     ██║   ██║ █╗ ██║
██╔══██║██╔══██║╚════██║██╔═██╗ ██╔══╝  ██║     ██║         ██╔══╝     ██║   ██║███╗██║
██║  ██║██║  ██║███████║██║  ██╗███████╗███████╗███████╗    ██║        ██║   ╚███╔███╔╝
╚═╝  ╚═╝╚═╝  ╚═╝╚══════╝╚═╝  ╚═╝╚══════╝╚══════╝╚══════╝    ╚═╝        ╚═╝    ╚══╝╚══╝

                                    $$\                  $$$$$$\  $$\         $$\   $$$$$$\        $$\      $$\   $$\ $$\
                                    \__|                $$  __$$\ $$ |      $$$$ | $$  __$$\       $$ |     $$ |  $$ |$$ |
 $$$$$$$\  $$$$$$\   $$$$$$\        $$\ $$$$$$$\        \__/  $$ |$$ |  $$\ \_$$ | $$ /  $$ |      $$ |     $$ |  $$ |$$ |
$$  _____|$$  __$$\ $$  __$$\       $$ |$$  __$$\        $$$$$$  |$$ | $$  |  $$ | \$$$$$$$ |      $$ |     $$ |  $$ |$$ |
$$ /      $$ /  $$ |$$ /  $$ |      $$ |$$ |  $$ |      $$  ____/ $$$$$$  /   $$ |  \____$$ |      $$ |     $$ |  $$ |$$ |
$$ |      $$ |  $$ |$$ |  $$ |      $$ |$$ |  $$ |      $$ |      $$  _$$<    $$ | $$\   $$ |      $$ |     $$ |  $$ |$$ |
\$$$$$$$\ $$$$$$$  |$$$$$$$  |      $$ |$$ |  $$ |      $$$$$$$$\ $$ | \$$\ $$$$$$\\$$$$$$  |      $$$$$$$$\\$$$$$$  |$$$$$$$$\
 \_______|$$  ____/ $$  ____/       \__|\__|  \__|      \________|\__|  \__|\______|\______/       \________|\______/ \________|
          $$ |      $$ |
          $$ |      $$ |
          \__|      \__|
-}

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

main :: IO ()
main = do
    line <- getLine >> getLine
    let nums :: [Int] = sortBy (flip compare) . map read . words $ line
    putStrLn . unwords . map show . S.toDescList . solve . S.fromDescList $ nums

possibilities :: Int -> [Int]
possibilities n | n == 1    = [1]
                | even n    = n : possibilities (n     `div` 2)
                | otherwise = n : possibilities ((n-1) `div` 2)

reduce :: S.Set Int -> Maybe (S.Set Int)
reduce  xs           = maxNonMember >>= (\e -> Just . S.insert e . S.delete maxElem $ xs) where
        maxElem      = S.findMax xs
        maxNonMember = find (`S.notMember` xs) $ possibilities maxElem

solve :: S.Set Int -> S.Set Int
solve xs = case reduce xs of
    Nothing -> xs
    Just ys -> solve ys

import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S

readInt s = let Just (a, _) = BS.readInt s in a

main = BS.interact $ BS.unwords . map (BS.pack . show) . solve . map readInt . BS.words

solve (n:rest) = S.toList $ relax_all $ S.fromList $ take n rest
  where relax_all s = let rv = relax s in
          if rv > 0 then S.insert rv $ S.deleteMax s
          else s

relax s = relax_ $ S.findMax s
  where relax_ v = if S.notMember v s then v else relax_ $ v `div` 2

import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S

readInt s = let Just (a, _) = BS.readInt s in a

main = BS.interact $ BS.unwords . map (BS.pack . show) . solve . map readInt . BS.words

solve (n:rest) = S.toList $ relax_all $ S.fromList $ take n rest
  where relax_all s = let rv = relax s in
          if rv > 0 then S.insert rv $ S.deleteMax s
          else s

relax s = relax_ $ S.findMax s
  where relax_ v = if S.member v s then v else relax_ $ v `div` 2


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

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

----- <Solution> --------------------------------------------------------------
data TC = TC {as :: [Int64]}

type Output = Int64

input :: Scanner TC
input = do
  as <- numberOf int64
  return TC {..}

solve :: TC -> Output
solve = as >>> sum >>> abs

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

----- </Solution> -------------------------------------------------------------

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map solve >>> zip [1 ..] >>> map (uncurry output) >>> C.unlines

----- Template ----------------------------------------------------------------

-- Debug
debug :: Show a => a -> a

#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- helpers
(>$>) = flip ($)

infixl 0 >$>

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

-- pragmas.hs {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad         (replicateM_)
import           Data.Array            (Array, (!))
import qualified Data.ByteString.Char8 as C
import           Data.Ix               (Ix)
import           Data.List             (unfoldr)

solve :: [Int] -> Int
solve xs = abs (abs psum - abs nsum)
  where
  psum = sum $ filter (>=0) xs
  nsum = sum $ filter (<0) xs

docase :: IO ()
docase = do
  _ <- getInt
  xs <- getInts
  print $ solve xs

main :: IO ()
main = getInt >>= flip replicateM_ docase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts = unfoldr go where
    go s = do
        (n,s1) <- C.readInt s
        let s2 = C.dropWhile (==' ') s1
        pure (n,s2)

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

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

getInts :: IO [Int]
getInts = readInts <$> C.getLine


import Data.List

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

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

solve :: [Int] -> Bool
solve (na:nb:k:m:x) =
    let a = (sort $ take na x) !! (k - 1)
        b = (sort $ drop na x) !! (nb - m)
    in  a < b

import Control.Applicative
import Data.List

main::IO ()
main=do
    [n,m]<- map read <$> words <$>  getLine
    [a,b]<- map read <$> words <$> getLine ::IO [Int]
    a1<- head <$> drop (a-1) <$>  map read <$>   words   <$> getLine:: IO Int
    b1<- head <$> drop (m-b) <$> map read <$> words <$> getLine::IO Int
    putStrLn $ if a1 <b1 then "YES" else "NO"

main :: IO ()
main = putStrLn . yesno . solve . map (map read . words) . lines =<< getContents

solve :: [[Int]] -> Bool
solve [ [ _, nb ], [ k, m ], as, bs ] = as !! (k - 1) < bs !! (nb - m)
solve _ = undefined

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

readInts = fmap (map read . words) getLine
main = do
  getLine
  [k,m] <- readInts
  as <- readInts
  bs <- readInts
  putStrLn $ if as !! (k-1) < bs !! (length bs - m) then "YES" else "NO"

f :: [Int] -> [Int] -> Int -> Int -> Int -> Bool
f xs ys k m n2 = xs !! (k-1) < ys !! (n2-m)

main = do
    [n1,n2] <- getList
    [k,m] <- getList
    xs <- getList
    ys <- getList
    putStrLn $ if f xs ys k m n2 then "YES"
                                 else "NO"

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

main=interact $ solve . map read . words
solve (la:lb:m:k:x) = if x!!(m-1)<x!!(la+lb-k) then "YES" else "NO"

parseLine :: String -> [Int]
parseLine str = map (read :: String -> Int) $ words str

main :: IO ()
main = do
    sizes <- getLine -- ignore
    counts <- getLine
    let [k, m] = map (+ (-1)) $ parseLine counts
    input <- getLine
    let a = parseLine input
    input <- getLine
    let b = parseLine input
    putStrLn $ if a !! k < (reverse b) !! m
                   then "YES"
                   else "NO"

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

main=do
	[na,nb]<-  map read.words  <$> getLine:: IO  [Int]
	[k,m]<-  map read.words  <$> getLine:: IO  [Int]
	a<-  sort.map (fst.fromJust.C.readInt). C.words <$> C.getLine ::IO [Int]
	b<-  reverse.sort.map (fst.fromJust.C.readInt). C.words <$> C.getLine ::IO [Int]
	let a1 = head $ drop (k-1) a
	let b1 = head $ drop (m-1) b
	putStrLn $ if a1 <b1 then "YES" else "NO"

ans (a,b)
  | a < b = "YES"
  | otherwise = "NO"

readRow = do
  input <- getLine
  return [read x::Int | x <- words input]

main = do
  input <- getLine
  input <- getLine
  let [k,m] = [read x::Int | x <- words input]
  a <- readRow
  b <- readRow
  putStrLn(ans((a !! (k-1),(b !! (length b - m)))))

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Control.Applicative

-- Meat
solve :: Int -> Int -> [Int] -> [Int] -> String
solve k m as bs
  | length btail >= m = "YES"
  | otherwise = "NO"
    where amax = last $ take k as
          btail = dropWhile (<= amax) bs

-- Shit
main :: IO ()
main = do
        [_, [k,m], as, bs] <- readShit
        printShit [solve k m as bs]

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

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

parseInput input = (na, nb, k, m, xs, ys) where
    ls = lines input
    [na, nb] = map read $ words $ head ls :: [Int]
    [k, m] = map read $ words $ head $ tail ls :: [Int]
    xs = map read $ words $ ls !! 2 :: [Int]
    ys = map read $ words $ last ls :: [Int]

solve _ nb k m xs ys = case last as < head bs of
                            True -> "YES"
                            _    -> "NO"
                       where
                            as = take k xs
                            bs = drop (nb - m) ys

main = do
    input <- getContents
    let (na, nb, k, m, xs, ys) = parseInput input
    putStrLn $ solve na nb k m xs ys

main :: IO()
main = do
    [a,b] <- fmap (map (\x -> read x::Int) . words) getLine
    [m,k] <- fmap (map (\x -> read x::Int) . words) getLine
    a1 <- fmap (map (\x -> read x::Int) . words) getLine
    a2 <- fmap (map (\x -> read x::Int) . words) getLine
    let det = a1!!(m-1)
    if length ([x | x<-a2 , x>det]) >= k then putStrLn "YES" else putStrLn "NO"

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# 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
  getLine
  [a, b] <- getInts
  xs <- getInts
  ys <- getInts

  putStrLn $ if xs!!(a-1) < ys!!(length ys - b) then "YES" else "NO"

answer::Int->Int->[Int]->[Int]->String
answer k m na nb = btos ((na !! (k-1)) < (nb !! ((length nb)-m)))
btos::Bool -> String
btos True = "YES"
btos False = "NO"
main = do
       w0 <- getLine
       w1 <- getLine
       w2 <- getLine
       w3 <- getLine
       let w = words w1
       let k = read (w !! 0)::Int
       let m = read (w !! 1)::Int
       let na = [read n::Int|n <-(words w2)]
       let nb = [read n::Int|n <-(words w3)]
       putStrLn $ answer k m na nb

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List

main = do
    let int = fst . fromJust . B.readInt
        ints = map int . B.words
    B.getLine
    [n, m] <- ints <$> B.getLine
    as <- ints <$> B.getLine
    bs <- ints <$> B.getLine
    putStrLn $ if (last $ take n $ sort as) < ( head $ drop (length bs - m ) $ sort bs) then "YES" else "NO"

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List

main = do
    let int = fst . fromJust . B.readInt
        ints = map int . B.words
    B.getLine
    [n, m] <- ints <$> B.getLine
    as <- ints <$> B.getLine
    bs <- ints <$> B.getLine
    putStrLn $ if (last $ take n as) < ( head $ drop (length bs - m ) bs) then "YES" else "NO"

-- Codeforces 572A

main :: IO ()
main = do
    [na, nb] <- readAndSplit
    [k, m] <- readAndSplit
    a <- readAndSplit
    b <- readAndSplit
    putStrLn $ if (a!!(k-1)) < (b!!(nb-m)) then "YES" else "NO" where
        readAndSplit = fmap (map read . words) getLine

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

getIntList :: IO [Int]
getIntList = map fst . mapMaybe C.readInt . C.words <$> C.getLine

main :: IO ()
main = do
  _:n:_ <- getIntList
  k:m:_ <- getIntList
  as <- getIntList
  bs <- getIntList
  let a = last $ take k as
  let b = head $ if n>m then drop (n-m) bs else bs
  putStrLn $ if a<b then "YES" else "NO"

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List

main = do
    let int = fst . fromJust . B.readInt
        ints = map int . B.words
    B.getLine
    [n, m] <- ints <$> B.getLine
    as <- ints <$> B.getLine
    bs <- ints <$> B.getLine
    putStrLn $ if (last $ take n $ sort as) < (head $ sort bs) then "YES" else "NO"

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

getIntList :: IO [Int]
getIntList = map fst . mapMaybe C.readInt . C.words <$> C.getLine

main :: IO ()
main = do
  _ <- C.getLine
  k:m:_ <- getIntList
  as <- getIntList
  bs <- getIntList
  let a = maximum $ take k as
  let b = minimum $ take m bs
  putStrLn $ if a<b then "YES" else "NO"

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

getIntList :: IO [Int]
getIntList = map fst . mapMaybe C.readInt . C.words <$> C.getLine

main :: IO ()
main = do
  _ <- C.getLine
  k:m:_ <- getIntList
  as <- getIntList
  bs <- getIntList
  let a = as!!k
  let b = head bs
  putStrLn $ if a<b then "YES" else "NO"

import Control.Applicative
import Data.List

main::IO ()
main=do
    n<-   getLine
    [a,b]<- map read <$> words <$> getLine ::IO [Int]
    a1<- head <$> drop (b-1) <$>  map read <$>   words   <$> getLine:: IO Int
    b1<- head <$> map read <$> words <$> getLine::IO Int
    putStrLn $ if a1 <b1 then "YES" else "NO"


{-# LANGUAGE BangPatterns #-}

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

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, foldM, mapM, filterM, forM) -- foldM est un foldl
import Data.Maybe
import Data.Int

solve :: Integer -> Integer -> Integer
solve a b = a * b

plotResult :: Integer -> IO ()
plotResult = print

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[a, b] <- fmap ((fmap read) . words) getLine :: IO [Integer]
		--a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve a b

import Control.Monad

answer :: Int -> Int -> Int
answer x y = x * y

solve line = x * y
    where (x:y:_) = map read $ words line

main :: IO ()
main = do
    t <- getLine
    replicateM_ (read t) $ do
        line <- getLine
        print $ solve line


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

check l = if sort l == l then Just l else Nothing

solve (_ : moneys) = check $ zipWith (\x y -> y - x) [0..] $ sort (zipWith (+) [0..] moneys)

pp Nothing = [":("]
pp (Just l) = [unwords $ map show l]

main = B.interact $ B.unlines . map B.pack . pp . solve . map readInt . B.words

readInt = fst . fromJust . B.readInt

import Data.Char (ord)
import Data.List

type Input  = [Int]
type Output = Maybe [Int]

readInt :: String -> Int
readInt = foldl' (\s d -> s * 10 + ord d - 48) 0

parse :: String -> Input
parse contents = a where [_, a] = map (map readInt . words) . lines $ contents

check :: [Int] -> Maybe [Int]
check a | sorted    = Just a
        | otherwise = Nothing
        where sorted = and $ zipWith (<=) (0 : a) a

solve :: Input -> Output
solve = check . add (map negate nats) . sort . add nats
        where nats = [0..]
              add  = zipWith (+)

format :: Output -> String
format Nothing  = ":("
format (Just a) = unwords . map show $ a

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


{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
main = interact $ unlines . g . tail . lines
        where
            aux1 :: String -> Int
            aux1 ss = read . last . words $ ss
            aux2 :: String -> [Int]
            aux2 ss = map read . words $ ss
            g :: [String] -> [String]
            g (x:y:sss) = f' (aux2 y) (aux1 x): g sss
            g [] = []

f' :: [Int] -> Int -> String
f' (s:ss) d = show . (\(x, _, _) -> x) . foldl ff (0, s, s) $ ss
                where
                    twiceD = 2*d
                    ff (accum, smin, smax) x
                        | x > smax = if x - smin > twiceD then
                                        (accum+1, x, x)
                                     else
                                        (accum, smin, x)
                        | x < smin = if smax - x > twiceD then
                                        (accum+1, x, x)
                                     else
                                        (accum, x, smax)
                        | otherwise = (accum, smin, smax)

f :: [Int] -> Int -> String
f (s:ss) d = show (aux s s 0 ss)
    where
        twiceD = 2*d
        aux :: Int -> Int -> Int -> [Int] -> Int
        aux smin smax accum (x:xs)
            | x > smax = if x - smin > twiceD then
                            aux x x (accum+1) xs
                         else
                            aux smin x accum xs
            | x < smin = if smax - x > twiceD then
                            aux x x (accum+1) xs
                         else
                            aux x smax accum xs
            | otherwise = aux smin smax accum xs
        aux _ _ accum [] = accum

{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM
                                                , replicateM_
                                                )
import           Data.Bits                      ( Bits(..) )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( elemIndex
                                                , findIndex
                                                , foldl'
                                                , unfoldr
                                                )
import           Data.Maybe                     ( fromMaybe )
import           Text.Printf                    ( printf )

-- arrange :: [a] -> Int -> [[a]]
-- arrange xs n = mapM (const xs) [1 .. n]

-- data Tree a = Null | Branch a (Tree a) (Tree a)
--   deriving (Show, Eq, Functor)

-- makeBaseFunctor ''Tree

-- x :: Tree Int
-- x = Branch 1 (Branch 2 Null Null) (Branch 3 Null Null)

-- y :: Tree Int -> Int
-- y = cata $ \case
--     NullF         -> 0
--     BranchF x a b -> x + a + b

-- >>> y x
-- 6

-- z :: Tree Int -> Int
-- z = para $ \case
--     NullF                     -> 0
--     BranchF x (x1, a) (x2, b) -> x + a + b + y x1 + y x2

-- >>> z x
-- 11

-- quicksort :: Ord a => [a] -> [a]
-- quicksort = hylo merge split  where
--     split []       = NullF
--     split (x : xs) = let (l, r) = partition (< x) xs in BranchF x l r

--     merge NullF           = []
--     merge (BranchF x l r) = l ++ [x] ++ r

-- >>> quicksort ([5,4,6,7,8,6,4,2])
-- [2,4,4,5,6,6,7,8]

-- fibSeq :: [Int]
-- fibSeq = futu phi Nil
--   where
--     phi Nil                    = Cons 0 (Pure (Cons 0 Nil))
--     phi x@(Cons _ Nil        ) = Cons 1 (Pure (Cons 1 (Cons 0 Nil)))
--     phi t@(Cons x (Cons y xs)) = Cons (x + y) (Pure (Cons (x + y) (Cons x Nil)))

-- >>> take 20 fibSeq
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

-- f1 :: [Int] -> Int
-- f1 = flip runReader 0 . cataA phi
--   where
--     phi Nil        = return 0
--     phi (Cons x t) = do
--         n <- ask
--         if n >= 10 then return 0 else (x +) <$> local succ t

-- f2 :: [Int]
-- f2 = apo phi 1
--   where
--     phi n | n < 100   = Cons (n * 2) (Right (n + 1))
--           | otherwise = Cons (n * 2) (Left [1, 2, 3])

-- >>> f1 fibSeq
-- 88

-- >>> f2
-- [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198]

-- urlParser :: Parser String
-- urlParser = argument str (metavar "URL")

-- segmented :: Int -> Int -> [(Int, Int)]
-- segmented total blocksize = (id &&& (min (total - 1) . (+ (blocksize - 1)))) <$> takeWhile (< total) [0, blocksize ..]

-- main :: IO ()
-- main = do
--     manager <- newManager tlsManagerSettings
--     url     <- execParser opts
--     req     <- parseRequest url
--     res     <- httpNoBody req manager
--     let len = maybe 0 fst (readInt =<< (lookup "Content-Length" (requestHeaders req) <|> lookup "content-length" (responseHeaders res)))
--     if len == 0
--         then do
--             res <- httpLbs req manager
--             print $ responseStatus res
--             print $ responseBody res
--         else do
--             pool <- createPool (pure ()) (const (pure ())) 2 0.5 5
--             mapConcurrently_
--                 (\(s, e) -> withResource pool $ \_ -> do
--                     res <- httpLbs (req { requestHeaders = ("Range", BS.pack $ formatToString ("bytes=" % int % "-" % int) s e) : requestHeaders req }) manager
--                     print $ responseStatus res
--                     -- print $ responseBody res
--                 )
--                 (segmented len tenMegabytes)
--   where
--     opts         = info urlParser fullDesc
--     tenMegabytes = 10485760

-- eigenvector :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a)) => r (r a) -> r a
-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue :: (Fractional a, Foldable t, Additive t, Conjugate a) => t (t a) -> t a -> a
-- eigenvalue m x = (let V1 (V1 p) = (helper x!*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q)
--     where
--         helper :: (Functor t, Conjugate a) => t a -> V1 (t a)
--         helper = adjoint . fmap V1

-- eigenvalues :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a), Finite r, KnownNat (Size r), Traversable r, Num (r (r a)), Applicative r, Eq a, Distributive r, Conjugate a, R1 r) => r (r a) -> [a]
-- eigenvalues m = go [e0] (m - e0 *!! identity)
--     where
--         c0 = eigenvector m
--         e0 = eigenvalue m c0
--         go acc ma | luDetFinite (m - ev *!! identity) /= 0 = acc
--                   | otherwise = go (ev : acc) (ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec))
--                   where ec = eigenvector ma
--                         ev = eigenvalue ma ec
--                         ec' = (<$ unit _x) <$> ec

-- >>> eigenvalues (V2 (V2 1 2) (V2 3 4))
-- []

data Break = Break
    deriving Show

instance Exception Break

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine where parse s = let Just (n, _) = C.readInt s in n

readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
  where
    parse = unfoldr go
    go s = do
        (n, s1) <- C.readInt s
        let s2 = C.dropWhile (== ' ') s1
        return (fromIntegral n, s2)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, m] <- readChar8'
        xs     <- readChar8'
        print $ fst $ foldl'
            (\(acc, (mx, mi)) x ->
                let mx' = max mx x
                    mi' = min mi x
                in  if mx' - mi' > 2 * m then (acc + 1, (x, x)) else (acc, (mx', mi'))
            )
            (0, (head xs, head xs))
            xs

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
import qualified Data.ByteString.Char8 as B
import Data.Maybe ( fromJust )

main :: IO ()
main = B.interact $ B.unlines . g . tail . B.lines
        where
            aux1 ss = fst . fromJust . B.readInt . last . B.words $ ss
            aux2 ss = map (fst . fromJust . B.readInt) . B.words $ ss
            g (x:y:sss) = f' (aux2 y) (aux1 x): g sss
            g [] = []

f' :: (Ord c, Num c) => [c] -> c -> B.ByteString
f' (s:ss) d =  B.pack . show . (\(x, _, _) -> x) . foldl ff (0, s, s) $ ss
                where
                    twiceD = 2*d
                    ff (accum, smin, smax) x
                        | x > smax = if x - smin > twiceD then
                                        (accum+1, x, x)
                                     else
                                        (accum, smin, x)
                        | x < smin = if smax - x > twiceD then
                                        (accum+1, x, x)
                                     else
                                        (accum, x, smax)
                        | otherwise = (accum, smin, smax)


{-# LANGUAGE BlockArguments #-}

import Control.Monad
import Data.List

solve xs = show' if ones <= len `div` 2 then (len - ones, 0) else (ones - if even ones then 0 else 1, 1)
  where
    len = length xs
    ones = sum xs
    show' (l, x) = show l ++ "\n" ++ intercalate " " (replicate l $ show x)

main = mkMain solve

mkMain f = do
  n <- readLn
  replicateM_ n do
    void $ getLine
    a <- map read . words <$> getLine
    putStrLn $ f a

{-# 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
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInt
	as <- readInts
	let
		k = n `div` 2
		ones = length $ filter ( == 1 ) as
	if  | as == [ 1, 1 ] -> do
			print n
			printList as
		| ones <= n `div` 2 -> do
			print k
			printList $ replicate k 0
		| otherwise -> do
			let
				k' = if odd ones then ones - 1 else ones
			print $ k'
			printList $ replicate k' 1

{-# 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
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInt
	as <- readInts
	let
		k = n `div` 2
		ones = length ( filter odd as )
	if n == 2 && as == [ 1, 1 ]
		then do
			print n
			printList as
		else do
			print $ k
			printList $ replicate k ( which 0 1 $ ones <= k )

{-# 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
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInt
	as <- readInts
	let
		k = n `div` 2
		ones = length $ filter ( == 1 ) as
	if  | as == [ 1, 1 ] -> do
			print n
			printList as
		|  ones <= n `div` 2  ->  do
			print k
			printList $ replicate k 0
		| otherwise -> do
			let
				k' = if odd k then k - 1 else k
			print $ k'
			printList $ replicate k' 1

{-# 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
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInt
	as <- readInts
	let
		k = n `div` 2
		ones = length ( filter odd as )
	print $ k
	printList $ replicate k ( which 0 1 $ ones <= k )


import Data.List

main = getLine >>= test . read

test 0 = return ()
test i = do
    getLine
    as <- map read . words <$> getLine
    print $ solve (head as) as
    test (i - 1)

solve _ [] = 0
solve a (d:ds) = max (binaryLength (a - d)) (solve (max a d) ds)

binaryLength x = until ((> x) . (2 ^)) (+ 1) 0

import Control.Monad

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ getLine >> getLine >>= print . solve . map read . words

bitcnt :: Int -> Int
bitcnt 0 = 0
bitcnt n = succ . bitcnt $ n `div` 2

solve :: [Int] -> Int
solve a = maximum . map bitcnt $ zipWith (-) (scanl1 max a) a

import Control.Monad
import Data.Bits

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ getLine >> getLine >>= print . solve . map read . words

bitcnt :: Int -> Int
bitcnt x = finiteBitSize x - countLeadingZeros x

solve :: [Int] -> Int
solve a = maximum . map bitcnt $ zipWith (-) (scanl1 max a) a

import Control.Monad
import Data.Bits
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    _ <- getLine
    xs <- (map read.words) <$> getLine
    print $ solve xs

solve :: [Int] -> Int
solve xs =maximum $ map (\x -> if x<=0 then 0 else 1 + logBase2 x) $ f (head xs) xs

f :: Int -> [Int] -> [Int]
f prev (x:xs) = (prev-x) : f (max prev x) xs
f prev [] = []

logBase2 :: Int -> Int
logBase2 x = finiteBitSize x - 1 - countLeadingZeros x

{-# LANGUAGE ScopedTypeVariables #-}

everySecond []           = []
everySecond (a : b : xs) = b : everySecond xs

-- https://stackoverflow.com/a/14359943/61394
log2 n = length (takeWhile (< n) (iterate (* 2) 1))

f xs =
  let runningMax = scanl1 max xs
      maxDiff    = maximum $ zipWith (-) runningMax xs
  in  if maxDiff <= 0 then 0 else log2 (maxDiff + 1)

main =
  interact
    $ unlines
    . map (show . f . map read . words)
    . everySecond
    . tail
    . lines

{-# LANGUAGE ScopedTypeVariables #-}

everySecond []           = []
everySecond (a : b : xs) = b : everySecond xs

-- https://stackoverflow.com/a/14359943/61394
log2 n = length (takeWhile (< n) (iterate (* 2) 1))

f xs =
  let runningMax = scanl1 max xs
      maxDiff    = maximum $ zipWith (-) runningMax xs
  in  if maxDiff <= 0 then 0 else 1 + log2 maxDiff

main =
  interact
    $ unlines
    . map (show . f . map read . words)
    . everySecond
    . tail
    . lines

import Data.List

main = getLine >>= test . read

test 0 = return ()
test i = do
    getLine
    as <- map read . words <$> getLine
    let ds = zipWith (-) as (tail as)
    print $ solve 0 $ sort $ filter (> 0) ds
    test (i - 1)

solve x [] = x
solve x (d:ds)
    | 2 ^ x < d = solve (x + 1) ((d - 2 ^ x):ds)
    | otherwise = solve (x + 1) ds

import Data.List

main = getLine >>= test . read

test 0 = return ()
test i = do
    getLine
    as <- map read . words <$> getLine
    print $ solve 0 as
    test (i - 1)

solve _ [] = 0
solve a (d:ds) = max (binaryLength (a - d)) (solve (max a d) ds)

binaryLength x
    | x <= 0 = 0
    | otherwise = until ((> x) . (2 ^)) (+ 1) 0

import Control.Monad

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

routine :: IO ()
routine = do
    _ <- getLine
    xs <- (map read.words) <$> getLine
    print $ solve xs

solve :: [Int] -> Int
solve [_] = 0
solve [x,y] = f2 (x-y)
solve xs = f3. map f2 . f1 $ xs

f1 :: [Int] -> [Int]
f1 xs = zipWith (-) xs (tail xs)

f2 :: Int -> Int
f2 x = floor $ if x<=0 then 0 else 1+ logBase 2 (fromIntegral x)

f3 :: [Int] -> Int
f3 xs =maximum $ zipWith (\x y -> if x==y && x>0 then x+1 else max x y) xs (tail xs)

import Control.Monad
import Data.Bits
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    _ <- getLine
    xs <- (map read.words) <$> getLine
    print $ solve xs

solve :: [Int] -> Int
solve xs =maximum $ map (\x -> if x<=0 then 0 else 1 + logBase2 x) $ f 0 xs

f :: Int -> [Int] -> [Int]
f prev (x:xs) = (prev-x) : f (max prev x) xs
f prev [] = []

logBase2 :: Int -> Int
logBase2 x = finiteBitSize x - 1 - countLeadingZeros x


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

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

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

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

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    pts2 = map head . group . sort $ solveInterval (sort pts)

solveInterval [] = []
solveInterval xs = solveInterval lo ++ solveInterval (tail hi) ++ [ (x, y) | (_, y) <- xs]
  where
    len = length xs
    (lo, hi) = splitAt (len `div` 2) xs

    x = fst $ head hi

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

module Main where

import Control.Monad
import Data.List
import Data.Ord

main = do
    n <- read `liftM` getLine
    points <- sortBy (comparing fst) `liftM` replicateM n ( do
        [x, y] <- ( map read . words ) `liftM` getLine :: IO [Int]
        return (x, y) )

    let resPoints = fst $ fill points
    putStrLn $ show $ length resPoints
    putStr $ unlines $ map (\(x, y) -> show x ++ " " ++ show y) resPoints

fill :: [(Int, Int)] -> ([(Int, Int)], [Int])
fill pts =
    let n = length pts
        x0 = fst $ pts !! ( n `div` 2 )
        (left, middle, right) = foldr (\p@(x, _) (left, middle, right) ->
                case compare x x0 of
                    LT -> (p:left, middle, right)
                    EQ -> (left, p:middle, right)
                    GT -> (left, middle, p:right)
            ) ([], [], []) pts
        middleY = sort $ map snd middle

        (left', leftY) = fill left
        (right', rightY) = fill right

        y = merge3 leftY middleY rightY

        middle' = map (\y -> (x0, y)) y

    in if n == 0 then ([], []) else (left' ++ middle' ++ right', y)

merge3 :: (Bounded a, Ord a) => [a] -> [a] -> [a] -> [a]
merge3 as bs cs =
    let a = if null as then maxBound else head as
        b = if null bs then maxBound else head bs
        c = if null cs then maxBound else head cs
        ta = tail as
        tb = tail bs
        tc = tail cs
    in case compare a b of
        LT -> case compare a c of
            LT -> a : merge3 ta bs cs
            EQ -> a : merge3 ta bs tc
            GT -> c : merge3 as bs tc
        EQ -> case compare a c of
            LT -> a : merge3 ta tb cs
            EQ -> if a == maxBound then [] else a : merge3 ta tb tc
            GT -> c : merge3 as bs tc
        GT -> case compare b c of
            LT -> b : merge3 as tb cs
            EQ -> b : merge3 as tb tc
            GT -> c : merge3 as bs tc

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

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

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

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

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    pts2 = map head . group . sort $ solveInterval (sort pts)

solveInterval [] = []
solveInterval [a] = [a]
solveInterval xs = solveInterval lo ++ solveInterval (tail hi) ++ [ (x, y) | (_, y) <- xs]
  where
    len = length xs
    (lo, hi) = splitAt (len `div` 2) xs

    x = snd $ head hi

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

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

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

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

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

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    pts2 = map head . group . sort $ solveInterval (sort pts)

solveInterval [] = []
solveInterval [a] = [a]
solveInterval xs = solveInterval lo ++ solveInterval hi ++ [ (x, y) | (_, y) <- xs]
  where
    len = length xs
    (lo, hi) = splitAt (len `div` 2) xs

    x = snd $ head hi

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

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

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

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

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

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    pts2 = map head . group . sort $ solveInterval (sort pts)

solveInterval [] = []
solveInterval [a] = [a]
solveInterval xs = solveInterval lo ++ solveInterval hi ++ [ (x, y) | (x, _) <- xs]
  where
    len = length xs
    (lo, hi) = splitAt (len `div` 2) xs

    y = snd $ head hi

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

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

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

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

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

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    ptsGrouped = groupBy ((==) `on` fst) $ sort pts
    ptsMerged = concat $ zipWith mergeLine ptsGrouped (tail ptsGrouped) :: [(Int,Int)]

    xs = map head . group . sort $ map fst pts
    ys = map head . group . sort $ map snd pts

    borderX = [ (x, y) | x <- xs, y <- [minimum ys, maximum ys]]
    borderY = [ (x, y) | y <- ys, x <- [minimum xs, maximum xs]]

    pts2 = map head . group . sort $ ptsMerged ++ borderX ++ borderY :: [(Int,Int)]

mergeLine :: [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)]
mergeLine [] x = x
mergeLine x [] = x
mergeLine x y = [(xVal, val) | val <- lst, inRange rangeX val] ++ [(yVal, val) | val <- lst, inRange rangeY val]
  where
    xVal = fst $ head x
    yVal = fst $ head y
    lst = IntSet.toList . IntSet.fromList $ map snd x ++ map snd y

    rangeX = (minimum $ map snd x, maximum $ map snd x)
    rangeY = (minimum $ map snd y, maximum $ map snd y)

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State


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

f o n
  | o < 0 = print $ -1
  | otherwise = print $ min o n

inspect 0 = putStr ""
inspect linenum = do
  line <- getLine
  let
    k:n:a:b:_ = map read $ words line
    m = a * n
    d = a - b
    e = m - k
    q = (div e d) + 1
    o = n - q
  f o n
  inspect $ linenum - 1

main = do
  line <- getLine
  inspect $ read line

readInt :: String -> Integer
readInt = read

main = interact $ solve . (map ((map readInt) . words)) . tail . lines

solve :: [[Integer]] -> String
solve [] = ""
solve (l:ls) = solveInstance l ++ solve ls

solveInstance :: [Integer] -> String
solveInstance [k, n, a, b]
    | n*b >= k = "-1\n"
    | otherwise = let t = (k - n*b - 1) `div` (a - b) in (++"\n") $ show (min n t)

readInt :: String -> Int
readInt = read

main = interact $ solve . (map ((map readInt) . words)) . tail . lines

solve :: [[Int]] -> String
solve [] = ""
solve (l:ls) = solveInstance l ++ solve ls

solveInstance :: [Int] -> String
solveInstance [k, n, a, b]
    | n*b >= k = "-1\n"
    | otherwise = let t = (k - n*b - 1) `div` (a - b) in (++"\n") $ show (min n t)


import Control.Monad
import Data.List
import Data.Ord (comparing)

main = do
    n <- fmap read getLine
    strings <- replicateM n getLine
    let sort_strings = lsort strings
    let len = length sort_strings
    if (check sort_strings len || (len == 1))
    then do
         putStrLn "YES"
         mapM_ putStrLn sort_strings
    else do
         putStr "NO"
         --mapM_ putStrLn sort_strings

lsort :: [String] -> [String]
lsort = sortBy (comparing length)

check :: [String] -> Int -> Bool
check _ 1 = True
check (x:y:xs) l = if isInfixOf x y
                   then check (y:xs) (l-1)
                   else False

module Main where

import Data.List
import Control.Monad

main :: IO ()
main = do
  n <- fmap read getLine
  strings <- sequence $ take n $ repeat getLine
  let sortedByLength = sortBy (\str str' -> compare (length str) (length str')) strings
      grouped = group sortedByLength
      groupedByLength = groupBy (\str str' -> length str == length str') sortedByLength
  if length grouped /= length groupedByLength then do
    putStrLn "NO"
  else do
    let (_,satisfy) = foldl (\(preceeding,flag) current ->
                                 let newFlag = all id $ map (flip isInfixOf current) preceeding
                                 in (current:preceeding,flag && newFlag)) ([],True) $ map head grouped
    if satisfy then do
      putStrLn "YES"
      forM_ (concat grouped) (\str -> putStrLn str)
    else
      putStrLn "NO"

import Control.Monad
import qualified Data.Map as M
import Data.Map(Map)
import Data.List
import Data.Ord (comparing)

sort_str :: [String] -> [String]
sort_str = sortBy (comparing length)

rec :: [String] -> Int -> Bool
rec _ 1 = True
rec (x : y : xs) l = if isInfixOf x y
                     then rec (y : xs) (l - 1)
                     else False

main = do
    n <- fmap read getLine
    a <- replicateM n getLine
    let arr = sort_str a
    let len = length arr
    if (rec arr len || (len == 1))
    then do
         putStrLn "YES"
         mapM_ putStrLn arr
    else do
         putStr "NO"

module Main where

import           Control.Monad (replicateM)
import           Data.List     (isInfixOf, sort)

newtype MyString = MyString String
    deriving (Eq)

instance Show MyString where
    show (MyString a) = a

instance Ord MyString where
    (<=) (MyString a) (MyString b) = length a <= length b && isInfixOf a b

checkInvariant :: [MyString] -> Bool
checkInvariant l@(x : xs) = all (\(MyString a, MyString b) -> isInfixOf a b) (zip l xs)
checkInvariant _          = True

main :: IO ()
main = do
    nStr <- getLine
    let n = read nStr :: Int
    s <- replicateM n getLine
    let answer = sort (map MyString s)
    if checkInvariant answer
    then do
        putStrLn "YES"
        mapM_ print answer
    else putStrLn "NO"

import Control.Monad
import Data.List
import Data.Ord
import Data.String

subpair t = isInfixOf (fst t) (snd t)

main = do
  fline <- getLine
  let n = read fline::Int
  strs <- replicateM n getLine
  let sstrs = sortBy (comparing length) strs
  let pstrs = zip (take (n-1) sstrs) (tail sstrs)
  let judge = foldl (&&) True $ map subpair pstrs
  if judge
    then do putStrLn "YES";
	        mapM_ putStrLn sstrs
    else do putStrLn "NO"

module Main where

import           Control.Monad (replicateM)
import           Data.List     (isInfixOf, sort)

newtype MyString = MyString String
    deriving (Eq)

instance Show MyString where
    show (MyString a) = a

instance Ord MyString where
    (<=) (MyString a) (MyString b) = isInfixOf a b

checkInvariant :: [MyString] -> Bool
checkInvariant l@(x : xs) = all (\(MyString a, MyString b) -> a <= b) (zip l xs)
checkInvariant _          = True

main :: IO ()
main = do
    nStr <- getLine
    let n = read nStr :: Int
    s <- replicateM n getLine
    let answer = sort (map MyString s)
    if checkInvariant answer
    then do
        putStrLn "YES"
        mapM_ print answer
    else putStrLn "NO"