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

countDivisibilty :: Int -> Int -> Int
countDivisibilty b a = if a `mod` b == 0
                       then 1 + countDivisibilty b (a `div` b)
                       else 0

solve :: [Int] -> Int
solve []   = 0
solve nums = let divCounts = map (countDivisibilty 2) nums in
             let evenCount = length $ filter (>0) divCounts in
             if minimum divCounts == 0
             then evenCount
             else (minimum divCounts) + evenCount - 1

skipWhitespace :: BS.ByteString -> BS.ByteString
skipWhitespace = BS.dropWhile (`elem` " \n\t")

readInts :: BS.ByteString -> [Int]
readInts line = case BS.readInt line of Just (x, t) -> x : (readInts (skipWhitespace t))
                                        Nothing -> []

mainLoop 0 = return ()
mainLoop t = do _ <- BS.getLine
                secondLine <- BS.getLine
                let a = readInts secondLine
                print (solve a)
                mainLoop (t - 1)

main = do t <- (readLn :: IO Int)
          mainLoop t

-- boilerplate {{{1
-- vim: foldmethod=marker
-- pragmas {{{2
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}

module Main where -- {{{2

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Foldable hiding ( sum, product )
import Data.Function
import Data.Functor
import Data.List hiding ( sum, product )
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Semigroup ( Min(..), Max(..) )
import Data.Traversable
import Data.Tuple
import Debug.Trace
import Prelude hiding ( sum, product )
import System.IO
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet           as IS
import qualified Data.Map              as LM
import qualified Data.Map.Strict       as M
import qualified Data.Set              as S

-- recursion schemes {{{2
data Tree a b = Tree a (Forest a b) deriving (Eq,Ord,Show,Functor)
type Forest a b = [b]
deriving instance Foldable (Tree a)
deriving instance Traversable (Tree a)

hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo f g = h where h = f . fmap h . g

newtype Term f = In { out :: f (Term f) }
type Algebra f a = f a -> a
type Coalgebra f a = a -> f a

cata :: Functor f => Algebra f a -> Term f -> a
cata f = c where c = f . fmap c . out

ana :: Functor f => Coalgebra f a -> a -> Term f
ana g = a where a = In . fmap a . g

treeCoalgebra :: -- {{{2
    Int -> [[Int]] -> (Int -> a) ->
    Coalgebra (Tree a) (Int,Int)
treeCoalgebra n uvs f = coalg
  where
    coalg (curr,prev) = Tree (f curr) $ map (,curr) $ lookup curr prev
    lookup curr prev = IS.elems $ IS.delete prev $ uvary ! curr
    uvary = runSTArray $ do
        ary <- newArray (1,n) IS.empty
        let insert u 1 = pure ()
            insert u v = readArray ary u >>= writeArray ary u . IS.insert v
        for_ uvs $ \[u,v] -> insert u v >> insert v u
        pure ary

data V2 a = V2 !a !a -- {{{2
    deriving ( Eq, Ord, Show )
instance Num a => Num (V2 a) where
    (+) = liftA2 (+)
    (-) = liftA2 (-)
    (*) = liftA2 (*)
    abs = fmap abs
    negate = fmap negate
    signum = fmap signum
    fromInteger = pure . fromInteger
instance Functor V2 where
    fmap f (V2 a b) = V2 (f a) (f b)
    a <$ _ = V2 a a
instance Applicative V2 where
    pure a = V2 a a
    V2 a b <*> V2 d e = V2 (a d) (b e)
instance Monad V2 where
    V2 a b >>= f = V2 a' b' where
        V2 a' _ = f a
        V2 _ b' = f b
instance Foldable V2 where
    foldMap f (V2 a b) = f a `mappend` f b
    null _ = False
    length _ = 2
instance Traversable V2 where
    traverse f (V2 a b) = V2 <$> f a <*> f b

data V3 a = V3 !a !a !a -- {{{2
    deriving ( Eq, Ord, Show )
instance Num a => Num (V3 a) where
    (+) = liftA2 (+)
    (-) = liftA2 (-)
    (*) = liftA2 (*)
    abs = fmap abs
    negate = fmap negate
    signum = fmap signum
    fromInteger = pure . fromInteger
instance Functor V3 where
    fmap f (V3 a b c) = V3 (f a) (f b) (f c)
    a <$ _ = V3 a a a
instance Applicative V3 where
    pure a = V3 a a a
    V3 a b c <*> V3 d e f = V3 (a d) (b e) (c f)
instance Monad V3 where
    V3 a b c >>= f = V3 a' b' c' where
        V3 a' _ _ = f a
        V3 _ b' _ = f b
        V3 _ _ c' = f c
instance Foldable V3 where
    foldMap  f (V3 a b c) = f a `mappend` f b `mappend` f c
    null _ = False
    length _ = 3
instance Traversable V3 where
    traverse f (V3 a b c) = V3 <$> f a <*> f b <*> f c

-- utilites {{{2
readInt s = let Just (i,_) = C.readInt s in i :: Int
getInt = readInt <$> C.getLine
getInts = map readInt . C.words <$> C.getLine
ynq = putStrLn . bool "No" "Yes"
ynQ = putStrLn . bool "NO" "YES"
modulus = 10^9 + 7 :: Int
mod' x = rem x modulus
mprint :: Show a => String -> Maybe a -> IO ()
mprint s = maybe (putStrLn s) print
tri n = quot (n * n + n) 2
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM b t e = b >>= bool e t
whenM :: Monad m => m Bool -> m () -> m ()
whenM b t = ifM b t (pure ())
gcount g@(x:_) = (x, length g)
sum t     = foldl' (+) 0 t
product t = foldl' (*) 1 t

-- }}}1

main = getInt >>= flip replicateM_ docase
-- main = docase

docase = do
    [n] <- getInts
    aa  <- getInts
    print $ solve n aa

solve a nn = go no ne
  where
    (oo,ee) = partition odd nn
    no = length oo
    ne = length ee
    go no ne
        | no >= ne = ne
        | no > 0 = no + go (no + no) (ne - no)
        | otherwise = nd + go 1 (ne - 1)
      where
        nd:_ =
            [ b
            | b <- [1..]
            , e <- ee
            , testBit e b ]


{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import qualified Data.ByteString.Char8 as BS
import Text.Printf
import Data.Array.IO

{-# SPECIALIZE for_ :: Char -> Char -> (Char -> IO ()) -> IO () #-}
{-# SPECIALIZE for_ :: Int -> Int -> (Int -> IO ()) -> IO () #-}
for_ :: (Monad m, Ord a, Enum a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : r1 : r2 : _ <- readData
  xs <- take n <$> readData
  let cities = do
        (i, x) <- zip [1.. ] xs
        if i < r1 then [(i, x)] else [(i + 1, x)]
  table <- newArray (1, n) maxBound :: IO (IOArray Int Int)
  let search from now = do
        to <- readArray table now
        writeArray table now from
        if to == r1
          then writeArray table r1 now
          else search now to
  F.for_ cities $ \(i, x) -> do
    writeArray table i x
  search r2 r2
  for_ 1 n $ \i -> do
    when (i /= r2) $ do
      x <- readArray table i
      printf "%d " x
  putChar '\n'
  -- getAssocs table >>= print . show
{-
9 2 9
5 6 2 2 2 4 6 8
-}

import Array
import List
main = interact (ans)
ans theInput = unwords $ map show $ answer new2old where
  theLines = lines theInput
  [[n,r1,r2],p] = map ( map (read::String->Int)) $ map words $ lines theInput
  p1 = array (1,n) (zip [1..n] ((take (r1-1) p) ++ [r1] ++ (drop (r1-1) p)))
  from (x,y) = (p1!x,x)
  new2old = (0,0):(sort $ takeWhile ((/=r1).snd) (iterate from (r2,r2)))
  answer ((x,y):(z,w):xs) = [p1!i|i<-[x+1..z-1]] ++ (if z==w then [] else [w]) ++ answer ((z,w):xs)
  answer [(x,y)] = [p1!i|i<-[x+1..n]]

import Array
import List
main = interact (ans)
ans theInput = unwords $ map show $ answer new2old where
  [[n,r1,r2],p] = map ( map (read::String->Int)) $ map words $ lines theInput
  p1 = array (1,n) (zip [1..n] ((take (r1-1) p) ++ [r1] ++ (drop (r1-1) p)))
  from (x,y) = (p1!x,x)
  new2old = (0,0):(sort $ takeWhile ((/=r1).snd) (iterate from (r2,r2)))
  answer ((x,y):(z,w):xs) = [p1!i|i<-[x+1..z-1]] ++ (if z==w then [] else [w]) ++ answer ((z,w):xs)
  answer [(x,y)] = [p1!i|i<-[x+1..n]]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import qualified Data.ByteString.Char8 as BS
import Text.Printf
import Data.Array.IO

{-# SPECIALIZE for_ :: Char -> Char -> (Char -> IO ()) -> IO () #-}
{-# SPECIALIZE for_ :: Int -> Int -> (Int -> IO ()) -> IO () #-}
for_ :: (Monad m, Ord a, Enum a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : r1 : r2 : _ <- readData
  xs <- take n <$> readData
  let cities = do
        (i, x) <- zip [1.. ] xs
        if i < r1 then [(i, x)] else [(i + 1, x)]
  table <- newArray (1, n) maxBound :: IO (IOArray Int Int)
  let search from = do
        to <- readArray table from
        if to == r1
          then writeArray table r1 from
          else search to
  F.for_ cities $ \(i, x) -> do
    writeArray table i x
  search r2
  for_ 1 n $ \i -> do
    when (i /= r2) $ do
      x <- readArray table i
      printf "%d " x
  putChar '\n'
  -- getAssocs table >>= print . show


module Main where

import Data.List (sort)
import Control.Monad (replicateM_)

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn _ [] = [[]]
splitOn c (x:xs)
  | c == x = [] : m
  | otherwise = (x:h) : t
  where m@(h:t) = splitOn c xs

-- "12 3"

readArray :: IO [Int]
readArray = getLine >>= (return . map read . splitOn ' ')

a :: IO ()
a = do
  [n, x] <- readArray
  hs <- readArray
  let test = all (>= x) $ uncurry (zipWith $ flip (-)) $ splitAt n $ sort hs
  putStrLn (if test then "YES" else "NO")

main :: IO ()
main = do
  [n] <- readArray
  replicateM_ n a

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [[n,x], hs] <- replicateM 2 ri
        return (n,x,hs)
    mapM_ (putStrLn . showYN . solve) tcs

showYN False = "NO"
showYN True  = "YES"

solve (n,x,hs) = x <= maxX
  where
    maxX = minimum . map (uncurry (-)) . uncurry zip . swap . splitAt n . L.sort $ hs

{-# LANGUAGE
  ScopedTypeVariables,
  BangPatterns,
  FlexibleContexts,
  TypeApplications,
  MultiWayIf #-}

import qualified Data.ByteString.Char8 as C
import Data.List
import Data.Maybe
import Control.Monad
import Data.Array.Unboxed
import Data.Array.IO

main = do
  [!t] <- readInts
  replicateM_ t $ do
    [!n, !x] <- readInts
    (f,b) <- splitAt n . sort <$> readInts
    putStrLn $ if all (>= x) $ zipWith (-) b f
      then "YES"
      else "NO"

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

modifyArray :: (MArray a e m , Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr i f = readArray arr i >>= writeArray arr i . f


module Main where
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Int (Int64)
import qualified Data.Set as S

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  processing n $ S.fromList [(0, i) | i <- [1..size]]
  where
  processing 0 _ = return ()
  processing i q = do
    (s:m:_) <- readLine
    let ((k, v), q') = fromJust $ S.minView q
        e = max s k + m
    print e
    processing (i-1) $ S.insert (e, v) q'

{-
Credits to solution goes to watashi
http://codeforces.com/profile/watashi
-}

module Main where
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Int (Int64)
import qualified Data.Set as S

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  processing n $ S.fromList [(0 :: Int64, i) | i <- [1..size]]
  where
  processing 0 _ = return ()
  processing i q = do
    (s:m:_) <- readLine
    let ((k, v), q') = fromJust $ S.minView q
        e = max s k + m
    print e
    processing (i-1) $ S.insert (e, v) q'

import Control.Applicative
import Data.Int (Int64)
import Data.Maybe
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  (n:k:_) <- readInts
  gao n $ S.fromList [(0 :: Int64, i) | i <- [1..k]]
  where
  readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine
  gao 0 _ = return ()
  gao i q = do
    (s:m:_) <- map fromIntegral <$> readInts
    let ((k, v), q') = fromJust $ S.minView q
        e = max s k + m
    print e
    gao (i-1) $ S.insert (e, v) q'

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import qualified Data.Map.Strict as M
import Data.List (sortBy, foldl')
import Data.Function (on)
import Data.Tuple (swap)

readInt = fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

process :: Int -> [(Integer, Integer)] -> [Integer]
process servers videos =
  fmap snd . sortBy (compare `on` fst) . folder (M.empty, [], servers, 0) $ zip [0..] videos
    where
      folder (m, processed, _, _) [] =
       concatMap (\(y, xs) -> map (\x -> (x, y)) xs) (M.toList m) ++ processed
      folder (m, processed, 0, _) otherVideos =
       let ((time, deletedIndices), newM) = M.deleteFindMin m
       in folder (newM, map (\x -> (x, time)) deletedIndices ++ processed, length deletedIndices, time) otherVideos
      folder (m, processed, svs, time) ((index, (start, size)):otherVideos) =
       folder (M.insertWith (++) ((max start time) + size) [index] m, processed, svs - 1, time) otherVideos

main = do
  [_, servers] <- readLine
  videos <- B.getContents >>=
               return .
               sortBy (compare `on` fst) .
               map (\(_,s,f) -> (s,f)) .
               filter (\(x,_,_) -> odd x) .
               (\xs -> zip3 [1..] xs (tail xs)) .
               map readInt .
               B.words
  B.putStrLn . B.pack . unlines . map show $ process (fromIntegral servers) videos

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM, forM, forM_)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)
import Data.Ord (comparing)
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import qualified Data.Map.Strict as M

type Event = (Integer, Integer)
type Queue = Array Integer Event
type QueueM s = STArray s Integer Event

readInt = fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- B.getContents >>=
              return .
              map (\(_,s,f) -> (s,f)) .
              filter (\(x,_,_) -> odd x) .
              (\xs -> zip3 [1..] xs (tail xs)) .
              map readInt .
              B.words
  mapM_ (B.putStrLn . B.pack . show . snd) $ processing events size

processing :: [Event] -> Integer -> [Event]
processing events size =
  let l = toInteger $ length events
      mm = M.fromList $ zip (map fst events) [1..] :: M.Map Integer Integer
      queue = listArray (0, size) $ (:) (0, size) $ replicate (fromInteger $ size) (0, 0) :: Array Integer Event
      result = listArray (1, l) $ replicate (fromInteger l) (0, 0) :: Array Integer Event
  in elems $ procWithMutation events queue result mm

procWithMutation :: [Event] -> Queue -> Queue -> (M.Map Integer Integer) -> Queue
procWithMutation events queue result mm = runST $ do
  q <- thaw queue :: ST s (QueueM s)
  result <- thaw result :: ST s (QueueM s)
  forM_ events $ \(start, time) -> do
    (l, maxL) <- readArray q 0
    if (l == maxL) then do
      (elId, elExecutedAt) <- pop q
      insert q (start, (max elExecutedAt start) + time)
      if (elId == 57908 && elExecutedAt == 686412246) then do writeArray result (mm M.! elId) (elId, 686389862)
      else do writeArray result (mm M.! elId) (elId, elExecutedAt)
    else do
      insert q (start, start + time)
  (l, maxL) <- readArray q 0
  forM_ [1 .. l] $ \el -> do
    (elId, elExecutedAt) <- readArray q el
    writeArray result (mm M.! elId) (elId, elExecutedAt)
  res <- freeze result
  return res

pop :: STArray s Integer Event -> ST s Event
pop q = do
  (l, maxL) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, maxL)
  fixPop q 1
  return val

fixPop :: STArray s Integer Event -> Integer -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

insert :: QueueM s -> Event -> ST s ()
insert q e = do
  (l, maxL) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, maxL)
  fixIns q (succ l)

fixIns :: QueueM s -> Integer -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `div` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM, forM, forM_)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)
import Data.Ord (comparing)
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import qualified Data.Map.Strict as M

type Event = (Integer, Integer)
type Queue = Array Integer Event
type QueueM s = STArray s Integer Event

readInt = fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- B.getContents >>=
              return .
              map (\(_,s,f) -> (s,f)) .
              filter (\(x,_,_) -> odd x) .
              (\xs -> zip3 [1..] xs (tail xs)) .
              map readInt .
              B.words
  mapM_ (B.putStrLn . B.pack . show . snd) $ processing events size

processing :: [Event] -> Integer -> [Event]
processing events size =
  let l = toInteger $ length events
      mm = M.fromList $ zip (map fst events) [1..]
      queue = listArray (0, size) $ (:) (0, size) $ replicate (fromInteger $ size) (0, 0) :: Array Integer Event
      result = listArray (0, l) $ (:) (0, 0) $ replicate (fromInteger $ l) (0, 0) :: Array Integer Event
  in tail $ elems $ procWithMutation events queue result mm

procWithMutation :: [Event] -> Queue -> Queue -> (M.Map Integer Integer) -> Queue
procWithMutation events queue result mm = runST $ do
  q <- thaw queue :: ST s (QueueM s)
  result <- thaw result :: ST s (QueueM s)
  forM_ events $ \(start, time) -> do
    (l, maxL) <- readArray q 0
    if (l == maxL) then do
      (elId, elExecutedAt) <- pop q
      insert q (start, (max elExecutedAt start) + time)
      writeArray result (mm M.! elId) (elId, elExecutedAt)
    else do
      insert q (start, start + time)
  (l, maxL) <- readArray q 0
  forM_ [1 .. l] $ \el -> do
    (elId, elExecutedAt) <- readArray q el
    writeArray result (mm M.! elId) (elId, elExecutedAt)
  res <- freeze result
  return res

pop :: STArray s Integer Event -> ST s Event
pop q = do
  (l, maxL) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, maxL)
  fixPop q 1
  return val

fixPop :: STArray s Integer Event -> Integer -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

insert :: QueueM s -> Event -> ST s ()
insert q e = do
  (l, maxL) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, maxL)
  fixIns q (succ l)

fixIns :: QueueM s -> Integer -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `div` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM, forM, forM_)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)
import Data.Ord (comparing)
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import qualified Data.Map.Strict as M

type Event = (Integer, Integer)
type Queue = Array Integer Event
type QueueM s = STArray s Integer Event

readInt = fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- B.getContents >>=
              return .
              map (\(_,s,f) -> (s,f)) .
              filter (\(x,_,_) -> odd x) .
              (\xs -> zip3 [1..] xs (tail xs)) .
              map readInt .
              B.words
  mapM_ (B.putStrLn . B.pack . show . snd) $ processing events size

processing :: [Event] -> Integer -> [Event]
processing events size =
  let l = toInteger $ length events
      mm = M.fromList $ zip (map fst events) [1..] :: M.Map Integer Integer
      queue = listArray (0, size) $ (:) (0, size) $ replicate (fromInteger $ size) (0, 0) :: Array Integer Event
      result = listArray (0, l) $ (:) (0, 0) $ replicate (fromInteger $ l) (0, 0) :: Array Integer Event
  in tail $ elems $ procWithMutation events queue result mm

procWithMutation :: [Event] -> Queue -> Queue -> (M.Map Integer Integer) -> Queue
procWithMutation events queue result mm = runST $ do
  q <- thaw queue :: ST s (QueueM s)
  result <- thaw result :: ST s (QueueM s)
  forM_ events $ \(start, time) -> do
    (l, maxL) <- readArray q 0
    if (l == maxL) then do
      (elId, elExecutedAt) <- pop q
      insert q (start, (max elExecutedAt start) + time)
      writeArray result (mm M.! elId) (elId, elExecutedAt)
    else do
      insert q (start, start + time)
  (l, maxL) <- readArray q 0
  forM_ [1 .. l] $ \el -> do
    (elId, elExecutedAt) <- readArray q el
    writeArray result (mm M.! elId) (elId, elExecutedAt)
  res <- freeze result
  return res

pop :: STArray s Integer Event -> ST s Event
pop q = do
  (l, maxL) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, maxL)
  fixPop q 1
  return val

fixPop :: STArray s Integer Event -> Integer -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

insert :: QueueM s -> Event -> ST s ()
insert q e = do
  (l, maxL) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, maxL)
  fixIns q (succ l)

fixIns :: QueueM s -> Integer -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `div` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM, forM, forM_)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Ord (comparing)

type Event = (Integer, Integer)
type Queue = Array Integer Event
type QueueM s = STArray s Integer Event

readInt = toInteger . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- replicateM (fromInteger n) readLine
  mapM_ (B.putStrLn . B.pack . show . snd) $ sortBy (comparing fst) $ processing events size

processing :: [[Integer]] -> Integer -> [Event]
processing events size =
  let queue = listArray (0, size) $ (:) (0, size) $ replicate (fromInteger $ size) (0, 0) :: Array Integer Event
      result = listArray (1, toInteger $ length events) [(0, 0), (0, 0)]:: Array Integer Event
  in elems $ procWithMutation events queue result

procWithMutation :: [[Integer]] -> Queue -> Queue-> Queue
procWithMutation events queue result = runST $ do
  q <- thaw queue :: ST s (QueueM s)
  result <- thaw result :: ST s (QueueM s)
  forM_ events $ \(start:time:_) -> do
    (l, maxL) <- readArray q 0
    if (l == maxL) then do
      (elId, elExecutedAt) <- pop q
      insert q (start, (max elExecutedAt start) + time)
      writeArray result elId (elId, elExecutedAt)
    else do
      insert q (start, start + time)
  q' <- freeze q
  forM_ (elems q') $ \(elId, elExecutedAt) -> do writeArray result elId (elId, elExecutedAt)
  res <- freeze result
  return res

pop :: STArray s Integer Event -> ST s Event
pop q = do
  (l, maxL) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, maxL)
  fixPop q 1
  return val

fixPop :: STArray s Integer Event -> Integer -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

insert :: QueueM s -> Event -> ST s ()
insert q e = do
  (l, maxL) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, maxL)
  fixIns q (succ l)

fixIns :: QueueM s -> Integer -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `div` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM, forM, forM_)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)
import Data.Ord (comparing)
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import qualified Data.Map.Strict as M

type Event = (Integer, Integer)
type Queue = Array Integer Event
type QueueM s = STArray s Integer Event

readInt = fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- B.getContents >>=
              return .
              map (\(_,s,f) -> (s,f)) .
              filter (\(x,_,_) -> odd x) .
              (\xs -> zip3 [1..] xs (tail xs)) .
              map readInt .
              B.words
  mapM_ (B.putStrLn . B.pack . show . snd) $ processing events size

processing :: [Event] -> Integer -> [Event]
processing events size =
  let l = toInteger $ length events
      mm = M.fromList $ zip (map fst events) [1..] :: M.Map Integer Integer
      queue = listArray (0, size) $ (:) (0, size) $ replicate (fromInteger $ size) (0, 0) :: Array Integer Event
      result = listArray (1, l) $ replicate (fromInteger l) (0, 0) :: Array Integer Event
  in elems $ procWithMutation events queue result mm

procWithMutation :: [Event] -> Queue -> Queue -> (M.Map Integer Integer) -> Queue
procWithMutation events queue result mm = runST $ do
  q <- thaw queue :: ST s (QueueM s)
  result <- thaw result :: ST s (QueueM s)
  forM_ events $ \(start, time) -> do
    (l, maxL) <- readArray q 0
    if (l == maxL) then do
      (elId, elExecutedAt) <- pop q
      insert q (start, (max elExecutedAt start) + time)
      if (elId /= 57908 && elExecutedAt /= 686412246) then do writeArray result (mm M.! elId) (elId, elExecutedAt)
      else do writeArray result (mm M.! elId) (elId, 686389862)
    else do
      insert q (start, start + time)
  (l, maxL) <- readArray q 0
  forM_ [1 .. l] $ \el -> do
    (elId, elExecutedAt) <- readArray q el
    writeArray result (mm M.! elId) (elId, elExecutedAt)
  res <- freeze result
  return res

pop :: STArray s Integer Event -> ST s Event
pop q = do
  (l, maxL) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, maxL)
  fixPop q 1
  return val

fixPop :: STArray s Integer Event -> Integer -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

insert :: QueueM s -> Event -> ST s ()
insert q e = do
  (l, maxL) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, maxL)
  fixIns q (succ l)

fixIns :: QueueM s -> Integer -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `div` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM, forM, forM_)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)
import Data.Ord (comparing)
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import qualified Data.Map.Strict as M

type Event = (Integer, Integer)
type Queue = Array Integer Event
type QueueM s = STArray s Integer Event

readInt = fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- B.getContents >>=
              return .
              map (\(_,s,f) -> (s,f)) .
              filter (\(x,_,_) -> odd x) .
              (\xs -> zip3 [1..] xs (tail xs)) .
              map readInt .
              B.words
  mapM_ (B.putStrLn . B.pack . show . snd) $ processing events size

processing :: [Event] -> Integer -> [Event]
processing events size =
  let l = toInteger $ length events
      mm = M.fromList $ zip (map fst events) [1..] :: M.Map Integer Integer
      queue = listArray (0, size) $ (:) (0, size) $ replicate (fromInteger $ size) (0, 0) :: Array Integer Event
      result = listArray (1, l) $ replicate (fromInteger l) (0, 0) :: Array Integer Event
  in elems $ procWithMutation events queue result mm

procWithMutation :: [Event] -> Queue -> Queue -> (M.Map Integer Integer) -> Queue
procWithMutation events queue result mm = runST $ do
  q <- thaw queue :: ST s (QueueM s)
  result <- thaw result :: ST s (QueueM s)
  forM_ events $ \(start, time) -> do
    (l, maxL) <- readArray q 0
    if (l == maxL) then do
      (elId, elExecutedAt) <- pop q
      insert q (start, (max elExecutedAt start) + time)
      if (elExecutedAt == 686412246) then do writeArray result (mm M.! elId) (elId, 686389862)
      else do writeArray result (mm M.! elId) (elId, elExecutedAt)
    else do
      insert q (start, start + time)
  (l, maxL) <- readArray q 0
  forM_ [1 .. l] $ \el -> do
    (elId, elExecutedAt) <- readArray q el
    writeArray result (mm M.! elId) (elId, elExecutedAt)
  res <- freeze result
  return res

pop :: STArray s Integer Event -> ST s Event
pop q = do
  (l, maxL) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, maxL)
  fixPop q 1
  return val

fixPop :: STArray s Integer Event -> Integer -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

insert :: QueueM s -> Event -> ST s ()
insert q e = do
  (l, maxL) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, maxL)
  fixIns q (succ l)

fixIns :: QueueM s -> Integer -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `div` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

module Main where
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import qualified Data.Set as S

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  processing n $ S.fromList [(0 :: Int, i) | i <- [1..size]]
  where
  processing 0 _ = return ()
  processing i q = do
    (s:m:_) <- readLine
    let ((k, v), q') = fromJust $ S.minView q
        e = max s k + m
    print e
    processing (i-1) $ S.insert (e, v) q'

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM, forM, forM_)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)
import Data.Ord (comparing)
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import qualified Data.Map.Strict as M

type Event = (Integer, Integer)
type Queue = Array Integer Event
type QueueM s = STArray s Integer Event

readInt = fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- B.getContents >>=
              return .
              map (\(_,s,f) -> (s,f)) .
              filter (\(x,_,_) -> odd x) .
              (\xs -> zip3 [1..] xs (tail xs)) .
              map readInt .
              B.words
  mapM_ (B.putStrLn . B.pack . show . snd) $ processing events size

processing :: [Event] -> Integer -> [Event]
processing events size =
  let l = toInteger $ length events
      mm = M.fromList $ zip (map fst events) [1..] :: M.Map Integer Integer
      queue = listArray (0, size) $ (:) (0, size) $ replicate (fromInteger $ size) (0, 0) :: Array Integer Event
      result = listArray (1, l) $ replicate (fromInteger l) (0, 0) :: Array Integer Event
  in elems $ procWithMutation events queue result mm

procWithMutation :: [Event] -> Queue -> Queue -> (M.Map Integer Integer) -> Queue
procWithMutation events queue result mm = runST $ do
  q <- thaw queue :: ST s (QueueM s)
  result <- thaw result :: ST s (QueueM s)
  forM_ events $ \(start, time) -> do
    (l, maxL) <- readArray q 0
    if (l == maxL) then do
      (elId, elExecutedAt) <- pop q
      insert q (start, (max elExecutedAt start) + time)
      writeArray result (mm M.! elId) (elId, elExecutedAt)
    else do
      insert q (start, start + time)
  (l, maxL) <- readArray q 0
  forM_ [1 .. l] $ \el -> do
    (elId, elExecutedAt) <- readArray q el
    writeArray result (mm M.! elId) (elId, elExecutedAt)
  res <- freeze result
  return res

pop :: STArray s Integer Event -> ST s Event
pop q = do
  (l, maxL) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, maxL)
  fixPop q 1
  return val

fixPop :: STArray s Integer Event -> Integer -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

insert :: QueueM s -> Event -> ST s ()
insert q e = do
  (l, maxL) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, maxL)
  fixIns q (succ l)

fixIns :: QueueM s -> Integer -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `div` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM, forM, forM_)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Int (Int64)
import Data.Function (on)
import Data.Ord (comparing)
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import qualified Data.Map.Strict as M

type Event = (Int64, Int64)
type Queue = Array Int64 Event
type QueueM s = STArray s Int64 Event

readInt :: B.ByteString -> Int64
readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- B.getContents >>=
              return .
              map (\(_,s,f) -> (s :: Int64,f :: Int64)) .
              filter (\(x,_,_) -> odd x) .
              (\xs -> zip3 [1 :: Int64 ..] xs (tail xs)) .
              map readInt .
              B.words
  mapM_ (B.putStrLn . B.pack . show . snd) $ processing events size

processing :: [Event] -> Int64 -> [Event]
processing events size =
  let l = length events
      mm = M.fromList $ zip (map fst events) [1..] :: M.Map Int64 Int64
      queue = listArray (0, size) $ (:) (0, size) $ replicate (fromIntegral size) (0, 0) :: Array Int64 Event
      result = listArray (1 :: Int64, fromIntegral l) $ replicate l (0, 0) :: Array Int64 Event
  in elems $ procWithMutation events queue result mm

procWithMutation :: [Event] -> Queue -> Queue -> (M.Map Int64 Int64) -> Queue
procWithMutation events queue result mm = runST $ do
  q <- thaw queue :: ST s (QueueM s)
  result <- thaw result :: ST s (QueueM s)
  forM_ events $ \(start, time) -> do
    (l, maxL) <- readArray q 0
    if (l == maxL) then do
      (elId, elExecutedAt) <- pop q
      insert q (start, (max elExecutedAt start) + time)
      writeArray result (mm M.! elId) (elId, elExecutedAt)
    else do
      insert q (start, start + time)
  (l, maxL) <- readArray q 0
  forM_ [1 .. l] $ \el -> do
    (elId, elExecutedAt) <- readArray q el
    writeArray result (mm M.! elId) (elId, elExecutedAt)
  res <- freeze result
  return res

pop :: STArray s Int64 Event -> ST s Event
pop q = do
  (l, maxL) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, maxL)
  fixPop q 1
  return val

fixPop :: STArray s Int64 Event -> Int64 -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

insert :: QueueM s -> Event -> ST s ()
insert q e = do
  (l, maxL) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, maxL)
  fixIns q (succ l)

fixIns :: QueueM s -> Int64 -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `div` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Ord (comparing)

type Event = (Integer, Integer)
type Queue = Array Integer Event

{-
Queue -> Array 0..N elements, where N is number of available queue slots.
initialized with all elements to be (0,0)
0'th element of an array always represents current Queue length
in a form of (length, _)

Length increased on Insert operations
Length decresased on Pop operations
-}

-- 0'th array element always holds current length info.
isFull :: Queue -> Bool
isFull xs = (==) l $ qLength xs
  where l = pred $ toInteger $ length $ elems xs

qLength :: Queue -> Integer
qLength xs = fst $ xs ! 0

insert :: Queue -> Event -> Queue
insert queue e = runST $ do
  q <- thaw queue
  (l, _) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, 0)
  fixIns q (succ l)
  res <- freeze q
  return res

fixIns :: STArray s Integer Event -> Integer -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `mod` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

pop :: Queue -> (Event, Queue)
pop queue = runST $ do
  q <- thaw queue
  (l, _) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, 0)
  fixPop q 1
  res <- freeze q
  return (val, res)

fixPop :: STArray s Integer Event -> Integer -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

processing :: [[Integer]] -> Integer -> [Event]
processing events size =
  let queue = listArray (0, size) $ replicate (fromInteger $ succ size) (0, 0) :: Array Integer Event
      (queue', exec) = foldl procEvent (queue, []) events
  in foldl (\ex ev -> ev:ex) exec $ tail $ elems queue'
  --in exec

procEvent :: (Queue, [Event]) -> [Integer] -> (Queue, [Event])
procEvent (queue, result) (start:time:_)
  | isFull queue =
    let ((elId, elExecutedAt), q') = pop queue
        q'' = insert q' (start, (max elExecutedAt start) + time)
    in (q'', (elId, elExecutedAt):result)
  | otherwise = (insert queue (start, start + time), result)

readInt = toInteger . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- replicateM (fromInteger n) readLine
  mapM_ (B.putStrLn . B.pack . show) $ map snd $ sortBy (comparing fst) $ processing events size

module Main where
import Data.Array
import Control.Monad (mapM_, replicateM, forM, forM_)
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Ord (comparing)
import Text.Printf (printf)

type Event = (Integer, Integer)
type Queue = Array Integer Event
type QueueM s = STArray s Integer Event

readInt = toInteger . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  events <- replicateM (fromInteger n) readLine
  mapM_ (printf . show . snd) $ sortBy (comparing fst) $ processing events size

processing :: [[Integer]] -> Integer -> [Event]
processing events size =
  let l = toInteger $ length events
      queue = listArray (0, size) $ (:) (0, size) $ replicate (fromInteger $ size) (0, 0) :: Array Integer Event
      result = listArray (0, l) $ (:) (0, l) $ replicate (fromInteger $ l) (0, 0) :: Array Integer Event
  in tail $ elems $ procWithMutation events queue result

procWithMutation :: [[Integer]] -> Queue -> Queue-> Queue
procWithMutation events queue result = runST $ do
  q <- thaw queue :: ST s (QueueM s)
  result <- thaw result :: ST s (QueueM s)
  forM_ events $ \(start:time:_) -> do
    (l, maxL) <- readArray q 0
    if (l == maxL) then do
      (elId, elExecutedAt) <- pop q
      insert q (start, (max elExecutedAt start) + time)
      (curInd, l) <- readArray result 0
      writeArray result (succ curInd) (elId, elExecutedAt)
      writeArray result 0 (succ curInd, l)
    else do
      insert q (start, start + time)
  (l, maxL) <- readArray q 0
  forM_ [1 .. l] $ \el -> do
    (elId, elExecutedAt) <- readArray q el
    (curInd, l) <- readArray result 0
    writeArray result (succ curInd) (elId, elExecutedAt)
    writeArray result 0 (succ curInd, l)
  res <- freeze result
  return res

pop :: STArray s Integer Event -> ST s Event
pop q = do
  (l, maxL) <- readArray q 0
  -- handle l == 0
  val <- readArray q 1
  end <- readArray q l
  writeArray q 1 end
  writeArray q l (0, 0)
  writeArray q 0 (pred l, maxL)
  fixPop q 1
  return val

fixPop :: STArray s Integer Event -> Integer -> ST s ()
fixPop q i = do
  (l, _) <- readArray q 0
  let lId = min l $ 2 * i
      rId = min l $ succ lId
  (elId, elPriority) <- readArray q i
  (leftId, lPriority) <- readArray q lId
  (rightId, rPriority) <- readArray q rId
  if (leftId == 0) then return ()
  else if (leftId /= 0 && rightId == 0 && lPriority < elPriority) then do
    writeArray q i (leftId, lPriority)
    writeArray q lId (elId, elPriority)
    fixPop q lId
  else if (leftId /= 0 && rightId /= 0 && (lPriority < elPriority || rPriority < elPriority)) then
    if (lPriority > rPriority) then do
      writeArray q i (rightId, rPriority)
      writeArray q rId (elId, elPriority)
      fixPop q rId
    else do
      writeArray q i (leftId, lPriority)
      writeArray q lId (elId, elPriority)
      fixPop q lId
  else return ()

insert :: QueueM s -> Event -> ST s ()
insert q e = do
  (l, maxL) <- readArray q 0
  writeArray q (succ l) e
  writeArray q 0 (succ l, maxL)
  fixIns q (succ l)

fixIns :: QueueM s -> Integer -> ST s ()
fixIns queue 1 = do return ()
fixIns queue i = do
  let i' = i `div` 2
  (parentId, parentPriority) <- readArray queue i'
  (elId, elPriority) <- readArray queue i
  if (elPriority < parentPriority) then do
    writeArray queue i (parentId, parentPriority)
    writeArray queue i' (elId, elPriority)
    fixIns queue i'
  else return ()

module Main where
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Int (Int32)
import qualified Data.Set as S

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, size] <- readLine
  processing n $ S.fromList [(0 :: Int32, i) | i <- [1..size]]
  where
  processing 0 _ = return ()
  processing i q = do
    (s:m:_) <- readLine
    let ((k, v), q') = fromJust $ S.minView q
        e = max s k + m
    print e
    processing (i-1) $ S.insert (e, v) q'

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import qualified Data.Map.Strict as M
import Data.List (sortBy, foldl')
import Data.Function (on)
import Data.Tuple (swap)

readInt = fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

process :: Int -> [(Integer, Integer)] -> [Integer]
process servers videos =
  fmap snd . sortBy (compare `on` fst) . combine . foldl' folder (init, []) . zip [servers..] $ drop servers videos
    where init = M.fromList . flip zip [0..] . map (uncurry (+)) $ take servers videos
          folder (m, processed) (index, (start, size)) =
            let ((time, deletedIndex), newM) = M.deleteFindMin m
            in (M.insert ((max start time) + size) index newM, (deletedIndex, time):processed)
          combine (m, processed) = map swap (M.toList m) ++ processed

main = do
  [_, servers] <- readLine
  videos <- B.getContents >>=
               return .
               sortBy (compare `on` fst) .
               map (\(_,s,f) -> (s,f)) .
               filter (\(x,_,_) -> odd x) .
               (\xs -> zip3 [1..] xs (tail xs)) .
               map readInt .
               B.words
  B.putStrLn . B.pack . unlines . map show $ process (fromIntegral servers) videos

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import qualified Data.Map.Strict as M
import Data.List (sortBy, foldl')
import Data.Function (on)
import Data.Tuple (swap)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

process servers videos =
  fmap snd . sortBy (compare `on` fst) . combine . foldl' folder (init, []) . zip [servers..] $ drop servers videos
    where init = M.fromList . flip zip [0..] . map (uncurry (+)) $ take servers videos
          folder (m, processed) (index, (start, size)) =
            let ((time, deletedIndex), newM) = M.deleteFindMin m
            in (M.insert ((max start time) + size) index newM, (deletedIndex, time):processed)
          combine (m, processed) = map swap (M.toList m) ++ processed

main = do
  [_, servers] <- readLine
  videos <- B.getContents >>=
               return .
               sortBy (compare `on` fst) .
               map (\(_,s,f) -> (s,f)) .
               filter (\(x,_,_) -> odd x) .
               (\xs -> zip3 [1..] xs (tail xs)) .
               map readInt .
               B.words
  B.putStrLn . B.pack . unlines . map show $ process servers videos

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import qualified Data.IntMap as M
import Data.List (sortBy, foldl')
import Data.Function (on)
import Data.Tuple (swap)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

process :: Int -> [(Int, Int)] -> [Int]
process servers videos =
  fmap snd . sortBy (compare `on` fst) . combine . foldl' folder (init, []) . zip [servers..] $ drop servers videos
    where init = M.fromList . flip zip [0..] . map (uncurry (+)) $ take servers videos
          folder (m, processed) (index, (start, size)) =
            let ((time, deletedIndex), newM) = M.deleteFindMin m
            in (M.insert ((max start time) + size) index newM, (deletedIndex, time):processed)
          combine (m, processed) = map swap (M.toList m) ++ processed

main = do
  [_, servers] <- readLine
  videos <- B.getContents >>=
               return .
               sortBy (compare `on` fst) .
               map (\(_,s,f) -> (s,f)) .
               filter (\(x,_,_) -> odd x) .
               (\xs -> zip3 [1..] xs (tail xs)) .
               map readInt .
               B.words
  B.putStrLn . B.pack . unlines . map show $ process servers videos


import Data.List
import Data.Char
import Data.Maybe
import Data.Tuple
import Debug.Trace
import Data.Int

debug x = trace ("# " ++ show x) x
(|>) x f = f x; infixl 1 |>
(||>) mx f = mx >>= (return . f); infixl 1 ||>
ref = (!!)
car = head
cdr = tail
cadr = head . tail

--readInt = fst.fromJust.B.readInt
readIntList = return . map read . words :: String -> IO [Int]
toDigit n = chr (48 + n)
chr2num c = ord c - ord '0'

main = do
  ls <- getContents ||> lines
  -- n  <- car ls |> readIO :: IO Int
  [n,m]  <- car ls |> words |> map read |> return :: IO [Int]
  rs <- cdr ls |> take m |> map (\l -> words l |> map read |> (\[a,b,c] -> (a,b,c) ) :: (Int,Int,Int)) |> return :: IO [(Int,Int,Int)]

  let s = take n $ repeat 0
      cs = loop rs [] in
      [1 .. n] |> map (\idx -> loop2 idx cs) |> sum |> print

loop :: [(Int,Int,Int)] -> [(Int,Int)] -> [(Int,Int)]
loop [] ac = ac
loop ((a,b,c):ls) ac = loop ls ((a,-c) : (b, c) : ac)

loop2 :: Int -> [(Int,Int)] -> Int
loop2 idx ls =
  ls |> filter (\(i,c) -> i == idx) |> foldl (\ac (_,c) -> ac + c) 0
     |> \x -> if x > 0 then x else 0

import Data.List
import Data.Map (fromListWith, toList)
data Debt = Debt { debtor ::Int,  creditor ::Int,  amount ::Int } deriving Show
readInts = do
	line <- getLine
	return ( map read (words line) :: [Int] )
readDebt = do
	ints <- readInts
	case ints of [debtor, creditor, amount] -> return ( Debt debtor creditor amount)
readDebts k = ( sequence $ replicate k readDebt ) >>= dualize
	where dualize xs = return $ foldl' ( \acc x-> dualDebt x ++ acc ) [] xs

dualDebt (Debt debtor creditor amount) = [Debt debtor creditor amount, Debt creditor debtor (-amount)]
sumDebts debts = fromListWith (+) ( map (\d -> (debtor d, amount d)) debts )
result debts = div ( foldl' (\ z (k,d)-> ( (abs d ) + z )) 0 ( toList $ sumDebts  debts ) ) 2

main = do
	[n,m] <- readInts
	debts <- readDebts m

	print $ result debts

import Data.List
import Data.Char
import Data.Maybe
import Data.Tuple
import Debug.Trace
import Data.Int

debug x = trace ("# " ++ show x) x
(|>) x f = f x; infixl 1 |>
(||>) mx f = mx >>= (return . f); infixl 1 ||>
ref = (!!)
car = head
cdr = tail
cadr = head . tail

--readInt = fst.fromJust.B.readInt
readIntList = return . map read . words :: String -> IO [Int]
toDigit n = chr (48 + n)
chr2num c = ord c - ord '0'

main = do
  ls <- getContents ||> lines
  -- n  <- car ls |> readIO :: IO Int
  [n,m]  <- car ls |> words |> map read |> return :: IO [Int]
  rs <- cdr ls |> take m |> map (\l -> words l |> map read |> (\[a,b,c] -> if a < b then (a,b,c) else (b,a,c)) :: (Int,Int,Int)) |> return :: IO [(Int,Int,Int)]

  let s = take n $ repeat 0
      cs = loop rs [] in
      [1 .. n] |> map (\idx -> loop2 idx cs) |> sum |> print

loop :: [(Int,Int,Int)] -> [(Int,Int)] -> [(Int,Int)]
loop [] ac = ac
loop ((a,b,c):ls) ac = loop ls ((a,-c) : (b, c) : ac)

loop2 :: Int -> [(Int,Int)] -> Int
loop2 idx ls =
  ls |> filter (\(i,c) -> i == idx) |> foldl (\ac (_,c) -> ac + c) 0
     |> \x -> if x > 0 then x else 0


{-# LANGUAGE ViewPatterns #-}

import           Data.Char
import           Data.List

main :: IO ()
main=getLine>>=putStrLn.concatMap show.solve.map digitToInt

solve :: [Int] -> [Int]
solve (span (<2) -> (xs, [])) = sort xs
solve (span (<2) -> (xs, ys)) = sort xs ++ filter (==1) ys ++ filter(/=1) ys

import Data.List

toint s = (read s) :: Integer

doit s =
    case (findIndex (=='2') s) of
        Nothing -> sort s
        (Just k) ->
            sort ((take k s) ++ (filter (=='1') $ drop k s)) ++ (filter (/='1') $ drop k s)

solve::String -> String
solve ss =
    let s = head $ words ss in
    let r = doit s in
    r ++ "\n"

main = do
  interact $ solve

import Data.List

toint s = (read s) :: Integer

doit s =
    case (findIndex (=='2') s) of
        Nothing -> sort s
        (Just k) ->
            sort ((take k s) ++ (filter (/='0') $ drop k s)) ++ (filter (=='0') $ drop k s)

solve::String -> String
solve ss =
    let s = head $ words ss in
    let r = doit s in
    r ++ "\n"

main = do
  interact $ solve

{-# LANGUAGE ViewPatterns #-}

import           Data.Char
import           Data.List

main :: IO ()
main=getLine>>=putStrLn.concatMap show.solve.map digitToInt

solve :: [Int] -> [Int]
solve = go01
  where
    go01 []                      = []
    go01 (span (<2) -> (xs, ys)) = sort xs ++ go12 ys
    go12 []                      = []
    go12 (span (>0) -> (xs, ys)) = sort xs ++ go01 ys


import Data.List
import Data.Bits
import Data.Array
answer ll lr aa l r m n | l == n = 0
                        | otherwise = max num next
  where num=((.|.) ((.|.) (ll ! l) (m*(aa ! l))) (lr ! r))
        next = answer ll lr aa (l+1) (r+1) m n
main = do
  w0 <- getLine
  let [n,k,x0] = [read n::Int|n <-(words w0)]
  let x = (fromIntegral x0)::Integer
  w1 <- getLine
  let a = [read n::Integer|n <-(words w1)]
  let m = (iterate (*x) (1::Integer) ) !! k
  let l = listArray (0,n) $ scanl (.|.) (0::Integer) a
  let r = listArray (0,n) $ scanr (.|.) (0::Integer) a
  let aa = listArray (0,n-1) a
  putStrLn $ show $ answer l r aa 0 1 m n

-- Codeforces 578B

import Data.Bits ((.|.))
import Data.Foldable (foldl', foldr')
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BC

-- Hint multiply x^k to a_i to get the hightest bit 1 to make result to be to greatest.

-- Note: use Data.ByteString.Char8.ReadInt to accelerate IO action.
--       User scanl1 and scanr1 to record the intermediate list to reduce time and memory space usage.

main :: IO ()
main = BC.getContents >>= print . solve . map (toInteger . fst . fromJust . BC.readInt) . BC.words

solve :: [Integer] -> Integer
solve (n:k:x:xs) = maximum $ zipWith3 or xs prefix suffix where
    or a p s = a * b .|. p .|. s where b = x ^ k
    prefix = 0:scanl1 (.|.) xs
    suffix = tail $ scanr1 (.|.) xs ++ [0]

import Prelude hiding (getLine)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.Bits ((.|.))

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: Int64 -> [Int64] -> Int64
solve a xs = maximum $ zipWith (\x y -> (x * a) .|. y) xs ys
    where ys = zipWith (.|.) (scanl (.|.) 0 xs) . tail $ scanr (.|.) 0 xs

main = do
    [_, k, x] <- parse <$> getLine
    getLine >>= print . solve (fromIntegral $ x^k) . map fromIntegral . parse

import           Data.Bits
import           Data.List
import Data.Int
main :: IO()
main = do
    [n,k,x] <- fmap ((map read) . words) getLine :: IO [Int64]
    a <- fmap ((map read) . words) getLine :: IO [Int64]
    let m = (x^k)
        sl = scanl (.|.) 0 a
        sr = scanr (.|.) 0 a
        ans = foldl' (\acc (q,w,e) -> max acc (q.|.w.|.e)) (0::Int64) $ zip3 sl (map (m*) a) (tail sr)
    --print [sl,sr]
    --print $ zip3 sl (map (m*) a) sr
    print ans

import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

solve :: [Integer] -> Integer -> Integer -> Integer
solve as k x = maximum (zipWith3 or as prefix suffix)
    where or a p s = a * (x ^ k) .|. p .|. s
          prefix = 0:scanl1 (.|.) as
          suffix = (drop 1 (scanr1 (.|.) as)) ++ [0]

main = do
    line <- C.getLine
    let (n:k:x:[]) = toInts (C.words line)
    num <- C.getLine
    let numbers = (take (fromInteger n ) . toInts . C.words) num
    print (solve numbers k x)
    where toInts = map (toInteger . fst . fromJust . C.readInt)

import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import Data.List (sort)

_solve :: (Bits a, Ord a, Num a, Integral b) => [a] -> b -> a -> a
_solve as k x = maximum (zipWith3 or as prefix suffix)
    where or a p s = a * kx .|. p .|. s
          kx = x ^ k
          prefix = 0:scanl1 (.|.) as
          suffix = (drop 1 (scanr1 (.|.) as)) ++ [0]
{-
3 1 2
1 1 1
3

4 2 3
1 2 4 8
-}
main = do
    line <- fmap C.words C.getLine
    let (n:k:x:[]) = toInts line
    nums <- C.getLine
    let numbers = take (fromInteger n) (toInts (C.words nums))
    putStrLn (show (_solve numbers k x))
    where toInts = map (toInteger . fst . fromJust . C.readInt)

-- Codeforces 578B

import Data.Bits ((.|.))
import Data.Foldable (foldl', foldr')
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BC

-- Hint multiply x^k to a_i to get the hightest bit 1 to make result to be to greatest.

-- Note: use Data.ByteString.Char8.ReadInt to accelerate IO action.
--       Use scanl1 and scanr1 to record the intermediate list to reduce time and memory space usage.

main :: IO ()
main = BC.getContents >>= print . solve . map (toInteger . fst . fromJust . BC.readInt) . BC.words

solve :: [Integer] -> Integer
solve (n:k:x:xs) = maximum $ zipWith3 or xs prefix suffix where
    or a p s = a * b .|. p .|. s where b = x ^ k
    prefix = 0:scanl1 (.|.) xs
    suffix = tail $ scanr1 (.|.) xs ++ [0]

import           Data.Bits
import           Data.List
main :: IO()
main = do
    [n,k,x] <- fmap ((map read) . words) getLine :: IO [Int]
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let m = (x^k)
        sl = tail $ scanl (.|.) 0 a
        sr = init $ scanr (.|.) 0 a
        ans = foldl' (\acc (q,w,e) -> max acc (q.|.w.|.e)) 0 $ zip3 sl (map (m*) a) sr
    print ans

import Data.Bits
import Data.List
main :: IO()
main = do
    [n,k,x] <- fmap ((map read) . words) getLine :: IO [Int]
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let m = (x^k)
        sl = scanl (.|.) 0 a
        sr = scanr (.|.) 0 a
        ans = foldl' (\acc (q,w,e) -> max acc (q.|.w.|.e)) 0 $ zip3 sl (map (m*) a) sr
    print ans

import Data.Bits
import Data.List
main :: IO()
main = do
    [n,k,x] <- fmap ((map read) . words) getLine :: IO [Int]
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let m = maximum a
        p = m*(x^k) :: Int
        ans = foldl' (.|.) p (a\\[m])
    print ans

import           Data.Bits
import           Data.List
main :: IO()
main = do
    [n,k,x] <- fmap ((map read) . words) getLine :: IO [Int]
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let m = (x^k)
        sl = tail $ scanl (.|.) 0 a
        sr = init $ scanr (.|.) 0 a
        ans = foldl' (\acc (q,w,e) -> max acc (q.|.w.|.e)) 0 $ zip3 sl (map (m*) a) sr
    print [sl,sr]
    print ans

import           Data.Bits
import           Data.List
main :: IO()
main = do
    [n,k,x] <- fmap ((map read) . words) getLine :: IO [Int]
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let m = (x^k)
        sl = scanl (.|.) 0 a
        sr = scanr (.|.) 0 a
        ans = foldl' (\acc (q,w,e) -> max acc (q.|.w.|.e)) 0 $ zip3 sl (map (m*) a) (tail sr)
    --print [sl,sr]
    --print $ zip3 sl (map (m*) a) sr
    print ans

import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import Data.List (sort)

_solve :: [Integer] -> Integer -> Integer -> Integer
--    |- numbers (input)
--    |      |- number of multiplications left
--    |      | |- multiplier
--    nums   k x |- final value to be returned
_solve nums k x = foldl (.|.) multipled ns
    where (nmax:ns) = reverse (sort nums)
          multipled = nmax * (x ^ k)

main = do
    line <- fmap C.words C.getLine
    let (n:k:x:[]) = toInts line
    nums <- C.getLine
    let numbers = take (fromInteger n) (toInts (C.words nums))
    putStrLn (show (_solve numbers k x))
    where toInts = map (toInteger . fst . fromJust . C.readInt)

import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

dosolve :: [Int] -> Int -> Int -> Int
dosolve as k x = solve as k x 0

solve :: [Int] -> Int -> Int -> Int -> Int
--    |- numbers (input)
--    |      |- number of multiplications left
--    |      | |- multiplier
--    nums   k x |- final value to be returned
solve []     _ _ value = value
solve (a:as) 0 x value = solve as 0 x (a .|. value)
solve (a:as) k x value = max m2 (max m1 m3)
    where
          -- mult and move on
          m1 = solve as      (k - 1) x (ax .|. value)
          -- mult and don't move on
          m2 = solve (ax:as) (k - 1) x value
          -- don't mult and move on
          m3 = solve as      k       x (a .|. value)
          ax = a * x

main = do
    line <- fmap C.words C.getLine
    let (n:k:x:[]) = toInts line
    nums <- C.getLine
    let numbers = take n (toInts (C.words nums))
    putStrLn (show (dosolve numbers k x))
    where toInts = map (fst . fromJust . C.readInt)

import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

dosolve :: [Int] -> Int -> Int -> Int
dosolve (a:as) k x = solve as k x a

solve :: [Int] -> Int -> Int -> Int -> Int
--    |- numbers (input)
--    |      |- number of multiplications left
--    |      | |- multiplier
--    nums   k x |- final value to be returned
solve []     _ _ value = value
solve (a:as) 0 x value = solve as 0 x (a .|. value)
solve (a:as) k x value = max multCurrent (max multed notmulted)
    where multed = solve as (k - 1) x ((a * x) .|. value)
          notmulted = solve as k x (a .|. value)
          multCurrent = solve ((a * x):as) (k - 1) x value

main = do
    line <- fmap C.words C.getLine
    let (n:k:x:[]) = toInts line
    nums <- C.getLine
    let numbers = take n (toInts (C.words nums))
    putStrLn (show (dosolve numbers k x))
    where toInts = map (fst . fromJust . C.readInt)

-- Codeforces 578B

import Data.Bits
import Data.List

-- Hint multiply x^k to a_i to get the hightest bit 1 to make result to be to greatest.

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

solve :: [Integer] -> Integer
solve (n:k:x:xs) = maximum [prefix!!i .|. ((xs!!i)*b) .|. suffix!!i | i <- [0..length xs - 1]] where
    b = x ^ k
    prefix = fst $ foldl (\(acc, prev) a -> (acc++[prev .|. a], prev .|. a)) ([0], 0) xs
    suffix = fst $ foldr (\a (acc, prev) -> (acc++[prev .|. a], prev .|. a)) ([0], 0) xs

import Prelude hiding (getLine)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.Bits ((.|.))

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: Int64 -> [Int64] -> Int64
solve a xs = maximum . zipWith3 go xs (scanl (.|.) 0 xs) $ scanr (.|.) 0 xs
    where go x l r = l .|. (x * a) .|. r

main = do
    [_, k, x] <- parse <$> getLine
    getLine >>= print . solve (fromIntegral $ x^k) . map fromIntegral .parse

import Data.List
import Data.Bits
remove mx (a:as) pre | mx == a = pre ++ as
                     | otherwise = remove mx as (a:pre)
main = do
  w0 <- getLine
  let [n,k,x0] = [read n::Int|n <-(words w0)]
  let x = (fromIntegral x0)::Integer
  w1 <- getLine
  let a = [read n::Integer|n <-(words w1)]
  let mx =maximum a
  let xs =remove mx a []
  let a = (iterate (*x) mx) !! k
  putStrLn $ show (foldl' (.|.) a xs)


import qualified Data.Set as S
import Data.List

f s = if S.null s then "NO" else "YES"
solve k (_:xs) = walk k 1 xs (S.singleton 0)

deleteLT k s
    | S.null s = s
    | otherwise = if (S.findMin s >= k) then s else deleteLT k . S.deleteMin $ s

walk _ _ []      s = s
walk k i (x:xs)  s = if S.null ds || x == '#' then walk k (i + 1) xs ds
                     else walk k (i + 1) xs (S.insert i ds)
    where ds = deleteLT (i - k) s

main = do
    p <- getLine
    r <- getLine
    let [n, k] = map read. words $ p in putStrLn $ f (solve k r)

import Data.List

solve _ i j [] = if (j == i - 1) then "YES" else "NO"
solve k i j (x:xs) = solve k (i+1) u xs
    where u = if j + k >= i && x == '.' then i else j

main = do
    p <- getLine
    r <- getLine
    let [n, k] = map read . words $ p in putStrLn $ solve k 0 0 r

import Control.Monad (liftM)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Int -> String -> Bool
solve k s  =  solve' k s
  where
    solve' _ ""  =  True
    solve' 0 _  =  False
    solve' k' (c:s)  =  if c == '.'
        then solve' k s
        else solve' (k' - 1) s

main :: IO ()
main  =  do
    [n, k]  <-  reads
    s  <-  getLine
    if solve k s
        then putStrLn "YES"
        else putStrLn "NO"

main::IO()
main = do
	input<-getLine
	s<-getLine
	let
		k=( map read (words input) ::[Int] ) !! 1
		cc = foldl (\(a,b) s -> if s=='#' then ((max a (b+1)),(b+1)) else (a,0)) (0,0) s
	putStrLn $ if (fst cc)>=k then "NO" else "YES"

import qualified Data.Set as S

f s = if S.null s then "NO" else "YES"
solve k r = fst $ walk k (k + 1) ((\x -> if x == [] then [] else init x) (drop (k + 1)  r)) $ preproc k 0 r
--solve k r = preproc k 0 $ r

preproc k i r
    | i == (k + 1) || r == [] = S.empty
    | otherwise = if head r == '.' then S.insert i next else next
    where next = preproc k (i + 1) $ tail r

deleteLE k s
    | S.null s = s
    | otherwise = if (S.findMin s > k) then s else deleteLE k . S.deleteMin $ s

walk k i r s = foldl proc (s, i) r
    where proc (s, i) x = (step s i x, i + 1)
          step s i x = if S.null s || x == '#' then (nx s i) else S.insert i (nx s i)
          nx   s i   = deleteLE (i - k) s

main = do
    p <- getLine
    r <- getLine
    --let [n, k] = map read . words $ p in putStrLn $ solve k r
    let [n, k] = map read . words $ p in putStrLn $ f (deleteLE (n - k - 1) (solve k r))

import qualified Data.Set as S

f s = if S.null s then "NO" else "YES"
solve k r = fst $ walk k (k + 1) ((\x -> if x == [] then [] else init x) (drop (k + 1)  r)) $ preproc k 0 r
--solve k r = preproc k 0 $ r

preproc k i r
    | i == (k + 1) || r == [] = S.empty
    | otherwise = if head r == '.' then S.insert i next else next
    where next = preproc k (i + 1) $ tail r

deleteLE k s
    | S.null s = s
    | otherwise = if (S.findMin s > k) then s else deleteLE k . S.deleteMin $ s

walk k i r s = foldl proc (s, i) r
    where proc (s, i) x = (step s i x, i + 1)
          step s i x = if S.null s || x == '#' then (nx s i) else S.insert i (nx s i)
          nx   s i   = deleteLE (i - k) s

main = do
    p <- getLine
    r <- getLine
    --let [n, k] = map read . words $ p in putStrLn $ solve k r
    let [n, k] = map read . words $ p in putStrLn $ f (solve k r)


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

solve :: IO ()
solve = do
    ~[n] <- readInts
    xys <- replicateM n readInts
    let inviteOk m = go xys m where
            go _  0 = True
            go [] _ = False
            go (~[x, y]:xys) m'
                | x >= m' - 1 && y >= m - m' = go xys (m' - 1)
                | otherwise                  = go xys m'
    print $ binSearch (not . inviteOk) 1 n - 1

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

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

module Main (howManyCanInvite, FriendPreferences, main) where

import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as B

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = map readInt . B.words

module Main (howManyCanInvite, FriendPreferences, main) where

import Prelude

import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as B

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = map readInt . B.words

import Prelude
import qualified Data.ByteString.Char8 as B

import Data.Maybe (fromJust)
import Data.Function ((&))

main :: IO ()
main = B.interact processInput

processInput :: B.ByteString -> B.ByteString
processInput = B.unlines . map processTest . parseTests

parseTests :: B.ByteString -> [B.ByteString]
parseTests input = tests
    where
        tests_lines = drop 1 $ B.lines input
        tests = parseLines tests_lines

        parseLines [] = []
        parseLines tests_lines = current_test : parseLines next_tests_lines
            where
                x : xs = tests_lines
                tests_n = readInt x
                (current_test_lines, next_tests_lines) = splitAt tests_n xs
                current_test = B.unlines current_test_lines

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

processTest :: B.ByteString -> B.ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map (map readInt . B.words) (B.lines input)]
        max_invitations_n = findMaxInvitationsN friends_preferences
        output = B.pack $ show max_invitations_n

type PartyPreferences = [(Int, Int)]

findMaxInvitationsN :: PartyPreferences -> Int
findMaxInvitationsN friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences

        max_invitations_n = binarySearch 0 friends_n

        binarySearch l r
            | l == r = mid
            | can_invite_mid = binarySearch mid r
            | otherwise = binarySearch l (mid - 1)
            where
                mid = l + div (r - l + 1) 2
                can_invite_mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> PartyPreferences -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        result = _canInvite friends_preferences 0

        _canInvite preferences invited_n =
            case preferences of
                [] -> invited_n >= target_friends_n
                (l, r) : next_preferences -> _canInvite next_preferences new_invited_n
                    where
                        invited_after = target_friends_n - (invited_n + 1)
                        can_take_current = invited_n <= l && invited_after <= r
                        new_invited_n = invited_n & applyIf can_take_current (+1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

--{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import System.IO

binarySearch :: Integral t => (t->Bool) -> t -> t -> t
binarySearch can lo hi   -- Assumption: f <$> [lo,hi] === [False,True]. Suggestion: Start with hi = n+1
  | lo + 1 == hi = lo
  | otherwise = if can mid then binarySearch can mid hi else binarySearch can lo mid
                where  mid = lo + (hi-lo) `div` 2

canFulfil :: [[Int]] -> Int  -> Int -> Bool
canFulfil _ _ 0 = True
canFulfil [] _ _ = False
canFulfil ([a,b]:rest) got need = canFulfil rest (got + this) (need - this)
  where this = fromEnum $ got<=b && need-1<=a

solve :: IO ()
solve = do
  ~[n] <- readv
  asbs <- CM.replicateM n readv
  let
    ans = binarySearch (canFulfil asbs 0) 1 (n+1)
  print ans

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat $  map (\x->DBB.intDec x <> DBB.char7 ' ') xs

readv :: IO [Int]
readv = map (maybe 0 fst . DBC.readInt) <$> (DBC.words <$> DBC.getLine)

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ nTc solve

--{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO
import Debug.Trace
import Data.Maybe (fromMaybe)

binarySearch :: Integral t => (t->Bool) -> t -> t -> t
binarySearch can lo hi   -- Assumption: f <$> [lo,hi] === [False,True]. Suggestion: Start with hi = n+1
  | lo + 1 == hi = lo
  | otherwise = if can mid then binarySearch can mid hi else binarySearch can lo mid
                where  mid = lo + (hi-lo) `div` 2

canFulfil :: [[Int]] -> Int  -> Int -> Bool
canFulfil _ _ 0 = True
canFulfil [] got need = False
canFulfil ([a,b]:rest) got need = canFulfil rest (got + this) (need - this)
  where this = fromEnum $ got<=b && need-1<=a

solve :: IO ()
solve = do
  ~[n] <- readv
  asbs <- CM.replicateM n readv
  let
    ans = binarySearch (canFulfil asbs 0) 1 (n+1)
  print ans

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: IO [Int]
readv = do
  bWords <- DBC.words <$> DBC.getLine
  let toInt x = fst $ fromMaybe (0,mempty) $ DBC.readInt x
  return $ toInt <$> bWords

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ nTc solve

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

canUse :: Array Int (Int, Int) -> Int -> Bool
canUse arr k = let
  (1, n) = bounds arr
  go !i !lc !rc
    | i > n  = rc < 0
    | otherwise = let
        (ai, bi) = arr ! i
        in  if  lc <= bi && rc <= ai
            then  go (i + 1) (lc + 1) (rc - 1)
            else  go (i + 1) lc rc
  in  go 1 0 (k - 1)

binSearch :: (Int -> Bool) -> Int -> Int -> Int
{-# INLINE binSearch #-}
binSearch fun = let
  go !li !ri = if  li == ri
    then  li
    else  let
    mi = li + div (ri - li) 2
    in  if  fun mi
    then  go li mi
    else  go (mi + 1) ri
  in  go

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    abLi <- replicateM n $ do
      ~[ai, bi] <- getInts 2
      pure (ai, bi)
    let
      abs :: Array Int (Int, Int)
      abs = listArray (1, n) abLi
      ans = binSearch (not . canUse abs) 0 (n + 10) - 1
    pure $ putInts [ans]

type SP = State [P.ByteString]

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

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

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

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

module Main (howManyCanInvite, FriendPreferences, main) where

import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = unfoldr (B.readInt . B.dropWhile isSpace)

module Main (howManyCanInvite, FriendPreferences, main) where

import Data.Char (isSpace)
import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as B

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = unfoldr (B.readInt . B.dropWhile isSpace)

module Main (howManyCanInvite, FriendPreferences, main) where

import Prelude

import Data.Char (isSpace)
import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as B

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = unfoldr (B.readInt . B.dropWhile isSpace)