When you play the game of thrones, you win, or you die. There is no middle ground.Cersei Lannister, A Game of Thrones by George R. R. MartinThere are $$$n$$$ nobles, numbered from $$$1$$$ to $$$n$$$. Noble $$$i$$$ has a power of $$$i$$$. There are also $$$m$$$ "friendships". A friendship between nobles $$$a$$$ and $$$b$$$ is always mutual.A noble is defined to be vulnerable if both of the following conditions are satisfied:   the noble has at least one friend, and  all of that noble's friends have a higher power. You will have to process the following three types of queries.   Add a friendship between nobles $$$u$$$ and $$$v$$$.  Remove a friendship between nobles $$$u$$$ and $$$v$$$.  Calculate the answer to the following process. The process: all vulnerable nobles are simultaneously killed, and all their friendships end. Then, it is possible that new nobles become vulnerable. The process repeats itself until no nobles are vulnerable. It can be proven that the process will end in finite time. After the process is complete, you need to calculate the number of remaining nobles.Note that the results of the process are not carried over between queries, that is, every process starts with all nobles being alive!

The first line contains the integers $$$n$$$ and $$$m$$$ ($$$1 \le n \le 2\cdot 10^5$$$, $$$0 \le m \le 2\cdot 10^5$$$) — the number of nobles and number of original friendships respectively. The next $$$m$$$ lines each contain the integers $$$u$$$ and $$$v$$$ ($$$1 \le u,v \le n$$$, $$$u \ne v$$$), describing a friendship. No friendship is listed twice. The next line contains the integer $$$q$$$ ($$$1 \le q \le 2\cdot {10}^{5}$$$) — the number of queries.  The next $$$q$$$ lines contain the queries themselves, each query has one of the following three formats.    $$$1$$$ $$$u$$$ $$$v$$$ ($$$1 \le u,v \le n$$$, $$$u \ne v$$$) — add a friendship between $$$u$$$ and $$$v$$$. It is guaranteed that $$$u$$$ and $$$v$$$ are not friends at this moment.  $$$2$$$ $$$u$$$ $$$v$$$ ($$$1 \le u,v \le n$$$, $$$u \ne v$$$) — remove a friendship between $$$u$$$ and $$$v$$$. It is guaranteed that $$$u$$$ and $$$v$$$ are friends at this moment.  $$$3$$$ — print the answer to the process described in the statement.

For each type $$$3$$$ query print one integer to a new line. It is guaranteed that there will be at least one type $$$3$$$ query.

NoteConsider the first example. In the first type 3 query, we have the diagram below.In the first round of the process, noble $$$1$$$ is weaker than all of his friends ($$$2$$$ and $$$3$$$), and is thus killed. No other noble is vulnerable in round 1. In round 2, noble $$$3$$$ is weaker than his only friend, noble $$$4$$$, and is therefore killed. At this point, the process ends, and the answer is $$$2$$$.  In the second type 3 query, the only surviving noble is $$$4$$$.    The second example consists of only one type $$$3$$$ query. In the first round, two nobles are killed, and in the second round, one noble is killed. The final answer is $$$1$$$, since only one noble survives.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Applicative (liftA2)
import Control.Monad (replicateM, forM)
import Control.Monad.ST
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust, catMaybes)

main :: IO ()
main = C.interact $ runScanner (C.pack <$> testCase)

testCase :: Scanner String
testCase = do
  n <- int
  m <- int
  edges <- m >< pair int int
  q <- int
  qs <- q >< query
  return . unlines . map show $ solve n edges qs

data Query = Add Int Int | Rem Int Int | Ask deriving (Eq, Show)

query :: Scanner Query
query = do
  t <- int
  case t of
    1 -> Add <$> int <*> int
    2 -> Rem <$> int <*> int
    3 -> pure Ask

solve :: Int -> [(Int, Int)] -> [Query] -> [Int]
solve n edges qs = runST compute
  where
    init :: UArray Int Int
    init = accumArray (+) 0 (1, n) [(min u v, 1) | (u, v) <- edges]

    initAns :: Int
    initAns = length . filter (== 0) $ elems init

    compute :: forall s. ST s [Int]
    compute = do
      (better :: STUArray s Int Int) <- thaw init
      deltas <- forM qs $ \case
        Add u v -> do
          let x = min u v
          d <- readArray better x
          writeArray better x (d + 1)
          return $ if d == 0 then (-1) else 0
        Rem u v -> do
          let x = min u v
          d <- readArray better x
          writeArray better x (d - 1)
          return $ if d == 1 then 1 else 0
        Ask -> return 0
      let values = tail $ scanl1 (+) (initAns : deltas)
      return [v | (q, v) <- zip qs values, case q of Ask -> True; _ -> False]

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

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

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

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

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

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

(><) = times

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

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

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.IO.Safe
import qualified Data.IntSet as S
import Data.Maybe

modifyAt :: IOArray Int t -> Int -> (t -> t) -> IO ()
modifyAt arr ix fun = do
  val <- readArray arr ix
  let  nval = fun val
  nval `seq` writeArray arr ix nval

insE :: IOArray Int S.IntSet -> Int -> Int -> SIO ()
insE arr u v = lift $ do
  modifyAt arr u $ S.insert v
  modifyAt arr v $ S.insert u

