Polycarp wants to train before another programming competition. During the first day of his training he should solve exactly $$$1$$$ problem, during the second day — exactly $$$2$$$ problems, during the third day — exactly $$$3$$$ problems, and so on. During the $$$k$$$-th day he should solve $$$k$$$ problems.Polycarp has a list of $$$n$$$ contests, the $$$i$$$-th contest consists of $$$a_i$$$ problems. During each day Polycarp has to choose exactly one of the contests he didn't solve yet and solve it. He solves exactly $$$k$$$ problems from this contest. Other problems are discarded from it. If there are no contests consisting of at least $$$k$$$ problems that Polycarp didn't solve yet during the $$$k$$$-th day, then Polycarp stops his training.How many days Polycarp can train if he chooses the contests optimally?

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of contests. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 2 \cdot 10^5$$$) — the number of problems in the $$$i$$$-th contest.

Print one integer — the maximum number of days Polycarp can train if he chooses the contests optimally.

import Data.List

readInt :: String -> Int
readInt = read

main = do
    unusefulThrash <- getLine
    a <- getLine
    putStrLn $ show $ solve [1..] ((sort . map readInt . words) a)

solve :: [Int] -> [Int] -> Int
solve (x:xs) [] = 0
solve (x:xs) (y:ys) =
    if x <= y
    then 1 + solve xs ys
    else solve (x:xs) ys

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, FlexibleContexts, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import qualified Data.Array.Unboxed as UA
import Control.Monad
import Control.Monad.ST
import Data.Array.ST.Safe

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

solve :: [Int] -> Builder
solve (n:a) = intDec res <> char7 '\n'
  where
    b = take n a
    !m = maximum b
    x :: UA.UArray Int Int
    x = UA.accumArray (+) 0 (0, m) (zip b (repeat 1))
    !res = runST $ do
      c <- thaw x :: ST s (STUArray s Int Int)
      let
        loop k s = do
          if s > m then return $! (k - 1)
          else do
            w <- readArray c s
            if w > 0 then do
              writeArray c s (pred w)
              loop (succ k) (max (succ k) s)
            else loop k (succ s)
      loop 1 1

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents


Kevin and Nicky Sun have invented a new game called Lieges of Legendre. In this game, two players take turns modifying the game state with Kevin moving first. Initially, the game is set up so that there are n piles of cows, with the i-th pile containing ai cows. During each player's turn, that player calls upon the power of Sunlight, and uses it to either:  Remove a single cow from a chosen non-empty pile.  Choose a pile of cows with even size 2·x (x > 0), and replace it with k piles of x cows each. The player who removes the last cow wins. Given n, k, and a sequence a1, a2, ..., an, help Kevin and Nicky find the winner, given that both sides play in optimal way.

The first line of the input contains two space-separated integers n and k (1 ≤ n ≤ 100 000, 1 ≤ k ≤ 109). The second line contains n integers, a1, a2, ... an (1 ≤ ai ≤ 109) describing the initial state of the game.

Output the name of the winning player, either "Kevin" or "Nicky" (without quotes).

NoteIn the second sample, Nicky can win in the following way: Kevin moves first and is forced to remove a cow, so the pile contains two cows after his move. Next, Nicky replaces this pile of size 2 with two piles of size 1. So the game state is now two piles of size 1. Kevin then removes one of the remaining cows and Nicky wins by removing the other.

import Data.Bits (xor)
import Data.Char (ord)
import Data.List (foldl1')

readInt :: String -> Int
readInt = foldl (\s c -> s * 10 + ord c - 48) 0

type Input = (Int, [Int])

parse :: String -> Input
parse contents = (k, readInts l1)
    where [l0, l1] = lines contents
          [_, k] = readInts l0
          readInts l = map readInt $ words l

sgEven :: Int -> Int
sgEven n
    | n < 3     = n
    | otherwise = (n + 1) `mod` 2

sgOdd :: Int -> Int
sgOdd n
    | n < 5 = [0, 1, 0, 1, 2] !! n
    | odd n = 0
    | otherwise = let sg' = sgOdd (n `div` 2) in
                  case sg' of
                      0 -> 1
                      1 -> 2
                      2 -> 1
                      _ -> undefined

sg :: Int -> Int -> Int
sg k
    | odd k = sgOdd
    | otherwise = sgEven

solve :: Input -> Bool
solve (k, a) = s == 0
    where s = foldl1' xor . map (sg k) $ a

format :: Bool -> String
format False = "Kevin"
format True = "Nicky"

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

import Data.Bits

getgrundy :: Int -> Int
getgrundy 0 = 0
getgrundy 1 = 1
getgrundy 2 = 2
getgrundy x
 | even x = 1
 | otherwise = 0

no1 :: Int -> Int
no1 1 = 2
no1 _ = 1

getgrundy' :: Int -> Int
getgrundy' 0 = 0
getgrundy' 1 = 1
getgrundy' 2 = 0
getgrundy' 3 = 1
getgrundy' 4 = 2
getgrundy' x
 | even x = no1 $ getgrundy' $ div x 2
 | otherwise = 0

calc :: (Int -> Int) -> [Int] -> Int
calc f (x:xs) =  xor (f x) (calc f xs)
calc _ _ = 0

solve' :: Int -> [Int] -> Int
solve' 0 x = calc getgrundy $ x
solve' 1 x = calc getgrundy' $ x

solve ::Int -> [Int] -> String
solve k x
 | 0 == solve' k x = "Nicky"
 | otherwise = "Kevin"

parse :: String -> String
parse x = solve (mod (a!!1) 2) (tail $ tail a) where a = map read $ words x

main = interact parse


Eric has an array $$$b$$$ of length $$$m$$$, then he generates $$$n$$$ additional arrays $$$c_1, c_2, \dots, c_n$$$, each of length $$$m$$$, from the array $$$b$$$, by the following way:Initially, $$$c_i = b$$$ for every $$$1 \le i \le n$$$. Eric secretly chooses an integer $$$k$$$ $$$(1 \le k \le n)$$$ and chooses $$$c_k$$$ to be the special array.There are two operations that Eric can perform on an array $$$c_t$$$: Operation 1: Choose two integers $$$i$$$ and $$$j$$$ ($$$2 \leq i < j \leq m-1$$$), subtract $$$1$$$ from both $$$c_t[i]$$$ and $$$c_t[j]$$$, and add $$$1$$$ to both $$$c_t[i-1]$$$ and $$$c_t[j+1]$$$. That operation can only be used on a non-special array, that is when $$$t \neq k$$$.; Operation 2: Choose two integers $$$i$$$ and $$$j$$$ ($$$2 \leq i < j \leq m-2$$$), subtract $$$1$$$ from both $$$c_t[i]$$$ and $$$c_t[j]$$$, and add $$$1$$$ to both $$$c_t[i-1]$$$ and $$$c_t[j+2]$$$. That operation can only be used on a special array, that is when $$$t = k$$$.Note that Eric can't perform an operation if any element of the array will become less than $$$0$$$ after that operation.Now, Eric does the following:  For every non-special array $$$c_i$$$ ($$$i \neq k$$$), Eric uses only operation 1 on it at least once. For the special array $$$c_k$$$, Eric uses only operation 2 on it at least once.Lastly, Eric discards the array $$$b$$$.For given arrays $$$c_1, c_2, \dots, c_n$$$, your task is to find out the special array, i.e. the value $$$k$$$. Also, you need to find the number of times of operation $$$2$$$ was used on it.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Description of test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$3 \leq n \leq 10^5$$$, $$$7 \leq m \leq 3 \cdot 10^5$$$) — the number of arrays given to you, and the length of each array. The next $$$n$$$ lines contains $$$m$$$ integers each, $$$c_{i,1}, c_{i,2}, \dots , c_{i,m}$$$. It is guaranteed that each element of the discarded array $$$b$$$ is in the range $$$[0,10^6]$$$, and therefore $$$0 \leq c_{i,j} \leq 3 \cdot 10^{11}$$$ for all possible pairs of $$$(i,j)$$$. It is guaranteed that the sum of $$$n \cdot m$$$ over all test cases does not exceed $$$10^6$$$. It is guaranteed that the input is generated according to the procedure above.

For each test case, output one line containing two integers — the index of the special array, and the number of times that Operation 2 was performed on it. It can be shown that under the constraints given in the problem, this value is unique and won't exceed $$$10^{18}$$$, so you can represent it as a $$$64$$$-bit integer. It can also be shown that the index of the special array is uniquely determined. In this problem, hacks are disabled.

NoteIn the first test case, the secret array $$$b$$$ is $$$[0, 1, 1, 1, 1, 1, 1, 1, 0]$$$. Array $$$c_1$$$ and array $$$c_2$$$ are generated by using operation 1. Array $$$c_3$$$ is generated by using operation 2.For Array $$$c_1$$$,you can choose $$$i=4$$$ and $$$j=5$$$ perform Operation 1 one time to generate it. For Array $$$c_2$$$, you can choose $$$i=6$$$ and $$$j=7$$$ perform Operation 1 one time to generate it. For Array $$$c_3$$$,you can choose $$$i=4$$$ and $$$j=5$$$ perform Operation 2 one time to generate it.In the second test case, the secret array $$$b$$$ is $$$[20, 20, 20, 20, 20, 20, 20]$$$. You can also find that array $$$c_1$$$ and array $$$c_2$$$ are generated by using Operation 1. Array $$$c_3$$$ is generated by using Operation 2.In the third test case, the secret array $$$b$$$ is $$$[20, 20, 20, 20, 20, 20, 20, 20, 20]$$$. You can also find that array $$$c_1$$$ and array $$$c_2$$$ are generated by using Operation 1. Array $$$c_3$$$ is generated by using Operation 2.

{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM
                                                , replicateM_
                                                )
import           Data.Bits                      ( Bits(..) )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( findIndex
                                                , foldl'
                                                , unfoldr
                                                )
import           Data.Maybe                     ( fromMaybe )
import           Text.Printf                    ( printf )

-- arrange :: [a] -> Int -> [[a]]
-- arrange xs n = mapM (const xs) [1 .. n]

-- data Tree a = Null | Branch a (Tree a) (Tree a)
--   deriving (Show, Eq, Functor)

-- makeBaseFunctor ''Tree

-- x :: Tree Int
-- x = Branch 1 (Branch 2 Null Null) (Branch 3 Null Null)

-- y :: Tree Int -> Int
-- y = cata $ \case
--     NullF         -> 0
--     BranchF x a b -> x + a + b

-- >>> y x
-- 6

-- z :: Tree Int -> Int
-- z = para $ \case
--     NullF                     -> 0
--     BranchF x (x1, a) (x2, b) -> x + a + b + y x1 + y x2

-- >>> z x
-- 11

-- quicksort :: Ord a => [a] -> [a]
-- quicksort = hylo merge split  where
--     split []       = NullF
--     split (x : xs) = let (l, r) = partition (< x) xs in BranchF x l r

--     merge NullF           = []
--     merge (BranchF x l r) = l ++ [x] ++ r

-- >>> quicksort ([5,4,6,7,8,6,4,2])
-- [2,4,4,5,6,6,7,8]

-- fibSeq :: [Int]
-- fibSeq = futu phi Nil
--   where
--     phi Nil                    = Cons 0 (Pure (Cons 0 Nil))
--     phi x@(Cons _ Nil        ) = Cons 1 (Pure (Cons 1 (Cons 0 Nil)))
--     phi t@(Cons x (Cons y xs)) = Cons (x + y) (Pure (Cons (x + y) (Cons x Nil)))

-- >>> take 20 fibSeq
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

-- f1 :: [Int] -> Int
-- f1 = flip runReader 0 . cataA phi
--   where
--     phi Nil        = return 0
--     phi (Cons x t) = do
--         n <- ask
--         if n >= 10 then return 0 else (x +) <$> local succ t

-- f2 :: [Int]
-- f2 = apo phi 1
--   where
--     phi n | n < 100   = Cons (n * 2) (Right (n + 1))
--           | otherwise = Cons (n * 2) (Left [1, 2, 3])

-- >>> f1 fibSeq
-- 88

-- >>> f2
-- [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198]

-- urlParser :: Parser String
-- urlParser = argument str (metavar "URL")

-- segmented :: Int -> Int -> [(Int, Int)]
-- segmented total blocksize = (id &&& (min (total - 1) . (+ (blocksize - 1)))) <$> takeWhile (< total) [0, blocksize ..]

-- main :: IO ()
-- main = do
--     manager <- newManager tlsManagerSettings
--     url     <- execParser opts
--     req     <- parseRequest url
--     res     <- httpNoBody req manager
--     let len = maybe 0 fst (readInt =<< (lookup "Content-Length" (requestHeaders req) <|> lookup "content-length" (responseHeaders res)))
--     if len == 0
--         then do
--             res <- httpLbs req manager
--             print $ responseStatus res
--             print $ responseBody res
--         else do
--             pool <- createPool (pure ()) (const (pure ())) 2 0.5 5
--             mapConcurrently_
--                 (\(s, e) -> withResource pool $ \_ -> do
--                     res <- httpLbs (req { requestHeaders = ("Range", BS.pack $ formatToString ("bytes=" % int % "-" % int) s e) : requestHeaders req }) manager
--                     print $ responseStatus res
--                     -- print $ responseBody res
--                 )
--                 (segmented len tenMegabytes)
--   where
--     opts         = info urlParser fullDesc
--     tenMegabytes = 10485760

-- eigenvector :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a)) => r (r a) -> r a
-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue :: (Fractional a, Foldable t, Additive t, Conjugate a) => t (t a) -> t a -> a
-- eigenvalue m x = (let V1 (V1 p) = (helper x!*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q)
--     where
--         helper :: (Functor t, Conjugate a) => t a -> V1 (t a)
--         helper = adjoint . fmap V1

-- eigenvalues :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a), Finite r, KnownNat (Size r), Traversable r, Num (r (r a)), Applicative r, Eq a, Distributive r, Conjugate a, R1 r) => r (r a) -> [a]
-- eigenvalues m = go [e0] (m - e0 *!! identity)
--     where
--         c0 = eigenvector m
--         e0 = eigenvalue m c0
--         go acc ma | luDetFinite (m - ev *!! identity) /= 0 = acc
--                   | otherwise = go (ev : acc) (ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec))
--                   where ec = eigenvector ma
--                         ev = eigenvalue ma ec
--                         ec' = (<$ unit _x) <$> ec

