She is skilled in all kinds of magics, and is keen on inventing new one.—Perfect Memento in Strict SensePatchouli is making a magical talisman. She initially has $$$n$$$ magical tokens. Their magical power can be represented with positive integers $$$a_1, a_2, \ldots, a_n$$$. Patchouli may perform the following two operations on the tokens.  Fusion: Patchouli chooses two tokens, removes them, and creates a new token with magical power equal to the sum of the two chosen tokens.  Reduction: Patchouli chooses a token with an even value of magical power $$$x$$$, removes it and creates a new token with magical power equal to $$$\frac{x}{2}$$$. Tokens are more effective when their magical powers are odd values. Please help Patchouli to find the minimum number of operations she needs to make magical powers of all tokens odd values.

Each test contains multiple test cases.  The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^3$$$) — the number of test cases. The description of the test cases follows. For each test case, the first line contains one integer $$$n$$$ ($$$1 \leq n\leq 2\cdot 10^5$$$) — the initial number of tokens. The second line contains $$$n$$$ intergers $$$a_1,a_2,\ldots,a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — the initial magical power of the $$$n$$$ tokens. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print a single integer — the minimum number of operations Patchouli needs to make all tokens have an odd value of magical power. It can be shown that under such restrictions the required sequence of operations exists.

NoteTest case 1:$$$a$$$ consists solely of odd numbers initially.Test case 2:Choose the tokens with magical power of $$$1$$$ and $$$2$$$ and perform Fusion. Now $$$a=[1,3]$$$, both are odd numbers.Test case 3:Choose the tokens with magical power of $$$2$$$ and $$$8$$$ and perform Fusion. Now $$$a=[4,10]$$$.Choose the token with magical power of $$$10$$$ and perform Reduction. Now $$$a=[4,5]$$$.Choose the tokens with magical power of $$$4$$$ and $$$5$$$ and perform Fusion. Now $$$a=[9]$$$, and $$$9$$$ is an odd number.It can be shown that you can not make all the magical powers odd numbers in less than $$$3$$$ moves, so the answer is $$$3$$$.

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 ]


There are n cities in Berland. Each city has its index — an integer number from 1 to n. The capital has index r1. All the roads in Berland are two-way. The road system is such that there is exactly one path from the capital to each city, i.e. the road map looks like a tree. In Berland's chronicles the road map is kept in the following way: for each city i, different from the capital, there is kept number pi — index of the last city on the way from the capital to i.Once the king of Berland Berl XXXIV decided to move the capital from city r1 to city r2. Naturally, after this the old representation of the road map in Berland's chronicles became incorrect. Please, help the king find out a new representation of the road map in the way described above.

The first line contains three space-separated integers n, r1, r2 (2 ≤ n ≤ 5·104, 1 ≤ r1 ≠ r2 ≤ n) — amount of cities in Berland, index of the old capital and index of the new one, correspondingly. The following line contains n - 1 space-separated integers — the old representation of the road map. For each city, apart from r1, there is given integer pi — index of the last city on the way from the capital to city i. All the cities are described in order of increasing indexes.

Output n - 1 numbers — new representation of the road map in the same format.

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

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


Shaass has n books. He wants to make a bookshelf for all his books. He wants the bookshelf's dimensions to be as small as possible. The thickness of the i-th book is ti and its pages' width is equal to wi. The thickness of each book is either 1 or 2. All books have the same page heights.  Shaass puts the books on the bookshelf in the following way. First he selects some of the books and put them vertically. Then he puts the rest of the books horizontally above the vertical books. The sum of the widths of the horizontal books must be no more than the total thickness of the vertical books. A sample arrangement of the books is depicted in the figure.  Help Shaass to find the minimum total thickness of the vertical books that we can achieve.

The first line of the input contains an integer n, (1 ≤ n ≤ 100). Each of the next n lines contains two integers ti and wi denoting the thickness and width of the i-th book correspondingly, (1 ≤ ti ≤ 2, 1 ≤ wi ≤ 100).