remE :: IOArray Int S.IntSet -> Int -> Int -> SIO ()
remE arr u v = lift $ do
  modifyAt arr u $ S.delete v
  modifyAt arr v $ S.delete u

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m] <- readInts
  arr <- lift $ newArray (1, n) S.empty :: SIO (IOArray Int S.IntSet)
  replicateM_ m $ do
    [u, v] <- readInts
    insE arr u v
  let
    isVuln :: Int -> SIO Bool
    isVuln i = lift $ isJust . S.lookupGT i <$> readArray arr i
  ivulns <- fmap S.fromAscList $ filterM isVuln [1..n]
  let
    insv (vulns, ct) u = (
      S.insert u vulns,
      ct + if  S.notMember u vulns  then  1  else  0
      )
    remv (vulns, ct) u = (
      S.delete u vulns,
      ct - if  S.member u vulns  then  1  else  0
      )
  [q] <- readInts
  (\fun -> foldM_ fun (ivulns, S.size ivulns) [1..q]) $ \(vulns, ct) _ -> do
    qt : pars <- readInts
    case  (qt, pars)  of
      (1, [u, v]) -> do
        insE arr u v
        uv <- isVuln u
        vv <- isVuln v
        let  (v1, c1) = if  uv  then  insv (vulns, ct) u  else  (vulns, ct)
        pure $ if  vv  then  insv (v1, c1) v  else  (v1, c1)
      (2, [u, v]) -> do
        remE arr u v
        uv <- isVuln u
        vv <- isVuln v
        let  (v1, c1) = if  not uv  then  remv (vulns, ct) u  else  (vulns, ct)
        pure $ if  not vv  then  remv (v1, c1) v  else  (v1, c1)
      (3, []) -> (vulns, ct) <$ putInts [n - ct]
      _ -> error "bad input"

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  ~(out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


Cheaterius is a famous in all the Berland astrologist, magician and wizard, and he also is a liar and a cheater. One of his latest inventions is Cheaterius' amulets! They bring luck and wealth, but are rather expensive. Cheaterius makes them himself. The technology of their making is kept secret. But we know that throughout long nights Cheaterius glues together domino pairs with super glue to get squares 2 × 2 which are the Cheaterius' magic amulets!    That's what one of Cheaterius's amulets looks like After a hard night Cheaterius made n amulets. Everyone of them represents a square 2 × 2, every quarter contains 1 to 6 dots. Now he wants sort them into piles, every pile must contain similar amulets. Two amulets are called similar if they can be rotated by 90, 180 or 270 degrees so that the following condition is met: the numbers of dots in the corresponding quarters should be the same. It is forbidden to turn over the amulets.Write a program that by the given amulets will find the number of piles on Cheaterius' desk.

The first line contains an integer n (1 ≤ n ≤ 1000), where n is the number of amulets. Then the amulet's descriptions are contained. Every description occupies two lines and contains two numbers (from 1 to 6) in each line. Between every pair of amulets the line "**" is located.

import Control.Monad
import Data.List

main = do
	n <- fmap read getLine
	a <- replicateM (3*n-1) getLine
	putStrLn $ show $ length $ group $ sort $ gao a where
		gao [] = []
		gao (a:b:s) = c: gao (drop 1 s) where
			c = minimum $ take 4 $ iterate (\(h:t) -> t ++ [h]) $ a ++ reverse b

import List
import Control.Monad

main = do
  n  <- readLn
  d  <- getDice
  ds <- replicateM (n-1) $ getLine>>getDice
  print $ solve (d:ds)

getDice = do
  xs <- getLine
  ys <- getLine
  return $ xs ++ reverse ys

solve ds = length$group$sort[sort[rotateL n d| n<-[0..3]]| d<-ds]

rotateL n xs = drop n xs ++ take n xs

import Data.List
main=interact$show.length.group.sort.f.tail.lines
f("**":s)=f s
f([a,b]:[c,d]:s)=minimum[[a,b,d,c],[b,d,c,a],[d,c,a,b],[c,a,b,d]]:f s
f _=[]

module Main where

import Control.Monad    -- replicateM, mapM, etc.
import Data.Int         -- Int, Int64, etc.
import Data.List        -- sort, find, etc.
import Data.Array       -- listArray, array, etc.
import Debug.Trace      -- trace

readI :: String -> Int
readI = read

readL :: String -> [Int]
readL = (map read) . words

main = do
    n <- getLine >>= return . readI
    ds <- replicateM (3*n-1) getLine
    print $ solve ds

solve ds = length $ nubBy isEq xs where

    xs = glue $ filter (/="**") ds
    glue xs = glue' xs [] where
        glue' []       acc = acc
        glue' (x:y:xs) acc = glue' xs ((x ++ y):acc)

    isEq [c1,c2,c3,c4] [a1,a2,a3,a4] =
        (c1==a1 && c2==a2 && c3==a3 && c4==a4) ||
        (c1==a2 && c2==a4 && c3==a1 && c4==a3) ||
        (c1==a3 && c2==a1 && c3==a4 && c4==a2) ||
        (c1==a4 && c2==a3 && c3==a2 && c4==a1)

import Control.Monad (liftM2, replicateM)
import List (nub)

data Eq a => T a  =  T [a]

instance Eq a => Eq (T a)
  where
    (==) (T as) (T bs)  =  elem as $ rotations bs

rotations :: [a] -> [[a]]
rotations xs  =  take n . map (take n) . iterate tail . cycle $ xs
  where
    n  =  length xs

parse :: String -> String -> T Char
parse [c1, c2] [c3, c4]  =  T [c1, c2, c4, c3]

getT :: IO (T Char)
getT  =  liftM2 parse (while (== "**") getLine) getLine

solve :: [T Char] -> Int
solve  =  length . nub

while :: Monad m => (a -> Bool) -> m a -> m a
while f ma  =  do
    a  <-  ma
    if f a
        then while f ma
        else return a

main :: IO ()
main  =  readLn >>= flip replicateM getT >>= print . solve

import Data.Set
main = interact solve
solve input = show $ size $ f $ lines input
f [] = empty
f (x:y:z:xs) = insert (minimum $ take 4 $ iterate g (y ++ reverse z)) (f xs)
g (x:xs) = xs ++ [x]

import Data.List
main=interact$show.length.group.sort.f.tail.lines
f([a,b]:[c,d]:_:s)=minimum[[a,b,d,c],[b,d,c,a],[d,c,a,b],[c,a,b,d]]:f s
f _=[]


Polycarp studies at the university in the group which consists of n students (including himself). All they are registrated in the social net "TheContacnt!".Not all students are equally sociable. About each student you know the value ai — the maximum number of messages which the i-th student is agree to send per day. The student can't send messages to himself. In early morning Polycarp knew important news that the programming credit will be tomorrow. For this reason it is necessary to urgently inform all groupmates about this news using private messages. Your task is to make a plan of using private messages, so that:  the student i sends no more than ai messages (for all i from 1 to n);  all students knew the news about the credit (initially only Polycarp knew it);  the student can inform the other student only if he knows it himself. Let's consider that all students are numerated by distinct numbers from 1 to n, and Polycarp always has the number 1.In that task you shouldn't minimize the number of messages, the moment of time, when all knew about credit or some other parameters. Find any way how to use private messages which satisfies requirements above.

The first line contains the positive integer n (2 ≤ n ≤ 100) — the number of students.  The second line contains the sequence a1, a2, ..., an (0 ≤ ai ≤ 100), where ai equals to the maximum number of messages which can the i-th student agree to send. Consider that Polycarp always has the number 1.

Print -1 to the first line if it is impossible to inform all students about credit.  Otherwise, in the first line print the integer k — the number of messages which will be sent. In each of the next k lines print two distinct integers f and t, meaning that the student number f sent the message with news to the student number t. All messages should be printed in chronological order. It means that the student, who is sending the message, must already know this news. It is assumed that students can receive repeated messages with news of the credit.  If there are several answers, it is acceptable to print any of them.

NoteIn the first test Polycarp (the student number 1) can send the message to the student number 2, who after that can send the message to students number 3 and 4. Thus, all students knew about the credit.

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.List             (mapAccumL, sortBy, unfoldr, length)
import           Data.Ord              (Down (..), comparing)

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

data Step = Remains Int [(Int, Int)] | Failed deriving Eq

assign::Step->(Int, Int)->(Step, (Int, Int))
assign (Remains cnt knows) (stud, soc) | cnt > 0  =
  let (guy, gsoc) : rest = dropWhile ((==0).snd) knows
      cleared = (guy, gsoc - 1) : rest
      newCnt  = cnt + soc - 1
  in (Remains newCnt cleared,  (guy, stud))
                                       | otherwise = (Failed, undefined)
assign Failed _ = (Failed, undefined)

main :: IO ()
main = do
  void getLine
  (pol: socs) <- getInts
  let studs = sortBy (comparing (Down . snd)) $ zip [2..] socs
      start = Remains pol ((1, pol):studs)
      (result, pairs) = mapAccumL assign start studs
  if result == Failed then putStrLn "-1"
    else do
      print $ length pairs
      forM_ pairs (\(from, to) -> putStrLn $ show from ++ " " ++ show to)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.List             (mapAccumL, sortBy, unfoldr)
import           Data.Ord              (Down (..), comparing)

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

data Step = Remains Int [(Int, Int)] | Failed deriving Eq

assign::Step->(Int, Int)->(Step, (Int, Int))
assign (Remains cnt knows) (stud, soc) | cnt > 0  =
  let (guy, gsoc) : rest = dropWhile ((==0).snd) knows
      cleared = (guy, gsoc - 1) : rest
      newCnt  = cnt + soc - 1
  in (Remains newCnt cleared,  (guy, stud))
                                       | otherwise = (Failed, undefined)
assign Failed _ = (Failed, undefined)

main :: IO ()
main = do
  void getLine
  (pol: socs) <- getInts
  let studs = sortBy (comparing (Down . snd)) $ zip [2..] socs
      start = Remains pol ((1, pol):studs)
      (result, pairs) = mapAccumL assign start studs
  if result == Failed then putStrLn "-1"
    else forM_ pairs (\(from, to) -> putStrLn $ show from ++ " " ++ show to)


The term of this problem is the same as the previous one, the only exception — increased restrictions.

The first line contains two positive integers n and k (1 ≤ n ≤ 100 000, 1 ≤ k ≤ 109) — the number of ingredients and the number of grams of the magic powder. The second line contains the sequence a1, a2, ..., an (1 ≤ ai ≤ 109), where the i-th number is equal to the number of grams of the i-th ingredient, needed to bake one cookie. The third line contains the sequence b1, b2, ..., bn (1 ≤ bi ≤ 109), where the i-th number is equal to the number of grams of the i-th ingredient, which Apollinaria has.

Print the maximum number of cookies, which Apollinaria will be able to bake using the ingredients that she has and the magic powder.

import Data.Maybe (fromJust)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

readInt = fromIntegral . fst . fromJust . BS8.readInteger

readIntsLine = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

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

-- can cook more if powder > then sum of all missing ingridients
canCook need has powder x = (powder >=) . sum . filter ( > 0 ) . map (\(need, has) -> need * x - has) $ zip need has

cook _canCook from to limit
  | to > limit = cook _canCook from limit limit -- limit yourself
  | from == to && _canCook to = to
  | from == to && not (_canCook to) = 0  -- can't cook anything
  | to - from == 1 && _canCook to = to
  | from == cookies && _canCook cookies = cookies -- found answer
  | _canCook cookies = cook _canCook cookies (cookies * 2) limit -- can cook more so search
  | otherwise = cook _canCook from cookies limit -- search on the left
  where cookies = (from + to) `quot` 2

main = do
   [_, powder] <- readLine
   need <- readLine
   has <- readLine
   let maxCookies = (sum has + powder + 1) `quot` sum need
   print $ cook (canCook need has powder) 1 4 maxCookies

{-
Find max x + y + z such as, a * x + b * y + c * z = n
For given a, b, c and n
-}
module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

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

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Integer -> [(Integer, Integer)] -> Integer
main' powder recIng = findMax (0, max' + powder) recIng powder
  where max' = sum $ map snd recIng