-- >>> eigenvalues (V2 (V2 1 2) (V2 3 4))
-- []

data Break = Break
    deriving Show

instance Exception Break

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine where parse s = let Just (n, _) = C.readInt s in n

readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
  where
    parse = unfoldr go
    go s = do
        (n, s1) <- C.readInt s
        let s2 = C.dropWhile (== ' ') s1
        return (fromIntegral n, s2)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, _] <- readChar8'
        xs <- fmap (sum . scanl (+) 0) <$> replicateM n readChar8'
        let idx = fromMaybe 0 $ findIndex (< mx) xs
            mx  = maximum xs
        printf "%d %d\n" (idx + 1) (mx - xs !! idx)

{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM
                                                , replicateM_
                                                )
import           Data.Bits                      ( Bits(..) )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( findIndex
                                                , foldl'
                                                , unfoldr
                                                )
import           Data.Maybe                     ( fromMaybe )
import           Text.Printf                    ( printf )

-- arrange :: [a] -> Int -> [[a]]
-- arrange xs n = mapM (const xs) [1 .. n]

-- data Tree a = Null | Branch a (Tree a) (Tree a)
--   deriving (Show, Eq, Functor)

-- makeBaseFunctor ''Tree

-- x :: Tree Int
-- x = Branch 1 (Branch 2 Null Null) (Branch 3 Null Null)

-- y :: Tree Int -> Int
-- y = cata $ \case
--     NullF         -> 0
--     BranchF x a b -> x + a + b

-- >>> y x
-- 6

-- z :: Tree Int -> Int
-- z = para $ \case
--     NullF                     -> 0
--     BranchF x (x1, a) (x2, b) -> x + a + b + y x1 + y x2

-- >>> z x
-- 11

-- quicksort :: Ord a => [a] -> [a]
-- quicksort = hylo merge split  where
--     split []       = NullF
--     split (x : xs) = let (l, r) = partition (< x) xs in BranchF x l r

--     merge NullF           = []
--     merge (BranchF x l r) = l ++ [x] ++ r

-- >>> quicksort ([5,4,6,7,8,6,4,2])
-- [2,4,4,5,6,6,7,8]

-- fibSeq :: [Int]
-- fibSeq = futu phi Nil
--   where
--     phi Nil                    = Cons 0 (Pure (Cons 0 Nil))
--     phi x@(Cons _ Nil        ) = Cons 1 (Pure (Cons 1 (Cons 0 Nil)))
--     phi t@(Cons x (Cons y xs)) = Cons (x + y) (Pure (Cons (x + y) (Cons x Nil)))

-- >>> take 20 fibSeq
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

-- f1 :: [Int] -> Int
-- f1 = flip runReader 0 . cataA phi
--   where
--     phi Nil        = return 0
--     phi (Cons x t) = do
--         n <- ask
--         if n >= 10 then return 0 else (x +) <$> local succ t

-- f2 :: [Int]
-- f2 = apo phi 1
--   where
--     phi n | n < 100   = Cons (n * 2) (Right (n + 1))
--           | otherwise = Cons (n * 2) (Left [1, 2, 3])

-- >>> f1 fibSeq
-- 88

-- >>> f2
-- [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198]

-- urlParser :: Parser String
-- urlParser = argument str (metavar "URL")

-- segmented :: Int -> Int -> [(Int, Int)]
-- segmented total blocksize = (id &&& (min (total - 1) . (+ (blocksize - 1)))) <$> takeWhile (< total) [0, blocksize ..]

-- main :: IO ()
-- main = do
--     manager <- newManager tlsManagerSettings
--     url     <- execParser opts
--     req     <- parseRequest url
--     res     <- httpNoBody req manager
--     let len = maybe 0 fst (readInt =<< (lookup "Content-Length" (requestHeaders req) <|> lookup "content-length" (responseHeaders res)))
--     if len == 0
--         then do
--             res <- httpLbs req manager
--             print $ responseStatus res
--             print $ responseBody res
--         else do
--             pool <- createPool (pure ()) (const (pure ())) 2 0.5 5
--             mapConcurrently_
--                 (\(s, e) -> withResource pool $ \_ -> do
--                     res <- httpLbs (req { requestHeaders = ("Range", BS.pack $ formatToString ("bytes=" % int % "-" % int) s e) : requestHeaders req }) manager
--                     print $ responseStatus res
--                     -- print $ responseBody res
--                 )
--                 (segmented len tenMegabytes)
--   where
--     opts         = info urlParser fullDesc
--     tenMegabytes = 10485760

-- eigenvector :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a)) => r (r a) -> r a
-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue :: (Fractional a, Foldable t, Additive t, Conjugate a) => t (t a) -> t a -> a
-- eigenvalue m x = (let V1 (V1 p) = (helper x!*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q)
--     where
--         helper :: (Functor t, Conjugate a) => t a -> V1 (t a)
--         helper = adjoint . fmap V1

-- eigenvalues :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a), Finite r, KnownNat (Size r), Traversable r, Num (r (r a)), Applicative r, Eq a, Distributive r, Conjugate a, R1 r) => r (r a) -> [a]
-- eigenvalues m = go [e0] (m - e0 *!! identity)
--     where
--         c0 = eigenvector m
--         e0 = eigenvalue m c0
--         go acc ma | luDetFinite (m - ev *!! identity) /= 0 = acc
--                   | otherwise = go (ev : acc) (ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec))
--                   where ec = eigenvector ma
--                         ev = eigenvalue ma ec
--                         ec' = (<$ unit _x) <$> ec

-- >>> eigenvalues (V2 (V2 1 2) (V2 3 4))
-- []

data Break = Break
    deriving Show

instance Exception Break

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine where parse s = let Just (n, _) = C.readInt s in n

readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
  where
    parse = unfoldr go
    go s = do
        (n, s1) <- C.readInt s
        let s2 = C.dropWhile (== ' ') s1
        return (fromIntegral n, s2)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, _] <- readChar8
        xs <- fmap (sum . scanl (+) 0) <$> replicateM n readChar8
        let idx = fromMaybe 0 $ findIndex (< mx) xs
            mx  = maximum xs
        printf "%d %d\n" (idx + 1) (mx - xs !! idx)


There is a square painted on a piece of paper, the square's side equals n meters. John Doe draws crosses on the square's perimeter. John paints the first cross in the lower left corner of the square. Then John moves along the square's perimeter in the clockwise direction (first upwards, then to the right, then downwards, then to the left and so on). Every time he walks (n + 1) meters, he draws a cross (see picture for clarifications).John Doe stops only when the lower left corner of the square has two crosses. How many crosses will John draw?   The figure shows the order in which John draws crosses for a square with side 4. The lower left square has two crosses. Overall John paints 17 crosses.

