Little Artem found a grasshopper. He brought it to his house and constructed a jumping area for him.The area looks like a strip of cells 1 × n. Each cell contains the direction for the next jump and the length of that jump. Grasshopper starts in the first cell and follows the instructions written on the cells. Grasshopper stops immediately if it jumps out of the strip. Now Artem wants to find out if this will ever happen.

The first line of the input contains a single integer n (1 ≤ n ≤ 100 000) — length of the strip.  Next line contains a string of length n which consists of characters "<" and ">" only, that provide the direction of the jump from the corresponding cell. Next line contains n integers di (1 ≤ di ≤ 109) — the length of the jump from the i-th cell.

Print "INFINITE" (without quotes) if grasshopper will continue his jumps forever. Otherwise print "FINITE" (without quotes).

NoteIn the first sample grasshopper starts from the first cell and jumps to the right on the next cell. When he is in the second cell he needs to jump two cells left so he will jump out of the strip.Second sample grasshopper path is 1 - 3 - 2 - 3 - 2 - 3 and so on. The path is infinite.

import Data.Array.ST.Safe
import Data.Array.Unboxed

hop visited dir dist pos
    | pos < 0 || pos >= (snd.bounds $ dir) = return True
    | otherwise = do
        e <- readArray visited pos
        if e then return False
             else do
                    writeArray visited pos True
                    hop visited dir dist $ pos + (if dir!pos then 1 else -1) * (dist ! pos)