findMax :: (Integer, Integer) -> [(Integer, Integer)] -> Integer -> Integer
findMax (start, end) recIng powder
  | (start == end - 1) && canCookMid && (not canCookMid') = start
  | (start == end - 1) && canCookMid && canCookMid' = end
  | start == end = end
  | canCookMid = findMax (mid, end) recIng powder
  | otherwise = findMax (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    canCookMid = canCookN mid recIng powder
    canCookMid' = canCookN (mid + 1) recIng powder

canCookN :: Integer -> [(Integer, Integer)] -> Integer -> Bool
canCookN n recInt powder
  | n == 0 = True
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

{-
Find max x + y + z such as, a * x + b * y + c * z = n
For given a, b, c and n
-}
module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

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

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Integer -> [(Integer, Integer)] -> Integer
main' powder recIng = findMaxCook (0, 2 * 10^9) recIng powder

findMaxCook :: (Integer, Integer) -> [(Integer, Integer)] -> Integer -> Integer
findMaxCook (start, end) recIng powder
  -- | and [not ccN, n' == 1] = base
  | ccEnd = end
  | and [ccN, not ccN1] = mid
  | ccN = findMaxCook (mid, end) recIng powder
  | otherwise = findMaxCook (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    ccN = canCookN mid recIng powder
    ccEnd = canCookN end recIng powder
    ccN1 = canCookN (mid + 1) recIng powder

canCookN :: Integer -> [(Integer, Integer)] -> Integer -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger

prove magicPowder recipe stock n =
  (magicPowder >=) . sum . filter (> 0) . map (\(r,s) -> r * n - s) $ zip recipe stock

bs f l h =
  let
    middle = quot (h - l) 2 + l
  in
    if middle == l then
      middle
    else
      if f middle then
        bs f middle h
      else
        bs f l middle

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

main = do
  [_, magicPowder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $
    bs (prove magicPowder recipe stock)
       -- always possible to bake zero
       0
       -- never possible to bake more than maximum in stock plus all magic powder
       -- even if we need only one gram per cookie
       (maximum stock + magicPowder + 1)

-- priority queue

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger

prove magicPowder recipe stock n =
  (magicPowder >=) . sum . filter (> 0) . map (\(r,s) -> r * n - s) $ zip recipe stock

bs f l h =
  let
    middle = quot (h - l) 2 + l
  in
    if middle == l then
      middle
    else
      if f middle then
        bs f middle h
      else
        bs f l middle

main = do
  [ingrNumber, magicPowder] <- B.getLine >>= return . map readInt . B.words
  recipe <- B.getLine >>= return . map readInt . B.words
  stock <- B.getLine >>= return . map readInt . B.words
  B.putStrLn . B.pack . show $
    bs (prove magicPowder recipe stock)
       -- always possible to bake zero
       0
       -- never possible to bake more than maximum in stock plus all magic powder
       -- even if we need only one gram per cookie
       (maximum stock + magicPowder + 1)

module Main where

import Data.Maybe (fromJust)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

readInt = fromIntegral . fst . fromJust . BS8.readInteger

readIntsLine = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

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

-- can cook more if powder > then sum of all missing ingridients
canCook need has powder x = (powder >=) . sum . filter ( > 0 ) . map (\(need, has) -> need * x - has) $ zip need has

cook _canCook from to limit
  | to > limit = cook _canCook from limit limit -- limit yourself
  | from == to = 0 -- can't cook anything
  | to - from == 1 && _canCook to = to
  | from == cookies && _canCook cookies = cookies -- found answer
  | _canCook cookies = cook _canCook cookies (cookies * 2) limit -- can cook more so search
  | otherwise = cook _canCook from cookies limit -- search on the left
  where cookies = (from + to) `quot` 2

main = do
   [_, powder] <- readLine
   need <- readLine
   has <- readLine
   let maxCookies = (sum has + powder + 1) `quot` sum need
   print $ cook (canCook need has powder) 1 4 maxCookies

{-
Find max x + y + z such as, a * x + b * y + c * z = n
For given a, b, c and n
-}
module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

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

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMax (0, max' + powder) recIng powder
  where max' = sum $ map snd recIng

findMax :: (Int, Int) -> [(Int, Int)] -> Int -> Int
findMax (start, end) recIng powder
  | (start == end - 1) && canCookMid && (not canCookMid') = start
  | (start == end - 1) && canCookMid && canCookMid' = end
  | start == end = end
  | canCookMid = findMax (mid, end) recIng powder
  | otherwise = findMax (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    canCookMid = canCookN mid recIng powder
    canCookMid' = canCookN (mid + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | n == 0 = True
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

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

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMaxCook (0, 2 * 10^9) recIng powder

findMaxCook :: (Int, Int) -> [(Int, Int)] -> Int -> Int
findMaxCook (start, end) recIng powder
  -- | and [not ccN, n' == 1] = base
  | ccEnd = end
  | and [ccN, not ccN1] = mid
  | ccN = findMaxCook (mid, end) recIng powder
  | otherwise = findMaxCook (start, mid) recIng powder
  where
    mid = start + ((end - start) `div` 2)
    ccN = canCookN mid recIng powder
    ccEnd = canCookN end recIng powder
    ccN1 = canCookN (mid + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

{-
Find max x + y + z such as, a * x + b * y + c * z = n
For given a, b, c and n
-}
module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

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

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMaxCook (0, 2 * 10^9) recIng powder

findMaxCook :: (Int, Int) -> [(Int, Int)] -> Int -> Int
findMaxCook (start, end) recIng powder
  -- | and [not ccN, n' == 1] = base
  | ccEnd = end
  | and [ccN, not ccN1] = mid
  | ccN = findMaxCook (mid, end) recIng powder
  | otherwise = findMaxCook (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    ccN = canCookN mid recIng powder
    ccEnd = canCookN end recIng powder
    ccN1 = canCookN (mid + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

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

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMaxCook (0, max' + powder) recIng powder
  where max' = foldr (\(_, y) agg -> agg + y ) 0 recIng

findMaxCook :: (Int, Int) -> [(Int, Int)] -> Int -> Int
findMaxCook (start, end) recIng powder
  -- | and [not ccN, n' == 1] = base
  | ccEnd = end
  | and [ccN, not ccN1] = mid
  | ccN = findMaxCook (mid, end) recIng powder
  | otherwise = findMaxCook (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    ccN = canCookN mid recIng powder
    ccEnd = canCookN end recIng powder
    ccN1 = canCookN (mid + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

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

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ 1000000000-- main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMaxCook 1 0 recIng powder

findMaxCook :: Int -> Int -> [(Int, Int)] -> Int -> Int
findMaxCook n base recIng powder
  | and [not ccN, n' == 1] = base
  | and [ccN, not ccN1] = n'
  | ccN = findMaxCook (n * 2) base recIng powder
  | otherwise = findMaxCook 1 (base + (n `div` 2)) recIng powder
  where
    n' = n + base
    ccN = canCookN n' recIng powder
    ccN1 = canCookN (n' + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

-- priority queue

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger

prove magicPowder recipe stock n =
  (magicPowder >=) . sum . map (\(r,s) -> r * n - s) $ zip recipe stock

bs f l h =
  let
    middle = quot (h - l) 2 + l
  in
    if middle == l then
      middle
    else
      if f middle then
        bs f middle h
      else
        bs f l middle

main = do
  [ingrNumber, magicPowder] <- B.getLine >>= return . map readInt . B.words
  recipe <- B.getLine >>= return . map readInt . B.words
  stock <- B.getLine >>= return . map readInt . B.words
  B.putStrLn . B.pack . show $
    bs (prove magicPowder recipe stock)
       0
       (maximum stock + magicPowder + 1)


Dima has a hamsters farm. Soon N hamsters will grow up on it and Dima will sell them in a city nearby.Hamsters should be transported in boxes. If some box is not completely full, the hamsters in it are bored, that's why each box should be completely full with hamsters.Dima can buy boxes at a factory. The factory produces boxes of K kinds, boxes of the i-th kind can contain in themselves ai hamsters. Dima can buy any amount of boxes, but he should buy boxes of only one kind to get a wholesale discount.Of course, Dima would buy boxes in such a way that each box can be completely filled with hamsters and transported to the city. If there is no place for some hamsters, Dima will leave them on the farm.Find out how many boxes and of which type should Dima buy to transport maximum number of hamsters.

The first line contains two integers N and K (0 ≤ N ≤ 1018, 1 ≤ K ≤ 105) — the number of hamsters that will grow up on Dima's farm and the number of types of boxes that the factory produces. The second line contains K integers a1, a2, ..., aK (1 ≤ ai ≤ 1018 for all i) — the capacities of boxes.

Output two integers: the type of boxes that Dima should buy and the number of boxes of that type Dima should buy. Types of boxes are numbered from 1 to K in the order they are given in input. If there are many correct answers, output any of them.

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInteger, readInteger, words)
import qualified Data.Maybe as M (fromJust)
import Data.Int as I (Int64)
import Data.Function as F (on)
import Data.List as L (maximumBy)

readInt = fromIntegral . fst . M.fromJust . C.readInteger

run n (i, x) = (n - n `mod` x, [i, n `div` x])
xshow (_, xs) = unwords $ map show xs

main = do
    (map readInt . C.words -> [n :: I.Int64, _]) <- B.getLine
    (map readInt . C.words -> xs :: [I.Int64]) <- B.getLine
    putStrLn $ xshow $ L.maximumBy (compare `F.on` fst) $ map (run n) $ zip [1..] xs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, readInteger, words)
import qualified Data.Maybe as M (fromJust)
import Data.Int as I (Int64)
import Data.Function as F (on)
import Data.List as L (maximumBy)

readInt = fromIntegral . fst . M.fromJust . C.readInt

run n (i, x) = (n - n `mod` x, [i, n `div` x])
xshow (_, xs) = unwords $ map show xs

main = do
    (map readInt . C.words -> [n :: I.Int64, _]) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    putStrLn $ xshow $ L.maximumBy (compare `F.on` fst) $ map (run n) $ zip [1..] xs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, readInteger, words)
import qualified Data.Maybe as M (fromJust)
import Data.Int as I (Int64)
import Data.Function as F (on)
import Data.List as L (maximumBy)

readInt = fromIntegral . fst . M.fromJust . C.readInt

run n (i, x) = (n - n `mod` x, [i, x])
xshow (_, xs) = unwords $ map show xs

main = do
    (map readInt . C.words -> [n :: I.Int64, _]) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    putStrLn $ xshow $ L.maximumBy (compare `F.on` fst) $ map (run n) $ zip [1..] xs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, readInteger, words)
import qualified Data.Maybe as M (fromJust)
import Data.Int as I (Int64)
import Data.Function as F (on)
import Data.List as L (maximumBy)

readInt = fromIntegral . fst . M.fromJust . C.readInt

run n (i, x) = (n - n `mod` x, [i, n `div` x])
xshow (_, xs) = unwords $ map show xs

main = do
    (map readInt . C.words -> [n :: I.Int64, _]) <- B.getLine
    (map readInt . C.words -> xs :: [I.Int64]) <- B.getLine
    putStrLn $ xshow $ L.maximumBy (compare `F.on` fst) $ map (run n) $ zip [1..] xs


Vasiliy likes to rest after a hard work, so you may often meet him in some bar nearby. As all programmers do, he loves the famous drink "Beecola", which can be bought in n different shops in the city. It's known that the price of one bottle in the shop i is equal to xi coins.Vasiliy plans to buy his favorite drink for q consecutive days. He knows, that on the i-th day he will be able to spent mi coins. Now, for each of the days he want to know in how many different shops he can buy a bottle of "Beecola".

The first line of the input contains a single integer n (1 ≤ n ≤ 100 000) — the number of shops in the city that sell Vasiliy's favourite drink. The second line contains n integers xi (1 ≤ xi ≤ 100 000) — prices of the bottles of the drink in the i-th shop. The third line contains a single integer q (1 ≤ q ≤ 100 000) — the number of days Vasiliy plans to buy the drink. Then follow q lines each containing one integer mi (1 ≤ mi ≤ 109) — the number of coins Vasiliy can spent on the i-th day.

Print q integers. The i-th of them should be equal to the number of shops where Vasiliy will be able to buy a bottle of the drink on the i-th day.

NoteOn the first day, Vasiliy won't be able to buy a drink in any of the shops.On the second day, Vasiliy can buy a drink in the shops 1, 2, 3 and 4.On the third day, Vasiliy can buy a drink only in the shop number 1.Finally, on the last day Vasiliy can buy a drink in any shop.

{-# OPTIONS -XBangPatterns #-}
import Data.List (sort)
import Data.Array.Unboxed
main = do
	n <- readLn :: IO Int
	a <- fmap (listArray (1,n) . sort . ((map read) . words)) getLine :: IO (UArray Int Int)
	q <- readLn :: IO Int

	let binary_search !l !r !e
			|a!l > e || l==r = l-1
			|r-l == 1 = l
			|otherwise =
				let m = (l+r) `div` 2
				in if e < a!m
						then binary_search l m e
						else binary_search m r e

	flip mapM [1..q] $ \i -> do
		x <- readLn :: IO Int
		let ans = binary_search 1 n x
		if a!(ans+1) <= x
			then print $ ans+1
			else print ans

import Data.List (sort)
import Data.Array.Unboxed
main = do
	n <- readLn :: IO Int
	a <- fmap (listArray (1,n) . sort . ((map read) . words)) getLine :: IO (UArray Int Int)
	q <- readLn :: IO Int

	let binary_search l r e
			|a!l > e || l==r = l-1
			|r-l == 1 = l
			|otherwise =
				let m = (l+r) `div` 2
				in if e < a!m
						then binary_search l m e
						else binary_search m r e

	flip mapM [1..q] $ \i -> do
		x <- readLn :: IO Int
		let ans = binary_search 1 n x
		if a!(ans+1) <= x
			then print $ ans+1
			else print ans

import Control.Applicative ((<$>))
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Control.Monad (replicateM)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  xs <- readInts
  [q] <- readInts
  ms <- replicateM q (readInt' <$> getLine)

  let
    a = listArray (1, n) $ sort xs :: UArray Int Int

    count x = search 1 n
      where
        search l r
          | l >= r = if v<= x then l else 0
          | x >= v = search m r
          | x < v = search l (m-1)
          where
            m = (l+r+1)`div`2
            v = a!m

  putStr $ unlines $ map show $ map count ms

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = forM [1..3] (return C.getLine)>>= (\(a:bs:c:[]) ->solve.([map rIn $ C.words bs] ++).(\ls->[ls])=<<forM [1..rIn c] (\i->rIn<$>C.getLine) )
solve [xs,ys]= let ma_x = maximum xs; zs = zip [1..] $ uncurry (zipWith (\(a1,a2) (b1,b2)->(a1,(a2,b2)))) $ (id&&&tail)  $ scanl (\(b1,b2) (a1,a2)->(b1+a1,a2) ) (0,0)  $ map (length&&&head) $ group $ sort xs; ms = Map.fromList zs; len = length zs; tre=tre_e ((Map.!) ms) (1,len); len2= length xs in forM_ ys $ \i-> if i>=ma_x then print len2 else print $ slv1 i tre
tre_e f (x,y) = unfoldTree g (x,y)
     where g (a,b) = let z= (a+)$ div (b-a) 2 in if a>=b then (f a, []) else if a/=z then (f z, [(a,z-1),(z+1,b)]) else (f z, [(z+1,b)])
slv1 n (Node (x,(y,z)) ts) = if n>=y&&n<z then x else if n>=z then slv1 n (last ts) else slv1 n (head ts)

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

import Control.Monad (replicateM, mapM_)
import Data.List (sort)
import Data.Functor ((<$>))

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T

import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as I

{-
import Data.IntMultiSet (IntMultiSet)
import qualified Data.IntMultiSet as I

parseInt :: Text -> Int
parseInt !t =
  case T.decimal t of
    Left _ -> error "wtf"
    Right (x, _) -> x

beersI :: IntMultiSet -> [Int] -> [Int]
beersI !prices !coins = map (\c -> I.size (I.filter (<=c) prices)) coins

mainI :: IO ()
mainI = do
  n <- parseInt <$> T.getLine
  prices <- map parseInt . T.splitOn " " <$> T.getLine
  q <- parseInt <$> T.getLine
  coins <- replicateM q (parseInt <$> T.getLine)
  mapM_ print (beersI (I.fromList prices) coins)
  --mapM_ print (beers (sort prices) coins)
 -}

{- prefix sums of sorted int list -}
prefixSum :: [Int] -> IntMap Int
prefixSum xs0 = go xs0 0 0 I.empty
  where
    go !xs y i ps =
      case xs of
        [] -> (I.insert y i ps)
        x:xs' | x <= y -> go xs' y (i+1) ps
              | otherwise -> go xs (y+1) i (I.insert y i ps)

beers :: [Int] -> [Int] -> [Int]
beers !prices !coins = map (\c -> length (takeWhile (<=c) prices)) coins

parseIntS :: String-> Int
parseIntS !s = read s

splitS :: String -> [String]
splitS !s0 = splitH s0 "" where
  splitH !cs !ds =
    case cs of
      "" -> if null ds then [] else [reverse ds]
      ' ':cs' -> if null ds then splitH cs' ds else reverse ds : splitH cs' ""
      c:cs' -> splitH cs' (c:ds)

mainS :: IO ()
mainS = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  mapM_ print (beers (sort prices) coins)

mainIM :: IO ()
mainIM = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  let ps = prefixSum (sort prices)
  mapM_ (\c -> print (I.findWithDefault (length prices) c ps)) coins

main = mainIM

import Data.Array
import Data.List
import Control.Monad
main = do
  n <- readLn
  ps <- listArray (0,n) . (0 :) . sort . map read . words <$> getLine
  let bsearch g = go 0 n where
        go a b | a >= b = b
               | g >= v = go m b
               | otherwise = go a (m-1)
          where m = (a + b + 1) `div` 2
                v = ps!m :: Int
  q <- readLn
  replicateM_ q $ print . bsearch =<< readLn

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

-- for codeforces
import Data.Ord
sortOn f =
  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))

type I = Int

main :: IO ()
main = do
  n <- readi <$> getLine
  xs <- map readi . words <$> getLine
  q <- readi <$> getLine
  ms <- map readi <$> replicateM q getLine
  mapM_ print $ fst . unzip . sortOn snd $ solve (sortOn fst $ zip ms [1..]) (sort xs) 0

solve :: [(I, I)] -> [I] -> I -> [(I, I)]
solve [] _ _ = []
solve ((q, p):qs) xs n =
  (n', p) : solve qs (dropWhile (<= q) xs) n' where
    n' = n + length (takeWhile (<= q) xs)

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

readi :: String -> I
readi = read

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

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

import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.Map as M
import Data.Maybe

main = do
		getLine
		n<-  sort <$> map read <$> words <$> getLine ::IO [Int]
		let m = M.fromAscList $ zip n [1..]
		getLine
		q<- map read <$> words <$> getContents :: IO [Int]
		mapM_ print $ map (\z-> snd (fromMaybe (0,0)  (M.lookupLE z m))) q

import Data.List (sort)
import Data.Array.Unboxed
main = do
	n <- readLn :: IO Int
	a <- fmap (listArray (1,n) . sort . ((map read) . words)) getLine :: IO (UArray Int Int)
	q <- readLn :: IO Int

	let binary_search l r e =
		if r-l <= 1
			then l
			else
				let
					m = (l+r) `div` 2
					val = a!m
				in if e <= val
					then binary_search l m e
					else binary_search m r e

	flip mapM [1..q] $ \i -> do
		x <- readLn :: IO Int
		let ans = binary_search 1 (n-1) x
		if (a!ans > x) then print $ ans-1
		else if (a!(ans+1) <= x) then print $ ans+1
		else print ans

import Data.List (sort)
import Data.Array.Unboxed
main = do
	n <- readLn :: IO Int
	a <- fmap (listArray (1,n) . sort . ((map read) . words)) getLine :: IO (UArray Int Int)
	q <- readLn :: IO Int

	let binary_search l r e =
		if l>=r
			then l
			else
				let
					m = (l+r) `div` 2
					val = a!m
				in if val == e
					then m
					else if e < val
							then binary_search l m e
							else binary_search (m+1) r e

	flip mapM [1..q] $ \i -> do
		x <- readLn :: IO Int
		let ans = binary_search 1 n x
		if (a!ans > x)
			then print $ ans-1
			else print ans

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = forM [1..3] (return C.getLine)>>= (\(a:bs:c:[]) ->solve.([map rIn $ C.words bs] ++).(\ls->[ls])=<<forM [1..rIn c] (\i->rIn<$>C.getLine) )
solve [xs,ys]= let ma_x = maximum xs; zs = zip [1..] $ uncurry (zipWith (\(a1,a2) (b1,b2)->(a1,(a2,b2)))) $ (id&&&tail)  $ scanl (\(b1,b2) (a1,a2)->(b1+a1,a2) ) (0,0)  $ map (length&&&head) $ group $ sort xs; ms = Map.fromList zs; len = length zs; tre=tre_e ((Map.!) ms) (1,len) in forM_ ys $ \i-> if i>=ma_x then print len else print $ slv1 i tre
tre_e f (x,y) = unfoldTree g (x,y)
     where g (a,b) = let z= (a+)$ div (b-a) 2 in if a>=b then (f a, []) else if a/=z then (f z, [(a,z-1),(z+1,b)]) else (f z, [(z+1,b)])
slv1 n (Node (x,(y,z)) ts) = if n>=y&&n<z then x else if n>=z then slv1 n (last ts) else slv1 n (head ts)

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

import Control.Monad (replicateM, mapM_)
import Data.List (sort)
import Data.Functor ((<$>))

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T

import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as I

{-
import Data.IntMultiSet (IntMultiSet)
import qualified Data.IntMultiSet as I

parseInt :: Text -> Int
parseInt !t =
  case T.decimal t of
    Left _ -> error "wtf"
    Right (x, _) -> x

beersI :: IntMultiSet -> [Int] -> [Int]
beersI !prices !coins = map (\c -> I.size (I.filter (<=c) prices)) coins

mainI :: IO ()
mainI = do
  n <- parseInt <$> T.getLine
  prices <- map parseInt . T.splitOn " " <$> T.getLine
  q <- parseInt <$> T.getLine
  coins <- replicateM q (parseInt <$> T.getLine)
  mapM_ print (beersI (I.fromList prices) coins)
  --mapM_ print (beers (sort prices) coins)
 -}

{- prefix sums of sorted int list -}
prefixSum :: [Int] -> IntMap Int
prefixSum xs0 = go xs0 0 0 I.empty
  where
    go !xs y i ps =
      case xs of
        [] -> (I.insert y i ps)
        x:xs' | x <= y -> go xs' y (i+1) ps
              | otherwise -> go xs (y+1) i (I.insert y i ps)

beers :: [Int] -> [Int] -> [Int]
beers !prices !coins = map (\c -> length (takeWhile (<=c) prices)) coins

parseIntS :: String-> Int
parseIntS !s = read s

splitS :: String -> [String]
splitS !s0 = splitH s0 "" where
  splitH !cs !ds =
    case cs of
      "" -> if null ds then [] else [reverse ds]
      ' ':cs' -> if null ds then splitH cs' ds else reverse ds : splitH cs' ""
      c:cs' -> splitH cs' (c:ds)

mainS :: IO ()
mainS = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  mapM_ print (beers (sort prices) coins)

mainIM :: IO ()
mainIM = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  let ps = prefixSum (sort prices)
  mapM_ (\c -> print (I.findWithDefault 0 c ps)) coins

main = mainIM

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

import Control.Monad (replicateM, mapM_)
import Data.List (sort)
import Data.Functor ((<$>))

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T

import Data.Set (Set)
import qualified Data.Set as S

parseInt :: Text -> Int
parseInt !t =
  case T.decimal t of
    Left _ -> error "wtf"
    Right (x, _) -> x

beersS :: Set Int -> [Int] -> [Int]
beersS !prices !coins = map (\c -> S.size (S.filter (<=c) prices)) coins

main :: IO ()
main = do
  n <- parseInt <$> T.getLine
  prices <- map parseInt . T.splitOn " " <$> T.getLine
  q <- parseInt <$> T.getLine
  coins <- replicateM q (parseInt <$> T.getLine)
  mapM_ print (beersS (S.fromList prices) coins)
  --mapM_ print (beers (sort prices) coins)

beers :: [Int] -> [Int] -> [Int]
beers !prices !coins = map (\c -> length (takeWhile (<=c) prices)) coins

parseIntS :: String-> Int
parseIntS !s = read s

splitS :: String -> [String]
splitS !s0 = splitH s0 "" where
  splitH !cs !ds =
    case cs of
      "" -> if null ds then [] else [reverse ds]
      ' ':cs' -> if null ds then splitH cs' ds else reverse ds : splitH cs' ""
      c:cs' -> splitH cs' (c:ds)

mainS :: IO ()
mainS = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  mapM_ print (beers (sort prices) coins)

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

-- for codeforces
import Data.Ord
sortOn f =
  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))

type I = Int

main :: IO ()
main = do
  n <- readi <$> getLine
  xs <- map readi . words <$> getLine
  q <- readi <$> getLine
  ms <- map readi <$> replicateM q getLine
  print $ fst . unzip . sortOn snd $ solve (sortOn fst $ zip ms [1..]) (sort xs) 0

solve :: [(I, I)] -> [I] -> I -> [(I, I)]
solve [] _ _ = []
solve ((q, p):qs) xs n =
  (n', p) : solve qs (dropWhile (<= q) xs) n' where
    n' = n + length (takeWhile (<= q) xs)

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

readi :: String -> I
readi = read

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

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


Polycarpus has a computer with n processors. Also, his computer has n memory cells. We'll consider the processors numbered by integers from 1 to n and that the memory cells are consecutively numbered by integers from 1 to n.Polycarpus needs to come up with a parallel program model. For each memory cell number i this program must record the value n - i to this cell. In other words, for each cell you've got to find the distance to cell n.Let's denote the value that is written in the i-th cell as ai. Initially, ai = 1 (1 ≤ i < n) and an = 0. We will consider that only processor i can write values in the memory cell number i. All processors can read an information from some cell (several processors can read an information from some cell simultaneously).The parallel program is executed in several steps. During each step we execute the parallel version of the increment operation. Executing the parallel version of the increment operation goes as follows:  Each processor independently of the other ones chooses some memory cell. Let's say that processor i has chosen a cell with number ci (1 ≤ ci ≤ n).  All processors simultaneously execute operation ai = ai + aci. Help Polycarpus come up with the parallel program model that is executed in exactly k steps. Calculate the operations that need to be executed. Note that after k steps for all i's value ai must be equal n - i.

The first line contains two space-separated integers n and k (1 ≤ n ≤ 104, 1 ≤ k ≤ 20). It is guaranteed that at the given n and k the required sequence of operations exists.

Print exactly n·k integers in k lines. In the first line print numbers c1, c2, ..., cn (1 ≤ ci ≤ n) for the first increment operation. In the second line print the numbers for the second increment operation. In the k-th line print the numbers for the k-th increment operation. As a result of the printed operations for any i value ai must equal n - i.

import Data.Bits

main :: IO ()
main = do
  [n, m] <- fmap (map read . words) getLine
  let ans = [take n $ (0:) $ cycle $ replicate b 0 ++ replicate b b |
        b <- map (2^) [0 .. m - 1]]
  putStr $ unlines $ [unwords $ reverse $ map (show . (n-)) i | i <- ans]

import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printList $ map (map (n-) . reverse . take n . operations . (2^)) [0..k-1]

operations k = replicate k 0 ++ [0..k+1] ++ repeat k

printList = putStrLn . concat . intersperse " " . map show

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate)

getLine' :: Int -> Int -> [Int]
getLine' n i  =  reverse $ take n $ concat
    [
      [n],
      replicate (2^(i-1)) n,
      [n-1, n-2 .. n-2^(i-1)],
      repeat (n-2^(i-1))
    ]

main :: IO ()
main  =  do
    [n, k]  <-  reads
    mapM_ (prints . getLine' n) [1..k]

  where

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

l=map(\n->0:replicate(2^n)0++[1..2^n]++repeat(2^n))[0..]
s[n,k]=map(map(n-))$map reverse$take k(map(take n)l)
main=interact$unlines.map(unwords.map show).s.map read.words

import Data.Bits

main :: IO ()
main = do
  [n, m] <- fmap (map read . words) getLine
  let ans = [[if (i == 2 * b || (i /= b && j)) then b else 0 | (i, j) <- zip [0 ..] d] |
        b <- map (2^) [0 .. m - 1],
        let d = take n $ cycle $ replicate b False ++ replicate b True]
  putStr $ unlines $ [unwords $ reverse $ map (show . (n-)) i | i <- ans]

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2] ++ (drop 4 $ operations 3 2)):(map (\k -> operations (1 `shiftL` k) k) [2..])

operations mask k = map getCi [0..]
    where
        getCi x | x <= mask          = 0
                | isPowerOfTwo x     = x
                | x .&. mask == mask = k
                | otherwise          = 0

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2] ++ (drop 4 $ operations' 3 2)):(map (\k -> operations $ 1 `shiftL` k) [2..])

operations k = operations' k k

operations' mask k = map getCi [0..]
    where
        getCi x | x <= mask          = 0
                | isPowerOfTwo x     = x
                | x .&. mask == mask = k
                | otherwise          = 0

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2] ++ (drop 4 $ operations' 3 2)):(map (\k -> operations $ 1 `shiftL` k) [2..])

operations k = operations' k k

operations' mask k = map getCi [0..]
    where
        getCi x | x <= mask          = 0
                | x .&. (k - 1) == 0 = x
                | x .&. mask == mask = k
                | otherwise          = 0

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2] ++ (drop 4 $ operations 3 2)):(map (\k -> operations (1 `shiftL` k) k) [2..])

operations mask k = map getCi [0..]
    where
        getCi x | x <= mask          = 0
                | isPowerOfTwo x     = x
                | x .&. mask == mask = mask
                | otherwise          = 0

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2,2] ++ (concat $ repeat [0,0,2,0])):(map operations [2..])

operations k = map getCi [0..]
    where
        bit = 1 `shiftL` k
        getCi x | x <= bit         = 0
                | isPowerOfTwo x   = x
                | x .&. bit == bit = bit
                | otherwise        = 0

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,1,2] ++ (concat $ repeat [0,0,1,0])):(map operations [2..])

operations k = map getCi [0..]
    where
        bit = 1 `shiftL` k
        getCi x | x <= bit         = 0
                | isPowerOfTwo x   = x
                | x .&. bit == bit = bit

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show


Om Nom is the main character of a game "Cut the Rope". He is a bright little monster who likes visiting friends living at the other side of the park. However the dark old parks can scare even somebody as fearless as Om Nom, so he asks you to help him.  The park consists of 2n + 1 - 1 squares connected by roads so that the scheme of the park is a full binary tree of depth n. More formally, the entrance to the park is located at the square 1. The exits out of the park are located at squares 2n, 2n + 1, ..., 2n + 1 - 1 and these exits lead straight to the Om Nom friends' houses. From each square i (2 ≤ i < 2n + 1) there is a road to the square . Thus, it is possible to go from the park entrance to each of the exits by walking along exactly n roads.    To light the path roads in the evening, the park keeper installed street lights along each road. The road that leads from square i to square  has ai lights.Om Nom loves counting lights on the way to his friend. Om Nom is afraid of spiders who live in the park, so he doesn't like to walk along roads that are not enough lit. What he wants is that the way to any of his friends should have in total the same number of lights. That will make him feel safe. He asked you to help him install additional lights. Determine what minimum number of lights it is needed to additionally place on the park roads so that a path from the entrance to any exit of the park contains the same number of street lights. You may add an arbitrary number of street lights to each of the roads.

The first line contains integer n (1 ≤ n ≤ 10) — the number of roads on the path from the entrance to any exit. The next line contains 2n + 1 - 2 numbers a2, a3, ... a2n + 1 - 1 — the initial numbers of street lights on each road of the park. Here ai is the number of street lights on the road between squares i and . All numbers ai are positive integers, not exceeding 100.

Print the minimum number of street lights that we should add to the roads of the park to make Om Nom feel safe.

NotePicture for the sample test. Green color denotes the additional street lights.

import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import qualified Data.Foldable as Fold
import Data.Int
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Ord
import qualified Data.IntMap.Strict as IM
import Data.Traversable
import qualified Data.Sequence as Seq
--import Prelude hiding (foldl)
import qualified Data.Set as Set
import qualified Data.IntSet as IS
import Debug.Trace

data Tree = Node Int Int Tree Tree | Leaf
  deriving Show

main = do
  firstWords <- fmap BS.words BS.getLine
  let Just (n, _) = BS.readInt $ firstWords !! 0
  lines <- fmap BS.lines BS.getContents
  let firstLine = head lines
  let arrayN = (2^(n+1)-2)
  let lights = array (1, arrayN) $ zip [1..arrayN] (readLights firstLine)
  let tree = buildTree 1 (arrayN `div` 2) lights
  let maxLight = maxLights tree
  let x = lightsNeeded maxLight tree
  --putStrLn (show maxLight)
  --putStrLn (show tree)
  putStrLn (show x)

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

buildTree :: Int -> Int -> Array Int Int -> Tree
buildTree n max lights =
  if n > max
    then Leaf
    else let
      lTree = buildTree (2*n) max lights
      rTree = buildTree (2*n + 1) max lights
    in
      Node (lights ! (2*n-1)) (lights ! (2*n)) lTree rTree

maxLights :: Tree -> Int
maxLights Leaf = 0
maxLights (Node ln rn lTree rTree) =
  max (ln + maxLights lTree) (rn + maxLights rTree)

lightsNeeded :: Int -> Tree -> Int
lightsNeeded 0 Leaf = 0
lightsNeeded goal (Node ln rn lTree rTree) =
  let
    ln' = goal - (maxLights lTree)
    rn' = goal - (maxLights rTree)
    x = (ln' - ln) + (lightsNeeded (goal - ln') lTree) +
      (rn' - rn) + (lightsNeeded (goal - rn') rTree)
  in
    --trace ("ln: " ++ (show ln) ++ " -> " ++ (show ln') ++ " rn: " ++ (show rn) ++ " -> " ++ (show rn')) x
    x

main = do
 y <- getLine
 if y=="0" then putStrLn "0" else do
    x <- getLine
    putStrLn $ show $ solve (read y)  (map read $ words x)

solve d x = s x (2^d-3)

s x (-2) = 0
s x to = abs(lSon - rSon) +
    s ((take to x)++[(x!!to) + max lSon rSon]++(drop (to+1) x)) (to-1)
    where
    lSon = x!!(2*to+2)
    rSon = x!!(2*to+3)

import Data.Bits(shiftL)
import Control.Monad

main = do
    n <- readInt `fmap` getLine
    a <- (map readInt . words) `fmap` getLine
    print (solveTaskB ((1 `shiftL` (n + 1)) - 1) (0 : a))

solveTaskB length lights =
    fst $ solveForIndex $ 0
        where
            solveForIndex index = if index * 2 + 2 >= length
                then (0, lights !! index)
                else (abs (lDep - rDep) + lAns + rAns, (lights !! index) + (max lDep rDep))
                    where
                        lAns = fst lSon
                        rAns = fst rSon
                        lDep = snd lSon
                        rDep = snd rSon
                        lSon = solveForIndex (2 * index + 1)
                        rSon = solveForIndex (2 * index + 2)

readInt = read :: String -> Int

import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import qualified Data.Foldable as Fold
import Data.Int
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Ord
import qualified Data.IntMap.Strict as IM
import Data.Traversable
import qualified Data.Sequence as Seq
--import Prelude hiding (foldl)
import qualified Data.Set as Set
import qualified Data.IntSet as IS
import Debug.Trace

data Tree = Node Int Int Tree Tree | Leaf
  deriving Show

main = do
  firstWords <- fmap BS.words BS.getLine
  let Just (n, _) = BS.readInt $ firstWords !! 0
  lines <- fmap BS.lines BS.getContents
  let firstLine = head lines
  let lights = readLights firstLine
  let tree = buildTree (2^(n+1) - 2) lights
  let maxLight = maxLights tree
  let x = lightsNeeded maxLight tree
  putStrLn (show x)

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

buildTree :: Int -> [Int] -> Tree
buildTree 0 [] = Leaf
buildTree n (ln:rn:remLights) =
  let
    n' = (n `div` 2) - 1
    (lLights, rLights) = splitAt n' remLights
  in
    Node ln rn (buildTree n' lLights) (buildTree n' rLights)

maxLights :: Tree -> Int
maxLights Leaf = 0
maxLights (Node ln rn lTree rTree) =
  max (ln + maxLights lTree) (rn + maxLights rTree)

lightsNeeded :: Int -> Tree -> Int
lightsNeeded 0 Leaf = 0
lightsNeeded goal (Node ln rn lTree rTree) =
  let
    ln' = goal - (maxLights lTree)
    rn' = goal - (maxLights rTree)
  in
    (ln' - ln) + (lightsNeeded (goal - ln') lTree) +
      (rn' - rn) + (lightsNeeded (goal - rn') rTree)

import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import qualified Data.Foldable as Fold
import Data.Int
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Ord
import qualified Data.IntMap.Strict as IM
import Data.Traversable
import qualified Data.Sequence as Seq
--import Prelude hiding (foldl)
import qualified Data.Set as Set
import qualified Data.IntSet as IS
import Debug.Trace

data Tree = Node Int Int Tree Tree | Leaf
  deriving Show

main = do
  firstWords <- fmap BS.words BS.getLine
  let Just (n, _) = BS.readInt $ firstWords !! 0
  lines <- fmap BS.lines BS.getContents
  let firstLine = head lines
  let lights = readLights firstLine
  let (tree, _) = buildTree n lights
  let maxLight = maxLights tree
  let x = lightsNeeded maxLight tree
  putStrLn (show x)

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

buildTree :: Int -> [Int] -> (Tree, [Int])
buildTree 0 xs = (Leaf, xs)
buildTree n (ln:rn:remLights) =
  let
    (lTree, remLights') = buildTree (n-1) remLights
    (rTree, remLights'') = buildTree (n-1) remLights'
  in
    (Node ln rn lTree rTree, remLights'')

maxLights :: Tree -> Int
maxLights Leaf = 0
maxLights (Node ln rn lTree rTree) =
  max (ln + maxLights lTree) (rn + maxLights rTree)

lightsNeeded :: Int -> Tree -> Int
lightsNeeded 0 Leaf = 0
lightsNeeded goal (Node ln rn lTree rTree) =
  let
    ln' = goal - (maxLights lTree)
    rn' = goal - (maxLights rTree)
  in
    (ln' - ln) + (lightsNeeded (goal - ln') lTree) +
      (rn' - rn) + (lightsNeeded (goal - rn') rTree)

main = do
 y <- getLine
 if y=="0" then putStrLn "0" else do
    x <- getLine
    putStrLn $ show $ solve (read y)  (map read $ words x)

solve 0 x = 0
solve d x = (delt rest) + solve (d-1) (zipWith (+) (take ((2^d)-2) x) (comb rest))
 where rest = drop ((2^d)-2) x

delt (x:y:[]) = abs (x-y)
delt (x:y:xs) = (abs (x-y)) + (delt xs)
delt (x:[])   = 0

comb (x:y:[]) = [max x y]
comb (x:y:xs) = (max x y):(comb xs)

import Data.Bits(shiftL)
import Control.Monad

main = do
    n <- readInt `fmap` getLine
    a <- (map readInt . words) `fmap` getLine
    print (solveTaskB ((1 `shiftL` (n + 1)) - 2) a)

solveTaskB length lights =
    fst $ solveForIndex $ 0
        where
            solveForIndex index = if index * 2 + 2 >= length
                then (0, lights !! index)
                else (abs (lDep - rDep) + lAns + rAns, (lights !! index) + (max lDep rDep))
                    where
                        lAns = fst lSon
                        rAns = fst rSon
                        lDep = snd lSon
                        rDep = snd rSon
                        lSon = solveForIndex (2 * index + 1)
                        rSon = solveForIndex (2 * index + 2)

readInt = read :: String -> Int


Polycarp and his friends want to visit a new restaurant. The restaurant has $$$n$$$ tables arranged along a straight line. People are already sitting at some tables. The tables are numbered from $$$1$$$ to $$$n$$$ in the order from left to right. The state of the restaurant is described by a string of length $$$n$$$ which contains characters "1" (the table is occupied) and "0" (the table is empty).Restaurant rules prohibit people to sit at a distance of $$$k$$$ or less from each other. That is, if a person sits at the table number $$$i$$$, then all tables with numbers from $$$i-k$$$ to $$$i+k$$$ (except for the $$$i$$$-th) should be free. In other words, the absolute difference of the numbers of any two occupied tables must be strictly greater than $$$k$$$.For example, if $$$n=8$$$ and $$$k=2$$$, then:  strings "10010001", "10000010", "00000000", "00100000" satisfy the rules of the restaurant;  strings "10100100", "10011001", "11111111" do not satisfy to the rules of the restaurant, since each of them has a pair of "1" with a distance less than or equal to $$$k=2$$$. In particular, if the state of the restaurant is described by a string without "1" or a string with one "1", then the requirement of the restaurant is satisfied.You are given a binary string $$$s$$$ that describes the current state of the restaurant. It is guaranteed that the rules of the restaurant are satisfied for the string $$$s$$$.Find the maximum number of free tables that you can occupy so as not to violate the rules of the restaurant. Formally, what is the maximum number of "0" that can be replaced by "1" such that the requirement will still be satisfied?For example, if $$$n=6$$$, $$$k=1$$$, $$$s=$$$ "100010", then the answer to the problem will be $$$1$$$, since only the table at position $$$3$$$ can be occupied such that the rules are still satisfied.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the test. Then $$$t$$$ test cases follow. Each test case starts with a line containing two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 2\cdot 10^5$$$) — the number of tables in the restaurant and the minimum allowed distance between two people. The second line of each test case contains a binary string $$$s$$$ of length $$$n$$$ consisting of "0" and "1" — a description of the free and occupied tables in the restaurant. The given string satisfy to the rules of the restaurant — the difference between indices of any two "1" is more than $$$k$$$. The sum of $$$n$$$ for all test cases in one test does not exceed $$$2\cdot 10^5$$$.

For each test case output one integer — the number of tables that you can occupy so as not to violate the rules of the restaurant. If additional tables cannot be taken, then, obviously, you need to output $$$0$$$.

NoteThe first test case is explained in the statement.In the second test case, the answer is $$$2$$$, since you can choose the first and the sixth table.In the third test case, you cannot take any free table without violating the rules of the restaurant.

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  [n,k] <- (map read.words) <$> getLine
  s <- getLine
  print $ solve n k s

solve :: Int -> Int -> String -> Int
solve n k s
  | length grpd == 1 && (fst.head) grpd == '1' = 0
  | length grpd == 1 = 1 + ((n-1) `div` (k+1))
  | otherwise = f2 n k grpd
  where
    grpd =map (\l -> (head l, length l)) $ group s

f2 :: Int -> Int -> [(Char,Int)] -> Int
f2 n k (x:xs)
  | fst x == '0' = (snd x `div` (k+1)) + f2 n k xs
  | fst l == '0' = (snd l `div` (k+1)) + f2 n k (init (x:xs))
  | otherwise = r
  where
    l = last (x:xs)
    zs = map snd $ filter ((=='0').fst) (x:xs)
    r = sum $ map (\y -> max 0 $ (y-k) `quot` (k+1)) zs

import Data.List

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

solve :: Int -> IO ()
solve 0 = putStr ""
solve n = do
  numbers <- getLine
  input <- getLine
  let list = read ("[" ++ map (\x -> if x == ' ' then ',' else x) numbers ++ "]") :: [Int]
  solveCase (list !! 1) input
  solve (n - 1)

solveCase :: Int -> [Char] -> IO()
solveCase x s =  print $ if length (group s) == 1 && head s == '0' then 1 + checkBounds(init s) else foldl check 0 (zip [0..] (init $ group s)) + checkBounds (last $ group s)
    where
        checkBounds group = if length group == 0 then 0 else if (head group == '0') then length group `div` (x + 1) else 0
        check acc group = acc + if fst group == 0 then checkBounds (snd group) else checkInside (snd group)
        checkInside group = if (head group == '0' && length group >= x * 2 + 1) then (length group - x) `div` (x + 1) else 0

-- solveCase :: [Int] -> IO ()
-- solveCase xs = print $ if odd == even then odd else (-1)
--   where
--     odd = foldl (\acc i -> acc + if (xs !! i) `mod` 2 == 1 then 0 else 1) 0 [1, 3 .. length xs - 1]
--     even = foldl (\acc i -> acc + if (xs !! i) `mod` 2 == 0 then 0 else 1) 0 [0, 2 .. length xs - 1]

{-# LANGUAGE DeriveFunctor #-}

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

solve n x
  = if all (=='0') x
  then (1+) . solve n $ '1' : tail x
  else sum . map f . map (fmap length) . filter ((=='0') . head . contains) . g False . group $ x
  where
    g :: Bool -> [a] -> [Chairs a]
    g _ [] = error "???"
    g _ [x]        = [Edge x]
    g False (x:xs) = Edge x : g True xs
    g True  (x:xs) = Inside x : g True xs
    f (Edge k) = k `div` (n+1)
    f (Inside k) = f (Edge $ k - n)

data Chairs a = Edge a | Inside a deriving Functor
contains :: Chairs a -> a
contains (Edge a) = a
contains (Inside a) = a

main = readLn >>= flip replicateM_ go where
    go = do
        [_,n] <- getList
        getLine >>= print . solve n

    getList = map read . words <$> getLine

f :: Char -> Int
f = fromIntegral . fromEnum

import Control.Monad

dists :: Int -> String -> Int -> Int -> [Int]
dists k [] acc _ = [acc]
dists k (h : t) acc 0
  | h == '0'  = dists k t (acc + 1) 0
  | otherwise = acc : dists k t 0 k
dists k (_ : t) _ b = dists k t 0 (b - 1)

specMap k [] = []
specMap k [x] = if x == 0 then [0] else [1 + ((x - 1) `div` (k + 1))]
specMap k (x:t) = (x `div` (k + 1)) : specMap k t

solve (k, seats) =
  let
    d = dists k seats 0 0
  in
    sum $ specMap k d

getCase = do
  inp <- getLine
  inp2 <- getLine
  let [n, k] = (map read) $ words inp
  return (k, inp2)

main = do
  n <- read <$> getLine
  inp <- replicateM n getCase
  mapM_ (putStrLn . show . solve) inp

import Control.Monad

dists :: Int -> String -> Int -> Int -> [Int]
dists k [] acc _ = [acc]
dists k (h : t) acc 0
  | h == '0'  = dists k t (acc + 1) 0
  | otherwise = acc : dists k t 0 k
dists k (_ : t) _ b = dists k t 0 (b - 1)

specMap k [] = []
specMap k [x] = if x == 0 then [0] else [max 1 (x `div` (k + 1))]
specMap k (x:t) = (x `div` (k + 1)) : specMap k t

solve (k, seats) =
  let
    d = dists k seats 0 0
  in
    sum $ specMap k d

getCase = do
  inp <- getLine
  inp2 <- getLine
  let [n, k] = (map read) $ words inp
  return (k, inp2)

main = do
  n <- read <$> getLine
  inp <- replicateM n getCase
  mapM_ (putStrLn . show . solve) inp

import Control.Monad

dists :: Int -> String -> Int -> Int -> [Int]
dists k [] acc _ = [acc]
dists k (h : t) acc 0
  | h == '0'  = dists k t (acc + 1) 0
  | otherwise = acc : dists k t 0 k
dists k (_ : t) _ b = dists k t 0 (b - 1)

solve (k, seats) =
  let
    d = dists k seats 0 0
  in
    case d of
      [x] -> max 1 (x `div` (k + 1))
      _ -> sum $ map (\x -> x `div` (k + 1)) d

getCase = do
  inp <- getLine
  inp2 <- getLine
  let [n, k] = (map read) $ words inp
  return (k, inp2)

main = do
  n <- read <$> getLine
  inp <- replicateM n getCase
  mapM_ (putStrLn . show . solve) inp


You are given two positive integers $$$n$$$ and $$$k$$$. Print the $$$k$$$-th positive integer that is not divisible by $$$n$$$.For example, if $$$n=3$$$, and $$$k=7$$$, then all numbers that are not divisible by $$$3$$$ are: $$$1, 2, 4, 5, 7, 8, 10, 11, 13 \dots$$$. The $$$7$$$-th number among them is $$$10$$$.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases in the input. Next, $$$t$$$ test cases are given, one per line. Each test case is two positive integers $$$n$$$ ($$$2 \le n \le 10^9$$$) and $$$k$$$ ($$$1 \le k \le 10^9$$$).

For each test case print the $$$k$$$-th positive integer that is not divisible by $$$n$$$.

import           Control.Arrow

main = interact $
  lines >>> drop 1 >>> map (words >>> map read >>> solve >>> show) >>> unlines

solve :: [Integer] -> Integer
solve [n,k] = ((k-1) `div` (n-1)) * n + ((k-1) `mod` (n-1)) + 1

import Control.Monad

type Test = (Integer, Integer)

getTests :: Integer -> IO [Test]
getTests count = replicateM (fromIntegral count) getTest

getTest :: IO Test
getTest = do
    line <- getLine
    let list = words line
    return (read (head list), read (head $ tail list))

getAnswer :: Test -> Integer
getAnswer (n, k) = remainderGroups + k
    where remainderGroups = (k - 1) `div` (n - 1)

printResult :: Integer -> IO ()
printResult result = print result

main :: IO ()
main = do
    count <- getLine
    tests <- getTests $ read count
    let results = map getAnswer tests
    mapM_ printResult results

import Control.Monad (replicateM_)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

main = readLn >>= flip replicateM_ ioSolve

ioSolve :: IO ()
ioSolve = getList >>= \[x,y] -> print $ solve x y

solve :: Int -> Int -> Int
solve n k = k + (k-1) `div` (n-1)

solve :: Integer -> Integer -> Integer
solve n k
    | r==0      = n*m-1
    | otherwise = n*m+r
    where
        m = k`div`(n-1)
        r = k`mod`(n-1)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:k:_) <- readNums
    print $ solve n k
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readNums
    testCases t

readNums :: (Read n) => IO [n]
readNums = map read . words <$> getLine

main :: IO ()
main = do
    getLine
    ans <- map (solve . map read . words) <$> lines <$> getContents
    mapM_ print ans

solve :: [Int] -> Int
solve [x,y] = y + f 0 x y

f x y z = let a = (z `div` y) - (x `div` y)
           in case a of
                0 -> 0
                _ -> a + f z y (z + a)


You were dreaming that you are traveling to a planet named Planetforces on your personal spaceship. Unfortunately, its piloting system was corrupted and now you need to fix it in order to reach Planetforces.  Space can be represented as the $$$XY$$$ plane. You are starting at point $$$(0, 0)$$$, and Planetforces is located in point $$$(p_x, p_y)$$$.The piloting system of your spaceship follows its list of orders which can be represented as a string $$$s$$$. The system reads $$$s$$$ from left to right. Suppose you are at point $$$(x, y)$$$ and current order is $$$s_i$$$:   if $$$s_i = \text{U}$$$, you move to $$$(x, y + 1)$$$;  if $$$s_i = \text{D}$$$, you move to $$$(x, y - 1)$$$;  if $$$s_i = \text{R}$$$, you move to $$$(x + 1, y)$$$;  if $$$s_i = \text{L}$$$, you move to $$$(x - 1, y)$$$. Since string $$$s$$$ could be corrupted, there is a possibility that you won't reach Planetforces in the end. Fortunately, you can delete some orders from $$$s$$$ but you can't change their positions.Can you delete several orders (possibly, zero) from $$$s$$$ in such a way, that you'll reach Planetforces after the system processes all orders?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Each test case consists of two lines. The first line in each test case contains two integers $$$p_x$$$ and $$$p_y$$$ ($$$-10^5 \le p_x, p_y \le 10^5$$$; $$$(p_x, p_y) \neq (0, 0)$$$) — the coordinates of Planetforces $$$(p_x, p_y)$$$. The second line contains the string $$$s$$$ ($$$1 \le |s| \le 10^5$$$: $$$|s|$$$ is the length of string $$$s$$$) — the list of orders. It is guaranteed that the sum of $$$|s|$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, print "YES" if you can delete several orders (possibly, zero) from $$$s$$$ in such a way, that you'll reach Planetforces. Otherwise, print "NO". You can print each letter in any case (upper or lower).

6
10 5
RRRRRRRRRRUUUUU
1 1
UDDDRLLL
-3 -5
LDLDLDDDR
1 2
LLLLUU
3 -2
RDULRLLDR
-1 6
RUDURUUUUR

NoteIn the first case, you don't need to modify $$$s$$$, since the given $$$s$$$ will bring you to Planetforces.In the second case, you can delete orders $$$s_2$$$, $$$s_3$$$, $$$s_4$$$, $$$s_6$$$, $$$s_7$$$ and $$$s_8$$$, so $$$s$$$ becomes equal to "UR".In the third test case, you have to delete order $$$s_9$$$, otherwise, you won't finish in the position of Planetforces.

chunksOf :: Int -> [a] -> [[a]]
chunksOf x [] = []
chunksOf x l = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map (read :: Read a => String -> a) . words

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

solve :: Int -> Int -> String -> Bool
solve px py s = count 'U' s >= py &&
                count 'D' s >= -py &&
                count 'R' s >= px &&
                count 'L' s >= -px
    where count x = length . filter (==x)

main :: IO ()
main = interact (unlines . map (fmtB . uncurry3 solve . getInput) . chunksOf 2 . tail . lines)
    where getInput [a, b] = let [px, py] = toArr a in (px, py, b)
          uncurry3 f (a,b,c) = f a b c

solve :: Int -> Int -> String -> Bool
solve px py s = count 'U' s >= py &&
                count 'D' s >= -py &&
                count 'R' s >= px &&
                count 'L' s >= -px
    where count x = length . filter (==x)

main :: IO ()
main = interact (unlines . map (fmtB . uncurry3 solve . getInput) . chunksOf2 . tail . lines)
    where getInput [a, b] = let [px, py] = toArr a in (px, py, b)
          chunksOf2 [] = []
          chunksOf2 (a : b : l) = [a,b] : chunksOf2 l
          uncurry3 f (a,b,c) = f a b c
          toArr = map (read :: String -> Int) . words
          fmtB True = "YES"
          fmtB False = "NO"

import Control.Monad

solve :: ((Int,Int), String) -> String
solve ((x,y), as)
    | and [x_axis, y_axis]  = "YES"
    | otherwise             = "NO"
    where
        x_axis = or [and [x<0, (abs x) <= ls], and [x>=0, x <= rs]]
        y_axis = or [and [y<0, (abs y) <= ds], and [y>=0, y <= us]]
        ls = (length . filter (=='L')) as
        us = (length . filter (=='U')) as
        ds = (length . filter (=='D')) as
        rs = (length . filter (=='R')) as

-- (x,y)
-- u -> y+1, d -> y-1, r -> x+1, l -> x-1

readTestcase :: IO ((Int, Int), String)
readTestcase = do
    line <- getLine
    let [x,y] = [read i :: Int | i <- words line]
    word <- getLine
    return $ ((x,y),word)

main = do
    t <- getLine
    let t_int = read t :: Int
    testcases <- replicateM t_int readTestcase
    putStrLn $ unlines $ map solve testcases

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           GHC.IO.Handle              (hDuplicateTo)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             openFile, stdin, stdout)
import           Text.Printf                (printf)

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

