You are given an array $$$a$$$ consisting of $$$n$$$ integers. You want to distribute these $$$n$$$ integers into two groups $$$s_1$$$ and $$$s_2$$$ (groups can be empty) so that the following conditions are satisfied:  For each $$$i$$$ $$$(1 \leq i \leq n)$$$, $$$a_i$$$ goes into exactly one group. The value $$$|sum(s_1)| - |sum(s_2)|$$$ is the maximum possible among all such ways to distribute the integers.Here $$$sum(s_1)$$$ denotes the sum of the numbers in the group $$$s_1$$$, and $$$sum(s_2)$$$ denotes the sum of the numbers in the group $$$s_2$$$.Determine the maximum possible value of $$$|sum(s_1)| - |sum(s_2)|$$$.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ $$$(1 \leq t \leq 2 \cdot 10^4)$$$  — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ $$$(1 \leq n \leq 10^5)$$$  — the length of the array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1,a_2 \ldots a_n$$$ $$$(-10^9 \leq a_i \leq 10^9)$$$  — elements of the array $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot 10^5$$$.

For each test case, output a single integer  — the maximum possible value of $$$|sum(s_1)| - |sum(s_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


Let's consider the following game. We have a rectangular field n × m in size. Some squares of the field contain chips.Each chip has an arrow painted on it. Thus, each chip on the field points in one of the following directions: up, down, left or right.The player may choose a chip and make a move with it.The move is the following sequence of actions. The chosen chip is marked as the current one. After that the player checks whether there are more chips in the same row (or in the same column) with the current one that are pointed by the arrow on the current chip. If there is at least one chip then the closest of them is marked as the new current chip and the former current chip is removed from the field. After that the check is repeated. This process can be repeated several times. If a new chip is not found, then the current chip is removed from the field and the player's move ends.By the end of a move the player receives several points equal to the number of the deleted chips.By the given initial chip arrangement determine the maximum number of points that a player can receive during one move. Also determine the number of such moves.

The first line contains two integers n and m (1 ≤ n, m, n × m ≤ 5000). Then follow n lines containing m characters each — that is the game field description. "." means that this square is empty. "L", "R", "U", "D" mean that this square contains a chip and an arrow on it says left, right, up or down correspondingly. It is guaranteed that a field has at least one chip.

Print two numbers — the maximal number of points a player can get after a move and the number of moves that allow receiving this maximum number of points.

NoteIn the first sample the maximum number of points is earned by the chip in the position (3, 3). You can see its progress at the following picture:   All other chips earn fewer points.

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

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

import Debug.Trace

import GHC.Conc (par, pseq)

parMap f xs
    | null hi   = map f xs
    | otherwise = loRes `par` (hiRes `pseq` (loRes ++ hiRes))
  where
    (lo, hi) = splitAt 128 xs
    loRes = map f lo
    hiRes = parMap f hi

parseInput = do
    n <- readInt
    m <- readInt
    grid <- replicateM n (BS.unpack <$> readString)
    return (n, m, grid)
  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 = putStr =<< solve . evalState parseInput <$> BS.getContents

solve (n, m, grid') = show mans ++ " " ++ show (length $ filter (==mans) answer) ++ "\n"
  where
    bnds = ((1,1),(n,m))
    grid = listArray bnds [ele | row <- grid', ele <- row] :: UArray (Int,Int) Char

    answer = parMap walkingGrid [idx | idx <- range bnds, let ch = grid ! idx, ch /= '.']
    walkingGrid = walking grid

    mans = maximum answer

getD 'U' = (-1, 0)
getD 'D' = (1, 0)
getD 'R' = (0, 1)
getD 'L' = (0, -1)

getI 'U' = 0
getI 'D' = 1
getI 'R' = 2
getI 'L' = 3

walking :: UArray (Int,Int) Char -> (Int, Int) -> Int
walking grid (sx, sy) = runST $ do
    arr <- thaw initialArr :: ST s (STUArray s (Int, Int) Int)
    go arr (index bndsGrid (sx, sy)) 0
  where
    bndsGrid = bounds grid
    bnds = ((0, 0), (rangeSize bndsGrid - 1, 3))

    initialArr = runSTUArray $ do
        arr <- newListArray bnds [ if inRange bndsGrid xy' then index bndsGrid xy' else (-1)
                                 | (x, y) <- range bndsGrid
                                 , ch <- "UDRL"
                                 , let (dx, dy) = getD ch
                                 , let xy' = (x + dx, y + dy)
                                 ] :: ST s (STUArray s (Int,Int) Int)
        forM_ (assocs grid') (\(place, ch) -> when (ch == '.') (removeNode arr place))
        return arr

    grid' = listArray (0, rangeSize bndsGrid - 1) $ elems grid :: UArray Int Char

    go arr (-1) steps = return steps
    go arr place steps = do
        removeNode arr place
        nextPlace <- readArray arr (place, dir)
        go arr nextPlace (steps + 1)
      where
        dir = getI $ grid' ! place

removeNode :: STUArray s (Int,Int) Int -> Int -> ST s ()
removeNode arr place = {-forM_ [0..3] $ \i -> do
    back <- readArray arr (place, i `xor` 1)
    when (back >= 0) $ do
        front <- readArray arr (place, i)
        writeArray arr (back, i) front-} do
    x0 <- readArray arr (place, 0)
    x1 <- readArray arr (place, 1)
    x2 <- readArray arr (place, 2)
    x3 <- readArray arr (place, 3)
    when (x0 >= 0) $ writeArray arr (x0, 1) x1
    when (x1 >= 0) $ writeArray arr (x1, 0) x0
    when (x2 >= 0) $ writeArray arr (x2, 3) x3
    when (x3 >= 0) $ writeArray arr (x3, 2) x2

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

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


You are given two arrays A and B consisting of integers, sorted in non-decreasing order. Check whether it is possible to choose k numbers in array A and choose m numbers in array B so that any number chosen in the first array is strictly less than any number chosen in the second array.

The first line contains two integers nA, nB (1 ≤ nA, nB ≤ 105), separated by a space — the sizes of arrays A and B, correspondingly. The second line contains two integers k and m (1 ≤ k ≤ nA, 1 ≤ m ≤ nB), separated by a space. The third line contains nA numbers a1, a2, ... anA ( - 109 ≤ a1 ≤ a2 ≤ ... ≤ anA ≤ 109), separated by spaces — elements of array A. The fourth line contains nB integers b1, b2, ... bnB ( - 109 ≤ b1 ≤ b2 ≤ ... ≤ bnB ≤ 109), separated by spaces — elements of array B.

Print "YES" (without the quotes), if you can choose k numbers in array A and m numbers in array B so that any number chosen in array A was strictly less than any number chosen in array B. Otherwise, print "NO" (without the quotes).

NoteIn the first sample test you can, for example, choose numbers 1 and 2 from array A and number 3 from array B (1 < 3 and 2 < 3).In the second sample test the only way to choose k elements in the first array and m elements in the second one is to choose all numbers in both arrays, but then not all the numbers chosen in A will be less than all the numbers chosen in B: .

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

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

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

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

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"


Michael is accused of violating the social distancing rules and creating a risk of spreading coronavirus. He is now sent to prison. Luckily, Michael knows exactly what the prison looks like from the inside, especially since it's very simple.The prison can be represented as a rectangle $$$a\times b$$$ which is divided into $$$ab$$$ cells, each representing a prison cell, common sides being the walls between cells, and sides on the perimeter being the walls leading to freedom. Before sentencing, Michael can ask his friends among the prison employees to make (very well hidden) holes in some of the walls (including walls between cells and the outermost walls). Michael wants to be able to get out of the prison after this, no matter which cell he is placed in. However, he also wants to break as few walls as possible.Your task is to find out the smallest number of walls to be broken so that there is a path to the outside from every cell after this.

The first line contains a single integer $$$t$$$ ($$$1\leq t\leq 100$$$) — the number of test cases. Each of the following $$$t$$$ lines contains two integers $$$a$$$ and $$$b$$$ ($$$1\leq a, b\leq 100$$$), representing a corresponding test case.

For each test case print the single integer on a separate line — the answer to the problem.

NoteSome possible escape plans for the example test cases are shown below. Broken walls are shown in gray, not broken walls are shown in black.

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


Do you like summer? Residents of Berland do. They especially love eating ice cream in the hot summer. So this summer day a large queue of n Berland residents lined up in front of the ice cream stall. We know that each of them has a certain amount of berland dollars with them. The residents of Berland are nice people, so each person agrees to swap places with the person right behind him for just 1 dollar. More formally, if person a stands just behind person b, then person a can pay person b 1 dollar, then a and b get swapped. Of course, if person a has zero dollars, he can not swap places with person b.Residents of Berland are strange people. In particular, they get upset when there is someone with a strictly smaller sum of money in the line in front of them.Can you help the residents of Berland form such order in the line so that they were all happy? A happy resident is the one who stands first in the line or the one in front of who another resident stands with not less number of dollars. Note that the people of Berland are people of honor and they agree to swap places only in the manner described above.

The first line contains integer n (1 ≤ n ≤ 200 000) — the number of residents who stand in the line. The second line contains n space-separated integers ai (0 ≤ ai ≤ 109), where ai is the number of Berland dollars of a man standing on the i-th position in the line. The positions are numbered starting from the end of the line.

If it is impossible to make all the residents happy, print ":(" without the quotes. Otherwise, print in the single line n space-separated integers, the i-th of them must be equal to the number of money of the person on position i in the new line. If there are multiple answers, print any of them.

NoteIn the first sample two residents should swap places, after that the first resident has 10 dollars and he is at the head of the line and the second resident will have 9 coins and he will be at the end of the line. In the second sample it is impossible to achieve the desired result.In the third sample the first person can swap with the second one, then they will have the following numbers of dollars: 4 11 3, then the second person (in the new line) swaps with the third one, and the resulting numbers of dollars will equal to: 4 4 10. In this line everybody will be happy.

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


Luke likes to eat. There are $$$n$$$ piles of food aligned in a straight line in front of him. The $$$i$$$-th pile contains $$$a_i$$$ units of food. Luke will walk from the $$$1$$$-st pile towards the $$$n$$$-th pile, and he wants to eat every pile of food without walking back. When Luke reaches the $$$i$$$-th pile, he can eat that pile if and only if $$$|v - a_i| \leq x$$$, where $$$x$$$ is a fixed integer, and $$$v$$$ is Luke's food affinity.Before Luke starts to walk, he can set $$$v$$$ to any integer. Also, for each $$$i$$$ ($$$1 \leq i \leq n$$$), Luke can change his food affinity to any integer before he eats the $$$i$$$-th pile.Find the minimum number of changes needed to eat every pile of food.Note that the initial choice for $$$v$$$ is not considered as a change.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The description of test cases follows. For each test case, the first line contains two integers, $$$n, x$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$, $$$1 \leq x \leq 10^9$$$) — the number of piles, and the maximum difference between the size of a pile and Luke's food affinity, such that Luke can eat the pile. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots , a_n$$$ ($$$1 \leq a_i \leq 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output an integer on a separate line, which is the minimum number of changes needed.

NoteIn the first test case, Luke can set $$$v$$$ to $$$5$$$ before he starts to walk. And he can walk straight to eat every piles of food without changing $$$v$$$.In the second test case, Luke can set $$$v$$$ to $$$3$$$ before he starts to walk. And he could change $$$v$$$ to $$$10$$$ before he eats the second pile. After that, he can walk straight to eat remaining food without changing $$$v$$$.In the fourth test case, Luke can set $$$v$$$ to $$$3$$$ before he starts to walk. And he could change $$$v$$$ to $$$8$$$ before he eats the sixth pile. After that, he can walk straight to eat remaining food without changing $$$v$$$.In the fifth test case, Luke can set $$$v$$$ to $$$4$$$ before he starts to walk. And he could change $$$v$$$ to $$$6$$$ before he eats the fourth pile. Then he could change $$$v$$$ to $$$12$$$ before he eats the seventh pile. After that, he can walk straight to eat remaining food without changing $$$v$$$.

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

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


Alexandra has an even-length array $$$a$$$, consisting of $$$0$$$s and $$$1$$$s. The elements of the array are enumerated from $$$1$$$ to $$$n$$$. She wants to remove at most $$$\frac{n}{2}$$$ elements (where $$$n$$$ — length of array) in the way that alternating sum of the array will be equal $$$0$$$ (i.e. $$$a_1 - a_2 + a_3 - a_4 + \dotsc = 0$$$). In other words, Alexandra wants sum of all elements at the odd positions and sum of all elements at the even positions to become equal. The elements that you remove don't have to be consecutive.For example, if she has $$$a = [1, 0, 1, 0, 0, 0]$$$ and she removes $$$2$$$nd and $$$4$$$th elements, $$$a$$$ will become equal $$$[1, 1, 0, 0]$$$ and its alternating sum is $$$1 - 1 + 0 - 0 = 0$$$.Help her!

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^3$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 10^3$$$, $$$n$$$ is even)  — length of the array. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 1$$$)  — elements of the array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^3$$$.

For each test case, firstly, print $$$k$$$ ($$$\frac{n}{2} \leq k \leq n$$$) — number of elements that will remain after removing in the order they appear in $$$a$$$. Then, print this $$$k$$$ numbers. Note that you should print the numbers themselves, not their indices. We can show that an answer always exists. If there are several answers, you can output any of them.

NoteIn the first and second cases, alternating sum of the array, obviously, equals $$$0$$$.In the third case, alternating sum of the array equals $$$1 - 1 = 0$$$.In the fourth case, alternating sum already equals $$$1 - 1 + 0 - 0 = 0$$$, so we don't have to remove anything.

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


You have an array $$$a$$$ of length $$$n$$$. For every positive integer $$$x$$$ you are going to perform the following operation during the $$$x$$$-th second:  Select some distinct indices $$$i_{1}, i_{2}, \ldots, i_{k}$$$ which are between $$$1$$$ and $$$n$$$ inclusive, and add $$$2^{x-1}$$$ to each corresponding position of $$$a$$$. Formally, $$$a_{i_{j}} := a_{i_{j}} + 2^{x-1}$$$ for $$$j = 1, 2, \ldots, k$$$. Note that you are allowed to not select any indices at all. You have to make $$$a$$$ nondecreasing as fast as possible. Find the smallest number $$$T$$$ such that you can make the array nondecreasing after at most $$$T$$$ seconds.Array $$$a$$$ is nondecreasing if and only if $$$a_{1} \le a_{2} \le \ldots \le a_{n}$$$.You have to answer $$$t$$$ independent test cases.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^{4}$$$) — the number of test cases. The first line of each test case contains single integer $$$n$$$ ($$$1 \le n \le 10^{5}$$$) — the length of array $$$a$$$. It is guaranteed that the sum of values of $$$n$$$ over all test cases in the input does not exceed $$$10^{5}$$$. The second line of each test case contains $$$n$$$ integers $$$a_{1}, a_{2}, \ldots, a_{n}$$$ ($$$-10^{9} \le a_{i} \le 10^{9}$$$).

For each test case, print the minimum number of seconds in which you can make $$$a$$$ nondecreasing.

NoteIn the first test case, if you select indices $$$3, 4$$$ at the $$$1$$$-st second and $$$4$$$ at the $$$2$$$-nd second, then $$$a$$$ will become $$$[1, 7, 7, 8]$$$. There are some other possible ways to make $$$a$$$ nondecreasing in $$$2$$$ seconds, but you can't do it faster.In the second test case, $$$a$$$ is already nondecreasing, so answer is $$$0$$$.In the third test case, if you do nothing at first $$$2$$$ seconds and select index $$$2$$$ at the $$$3$$$-rd second, $$$a$$$ will become $$$[0, 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

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

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


This is the hard version of the problem. The difference between versions is the constraints on $$$n$$$ and $$$a_i$$$. You can make hacks only if all versions of the problem are solved.First, Aoi came up with the following idea for the competitive programming problem:Yuzu is a girl who collecting candies. Originally, she has $$$x$$$ candies. There are also $$$n$$$ enemies numbered with integers from $$$1$$$ to $$$n$$$. Enemy $$$i$$$ has $$$a_i$$$ candies.Yuzu is going to determine a permutation $$$P$$$. A permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$\{2,3,1,5,4\}$$$ is a permutation, but $$$\{1,2,2\}$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$\{1,3,4\}$$$ is also not a permutation (because $$$n=3$$$ but there is the number $$$4$$$ in the array).After that, she will do $$$n$$$ duels with the enemies with the following rules:  If Yuzu has equal or more number of candies than enemy $$$P_i$$$, she wins the duel and gets $$$1$$$ candy. Otherwise, she loses the duel and gets nothing.  The candy which Yuzu gets will be used in the next duels. Yuzu wants to win all duels. How many valid permutations $$$P$$$ exist?This problem was easy and wasn't interesting for Akari, who is a friend of Aoi. And Akari made the following problem from the above idea:Let's define $$$f(x)$$$ as the number of valid permutations for the integer $$$x$$$.You are given $$$n$$$, $$$a$$$ and a prime number $$$p \le n$$$. Let's call a positive integer $$$x$$$ good, if the value $$$f(x)$$$ is not divisible by $$$p$$$. Find all good integers $$$x$$$.Your task is to solve this problem made by Akari.

The first line contains two integers $$$n$$$, $$$p$$$ $$$(2 \le p \le n \le 10^5)$$$. It is guaranteed, that the number $$$p$$$ is prime (it has exactly two divisors $$$1$$$ and $$$p$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ $$$(1 \le a_i \le 10^9)$$$.

In the first line, print the number of good integers $$$x$$$. In the second line, output all good integers $$$x$$$ in the ascending order. It is guaranteed that the number of good integers $$$x$$$ does not exceed $$$10^5$$$.

NoteIn the first test, $$$p=2$$$.  If $$$x \le 2$$$, there are no valid permutations for Yuzu. So $$$f(x)=0$$$ for all $$$x \le 2$$$. The number $$$0$$$ is divisible by $$$2$$$, so all integers $$$x \leq 2$$$ are not good.  If $$$x = 3$$$, $$$\{1,2,3\}$$$ is the only valid permutation for Yuzu. So $$$f(3)=1$$$, so the number $$$3$$$ is good.  If $$$x = 4$$$, $$$\{1,2,3\} , \{1,3,2\} , \{2,1,3\} , \{2,3,1\}$$$ are all valid permutations for Yuzu. So $$$f(4)=4$$$, so the number $$$4$$$ is not good.  If $$$x \ge 5$$$, all $$$6$$$ permutations are valid for Yuzu. So $$$f(x)=6$$$ for all $$$x \ge 5$$$, so all integers $$$x \ge 5$$$ are not good. So, the only good number is $$$3$$$.In the third test, for all positive integers $$$x$$$ the value $$$f(x)$$$ is divisible by $$$p = 3$$$.

import qualified Data.IntMap as IntMap
import           Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

main :: IO()
main =
  do
    [n, p] <- map read . words <$> getLine :: IO [Int]
    a <- map read . words <$> getLine :: IO [Int]
    let k = maximum a
    let empty = IntMap.fromList $ zip [0 .. n - 1] $ repeat 0
    let cntMap = foldr (IntMap.alter ((1+) <$>) . (\x -> if x > k - n then x - k + n - 1 else 0)) empty a
    let s = foldr (wtf p) IntSet.empty $ scanl1 (\(_, ci) (j, cj) -> (j, ci + cj)) $ IntMap.toList cntMap
    let ans = [x + k - n + 1 | x <- [0..n-1], x < p, IntSet.notMember (x `mod` p) s]
    print $ length ans
    putStrLn $ unwords $ map show ans
  where
    wtf :: Int -> (Int, Int) -> IntSet -> IntSet
    wtf p = (\(i, m) -> if (-m) `mod` p <= i then IntSet.insert $ (-m) `mod` p else id).(\(i, c) -> (i, c - i))


You have an array $$$a_1,a_2, \dots, a_n$$$. Each element initially has value $$$0$$$ and color $$$1$$$. You are also given $$$q$$$ queries to perform:   Color $$$l$$$ $$$r$$$ $$$c$$$: Change the color of elements $$$a_l,a_{l+1},\cdots,a_r$$$ to $$$c$$$ ($$$1 \le l \le r \le n$$$, $$$1 \le c \le n$$$).  Add $$$c$$$ $$$x$$$: Add $$$x$$$ to values of all elements $$$a_i$$$ ($$$1 \le i \le n$$$) of color $$$c$$$ ($$$1 \le c \le n$$$, $$$-10^9 \le x \le 10^9$$$).  Query $$$i$$$: Print $$$a_i$$$ ($$$1 \le i \le n$$$).

The first line of input contains two integers $$$n$$$ and $$$q$$$ ($$$1 \le n,q \le 10^6$$$) — the length of array $$$a$$$ and the number of queries you have to perform. Each of the next $$$q$$$ lines contains the query given in the form described in the problem statement.

Print the answers to the queries of the third type on separate lines.

5 8
Color 2 4 2
Add 2 2
Query 3
Color 4 5 3
Color 2 2 3
Add 3 3
Query 2
Query 5

2 7
Add 1 7
Query 1
Add 2 4
Query 2
Color 1 1 1
Add 1 1
Query 2

NoteThe first sample test is explained below. Blue, red and green represent colors $$$1$$$, $$$2$$$ and $$$3$$$ respectively.

{-# LANGUAGE FlexibleContexts #-}
import Control.Monad
import Control.Monad.State
import Data.Array.Base
import Data.Array.IO
import Data.Bits
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap.Strict as IM

main :: IO ()
main = do
    ~[n, q] <- readInts
    pend <- newArray (1, n) 0 :: IO (IOUArray Int Int)
    ft <- newFT (1, n) :: IO (IOUArray Int Int)
    flip evalStateT (IM.singleton 1 1) $ replicateM_ q $ do
        qry <- lift $ parseInts . C.dropWhile (/=' ') <$> C.getLine
        case qry of
            [l, r, c] -> do
                modify' $ dup l . dup (r + 1)
                delRanges l =<< gets (IM.! l)
                modify' $ IM.insert l c
              where
                dup i m = let Just (_, c) = IM.lookupLE i m in IM.insert i c m
                delRanges i ci = do
                    Just (j, cj) <- gets $ IM.lookupGT i
                    lift $ do
                        d <- (-) <$> readArray pend ci <*> readArray pend c
                        updateFT ft i d >> updateFT ft j (-d)
                    when (j < r + 1) $ do
                        modify' $ IM.delete j
                        delRanges j cj
            [c, x] -> lift $ writeArray pend c . (+x) =<< readArray pend c
            [i] -> do
                Just (_, c) <- gets $ IM.lookupLE i
                lift $ print =<< ((+) <$> queryFT ft i <*> readArray pend c)
            _ -> error "!"

newFT :: MArray a Int m => (Int, Int) -> m (a Int Int)
newFT bnds = newArray bnds 0

updateFT :: MArray a Int m => a Int Int -> Int -> Int -> m ()
updateFT a i x = do
    (l, r) <- getBounds a
    let n = r - l + 1
        go j | j >= n = pure ()
        go j = unsafeRead a j >>= unsafeWrite a j . (+x) >> go (j .|. (j + 1))
    go (i - l)

queryFT :: MArray a Int m => a Int Int -> Int -> m Int
queryFT a i = do
    (l, _) <- getBounds a
    let go j acc | j < 0 = pure acc
        go j acc = do
            x <- unsafeRead a j
            let acc' = acc + x
            acc' `seq` go ((j .&. (j + 1)) - 1) acc'
    go (i - l) 0

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

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


Consider a tunnel on a one-way road. During a particular day, $$$n$$$ cars numbered from $$$1$$$ to $$$n$$$ entered and exited the tunnel exactly once. All the cars passed through the tunnel at constant speeds.A traffic enforcement camera is mounted at the tunnel entrance. Another traffic enforcement camera is mounted at the tunnel exit. Perfectly balanced.Thanks to the cameras, the order in which the cars entered and exited the tunnel is known. No two cars entered or exited at the same time.Traffic regulations prohibit overtaking inside the tunnel. If car $$$i$$$ overtakes any other car $$$j$$$ inside the tunnel, car $$$i$$$ must be fined. However, each car can be fined at most once.Formally, let's say that car $$$i$$$ definitely overtook car $$$j$$$ if car $$$i$$$ entered the tunnel later than car $$$j$$$ and exited the tunnel earlier than car $$$j$$$. Then, car $$$i$$$ must be fined if and only if it definitely overtook at least one other car.Find the number of cars that must be fined.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$), denoting the number of cars. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$), denoting the ids of cars in order of entering the tunnel. All $$$a_i$$$ are pairwise distinct. The third line contains $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$1 \le b_i \le n$$$), denoting the ids of cars in order of exiting the tunnel. All $$$b_i$$$ are pairwise distinct.

NoteThe first example is depicted below:Car $$$2$$$ definitely overtook car $$$5$$$, while car $$$4$$$ definitely overtook cars $$$1$$$, $$$2$$$, $$$3$$$ and $$$5$$$. Cars $$$2$$$ and $$$4$$$ must be fined.In the second example car $$$5$$$ was definitely overtaken by all other cars.In the third example no car must be fined.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}
#ifndef DEBUG
{-# LANGUAGE Safe              #-}
#endif

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.State.Strict
import qualified Data.Array                 as A
import qualified Data.Array.Unboxed         as UA
import qualified Data.Array.ST.Safe         as MA
import           Data.Bool
import qualified Data.ByteString.Builder    as B
import qualified Data.ByteString.Char8      as C
import           Data.Char
import           Data.Function
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import qualified Data.List                  as L
import qualified Data.List.NonEmpty         as NL
import           Data.Monoid
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup
import qualified Data.Set                   as S
import           Data.Tuple
import           Foreign
import qualified System.IO                  as IO
#ifdef DEBUG
import           Debug.Trace
#endif

main :: IO ()
main = do
    n <- readLn
    xs <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
    ys <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
    print $ solve n xs ys

solve :: Int -> [Int] -> [Int] -> Int
solve n xs ys = go IS.empty xs ys
  where
    go fined (x:xs) (y:ys)
        | x == y = go fined xs ys
        | IS.member x fined = go fined xs (y:ys)
        | otherwise = go (IS.insert y fined) (x:xs) ys
    go fined _ [] = IS.size fined


A set of points on a plane is called good, if for any two points at least one of the three conditions is true: those two points lie on same horizontal line;  those two points lie on same vertical line;  the rectangle, with corners in these two points, contains inside or on its borders at least one point of the set, other than these two. We mean here a rectangle with sides parallel to coordinates' axes, the so-called bounding box of the two points.You are given a set consisting of n points on a plane. Find any good superset of the given set whose size would not exceed 2·105 points.

The first line contains an integer n (1 ≤ n ≤ 104) — the number of points in the initial set. Next n lines describe the set's points. Each line contains two integers xi and yi ( - 109 ≤ xi, yi ≤ 109) — a corresponding point's coordinates. It is guaranteed that all the points are different.

Print on the first line the number of points m (n ≤ m ≤ 2·105) in a good superset, print on next m lines the points. The absolute value of the points' coordinates should not exceed 109. Note that you should not minimize m, it is enough to find any good superset of the given set, whose size does not exceed 2·105. All points in the superset should have integer coordinates.

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

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


Vova is playing a computer game. There are in total $$$n$$$ turns in the game and Vova really wants to play all of them. The initial charge of his laptop battery (i.e. the charge before the start of the game) is $$$k$$$.During each turn Vova can choose what to do:   If the current charge of his laptop battery is strictly greater than $$$a$$$, Vova can just play, and then the charge of his laptop battery will decrease by $$$a$$$;  if the current charge of his laptop battery is strictly greater than $$$b$$$ ($$$b<a$$$), Vova can play and charge his laptop, and then the charge of his laptop battery will decrease by $$$b$$$;  if the current charge of his laptop battery is less than or equal to $$$a$$$ and $$$b$$$ at the same time then Vova cannot do anything and loses the game. Regardless of Vova's turns the charge of the laptop battery is always decreases.Vova wants to complete the game (Vova can complete the game if after each of $$$n$$$ turns the charge of the laptop battery is strictly greater than $$$0$$$). Vova has to play exactly $$$n$$$ turns. Among all possible ways to complete the game, Vova wants to choose the one where the number of turns when he just plays (first type turn) is the maximum possible. It is possible that Vova cannot complete the game at all.Your task is to find out the maximum possible number of turns Vova can just play (make the first type turn) or report that Vova cannot complete the game.You have to answer $$$q$$$ independent queries.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 10^5$$$) — the number of queries. Each query is presented by a single line. The only line of the query contains four integers $$$k, n, a$$$ and $$$b$$$ ($$$1 \le k, n \le 10^9, 1 \le b < a \le 10^9$$$) — the initial charge of Vova's laptop battery, the number of turns in the game and values $$$a$$$ and $$$b$$$, correspondingly.

For each query print one integer: -1 if Vova cannot complete the game or the maximum number of turns Vova can just play (make the first type turn) otherwise.

NoteIn the first example query Vova can just play $$$4$$$ turns and spend $$$12$$$ units of charge and then one turn play and charge and spend $$$2$$$ more units. So the remaining charge of the battery will be $$$1$$$.In the second example query Vova cannot complete the game because even if he will play and charge the battery during each turn then the charge of the laptop battery will be $$$0$$$ after the last turn.

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)

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


You are given $$$n$$$ strings. Each string consists of lowercase English letters. Rearrange (reorder) the given strings in such a way that for every string, all strings that are placed before it are its substrings.String $$$a$$$ is a substring of string $$$b$$$ if it is possible to choose several consecutive letters in $$$b$$$ in such a way that they form $$$a$$$. For example, string "for" is contained as a substring in strings "codeforces", "for" and "therefore", but is not contained as a substring in strings "four", "fofo" and "rof".

The first line contains an integer $$$n$$$ ($$$1 \le n \le 100$$$) — the number of strings. The next $$$n$$$ lines contain the given strings. The number of letters in each string is from $$$1$$$ to $$$100$$$, inclusive. Each string consists of lowercase English letters. Some strings might be equal.

If it is impossible to reorder $$$n$$$ given strings in required order, print "NO" (without quotes). Otherwise print "YES" (without quotes) and $$$n$$$ given strings in required order.

NoteIn the second example you cannot reorder the strings because the string "abab" is not a substring of the string "abacaba".

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

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

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"