On the only line of the output print the minimum total thickness of the vertical books that we can achieve.

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

main :: IO ()
main = do
  n <- read <$> getLine
  a <- replicateM n $ do
    [i, j] <- map read . words <$> getLine
    return (i, j)
  let f i = zip [0::Int ..] . reverse . scanl (+) 0 . sort . map snd . filter ((==i) . fst)
  print $ minimum $ [i + 2 * j | (i, x) <- f 1 a, (j, y) <- f 2 a, i + 2 * j >= x + y]


Mark is asked to take a group photo of $$$2n$$$ people. The $$$i$$$-th person has height $$$h_i$$$ units.To do so, he ordered these people into two rows, the front row and the back row, each consisting of $$$n$$$ people. However, to ensure that everyone is seen properly, the $$$j$$$-th person of the back row must be at least $$$x$$$ units taller than the $$$j$$$-th person of the front row for each $$$j$$$ between $$$1$$$ and $$$n$$$, inclusive.Help Mark determine if this is possible.

The first line contains one integer $$$t$$$ ($$$1\leq t\leq 100$$$) — the number of test cases. Each test case consists of two lines. The first line of each test case contains two positive integers $$$n$$$ and $$$x$$$ ($$$1\leq n\leq 100$$$, $$$1\leq x\leq 10^3$$$) — the number of people in each row and the minimum difference Mark wants. The second line of each test case contains $$$2n$$$ positive integers $$$h_1,h_2,\ldots,h_{2n}$$$ ($$$1\leq h_i\leq 10^3$$$) — the height of each person in units. Note that the sum of $$$n$$$ over all test cases is not bounded.

For each test case, print a single line containing "YES" if Mark could arrange people satisfying his condition and "NO" otherwise. You may print each letter in any case (for example, YES, Yes, yes, yEs will all be recognized as positive answers).

NoteIn the first test case, one possible order is to have the third, fifth, and sixth person on the back row and the second, first, and fourth on the front row. The heights of the people will look like this. Back$$$9$$$$$$12$$$$$$16$$$Front$$$3$$$$$$1$$$$$$10$$$ It works because   $$$h_3-h_2 = 9-3 \geq 6$$$,    $$$h_5-h_1 = 12-1\geq 6$$$, and    $$$h_6-h_4 = 16-10\geq 6$$$. In the second test case, it can be shown there is no way to order people in a way that satisfies the condition.In the third test case, the only way to arrange people to satisfy the condition is to have the first person on the back row and the second person on the front row.

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


A social network for dogs called DH (DogHouse) has k special servers to recompress uploaded videos of cute cats. After each video is uploaded, it should be recompressed on one (any) of the servers, and only after that it can be saved in the social network.We know that each server takes one second to recompress a one minute fragment. Thus, any server takes m seconds to recompress a m minute video.We know the time when each of the n videos were uploaded to the network (in seconds starting from the moment all servers started working). All videos appear at different moments of time and they are recompressed in the order they appear. If some video appeared at time s, then its recompressing can start at that very moment, immediately. Some videos can await recompressing when all the servers are busy. In this case, as soon as a server is available, it immediately starts recompressing another video. The videos that await recompressing go in a queue. If by the moment the videos started being recompressed some servers are available, then any of them starts recompressing the video.For each video find the moment it stops being recompressed.

The first line of the input contains integers n and k (1 ≤ n, k ≤ 5·105) — the number of videos and servers, respectively. Next n lines contain the descriptions of the videos as pairs of integers si, mi (1 ≤ si, mi ≤ 109), where si is the time in seconds when the i-th video appeared and mi is its duration in minutes. It is guaranteed that all the si's are distinct and the videos are given in the chronological order of upload, that is in the order of increasing si.

Print n numbers e1, e2, ..., en, where ei is the time in seconds after the servers start working, when the i-th video will be recompressed.

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'

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

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'

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