solve :: (Int, Int) -> String -> Bool
solve (px, py) steps = xCan && yCan
    where
        directionCounts :: M.Map Char Int
        directionCounts = foldl (\counts direction -> M.insertWith (+) direction 1 counts) M.empty steps

        xDirection = if px < 0 then 'L' else 'R'
        yDirection = if py < 0 then 'D' else 'U'

        xCan = M.findWithDefault 0 xDirection directionCounts >= abs px
        yCan = M.findWithDefault 0 yDirection directionCounts >= abs py

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [px, py] <- B8.getLine <&> map readIntB8 . B8.words
        steps <- B8.getLine <&> B8.unpack . head . B8.words
        let answer = solve (px, py) steps
        printf "%s\n" $ if answer then "YES" else "NO" :: String

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put . P.tail . snd $ P.break (== '\n') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [px, py] <- readInts
    s <- readLine
    let
      [px', py'] = map fromIntegral [px, py]
      minX = 0 - P.count 'L' s
      maxX =     P.count 'R' s
      minY = 0 - P.count 'D' s
      maxY =     P.count 'U' s
    lift . P.putStrLn . P.pack
      $ if  minX <= px' && px' <= maxX && minY <= py' && py' <= maxY
      then "YES"
      else "NO"


n people are standing in a line to play table tennis. At first, the first two players in the line play a game. Then the loser goes to the end of the line, and the winner plays with the next person from the line, and so on. They play until someone wins k games in a row. This player becomes the winner.For each of the participants, you know the power to play table tennis, and for all players these values are different. In a game the player with greater power always wins. Determine who will be the winner.