The first line contains integer t (1 ≤ t ≤ 104) — the number of test cases.  The second line contains t space-separated integers ni (1 ≤ ni ≤ 109) — the sides of the square for each test sample.

For each test sample print on a single line the answer to it, that is, the number of crosses John will draw as he will move along the square of the corresponding size. Print the answers to the samples in the order in which the samples are given in the input. Please do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

import qualified Data.ByteString.Char8 as B
import Data.Maybe

solve x
    | odd x && (x - 3) `mod` 4 == 0 = x + 1
    | odd x = x * 2 + 1
    | otherwise = x * 4 + 1

main =  B.putStrLn =<< B.unlines . map (B.pack . show . solve . fst . fromJust .  B.readInteger) . B.words  <$>  (B.getLine >> B.getLine)

solve :: Integer -> Integer
solve n  =  1 + div (lcm (4*n) (n + 1)) (n + 1)

main :: IO ()
main  =  do
    getLine
    xs  <-  getLine >>= return . map read . words
    mapM_ (print . solve) xs

main = do
  getLine -- t
  xs <- (map read . words) `fmap` getLine
  mapM_ (print . solve) xs
    where solve x = lcm (4 * x) (x + 1) `div` (x + 1) + 1

main = getLine >> getLine >>= putStr.unlines.map (show.solve.read).words

solve :: Integer -> Integer
solve n
  | r == 1    = 2*n+1
  | r == 3    = n+1
  | otherwise = 4*n+1
   where r = mod n 4

import Control.Applicative
import Data.List
--import Test.QuickCheck

main'fast :: Integer -> Integer
main'fast 1 = 3
main'fast n
    | n `mod` 2 == 0 = n * 4 + 1
    | n `mod` 4 == 1 = n * 2 + 1
    | otherwise = n + 1

--main'slow :: Integer -> Integer
main'slow n = (+2). genericLength. takeWhile (/=0). tail$ iterate f 0 where
    f x = (x + n + 1) `mod` (n*4)

--prop_main' x = x >= 1 ==> main'slow x == main'fast x

main = do
    getLine
    ss <- getLine
    putStrLn$ unlines. map (show. main'fast. read). words$ ss

calc :: Integer -> Integer
calc n = head [i*n+1 | i <- [1..], ((n+1)*n*i) `mod` (n*4) == 0]

putLs [] = return ()

putLs (x:xs) = do putStrLn x

                  putLs xs

main = do s <- getLine

          t <- getLine

          putLs $ map (\a -> show $ calc (read a :: Integer)) $ words t

main = getContents >>= mapM_ print.map solve. map (\x -> read x :: Integer). tail. words
 where
  solve x
   | even x = 4*x + 1
   | x `mod` 4 == 3 = x+1
   | otherwise = 2*x+1

main = getLine >> getLine >>= putStrLn.unlines.map (show.solve.read).words

solve :: Integer -> Integer
solve 1 = 3
solve n = 4*n+1


Among Johnny's numerous hobbies, there are two seemingly harmless ones: applying bitwise operations and sneaking into his dad's office. As it is usually the case with small children, Johnny is unaware that combining these two activities can get him in a lot of trouble.There is a set $$$S$$$ containing very important numbers on his dad's desk. The minute Johnny heard about it, he decided that it's a good idea to choose a positive integer $$$k$$$ and replace each element $$$s$$$ of the set $$$S$$$ with $$$s \oplus k$$$ ($$$\oplus$$$ denotes the exclusive or operation). Help him choose such $$$k$$$ that Johnny's dad will not see any difference after his son is done playing (i.e. Johnny will get the same set as before playing). It is possible that no such number exists. It is also possible that there are many of them. In such a case, output the smallest one. Note that the order of elements in a set doesn't matter, i.e. set $$$\{1, 2, 3\}$$$ equals to set $$$\{2, 1, 3\}$$$.Formally, find the smallest positive integer $$$k$$$ such that $$$\{s \oplus k | s \in S\} = S$$$ or report that there is no such number.For example, if $$$S = \{1, 3, 4\}$$$ and $$$k = 2$$$, new set will be equal to $$$\{3, 1, 6\}$$$. If $$$S = \{0, 1, 2, 3\}$$$ and $$$k = 1$$$, after playing set will stay the same.

In the first line of input, there is a single integer $$$t$$$ ($$$1 \leq t \leq 1024$$$), the number of test cases. In the next lines, $$$t$$$ test cases follow. Each of them consists of two lines.  In the first line there is a single integer $$$n$$$ ($$$1 \leq n \leq 1024$$$) denoting the number of elements in set $$$S$$$. Second line consists of $$$n$$$ distinct integers $$$s_i$$$ ($$$0 \leq s_i < 1024$$$), elements of $$$S$$$. It is guaranteed that the sum of $$$n$$$ over all test cases will not exceed $$$1024$$$.

Print $$$t$$$ lines; $$$i$$$-th line should contain the answer to the $$$i$$$-th test case, the minimal positive integer $$$k$$$ satisfying the conditions or $$$-1$$$ if no such $$$k$$$ exists.

NoteIn the first test case, the answer is $$$1$$$ because it is a minimum positive integer and it satisfies all the conditions.

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let _:vals = read <$> split input :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          n:rest0   ->
            let (ls, rest1) = splitAt n rest0
                guess = (\cand ->
                  let ls1 = xor cand <$> ls
                  in sort ls == sort ls1
                  )
                guessAll = (\(!curr) -> if
                  | curr == 1024  -> -1
                  | otherwise     -> if guess curr then curr else guessAll (curr+1)
                  )
                subres = guessAll 1
            in Just (subres, rest1)
        ) vals
  sequence_ (putStrLn . show <$> res)

import Data.Set as S
import Data.Bits as B
import Data.List as L

isMatch :: S.Set Int -> Int -> Bool
isMatch s n = s == S.map (\x -> B.xor x n) s

isPossible :: S.Set Int -> Int
isPossible s = case L.find (\x -> isMatch s x) [1..1024] of
                 (Just a) -> a
                 Nothing -> -1

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n arr = (L.take n arr):(groupByNLines n (L.drop n arr))

parse :: [String] -> String
parse [_, input] = show $ isPossible $ S.fromList arr
  where arr = L.map (\x -> read x :: Int) $ words input

main :: IO ()
main = interact (unlines . L.map parse . groupByNLines 2 . tail . lines)


You are playing a game where your character should overcome different obstacles. The current problem is to come down from a cliff. The cliff has height $$$h$$$, and there is a moving platform on each height $$$x$$$ from $$$1$$$ to $$$h$$$.Each platform is either hidden inside the cliff or moved out. At first, there are $$$n$$$ moved out platforms on heights $$$p_1, p_2, \dots, p_n$$$. The platform on height $$$h$$$ is moved out (and the character is initially standing there).If you character is standing on some moved out platform on height $$$x$$$, then he can pull a special lever, which switches the state of two platforms: on height $$$x$$$ and $$$x - 1$$$. In other words, the platform you are currently standing on will hide in the cliff and the platform one unit below will change it state: it will hide if it was moved out or move out if it was hidden. In the second case, you will safely land on it. Note that this is the only way to move from one platform to another.Your character is quite fragile, so it can safely fall from the height no more than $$$2$$$. In other words falling from the platform $$$x$$$ to platform $$$x - 2$$$ is okay, but falling from $$$x$$$ to $$$x - 3$$$ (or lower) is certain death. Sometimes it's not possible to come down from the cliff, but you can always buy (for donate currency) several magic crystals. Each magic crystal can be used to change the state of any single platform (except platform on height $$$h$$$, which is unaffected by the crystals). After being used, the crystal disappears.What is the minimum number of magic crystal you need to buy to safely land on the $$$0$$$ ground level?

The first line contains one integer $$$q$$$ ($$$1 \le q \le 100$$$) — the number of queries. Each query contains two lines and is independent of all other queries. The first line of each query contains two integers $$$h$$$ and $$$n$$$ ($$$1 \le h \le 10^9$$$, $$$1 \le n \le \min(h, 2 \cdot 10^5)$$$) — the height of the cliff and the number of moved out platforms. The second line contains $$$n$$$ integers $$$p_1, p_2, \dots, p_n$$$ ($$$h = p_1 > p_2 > \dots > p_n \ge 1$$$) — the corresponding moved out platforms in the descending order of their heights. The sum of $$$n$$$ over all queries does not exceed $$$2 \cdot 10^5$$$.

For each query print one integer — the minimum number of magic crystals you have to spend to safely come down on the ground level (with height $$$0$$$).