Imagine that there is a group of three friends: A, B and С. A owes B 20 rubles and B owes C 20 rubles. The total sum of the debts is 40 rubles. You can see that the debts are not organized in a very optimal manner. Let's rearrange them like that: assume that A owes C 20 rubles and B doesn't owe anything to anybody. The debts still mean the same but the total sum of the debts now equals 20 rubles.This task is a generalisation of a described example. Imagine that your group of friends has n people and you know the debts between the people. Optimize the given debts without changing their meaning. In other words, finally for each friend the difference between the total money he should give and the total money he should take must be the same. Print the minimum sum of all debts in the optimal rearrangement of the debts. See the notes to the test samples to better understand the problem.

The first line contains two integers n and m (1 ≤ n ≤ 100; 0 ≤ m ≤ 104). The next m lines contain the debts. The i-th line contains three integers ai, bi, ci (1 ≤ ai, bi ≤ n; ai ≠ bi; 1 ≤ ci ≤ 100), which mean that person ai owes person bi ci rubles. Assume that the people are numbered by integers from 1 to n. It is guaranteed that the same pair of people occurs at most once in the input. The input doesn't simultaneously contain pair of people (x, y) and pair of people (y, x).

Print a single integer — the minimum sum of debts in the optimal rearrangement.

NoteIn the first sample, you can assume that person number 1 owes 8 rubles to person number 2, 1 ruble to person number 3 and 1 ruble to person number 4. He doesn't owe anybody else anything. In the end, the total debt equals 10.In the second sample, there are no debts.In the third sample, you can annul all the debts.

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


You're given an array $$$a$$$ of $$$n$$$ integers, such that $$$a_1 + a_2 + \cdots + a_n = 0$$$.In one operation, you can choose two different indices $$$i$$$ and $$$j$$$ ($$$1 \le i, j \le n$$$), decrement $$$a_i$$$ by one and increment $$$a_j$$$ by one. If $$$i < j$$$ this operation is free, otherwise it costs one coin.How many coins do you have to spend in order to make all elements equal to $$$0$$$?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 5000$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \le n \le 10^5$$$)  — the number of elements. The next line contains $$$n$$$ integers $$$a_1, \ldots, a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$). It is given that $$$\sum_{i=1}^n a_i = 0$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, print the minimum number of coins we have to spend in order to make all elements equal to $$$0$$$.

NotePossible strategy for the first test case:   Do $$$(i=2, j=3)$$$ three times (free), $$$a = [-3, 2, 0, 1]$$$.  Do $$$(i=2, j=1)$$$ two times (pay two coins), $$$a = [-1, 0, 0, 1]$$$.  Do $$$(i=4, j=1)$$$ one time (pay one coin), $$$a = [0, 0, 0, 0]$$$.

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

-- import Debug.Trace
-- debug = flip trace

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

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

solve :: Int -> [Int64] -> Int64
solve n as = (availSteps + sum steps) `div` 2
    where
        (availSteps, steps) = mapAccumR performStep 0 as
        performStep availSteps e = (availSteps - delta, e - delta)
            where
                delta = min availSteps e

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


You are given a ternary string (it is a string which consists only of characters '0', '1' and '2').You can swap any two adjacent (consecutive) characters '0' and '1' (i.e. replace "01" with "10" or vice versa) or any two adjacent (consecutive) characters '1' and '2' (i.e. replace "12" with "21" or vice versa).For example, for string "010210" we can perform the following moves:   "010210" $$$\rightarrow$$$ "100210";  "010210" $$$\rightarrow$$$ "001210";  "010210" $$$\rightarrow$$$ "010120";  "010210" $$$\rightarrow$$$ "010201". Note than you cannot swap "02" $$$\rightarrow$$$ "20" and vice versa. You cannot perform any other operations with the given string excluding described above.You task is to obtain the minimum possible (lexicographically) string by using these swaps arbitrary number of times (possibly, zero).String $$$a$$$ is lexicographically less than string $$$b$$$ (if strings $$$a$$$ and $$$b$$$ have the same length) if there exists some position $$$i$$$ ($$$1 \le i \le |a|$$$, where $$$|s|$$$ is the length of the string $$$s$$$) such that for every $$$j < i$$$ holds $$$a_j = b_j$$$, and $$$a_i < b_i$$$.