The first line contains two integers: n and k (2 ≤ n ≤ 500, 2 ≤ k ≤ 1012) — the number of people and the number of wins. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ n) — powers of the player. It's guaranteed that this line contains a valid permutation, i.e. all ai are distinct.

Output a single integer — power of the winner.

NoteGames in the second sample:3 plays with 1. 3 wins. 1 goes to the end of the line.3 plays with 2. 3 wins. He wins twice in a row. He becomes the winner.

import Data.Int
import Data.List
main = getContents >>= print . exec
exec = solve . map read . words
solve (n:k:xs)
  | k >= n = m :: Int64
  | otherwise = (\r -> case r of { [] -> m; (x:_):_ -> x }) $ filter ((>= k) . genericLength) $ group $ tail $ scanl (\w f -> max w f) (head xs) (tail xs)
  where m = maximum xs

module Main (main) where

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

main :: IO ()
main = do
    [n, k] <- map readInt . words <$> getLine
    xs <-  map readInt . words <$> getLine
    let ans = solve n k xs
    print ans

readInt :: String -> Integer
readInt = read

solve n k (x:xs) | k > n     = n
                 | otherwise = fst $ foldl (play k) (x, 0) $ xs ++ xs ++ xs

play k (w, c) p | w == p || c == k = (w, c)
                | w > p            = (w, c+1)
                | w < p            = (p, 1)