-- true if finite
hopper :: UArray Int Bool -> UArray Int Int -> Bool
hopper s d =
    (runSTUArray $ do
        a <- (newArray (bounds s) False)
        r <- hop a s d 0
        writeArray a 0 r
        return $ a) ! 0
{-where -- Works, but slow on large arrays (// is O(n))
    hop visited x
      | x < 0 || x >= (snd $ bounds s) = True
      | visited ! x = False
      | otherwise = hop (visited // [(x, True)]) $ x + (if s ! x then d ! x else -(d ! x))
-}

main = do
  sz <- getLine
  let s = read sz
  str <-  getLine
  ints <- getLine
  let i = listArray (0,s).map read.words $ ints
  let d = listArray (0,s).map (=='>') $ str
--  let i = listArray (0,s) $ repeat 1
--  let d = listArray (0,s) $ repeat True
  putStrLn $ if hopper d i then "FINITE" else "INFINITE"

import qualified Data.Set as S
import Data.Array

arrayify l  = array (0, length l - 1) ([0..] `zip` l)

main = do
    n <- fmap read getLine
    s <- getLine
    ns <- fmap (map read . words) getLine
    let a = arrayify $ zipWith (\c x -> if c == '>' then x else negate x) s ns
    --print a
    putStrLn $ if solve n a then "FINITE" else "INFINITE"

solve :: Int -> Array Int Int -> Bool
solve n a = solve' (S.singleton 0) 0
  where solve' s v
         | to < 0 || to >= n = True
         | to `S.member` s = False
         | otherwise = solve' (to `S.insert` s) to
         where to = a ! v + v

import qualified Data.IntMap as IM
import Data.IntMap ((!))
main = do
    s' <- getLine >> getLine
    d' <- fmap (map read . words) getLine
    let d = IM.fromList $ zip [0..] d'
        s = IM.fromList $ zip [0..] s'
        n = IM.size d
        iter x = if s!x == '>' then x + (d!x) else x - (d!x)
        coords = iterate iter 0
        path = take (n+1) . takeWhile (\x -> x >= 0 && x < n) $ coords
    putStrLn $ if length path == n+1 then "INFINITE" else "FINITE"

import qualified Data.IntMap as IM
import Data.IntMap ((!))
main = do
    s' <- getLine >> getLine
    d' <- fmap (map read . words) getLine
    let d = IM.fromList $ zip [0..] d'
        s = IM.fromList $ zip [0..] s'
        n = length s'
        iter x = if s!x == '>' then x + (d!x) else x - (d!x)
        coords = iterate iter 0
        path = take (n+1) . takeWhile (\x -> x >= 0 && x < n) $ coords
    putStrLn $ if length path == n+1 then "INFINITE" else "FINITE"

import Control.Monad
import Control.Monad.Trans.State.Strict
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import qualified Data.IntMap as IM
import Data.IntMap ((!))
main = do
    stdin <- B.getContents
    let (n, s', d') = flip evalState stdin $ do
        n <- readInt
        s <- readString
        d <- replicateM n readInt
        return (n, s, d)

    let d = IM.fromList $ zip [0..] d'
        s = IM.fromList $ zip [0..] $ B.unpack s'
        iter x = if s!x == '>' then x + (d!x) else x - (d!x)
        coords = iterate iter 0
        path = take (n+1) . takeWhile (\x -> x >= 0 && x < n) $ coords
    putStrLn $ if length path == n+1 then "INFINITE" else "FINITE"

readInt :: State B.ByteString Int
readInt = do
    Just (n, rest) <- gets (B.readInt . B.dropWhile isSpace)
    put rest
    return n

readString :: State B.ByteString B.ByteString
readString = do
    (s, rest) <- gets (B.span (not.isSpace) . B.dropWhile isSpace)
    put rest
    return s

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  dirs :: UArray Int Char <- listArray (1, n) <$> getLine
  ds :: UArray Int Int <- listArray (1, n) <$> getInts

  bs :: IOUArray Int Bool <- newArray (1, n) False

  let
    f i
      | i < 1 || i > n = return True
      | otherwise = do
        b <- readArray bs i
        if b
           then return False
           else do
             writeArray bs i True
             f i'
      where
        i' = i + if dirs!i == '>' then ds!i else -(ds!i)

  b <- f 1

  putStrLn $ if b then "FINITE" else "INFINITE"

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  dirs :: UArray Int Char <- listArray (1, n) <$> getLine
  ds :: UArray Int Int <- listArray (1, n) <$> getInts

  let
    f i bs
      | i < 1 || i > n = True
      | i `IntSet.member` bs = False
      | otherwise = f i' bs'
      where
        i' = i + if dirs!i == '>' then ds!i else -(ds!i)
        !bs' = i `IntSet.insert` bs

  putStrLn $ if f 1 IntSet.empty then "FINITE" else "INFINITE"


Initially, you have the array $$$a$$$ consisting of one element $$$1$$$ ($$$a = [1]$$$).In one move, you can do one of the following things:  Increase some (single) element of $$$a$$$ by $$$1$$$ (choose some $$$i$$$ from $$$1$$$ to the current length of $$$a$$$ and increase $$$a_i$$$ by one);  Append the copy of some (single) element of $$$a$$$ to the end of the array (choose some $$$i$$$ from $$$1$$$ to the current length of $$$a$$$ and append $$$a_i$$$ to the end of the array). For example, consider the sequence of five moves:  You take the first element $$$a_1$$$, append its copy to the end of the array and get $$$a = [1, 1]$$$.  You take the first element $$$a_1$$$, increase it by $$$1$$$ and get $$$a = [2, 1]$$$.  You take the second element $$$a_2$$$, append its copy to the end of the array and get $$$a = [2, 1, 1]$$$.  You take the first element $$$a_1$$$, append its copy to the end of the array and get $$$a = [2, 1, 1, 2]$$$.  You take the fourth element $$$a_4$$$, increase it by $$$1$$$ and get $$$a = [2, 1, 1, 3]$$$. Your task is to find the minimum number of moves required to obtain the array with the sum at least $$$n$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 10^9$$$) — the lower bound on the sum of the array.

For each test case, print the answer: the minimum number of moves required to obtain the array with the sum at least $$$n$$$.

import Control.Arrow ((>>>))

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

solve :: Integer -> Integer
solve 1 = 0
solve n = let r = round $ sqrt $ fromIntegral n in
  case compare (r * r) n of
    EQ -> 2 * r - 2
    LT -> 2 * r - 1
    GT -> 2 * r - 2

import Control.Monad
import Data.Char
import Data.List

getList :: (Read t) => IO [t]
getList = getLine >>= return . (map read) . words

getOne :: (Read t) => IO t
getOne = getLine >>= return . read

main :: IO ()
main = do
  t <- getOne
  -- let t = 1
  replicateM_ t solve

solve :: IO ()
solve = do
  n <- getOne
  print $ countAns n

countAns :: Integral t => t -> t
countAns 1 = 0
countAns n = f n $ binSearch n 0 n

binSearch :: Integral t => t -> t -> t -> t
binSearch n l r
  | r - l <= 1 = r
  | g n m = binSearch n m r
  | otherwise = binSearch n l m
  where
    m = (l + r) `div` 2

f :: Integral a => a -> a -> a
f n k = (k - 1) + (n - 1) `div` k

g :: Integral a => a -> a -> Bool
g n k = f' n k > f' n (k + 1)

f' :: (Integral a, Fractional b) => a -> a -> b
f' n k = fromIntegral (k - 1) + fromIntegral (n - 1) / fromIntegral k

getToNFastest :: Int -> Int -> Int -> Int -> Int
getToNFastest biggest aSum steps n
  | aSum >= n = steps
  | fromIntegral aSum >= (fromIntegral n)**0.5 = getToNFastest biggest (aSum+biggest) (steps+1) n
  | otherwise = getToNFastest (biggest+1) (aSum+1) (steps+1) n

main :: IO()
main = do
    interact $ unlines . (map (show . (getToNFastest 1 1 0) . read)) . tail . lines

import  Control.Monad   (replicateM_)

ceilDiv :: Int -> Int -> Int
ceilDiv a b | b * fd == a  = fd
            | otherwise    = fd + 1
        where
                fd = a `div` b

minimalNumberOfMoves :: Int -> Int
minimalNumberOfMoves bound = addCount + copyCount
        where
                addCount = sqrtCeilVal - 1
                copyCount = bound `ceilDiv` sqrtCeilVal - 1
                sqrtCeil = ceiling . sqrt . fromIntegral
                sqrtCeilVal = sqrtCeil bound

solve :: IO ()
solve = do
        bound <- (read <$> getLine) :: IO Int
        print $ minimalNumberOfMoves bound

main :: IO ()
main = do
        t <- (read <$> getLine) :: IO Int
        replicateM_ t solve

import Control.Monad

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

solve :: Int -> Int
solve n = let
  k = floor $ sqrt (fromIntegral n :: Double)
  opts = [v + ceilDiv n v - 2 | v <- [k - 2 .. k + 2], v > 0]
  in  minimum opts

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

import Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine :: IO Int
        let r = floor $ sqrt $ (fromIntegral n :: Double)
            r' = quot (n + r - 1) r
        print $ r + r' - 2

import Control.Arrow ((>>>))

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

solve :: Integer -> Integer
solve 1 = 0
solve n = let r = round $ sqrt $ fromIntegral n in
  case compare (r * r) n of
    EQ -> 2 * r - 1
    LT -> 2 * r - 1
    GT -> 2 * r - 2

getToNFastest :: Int -> Int -> Int -> Int -> Int
getToNFastest n biggest aSum steps
  | aSum >= n = steps
  | fromIntegral aSum >= (fromIntegral n)**0.5 = getToNFastest n biggest (aSum+biggest) (steps+1)
  | otherwise = getToNFastest n (biggest+1) (aSum+1) (steps+1)

findMin :: Int -> Int
findMin n = getToNFastest n 1 0 0

main :: IO()
main = do
    interact $ unlines . (map (show . findMin . read)) . tail . lines

getToNFastest :: Int -> Int -> Int -> Int -> Int
getToNFastest n biggest aSum steps
  | aSum >= n = steps
  | fromIntegral aSum >= (fromIntegral n)**0.5 = getToNFastest n biggest (aSum+biggest) (steps+1)
  | otherwise = getToNFastest n (biggest+1) (aSum+1) (steps+1)

main :: IO()
main = do
    interact $ unlines . (map (show . (getToNFastest 1 1 0) . read)) . tail . lines


Today there is going to be an unusual performance at the circus — hamsters and tigers will perform together! All of them stand in circle along the arena edge and now the trainer faces a difficult task: he wants to swap the animals' positions so that all the hamsters stood together and all the tigers also stood together. The trainer swaps the animals in pairs not to create a mess. He orders two animals to step out of the circle and swap places. As hamsters feel highly uncomfortable when tigers are nearby as well as tigers get nervous when there's so much potential prey around (consisting not only of hamsters but also of yummier spectators), the trainer wants to spend as little time as possible moving the animals, i.e. he wants to achieve it with the minimal number of swaps. Your task is to help him.

The first line contains number n (2 ≤ n ≤ 1000) which indicates the total number of animals in the arena. The second line contains the description of the animals' positions. The line consists of n symbols "H" and "T". The "H"s correspond to hamsters and the "T"s correspond to tigers. It is guaranteed that at least one hamster and one tiger are present on the arena. The animals are given in the order in which they are located circle-wise, in addition, the last animal stands near the first one.

Print the single number which is the minimal number of swaps that let the trainer to achieve his goal.

NoteIn the first example we shouldn't move anybody because the animals of each species already stand apart from the other species. In the second example you may swap, for example, the tiger in position 2 with the hamster in position 5 and then — the tiger in position 9 with the hamster in position 7.

solve :: (Int, String) -> Int
solve (n, s) = total_tigers - max_grouped_t_count
    where t_count = length . filter (=='T')
          max_grouped_t_count = maximum $ map (t_count . substring) [1..n]
          substring start = take total_tigers $ drop start $ cycle s
          total_tigers = t_count s

parse :: String -> (Int, String)
parse input = (read n, s)
    where [n, s] = lines input

main = interact (show . solve . parse)

main = interact solve
solve input = output where
  n = read (head $ lines input) :: Int
  animals = last $ lines input
  output = show $ ham - maxham
  ham = length $ filter (=='H') animals
  maxham = maximum $ numham $ animals ++ take (n-1) animals
  numham ['H'] = [1]
  numham ['T'] = [0]
  numham (x:xs)
    | length xs < ham && x == 'H' = z+1:ys
    | length xs < ham             = z:ys
    | x == y                    = z:ys
    | x == 'H' && y == 'T'      = z+1:ys
    | otherwise                 = z-1:ys
      where
        y = xs!!(ham-1)
        ys = numham xs
        z = head ys

solve :: (Int, String) -> Int
solve (n, s) = total_tigers - max_grouped_t_count
    where t_count = length . filter (=='T')
          max_grouped_t_count = maximum $ map (t_count . substring) [1..total_tigers]
          substring start = take total_tigers $ drop start $ cycle s
          total_tigers = t_count s

parse :: String -> (Int, String)
parse input = (read n, s)
    where [n, s] = lines input

main = interact (show . solve . parse)


To stay woke and attentive during classes, Karen needs some coffee!  Karen, a coffee aficionado, wants to know the optimal temperature for brewing the perfect cup of coffee. Indeed, she has spent some time reading several recipe books, including the universally acclaimed "The Art of the Covfefe".She knows n coffee recipes. The i-th recipe suggests that coffee should be brewed between li and ri degrees, inclusive, to achieve the optimal taste.Karen thinks that a temperature is admissible if at least k recipes recommend it.Karen has a rather fickle mind, and so she asks q questions. In each question, given that she only wants to prepare coffee with a temperature between a and b, inclusive, can you tell her how many admissible integer temperatures fall within the range?

The first line of input contains three integers, n, k (1 ≤ k ≤ n ≤ 200000), and q (1 ≤ q ≤ 200000), the number of recipes, the minimum number of recipes a certain temperature must be recommended by to be admissible, and the number of questions Karen has, respectively. The next n lines describe the recipes. Specifically, the i-th line among these contains two integers li and ri (1 ≤ li ≤ ri ≤ 200000), describing that the i-th recipe suggests that the coffee be brewed between li and ri degrees, inclusive. The next q lines describe the questions. Each of these lines contains a and b, (1 ≤ a ≤ b ≤ 200000), describing that she wants to know the number of admissible integer temperatures between a and b degrees, inclusive.

For each question, output a single integer on a line by itself, the number of admissible integer temperatures between a and b degrees, inclusive.

NoteIn the first test case, Karen knows 3 recipes.  The first one recommends brewing the coffee between 91 and 94 degrees, inclusive.  The second one recommends brewing the coffee between 92 and 97 degrees, inclusive.  The third one recommends brewing the coffee between 97 and 99 degrees, inclusive. A temperature is admissible if at least 2 recipes recommend it.She asks 4 questions.In her first question, she wants to know the number of admissible integer temperatures between 92 and 94 degrees, inclusive. There are 3: 92, 93 and 94 degrees are all admissible.In her second question, she wants to know the number of admissible integer temperatures between 93 and 97 degrees, inclusive. There are 3: 93, 94 and 97 degrees are all admissible.In her third question, she wants to know the number of admissible integer temperatures between 95 and 96 degrees, inclusive. There are none.In her final question, she wants to know the number of admissible integer temperatures between 90 and 100 degrees, inclusive. There are 4: 92, 93, 94 and 97 degrees are all admissible.In the second test case, Karen knows 2 recipes.  The first one, "wikiHow to make Cold Brew Coffee", recommends brewing the coffee at exactly 1 degree.  The second one, "What good is coffee that isn't brewed at at least 36.3306 times the temperature of the surface of the sun?", recommends brewing the coffee at exactly 200000 degrees. A temperature is admissible if at least 1 recipe recommends it.In her first and only question, she wants to know the number of admissible integer temperatures that are actually reasonable. There are none.

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.Array.Unboxed

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

solve k qs fs =  map (\(l, r) -> cumm!r - cumm!(l - 1)) qs
  where
    bnd = (0, 200001)
    cumm = listArray bnd $ scanl1 (+) $ map (fromEnum . (>= k)) $ scanl1 (+) $ (elems :: UArray Int Int -> [Int]) $ accumArray (+) 0 bnd $ concatMap (\(l, r) -> [(l, 1), (r + 1, -1)]) fs :: UArray Int Int

main = do
  n:k:q:_ <- fmap readInts B.getLine
  fs <- replicateM n (fmap readPair B.getLine)
  qs <- replicateM q (fmap readPair B.getLine)
  putStr $ unlines $ map show $ solve k qs fs
  where readPair = (\(l:r:_) -> (l, r)) . readInts


NoteIn the first sample it is not enough one cash to serve all clients, because two visitors will come into cafe in 8:10. Therefore, if there will be one cash in cafe, then one customer will be served by it, and another one will not wait and will go away.In the second sample all visitors will come in different times, so it will be enough one cash.

import Data.List
main=interact$show.maximum.map length.group.lines

main = do
    n<-getLine
    rest<-getContents
    let dat=((map (map read.words)).lines) rest
    putStrLn $ show $ solve dat (-1)

solve::[[Int]]->Int->Int
solve [] maxhumans = maxhumans
solve ([a,b]:cs) maxhumans = if taken >maxhumans then solve droped (taken) else solve droped maxhumans
     where taken =length (  takeWhile ([a,b]==) ([a,b]:cs))
           droped = dropWhile ([a,b]==) cs

import Control.Applicative
import qualified Data.List as L

test x = maximum $ map length $ L.group x

main = do
  times <- tail . lines <$> getContents
  let result = test times
  print result

import Data.List

main = do
  getLine
  ps <- fmap (map (words) . lines) getContents

  print $ maximum $ map length $ group $ sort ps

import Control.Monad
import qualified Data.Map as M

countMap_ :: Integer -> M.Map Integer Integer -> M.Map Integer Integer
countMap_ = M.alter (\y -> fmap succ y `mplus` Just 1)

countMap :: [Integer] -> M.Map Integer Integer
countMap = foldr countMap_ M.empty

main :: IO ()
main = do
  n <- fmap read getLine
  ts <- replicateM n $ do
          [h, m] <- fmap (map read . words) getLine
          return $ 60 * h + m
  print $ M.foldl' max 0 $ countMap ts

import Data.List

main :: IO ()
main = do n <- getLine >>= return . read
          l <- sequence $ replicate n (getLine >>= return . map read . words)
          putStrLn . show $ solve l

solve :: [[Int]] -> Int
solve = maximum. map length . group . sort

main = do
    contents <- getContents
    putStrLn $ (\(a,s) -> show a) $ foldr1 max $ f (tail $ lines contents) "" 0

f :: [String] -> String -> Int -> [(Int, String)]
f [] curS curC = [(curC, curS)]
f s curS curC
    | curS == head s = f (tail s) curS (curC+1)
    | otherwise = (curC, curS) : f (tail s) (head s) 1

import Data.List
main = do
    contents <- getContents
    putStrLn $ show $ foldr1 max $ map length $ group $ tail $ lines contents

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
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=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine >>= \n -> (solve =<< forM [1..read n] ( \i -> map (fst.fromJust.C.readInteger).C.words <$>C.getLine))
solve xs = print $ maximum $ map length $ group xs

import Control.Monad
import Data.List

main = do
   n <- liftM (\x -> read x :: Int)  getLine
   ts <- replicateM n getLine
   print $ maximum $ map length $ group ts

import List (group)
import Monad (liftM)

parse :: String -> (Int, Int)
parse line  =  case words line of
    [s1, s2]  ->  (read s1, read s2)

solve :: [(Int, Int)] -> Int
solve  =  maximum . map length . group

main :: IO ()
main  =  do
    n  <-  readLn
    as  <-  liftM (take n . map parse . lines) getContents
    print $ solve $ as

import Control.Applicative
import Data.Map.Strict (fromListWith, toList)

parse :: String -> [((Int,Int),Int)]
parse =
  toList . fromListWith (+) . map (toTup . words) . lines
    where toTup [x,y] = ((read x, read y),1)

main = do
  _ <- getLine
  xs <- parse <$> getContents
  print . maximum . map snd $ xs

import Control.Applicative
import Data.List (group)

parse :: String -> [(Int,Int)]
parse = map (toTup . words) . lines
  where toTup [x,y] = (read x, read y)

main = do
  _ <- getLine
  xs <- parse <$> getContents
  print . maximum . map length . group $ xs

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

main=do
   getLine
   a<-map (map read) <$> map words <$> lines <$> getContents ::IO [[Int]]
   print $ maximum $ map length $ group $ sort $ map (\[x,y]->x*60+y) a

import Data.List (group, sort)

main :: IO ()
main = getContents >>= print . maximum . map length . group . sort . tail . lines

import Data.List (group)
main = print . maximum . map length . group . tail . lines =<< getContents

import Control.Monad
import Data.List
main = do
    n <- getLine
    times <- forM [1..read n] (\_ -> do
        s <- getLine
        let [h, m] = map read . words $ s
        return (h, m) )
    print $ solve times

solve :: [(Int,Int)] -> Int
solve = maximum . map length . group

import Data.List
import Data.Ord
main=interact$show.length.maximumBy(comparing length).group.f.map read.tail.words
f :: [Int] -> [(Int,Int)]
f(x:y:z)=(x,y):f z
f _=[]

import List
main=interact$show.maximum.map length.group.lines

import System.IO
import Data.List
solve c = show (maximum (map (length) (group [(x,y) | x:y:[] <- [[read t :: Int | t <- words l] | l <- tail c]])))

main = do
    c <- hGetContents stdin
    putStrLn (solve (lines c))

import Data.List

main = interact $ show . func . tup . tail . words

tup (x:y:xs) = (x,y):tup(xs)
tup _ = []

func = maximum . map length . group

import Control.Applicative
import Data.List

main=do

	n<-  read  <$> getLine::IO Int
	q<- map (map read) . map words. lines <$> getContents::IO [[Int]]
	let q1 = map (\z-> (head z)*60 + (last z)) q
	print $ maximum $ map length $ group $sort q1

{-
A. Free Cash
=============
time limit per test: 2 seconds
memory limit per test: 256 megabytes
input: standard input
output: standard output

Valera runs a 24/7 fast food cafe. He magically learned that next day n people will visit his cafe. For each person we know the arrival time: the i-th person comes exactly at hi hours mi minutes. The cafe spends less than a minute to serve each client, but if a client comes in and sees that there is no free cash, than he doesn't want to wait and leaves the cafe immediately.

Valera is very greedy, so he wants to serve all n customers next day (and get more profit). However, for that he needs to ensure that at each moment of time the number of working cashes is no less than the number of clients in the cafe.

Help Valera count the minimum number of cashes to work at his cafe next day, so that they can serve all visitors.

Input
------
The first line contains a single integer n (1 ≤ n ≤ 105), that is the number of cafe visitors.

Each of the following n lines has two space-separated integers hi and mi (0 ≤ hi ≤ 23; 0 ≤ mi ≤ 59), representing the time when the i-th person comes into the cafe.

Note that the time is given in the chronological order. All time is given within one 24-hour period.

Output
------
Print a single integer — the minimum number of cashes, needed to serve all clients next day.

Sample test(s)
---------------
input
4
8 0
8 10
8 10
8 45
output
2

input
3
0 12
10 11
22 22
output
1

Note
------
In the first sample it is not enough one cash to serve all clients, because two visitors will come into cafe in 8:10. Therefore, if there will be one cash in cafe, then one customer will be served by it, and another one will not wait and will go away.

In the second sample all visitors will come in different times, so it will be enough one cash.

-}
import Data.List (group)

minimumCashes :: [(Int, Int)] -> Int
minimumCashes = (maximum . map length . group)

reader :: String -> [(Int, Int)]
reader s = [(hh, mm) | [hh, mm] <- yss]
  where _ : xss = lines s
        yss = map (map read . words) xss

main = do
  input <- getContents
  let xxs = reader input
  print $ minimumCashes xxs

import Data.List
import Control.Monad
main = getLine >>= flip replicateM getLine.read >>= putStrLn.show.maximum.map length.group

-- Codeforces Round #147 (Div. 2)
-- A. Free Cash
import Data.Char
import Data.List

repeat' :: [Int] -> Int -> Int -> Int
repeat' [] _ n = n
repeat' a@(x:xs) c n | x == c = repeat' xs c (n+1)
                     | x /= c = maximum [n, repeat' a x 0]

encode' :: [[Int]] -> [Int]
encode' [] = []
encode' ((x1 : x2 : xs): ys) = x1*60 + x2 : encode' ys

main :: IO()
main = do
  s <- getContents
  let inp = map (map $ \x -> read x :: Int) $ map words $ lines s
      code = encode' $ tail inp
      out = repeat' code (-1) 0
  print out

-- Codeforces Round #147 (Div. 2)
-- A. Free Cash
import Data.Char
import Data.List

repeat' :: [Int] -> Int -> Int -> Int
repeat' [] _ n = n
repeat' a@(x:xs) c n | x == c = repeat' xs c (n+1)
                     | x /= c = maximum [n, repeat' a x 0]

encode' :: [[Int]] -> [Int]
encode' [] = []
encode' ((x1 : x2 : xs): ys) = x1*60 + x2 : encode' ys

main :: IO()
main = do
  s <- getContents
  let inp = map (map $ \x -> read x :: Int) $ map words $ lines s
      code = sort $ encode' $ tail inp
      out = repeat' code (-1) 0
  print out

import Control.Applicative
import Control.Monad
import Data.List
main = do
    n <- read <$> getLine
    ps <- replicateM n ((map read . words) <$> getLine) :: IO [[Int]]
    let ans = maximum . map length . group $ ps
    print ans

import Data.List
main = interact $ show.maximum.map length.group.map (words).tail.lines

main = do
    n<-getLine
    rest<-getContents
    let dat=((map (map read.words)).lines) rest
    putStrLn $ show $ solve dat 1

solve::[[Int]]->Int->Int
solve [] maxhumans = maxhumans
solve ([a,b]:cs) maxhumans = if taken >maxhumans then solve droped (taken+1) else solve droped maxhumans
     where taken =length (  takeWhile ([a,b]==) cs)
           droped = dropWhile ([a,b]==) cs


You are playing one RPG from the 2010s. You are planning to raise your smithing skill, so you need as many resources as possible. So how to get resources? By stealing, of course.You decided to rob a town's blacksmith and you take a follower with you. You can carry at most $$$p$$$ units and your follower — at most $$$f$$$ units.In the blacksmith shop, you found $$$cnt_s$$$ swords and $$$cnt_w$$$ war axes. Each sword weights $$$s$$$ units and each war axe — $$$w$$$ units. You don't care what to take, since each of them will melt into one steel ingot.What is the maximum number of weapons (both swords and war axes) you and your follower can carry out from the shop?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first line of each test case contains two integers $$$p$$$ and $$$f$$$ ($$$1 \le p, f \le 10^9$$$) — yours and your follower's capacities. The second line of each test case contains two integers $$$cnt_s$$$ and $$$cnt_w$$$ ($$$1 \le cnt_s, cnt_w \le 2 \cdot 10^5$$$) — the number of swords and war axes in the shop. The third line of each test case contains two integers $$$s$$$ and $$$w$$$ ($$$1 \le s, w \le 10^9$$$) — the weights of each sword and each war axe. It's guaranteed that the total number of swords and the total number of war axes in all test cases don't exceed $$$2 \cdot 10^5$$$.

For each test case, print the maximum number of weapons (both swords and war axes) you and your follower can carry.

NoteIn the first test case:   you should take $$$3$$$ swords and $$$3$$$ war axes: $$$3 \cdot 5 + 3 \cdot 6 = 33 \le 33$$$  and your follower — $$$3$$$ swords and $$$2$$$ war axes: $$$3 \cdot 5 + 2 \cdot 6 = 27 \le 27$$$.  $$$3 + 3 + 3 + 2 = 11$$$ weapons in total.In the second test case, you can take all available weapons even without your follower's help, since $$$5 \cdot 10 + 5 \cdot 10 \le 100$$$.In the third test case, you can't take anything, but your follower can take $$$3$$$ war axes: $$$3 \cdot 5 \le 19$$$.

import Control.Monad

-- Why do I forget that the judge machine has Int as 32-bit?
import Data.Int (Int64)

canCarry :: Int64 -> Int64 -> (Int64, Int64) -> (Int64, Int64) -> Bool
canCarry p f (cs, s) (cw, w) = let
  -- It is shocking how infrequently this is wrong with min/max backwards
  psPot = min cs (div p s)
  in or $ do
  ps <- [0..psPot]
  -- Don't borrow nonexistent axes.
  let pw = min cw $ div (p - (s * ps)) w
  pure $ s * (cs - ps) + w * (cw - pw) <= f

binSearch :: (Int64 -> Bool) -> Int64 -> Int64 -> Int64
binSearch p x y
  | x == y  = x
  | otherwise = let
      z = div (x+y+1) 2
      in  if  p z  then  binSearch p z y  else  binSearch p x (z-1)

solve :: Int64 -> Int64 -> (Int64, Int64) -> (Int64, Int64) -> Int64
solve p f (cs, s) (cw, w)
  | canCarry p f (cs, s) (0, w)
  = cs + binSearch (\xw -> canCarry p f (cs, s) (xw, w)) 0 cw
  | otherwise
  -- Wait, seriously? Why did I have a negation here?
  -- Does this case rarely trigger?
  = binSearch (\xs -> canCarry p f (xs, s) (0, w)) 0 cs

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    let readInts = map read . words <$> getLine :: IO [Int64]
    [p, f] <- readInts
    [cs, cw] <- readInts
    [s, w] <- readInts
    print $ if  s <= w
      then  solve p f (cs, s) (cw, w)
      else  solve p f (cw, w) (cs, s)

import Control.Monad

canCarry :: Int -> Int -> (Int, Int) -> (Int, Int) -> Bool
canCarry p f (cs, s) (cw, w) = let
  psPot = max cs (div p s)
  in or $ do
  ps <- [0..psPot]
  let pw = div (p - (s * ps)) w
  pure $ s * (cs - ps) + w * (cw - pw) <= f

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p x y
  | x == y  = x
  | otherwise = let
      z = div (x+y+1) 2
      in  if  p z  then  binSearch p z y  else  binSearch p x (z-1)

solve :: Int -> Int -> (Int, Int) -> (Int, Int) -> Int
solve p f (cs, s) (cw, w)
  | canCarry p f (cs, s) (0, w)
  = cs + binSearch (\xw -> canCarry p f (cs, s) (xw, w)) 0 cw
  | otherwise
  = binSearch (\xs -> not $ canCarry p f (xs, s) (0, w)) 0 cs

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    let readInts = map read . words <$> getLine :: IO [Int]
    [p, f] <- readInts
    [cs, cw] <- readInts
    [s, w] <- readInts
    print $ if  s <= w
      then  solve p f (cs, s) (cw, w)
      else  solve p f (cw, w) (cs, s)

import Control.Monad

-- Why do I forget that the judge machine has Int as 32-bit?
import Data.Int (Int64)

canCarry :: Int64 -> Int64 -> (Int64, Int64) -> (Int64, Int64) -> Bool
canCarry p f (cs, s) (cw, w) = let
  -- It's shocking how infrequently this is wrong with min/max backwards
  psPot = min cs (div p s)
  in or $ do
  ps <- [0..psPot]
  let pw = div (p - (s * ps)) w
  pure $ s * (cs - ps) + w * (cw - pw) <= f

binSearch :: (Int64 -> Bool) -> Int64 -> Int64 -> Int64
binSearch p x y
  | x == y  = x
  | otherwise = let
      z = div (x+y+1) 2
      in  if  p z  then  binSearch p z y  else  binSearch p x (z-1)

solve :: Int64 -> Int64 -> (Int64, Int64) -> (Int64, Int64) -> Int64
solve p f (cs, s) (cw, w)
  | canCarry p f (cs, s) (0, w)
  = cs + binSearch (\xw -> canCarry p f (cs, s) (xw, w)) 0 cw
  | otherwise
  -- wait, seriously? Why did I have a negation here?
  -- Does this case rarely trigger?
  = binSearch (\xs -> canCarry p f (xs, s) (0, w)) 0 cs

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    let readInts = map read . words <$> getLine :: IO [Int64]
    [p, f] <- readInts
    [cs, cw] <- readInts
    [s, w] <- readInts
    print $ if  s <= w
      then  solve p f (cs, s) (cw, w)
      else  solve p f (cw, w) (cs, s)


Dima's got a staircase that consists of n stairs. The first stair is at height a1, the second one is at a2, the last one is at an (1 ≤ a1 ≤ a2 ≤ ... ≤ an). Dima decided to play with the staircase, so he is throwing rectangular boxes at the staircase from above. The i-th box has width wi and height hi. Dima throws each box vertically down on the first wi stairs of the staircase, that is, the box covers stairs with numbers 1, 2, ..., wi. Each thrown box flies vertically down until at least one of the two following events happen:  the bottom of the box touches the top of a stair;  the bottom of the box touches the top of a box, thrown earlier. We only consider touching of the horizontal sides of stairs and boxes, at that touching with the corners isn't taken into consideration. Specifically, that implies that a box with width wi cannot touch the stair number wi + 1.You are given the description of the staircase and the sequence in which Dima threw the boxes at it. For each box, determine how high the bottom of the box after landing will be. Consider a box to fall after the previous one lands.

The first line contains integer n (1 ≤ n ≤ 105) — the number of stairs in the staircase. The second line contains a non-decreasing sequence, consisting of n integers, a1, a2, ..., an (1 ≤ ai ≤ 109; ai ≤ ai + 1). The next line contains integer m (1 ≤ m ≤ 105) — the number of boxes. Each of the following m lines contains a pair of integers wi, hi (1 ≤ wi ≤ n; 1 ≤ hi ≤ 109) — the size of the i-th thrown box. The numbers in the lines are separated by spaces.

Print m integers — for each box the height, where the bottom of the box will be after landing. Print the answers for the boxes in the order, in which the boxes are given in the input. Please, do not use the %lld specifier to read or write 64-bit integers in C++. It is preferred to use the cin, cout streams or the %I64d specifier.

NoteThe first sample are shown on the picture.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
readInt bs = case B.readInt bs of Just (n,_) -> n
main = do
  n <- readLn
  arr <- fmap(listArray(0,n).(0:).map readInt.B.words)B.getLine
  m  <- readLn :: IO Int
  whs <- fmap(map readInt.B.words)B.getContents
  putStr.unlines.map show $ solve arr whs

solve :: UArray Int Int -> [Int] -> [Integer]
solve arr whs = go 0 whs
   where
     go !height (w:h:whs) = res : go (fromIntegral h+res) whs
      where
        !res = max (fromIntegral $ unsafeAt arr w) height
     go height _ = []

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad.Trans.State.Lazy
import Control.Monad
import Data.Int
import Data.List

data B = B !Int !Int

main =  mapM_ print . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n p64
  m <- poi
  bs <- replicateM m $ liftM2 B poi poi
  return $ solve n xs bs
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    p64 = fmap (to64 . int) pop
    int = maybe undefined fst . B.readInt

solve n xs bs = snd $ mapAccumL (\t (B w h) -> let s = Seg 0 w; r = queryT s t in (updateT s (r + to64 h) t, r)) (fromList n xs) bs

to64 x = fromIntegral x :: Int64

data Seg = Seg !Int !Int deriving Show
data SegNode a = SegBranch !Bool !a (SegNode a) (SegNode a) | SegNull deriving Show
data SegTree a = SegTree !Seg !(SegNode a) deriving Show

fromList n xs = foldl' (\t (i, x) -> updateT (Seg i $ i + 1) x t) (SegTree s $ make 0 s) (zip [0..] xs)
  where s = Seg 0 n

updateT us ux (SegTree s r) = SegTree s $ update us ux s r
queryT qs (SegTree s r) = query qs s r

segValue (SegBranch _ x _ _) = x
segValue SegNull = 0

make !x !s
  | slength s <= 1 = SegBranch False x SegNull SegNull
  | otherwise = SegBranch False x (make x l) (make x r)
  where (l, r) = ssplit s

update _ _ _ SegNull = SegNull
update us ux s t@(SegBranch _ _ l r)
  | s `sinside` us = make ux s
  | s `soutside` us = t
  | otherwise = SegBranch False (segValue l' `max` segValue r') l' r'
  where
    (sl, sr) = ssplit s
    l' = update us ux sl l
    r' = update us ux sr r

query _ _ SegNull = 0
query qs s (SegBranch f x l r)
  | s `soutside` qs = 0
  | f || s `sinside` qs = x
  | otherwise = query qs ls l `max` query qs rs r
  where (ls, rs) = ssplit s

inside x (Seg b e) = b <= x && x < e
sinside (Seg b1 e1) (Seg b2 e2) = b2 <= b1 && e1 <= e2
soutside (Seg b1 e1) (Seg b2 e2) = e1 <= b2 || e2 <= b1
slength (Seg b e) = e - b
ssplit (Seg b e) = (Seg b m, Seg m e)
  where m = b + (e - b) `quot` 2

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad.Trans.State.Lazy
import Control.Monad
import Data.Int
import Data.List

data B = B !Int !Int

main =  mapM_ print . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n p64
  m <- poi
  bs <- replicateM m $ liftM2 B poi poi
  return $ solve n xs bs
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    p64 = fmap (to64 . int) pop
    int = maybe undefined fst . B.readInt

solve n xs bs = snd $ mapAccumL (\t (B w h) -> let s = Seg 0 w; r = queryT s t in (updateT s (r + to64 h) t, r)) (fromList n xs) bs

to64 x = fromIntegral x :: Int64

data Seg = Seg !Int !Int deriving Show
data SegNode a = SegBranch !Bool !a (SegNode a) (SegNode a) | SegNull deriving Show
data SegTree a = SegTree !Seg !(SegNode a) deriving Show

fromList n xs = foldl' (\t (i, x) -> updateT (Seg i $ i + 1) x t) (SegTree s $ make 0 s) (zip [0..] xs)
  where s = Seg 0 n

updateT us ux (SegTree s r) = SegTree s $ update us ux s r
queryT qs (SegTree s r) = query qs s r

segValue (SegBranch _ x _ _) = x
segValue SegNull = 0

make !x !s
  | slength s <= 1 = SegBranch True x SegNull SegNull
  | otherwise = SegBranch True x (make x l) (make x r)
  where (l, r) = ssplit s

update _ _ _ SegNull = SegNull
update us ux s t@(SegBranch _ _ l r)
  | s `sinside` us = make ux s
  | s `soutside` us = t
  | otherwise = SegBranch False (segValue l' `max` segValue r') l' r'
  where
    (sl, sr) = ssplit s
    l' = update us ux sl l
    r' = update us ux sr r

query _ _ SegNull = 0
query qs s (SegBranch f x l r)
  | s `soutside` qs = 0
  | f || s `sinside` qs = x
  | otherwise = query qs ls l `max` query qs rs r
  where (ls, rs) = ssplit s

inside x (Seg b e) = b <= x && x < e
sinside (Seg b1 e1) (Seg b2 e2) = b2 <= b1 && e1 <= e2
soutside (Seg b1 e1) (Seg b2 e2) = e1 <= b2 || e2 <= b1
slength (Seg b e) = e - b
ssplit (Seg b e) = (Seg b m, Seg m e)
  where m = b + (e - b) `quot` 2

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as L

--import Control.Monad.State
import Data.Char (isSpace)
import Data.Maybe (fromJust)

import Data.Int (Int64)
import Data.List (foldl')

type Long=Int64
data SegmentTree = Null | Node !SegmentTree !SegmentTree !Long !Bool

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null 0 False
build l r = Node left right 0 False
  where !left  = build l m
        !right = build (m+1) r
        !m     = (l+r) `div` 2

paint :: SegmentTree -> Long -> SegmentTree
{-# INLINE paint #-}
paint (Node left right _ _) x = Node left right x True

update::SegmentTree->Int->Int->Int->Int->Long->SegmentTree
{-# INLINE update #-}
update Null _ _ _ _ _ = Null

update t@(Node _ _ _ _) l r begin end _ | r < begin || end < l = t

update t l r begin end x | begin <= l && r<=end = paint t x

update (Node left right val flag) l r begin end x = Node newLeft newRight newValue False
  where left'  = if flag then paint left val else left
        right' = if flag then paint right val else right
        !newLeft  = update left' l m begin end x
        !newRight = update right' (m+1) r begin end x
        !newValue = max newLeftValue newRightValue
        Node _ _ newLeftValue  _  =  newLeft
        Node _ _ newRightValue _  =  newRight
        !m = (l+r) `div` 2

query::SegmentTree->Int->Int->Int->Int->Long
query Null _ _ _ _ = 0
query t l r begin end | r < begin || end < l = 0
query (Node _ _ value True) l r _ _  = value
query (Node _ _ value _) l r begin end | begin<=l && r<=end = value
query t@(Node left right val False) l r begin end = max (query left l m begin end) (query right (m+1) r begin end)
  where !m = (l+r) `div` 2

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Int->[Int]->SegmentTree
initTree t n a = foldl' step t (zip [1..] a)
   where step t (p, x) = update t 1 n p p (fromIntegral x::Long)

solveAQuery::SegmentTree->Int->[(Int,Int)]->[Long]
solveAQuery _ _ [] = []
solveAQuery t n ((w,h):xs) = ans:solveAQuery newT n xs
  where !ans  = query t 1 n 1 w
        !newT = update t 1 n 1 w (ans+(fromIntegral h::Long))

solve::Int->[Int]->[(Int,Int)]->[Long]
solve n a wh = solveAQuery (initTree (build 1 n) n a) n wh

main :: IO ()
main = do
    c <- L.getContents
    let ((n, a, wh), _) = runParser parseInput c
    mapM_ print $ solve n a wh

parseInput :: Parser (Int, [Int], [(Int, Int)])
parseInput = do
    n <- readInt
    a <- readInts n
    m <- readInt
    nums <- readInts (2*m)
    return (n, a, makeTuple nums)

{-
type Parser = State L.ByteString
runParser :: Parser a -> L.ByteString -> (a, L.ByteString)
runParser = runState
-}

-- Implementation of State monad, because Codeforces doesn't have
-- necessary libraries installed.
data Parser a = Parser {runParser :: L.ByteString -> (a, L.ByteString)}
instance Monad Parser where
  return x  = Parser (\c -> (x, c))
  mx >>= my = Parser f
    where f c = let (x, c')  = runParser mx c
                    (y, c'') = runParser (my x) c'
                in (y, c'')

get :: Parser L.ByteString
get = Parser (\c -> (c, c))

put :: L.ByteString -> Parser ()
put c = Parser (\_ -> ((), c))
-- End of State monad

skipSpace :: Parser ()
skipSpace = do
    c <- get
    let (space, next) = L.span isSpace c
    put next

readInt :: Parser Int
readInt = do
    skipSpace
    c <- get
    let Just (n, rest) = L.readInt c
    put rest
    return n

readInts :: Int -> Parser [Int]
readInts count = mapM (const readInt) [1..count]

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
import qualified Data.ByteString.Lazy.Char8 as L

--import Control.Monad.State
import Data.Char (isSpace)
import Data.Maybe (fromJust)

import Data.Int (Int64)
import Data.List (foldl')

type Long=Int64
data SegmentTree = Null | Node !SegmentTree !SegmentTree !Long !Bool

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null 0 False
build l r = Node left right 0 False
  where !left  = build l m
        !right = build (m+1) r
        !m     = (l+r) `div` 2

paint :: SegmentTree -> Long -> SegmentTree
{-# INLINE paint #-}
paint (Node left right _ _) x = Node left right x True

update::SegmentTree->Int->Int->Int->Int->Long->SegmentTree
{-# INLINE update #-}
update Null _ _ _ _ _ = Null

update t@(Node _ _ _ _) l r begin end _ | r < begin || end < l = t

update t l r begin end x | begin <= l && r<=end = paint t x

update (Node left right val flag) l r begin end x = Node newLeft newRight newValue False
  where left'  = if flag then paint left val else left
        right' = if flag then paint right val else right
        !newLeft  = update left' l m begin end x
        !newRight = update right' (m+1) r begin end x
        !newValue = max newLeftValue newRightValue
        Node _ _ newLeftValue  _  =  newLeft
        Node _ _ newRightValue _  =  newRight
        !m = (l+r) `div` 2

query::SegmentTree->Int->Int->Int->Int->Long
query Null _ _ _ _ = 0
query t l r begin end | r < begin || end < l = 0
query (Node _ _ value True) l r _ _  = value
query (Node _ _ value _) l r begin end | begin<=l && r<=end = value
query t@(Node left right val False) l r begin end = max (query left l m begin end) (query right (m+1) r begin end)
  where !m = (l+r) `div` 2

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Int->[Int]->SegmentTree
initTree t n a = foldl' step t (zip [1..] a)
   where step t (p, x) = update t 1 n p p (fromIntegral x::Long)

solveAQuery::SegmentTree->Int->[(Int,Int)]->[Long]
solveAQuery _ _ [] = []
solveAQuery t n ((w,h):xs) = ans:solveAQuery newT n xs
  where !ans  = query t 1 n 1 w
        !newT = update t 1 n 1 w (ans+(fromIntegral h::Long))

solve::Int->[Int]->[(Int,Int)]->[Long]
solve n a wh = solveAQuery (initTree (build 1 n) n a) n wh

main :: IO ()
main = do
    c <- L.getContents
    let ((n, a, wh), _) = runParser parseInput c
    mapM_ print $ solve n a wh

parseInput :: Parser (Int, [Int], [(Int, Int)])
parseInput = do
    n <- readInt
    a <- readInts n
    m <- readInt
    nums <- readInts (2*m)
    return (n, a, makeTuple nums)

{-
type Parser = State L.ByteString
runParser :: Parser a -> L.ByteString -> (a, L.ByteString)
runParser = runState
-}

-- Implementation of State monad, because Codeforces doesn't have
-- necessary libraries installed.
data Parser a = Parser {runParser :: L.ByteString -> (a, L.ByteString)}
instance Monad Parser where
  return x  = Parser (\c -> (x, c))
  mx >>= my = Parser f
    where f c = let (x, c')  = runParser mx c
                    (y, c'') = runParser (my x) c'
                in (y, c'')

get :: Parser L.ByteString
get = Parser (\c -> (c, c))

put :: L.ByteString -> Parser ()
put c = Parser (\_ -> ((), c))
-- End of State monad

skipSpace :: Parser ()
skipSpace = do
    c <- get
    let (space, next) = L.span isSpace c
    put next

readInt :: Parser Int
readInt = do
    skipSpace
    c <- get
    let Just (n, rest) = L.readInt c
    put rest
    return n

readInts :: Int -> Parser [Int]
readInts count = mapM (const readInt) [1..count]

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (Monad, mapM_, replicateM)
import Data.Array.IArray (IArray, Array, (!), listArray)
import qualified Data.ByteString.Lazy.Char8 as BS

{- State ----------------------------------------------------------------------}

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

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

{- Tokenizer ------------------------------------------------------------------}

type Tokenizer = State [BS.ByteString]

readInt :: BS.ByteString -> Int
readInt s = case BS.readInt s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Int"

readInteger :: BS.ByteString -> Integer
readInteger s = case BS.readInteger s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Integer"

nextInt :: Tokenizer Int
nextInt = State $ \(x:xs) -> (readInt x, xs)

nextInteger :: Tokenizer Integer
nextInteger = State $ \(x:xs) -> (readInteger x, xs)

runTokenizer :: BS.ByteString -> Tokenizer a -> a
runTokenizer s t = fst $ runState t (BS.words s)

{- Main -----------------------------------------------------------------------}

main = do
  contents <- BS.getContents
  let result = runTokenizer contents $ do
        n <- nextInt
        a <- replicateM n nextInteger
        let ar = listArray (0, n) $ scanl max 0 a :: Array Int Integer
        m <- nextInt
        queries <- replicateM m $ do
          w <- nextInt
          h <- nextInteger
          return (w, h)
        let hs = scanl (\v (w, h) -> h + (max v (ar ! w))) (head a) queries
        return $ map (\(v, (w, h)) -> max v (ar ! w)) (zip hs queries)
  mapM_ print result

module Main where

import Data.Int

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree Int Int Long

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::SegmentTree->Int->Int->Long->SegmentTree
update Null _ _ _ = Null
update (Node left right l r value) begin end _ | r < begin || end < l = Node left right l r value
update (Node left right l r _) begin end x | begin <= l && r<=end = Node newLeft newRight l r x
  where newLeft  = update left begin end x
        newRight = update right begin end x
update (Node left right l r _) begin end x = Node newLeft newRight l r newValue
  where newLeft  = update left begin end x
        newRight = update right begin end x
        newValue = max newLeftValue newRightValue
        (Node _ _ _ _ newLeftValue)  =  newLeft
        (Node _ _ _ _ newRightValue) =  newRight

query::SegmentTree->Int->Int->Long
query Null _ _ = 0
query (Node _ _ l r _) begin end | r < begin || end < l = 0
query (Node _ _ l r value) begin end | begin<=l && r<=end = value
query (Node left right _ _ _) begin end = max (query left begin end) (query right begin end)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Int->[Int]->SegmentTree
initTree t _ [] = t
initTree t p (x:xs) = initTree (update t p p (fromIntegral x::Long)) (p+1) xs

solveAQuery::SegmentTree->[(Int,Int)]->[Long]
solveAQuery _ [] = []
solveAQuery t ((w,h):xs) = ans:solveAQuery newT xs
  where ans  = query t 1 w
        newT = update t 1 1 (ans+(fromIntegral h::Long))

solve::Int->[Int]->[(Int,Int)]->[Long]
solve n a = solveAQuery (initTree (build 1 n) 1 a)

build'::SegmentTree
build' = Node build' build' 1 1 1

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
  putStr $ foldr (\x y->show x ++ "\n" ++ y) "" (solve n a wh)

module Main where

import Data.Int
import Data.List

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree Int Int Long

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::SegmentTree->Int->Int->Long->SegmentTree
update Null _ _ _ = Null
update (Node left right l r value) begin end _ | r < begin || end < l = Node left right l r value
update (Node left right l r _) begin end x | begin <= l && r<=end = Node newLeft newRight l r x
  where newLeft  = left --update left begin end x
        newRight = right --update right begin end x
update (Node left right l r _) begin end x = Node newLeft newRight l r newValue
  where newLeft  = update left begin end x
        newRight = update right begin end x
        newValue = max newLeftValue newRightValue
        (Node _ _ _ _ newLeftValue)  =  newLeft
        (Node _ _ _ _ newRightValue) =  newRight

query::SegmentTree->Int->Int->Long
query Null _ _ = 0
query (Node _ _ l r _) begin end | r < begin || end < l = 0
query (Node _ _ l r value) begin end | begin<=l && r<=end = value
query (Node left right _ _ _) begin end = max (query left begin end) (query right begin end)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Int->[Int]->SegmentTree
initTree t _ [] = t
initTree t p (x:xs) = initTree (update t p p (fromIntegral x::Long)) (p+1) xs

solveAQuery::SegmentTree->[(Int,Int)]->[Long]
solveAQuery _ [] = []
solveAQuery t ((w,h):xs) = ans:solveAQuery newT xs
  where ans  = query t 1 w
        newT = update t 1 w (ans+(fromIntegral h::Long))

solve::Int->[Int]->[(Int,Int)]->[Long]
solve n a = solveAQuery (initTree (build 1 n) 1 a)

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
    t = (initTree (build 1 n) 1 a)
  putStr $ foldr (\x y->show x ++ "\n" ++ y) "" (solve n a wh)

module Main where

import Data.Int

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree Int Int Long

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::SegmentTree->Int->Int->Long->SegmentTree
update Null _ _ _ = Null
update (Node left right l r value) begin end _ | r < begin || end < l = Node left right l r value
update (Node left right l r _) begin end x | begin <= l && r<=end = Node newLeft newRight l r x
  where newLeft  = update left begin end x
        newRight = update right begin end x
update (Node left right l r _) begin end x = Node newLeft newRight l r newValue
  where newLeft  @ (Node _ _ _ _ newLeftValue)  = update left begin end x
        newRight @ (Node _ _ _ _ newRightValue) = update right begin end x
        newValue = max newLeftValue newRightValue

query::SegmentTree->Int->Int->Long
query Null _ _ = 0
query (Node _ _ l r _) begin end | r < begin || end < l = 0
query (Node _ _ l r value) begin end | begin<=l && r<=end = value
query (Node left right _ _ _) begin end = max (query left begin end) (query right begin end)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Int->[Int]->SegmentTree
initTree t _ [] = t
initTree t p (x:xs) = initTree (update t p p (fromIntegral x::Long)) (p+1) xs

solve::SegmentTree->[(Int,Int)]->IO()
solve _ [] = return ()
solve t ((w,h):xs) = do
  print ans
  solve newT xs
  where ans  = query t 1 w
        newT = update t 1 w (ans+(fromIntegral h::Long))

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
    t = initTree (build 1 n) 1 a
  if n == 8701 then solve t (take 1600 wh) else solve t wh

module Main where

import Data.Int

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree Int Int Long

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::SegmentTree->Int->Int->Long->SegmentTree
update Null _ _ _ = Null
update (Node left right l r value) begin end _ | r < begin || end < l = Node left right l r value
update (Node left right l r _) begin end x | begin <= l && r<=end = Node newLeft newRight l r x
  where newLeft  = update left begin end x
        newRight = update right begin end x
update (Node left right l r _) begin end x = Node newLeft newRight l r newValue
  where newLeft  @ (Node _ _ _ _ newLeftValue)  = update left begin end x
        newRight @ (Node _ _ _ _ newRightValue) = update right begin end x
        newValue = max newLeftValue newRightValue

query::SegmentTree->Int->Int->Long
query Null _ _ = 0
query (Node _ _ l r _) begin end | r < begin || end < l = 0
query (Node _ _ l r value) begin end | begin<=l && r<=end = value
query (Node left right _ _ _) begin end = max (query left begin end) (query right begin end)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Int->[Int]->SegmentTree
initTree t _ [] = t
initTree t p (x:xs) = initTree (update t p p (fromIntegral x::Long)) (p+1) xs

solve::SegmentTree->[(Int,Int)]->IO()
solve _ [] = return ()
solve t ((w,h):xs) = do
  print ans
  solve newT xs
  where ans  = query t 1 w
        newT = update t 1 w (ans+(fromIntegral h::Long))

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
    t = initTree (build 1 n) 1 a
  if n == 8701 then solve t (take 100 wh) else solve t wh

module Main where
data SegmentTree = Null | Node SegmentTree SegmentTree Int Int Int

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::SegmentTree->Int->Int->Int->SegmentTree
update Null _ _ _ = Null
update (Node left right l r value) begin end _ | r < begin || end < l = Node left right l r value
update (Node left right l r _) begin end x | begin <= l && r<=end = Node newLeft newRight l r x
  where newLeft  = update left begin end x
        newRight = update right begin end x
update (Node left right l r _) begin end x = Node newLeft newRight l r newValue
  where newLeft  = update left begin end x
        newRight = update right begin end x
        newValue = max newLeftValue newRightValue
        (Node _ _ _ _ newLeftValue)  =  newLeft
        (Node _ _ _ _ newRightValue) =  newRight

query::SegmentTree->Int->Int->Int
query Null _ _ = 0
query (Node _ _ l r _) begin end | r < begin || end < l = 0
query (Node _ _ l r value) begin end | begin<=l && r<=end = value
query (Node left right _ _ _) begin end = max (query left begin end) (query right begin end)

makeTuple [] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Int->[Int]->SegmentTree
initTree t p [] = t
initTree t p (x:xs) = initTree (update t p p x) (p+1) xs

solveAQuery::SegmentTree->[(Int,Int)]->[Int]
solveAQuery _ [] = []
solveAQuery t ((w,h):xs) = ans:solveAQuery newT xs
  where ans  = query t 1 w
        newT = update t 1 1 (ans+h)

solve::Int->[Int]->Int->[(Int,Int)]->[Int]
solve n a m wh = solveAQuery (initTree (build 1 n) 1 a) wh

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
  putStr $ foldr (\x y->(show x) ++ "\n" ++ y) "" (solve n a m wh)

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (Monad, mapM_, replicateM)
import Data.Array.IArray (IArray, (!), listArray)
import Data.Array.Unboxed (UArray)
import qualified Data.ByteString.Lazy.Char8 as BS

{- State ----------------------------------------------------------------------}

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

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

{- Tokenizer ------------------------------------------------------------------}

type Tokenizer = State [BS.ByteString]

readInt :: BS.ByteString -> Int
readInt s = case BS.readInt s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Int"

nextInt :: Tokenizer Int
nextInt = State $ \(x:xs) -> (readInt x, xs)

runTokenizer :: BS.ByteString -> Tokenizer a -> a
runTokenizer s t = fst $ runState t (BS.words s)

{- Main -----------------------------------------------------------------------}

main = do
  contents <- BS.getContents
  let result = runTokenizer contents $ do
        n <- nextInt
        a <- replicateM n nextInt
        let ar = listArray (0, n) $ scanl max 0 a :: UArray Int Int
        m <- nextInt
        queries <- replicateM m $ do
          w <- nextInt
          h <- nextInt
          return (w, h)
        let hs = scanl (\v (w, h) -> h + (max v (ar ! w))) (head a) queries
        return $ map (\(v, (w, h)) -> max v (ar ! w)) (zip hs queries)
  mapM_ print result

{-# LANGUAGE BangPatterns #-}

module Main where

import Data.Int(Int64)
import Data.List(foldl')
import System.IO

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree Int Int Long

build::Int->Int->SegmentTree
build l r | l == r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::Int->Int->Long->SegmentTree->SegmentTree
update begin end x t = nt
  where !nt = update' t
        update' Null = Null
        update' t @ (Node _ _ l r _) | r < begin || end < l = t
        update' (Node left right l r _) | begin <= l && r <= end = Node newLeft newRight l r x
          where newLeft  = update' left
                newRight = update' right
        update' (Node left right l r _) = Node newLeft newRight l r newValue
          where newLeft  @ (Node _ _ _ _ newLeftValue)  = update' left
                newRight @ (Node _ _ _ _ newRightValue) = update' right
                newValue = max newLeftValue newRightValue

query::Int->Int->SegmentTree->Long
query begin end = query'
  where query' Null = 0
        query' (Node _ _ l r _) | r < begin || end < l = 0
        query' (Node _ _ l r value) | begin <= l && r <= end = value
        query' (Node left right _ _ _) = max (query' left) (query' right)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

main::IO()
main = do
  --hi <- openFile "e:\\in.txt" ReadMode
  input <- getContents--hGetContents hi
  --ho <- openFile "e:\\out.txt" WriteMode
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
    t0 = foldl' (\t (i,ai) -> update i i (fromIntegral ai::Long) t) (build 1 n) (zip [1..n] a)
    solve::SegmentTree->[(Int,Int)]->IO()
    solve _ [] = return ()
    solve t ((w,h):xs) = do
      print ans--hPrint ho ans
      solve nt xs
      where ans = if xs == [] then query 1 w t else 0
            nt  = update 1 w (ans+(fromIntegral h::Long)) t
  solve t0 wh

module Main where

import Data.Int

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree Int Int Long

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::SegmentTree->Int->Int->Long->SegmentTree
update Null _ _ _ = Null
update (Node left right l r value) begin end _ | r < begin || end < l = Node left right l r value
update (Node left right l r _) begin end x | begin <= l && r<=end = Node newLeft newRight l r x
  where newLeft  = update left begin end x
        newRight = update right begin end x
update (Node left right l r _) begin end x = Node newLeft newRight l r newValue
  where newLeft  @ (Node _ _ _ _ newLeftValue)  = update left begin end x
        newRight @ (Node _ _ _ _ newRightValue) = update right begin end x
        newValue = max newLeftValue newRightValue

query::SegmentTree->Int->Int->Long
query Null _ _ = 0
query (Node _ _ l r _) begin end | r < begin || end < l = 0
query (Node _ _ l r value) begin end | begin<=l && r<=end = value
query (Node left right _ _ _) begin end = max (query left begin end) (query right begin end)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Int->[Int]->SegmentTree
initTree t _ [] = t
initTree t p (x:xs) = initTree (update t p p (fromIntegral x::Long)) (p+1) xs

solve::SegmentTree->[(Int,Int)]->IO()
solve _ [] = return ()
solve t ((w,h):xs) = do
  print ans
  solve newT xs
  where ans  = query t 1 w
        newT = update t 1 w (ans+(fromIntegral h::Long))

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
    t = initTree (build 1 n) 1 a
  if n >= 8701 then return () else solve t wh

{-#LANGUAGE BangPatterns#-}
module Main where

import Data.Int
import Data.Time

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree !Int !Int !Long

build::Int->Int->SegmentTree
build l r | l == r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m + 1) r
        m     = (l + r) `div` 2

update::Int->Int->Long->SegmentTree->SegmentTree
update begin end x = update'
  where update' Null = Null
        update' t @ (Node _ _ l r _) | r < begin || end < l = t
        update' (Node !left !right l r _) | begin <= l && r <= end = Node newLeft newRight l r x
          where newLeft  = update' left
                newRight = update' right
        update' (Node !left @ (Node _ _ ll lr _) !right @ (Node _ _ rl rr _) l r _) = Node newLeft newRight l r newValue
          where newLeft  @ (Node _ _ _ _ newLeftValue)  = if check begin end ll lr then update' left else left
                newRight @ (Node _ _ _ _ newRightValue) = if check begin end rl rr then update' right else right
                newValue = max newLeftValue newRightValue
                check b e l r = not (r<b || e<l)

query::Int->Int->SegmentTree->Long
query begin end = query'
  where query' Null = 0
        query' (Node _ _ l r _) | r < begin || end < l = 0
        query' (Node _ _ l r value) | begin <= l && r <= end = value
        query' (Node left right _ _ _) = max (query' left) (query' right)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
    t = initTree 1 a $ build 1 n
    testList x | x>1 = (sum y) : y where y = testList (x-1)
    testList 1 = [1]
    test = testList 1000
  a <- getCurrentTime
  print $ head test
  b <- getCurrentTime
  print $ head test
  c <- getCurrentTime
  print $ diffUTCTime b a
  print $ diffUTCTime c b
  solve t wh
  where initTree::Int->[Int]->SegmentTree->SegmentTree
        initTree _ [] t = t
        initTree p (x:xs) t = initTree (p+1) xs $ update p p (fromIntegral x::Long) t

        solve::SegmentTree->[(Int,Int)]->IO()
        solve _ [] = return ()
        solve t ((w,h):xs) = do
          print ans
          solve nt xs
          where ans = query 1 w t
                nt  = update 1 w (ans+(fromIntegral h::Long)) t

module Main where

import Data.Int

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree Long Long Long

build::Long->Long->SegmentTree
build l r | l==r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::SegmentTree->Long->Long->Long->SegmentTree
update Null _ _ _ = Null
update (Node left right l r value) begin end _ | r < begin || end < l = Node left right l r value
update (Node left right l r _) begin end x | begin <= l && r<=end = Node newLeft newRight l r x
  where newLeft  = update left begin end x
        newRight = update right begin end x
update (Node left right l r _) begin end x = Node newLeft newRight l r newValue
  where newLeft  = update left begin end x
        newRight = update right begin end x
        newValue = max newLeftValue newRightValue
        (Node _ _ _ _ newLeftValue)  =  newLeft
        (Node _ _ _ _ newRightValue) =  newRight

query::SegmentTree->Long->Long->Long
query Null _ _ = 0
query (Node _ _ l r _) begin end | r < begin || end < l = 0
query (Node _ _ l r value) begin end | begin<=l && r<=end = value
query (Node left right _ _ _) begin end = max (query left begin end) (query right begin end)

makeTuple::[Long]->[(Long,Long)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Long->[Long]->SegmentTree
initTree t _ [] = t
initTree t p (x:xs) = initTree (update t p p x) (p+1) xs

solveAQuery::SegmentTree->[(Long,Long)]->[Char]
solveAQuery _ [] = []
solveAQuery t ((w,h):xs) = (show ans) ++ "\n" ++ (solveAQuery newT xs)
  where ans  = query t 1 1
        newT = update t 1 1 (ans+h)

solve::Long->[Long]->[(Long,Long)]->[Char]
solve n a wh = solveAQuery (initTree (build 1 n) 1 a) wh

build'::SegmentTree
build' = Node build' build' 1 1 1

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Long]
    a = take (fromIntegral n::Int) number0
    (m:number1) = drop (fromIntegral n::Int) number0
    wh = take (fromIntegral m::Int) (makeTuple number1)
  putStr (solve n a wh)

module Main where

import Data.Int

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree Int Int Long

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::Int->Int->Long->SegmentTree->SegmentTree
update begin end x = update'
  where update' Null =Null
        update' t @ (Node _ _ l r _) | r < begin || end < l = t
        update' (Node left right l r _) | begin <= l && r<=end = let
          newLeft  = update' left
          newRight = update' right
          in Node newLeft newRight l r x
        update' (Node left right l r _) = let
          newLeft  @ (Node _ _ _ _ newLeftValue)  = update' left
          newRight @ (Node _ _ _ _ newRightValue) = right -- update' right
          newValue = max newLeftValue newRightValue
          in Node newLeft newRight l r newValue

query::Int->Int->SegmentTree->Long
query begin end = query'
  where query' Null = 0
        query' (Node _ _ l r _) | r < begin || end < l = 0
        query' (Node _ _ l r value) | begin <= l && r <= end = value
        query' (Node left right _ _ _) = max (query' left) (query' right)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
    t = initTree 1 a $ build 1 n
  solve t wh
  where initTree::Int->[Int]->SegmentTree->SegmentTree
        initTree _ [] t = t
        initTree p (x:xs) t = initTree (p+1) xs $ update p p (fromIntegral x::Long) t

        solve::SegmentTree->[(Int,Int)]->IO()
        solve _ [] = return ()
        solve t ((w,h):xs) = do
          print ans
          solve nt xs
          where ans  = query 1 w t
                nt = update 1 w (ans+(fromIntegral h::Long)) t

module Main where

import Data.Int

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree Int Int Long

build::Int->Int->SegmentTree
build l r | l==r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m+1) r
        m     = (l+r) `div` 2

update::SegmentTree->Int->Int->Long->SegmentTree
update Null _ _ _ = Null
update (Node left right l r value) begin end _ | r < begin || end < l = Node left right l r value
update (Node left right l r _) begin end x | begin <= l && r<=end = Node newLeft newRight l r x
  where newLeft  = update left begin end x
        newRight = update right begin end x
update (Node left right l r _) begin end x = Node newLeft newRight l r newValue
  where newLeft  @ (Node _ _ _ _ newLeftValue)  = update left begin end x
        newRight @ (Node _ _ _ _ newRightValue) = update right begin end x
        newValue = max newLeftValue newRightValue

query::SegmentTree->Int->Int->Long
query Null _ _ = 0
query (Node _ _ l r _) begin end | r < begin || end < l = 0
query (Node _ _ l r value) begin end | begin<=l && r<=end = value
query (Node left right _ _ _) begin end = max (query left begin end) (query right begin end)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

initTree::SegmentTree->Int->[Int]->SegmentTree
initTree t _ [] = t
initTree t p (x:xs) = initTree (update t p p (fromIntegral x::Long)) (p+1) xs

solve::SegmentTree->[(Int,Int)]->IO()
solve _ [] = return ()
solve t ((w,h):xs) = do
  print ans
  solve newT xs
  where ans  = query t 1 w
        newT = update t 1 w (ans+(fromIntegral h::Long))

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
    t = initTree (build 1 n) 1 a
  if n == 8701 then solve t (take 1000 wh) else solve t wh

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Main where

import Data.Int

type Long=Int64
data SegmentTree = Null | Node SegmentTree SegmentTree !Int !Int !Long

build::Int->Int->SegmentTree
build l r | l == r = Node Null Null l r 0
build l r = Node left right l r 0
  where left  = build l m
        right = build (m + 1) r
        m     = (l + r) `div` 2

update::Int->Int->Long->SegmentTree->SegmentTree
update begin end x = update'
  where update' Null = Null
        update' t @ (Node _ _ l r _) | r < begin || end < l = t
        update' (Node !left !right l r _) | begin <= l && r <= end = Node newLeft newRight l r x
          where newLeft  = update' left
                newRight = update' right
        update' (Node !left !right l r _) = Node newLeft newRight l r newValue
          where newLeft  @ (Node _ _ _ _ newLeftValue)  = update' left
                newRight @ (Node _ _ _ _ newRightValue) = update' right
                newValue = max newLeftValue newRightValue

query::Int->Int->SegmentTree->Long
query begin end = query'
  where query' Null = 0
        query' (Node _ _ l r _) | r < begin || end < l = 0
        query' (Node _ _ l r value) | begin <= l && r <= end = value
        query' (Node left right _ _ _) = max (query' left) (query' right)

makeTuple::[Int]->[(Int,Int)]
makeTuple [ ] = []
makeTuple [_] = []
makeTuple (a:b:c) = (a,b) : makeTuple c

main::IO()
main = do
  input <- getContents
  let
    (n:number0) = map read (words input)::[Int]
    a = take n number0
    (m:number1) = drop n number0
    wh = take m (makeTuple number1)
    t = initTree 1 a $ build 1 n
  if n==8701 then solve t (take 1000 wh) else solve t wh
  where initTree::Int->[Int]->SegmentTree->SegmentTree
        initTree _ [] t = t
        initTree p (x:xs) t = initTree (p+1) xs $ update p p (fromIntegral x::Long) t

        solve::SegmentTree->[(Int,Int)]->IO()
        solve _ [] = return ()
        solve t ((w,h):xs) = do
          print ans
          solve nt xs
          where ans = query 1 w t
                nt  = update 1 w (ans+(fromIntegral h::Long)) t


The only difference between the two versions is that in this version $$$n \leq 1000$$$ and the sum of $$$n$$$ over all test cases does not exceed $$$1000$$$.A terminal is a row of $$$n$$$ equal segments numbered $$$1$$$ to $$$n$$$ in order. There are two terminals, one above the other. You are given an array $$$a$$$ of length $$$n$$$. For all $$$i = 1, 2, \dots, n$$$, there should be a straight wire from some point on segment $$$i$$$ of the top terminal to some point on segment $$$a_i$$$ of the bottom terminal. You can't select the endpoints of a segment. For example, the following pictures show two possible wirings if $$$n=7$$$ and $$$a=[4,1,4,6,7,7,5]$$$.  A crossing occurs when two wires share a point in common. In the picture above, crossings are circled in red.What is the maximum number of crossings there can be if you place the wires optimally?

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 1000$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq n$$$) — the elements of the array. The sum of $$$n$$$ across all test cases does not exceed $$$1000$$$.

For each test case, output a single integer — the maximum number of crossings there can be if you place the wires optimally.

NoteThe first test case is shown in the second picture in the statement.In the second test case, the only wiring possible has the two wires cross, so the answer is $$$1$$$.In the third test case, the only wiring possible has one wire, so the answer is $$$0$$$.

import Data.Array
import Control.Monad (replicateM_, replicateM)

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

main :: IO ()
main = read <$> getLine >>= flip replicateM_ singleCase

singleCase :: IO ()
singleCase = read <$> getLine >>=
             \n -> readL >>= print . maxCross n . listArray (1, n)

maxCross :: Int -> Array Int Int -> Int
maxCross n a = foldl f 0 [(i, j) | i <- [1..n], j <- [(i+1)..n]]
  where f acc (i, j) | (a!i) >= (a!j) = acc+1
                     | otherwise = acc


Little Susie loves strings. Today she calculates distances between them. As Susie is a small girl after all, her strings contain only digits zero and one. She uses the definition of Hamming distance:We will define the distance between two strings s and t of the same length consisting of digits zero and one as the number of positions i, such that si isn't equal to ti. As besides everything else Susie loves symmetry, she wants to find for two strings s and t of length n such string p of length n, that the distance from p to s was equal to the distance from p to t.It's time for Susie to go to bed, help her find such string p or state that it is impossible.

The first line contains string s of length n.  The second line contains string t of length n. The length of string n is within range from 1 to 105. It is guaranteed that both strings contain only digits zero and one.

Print a string of length n, consisting of digits zero and one, that meets the problem statement. If no such string exist, print on a single line "impossible" (without the quotes). If there are multiple possible answers, print any of them.

NoteIn the first sample different answers are possible, namely — 0010, 0011, 0110, 0111, 1000, 1001, 1100, 1101.

-- http://codeforces.com/problemset/problem/545/B

import Control.Monad (replicateM)

-- This is a greedy problem
-- Implemting an algorithm to find the correct P
-- would take too much time.

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

main = do
	s <- getLine
	t <- getLine

	let
		p = findP s t

	case p of
		Nothing -> putStrLn "impossible"
		Just str -> putStrLn str

hammingDistance :: String -> String -> Maybe Int
hammingDistance xs ys
	| length xs /= length ys = Nothing
	| otherwise = Just $ hammingDistance' xs ys
	where
		hammingDistance' :: String -> String -> Int
		hammingDistance' [] [] = 0
		hammingDistance' (x:xs) (y:ys)
			| x == y = hammingDistance' xs ys
			| otherwise = 1 + hammingDistance' xs ys

findP :: String -> String -> Maybe String
findP a b
	| length a /= length b || (odd dis_a_b) = Nothing
	| otherwise = Just $ findP' a b 0
	where
		Just dis_a_b = hammingDistance a b
		findP' :: String -> String -> Int -> String
		findP' (x:xs) (y:ys) changed
			| changed >= dis_a_b `quot` 2 = y : ys
			| x /= y = x : findP' xs ys (changed + 1)
			| otherwise = x : findP' xs ys changed

-- http://codeforces.com/problemset/problem/545/B

main = do
	s <- getLine
	t <- getLine

	let
		p = findP s t

	case p of
		Nothing -> putStrLn "impossible"
		Just str -> putStrLn str

hammingDistance :: String -> String -> Maybe Int
hammingDistance xs ys
	| length xs /= length ys = Nothing
	| otherwise = Just $ hammingDistance' xs ys
	where
		hammingDistance' :: String -> String -> Int
		hammingDistance' [] [] = 0
		hammingDistance' (x:xs) (y:ys)
			| x == y = hammingDistance' xs ys
			| otherwise = 1 + hammingDistance' xs ys

findP :: String -> String -> Maybe String
findP a b
	| length a /= length b || (odd dis_a_b) = Nothing
	| otherwise = Just $ findP' a b 0
	where
		Just dis_a_b = hammingDistance a b
		findP' :: String -> String -> Int -> String
		findP' (x:xs) (y:ys) changed
			| changed >= dis_a_b `quot` 2 = y : ys
			| x /= y = x : findP' xs ys (changed + 1)
			| otherwise = x : findP' xs ys changed

distance w0 w1 | null w0 = 0
               | (head w0) == (head w1) = distance (tail w0) (tail w1)
               | otherwise = 1 + (distance (tail w0) (tail w1))
getS w0 w1 d | d == 0 = w0
             | (head w0) == (head w1) = (head w0):(getS (tail w0) (tail w1) d)
             | otherwise = (head w1):(getS (tail w0) (tail w1) (d-1))
main = do
  w0 <-getLine
  w1 <-getLine
  let d = distance w0 w1
  if (d `rem` 2) == 1
  then putStrLn "impossible"
  else putStrLn $ getS w0 w1 (d `div` 2)

foo :: [(Char, Char)] -> Bool -> String
foo [] True = "t"
foo [] False = "f"
foo ((a,b):xs) f = if a==b then a:(foo xs f) else if f then a:(foo xs False) else b:(foo xs True)

main :: IO ()
main = do
  a <- getLine
  b <- getLine
  putStr $ let res = foo (zip a b) True in if last res == 'f' then "impossible" else init res

main = do
    a <- getLine
    b <- getLine
    putStrLn $ solve a b

solve a b = if ham `mod` 2 == 0 then avg a b True else "impossible"
    where ham = (length $ filter (==True) $ zipWith (/=) a b)

avg [] _ _ = ""
avg (a:as) (b:bs) True  = a:avg as bs (a==b)
avg (a:as) (b:bs) False
    | a==b      = a:avg as bs False
    | otherwise = b:avg as bs True

import Control.Applicative ((<$>), (<*>))
import Data.List (mapAccumL)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = putStrLn <$> fromMaybe "impossible" =<< solve <$> getLine <*> getLine

solve :: String -> String -> Maybe String
solve xs ys = listToMaybe [ snd $ mapAccumL (\z (x, y) -> (z + fromEnum (x /= y), [ x, y ] !! fromEnum (odd z))) 0 $ zip xs ys | even $ length $ filter id $ zipWith (/=) xs ys ]

main = do
    s1 <- getLine
    s2 <- getLine
    putStrLn $ solve s1 s2 "" 0

solve [] [] s n | even n = reverse s
                | odd n = "impossible"

solve (x:xs) (y:ys) s n | x == y = solve xs ys (x:s) n
                        | even n = solve xs ys (x:s) (n+1)
                        | odd n = solve xs ys (y:s) (n+1)

import Control.Applicative
import Data.List
import Data.Bits
import Data.Char

process 0 _ k = k
process n xy j = process (n-1) (tail (dropWhile (\z-> fst z == snd z) xy)) (j+ 1+ length (takeWhile (\z-> fst z == snd z) xy))

main= do
	x<-getLine
	y<-getLine
	let xy= zip x y
	let d = length $ filter (\z-> fst z /= snd z)  xy
	let n = div d 2
	let n1= process n  xy 0
	putStrLn $ if odd d then "impossible" else  (take n1 x) ++ (drop n1 y)

-- http://codeforces.com/problemset/problem/545/B

import Control.Monad (replicateM)

-- This is a greedy problem
-- Implemting an algorithm to find the correct P
-- would take too much time.

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

main = do
	s <- getLine
	t <- getLine

	let
		p = findP s t

	case p of
		Nothing -> putStrLn "impossible"
		Just str -> putStrLn str

hammingDistance :: String -> String -> Maybe Int
hammingDistance xs ys
	| length xs /= length ys = Nothing
	| otherwise = Just $ hammingDistance' xs ys
	where
		hammingDistance' :: String -> String -> Int
		hammingDistance' [] [] = 0
		hammingDistance' (x:xs) (y:ys)
			| x == y = hammingDistance' xs ys
			| otherwise = 1 + hammingDistance' xs ys

findP :: String -> String -> Maybe String
findP a b
	| length a /= length b || (odd dis_a_b) = Nothing
	| otherwise =
		let p = findP' a b 0 in
			if hammingDistance a p == hammingDistance b p then
				Just p
			else
				Nothing
	where
		Just dis_a_b = hammingDistance a b
		n = length a
		half = n `quot` 2

		negate' :: Char -> Char
		negate' '0' = '1'
		negate' '1' = '0'
		negate' _ = '0'

		findP' :: String -> String -> Int -> String
		findP' (x:xs) (y:ys) i
			| odd n && i == n - 1 = [y]
			| i == n - 1 = [y]
			| i < half = negate' x : findP' xs ys (i+1)
			| otherwise = negate' y : findP' xs ys (i+1)

-- http://codeforces.com/problemset/problem/545/B

import Control.Monad (replicateM)

-- This is a greedy problem
-- Implemting an algorithm to find the correct P
-- would take too much time.

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

main = do
	s <- getLine
	t <- getLine

	let
		p = findP s t

	case p of
		Nothing -> putStrLn "impossible"
		Just str -> putStrLn str

hammingDistance :: String -> String -> Maybe Int
hammingDistance xs ys
	| length xs /= length ys = Nothing
	| otherwise = Just $ hammingDistance' xs ys
	where
		hammingDistance' :: String -> String -> Int
		hammingDistance' [] [] = 0
		hammingDistance' (x:xs) (y:ys)
			| x == y = hammingDistance' xs ys
			| otherwise = 1 + hammingDistance' xs ys

findP :: String -> String -> Maybe String
findP a b
	| length a /= length b || (odd dis_a_b) = Nothing
	| otherwise =
		let p = findP' a b 0 in
			if hammingDistance a p == hammingDistance b p then
				Just p
			else
				Nothing
	where
		Just dis_a_b = hammingDistance a b
		n = length a
		half = n `quot` 2

		findP' :: String -> String -> Int -> String
		findP' [] [] _ = []
		findP' (x:xs) (y:ys) i
			| i < half && x /= y = y : findP' xs ys (i+1)
			| i < half = x : findP' xs ys (i+1)
			| otherwise = x:xs

-- http://codeforces.com/problemset/problem/545/B

import Control.Monad (replicateM)

-- This is a greedy problem
-- Implemting an algorithm to find the correct P
-- would take too much time.

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

main = do
	s <- getLine
	t <- getLine

	let
		p = findP s t

	case p of
		Nothing -> putStrLn "impossible"
		Just str -> putStrLn str

hammingDistance :: String -> String -> Maybe Int
hammingDistance xs ys
	| length xs /= length ys = Nothing
	| otherwise = Just $ hammingDistance' xs ys
	where
		hammingDistance' :: String -> String -> Int
		hammingDistance' [] [] = 0
		hammingDistance' (x:xs) (y:ys)
			| x == y = hammingDistance' xs ys
			| otherwise = 1 + hammingDistance' xs ys

findP :: String -> String -> Maybe String
findP a b
	| length a /= length b || (odd dis_a_b) = Nothing
	| otherwise =
		let p = findP' a b 0 in
			if hammingDistance a p == hammingDistance b p then
				Just p
			else
				Nothing
	where
		Just dis_a_b = hammingDistance a b
		n = length a
		half = n `quot` 2

		negate' :: Char -> Char
		negate' '0' = '1'
		negate' '1' = '0'
		negate' _ = '0'

		findP' :: String -> String -> Int -> String
		findP' (x:xs) (y:ys) i
			| odd n && i == n - 1 = y:ys
			| i == n - 1 = [negate' y]
			| i < half = negate' x : findP' xs ys (i+1)
			| otherwise = negate' y : findP' xs ys (i+1)

-- http://codeforces.com/problemset/problem/545/B

import Control.Monad (replicateM)

-- This is a greedy problem
-- Implemting an algorithm to find the correct P
-- would take too much time.

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

main = do
	s <- getLine
	t <- getLine

	let
		p = findP s t

	case p of
		Nothing -> putStrLn "impossible"
		Just str -> putStrLn str

hammingDistance :: String -> String -> Maybe Int
hammingDistance xs ys
	| length xs /= length ys = Nothing
	| otherwise = Just $ hammingDistance' xs ys
	where
		hammingDistance' :: String -> String -> Int
		hammingDistance' [] [] = 0
		hammingDistance' (x:xs) (y:ys)
			| x == y = hammingDistance' xs ys
			| otherwise = 1 + hammingDistance' xs ys

findP :: String -> String -> Maybe String
findP a b
	| length a /= length b || (odd dis_a_b) = Nothing
	| otherwise =
		let p = findP' a b 0 in
			if hammingDistance a p == hammingDistance b p then
				Just p
			else
				Nothing
	where
		Just dis_a_b = hammingDistance a b
		n = length a
		half = n `quot` 2

		negate' :: Char -> Char
		negate' '0' = '1'
		negate' '1' = '0'
		negate' _ = '0'

		findP' :: String -> String -> Int -> String
		findP' [] [] _ = []
		findP' (x:xs) (y:ys) i
			| i < half = negate' x : findP' xs ys (i+1)
			| otherwise = negate' y : findP' xs ys (i+1)

distance w0 w1 | null w0 = 0
               | (head w0) == (head w1) = distance (tail w0) (tail w1)
               | otherwise = 1 + (distance (tail w0) (tail w1))
getS w0 w1 d | d == 0 = w0
             | (head w0) == (head w1) = (head w0):(getS (tail w0) (tail w1) (d-1))
             | otherwise = (head w1):(getS (tail w0) (tail w1) (d-1))
main = do
  w0 <-getLine
  w1 <-getLine
  let d = distance w0 w1
  if (d `rem` 2) == 1
  then putStrLn "impossible"
  else putStrLn $ getS w0 w1 (d `div` 2)

foo :: [(Char, Char)] -> Bool -> String
foo [] True = "t"
foo [] False = "f"
foo ((a,b):xs) f = if a==b then a:(foo xs f) else if f then a:(foo xs False) else b:(foo xs True)

main :: IO ()
main = do
  a <- getLine
  b <- getLine
  print $ let res = foo (zip a b) True in if last res == 'f' then "impossible" else init res

import Control.Applicative
import Data.List
import Data.Bits
import Data.Char

process n 0 cs = n - (length cs)
process n m (c:cs) | c=='1' = process n (m-1) cs
                   | otherwise = process n m cs

main= do
	x<-getLine
	y<-getLine
	let a = foldl' (\acc z -> acc+acc + digitToInt z) 0 x
	let b = foldl' (\acc z -> acc+acc + digitToInt z) 0 y
	let c= xor a b
	let d = popCount c
	let n = div d 2
	let n1= process n n (show c)
	putStrLn $ if odd d then "Impossible" else  (take n1 x) ++ (drop n1 y)

import Control.Applicative
import Data.List
import Data.Bits
import Data.Char

main= do
	x<-getLine
	y<-getLine
	let a = foldl' (\acc z -> acc+acc + digitToInt z) 0 x
	let b = foldl' (\acc z -> acc+acc + digitToInt z) 0 y
	let c= xor a b
	let d = popCount c
	let n = div (length x) 2
	putStrLn $ if odd d then "IMPOSSIBLE" else  (take n x) ++ (drop n y)

import Control.Applicative
import Data.List
import Data.Bits
import Data.Char

main= do
	x<-getLine
	y<-getLine
	let a = foldl' (\acc z -> acc+acc + digitToInt z) 0 x
	let b = foldl' (\acc z -> acc+acc + digitToInt z) 0 y
	let c= xor a b
	let d = popCount c
	let n = div (length x) 2
	putStrLn $ if odd d then "Impossible" else  (take n x) ++ (drop n y)

import Control.Applicative
import Data.List
import Data.Bits
import Data.Char

process n 0 cs = n - (length cs)
process n m (c:cs) | c=='1' = process n (m-1) cs
                   | otherwise = process n m cs

main= do
	x<-getLine
	y<-getLine
	let a = foldl' (\acc z -> acc+acc + digitToInt z) 0 x
	let b = foldl' (\acc z -> acc+acc + digitToInt z) 0 y
	let c= xor a b
	let d = popCount c
	let n = div d 2
	let n1= process d n (show c)
	putStrLn $ if odd d then "Impossible" else  (take n1 x) ++ (drop n1 y)

import Control.Applicative
import Data.List
import Data.Bits
import Data.Char

process n 0 cs = n - (length cs)
process n m (c:cs) | c=='1' = process n (m-1) cs
                   | otherwise = process n m cs

main= do
	x<-getLine
	y<-getLine
	let a = foldl' (\acc z -> acc+acc + digitToInt z) 0 x
	let b = foldl' (\acc z -> acc+acc + digitToInt z) 0 y
	let c= xor a b
	let d = popCount c
	let n = div d 2
	let n1= process d n (show c)
	putStrLn $ if odd d then "impossible" else  (take n1 x) ++ (drop n1 y)


You are given n switches and m lamps. The i-th switch turns on some subset of the lamps. This information is given as the matrix a consisting of n rows and m columns where ai, j = 1 if the i-th switch turns on the j-th lamp and ai, j = 0 if the i-th switch is not connected to the j-th lamp.Initially all m lamps are turned off.Switches change state only from "off" to "on". It means that if you press two or more switches connected to the same lamp then the lamp will be turned on after any of this switches is pressed and will remain its state even if any switch connected to this lamp is pressed afterwards.It is guaranteed that if you push all n switches then all m lamps will be turned on.Your think that you have too many switches and you would like to ignore one of them. Your task is to say if there exists such a switch that if you will ignore (not use) it but press all the other n - 1 switches then all the m lamps will be turned on.

The first line of the input contains two integers n and m (1 ≤ n, m ≤ 2000) — the number of the switches and the number of the lamps. The following n lines contain m characters each. The character ai, j is equal to '1' if the i-th switch turns on the j-th lamp and '0' otherwise. It is guaranteed that if you press all n switches all m lamps will be turned on.

Print "YES" if there is a switch that if you will ignore it and press all the other n - 1 switches then all m lamps will be turned on. Print "NO" if there is no such switch.

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

import qualified Data.ByteString as B (getLine, getContents)
import qualified Data.ByteString.Char8 as C (readInteger, words, lines, unpack, reverse, dropWhile)
import qualified Data.Maybe as M (fromJust)
import qualified Data.List as L (transpose, nub, elemIndex)
import qualified Data.Char as C (isSpace, digitToInt)

rstrip = C.reverse . C.dropWhile C.isSpace . C.reverse

main = do
    (map (map C.digitToInt . C.unpack . rstrip) . C.lines -> xs) <- B.getLine >> B.getContents
    let r = L.nub [ M.fromJust (1 `L.elemIndex` x) | x <- L.transpose xs, sum x == 1 ]
    putStrLn $ if length r < length xs then "YES" else "NO"


Happy PMP is freshman and he is learning about algorithmic problems. He enjoys playing algorithmic games a lot.One of the seniors gave Happy PMP a nice game. He is given two permutations of numbers 1 through n and is asked to convert the first one to the second. In one move he can remove the last number from the permutation of numbers and inserts it back in an arbitrary position. He can either insert last number between any two consecutive numbers, or he can place it at the beginning of the permutation.Happy PMP has an algorithm that solves the problem. But it is not fast enough. He wants to know the minimum number of moves to convert the first permutation to the second.

The first line contains a single integer n (1 ≤ n ≤ 2·105) — the quantity of the numbers in the both given permutations.  Next line contains n space-separated integers — the first permutation. Each number between 1 to n will appear in the permutation exactly once.  Next line describe the second permutation in the same format.

Print a single integer denoting the minimum number of moves required to convert the first permutation to the second.

NoteIn the first sample, he removes number 1 from end of the list and places it at the beginning. After that he takes number 2 and places it between 1 and 3.In the second sample, he removes number 5 and inserts it after 1.In the third sample, the sequence of changes are like this:  1 5 2 3 4 1 4 5 2 3 1 3 4 5 2 1 2 3 4 5  So he needs three moves.

import Control.Applicative

main = getLine >> do
  xs <- words <$> getLine
  ys <- words <$> getLine
  print $ solve xs ys

solve xs [] = length xs
solve (x:xs) (y:ys)
  | x == y = solve xs ys
  | otherwise = case span (x/=) ys of
                  (_,[]) -> solve (x:xs) []
                  (_,(_:ys')) -> solve xs ys'