The first line of the input contains the string $$$s$$$ consisting only of characters '0', '1' and '2', its length is between $$$1$$$ and $$$10^5$$$ (inclusive).

Print a single string — the minimum possible (lexicographically) string you can obtain by using the swaps described above arbitrary number of times (possibly, zero).

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

{-# 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 (/='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


You are given n numbers a1, a2, ..., an. You can perform at most k operations. For each operation you can multiply one of the numbers by x. We want to make  as large as possible, where  denotes the bitwise OR. Find the maximum possible value of  after performing at most k operations optimally.

The first line contains three integers n, k and x (1 ≤ n ≤ 200 000, 1 ≤ k ≤ 10, 2 ≤ x ≤ 8). The second line contains n integers a1, a2, ..., an (0 ≤ ai ≤ 109).

Output the maximum value of a bitwise OR of sequence elements after performing operations.

NoteFor the first sample, any possible choice of doing one operation will result the same three numbers 1, 1, 2 so the result is . For the second sample if we multiply 8 by 3 two times we'll get 72. In this case the numbers will become 1, 2, 4, 72 so the OR value will be 79 and is the largest possible result.

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]

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

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)


You are given a sequence of $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$.You have to construct two sequences of integers $$$b$$$ and $$$c$$$ with length $$$n$$$ that satisfy:  for every $$$i$$$ ($$$1\leq i\leq n$$$) $$$b_i+c_i=a_i$$$  $$$b$$$ is non-decreasing, which means that for every $$$1<i\leq n$$$, $$$b_i\geq b_{i-1}$$$ must hold  $$$c$$$ is non-increasing, which means that for every $$$1<i\leq n$$$, $$$c_i\leq c_{i-1}$$$ must hold You have to minimize $$$\max(b_i,c_i)$$$. In other words, you have to minimize the maximum number in sequences $$$b$$$ and $$$c$$$.Also there will be $$$q$$$ changes, the $$$i$$$-th change is described by three integers $$$l,r,x$$$. You should add $$$x$$$ to $$$a_l,a_{l+1}, \ldots, a_r$$$. You have to find the minimum possible value of $$$\max(b_i,c_i)$$$ for the initial sequence and for sequence after each change.

The first line contains an integer $$$n$$$ ($$$1\leq n\leq 10^5$$$). The secound line contains $$$n$$$ integers $$$a_1,a_2,\ldots,a_n$$$ ($$$1\leq i\leq n$$$, $$$-10^9\leq a_i\leq 10^9$$$). The third line contains an integer $$$q$$$ ($$$1\leq q\leq 10^5$$$). Each of the next $$$q$$$ lines contains three integers $$$l,r,x$$$ ($$$1\leq l\leq r\leq n,-10^9\leq x\leq 10^9$$$), desribing the next change.

Print $$$q+1$$$ lines. On the $$$i$$$-th ($$$1 \leq i \leq q+1$$$) line, print the answer to the problem for the sequence after $$$i-1$$$ changes.

NoteIn the first test:  The initial sequence $$$a = (2, -1, 7, 3)$$$. Two sequences $$$b=(-3,-3,5,5),c=(5,2,2,-2)$$$ is a possible choice.  After the first change $$$a = (2, -4, 4, 0)$$$. Two sequences $$$b=(-3,-3,5,5),c=(5,-1,-1,-5)$$$ is a possible choice.  After the second change $$$a = (2, -4, 6, 2)$$$. Two sequences $$$b=(-4,-4,6,6),c=(6,0,0,-4)$$$ is a possible choice.

import Control.Monad
import Data.Maybe
import Data.List
import Data.Int
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap.Strict as IntMap

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

getInt64s :: IO [Int64]
getInt64s = map (fromIntegral . fst . fromJust . C.readInt) . C.words <$> C.getLine

type MyList = (Int, Int64, Int64, IntMap.IntMap Int64)