main = interact $ show . solve . map read . words
solve (n:k:a:as) = go a as 0 where
  go a _ i | i >= min (n-1) k = a
  go a (b:as) i | a > b = go a (as ++ [b]) (i+1)
                | otherwise = go b (as ++ [a]) 1

import Data.Int
import Data.List
main = getContents >>= print . exec
exec = solve . map read . words
solve (n:k:xs)
  | k >= n = m :: Int64
  | otherwise = maybe m fst $ find snd $ zipWith3 (\x ts _ -> (x, all (x>) $ genericTake k ts)) xs (tail $ tails xs) [1..n - k]
  where m = maximum xs

import Data.Int
import Data.List
main = getContents >>= print . exec
exec = solve . map read . words
solve (n:k:xs)
  | k >= n = m :: Int64
  | otherwise = (\r -> case r of { [] -> m; (x:_):_ -> x }) $ filter ((>= k) . genericLength) $ group $ scanl (\w f -> max w f) (head xs) (tail xs)
  where m = maximum xs

module Main (main) where

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

main :: IO ()
main = do
    [n, k] <- map readInt . words <$> getLine
    xs <-  map readInt . words <$> getLine
    let ans = solve n k xs
    print ans

readInt :: String -> Int
readInt = read

solve :: Int -> Int -> [Int] -> Int
solve n k (x:xs) | k > n     = n
                 | otherwise = fst $ foldl (play k) (x, 0) $ xs ++ xs ++ xs