{-# LANGUAGE BangPatterns #-}

import Data.List
import Control.Monad

main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    getLine
    line <- words <$> getLine
    let go [_] !acc = acc
        go [a,b] acc
          | b == 1 = acc
          | otherwise = acc + 1
        go (a:b:c:bs) acc
          | [a,b,c] == [a,a-1,a-2] = go (c:bs) acc
          | a - 1 == b = go (a-2:c:bs) (acc+1)
          | otherwise = go (b+1:b:c:bs) acc
    print $ go (read <$> line) 0


You've got array a[1], a[2], ..., a[n], consisting of n integers. Count the number of ways to split all the elements of the array into three contiguous parts so that the sum of elements in each part is the same. More formally, you need to find the number of such pairs of indices i, j (2 ≤ i ≤ j ≤ n - 1), that .

The first line contains integer n (1 ≤ n ≤ 5·105), showing how many numbers are in the array. The second line contains n integers a[1], a[2], ..., a[n] (|a[i]| ≤  109) — the elements of array a.

Print a single integer — the number of ways to split the array into three parts with the same sum.

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

main = putStr . evalState app . B.words =<< B.getContents

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

to64 x = fromIntegral x :: Int64

solve :: Int -> [Int64] -> Int64
solve n xs = case sum xs `quotRem` 3 of
  (s0, 0) -> sum $ zipWith (*) (take (n - 1) $ map (\s -> fromIntegral $ fromEnum (s == s0)) $ scanl1 (+) xs) (drop 2 $ scanr (\s p -> p + fromIntegral (fromEnum $ s == s0)) 0 $ scanr1 (+) xs)
  _ -> 0 :: Int64

import Numeric

fastRead :: String -> Integer
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.g.parse.tail.words
parse = map fastRead
g xs
  | i `mod` 3 /= 0 = 0
  | otherwise = f (i `div` 3) 0 xs 0 0
  where i = sum xs

f i tsum (x:[]) a1 a2 = a2
f i tsum (x:xs) a1 a2
  | h == i && h == j = f i h xs (a1+1) (a2+a1)
  | h == i = f i h xs (a1+1) a2
  | h == j = f i h xs a1 (a2+a1)
  | otherwise = f i h xs a1 a2
  where h = tsum+x
        j = 2*i

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

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

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

main = do
  getLine
  xs <- map fromIntegral <$> getInts :: IO [Int64]

  let
    s = sum xs
    s3 = s`div`3

    ls = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanl1 (+) xs
    rs = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanr1 (+) xs

    scan [] _ _ = 0 :: Int64
    scan (l:ls) rs k = (fromIntegral k') + scan ls rs'' k'
      where
        (rs', rs'') = break (l+1 <) rs
        k' = k - length rs'

  print $
    if s`mod`3 == 0
       then scan ls rs $ length rs
       else 0

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}
import Data.List
import Numeric
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ show.solve. concat. map (map fastRead.words).take 2.lines
solve :: [Integer]-> Integer
solve (x:xs) = slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=fromIntegral $ length scn in (l-1)*(l-2) `div` 2
       |otherwise = head $ tail $ foldl (f) [0,0] scn
          where
          f [b1,b2] a = if a==head sm then [1+b1,b2] else [b1,b1+b2]
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
  f [b] a = a== b || a== 2*b
fastRead :: String -> Integer
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input = show answer
    where
        n::Int64
        as::[Int64]
        n:as = map fastRead (words input)
        arras = A.listArray (0,n-1) as

        with_div3_r = snd (foldr rdp_folder (0,[]) as)
        with_div3_l = (reverse.snd) (foldl ldp_folder (0,[]) as)
        with_div3_l_a = A.listArray (1,n) with_div3_l

        rsum_div3_r::[Int64]
        rsum_div3_r = take (fromIntegral n) (scanr (+) 0 with_div3_r)
        rsum_div3_r_a = A.listArray (1,n) rsum_div3_r

        rdp_folder nextnum (cum,cumxs)
                | ncum == div3 = (ncum, 1:cumxs)
                | otherwise = (ncum, 0:cumxs)
                where ncum = cum+nextnum

        ldp_folder:: (Int64,[Int64]) -> Int64 -> (Int64,[Int64])
        ldp_folder (cum,cumxs) nextnum
                | ncum == div3 = (ncum, 1:cumxs)
                | otherwise = (ncum, 0:cumxs)
                where ncum = cum+nextnum

        tsum = sum as
        div3 = truncate ((fromIntegral tsum :: Double)/3)

        answer = if tsum `mod` 3 == 0 then
                    foldl' answer_folder 0 [1..(n-2)]
                 else
                     0

        answer_folder cumul nextidx
            | with_div3_l_a!nextidx == 1 =
                cumul + rsum_div3_r_a!(nextidx+2)
            | otherwise = cumul

import Data.Array.ST.Safe
import Data.Int
import Control.Monad.ST
import Control.Monad
import Data.STRef

main = do
  n <- readLn
  as <- map read . words <$> getLine
  print $ runST $ do
    acc <- newArray_ (0,n) :: ST s (STUArray s Int Int64)
    writeArray acc 0 0
    forM_ (zip [1..] as) $ \(i,a) ->
      writeArray acc i . (a +) =<< readArray acc (i-1)

    total <- readArray acc n

    ls <- newArray_ (0,n) :: ST s (STUArray s Int Int64)
    writeArray ls 0 0
    forM_ [1..n] $ \i -> do
      s <- readArray acc i
      writeArray ls i . (fromIntegral (fromEnum (3*s == total)) +)
        =<< readArray ls (i-1)

    c <- newSTRef 0
    forM_ [2..n-1] $ \i -> do
      s <- readArray acc i
      when (3*s == 2*total) $
        modifySTRef' c . (+) =<< readArray ls (i-1)
    readSTRef c

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

main = putStr . evalState app . B.words =<< B.getContents

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

to64 x = fromIntegral x :: Int64

solve n xs = case sum xs `quotRem` 3 of
  (s0, 0) -> sum $ zipWith (*) (take (n - 1) $ map (\s -> fromEnum (s == s0)) $ scanl1 (+) xs) (drop 2 $ scanr (\s p -> p + fromEnum (s == s0)) 0 $ scanr1 (+) xs)
  _ -> 0 :: Int

main = interact $ show.f.a.parse.tail.words
parse x = map read x :: [Integer]

g [] x y temp z = z
g (w:ws) x y temp z
  | x == y && w == 0 = g ws x y (temp+1) z
  | x == y && w /= 0 = g ws x w 0 (temp:z)
  | otherwise = g ws x (w+y) temp z

h (x:y:[]) = (x+1)*(y+1)
h x = 0

f x
  | rem i 3 == 0 = if j == [] then (c (length x)) else (h j)
  | otherwise = 0
  where i = sum x
        j = g x (div i 3) 0 0 []

a x = reduce x []
reduce [] ans = ans
reduce (x:[]) ans = reduce [] (x:ans)
reduce (x:y:xs) ans
  | x == 0 = reduce (y:xs) (0:ans)
  | x == (-y) = reduce xs (0:ans)
  | otherwise = reduce (y:xs) (x:ans)

factorial n = product [1..n]
c n = (factorial (n-1)) `div` ((factorial (n-3))*2)

main = interact $ show.f.a.parse.tail.words
parse x = map read x :: [Integer]

g [] x y temp z = z
g (w:ws) x y temp z
  | x == y && w == 0 = g ws x y (temp+1) z
  | x == y && w /= 0 = g ws x w 0 (temp:z)
  | otherwise = g ws x (w+y) temp z

h :: [Integer] -> Integer
h (x:y:[]) = (x+1)*(y+1)
h x = 0

f :: [Integer] -> Integer
f x
  | rem i 3 == 0 = if j == [] then (c (fromIntegral (length x))) else (h j)
  | otherwise = 0
  where i = sum x
        j = g x (div i 3) 0 0 []

a x = reduce x []
reduce [] ans = ans
reduce (x:[]) ans = reduce [] (x:ans)
reduce (x:y:xs) ans
  | x == 0 = reduce (y:xs) (0:ans)
  | x == (-y) = reduce xs (0:ans)
  | otherwise = reduce (y:xs) (x:ans)

factorial :: Integer -> Integer
factorial n = product [1..n]
c n = (factorial (n-1)) `div` ((factorial (n-3))*2)

main = interact $ show.f.a.parse.tail.words
parse x = map read x :: [Integer]

g [] x y temp z = z
g (w:ws) x y temp z
  | x == y && w == 0 = g ws x y (temp+1) z
  | x == y && w /= 0 = g ws x w 0 (temp:z)
  | otherwise = g ws x (w+y) temp z

h (x:y:[]) = (x+1)*(y+1)

f x
  | rem i 3 == 0 = if j == [] then ((length x) `c` 3) else (h j)
  | otherwise = 0
  where i = sum x
        j = g x (div i 3) 0 0 []

a x = reduce x []
reduce [] ans = ans
reduce (x:[]) ans = reduce [] (x:ans)
reduce (x:y:xs) ans
  | x == (-y) = reduce xs (0:ans)
  | otherwise = reduce (y:xs) (x:ans)

factorial n = product [1..n]
c n r = (factorial n) `div` ((factorial r)*(factorial (n-r)))

main = interact $ show.a.parse.tail.words
parse x = map read x :: [Integer]

g [] x y temp z = z
g (w:ws) x y temp z
  | x == y && w == 0 = g ws x y (temp+1) z
  | x == y && w /= 0 = g ws x w 0 (temp:z)
  | otherwise = g ws x (w+y) temp z

zeroes [] ans = ans
zeroes (x:xs) ans
  | x /= 0 = 0
  | otherwise = zeroes xs (ans+1)

h :: [Integer] -> Integer
h (x:y:[]) = (x+1)*(y+1)
h x = 0

f :: [Integer] -> Integer
f x
  | rem i 3 == 0 = h j
  | otherwise = 0
  where i = sum x
        j = g x (div i 3) 0 0 []

a x
  | k /= 0 = (c k)
  | otherwise = f (reduce x [])
  where k = (zeroes x 0)
reduce [] ans = ans
reduce (x:[]) ans = reduce [] (x:ans)
reduce (x:y:xs) ans
  | x == 0 = reduce (y:xs) (0:ans)
  | x == (-y) = reduce xs (0:ans)
  | otherwise = reduce (y:xs) (x:ans)

factorial :: Integer -> Integer
factorial n = product [1..n]
c n = (factorial (n-1)) `div` ((factorial (n-3))*2)

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

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

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

main = do
  getLine
  xs <- getInts

  let
    s = sum xs
    s3 = s`div`3

    ls = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanl1 (+) xs
    rs = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanr1 (+) xs

    scan [] _ _ = 0 :: Int64
    scan (l:ls) rs k = (fromIntegral k') + scan ls rs'' k'
      where
        (rs', rs'') = break (l+1 <) rs
        k' = k - length rs'

  print $
    if s`mod`3 == 0
       then scan ls rs $ length rs
       else 0

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

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

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

main = do
  getLine
  xs <- getInts

  let
    s = sum xs
    s3 = s`div`3

    ls = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanl1 (+) xs
    rs = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanr1 (+) xs

    scan [] _ _ = 0
    scan (l:ls) rs k = k' + scan ls rs'' k'
      where
        (rs', rs'') = break (l+1 <) rs
        k' = k - length rs'

  print $
    if s`mod`3 == 0
       then scan ls rs $ length rs
       else 0

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ solve. concat. map (map read.words).take 2.lines
solve :: [Int]-> String
solve (x:xs) = show slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=length scn in l*(l-1)*(l-2) `div` 6
       |otherwise = length [1| i<- scn,j<-scn, k<-scn,i<j,j<k]
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
    where
    f [b] a = a== b || a== 2*b || a== 3*b

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ show.solve. concat. map (map read.words).take 2.lines
solve :: [Int]-> Int64
solve (x:xs) = slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=fromIntegral $ length scn in (l-1)*(l-2) `div` 2
       |otherwise =snd $ foldl (\(b1,b2) a -> if a==head sm then (1+b1,b2) else (b1,b1+b2)) (0,0) scn
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
  f [b] a = a== b || a== 2*b

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ solve. concat. map (map read.words).take 2.lines
solve :: [Integer]-> String
solve (x:xs) = show $ slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=length scn in (l-1)*(l-2) `div` 2
       |otherwise = snd $ foldl (\(b1,b2) a -> if a==head sm then (1+b1,b2) else (b1,b1+b2)) (0,0) scn
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
  f [b] a = a== b || a== 2*b

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ solve. concat. map (map read.words).take 2.lines
solve :: [Int]-> String
solve (x:xs) = show $ slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=length scn in (l-1)*(l-2) `div` 2
       |otherwise = snd $ foldl (\(b1,b2) a -> if a==head sm then (1+b1,b2) else (b1,b1+b2)) (0,0) scn
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
  f [b] a = a== b || a== 2*b

import Data.List

main = interact gen

replicate_num = 5000

gen input = intercalate " " (map show toout)
    where
        toout::[Int]
        toout = (replicate_num*2):numarrs
        numarrs::[Int]
        numarrs = (foldr (++) [] replicated)
        basic::[Int]
        basic = [1,(-1)]
        replicated::[[Int]]
        replicated = replicate replicate_num basic

import Data.List
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead s = d
    where
        (d,r) = head (readDec s)

main = interact solve

solve input = show answer
    where
        n:as = map read (words input)
        arras = A.listArray (0,n-1) as

        with_div3_r = snd (foldr rdp_folder (0,[]) as)
        with_div3_l = (reverse.snd) (foldl ldp_folder (0,[]) as)
        with_div3_l_a = A.listArray (1,n) with_div3_l

        rsum_div3_r::[Int]
        rsum_div3_r = take n (scanr (+) 0 with_div3_r)
        rsum_div3_r_a = A.listArray (1,n) rsum_div3_r

        rdp_folder nextnum (cum,cumxs)
                | ncum == div3 = (ncum, 1:cumxs)
                | otherwise = (ncum, 0:cumxs)
                where ncum = cum+nextnum

        ldp_folder:: (Int,[Int]) -> Int -> (Int,[Int])
        ldp_folder (cum,cumxs) nextnum
                | ncum == div3 = (ncum, 1:cumxs)
                | otherwise = (ncum, 0:cumxs)
                where ncum = cum+nextnum

        tsum = sum as
        div3 = truncate ((fromIntegral tsum :: Double)/3)

        answer = if tsum `mod` 3 == 0 then
                    foldl' answer_folder 0 [1..(n-2)]
                 else
                     0

        answer_folder cumul nextidx
            | with_div3_l_a!nextidx == 1 =
                cumul + rsum_div3_r_a!(nextidx+2)
            | otherwise = cumul

import Data.Array
import Data.List
import Data.Int
main = do
  n <- readLn
  a <- listArray (1,n) . scanl1 (+) . map read . words <$> getLine
  let s = a!n
  let ls = listArray (0,n-1) $ scanl (+) 0 $
           map (\l -> fromIntegral $ fromEnum (3*a!l == s) :: Int64) [2..n]
  let rs = findIndices (\r -> 3*a!r == 2*s) [1..n-1]
  print $ sum $ map (ls !) rs

import Data.Array
import Data.List
import Data.Int
main = do
  n <- readLn
  a <- listArray (1,n) . scanl1 (+) . map read . words <$> getLine
  let s = a!n :: Int64
  let ls = listArray (0,n-1) $ scanl (+) 0 $
           map (\l -> fromIntegral $ fromEnum $ 3*a!l == s :: Int64) [2..n]
  let rs = findIndices (\r -> 3*a!r == 2*s) [1..n-1]
  print $ sum $ map (ls !) rs

import Data.Array
import Data.List
main = do
  n <- readLn
  a <- listArray (1,n) . scanl1 (+) . map read . words <$> getLine
  let s = a!n
  let ls = listArray (0,n-1) $ scanl (+) 0 $ map (\l -> fromEnum (3*a!l == s)) [2..n]
  let rs = findIndices (\r -> 3*a!r == 2*s) [1..n-1]
  print $ sum $ map (\r -> ls!r) rs


You've got an undirected graph, consisting of n vertices and m edges. We will consider the graph's vertices numbered with integers from 1 to n. Each vertex of the graph has a color. The color of the i-th vertex is an integer ci.Let's consider all vertices of the graph, that are painted some color k. Let's denote a set of such as V(k). Let's denote the value of the neighbouring color diversity for color k as the cardinality of the set Q(k) = {cu :  cu ≠ k and there is vertex v belonging to set V(k) such that nodes v and u are connected by an edge of the graph}.Your task is to find such color k, which makes the cardinality of set Q(k) maximum. In other words, you want to find the color that has the most diverse neighbours. Please note, that you want to find such color k, that the graph has at least one vertex with such color.

The first line contains two space-separated integers n, m (1 ≤ n, m ≤ 105) — the number of vertices end edges of the graph, correspondingly. The second line contains a sequence of integers c1, c2, ..., cn (1 ≤ ci ≤ 105) — the colors of the graph vertices. The numbers on the line are separated by spaces. Next m lines contain the description of the edges: the i-th line contains two space-separated integers ai, bi (1 ≤ ai, bi ≤ n; ai ≠ bi) — the numbers of the vertices, connected by the i-th edge.  It is guaranteed that the given graph has no self-loops or multiple edges.

Print the number of the color which has the set of neighbours with the maximum cardinality. It there are multiple optimal colors, print the color with the minimum number. Please note, that you want to find such color, that the graph has at least one vertex with such color.

import Control.Arrow
import Control.Applicative
import Control.Monad
import Data.Array
import Data.Function
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

main = do
  (n:m:ve) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let (vl, el) = splitAt n ve
      v = listArray (1, n) vl
      e = accumArray (flip (:)) [] (1, n) $ concat [[(i, j), (j, i)] |
        [i, j] <- map (take 2) $ takeWhile (not . null) $ iterate (drop 2) el]
      g = groupBy ((==) `on` fst) $ sort $ zip vl [1 ..]
  ans <- forM (map (liftA2 (,) (fst . head) (map snd)) g) $ \(c, s) -> do
    let q = map head $ group $ sort $ map (v!) $ concatMap (e!) s
    return $ first negate $ (length q - if elem c q then 1 else 0, c)
  print $ snd $ minimum ans


You are given an array consisting of all integers from $$$[l, r]$$$ inclusive. For example, if $$$l = 2$$$ and $$$r = 5$$$, the array would be $$$[2, 3, 4, 5]$$$. What's the minimum number of elements you can delete to make the bitwise AND of the array non-zero?A bitwise AND is a binary operation that takes two equal-length binary representations and performs the AND operation on each pair of the corresponding bits.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Then $$$t$$$ cases follow. The first line of each test case contains two integers $$$l$$$ and $$$r$$$ ($$$1 \leq l \leq r \leq 2 \cdot 10^5$$$) — the description of the array.

For each test case, output a single integer — the answer to the problem.

NoteIn the first test case, the array is $$$[1, 2]$$$. Currently, the bitwise AND is $$$0$$$, as $$$1\ \& \ 2 = 0$$$. However, after deleting $$$1$$$ (or $$$2$$$), the array becomes $$$[2]$$$ (or $$$[1]$$$), and the bitwise AND becomes $$$2$$$ (or $$$1$$$). This can be proven to be the optimal, so the answer is $$$1$$$.In the second test case, the array is $$$[2, 3, 4, 5, 6, 7, 8]$$$. Currently, the bitwise AND is $$$0$$$. However, after deleting $$$4$$$, $$$5$$$, and $$$8$$$, the array becomes $$$[2, 3, 6, 7]$$$, and the bitwise AND becomes $$$2$$$. This can be proven to be the optimal, so the answer is $$$3$$$. Note that there may be other ways to delete $$$3$$$ elements.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.Bits

score :: Int -> Int -> Int
score rv i = let
  s = bit i
  lows = s * rv `shiftR` (i + 1)
  mask = bit i * 2 - 1
  lv = rv .&. mask
  his = min lv s
  in  lows + his

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[lv, rv] <- getInts 2
    let
      opts = [score (rv + 1) i - score lv i
             | i <- [0 .. finiteBitSize (0 :: Int) - 2]]
    pure $ putInts [minimum opts]

type SP = State [P.ByteString]

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

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

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

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


After overcoming the stairs Dasha came to classes. She needed to write a password to begin her classes. The password is a string of length n which satisfies the following requirements:  There is at least one digit in the string,  There is at least one lowercase (small) letter of the Latin alphabet in the string,  There is at least one of three listed symbols in the string: '#', '*', '&'.   Considering that these are programming classes it is not easy to write the password.For each character of the password we have a fixed string of length m, on each of these n strings there is a pointer on some character. The i-th character displayed on the screen is the pointed character in the i-th string. Initially, all pointers are on characters with indexes 1 in the corresponding strings (all positions are numbered starting from one).During one operation Dasha can move a pointer in one string one character to the left or to the right. Strings are cyclic, it means that when we move the pointer which is on the character with index 1 to the left, it moves to the character with the index m, and when we move it to the right from the position m it moves to the position 1.You need to determine the minimum number of operations necessary to make the string displayed on the screen a valid password.

The first line contains two integers n, m (3 ≤ n ≤ 50, 1 ≤ m ≤ 50) — the length of the password and the length of strings which are assigned to password symbols.  Each of the next n lines contains the string which is assigned to the i-th symbol of the password string. Its length is m, it consists of digits, lowercase English letters, and characters '#', '*' or '&'. You have such input data that you can always get a valid password.

Print one integer — the minimum number of operations which is necessary to make the string, which is displayed on the screen, a valid password.

NoteIn the first test it is necessary to move the pointer of the third string to one left to get the optimal answer.   In the second test one of possible algorithms will be:   to move the pointer of the second symbol once to the right.  to move the pointer of the third symbol twice to the right.

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array
import Data.Char

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

klass c
  | isDigit c = 0
  | isAsciiLower c = 1
  | otherwise = 2

solve ms n m = minimum [tbl!(i, 0) + tbl!(j, 1) + tbl!(k, 2) | i:j:k:_ <- sequence $ replicate 3 [1..n], i /= j, j /= k, k /= i]
  where
    ms' = listArray (1, n) ms
    tbl = array ((1, 0), (n, 2)) [((i, k), go i k) | i <- [1..n], k <- [0..2]]
    go i k = let s = ms'!i in minimum $ 10000:[min j (m - j) | j <- [0..m - 1], klass (s `B.index` j) == k]

main = do
  n:m:_ <- readInts <$> B.getLine
  ms <- replicateM n B.getLine
  print $ solve ms n m

import qualified Data.Array as A
import Data.Char
import Data.List
import Control.Applicative

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. lines
    where prep l = ((!! 0). getFst $ l, (!! 1). getFst $ l, tail l)
          getFst = fmap read. words. head
printAns = show

solve :: Int -> Int -> [String] -> Int
solve n m a = minimum ops
    where
        costs = A.listArray (0, n-1) (map cost a)
        cost = A.listArray (0, 2). zipWith d [isAlpha, isDigit, isRest]. repeat
            where isRest c = not. or. map ($ c) $ [isAlpha, isDigit]
        d f = minimum. (inf :). map (dist. fst). filter (f. snd). zip [0..]
            where dist i = min i (m - i)
                  inf = 10^8 + 23

        ops = [op i j k | i <- [0..n-1], j <- [0..n-1], k <- [0..n-1], i /= j, i /= k, j /= k]
            where op i j k = sum. zipWith getC [i,j,k] $ [0, 1, 2]
                  getC a b = costs A.! a A.! b
                  bad (a,b,c) = a == b || b == c || a == c

import qualified Data.Array as A
import Data.Char
import Data.List

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. lines
    where prep l = ((!! 0). getFst $ l, (!! 1). getFst $ l, tail l)
          getFst = fmap read. words. head
printAns = show

solve :: Int -> Int -> [String] -> Int
solve n m a = minimum ops
    where
        costs = A.listArray (0, n-1) (map cost a)
        cost l = A.listArray (0, 2) [d isAlpha l, d isDigit l, d isRest l]
            where isRest c = (&&) (not (isAlpha c)) (not (isDigit c))
        d f = minimum. (inf :). map (dist. fst). filter (f. snd). zip [0..]
            where dist i = min i (m - i)
                  inf = 10^8 + 23

        ops = [op i j k | i <- [0..n-1], j <- [0..n-1], k <- [0..n-1], i /= j, i /= k, j /= k]
        op i j k = getC i 0 + getC j 1 + getC k 2
            where getC a b = costs A.! a A.! b

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE FlexibleContexts     #-}

import Data.Array.Unboxed
import Data.Array.ST.Safe (STArray, STUArray)
import Data.Array.MArray.Safe
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Data.Bits
import Data.Maybe

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine
    css <- replicateM n getLine
    print $ solve n css

solve :: Int -> [String] -> Int
solve n css = fromJust $ minCostFlow (n+5) numE gr src sink 3
  where
    num = n
    alpha = n + 1
    symbol = n + 2
    src = n + 3
    sink = n + 4
    numE = 4 * n + 3
    gr = [(num, sink, 0, 1), (alpha,sink,0,1), (symbol,sink,0,1)]
      ++ [(src,i,0,1)|i<-[0..n-1]]
      ++ concat[[(i,num,x,1),(i,alpha,y,1),(i,symbol,z,1)]|(i,cs)<-zip[0..]css,let(x,y,z)=calc cs]

convert c
  | '0' <= c, c <= '9' = 0
  | 'a' <= c, c <= 'z' = 1
  | otherwise = 2

calc cs = go inf inf inf $ zip [0..] ns ++ zip [1..](reverse$tail ns)
  where
    ns = map convert cs
    go !x !y !z ((i,c):rest)
      | c == 0 = go (min i x) y z rest
      | c == 1 = go x (min i y) z rest
      | otherwise = go x y (min i z) rest
    go !x !y !z [] = (x, y, z)

type Vertex = Int
type Edge = Int
type Cost = Int
type Cap = Int

inf :: Cost
inf = 0x3f3f3f3f
{-# INLINE inf #-}

-- Just cost -> flow0流した時の最小費用がcost
-- Nothing   -> flow0 を流すことは出来ない
minCostFlow :: Int -> Int -> [(Vertex,Vertex,Cost,Cap)] -> Vertex -> Vertex -> Cap -> Maybe Cost
minCostFlow numv nume vvccs source sink flow0 = runST $ do
  gr        <- newArray  (0,numv-1) []     :: ST s (STArray  s Vertex [Edge])
  residual  <- newArray  (0,2*nume-1) 0    :: ST s (STUArray s Edge Cap)
  to        <- newArray_ (0,2*nume-1)      :: ST s (STUArray s Edge Vertex)
  cost      <- newArray_ (0,2*nume-1)      :: ST s (STUArray s Edge Cost)
  potential <- newArray  (0,numv-1) 0      :: ST s (STUArray s Vertex Cost)
  dist      <- newArray  (0,numv-1) inf    :: ST s (STUArray s Vertex Cost)
  prevv     <- newArray  (0,numv-1) (-1)   :: ST s (STUArray s Vertex Vertex)
  preve     <- newArray  (0,2*nume-1) (-1) :: ST s (STUArray s Vertex Edge)

  let mkGraph !i ((v,nv,c,cap):vvccs) = do
        modifyArray gr v (i:) >> modifyArray gr nv ((i+1):)
        writeArray to i nv    >> writeArray to (i+1) v
        writeArray cost i c   >> writeArray cost (i+1) (-c)
        writeArray residual i cap
        mkGraph (i+2) vvccs
      mkGraph _ _ = return ()

  let dijkstra (Fork v c hs) = do
        dv <- readArray dist v
        if c > dv then dijkstra $ mergePairs hs
        else do
          es <- readArray gr v
          hs' <- forM es $ \e -> do
            nv   <- readArray to e
            cap  <- readArray residual e
            hv   <- readArray potential v
            hnv  <- readArray potential nv
            v2nv <- readArray cost e
            old  <- readArray dist nv
            let dnv = dv + v2nv + hv - hnv
            if cap > 0 && dnv < old then do
              writeArray dist nv dnv
              writeArray prevv nv v
              writeArray preve nv e
              return $ Fork nv dnv []
            else return Empty
          dijkstra $ mergePairs hs `merge` mergePairs hs'
      dijkstra Empty = readArray dist sink

  let update flow = go sink flow
         where
           go !v !f = do
             pv <- readArray prevv v
             if pv < 0 then return f
             else do
               pv2v <- readArray preve v
               nf <- readArray residual pv2v >>= go pv . min f
               modifyArray residual pv2v (subtract nf)
               modifyArray residual (xor pv2v 1) (nf+)
               return nf

  let primalDual !flow !res
        | flow == 0 = return $ Just res
        | otherwise = do
            rep numv $ \i ->
                writeArray dist i inf
            writeArray dist source 0
            dsink <- dijkstra $ Fork source 0 []
            if dsink == inf then return Nothing
            else do
              rep numv $ \v-> do
                dv <- readArray dist v
                modifyArray potential v (dv+)
              f <- update flow
              hsink <- readArray potential sink
              primalDual (flow - f) $ hsink * f + res

  mkGraph 0 vvccs
  primalDual flow0 0

rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}

modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}

-- Pairing heap for Dijkstra
data Heap = Fork {-# UNPACK #-} !Vertex
                 {-# UNPACK #-} !Cost
                                [Heap]
          | Empty

merge :: Heap -> Heap -> Heap
merge hx@(Fork _ x _) hy@(Fork _ y _)
  | x <= y    = join hx hy
  | otherwise = join hy hx
 where
   join (Fork v cost hs) h = Fork v cost (h:hs)
merge Empty hy = hy
merge hx Empty = hx

mergePairs :: [Heap] -> Heap
mergePairs []       = Empty
mergePairs [x]      = x
mergePairs (x:y:hs) = merge (merge x y) (mergePairs hs)

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array
import Data.Char

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

klass c
  | isDigit c = 0
  | isAsciiLower c = 1
  | otherwise = 2

solve ms n m = minimum [tbl!(i, 0) + tbl!(j, 1) + tbl!(k, 2) | i:j:k:_ <- sequence $ replicate 3 [1..n], i /= j, j /= k]
  where
    ms' = listArray (1, n) ms
    tbl = array ((0, 0), (n, 2)) [((i, k), go i k) | i <- [0..n], k <- [0..2]]
    go 0 _ = 10000
    go i k = let s = ms'!i in minimum $ tbl!(i-1, k):[min j (m - j) | j <- [0..m - 1], klass (s `B.index` j) == k]

main = do
  n:m:_ <- readInts <$> B.getLine
  ms <- replicateM n B.getLine
  print $ solve ms n m

import qualified Data.Array as A
import Data.Char
import Data.List

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. lines
    where prep l = ((!! 0). getFst $ l, (!! 1). getFst $ l, tail l)
          getFst = fmap read. words. head
printAns = show

solve :: Int -> Int -> [String] -> Int
solve n m a = minimum ops
    where
        costs = A.listArray (0, n-1) (map cost a)
        cost l = A.listArray (0, 2) [d isAlpha l, d isDigit l, d isRest l]
        isRest c = (&&) (not (isAlpha c)) (not (isDigit c))
        d f = minimum. (alot :). map (dist. fst). filter (f. snd). zip [1..]
        dist i = min i (m - i)
        alot = 10^8 + 23

        ops = [op i j k | i <- [0..n-1], j <- [0..n-1], k <- [0..n-1], i /= j, i /= k, j /= k]
        op i j k = getC i 0 + getC j 1 + getC k 2
            where getC a b = costs A.! a A.! b


Ryouko is an extremely forgetful girl, she could even forget something that has just happened. So in order to remember, she takes a notebook with her, called Ryouko's Memory Note. She writes what she sees and what she hears on the notebook, and the notebook became her memory.Though Ryouko is forgetful, she is also born with superb analyzing abilities. However, analyzing depends greatly on gathered information, in other words, memory. So she has to shuffle through her notebook whenever she needs to analyze, which is tough work.Ryouko's notebook consists of n pages, numbered from 1 to n. To make life (and this problem) easier, we consider that to turn from page x to page y, |x - y| pages should be turned. During analyzing, Ryouko needs m pieces of information, the i-th piece of information is on page ai. Information must be read from the notebook in order, so the total number of pages that Ryouko needs to turn is .Ryouko wants to decrease the number of pages that need to be turned. In order to achieve this, she can merge two pages of her notebook. If Ryouko merges page x to page y, she would copy all the information on page x to y (1 ≤ x, y ≤ n), and consequently, all elements in sequence a that was x would become y. Note that x can be equal to y, in which case no changes take place.Please tell Ryouko the minimum number of pages that she needs to turn. Note she can apply the described operation at most once before the reading. Note that the answer can exceed 32-bit integers.

The first line of input contains two integers n and m (1 ≤ n, m ≤ 105). The next line contains m integers separated by spaces: a1, a2, ..., am (1 ≤ ai ≤ n).

Print a single integer — the minimum number of pages Ryouko needs to turn.

NoteIn the first sample, the optimal solution is to merge page 4 to 3, after merging sequence a becomes {1, 2, 3, 3, 3, 2}, so the number of pages Ryouko needs to turn is |1 - 2| + |2 - 3| + |3 - 3| + |3 - 3| + |3 - 2| = 3.In the second sample, optimal solution is achieved by merging page 9 to 4.

import Control.Monad
import Data.Array.Unboxed
import Data.List

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Data.Int

import Data.Array.IO
import qualified Data.Array.MArray as M

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

median xs = let n = length xs in (sort xs) !! (div n 2)

main = do
  (n:m:_) <- fmap (map read . words) getLine
  nums <- fmap (parseInts m) BS.getLine
  barr <- newArray (1,n) [] :: IO (IOArray Int [Int])

  let a = listArray (1,m) nums :: UArray Int Int

  forM_ [1..m] $ \i -> do
    when (i > 1 && a!(i-1) /= a!i) $ do
      let x = a!(i-1)
      xs <- readArray barr x
      writeArray barr x ((a!i):xs)
    when (i < m && a!i /= a!(i+1)) $ do
      let x = a!(i+1)
      xs <- readArray barr x
      writeArray barr x ((a!i):xs)

  barr' <- M.freeze barr :: IO (Array Int [Int])

  let d x y = fromIntegral $ abs (x-y)
  let diff y bs = let x = median bs in sum [ d y v - d x v | v <- bs ]
      best = maximum [ diff y bs | y <- [1..n], let bs = barr'!y ]
      total = sum [ d (a!i) (a!(i+1)) | i <- [1..m-1] ]
      answer = total - best :: Int64
  print answer

import Control.Monad
import Data.Array.Unboxed
import Data.List

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import qualified Data.IntSet as S
import Debug.Trace

import Data.Array.IO
import qualified Data.Array.MArray as M

{-
import Data.Array.ST
import Control.Monad.ST (runST,ST)
-}

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

median xs = let n = length xs in (sort xs) !! (div n 2)

{-
inc a i x = do v <- readArray a i; writeArray a i (x+v)
{-# INLINE inc #-}

median' n [a] = a
median' n xs = runST $ do
  a <- newArray (1,n) 0 :: ST s (STUArray s Int Int)
  forM_ xs $ \x -> inc a x 1
  let loop c i = do v <- readArray a i
                    if c <= v then return i else loop (c-v) (i+1)
  m <- loop (div (length xs) 2) 1
  return m
-}

main = do
  (n:m:_) <- fmap (map read . words) getLine
  nums <- fmap (parseInts m) BS.getLine
  barr <- newArray (1,n) [] :: IO (IOArray Int [Int])

  let a = listArray (1,m) nums :: UArray Int Int
      d x y = abs (x-y)

  forM_ [1..m] $ \i -> do
    when (i > 1 && a!(i-1) /= a!i) $ do
      let x = a!(i-1)
      xs <- readArray barr x
      writeArray barr x ((a!i):xs)
    when (i < m && a!i /= a!(i+1)) $ do
      let x = a!(i+1)
      xs <- readArray barr x
      writeArray barr x ((a!i):xs)

  barr' <- M.freeze barr :: IO (Array Int [Int])

  let diff y bs = let x = median bs in sum [ d y v - d x v | v <- bs ]
      best = maximum [ diff y bs | y <- [1..n], let bs = barr'!y ]
      total = sum [ d (a!i) (a!(i+1)) | i <- [1..m-1] ]
      answer = total - best
  print answer


Seryozha has a very changeable character. This time he refused to leave the room to Dima and his girlfriend (her hame is Inna, by the way). However, the two lovebirds can always find a way to communicate. Today they are writing text messages to each other.Dima and Inna are using a secret code in their text messages. When Dima wants to send Inna some sentence, he writes out all words, inserting a heart before each word and after the last word. A heart is a sequence of two characters: the "less" characters (<) and the digit three (3). After applying the code, a test message looks like that: <3word1<3word2<3 ... wordn<3.Encoding doesn't end here. Then Dima inserts a random number of small English characters, digits, signs "more" and "less" into any places of the message.Inna knows Dima perfectly well, so she knows what phrase Dima is going to send her beforehand. Inna has just got a text message. Help her find out if Dima encoded the message correctly. In other words, find out if a text message could have been received by encoding in the manner that is described above.

The first line contains integer n (1 ≤ n ≤ 105) — the number of words in Dima's message. Next n lines contain non-empty words, one word per line. The words only consist of small English letters. The total length of all words doesn't exceed 105.  The last line contains non-empty text message that Inna has got. The number of characters in the text message doesn't exceed 105. A text message can contain only small English letters, digits and signs more and less.

In a single line, print "yes" (without the quotes), if Dima decoded the text message correctly, and "no" (without the quotes) otherwise.

7
i
am
not
main
in
the
family
<3i<>3am<3the<3<main<3in<3the<3><3family<3

NotePlease note that Dima got a good old kick in the pants for the second sample from the statement.

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

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

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

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

main = do
    n <- readLn
    l <- replicateM n getLine
    s <- getLine
    let s' = encodeMessage l
    putStrLn $ case match s' s of
        True -> "yes"
        False -> "no"

encodeMessage :: [String] -> String
encodeMessage l = concat $ ["<3"++w | w <- l] ++ ["<3"]

match ptn str = go ptn str
    where
    go [] _ = True
    go _ [] = False
    go (x:xs) (y:ys) | x == y = go xs ys
                     | otherwise = go (x:xs) ys

import Control.Monad (replicateM)
import Data.List (intersperse)

(?) :: Bool -> a -> a -> a
(?) p a b  =  if p then a else b

solve :: [String] -> String -> Bool
solve ss ms  =  solve' ss' ms
  where
    ss'  =  concat [word, concat $ intersperse word ss, word]
    word  =  "<3"
    solve' "" _  =  True
    solve' _ ""  =  False
    solve' (s:ss) (m:ms)
      | s == m  =  solve' ss ms
      | otherwise  =  solve' (s:ss) ms

main :: IO ()
main  =  do
    n   <-  readLn
    ss  <-  replicateM n getLine
    ms  <-  getLine
    putStrLn $ (solve ss ms) ? "yes" $ "no"

module Main where
import Control.Applicative
-- import Control.Monad
import Data.List
main :: IO ()
main = do
  _ <- read <$> getLine :: IO Int
  res <- lines <$> getContents :: IO [String]
  let msg:ws = let x:xs = reverse res
                  in x:reverse xs
      expectedSs = "<3" ++ intercalate "<3" ws ++ "<3"
      stripChars [] _ = []
      stripChars (ch:chs) ch'
        | ch == ch' = chs
        | otherwise = ch:chs
  -- putStrLn expectedSs
  putStr $
    case foldl stripChars expectedSs msg of
      "" -> "yes"
      _ -> "no"

import Control.Monad
import Control.Applicative

search :: String -> String -> Bool
search [] _ = True
search (x:xs) [] = False
search s1@(x:xs) (y:ys)
  | x == y = search xs ys
  | otherwise = search s1 ys

main :: IO ()
main = do
  n <- (read <$> getLine) :: IO Int
  wlist <- replicateM n $
    getLine

  let str = (concatMap ("<3"++) wlist ++ "<3")
  bigstr <- getLine

  if search str bigstr
    then putStrLn "yes"
    else putStrLn "no"

import Control.Monad (replicateM)

main = do
    n <- fmap read getLine
    messageWords <- replicateM n getLine
    message <- getLine
    putStrLn $ if solve messageWords message then "yes" else "no"

intersperse' :: a -> [a] -> [a]
intersperse' y = foldr (\x acc -> y:x:acc) [y]

solve :: [String] -> String -> Bool
solve messageWords = matches (intersperse' "<3" messageWords)

matches :: [String] -> String -> Bool
matches [] _ = True
matches (w:ws) text = case w `subSeqOf` text of
    Nothing -> False
    Just text' -> matches ws text'

subSeqOf :: String -> String -> Maybe String
subSeqOf "" txt = Just txt
subSeqOf _ "" = Nothing
subSeqOf (c:cs) (t:txt)
    | c == t = subSeqOf cs txt
    | otherwise = subSeqOf (c:cs) txt

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (replicateM)
import Data.Functor ((<$>))
import qualified Data.ByteString as B

main = do
    n <- fmap read getLine
    messageWords <- B.concat . intersperse' "<3" <$> replicateM n (fmap B.init B.getLine)
    message <- B.getLine
    putStrLn $ if solve messageWords message then "yes" else "no"

{-# INLINE intersperse' #-}
intersperse' :: a -> [a] -> [a]
intersperse' y = foldr (\x acc -> y:x:acc) [y]

solve :: B.ByteString -> B.ByteString -> Bool
solve "" txt = True
solve _ "" = False
solve words text
    | B.head words == B.head text = solve (B.tail words) (B.tail text)
    | otherwise = solve words (B.tail text)

module Main where
import Control.Applicative
-- import Control.Monad
import Data.List
main :: IO ()
main = do
  _ <- read <$> getLine :: IO Int
  res <- lines <$> getContents :: IO [String]
  let msg:ws = let x:xs = reverse res
                  in x:reverse xs
      expectedSs = "<3" ++ intercalate "<3" ws ++ "<3"
      stripChars [] _ = []
      stripChars (ch:chs) ch'
        | ch == ch' = chs
        | otherwise = ch:chs
  putStrLn expectedSs
  putStr $
    case foldl stripChars expectedSs msg of
      "" -> "yes"
      _ -> "no"

module Main where
import Control.Applicative
-- import Control.Monad
import Data.List
main :: IO ()
main = do
  _ <- read <$> getLine :: IO Int
  res <- lines <$> getContents :: IO [String]
  let msg:ws = let x:xs = reverse res
                  in x:reverse xs
      expectedSs = intercalate "<3" ws
      stripChars [] _ = []
      stripChars (ch:chs) ch'
        | ch == ch' = chs
        | otherwise = ch:chs
  putStr $
    case foldl stripChars expectedSs msg of
      "" -> "yes"
      _ -> "no"


Two famous competing companies ChemForces and TopChemist decided to show their sets of recently discovered chemical elements on an exhibition. However they know that no element should be present in the sets of both companies.In order to avoid this representatives of both companies decided to make an agreement on the sets the companies should present. The sets should be chosen in the way that maximizes the total income of the companies.All elements are enumerated with integers. The ChemForces company has discovered $$$n$$$ distinct chemical elements with indices $$$a_1, a_2, \ldots, a_n$$$, and will get an income of $$$x_i$$$ Berland rubles if the $$$i$$$-th element from this list is in the set of this company.The TopChemist company discovered $$$m$$$ distinct chemical elements with indices $$$b_1, b_2, \ldots, b_m$$$, and it will get an income of $$$y_j$$$ Berland rubles for including the $$$j$$$-th element from this list to its set.In other words, the first company can present any subset of elements from $$$\{a_1, a_2, \ldots, a_n\}$$$ (possibly empty subset), the second company can present any subset of elements from $$$\{b_1, b_2, \ldots, b_m\}$$$ (possibly empty subset). There shouldn't be equal elements in the subsets.Help the representatives select the sets in such a way that no element is presented in both sets and the total income is the maximum possible.

The first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$)  — the number of elements discovered by ChemForces. The $$$i$$$-th of the next $$$n$$$ lines contains two integers $$$a_i$$$ and $$$x_i$$$ ($$$1 \leq a_i \leq 10^9$$$, $$$1 \leq x_i \leq 10^9$$$)  — the index of the $$$i$$$-th element and the income of its usage on the exhibition. It is guaranteed that all $$$a_i$$$ are distinct. The next line contains a single integer $$$m$$$ ($$$1 \leq m \leq 10^5$$$)  — the number of chemicals invented by TopChemist. The $$$j$$$-th of the next $$$m$$$ lines contains two integers $$$b_j$$$ and $$$y_j$$$, ($$$1 \leq b_j \leq 10^9$$$, $$$1 \leq y_j \leq 10^9$$$)  — the index of the $$$j$$$-th element and the income of its usage on the exhibition. It is guaranteed that all $$$b_j$$$ are distinct.

Print the maximum total income you can obtain by choosing the sets for both companies in such a way that no element is presented in both sets.

NoteIn the first example ChemForces can choose the set ($$$3, 7$$$), while TopChemist can choose ($$$1, 2, 4$$$). This way the total income is $$$(10 + 2) + (4 + 4 + 4) = 24$$$.In the second example ChemForces can choose the only element $$$10^9$$$, while TopChemist can choose ($$$14, 92, 35$$$). This way the total income is $$$(239) + (15 + 65 + 89) = 408$$$.

module Main where

import qualified Data.IntMap.Strict as M
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString as BS

getElements :: IO ((M.IntMap Int,M.IntMap Int))
getElements = do
  input <- fmap (C.split '\n') $ BS.getContents
  let count1 = read . C.unpack . head $ input
      list1 = [(v1, v2) | edgeBS <- take count1 . tail $ input,
               let [v1', v2'] = C.split ' ' edgeBS
                   Just (v1,_) = C.readInt v1'
                   Just (v2,_) = C.readInt v2']
      list2 = [(v1, v2) | edgeBS <- drop (count1 + 2) input, not $ BS.null edgeBS,
               let [v1', v2'] = C.split ' ' edgeBS
                   Just (v1,_) = C.readInt v1'
                   Just (v2,_) = C.readInt v2']
  return (M.fromList list1, M.fromList list2)

main = do
  (top, forces) <- getElements
  let income = M.foldl (\acc income ->
                          acc + toInteger income) (0 :: Integer) $ M.unionWith max forces top
  print income

import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.State
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.STRef

operate :: [[Integer]] -> Integer
operate l = runST $ do
    cnt <- newSTRef (head (head l))
    summ <- newSTRef (0::Integer)
    mapM_ (\(x:y:xs) -> do
                cur <- readSTRef cnt
                if cur <= x then modifySTRef summ (+y) >>
                                 writeSTRef cnt (x+1)
                else return ()
                ) l
    readSTRef summ

comp :: [Integer] -> [Integer] -> Ordering
comp (a:[]) _ = LT
comp _ (a:[]) = GT
comp (a:b:[]) (c:d:[]) = if (a < c) then LT
                         else if (a > c) then GT
                              else if (b < d) then GT
                                   else if (b > d) then LT
                                        else EQ

main :: IO ()
main = do
    cn <- B.getContents
    let parsed = map ((map (\l -> let res = B.readInteger l in
                                    case res of
                                        Just a    -> fst a
                                        otherwise -> 0::Integer)) . B.words
                     ) (B.lines cn)
    let res = sortBy comp parsed

    let ans = operate (tail (tail res))
    print ans
    return ()

module Main where

import qualified Data.IntMap.Strict as M

getElements :: IO (M.IntMap Int)
getElements = do
  count <- fmap read getLine
  list <- sequence $ take count $ repeat $ do
    [id, income] <- fmap (map read . words) getLine
    return (id, income)
  return $ M.fromList list

main = do
  forces <- getElements
  top <- getElements
  let intersection = M.intersectionWith max forces top
      difference1 = M.difference forces top
      difference2 = M.difference top forces
      income = M.foldl (+) 0 $ M.unions [intersection, difference1, difference2]
  print income

module Main where

import qualified Data.IntMap.Strict as M

getElements :: IO (M.IntMap Int)
getElements = do
  count <- fmap read getLine
  list <- sequence $ take count $ repeat $ do
    [id, income] <- fmap (map read . words) getLine
    return (id, income)
  return $ M.fromList list

main = do
  forces <- getElements
  top <- getElements
  let income = M.foldl (+) 0 $ M.unionWith max forces top
  print income

import Control.Monad
import Control.Monad.Trans.State
import qualified Data.Foldable as F
import Data.List
import qualified Data.Map as M

type MII = M.Map Int Int

operate :: [[Int]] -> State MII Int
operate inp = do
    forM_ inp (\(x:y:xs) -> do
                    m <- get
                    let a = M.lookup x m
                    case a of
                        Nothing -> put (M.insert x y m)
                        Just pr -> if (pr < y) then put (M.insert x y m)
                                               else return ()
              )
    m <- get
    return $ F.foldl (+) 0 m

main :: IO ()
main = do
    n <- getLine
    let nn = read n :: Int
    inpn <- replicateM nn getLine
    let inppn = map ((map read) . words) inpn
    let inpppn = map (\(x:y:xs) -> (x, y)) inppn
    let mp = M.fromList inpppn
    m <- getLine
    let mm = read m :: Int
    inpm <- replicateM mm getLine
    let inpmm = map ((map read) . words) inpm
    print $ evalState (operate inpmm) mp
    return ()


This is the easier version of the problem. In this version $$$1 \le n, m \le 100$$$. You can hack this problem only if you solve and lock both problems.You are given a sequence of integers $$$a=[a_1,a_2,\dots,a_n]$$$ of length $$$n$$$. Its subsequence is obtained by removing zero or more elements from the sequence $$$a$$$ (they do not necessarily go consecutively). For example, for the sequence $$$a=[11,20,11,33,11,20,11]$$$:  $$$[11,20,11,33,11,20,11]$$$, $$$[11,20,11,33,11,20]$$$, $$$[11,11,11,11]$$$, $$$[20]$$$, $$$[33,20]$$$ are subsequences (these are just some of the long list);  $$$[40]$$$, $$$[33,33]$$$, $$$[33,20,20]$$$, $$$[20,20,11,11]$$$ are not subsequences. Suppose that an additional non-negative integer $$$k$$$ ($$$1 \le k \le n$$$) is given, then the subsequence is called optimal if:  it has a length of $$$k$$$ and the sum of its elements is the maximum possible among all subsequences of length $$$k$$$;  and among all subsequences of length $$$k$$$ that satisfy the previous item, it is lexicographically minimal. Recall that the sequence $$$b=[b_1, b_2, \dots, b_k]$$$ is lexicographically smaller than the sequence $$$c=[c_1, c_2, \dots, c_k]$$$ if the first element (from the left) in which they differ less in the sequence $$$b$$$ than in $$$c$$$. Formally: there exists $$$t$$$ ($$$1 \le t \le k$$$) such that $$$b_1=c_1$$$, $$$b_2=c_2$$$, ..., $$$b_{t-1}=c_{t-1}$$$ and at the same time $$$b_t<c_t$$$. For example:  $$$[10, 20, 20]$$$ lexicographically less than $$$[10, 21, 1]$$$,  $$$[7, 99, 99]$$$ is lexicographically less than $$$[10, 21, 1]$$$,  $$$[10, 21, 0]$$$ is lexicographically less than $$$[10, 21, 1]$$$. You are given a sequence of $$$a=[a_1,a_2,\dots,a_n]$$$ and $$$m$$$ requests, each consisting of two numbers $$$k_j$$$ and $$$pos_j$$$ ($$$1 \le k \le n$$$, $$$1 \le pos_j \le k_j$$$). For each query, print the value that is in the index $$$pos_j$$$ of the optimal subsequence of the given sequence $$$a$$$ for $$$k=k_j$$$.For example, if $$$n=4$$$, $$$a=[10,20,30,20]$$$, $$$k_j=2$$$, then the optimal subsequence is $$$[20,30]$$$ — it is the minimum lexicographically among all subsequences of length $$$2$$$ with the maximum total sum of items. Thus, the answer to the request $$$k_j=2$$$, $$$pos_j=1$$$ is the number $$$20$$$, and the answer to the request $$$k_j=2$$$, $$$pos_j=2$$$ is the number $$$30$$$.

The first line contains an integer $$$n$$$ ($$$1 \le n \le 100$$$) — the length of the sequence $$$a$$$. The second line contains elements of the sequence $$$a$$$: integer numbers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$). The third line contains an integer $$$m$$$ ($$$1 \le m \le 100$$$) — the number of requests. The following $$$m$$$ lines contain pairs of integers $$$k_j$$$ and $$$pos_j$$$ ($$$1 \le k \le n$$$, $$$1 \le pos_j \le k_j$$$) — the requests.

Print $$$m$$$ integers $$$r_1, r_2, \dots, r_m$$$ ($$$1 \le r_j \le 10^9$$$) one per line: answers to the requests in the order they appear in the input. The value of $$$r_j$$$ should be equal to the value contained in the position $$$pos_j$$$ of the optimal subsequence for $$$k=k_j$$$.

import Control.Monad
import Data.Array
import Data.List
import qualified Data.Map.Strict as M

input :: Read a => IO [a]
input = map read <$> words <$> getLine

output :: Show a => [a] -> IO ()
output = putStrLn <$> unwords <$> map show

main = do
  [n] <- input
  a <- input :: IO [Int]
  [m] <- input
  let top = sortOn (\(x,i)->(-x,i)) (zip a [0..])
  let r = listArray (0, n) $ scanl' (\m (x,i) -> M.insert i x m) M.empty top
  replicateM_ m $ do
    [k,pos] <- input
    let (i,x) = M.elemAt (pos-1) (r ! k)
    print x