updatePos :: Int -> Int64 -> MyList -> MyList
updatePos pos delta my_list@(n, a1, total, mp) =
  if pos <= 0 || pos >= n
    then my_list
    else let val = fromJust $ IntMap.lookup pos mp
             val' = val + delta
             total' = total - (max 0 val) + (max 0 val')
             mp' = IntMap.adjust (\_ -> val') pos mp
         in (n, a1, total', mp')

update :: (Int, Int) -> Int64 -> MyList -> MyList
update (left, right) delta my_list =
  let (n, a1, total, mp) = updatePos (left - 1) delta $ updatePos right (-delta) my_list
  in (n, if left <= 1 then a1 + delta else a1, total, mp)

main :: IO ()
main = do
  [n] <- getInts
  as <- getInt64s
  [q] <- getInts
  qs <- replicateM q getInt64s
  let ls = map (\(a1, a2, i) -> (i, a2 - a1)) $ zip3 as (tail as) [1..]
      total = foldl' (\s (_, d) -> if d > 0 then s + d else s) 0 ls
      mp = IntMap.fromList ls
      lists = scanl' (\my_list [l, r, x] -> update (fromIntegral l, fromIntegral r) x my_list) (n, as !! 0, total, mp) qs
      ans = map (\(_, a1, t, _) -> let x = (a1 - t) `div` 2 in max (x + t) (a1 - x)) lists
  putStrLn $ concat $ intersperse "\n" $ map show ans

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

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

type MyList = (Int, Int, Int, IntMap.IntMap Int)

updatePos :: Int -> Int -> MyList -> MyList
updatePos pos delta my_list@(n, a1, total, mp) =
  if pos <= 0 || pos >= n
    then my_list
    else let val = fromJust $ IntMap.lookup pos mp
             val' = val + delta
             total' = total - (max 0 val) + (max 0 val')
             mp' = IntMap.adjust (\_ -> val') pos mp
         in (n, a1, total', mp')

update :: (Int, Int) -> Int -> MyList -> MyList
update (left, right) delta my_list =
  let (n, a1, total, mp) = updatePos (left - 1) delta $ updatePos right (-delta) my_list
  in (n, if left <= 1 then a1 + delta else a1, total, mp)

main :: IO ()
main = do
  [n] <- getInts
  as <- getInts
  [q] <- getInts
  qs <- replicateM q getInts
  let ls = map (\(a1, a2, i) -> (i, a2 - a1)) $ zip3 as (tail as) [1..]
      total = foldl' (\s (_, d) -> if d > 0 then s + d else s) 0 ls
      mp = IntMap.fromList ls
      lists = scanl' (\my_list [l, r, x] -> update (l, r) x my_list) (n, as !! 0, total, mp) qs
      ans = map (\(_, a1, t, _) -> let x = (a1 - t) `div` 2 in max (x + t) (a1 - x)) lists
  putStrLn $ concat $ intersperse "\n" $ map show ans


Dima has a birthday soon! It's a big day! Saryozha's present to Dima is that Seryozha won't be in the room and won't disturb Dima and Inna as they celebrate the birthday. Inna's present to Dima is a stack, a queue and a deck.Inna wants her present to show Dima how great a programmer he is. For that, she is going to give Dima commands one by one. There are two types of commands:  Add a given number into one of containers. For the queue and the stack, you can add elements only to the end. For the deck, you can add elements to the beginning and to the end.  Extract a number from each of at most three distinct containers. Tell all extracted numbers to Inna and then empty all containers. In the queue container you can extract numbers only from the beginning. In the stack container you can extract numbers only from the end. In the deck number you can extract numbers from the beginning and from the end. You cannot extract numbers from empty containers. Every time Dima makes a command of the second type, Inna kisses Dima some (possibly zero) number of times. Dima knows Inna perfectly well, he is sure that this number equals the sum of numbers he extracts from containers during this operation.As we've said before, Dima knows Inna perfectly well and he knows which commands Inna will give to Dima and the order of the commands. Help Dima find the strategy that lets him give as more kisses as possible for his birthday!