play :: Int -> (Int, Int) -> Int -> (Int, Int)
play k (w, c) p | w == p || c == k = (w, c)
                | w > p            = (w, c+1)
                | w < p            = (p, 1)


Petya has an array $$$a$$$ consisting of $$$n$$$ integers. He has learned partial sums recently, and now he can calculate the sum of elements on any segment of the array really fast. The segment is a non-empty sequence of elements standing one next to another in the array.Now he wonders what is the number of segments in his array with the sum less than $$$t$$$. Help Petya to calculate this number.More formally, you are required to calculate the number of pairs $$$l, r$$$ ($$$l \le r$$$) such that $$$a_l + a_{l+1} + \dots + a_{r-1} + a_r < t$$$.

The first line contains two integers $$$n$$$ and $$$t$$$ ($$$1 \le n \le 200\,000, |t| \le 2\cdot10^{14}$$$). The second line contains a sequence of integers $$$a_1, a_2, \dots, a_n$$$ ($$$|a_{i}| \le 10^{9}$$$) — the description of Petya's array. Note that there might be negative, zero and positive elements.

Print the number of segments in Petya's array with the sum of elements less than $$$t$$$.

NoteIn the first example the following segments have sum less than $$$4$$$:  $$$[2, 2]$$$, sum of elements is $$$-1$$$  $$$[2, 3]$$$, sum of elements is $$$2$$$  $$$[3, 3]$$$, sum of elements is $$$3$$$  $$$[4, 5]$$$, sum of elements is $$$3$$$  $$$[5, 5]$$$, sum of elements is $$$-1$$$

{-# LANGUAGE Safe #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Applicative
import Data.List
import Text.Printf
import Data.Ratio
import Data.Array.IO.Safe
import Control.Monad
import Data.Int
import Data.Maybe
import Control.Applicative
import Data.Bits
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map

readIntBS = fst . fromJust . BS.readInt

main = do
  [n,t] <- map read . words <$> getLine :: IO [Int64]
  as <- scanl (+) 0 .  map (fromIntegral . readIntBS) . BS.words <$> BS.getLine :: IO [Int64]

  let im = Map.fromList . (flip zip) [1..] . map head . group . sort $ as :: Map.Map Int64 Int

  bit <- newFenwickTree (fromIntegral $ n+1) :: IO IOFenwickTree

  ans <- do
    forM (zip [0..] as) $ \(x,a) -> do
      let f = Map.lookupGT (a-t) im
      res <- case f of
               Just (_,i) -> (x-) <$> queryFenwickTree bit (i-1)
               Nothing -> return 0
      modifyFenwickTree bit (im Map.! a)
      return res

  print $ sum (map fromIntegral ans)

type IOFenwickTree = (IOUArray Int Int, Int)

newFenwickTree :: Int -> IO IOFenwickTree
newFenwickTree n = (,n) <$> newListArray (1,n) (take n (repeat 0))

modifyFenwickTree :: IOFenwickTree -> Int -> IO ()
modifyFenwickTree (tree,size) i = do
  aux i
  where
    aux j = do
      when (j <= size) $ do
        writeArray tree j =<< (+1) <$> readArray tree j
        aux (j + (j .&. (-j)))

queryFenwickTree :: IOFenwickTree -> Int -> IO Int
queryFenwickTree (tree,size) i = do
  aux i
  where
    aux j
      | j <= 0 = return 0
      | otherwise = (+) <$> readArray tree j <*> aux (j - (j .&. (-j)))

{-# LANGUAGE Safe #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Applicative
import Data.List
import Text.Printf
import Data.Ratio
import Data.Array.IO.Safe
import Control.Monad
import Data.Int
import Data.Maybe
import Control.Applicative
import Data.Bits
import qualified Data.ByteString.Char8 as BS
import qualified Data.IntMap as IM

readIntBS = fst . fromJust . BS.readInt

main = do
  [n,t] <- map readIntBS . BS.words <$> BS.getLine :: IO [Int]
  as <- scanl (+) 0 .  map readIntBS . BS.words <$> BS.getLine :: IO [Int]

  let im = IM.fromList . (flip zip) [1..] . map head . group . sort $ as

  bit <- newFenwickTree (n+1) :: IO IOFenwickTree

  ans <- do
    forM as $ \a -> do
      let f = IM.lookupGT (a-t) im
      res <- case f of
               Just (_,i) -> (-) <$> queryFenwickTree bit (n+1) <*> queryFenwickTree bit (i-1)
               Nothing -> return 0
      modifyFenwickTree bit (im IM.! a)
      return res

  print $ sum (map fromIntegral ans)

type IOFenwickTree = (IOUArray Int Int, Int)

newFenwickTree :: Int -> IO IOFenwickTree
newFenwickTree n = (,n) <$> newListArray (1,n) (take n (repeat 0))

modifyFenwickTree :: IOFenwickTree -> Int -> IO ()
modifyFenwickTree (tree,size) i = do
  aux i
  where
    aux j = do
      when (j <= size) $ do
        writeArray tree j =<< (+1) <$> readArray tree j
        aux (j + (j .&. (-j)))

queryFenwickTree :: IOFenwickTree -> Int -> IO Int
queryFenwickTree (tree,size) i = do
  aux i
  where
    aux j
      | j <= 0 = return 0
      | otherwise = (+) <$> readArray tree j <*> aux (j - (j .&. (-j)))

{-# LANGUAGE Safe #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Applicative
import Data.List
import Text.Printf
import Data.Ratio
import Data.Array.IO.Safe
import Control.Monad
import Data.Int
import Data.Maybe
import Control.Applicative
import Data.Bits
import qualified Data.ByteString.Char8 as BS
import qualified Data.IntMap as IM

readIntBS = fst . fromJust . BS.readInt

main = do
  [n,t] <- map readIntBS . BS.words <$> BS.getLine :: IO [Int]
  as <- scanl (+) 0 .  map readIntBS . BS.words <$> BS.getLine :: IO [Int]

  let im = IM.fromList . (flip zip) [1..] . map head . group . sort $ as

  bit <- newFenwickTree (n+1) :: IO IOFenwickTree

  ans <- do
    forM (zip [0..] as) $ \(x,a) -> do
      let f = IM.lookupGT (a-t) im
      res <- case f of
               Just (_,i) -> (x-) <$> queryFenwickTree bit (i-1)
               Nothing -> return 0
      modifyFenwickTree bit (im IM.! a)
      return res

  print $ sum (map fromIntegral ans)

type IOFenwickTree = (IOUArray Int Int, Int)

newFenwickTree :: Int -> IO IOFenwickTree
newFenwickTree n = (,n) <$> newListArray (1,n) (take n (repeat 0))

modifyFenwickTree :: IOFenwickTree -> Int -> IO ()
modifyFenwickTree (tree,size) i = do
  aux i
  where
    aux j = do
      when (j <= size) $ do
        writeArray tree j =<< (+1) <$> readArray tree j
        aux (j + (j .&. (-j)))

queryFenwickTree :: IOFenwickTree -> Int -> IO Int
queryFenwickTree (tree,size) i = do
  aux i
  where
    aux j
      | j <= 0 = return 0
      | otherwise = (+) <$> readArray tree j <*> aux (j - (j .&. (-j)))

{-# LANGUAGE Safe #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Applicative
import Data.List
import Text.Printf
import Data.Ratio
import Data.Array.IO.Safe
import Control.Monad
import Data.Int
import Data.Maybe
import Control.Applicative
import Data.Bits
import qualified Data.ByteString.Char8 as BS
import qualified Data.IntMap as IM

readIntBS = fst . fromJust . BS.readInt

main = do
  [n,t] <- map readIntBS . BS.words <$> BS.getLine :: IO [Int]
  as <- scanl (+) 0 .  map readIntBS . BS.words <$> BS.getLine :: IO [Int]

  let im = IM.fromList . (flip zip) [1..] . map head . group . sort $ as

  bit <- newFenwickTree (n+1) :: IO IOFenwickTree

  ans <- sum <$>  do
    forM as $ \a -> do
      let f = IM.lookupGT (a-t) im
      res <- case f of
               Just (_,i) -> (-) <$> queryFenwickTree bit (n+1) <*> queryFenwickTree bit (i-1)
               Nothing -> return 0
      modifyFenwickTree bit (im IM.! a)
      return res

  print ans

type IOFenwickTree = (IOUArray Int Int, Int)

newFenwickTree :: Int -> IO IOFenwickTree
newFenwickTree n = (,n) <$> newListArray (1,n) (take n (repeat 0))

modifyFenwickTree :: IOFenwickTree -> Int -> IO ()
modifyFenwickTree (tree,size) i = do
  aux i
  where
    aux j = do
      when (j <= size) $ do
        writeArray tree j =<< (+1) <$> readArray tree j
        aux (j + (j .&. (-j)))

queryFenwickTree :: IOFenwickTree -> Int -> IO Int
queryFenwickTree (tree,size) i = do
  aux i
  where
    aux j
      | j <= 0 = return 0
      | otherwise = (+) <$> readArray tree j <*> aux (j - (j .&. (-j)))

lowerBoundFenwickTree :: IOFenwickTree -> Int -> IO Int
lowerBoundFenwickTree (tree,size) x = do
  aux k 0 x
  where
    k = (2 ^ (floor $ logBase 2 (fromIntegral size)))
    aux i j w
      | i == 0 = return (j+1)
      | otherwise = do
          if i+j <= size then do
            a <- readArray tree (i+j)
            if a < w then aux (i `div` 2) (i+j) (w-a) else aux (i `div` 2) j w
            else
            aux (i `div` 2) j w