The first line contains integer n (1 ≤ n ≤ 105) — the number of Inna's commands. Then n lines follow, describing Inna's commands. Each line consists an integer:   Integer a (1 ≤ a ≤ 105) means that Inna gives Dima a command to add number a into one of containers.  Integer 0 shows that Inna asks Dima to make at most three extractions from different containers.

Each command of the input must correspond to one line of the output — Dima's action. For the command of the first type (adding) print one word that corresponds to Dima's choice:   pushStack — add to the end of the stack;  pushQueue — add to the end of the queue;  pushFront — add to the beginning of the deck;  pushBack — add to the end of the deck.  For a command of the second type first print an integer k (0 ≤ k ≤ 3), that shows the number of extract operations, then print k words separated by space. The words can be:   popStack — extract from the end of the stack;  popQueue — extract from the beginning of the line;  popFront — extract from the beginning from the deck;  popBack — extract from the end of the deck.  The printed operations mustn't extract numbers from empty containers. Also, they must extract numbers from distinct containers. The printed sequence of actions must lead to the maximum number of kisses. If there are multiple sequences of actions leading to the maximum number of kisses, you are allowed to print any of them.

0
pushStack
1 popStack
pushStack
pushQueue
2 popStack popQueue
pushStack
pushQueue
pushFront
3 popStack popQueue popFront

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
itof :: Int -> Double
itof = fromIntegral

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    n <- readLn :: IO Int
    ops <- map readInt . take n . B.words <$> B.getContents
    forM_ (solve ops) print

solve ops = go [] ops
    where
    go !l [] = map (const (Push Queue)) l
    go !l (0:ops) = createOps (reverse l)++go [] ops
    go !l (a:ops) = go (a:l) ops

createOps l | length l >= 3 = createOps3 l
            | length l == 2 = createOps2 l
            | length l == 1 = createOps1 l
            | length l == 0 = createOps0 l

data Dest = Stack | Queue | Front | Back deriving(Show)

data Op = Push Dest
        | Pop [Dest]

instance Show Op where
    show (Push d) = "push"++show d
    show (Pop l) = unwords $ show (length l): map (("pop"++).show) l

createOps0 _ = [Pop []]
createOps1 _ = [Push Stack,Pop [Stack]]
createOps2 _ = [Push Stack,Push Queue,Pop [Stack,Queue]]
createOps3 l = map f l' ++ [Pop [Stack,Queue,Front]]
    where
    l' = zip l [1..]
    a = maximum l'
    as = filter (not . (==a)) l'
    b = maximum as
    bs = filter (not . (==b)) as
    c = maximum bs
    f x | x == a = Push Stack
        | x == b = Push Queue
        | x == c = Push Front
        | otherwise = Push Back

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
itof :: Int -> Double
itof = fromIntegral

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    n <- readLn :: IO Int
    ops <- map readInt . take n . B.words <$> B.getContents
    forM_ (solve ops) print

solve ops = go [] ops
    where
    go _ [] = []
    go !l (0:ops) = createOps (reverse l)++go [] ops
    go !l (a:ops) = go (a:l) ops

createOps l | length l >= 3 = createOps3 l
            | length l == 2 = createOps2 l
            | length l == 1 = createOps1 l
            | length l == 0 = createOps0 l

data Dest = Stack | Queue | Front | Back deriving(Show)

data Op = Push Dest
        | Pop [Dest]

instance Show Op where
    show (Push d) = "push"++show d
    show (Pop l) = unwords $ show (length l): map (("pop"++).show) l

createOps0 _ = [Pop []]
createOps1 _ = [Push Stack,Pop [Stack]]
createOps2 _ = [Push Stack,Push Queue,Pop [Stack,Queue]]
createOps3 l = map f l' ++ [Pop [Stack,Queue,Front]]
    where
    l' = zip l [1..]
    a = maximum l'
    as = filter (not . (==a)) l'
    b = maximum as
    bs = filter (not . (==b)) as
    c = maximum bs
    f x | x == a = Push Stack
        | x == b = Push Queue
        | x == c = Push Front
        | otherwise = Push Back