This is an interactive problem.Natasha is going to fly to Mars. Finally, Natasha sat in the rocket. She flies, flies... but gets bored. She wishes to arrive to Mars already! So she decides to find something to occupy herself. She couldn't think of anything better to do than to calculate the distance to the red planet.Let's define $$$x$$$ as the distance to Mars. Unfortunately, Natasha does not know $$$x$$$. But it is known that $$$1 \le x \le m$$$, where Natasha knows the number $$$m$$$. Besides, $$$x$$$ and $$$m$$$ are positive integers.Natasha can ask the rocket questions. Every question is an integer $$$y$$$ ($$$1 \le y \le m$$$). The correct answer to the question is $$$-1$$$, if $$$x<y$$$, $$$0$$$, if $$$x=y$$$, and $$$1$$$, if $$$x>y$$$. But the rocket is broken — it does not always answer correctly. Precisely: let the correct answer to the current question be equal to $$$t$$$, then, if the rocket answers this question correctly, then it will answer $$$t$$$, otherwise it will answer $$$-t$$$.In addition, the rocket has a sequence $$$p$$$ of length $$$n$$$. Each element of the sequence is either $$$0$$$ or $$$1$$$. The rocket processes this sequence in the cyclic order, that is $$$1$$$-st element, $$$2$$$-nd, $$$3$$$-rd, $$$\ldots$$$, $$$(n-1)$$$-th, $$$n$$$-th, $$$1$$$-st, $$$2$$$-nd, $$$3$$$-rd, $$$\ldots$$$, $$$(n-1)$$$-th, $$$n$$$-th, $$$\ldots$$$. If the current element is $$$1$$$, the rocket answers correctly, if $$$0$$$ — lies. Natasha doesn't know the sequence $$$p$$$, but she knows its length — $$$n$$$.You can ask the rocket no more than $$$60$$$ questions.Help Natasha find the distance to Mars. Assume, that the distance to Mars does not change while Natasha is asking questions.Your solution will not be accepted, if it does not receive an answer $$$0$$$ from the rocket (even if the distance to Mars is uniquely determined by the already received rocket's answers).

The first line contains two integers $$$m$$$ and $$$n$$$ ($$$1 \le m \le 10^9$$$, $$$1 \le n \le 30$$$) — the maximum distance to Mars and the number of elements in the sequence $$$p$$$.

NoteIn the example, hacking would look like this:5 2 31 0This means that the current distance to Mars is equal to $$$3$$$, Natasha knows that it does not exceed $$$5$$$, and the rocket answers in order: correctly, incorrectly, correctly, incorrectly ...Really:on the first query ($$$1$$$) the correct answer is $$$1$$$, the rocket answered correctly: $$$1$$$;on the second query ($$$2$$$) the correct answer is $$$1$$$, the rocket answered incorrectly: $$$-1$$$;on the third query ($$$4$$$) the correct answer is $$$-1$$$, the rocket answered correctly: $$$-1$$$;on the fourth query ($$$5$$$) the correct answer is $$$-1$$$, the rocket answered incorrectly: $$$1$$$;on the fifth query ($$$3$$$) the correct and incorrect answer is $$$0$$$.

import System.IO
import Control.Monad

makeTry :: Int -> IO Int
makeTry x = do
  print x
  hFlush stdout
  readLn

getCorrectness :: Int -> IO [Bool]
getCorrectness n = do
  x <- makeTry 1
  if x == 0 then
    return []
  else replicateM (n - 1) (makeTry 1) >>= \y -> return . map (== 1) $ x : y

doRest :: Int -> Int -> [Bool] -> IO ()
doRest lb ub (x:xs) = do
  let mb = (lb + ub) `div` 2
  ans <- makeTry mb
  let ans' = if x then ans else -ans
  case ans' of
    0 -> return ()
    1 -> doRest (mb + 1) ub xs
    -1 -> doRest lb mb xs

main = do
  [m, n] <- fmap (map read . words) getLine
  l <- getCorrectness n
  if l == [] then return () else doRest 1 (m + 1) $ cycle l

import System.IO

toint s = (read s) :: Int

doit2 l [] s e ss = doit2 l l s e ss
doit2 l (t:ts) s e ss =
  let m = div (s+e) 2 in
  let a = t * (head ss) in
  ((show m) ++ "\n") ++ (if a == 0 then "" else (if a < 0 then (doit2 l ts s m (tail ss)) else doit2 l ts (m+1) e (tail ss)))

doit m n l s =
  if n == 0 then
    let ll = reverse l in
    doit2 ll ll 1 (m+1) s
  else
    let a = head s in
    "1\n" ++ (if a == 0 then ""  else (doit m (n-1) (a:l) (tail s)))

solve::String->String
solve ss =
  let (m:n:s) = map toint $ words ss in
  doit m n [] s

main = do
    hSetBuffering stdout LineBuffering
    interact solve

import System.IO

toint s = (read s) :: Int

doit2 l [] s e ss = doit2 l l s e ss
doit2 l (t:ts) s e ss =
  let m = div (s+e) 2 in
  let a = t * (head ss) in
  ((show m) ++ "\n") ++ (if a == 0 then "" else (if a < 0 then (doit2 l ts s m (tail ss)) else doit2 l ts (m+1) e (tail ss)))

doit m n l s =
  if n == 0 then
    let ll = reverse l in
    doit2 ll ll 1 (m+1) s
  else
    let a = head s in
    "1\n" ++ (if a == 0 then ""  else "1\n"++(doit m (n-1) (a:l) (tail s)))

solve::String->String
solve ss =
  let (m:n:s) = map toint $ words ss in
  doit m n [] s

main = do
    hSetBuffering stdout LineBuffering
    interact solve


You are given two integers $$$n$$$ and $$$k$$$.You should create an array of $$$n$$$ positive integers $$$a_1, a_2, \dots, a_n$$$ such that the sum $$$(a_1 + a_2 + \dots + a_n)$$$ is divisible by $$$k$$$ and maximum element in $$$a$$$ is minimum possible.What is the minimum possible maximum element in $$$a$$$?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first and only line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 10^9$$$; $$$1 \le k \le 10^9$$$).

For each test case, print one integer — the minimum possible maximum element in array $$$a$$$ such that the sum $$$(a_1 + \dots + a_n)$$$ is divisible by $$$k$$$.

NoteIn the first test case $$$n = 1$$$, so the array consists of one element $$$a_1$$$ and if we make $$$a_1 = 5$$$ it will be divisible by $$$k = 5$$$ and the minimum possible.In the second test case, we can create array $$$a = [1, 2, 1, 2]$$$. The sum is divisible by $$$k = 3$$$ and the maximum is equal to $$$2$$$.In the third test case, we can create array $$$a = [1, 1, 1, 1, 1, 1, 1, 1]$$$. The sum is divisible by $$$k = 8$$$ and the maximum is equal to $$$1$$$.

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.List
import Data.Int

type SIO = StateT P.ByteString IO

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

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    let
      k' = k * div (n+k-1) k
      (q', r) = divMod k' n
      ans = q' + if  r > 0  then  1  else  0
    lift . P.putStrLn . P.pack $ {- unwords $ map -} show ans

import Control.Monad
readDoubles = fmap (map read.words) getLine :: IO [Double]

printResult [n,k] = print $ ceiling $ (if k >= n then k else k*y)/n
                where y = fromInteger $ ceiling (n/k) :: Double

main = do
    t <- readLn :: IO Int
    a <- replicateM t readDoubles
    mapM_ printResult a

import Control.Monad
import Data.List
readDoubles = fmap (map read.words) getLine :: IO [Double]

printResult [n,k] = print $ ceiling (r/n)
                where r = if k >= n then k else k * (let y = fromInteger $ ceiling (n/k) :: Double in y)

main = do
    t <- readLn :: IO Int
    a <- replicateM t readDoubles
    mapM_ printResult a

module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Maybe
import Data.Int
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as BS
--import Debug.Trace

--debug = flip trace
readx = fromInteger . fst . fromJust. BS.readInteger <$> BS.getLine
readxs =  map (fromInteger . fst . fromJust. BS.readInteger) . BS.words <$> BS.getLine

printList :: Show a => [a] -> IO ()
printList [] = return ()
printList [a] = print a
printList (a:xs) = putStr (show a) >> putChar ' ' >> printList xs

solve :: Int64 -> Int64 -> Int64
solve n k = (totSum+n-1) `div` n
    where totSum = k * ((n+k-1) `div` k)

main :: IO()
main =  do
   t <- readx
   replicateM_ t $ do
       (n:k:_) <- readxs
       print $ solve n k

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  [n, k] <- map read . words <$> getLine :: IO [Integer]
  print $ if n <= k then (k - 1) `div` n + 1 else if n `mod` k == 0 then 1 else 2

import qualified Data.Set as Set
import Data.List
import Control.Monad
import Data.Char

readInts = fmap (map read.words) getLine :: IO [Int]

printArray [] = ""
printArray (x:xs) = show(x) ++" " ++ printArray xs

printS = do
    [n,k]<-readInts
    let cf = (div n k) + if (mod n k > 0) then 1 else 0
        r = (div (cf*k) n) + if (mod (cf*k) n > 0) then 1 else 0
    print r

main = do
    t<-readLn::IO Int
    replicateM_ t printS

main = getContents >>= traverse print . solves . map read . tail . words

solves [] = []
solves (n:k:xs) = f n (k * f k n) : solves xs
  where f n k = (n + k - 1) `div` n

solve :: [Int] -> Int
solve [n, k] = m `div` n + ceil
    where rem = n `mod` k
          m = if rem == 0 then n else n + (k - rem)
          ceil = if m `mod` n == 0 then 0 else 1

main :: IO ()
main = interact (unlines . map (show . solve . toArr) . tail . lines)
    where toArr s = map (read :: String -> Int) $ words s

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n, k] <- getInts
    C.putStrLn $ C.pack $ show $ if n > k then (if n `mod` k == 0 then 1 else 2) else (k + n - 1) `div` n

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

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

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

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

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

solve :: Int64 -> Int64 -> Int64
solve n k
    | n >= k && n `mod` k == 0    = 1
    | n >= k && n `mod` k /= 0    = 2
    | n < k = (k + n - 1) `div` n

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, k] <- B8.getLine <&> map readIntegerB8 . B8.words
        let answer = solve (fromInteger n) (fromInteger k)
        printf "%lld\n" answer

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.List
import Data.Int

type SIO = StateT P.ByteString IO

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

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    let
      (q, r) = divMod k n
      ans = q + if  r > 0 || q == 0  then  1  else  0
    lift . P.putStrLn . P.pack $ {- unwords $ map -} show ans

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.List
import Data.Int

type SIO = StateT P.ByteString IO

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

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    let
      (q, r) = divMod k n
      q' = max q 1
      --ans = concat $ zipWith replicate [r, n-r] [q+1, q]
      ans = q' + if  r > 0  then  1  else  0
    lift . P.putStrLn . P.pack $ {- unwords $ map -} show ans

module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Maybe
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as BS
--import Debug.Trace

--debug = flip trace
readx = fromInteger . fst . fromJust. BS.readInteger <$> BS.getLine
readxs =  map (fromInteger . fst . fromJust. BS.readInteger) . BS.words <$> BS.getLine

printList :: Show a => [a] -> IO ()
printList [] = return ()
printList [a] = print a
printList (a:xs) = putStr (show a) >> putChar ' ' >> printList xs

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

main :: IO()
main =  do
   t <- readx
   replicateM_ t $ do
       (n:k:_) <- readxs
       print $ solve n k

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  [n, k] <- map read . words <$> getLine :: IO [Integer]
  print $ if n > k then 2 else (k - 1) `div` n + 1


This problem is actually a subproblem of problem G from the same contest.There are $$$n$$$ candies in a candy box. The type of the $$$i$$$-th candy is $$$a_i$$$ ($$$1 \le a_i \le n$$$).You have to prepare a gift using some of these candies with the following restriction: the numbers of candies of each type presented in a gift should be all distinct (i. e. for example, a gift having two candies of type $$$1$$$ and two candies of type $$$2$$$ is bad). It is possible that multiple types of candies are completely absent from the gift. It is also possible that not all candies of some types will be taken to a gift.Your task is to find out the maximum possible size of the single gift you can prepare using the candies you have.You have to answer $$$q$$$ independent queries.If you are Python programmer, consider using PyPy instead of Python when you submit your code.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 2 \cdot 10^5$$$) — the number of queries. Each query is represented by two lines. The first line of each query contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of candies. The second line of each query contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$), where $$$a_i$$$ is the type of the $$$i$$$-th candy in the box. It is guaranteed that the sum of $$$n$$$ over all queries does not exceed $$$2 \cdot 10^5$$$.

For each query print one integer — the maximum possible size of the single gift you can compose using candies you got in this query with the restriction described in the problem statement.

NoteIn the first query, you can prepare a gift with two candies of type $$$8$$$ and one candy of type $$$5$$$, totalling to $$$3$$$ candies.Note that this is not the only possible solution — taking two candies of type $$$4$$$ and one candy of type $$$6$$$ is also valid.

import Data.List

readInt :: String -> Integer
readInt = read

main = interact $ solve . (map ((map readInt) . words)) . tail . lines

solve :: [[Integer]] -> String
solve [] = ""
solve (_:x:xs) = solveInstance x ++ solve xs

solveInstance :: [Integer] -> String
solveInstance xs =
    let l = reverse $ sort $ map genericLength $ groupBy (==) $ sort xs in
--    (++"\n") $ show l
    (++"\n") . show $ takeGreedily l (head l) 0

takeGreedily :: [Integer] -> Integer -> Integer -> Integer
takeGreedily [] _ _ = 0
takeGreedily _ 0 _ = 0
takeGreedily (x:xs) current carry
    | x >= current = current + takeGreedily xs (current - 1) carry
    | carry >= 1 = current + takeGreedily (x:xs) (current - 1) (carry - 1)
    | otherwise = takeGreedily (x:xs) (current - 1) carry

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

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

main = do
  [q] <- input
  replicateM_ q $ do
    getLine
    a <- input :: IO [Integer]
    let f = reverse $ sort $ map length $ group $ sort a
    print $ sum $ scanl1 (\b x -> max 0 $ min (b-1) x) f

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

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

main = do
  [q] <- input
  replicateM_ q $ do
    getLine
    a <- input :: IO [Int]
    let f = reverse $ sort $ map length $ group $ sort a
    print $ sum $ scanl1 (\b x -> max 0 $ min (b-1) x) f

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

readInt :: IO Int
readInt = read <$> getLine

readInts :: IO [Int]
readInts = map read <$> words <$> getLine

main = do
  q <- readInt
  replicateM_ q $ do
    getLine
    a <- readInts
    let f = reverse $ sort $ map length $ group $ sort a
    print $ sum $ scanl1 (\b x -> max 0 $ min (b-1) x) f

import Control.Monad
import Data.List

main = do
  q <- readLn
  replicateM (q :: Int) $ do
    getLine
    a <- map read . words <$> getLine
    print $ sum $ scanl1 (\x -> \y -> max 0 $ min (x-1) y) $ reverse . sort . map length . group . sort $ (a :: [Int])


You are given a following process. There is a platform with $$$n$$$ columns. $$$1 \times 1$$$ squares are appearing one after another in some columns on this platform. If there are no squares in the column, a square will occupy the bottom row. Otherwise a square will appear at the top of the highest square of this column. When all of the $$$n$$$ columns have at least one square in them, the bottom row is being removed. You will receive $$$1$$$ point for this, and all the squares left will fall down one row. You task is to calculate the amount of points you will receive.

The first line of input contain 2 integer numbers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 1000$$$) — the length of the platform and the number of the squares. The next line contain $$$m$$$ integer numbers $$$c_1, c_2, \dots, c_m$$$ ($$$1 \le c_i \le n$$$) — column in which $$$i$$$-th square will appear.

Print one integer — the amount of points you will receive.

NoteIn the sample case the answer will be equal to $$$2$$$ because after the appearing of $$$6$$$-th square will be removed one row (counts of the squares on the platform will look like $$$[2~ 3~ 1]$$$, and after removing one row will be $$$[1~ 2~ 0]$$$).After the appearing of $$$9$$$-th square counts will be $$$[2~ 3~ 1]$$$, and after removing one row it will look like $$$[1~ 2~ 0]$$$.So the answer will be equal to $$$2$$$.

import Data.Array

getInts = (map read . words) `fmap` getLine :: IO [Int]

main = do
    [n,m] <- getInts
    columns <- getInts
    let heights = accumArray (+) 0 (1,n) [(i,1) | i <- columns]
    print $ (minimum . elems) heights

{-# OPTIONS_GHC -O2 #-}
import Control.Applicative
import Data.List
getList = fmap ((map read).words) getLine
get c = sort $ map length (group (sort c))
solve n c
  | length (get c) < n = show 0
  | otherwise = show (head (get c))
main = do
  [n,_] <- getList
  c <- getList
  putStrLn $ solve n c

import Data.List

main = getContents >>= print . solve . map read . words

solve (x:_:xs) = subtract 1 $ minimum $ map length $ group $ sort $ [1 .. x] ++ xs

{-# LANGUAGE ScopedTypeVariables #-}

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad.State.Strict
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

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

main :: IO ()
main = do
    [n, m] <- (map readB8Int) <$> B8.words <$> B8.getLine
    (squares :: [Int]) <- (map readB8Int) <$> B8.words <$> B8.getLine
    let sizes :: MapS.Map Int Int = foldr' (MapS.alter (fmap (+1) . flip mplus (Just 0))) MapS.empty squares
    let minSize = (foldr1 min) . map (\i -> fromMaybe 0 . MapS.lookup i $ sizes) $ [1..n]
    printf "%d\n" minSize

main = do
  [n, m] <- getLine >>= return. map read. words :: IO [Int]
  a <- getLine >>= return. map read. words :: IO [Int]
  print.minimum. map (\x -> length.filter (==x) $ a) $ [1..n]

import Control.Applicative
import Data.List
getList = fmap ((map read).words) getLine
get c = reverse $ map length (group (sort c))
solve n c
  | length (get c) < n = show 0
  | otherwise = show (head (get c))
main = do
  [n,_] <- getList
  c <- getList
  putStrLn $ solve n c

{-# LANGUAGE ScopedTypeVariables #-}

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad.State.Strict
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

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

main :: IO ()
main = do
    [n, m] <- (map readB8Int) <$> B8.words <$> B8.getLine
    (squares :: [Int]) <- (map readB8Int) <$> B8.words <$> B8.getLine
    let sizes :: MapS.Map Int Int = foldr' (MapS.alter (fmap (+1) . mplus (Just 1))) MapS.empty squares
    let minSize = (foldr1 min) . map (\i -> fromMaybe 0 . MapS.lookup i $ sizes) $ [1..n]
    printf "%d\n" minSize

{-# LANGUAGE ScopedTypeVariables #-}

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad.State.Strict
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

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

main :: IO ()
main = do
    [n, m] <- (map readB8Int) <$> B8.words <$> B8.getLine
    (squares :: [Int]) <- (map readB8Int) <$> B8.words <$> B8.getLine
    let sizes :: MapS.Map Int Int = foldr' (MapS.alter (fmap (+1) . flip mplus (Just 1))) MapS.empty squares
    let minSize = (foldr1 min) . map (\i -> fromMaybe 0 . MapS.lookup i $ sizes) $ [1..n]
    printf "%d\n" minSize

main = do
  [n, m] <- getLine >>= return. map read. words :: IO [Int]
  a <- getLine >>= return. map read. words :: IO [Int]
  print.maximum. map (\x -> length.filter (==x) $ a) $ [1..n]


In one little known, but very beautiful country called Waterland, lives a lovely shark Valerie. Like all the sharks, she has several rows of teeth, and feeds on crucians. One of Valerie's distinguishing features is that while eating one crucian she uses only one row of her teeth, the rest of the teeth are "relaxing".For a long time our heroine had been searching the sea for crucians, but a great misfortune happened. Her teeth started to ache, and she had to see the local dentist, lobster Ashot. As a professional, Ashot quickly relieved Valerie from her toothache. Moreover, he managed to determine the cause of Valerie's developing caries (for what he was later nicknamed Cap).It turned that Valerie eats too many crucians. To help Valerie avoid further reoccurrence of toothache, Ashot found for each Valerie's tooth its residual viability. Residual viability of a tooth is a value equal to the amount of crucians that Valerie can eat with this tooth. Every time Valerie eats a crucian, viability of all the teeth used for it will decrease by one. When the viability of at least one tooth becomes negative, the shark will have to see the dentist again. Unhappy, Valerie came back home, where a portion of crucians was waiting for her. For sure, the shark couldn't say no to her favourite meal, but she had no desire to go back to the dentist. That's why she decided to eat the maximum amount of crucians from the portion but so that the viability of no tooth becomes negative. As Valerie is not good at mathematics, she asked you to help her to find out the total amount of crucians that she can consume for dinner.We should remind you that while eating one crucian Valerie uses exactly one row of teeth and the viability of each tooth from this row decreases by one.

The first line contains three integers n, m, k (1 ≤ m ≤ n ≤ 1000, 0 ≤ k ≤ 106) — total amount of Valerie's teeth, amount of tooth rows and amount of crucians in Valerie's portion for dinner. Then follow n lines, each containing two integers: r (1 ≤ r ≤ m) — index of the row, where belongs the corresponding tooth, and c (0 ≤ c ≤ 106) — its residual viability. It's guaranteed that each tooth row has positive amount of teeth.

In the first line output the maximum amount of crucians that Valerie can consume for dinner.

module Main where

import Data.STRef
import Data.Array
import Data.Array.ST
import Data.Array.MArray
import Control.Monad
import Data.List

main = do
    inputNMK <- getLine
    let [n, m, k] = map read $ words inputNMK

    teeth <- replicateM n $ do
        inputRC <- getLine
        let [r, c] = map read $ words inputRC

        return (r, c)

    let rowViability = runSTArray $ do
            rowViability <- newArray (1, m) 2147483647
            forM_ teeth $ \(r, c) -> do
                old_c <- readArray rowViability r
                if c < old_c
                    then writeArray rowViability r c
                    else return ()
            return rowViability

    putStrLn $ show $ min k $ sum $ elems rowViability

import Array

bigNum = 1000000

solve :: Int -> [(Int, Int)] -> Int
solve n assocs' = foldl (+) 0 elements
  where
    elements = elems (accumArray min bigNum (1, n) assocs')

readAssoc :: Int -> IO (Int, Int)
readAssoc _ = do
  line <- getLine
  let [a, b] = map read $ words line
  return (a, b)

main = do
  line <- getLine
  let [n, m, k] = map read $ words line
  assocs' <- sequence (map readAssoc [1..n])
  print $ min (solve m assocs') k

module Main where

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

main = do
  [n, m, k] <- map read . words <$> getLine
  let readline :: IO (Integer, Integer)
      readline = do
         [row, rv] <- map read . words <$> getLine
         return (row, rv)
  lst <- replicateM n readline
  let lst' = nubBy ((==) `on` fst) . sort $ lst
      total = sum' . map snd $ lst'
      sum'  = foldl1' (+)
  print (min total (fromIntegral k))

import Prelude
import List
import Char

main = interact q

q = func.lines

func::[String]->String
func (a:xs) = func' (words a) xs
              where
                func' (a:b:c:[]) xs = ((toString.solve a' b' c'.map (makeTooth.words).take a') xs)
                                      ++"\n"++ (func (drop a' xs))
                                      where a' = toInt a
                                            b' = toInt b
                                            c' = asInteger c
                                            makeTooth xs = (((toInt.head) xs),
                                                           ((asInteger.last) xs))
func []     = ""

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Integer->String
toString = show

solve::Int->Int->Integer->[(Int,Integer)]->Integer
solve a b c  = min c.sum.map (minimum.map snd).groupBy groupHelper.sortBy sorter
               where
                 sorter::(Int,Integer)->(Int,Integer)->Ordering
                 sorter a b = compare (fst a) (fst b)
                 groupHelper::(Int,Integer)->(Int,Integer)->Bool
                 groupHelper a b = (fst a) == (fst b)

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

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

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
      -- readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : m : k : _ <- readData
  v <- fmap (sum . map (snd . head) . groupBy ((==) `on` fst) . sort)
      . T.for [1 .. n] $ \i -> do
    r : c : _ <- readData
    return (r, c)
  print $ min v k

main = interact (ans)
ans theInput = show $ min (sum $ viability teeth) k where
	theLines = lines theInput
	[n,m,k] = map (read::String->Int) (words $ head theLines)
	teeth = map (map (read::String->Int)) (map words (take n (tail theLines)))
	viability [] = take m (repeat 1000001)
	viability (x:xs) = v1 ++ [v2] ++ v3 where
		r = x !! 0
		v = viability xs
		v1 = take (r-1) v
		v2 = min (v !! (r-1)) (x !! 1)
		v3 = drop r v

import Array

bigNum = 10000

solve :: Int -> [(Int, Int)] -> Int
solve n assocs' = foldl (+) 0 elements
  where
    elements = elems (accumArray min bigNum (1, n) assocs')

readAssoc :: Int -> IO (Int, Int)
readAssoc _ = do
  line <- getLine
  let [a, b] = map read $ words line
  return (a, b)

main = do
  line <- getLine
  let [n, m, k] = map read $ words line
  assocs' <- sequence (map readAssoc [1..n])
  print $ min (solve m assocs') k

import Prelude
import List
import Char

main = interact q

q = func.lines

func::[String]->String
func (a:xs) = func' (words a) xs
              where
                func' (a:b:c:[]) xs = ((toString.solve a' b' c'.map (makeTooth.words).take a') xs)
                                      ++ (func (drop a' xs))
                                      where a' = toInt a
                                            b' = toInt b
                                            c' = asInteger c
                                            makeTooth xs = (((toInt.head) xs),
                                                           ((asInteger.last) xs))
func []     = ""

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Integer->String
toString = show

solve::Int->Int->Integer->[(Int,Integer)]->Integer
solve a b c  = min (toInteger c).sum.map (maximum.map snd).groupBy groupHelper.sortBy sorter
               where
                 sorter::(Int,Integer)->(Int,Integer)->Ordering
                 sorter a b = compare (fst a) (fst b)
                 groupHelper::(Int,Integer)->(Int,Integer)->Bool
                 groupHelper a b = (fst a) == (fst b)

import Prelude
import List
import Char

main = interact q

q = func.lines

func::[String]->String
func (a:xs) = func' (words a) xs
              where
                func' (a:b:c:[]) xs = ((toString.solve a' b' c'.map (makeTooth.words).take a') xs)
                                      ++"\n"++ (func (drop a' xs))
                                      where a' = toInt a
                                            b' = toInt b
                                            c' = asInteger c
                                            makeTooth xs = (((toInt.head) xs),
                                                           ((asInteger.last) xs))
func []     = ""

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Integer->String
toString = show

solve::Int->Int->Integer->[(Int,Integer)]->Integer
solve a b c  = min c.sum.map (maximum.map snd).groupBy groupHelper.sortBy sorter
               where
                 sorter::(Int,Integer)->(Int,Integer)->Ordering
                 sorter a b = compare (fst a) (fst b)
                 groupHelper::(Int,Integer)->(Int,Integer)->Bool
                 groupHelper a b = (fst a) == (fst b)

import Prelude
import List
import Char

main = interact (func.lines)

func::[String]->String
func (a:xs) = func' (words a) xs
              where
                func' (a:b:c:[]) xs = ((toString.solve a' b' c'.map (makeTooth.words).take a') xs)
                                      ++ (func (drop a' xs))
                                      where a' = toInt a
                                            b' = toInt b
                                            c' = asInteger c
                                            makeTooth xs = (((toInt.head) xs),
                                                           ((asInteger.last) xs))
func []     = ""

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Integer->String
toString = show

solve::Int->Int->Integer->[(Int,Integer)]->Integer
solve a b c  = min (toInteger a).maximum.map (maximum.map snd).groupBy groupHelper.sortBy sorter
               where
                 sorter::(Int,Integer)->(Int,Integer)->Ordering
                 sorter a b = compare (fst a) (fst b)
                 groupHelper::(Int,Integer)->(Int,Integer)->Bool
                 groupHelper a b = (fst a) == (fst b)

import Prelude
import List
import Char

main = interact q

q = func.lines

func::[String]->String
func (a:xs) = func' (words a) xs
              where
                func' (a:b:c:[]) xs = ((toString.solve a' b' c'.map (makeTooth.words).take a') xs)
                                      ++ (func (drop a' xs))
                                      where a' = toInt a
                                            b' = toInt b
                                            c' = asInteger c
                                            makeTooth xs = (((toInt.head) xs),
                                                           ((asInteger.last) xs))
func []     = ""

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Integer->String
toString = show

solve::Int->Int->Integer->[(Int,Integer)]->Integer
solve a b c  = min c.sum.map (maximum.map snd).groupBy groupHelper.sortBy sorter
               where
                 sorter::(Int,Integer)->(Int,Integer)->Ordering
                 sorter a b = compare (fst a) (fst b)
                 groupHelper::(Int,Integer)->(Int,Integer)->Bool
                 groupHelper a b = (fst a) == (fst b)

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

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

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
      -- readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
      exit = print (-1) >> exitSuccess
  s1 <- getLine
  s2 <- getLine
  when (length s1 /= length s2) $  exit
  n <- readLn
  cs <- T.for [1 .. n] $ \i -> do
    from : to : v: _ <- words <$> getLine
    return (head from, Map.singleton (head to) (read v :: Int))
  let mp = Map.fromListWith (Map.unionWith min) cs
      bnds = (('a', 'a'), ('z', 'z'))
  table <- newArray bnds maxBound :: IO (IOArray (Char, Char) Int)
  F.for_ (zip ['a' .. 'z'] ['a' .. 'z']) $ \idx -> do
    writeArray table idx 0
  let fill from cost now = F.for_ (Map.lookup now mp) $ \mp' -> do
        F.for_ (Map.toList mp') $ \(to, new) -> do
          old <- readArray table (now, to)
          when (old == maxBound || new < old) $ do
            writeArray table (now, to) new
            let new' = cost + new
            old' <- readArray table (from, to)
            when (old' == maxBound || new' < old') $ do
              writeArray table (from, to) new'
            fill from new' to
  F.for_ ['a' .. 'z'] $ \c -> fill c 0 c
  F.for_ ['a' .. 'z'] $ \c -> fill c 0 c
  let check c1 c2
        | c1 == c2  = return (c1, 0)
        | otherwise = do
            xs <- T.for ['a' .. 'z'] $ \to -> do
              v1 <- readArray table (c1, to)
              v2 <- readArray table (c2, to)
              case () of
                _ | c1 == to  -> return (to, v2)
                  | c2 == to  -> return (to, v1)
                  | otherwise -> return (to, min v1 v2)
            when (null xs) $ exit
            let (c, cost) = minimumBy (comparing snd) xs
            if cost == maxBound
              then exit
              else do
                return (c, cost)
  (answer, cost) <- unzip <$> zipWithM check s1 s2
--  getAssocs table >>= printf "%s\n" . show
  print $ sum cost
  putStrLn answer

{-
ad
ad
6
a b 1
a e 4
b e 1
b c 2
c d 100
e d 5
-}


You are given a number $$$n$$$ and an array $$$b_1, b_2, \ldots, b_{n+2}$$$, obtained according to the following algorithm:   some array $$$a_1, a_2, \ldots, a_n$$$ was guessed;  array $$$a$$$ was written to array $$$b$$$, i.e. $$$b_i = a_i$$$ ($$$1 \le i \le n$$$);  The $$$(n+1)$$$-th element of the array $$$b$$$ is the sum of the numbers in the array $$$a$$$, i.e. $$$b_{n+1} = a_1+a_2+\ldots+a_n$$$;  The $$$(n+2)$$$-th element of the array $$$b$$$ was written some number $$$x$$$ ($$$1 \le x \le 10^9$$$), i.e. $$$b_{n+2} = x$$$; The  array $$$b$$$ was shuffled. For example, the array $$$b=[2, 3, 7, 12 ,2]$$$ it could be obtained in the following ways:   $$$a=[2, 2, 3]$$$ and $$$x=12$$$;  $$$a=[3, 2, 7]$$$ and $$$x=2$$$. For the given array $$$b$$$, find any array $$$a$$$ that could have been guessed initially.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$). The second row of each test case contains $$$n+2$$$ integers $$$b_1, b_2, \ldots, b_{n+2}$$$ ($$$1 \le b_i \le 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output:    "-1", if the array $$$b$$$ could not be obtained from any array $$$a$$$;  $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$, otherwise.  If there are several arrays of $$$a$$$, you can output any.

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L

result :: Integer -> [Integer] -> Maybe [Integer]
result n array = case (testxMax, testyMax) of
	(Nothing, Nothing) -> Nothing
	(Just i, _) -> Just $ fmap (arrayM !) $ filter (\j->j /= i && j /= xMax) [0..(length array - 1)]
	(_, Just i) -> Just $ fmap (arrayM !) $ filter (\j->j /= i && j /= yMax) [0..(length array - 1)]
	where
		(xMax, yMax) = unJust2 $ foldr aux (Nothing, Nothing) [0..(length array - 1)] where
			aux v (Nothing, Nothing) = (Nothing, Just v)
			aux v (Nothing, Just x)
			    | arrayM ! v > arrayM ! x = (Just v, Just x)
			    | otherwise = (Just x, Just v)
			aux v (Just x, Just y)
				| arrayM ! v > arrayM ! x = (Just v, Just x)
				| arrayM ! v > arrayM ! y = (Just x, Just v)
				| otherwise = (Just x, Just y)

			unJust2 (Just x, Just y) = (x, y)

		arrayM = M.fromList $ zip [0..] array

		sumArray = sum array

		testxMax = foldr aux Nothing [0..(length array - 1)] where
			aux i Nothing
				| i == xMax = Nothing
				| sumArray - arrayM ! xMax - arrayM ! i == arrayM ! xMax = Just i
				| otherwise = Nothing

			aux i (Just j) = Just j

		testyMax = foldr aux Nothing [0..(length array - 1)] where
			aux i Nothing
				| i == yMax = Nothing
				| sumArray - arrayM ! yMax - arrayM ! i == arrayM ! yMax = Just i
				| otherwise = Nothing

			aux i (Just j) = Just j

showR :: Maybe [Integer] -> String
showR Nothing = "-1"
showR (Just l) = aux l where
	aux [] = []
	aux (x:xs) = show x ++  " " ++ aux xs

main = do
	t <- getLine >>= return . read :: IO Int

	let loop t = if t==0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		b <- getLine >>= return . (fmap read) . words :: IO [Integer]

		putStrLn $ showR $ result n b

		loop $ t - 1

	loop t

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L

result :: Integer -> [Integer] -> Maybe [Integer]
result n array = case (testxMax, testyMax) of
	(Nothing, Nothing) -> Nothing
	(Just i, _) -> Just $ fmap (arrayM !) $ filter (\j->j /= i && j /= xMax) [0..(length array - 1)]
	(_, Just i) -> Just $ fmap (arrayM !) $ filter (\j->j /= i && j /= yMax) [0..(length array - 1)]
	where
		(xMax, yMax) = unJust2 $ foldr aux (Nothing, Nothing) [0..(length array - 1)] where
			aux v (Nothing, Nothing) = (Nothing, Just v)
			aux v (Nothing, Just x) = (Just $ max x v, Just $ min x v)
			aux v (Just x, Just y)
				| arrayM ! v > arrayM ! x = (Just v, Just x)
				| arrayM ! v > arrayM ! y = (Just x, Just v)
				| otherwise = (Just x, Just y)

			unJust2 (Just x, Just y) = (x, y)

		arrayM = M.fromList $ zip [0..] array

		sumArray = sum array

		testxMax = foldr aux Nothing [0..(length array - 1)] where
			aux i Nothing
				| i == xMax = Nothing
				| sumArray - arrayM ! xMax - arrayM ! i == arrayM ! xMax = Just i
				| otherwise = Nothing

			aux i (Just j) = Just j

		testyMax = foldr aux Nothing [0..(length array - 1)] where
			aux i Nothing
				| i == yMax = Nothing
				| sumArray - arrayM ! yMax - arrayM ! i == arrayM ! yMax = Just i
				| otherwise = Nothing

			aux i (Just j) = Just j

showR :: Maybe [Integer] -> String
showR Nothing = "-1"
showR (Just l) = aux l where
	aux [] = []
	aux (x:xs) = show x ++  " " ++ aux xs

main = do
	t <- getLine >>= return . read :: IO Int

	let loop t = if t==0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		b <- getLine >>= return . (fmap read) . words :: IO [Integer]

		putStrLn $ showR $ result n b

		loop $ t - 1

	loop t

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L

result :: Integer -> [Integer] -> Maybe [Integer]
result n array = case (testxMax, testyMax) of
	(Nothing, Nothing) -> Nothing
	(Just i, _) -> Just $ fmap (arrayM !) $ filter (\j->j /= i && j /= xMax) [0..(length array - 1)]
	(_, Just i) -> Just $ fmap (arrayM !) $ filter (\j->j /= i && j /= yMax) [0..(length array - 1)]
	where
		(xMax, yMax) = unJust2 $ foldr aux (Nothing, Nothing) [0..(length array - 1)] where
			aux v (Nothing, Nothing) = (Nothing, Just v)
			aux v (Nothing, Just x) = (Just $ max x v, Just $ min x v)
			aux v (Just x, Just y)
				| arrayM ! v > arrayM ! x = (Just v, Just x)
				| arrayM ! v > arrayM ! y = (Just x, Just v)
				| otherwise = (Just x, Just y)

			unJust2 (Just x, Just y) = (x, y)

		arrayM = M.fromList $ zip [0..] array

		sumArray = sum array

		testxMax = foldr aux Nothing [0..(length array - 1)] where
			aux i Nothing
				| sumArray - arrayM ! xMax - arrayM ! i == arrayM ! xMax = Just i
				| otherwise = Nothing

			aux i (Just j) = Just j

		testyMax = foldr aux Nothing [0..(length array - 1)] where
			aux i Nothing
				| sumArray - arrayM ! yMax - arrayM ! i == arrayM ! yMax = Just i
				| otherwise = Nothing

			aux i (Just j) = Just j

showR :: Maybe [Integer] -> String
showR Nothing = "-1"
showR (Just l) = aux l where
	aux [] = []
	aux (x:xs) = show x ++  " " ++ aux xs

main = do
	t <- getLine >>= return . read :: IO Int

	let loop t = if t==0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		b <- getLine >>= return . (fmap read) . words :: IO [Integer]

		putStrLn $ showR $ result n b

		loop $ t - 1

	loop t


There is a river of width $$$n$$$. The left bank of the river is cell $$$0$$$ and the right bank is cell $$$n + 1$$$ (more formally, the river can be represented as a sequence of $$$n + 2$$$ cells numbered from $$$0$$$ to $$$n + 1$$$). There are also $$$m$$$ wooden platforms on a river, the $$$i$$$-th platform has length $$$c_i$$$ (so the $$$i$$$-th platform takes $$$c_i$$$ consecutive cells of the river). It is guaranteed that the sum of lengths of platforms does not exceed $$$n$$$.You are standing at $$$0$$$ and want to reach $$$n+1$$$ somehow. If you are standing at the position $$$x$$$, you can jump to any position in the range $$$[x + 1; x + d]$$$. However you don't really like the water so you can jump only to such cells that belong to some wooden platform. For example, if $$$d=1$$$, you can jump only to the next position (if it belongs to the wooden platform). You can assume that cells $$$0$$$ and $$$n+1$$$ belong to wooden platforms.You want to know if it is possible to reach $$$n+1$$$ from $$$0$$$ if you can move any platform to the left or to the right arbitrary number of times (possibly, zero) as long as they do not intersect each other (but two platforms can touch each other). It also means that you cannot change the relative order of platforms.Note that you should move platforms until you start jumping (in other words, you first move the platforms and then start jumping).For example, if $$$n=7$$$, $$$m=3$$$, $$$d=2$$$ and $$$c = [1, 2, 1]$$$, then one of the ways to reach $$$8$$$ from $$$0$$$ is follow:    The first example: $$$n=7$$$.

The first line of the input contains three integers $$$n$$$, $$$m$$$ and $$$d$$$ ($$$1 \le n, m, d \le 1000, m \le n$$$) — the width of the river, the number of platforms and the maximum distance of your jump, correspondingly. The second line of the input contains $$$m$$$ integers $$$c_1, c_2, \dots, c_m$$$ ($$$1 \le c_i \le n, \sum\limits_{i=1}^{m} c_i \le n$$$), where $$$c_i$$$ is the length of the $$$i$$$-th platform.

If it is impossible to reach $$$n+1$$$ from $$$0$$$, print NO in the first line. Otherwise, print YES in the first line and the array $$$a$$$ of length $$$n$$$ in the second line — the sequence of river cells (excluding cell $$$0$$$ and cell $$$n + 1$$$). If the cell $$$i$$$ does not belong to any platform, $$$a_i$$$ should be $$$0$$$. Otherwise, it should be equal to the index of the platform ($$$1$$$-indexed, platforms are numbered from $$$1$$$ to $$$m$$$ in order of input) to which the cell $$$i$$$ belongs. Note that all $$$a_i$$$ equal to $$$1$$$ should form a contiguous subsegment of the array $$$a$$$ of length $$$c_1$$$, all $$$a_i$$$ equal to $$$2$$$ should form a contiguous subsegment of the array $$$a$$$ of length $$$c_2$$$, ..., all $$$a_i$$$ equal to $$$m$$$ should form a contiguous subsegment of the array $$$a$$$ of length $$$c_m$$$. The leftmost position of $$$2$$$ in $$$a$$$ should be greater than the rightmost position of $$$1$$$, the leftmost position of $$$3$$$ in $$$a$$$ should be greater than the rightmost position of $$$2$$$, ..., the leftmost position of $$$m$$$ in $$$a$$$ should be greater than the rightmost position of $$$m-1$$$. See example outputs for better understanding.

NoteConsider the first example: the answer is $$$[0, 1, 0, 2, 2, 0, 3]$$$. The sequence of jumps you perform is $$$0 \rightarrow 2 \rightarrow 4 \rightarrow 5 \rightarrow 7 \rightarrow 8$$$.Consider the second example: it does not matter how to place the platform because you always can jump from $$$0$$$ to $$$11$$$.Consider the third example: the answer is $$$[0, 0, 0, 0, 1, 1, 0, 0, 0, 0]$$$. The sequence of jumps you perform is $$$0 \rightarrow 5 \rightarrow 6 \rightarrow 11$$$.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = do
	[ n, m, d ] <- readInts
	cs <- readInts
	let
		shortage = n - sum cs
		res = solve d shortage $ zip cs [ 1 .. ]
		res_str = unwords $ map show res
	if length res == n
		then do
			putStrLn "YES"
			putStrLn res_str
		else putStrLn "NO"

solve d s [] = replicate zeros 0
	where
		zeros = min ( pred d ) s
solve d s ( ( c, i ):cis ) = replicate zeros 0 ++ replicate c i ++ solve d s' cis
	where
		zeros = min ( pred d ) s
		s' = s - zeros


The hero of the Cut the Rope game is a little monster named Om Nom. He loves candies. And what a coincidence! He also is the hero of today's problem.  One day, Om Nom visited his friend Evan. Evan has n candies of two types (fruit drops and caramel drops), the i-th candy hangs at the height of hi centimeters above the floor of the house, its mass is mi. Om Nom wants to eat as many candies as possible. At the beginning Om Nom can make at most x centimeter high jumps. When Om Nom eats a candy of mass y, he gets stronger and the height of his jump increases by y centimeters.What maximum number of candies can Om Nom eat if he never eats two candies of the same type in a row (Om Nom finds it too boring)?

The first line contains two integers, n and x (1 ≤ n, x ≤ 2000) — the number of sweets Evan has and the initial height of Om Nom's jump.  Each of the following n lines contains three integers ti, hi, mi (0 ≤ ti ≤ 1; 1 ≤ hi, mi ≤ 2000) — the type, height and the mass of the i-th candy. If number ti equals 0, then the current candy is a caramel drop, otherwise it is a fruit drop.

Print a single integer — the maximum number of candies Om Nom can eat.

NoteOne of the possible ways to eat 4 candies is to eat them in the order: 1, 5, 3, 2. Let's assume the following scenario:  Initially, the height of Om Nom's jump equals 3. He can reach candies 1 and 2. Let's assume that he eats candy 1. As the mass of this candy equals 4, the height of his jump will rise to 3 + 4 = 7.  Now Om Nom can reach candies 2 and 5. Let's assume that he eats candy 5. Then the height of his jump will be 7 + 5 = 12.  At this moment, Om Nom can reach two candies, 2 and 3. He won't eat candy 2 as its type matches the type of the previously eaten candy. Om Nom eats candy 3, the height of his jump is 12 + 3 = 15.  Om Nom eats candy 2, the height of his jump is 15 + 1 = 16. He cannot reach candy 4.

import Data.Array.IO
import Data.IORef
import Control.Monad
import Data.Tuple
import Data.List
import Data.Char
import qualified Data.ByteString.Lazy as B

parse :: B.ByteString -> [Int]
parse s = do
	q <- B.splitWith (\x-> x == 13 || x == 10 || x == 32) s
	if B.length q == 0 then
		[]
	else
		return $ foldl' (\a b-> a * 10 + (fromIntegral b) - (ord '0')) 0 (B.unpack q)

readc :: [Int] -> [(Int, Int, Int)]
readc [] = []
readc (t:h:m:xx) = (t,m,h):(readc xx)

spl :: [(Int, Int, Int)] -> ([(Int, Int)], [(Int, Int)])
spl [] = ([], [])
spl ((t, m, h):xs) = let (q0, q1) = spl xs in
	if t == 0 then ((m, h):q0, q1)
	else (q0, (m, h):q1)

getmaxnum :: [(Int, Int)] -> [(Int, Int)] -> Int -> IO Int
getmaxnum [] _ _ = return 0
getmaxnum xs ns x = do
	let aval = filter (\(_,b) -> b <= x) xs
	--putStrLn $ show aval
	if aval == [] then return 0
	else do
		let (mm, mh) = maximum aval
		r <- getmaxnum ns (delete (mm, mh) xs) (x + mm)
		return $ r + 1

main :: IO ()
main = do
	bbbb <- B.getContents
	let n:x:nn = parse bbbb
	let cs = readc nn
	let (kars, leds) = spl cs
	--putStrLn $ show $ (kars, leds)
	r1 <- getmaxnum kars leds x
	r2 <- getmaxnum leds kars x
	let res = max r1 r2
	putStrLn $ show res

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List hiding (insert)
import qualified Data.Map as M
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
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 #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

data Heap a = Fork !a [Heap a] | Empty

singleton :: a -> Heap a
singleton x = Fork x []

isEmpty :: Heap a -> Bool
isEmpty Empty = True
isEmpty _ = False

insert :: Ord a => a -> Heap a -> Heap a
insert x h = merge (Fork x []) h

maxElem :: Heap a -> Maybe a
maxElem (Fork x _) = Just x
maxElem _ = Nothing

deleteMax :: Ord a => Heap a -> Maybe (Heap a)
deleteMax (Fork _ hs) = Just $ mergePairs hs
deleteMax _ = Nothing

deleteFindMax :: Ord a => Heap a -> Maybe (a, Heap a)
deleteFindMax (Fork x hs) = Just (x, mergePairs hs)
deleteFindMax _ = Nothing

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

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

main :: IO ()
main = do
  [n,x] <- map read.words <$> getLine
  thms <- parse.map readInt.B.words <$> B.getContents
  print $ solve n x thms

parse :: [Int] -> [(Bool, Int, Int)]
parse (1:h:m:rest) = (True,h,m)  : parse rest
parse (0:h:m:rest) = (False,h,m) : parse rest
parse _ = []

solve :: Int -> Int -> [(Bool, Int, Int)] -> Int
solve n x thms = max (goF x 0 Empty Empty fs cs) (goC x 0 Empty Empty fs cs)
   where
     fs = sort[(h,m)|(True,h,m)<-thms]
     cs = sort[(h,m)|(False,h,m)<-thms]
     goF !x !cnt !canUseF !canUseC fs cs
       | Just (m, canUseF'')<-deleteFindMax canUseF' = goC (x+m) (cnt+1) canUseF'' canUseC fs' cs
       | otherwise = cnt
      where
        (ms, fs') = span ((<=x).fst) fs
        !canUseF' = foldl' (flip insert) canUseF $ map snd ms
     goC !x !cnt !canUseF !canUseC fs cs
       | Just (m, canUseC'')<-deleteFindMax canUseC'= goF (x+m) (cnt+1) canUseF canUseC'' fs cs'
       | otherwise = cnt
      where
        (ms, cs') = span ((<=x).fst) cs
        !canUseC' = foldl' (flip insert) canUseC $ map snd ms

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
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 #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  [n,x] <- map read.words <$> getLine
  thms <- parse.map readInt.B.words <$> B.getContents
  print $ solve n x thms

parse :: [Int] -> [(Bool, Int, Int)]
parse (1:h:m:rest) = (True,h,m)  : parse rest
parse (0:h:m:rest) = (False,h,m) : parse rest
parse _ = []

solve :: Int -> Int -> [(Bool, Int, Int)] -> Int
solve n x thms = max (goF x 0 IS.empty IS.empty fs cs) (goC x 0 IS.empty IS.empty fs cs)
   where
     fs = sort[(h,m)|(True,h,m)<-thms]
     cs = sort[(h,m)|(False,h,m)<-thms]
     goF !x !cnt !canUseF !canUseC fs cs
       | IS.null canUseF' = cnt
       | (m, canUseF'')<-IS.deleteFindMax canUseF' = goC (x+m) (cnt+1) canUseF'' canUseC fs' cs
      where
        (ms, fs') = span ((<=x).fst) fs
        !canUseF' = foldl' (flip IS.insert) canUseF $ map snd ms
     goC !x !cnt !canUseF !canUseC fs cs
       | IS.null canUseC' = cnt
       | (m, canUseC'')<-IS.deleteFindMax canUseC'= goF (x+m) (cnt+1) canUseF canUseC'' fs cs'
      where
        (ms, cs') = span ((<=x).fst) cs
        !canUseC' = foldl' (flip IS.insert) canUseC $ map snd ms

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
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 #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  [n,x] <- map read.words <$> getLine
  thms <- parse.map readInt.B.words <$> B.getContents
  print $ solve n x thms

parse :: [Int] -> [(Bool, Int, Int)]
parse (1:h:m:rest) = (True,h,m)  : parse rest
parse (0:h:m:rest) = (False,h,m) : parse rest
parse _ = []

solve :: Int -> Int -> [(Bool, Int, Int)] -> Int
solve n x thms = max (goF x 0 IS.empty fs cs) (goC x 0 IS.empty fs cs)
   where
     fs = sort[(h,m)|(True,h,m)<-thms]
     cs = sort[(h,m)|(False,h,m)<-thms]
     goF !x !cnt !canUse fs cs
       | IS.null canUse' = cnt
       | (m, canUse'')<-IS.deleteFindMax canUse' = goC (x+m) (cnt+1) canUse'' fs' cs
      where
        (ms, fs') = span ((<=x).fst) fs
        !canUse' = foldl' (flip IS.insert) canUse $ map snd ms
     goC !x !cnt !canUse fs cs
       | IS.null canUse' = cnt
       | (m, canUse'')<-IS.deleteFindMax canUse'= goF (x+m) (cnt+1) canUse'' fs cs'
      where
        (ms, cs') = span ((<=x).fst) cs
        !canUse' = foldl' (flip IS.insert) canUse $ map snd ms


There are n piles of pebbles on the table, the i-th pile contains ai pebbles. Your task is to paint each pebble using one of the k given colors so that for each color c and any two piles i and j the difference between the number of pebbles of color c in pile i and number of pebbles of color c in pile j is at most one.In other words, let's say that bi, c is the number of pebbles of color c in the i-th pile. Then for any 1 ≤ c ≤ k, 1 ≤ i, j ≤ n the following condition must be satisfied |bi, c - bj, c| ≤ 1. It isn't necessary to use all k colors: if color c hasn't been used in pile i, then bi, c is considered to be zero.

The first line of the input contains positive integers n and k (1 ≤ n, k ≤ 100), separated by a space — the number of piles and the number of colors respectively. The second line contains n positive integers a1, a2, ..., an (1 ≤ ai ≤ 100) denoting number of pebbles in each of the piles.

If there is no way to paint the pebbles satisfying the given condition, output "NO" (without quotes) . Otherwise in the first line output "YES" (without quotes). Then n lines should follow, the i-th of them should contain ai space-separated integers. j-th (1 ≤ j ≤ ai) of these integers should be equal to the color of the j-th pebble in the i-th pile. If there are several possible answers, you may output any of them.

inf = 10 ^ 9

greedyR k size = take size $ concat $ repeat [1..k]
greedyT k sizes = map (greedyR k) sizes

-- so ugly
counts elems arr = [length $ filter (==e) arr | e <- elems]
updateMinMax (minv, maxv) val = (min minv val, max maxv val)
check k ans = all (\(min, max) -> max - min <= 1) $ foldl (\l1 l2 -> zipWith updateMinMax l1 l2) (repeat (inf, -inf)) $ map (counts [1..k]) ans

main = do
    contents <- getContents
    let [[n, k], sizes] = map (map read . words) $ lines contents
    let ans = greedyT k sizes
    if check k ans then do
        putStrLn "YES"
        putStr $ unlines $ map (unwords . map show) $ ans
    else do
        putStr "NO"


You are given a string $$$s=s_1s_2\dots s_n$$$ of length $$$n$$$, which only contains digits $$$1$$$, $$$2$$$, ..., $$$9$$$.A substring $$$s[l \dots r]$$$ of $$$s$$$ is a string $$$s_l s_{l + 1} s_{l + 2} \ldots s_r$$$. A substring $$$s[l \dots r]$$$ of $$$s$$$ is called even if the number represented by it is even. Find the number of even substrings of $$$s$$$. Note, that even if some substrings are equal as strings, but have different $$$l$$$ and $$$r$$$, they are counted as different substrings.

The first line contains an integer $$$n$$$ ($$$1 \le n \le 65000$$$) — the length of the string $$$s$$$. The second line contains a string $$$s$$$ of length $$$n$$$. The string $$$s$$$ consists only of digits $$$1$$$, $$$2$$$, ..., $$$9$$$.

Print the number of even substrings of $$$s$$$.

NoteIn the first example, the $$$[l, r]$$$ pairs corresponding to even substrings are:   $$$s[1 \dots 2]$$$ $$$s[2 \dots 2]$$$ $$$s[1 \dots 4]$$$ $$$s[2 \dots 4]$$$ $$$s[3 \dots 4]$$$ $$$s[4 \dots 4]$$$ In the second example, all $$$10$$$ substrings of $$$s$$$ are even substrings. Note, that while substrings $$$s[1 \dots 1]$$$ and $$$s[2 \dots 2]$$$ both define the substring "2", they are still counted as different substrings.

import Data.Char
main = interact $ show  . evensubstr . last . lines

evensubstr :: String -> Int
evensubstr s = sum $ map es $ (zip s [1,2..])
  where es (x, y)
          | even $ digitToInt x = y
          | otherwise           = 0

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

evenSubstrings :: String -> Int
evenSubstrings = fst . foldl (\(a, b) c -> if elem c "02468"
                                           then (a + b, b + 1)
                                           else (a,     b + 1)) (0, 1)

main :: IO ()
main = do
    _ <- readInt
    s <- getLine
    print $ evenSubstrings s

main = interact $ show . solve . tail . lines
solve [s] = sum $ map fst $ filter ((`elem` "2468") . snd) $ zip [1..] s

import Data.List (inits, tails)
import Data.Char (digitToInt)

main :: IO ()
main = interact $ unlines . fmap (show . countSub) . tail . words

countSub :: String -> Int
countSub = sum . map fst . filter (even . digitToInt . snd) . zip [1..]

import Data.Char
evenSubstrings :: String -> Int
evenSubstrings s = sum $ map f $ (zip s [1..])
f (x,y)
  | even $ digitToInt x = y
  | otherwise           = 0
main = interact $ show . evenSubstrings . (!! 1) . lines

{-# LANGUAGE BangPatterns, 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 Data.List
import Data.Int

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

ceven !c = even $ ord c

solve :: [C.ByteString] -> Builder
solve (sn:s:_) = int64Dec res <> char7 '\n'
  where
    res :: Int64
    res = sum $ map (fromIntegral . fst) $ filter (ceven . snd) $ zip [1 .. ] $ C.unpack $ C.take (ri sn) s

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

main = interact $ show.helper.words

helper (x:xs:_) = fonk 0 1 xs
                 where fonk res _ [] = res
                       fonk res i (a:aa) = if (even.read) (a:"")
                                           then fonk (res + i) (i+1) aa
                                           else fonk (res) (i+1) aa

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

main= do
		n<- read <$> getLine ::IO [Int]
		s<-map digitToInt <$> getLine
		print $ sum $ zipWith (\a b-> if even b then a else 0)  [1..] s

--ghc 7.10

import Data.List(findIndices)

countEvenSubstrings :: [Int] -> Int
countEvenSubstrings = sum . map (+1) . findIndices (even)

main = do
    nStr <- getLine
    str <- getLine
    let xs = map read . map (:[]) $ str
    print $ countEvenSubstrings xs

import Data.Char

solve _ [] = 0
solve n (x:xs) | digitToInt x `mod` 2 == 0 = (n + 1) + solve (n + 1) xs
               | otherwise                 = solve (n + 1) xs

main = do
    input <- getContents
    let s = last $ lines input
    print $ solve 0 s

import Data.List
subseq = filter (not . null) . concatMap tails . inits
evenSubstrings = length . filter ((== 0) . (`mod` 2)) . map read . tail . subseq
main = interact $ show . evenSubstrings . (!! 1) . lines


Eshag has an array $$$a$$$ consisting of $$$n$$$ integers.Eshag can perform the following operation any number of times: choose some subsequence of $$$a$$$ and delete every element from it which is strictly larger than $$$AVG$$$, where $$$AVG$$$ is the average of the numbers in the chosen subsequence.For example, if $$$a = [1 , 4 , 3 , 2 , 4]$$$ and Eshag applies the operation to the subsequence containing $$$a_1$$$, $$$a_2$$$, $$$a_4$$$ and $$$a_5$$$, then he will delete those of these $$$4$$$ elements which are larger than $$$\frac{a_1+a_2+a_4+a_5}{4} = \frac{11}{4}$$$, so after the operation, the array $$$a$$$ will become $$$a = [1 , 3 , 2]$$$.Your task is to find the maximum number of elements Eshag can delete from the array $$$a$$$ by applying the operation described above some number (maybe, zero) times.A sequence $$$b$$$ is a subsequence of an array $$$c$$$ if $$$b$$$ can be obtained from $$$c$$$ by deletion of several (possibly, zero or all) elements.

The first line contains an integer $$$t$$$ $$$(1\le t\le 100)$$$ — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ $$$(1\le n\le 100)$$$ — the length of the array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ $$$(1\le a_i \le 100)$$$ — the elements of the array $$$a$$$.

For each test case print a single integer — the maximum number of elements Eshag can delete from the array $$$a$$$.

NoteConsider the first test case.Initially $$$a = [1, 1, 1, 2, 2, 3]$$$.In the first operation, Eshag can choose the subsequence containing $$$a_1$$$, $$$a_5$$$ and $$$a_6$$$, their average is equal to $$$\frac{a_1 + a_5 + a_6}{3} = \frac{6}{3} = 2$$$. So $$$a_6$$$ will be deleted.After this $$$a = [1, 1, 1, 2, 2]$$$.In the second operation, Eshag can choose the subsequence containing the whole array $$$a$$$, the average of all its elements is equal to $$$\frac{7}{5}$$$. So $$$a_4$$$ and $$$a_5$$$ will be deleted.After this $$$a = [1, 1, 1]$$$.In the second test case, Eshag can't delete any element.

evens (x:xs) = x:odds xs
evens _ = []

odds (_:xs) = evens xs
odds _ = []

solution :: [Int] -> String
solution a =
  show $ length a - (length . filter (== (foldr1 min a))) a

main = interact $ unlines . map (solution . map read . words) . odds . tail . lines

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let m = minimum a
        c =  length . filter (==m) $ a
    print $ n - c

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import Control.Monad
import Data.List
readInts = fmap (map read.words) getLine :: IO [Int]
solve [x] n = n
solve (x:xs) n = if x == head xs then solve xs (n+1) else n
printS = do
    n<-readLn::IO Int
    a <- readInts
    print $ n - solve (sort a) 1
main = do
    t <- readLn::IO Int
    replicateM_ t printS

import Control.Monad

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        a <- map read . words <$> getLine
        print $ n - countMinimums a

countMinimums :: [Int] -> Int
countMinimums a = length $ filter (== minimum  a) a

main = do
  --text <- readFile "inputt.txt"
  --putStrLn ((unlines . solve . map ((\x -> (map (\y -> read y :: Int) x)) . words) . tail . lines) text)
  interact (unlines . solve . map ((\x -> (map (\y -> read y :: Int) x)) . words) . tail . lines)

solve :: [[Int]] -> [String]
solve [] = []
solve (a : b : lst) = (show (head a - (occr (minelt b) b)) : solve lst)
occr elt [] = 0
occr elt (a : xs)
  | (==) a elt = (+) 1 (occr elt xs)
  | otherwise = (occr elt xs)
minelt [x] = x
minelt (x : xs)
  | (x < t) = x
  | otherwise = t
  where t = minelt (xs)

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

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    _ <- getInts
    (x : xs) <- sort <$> getInts
    C.putStrLn $ C.pack $ show $ length $ dropWhile (== x) xs


You are playing a game of Jongmah. You don't need to know the rules to solve this problem. You have $$$n$$$ tiles in your hand. Each tile has an integer between $$$1$$$ and $$$m$$$ written on it.To win the game, you will need to form some number of triples. Each triple consists of three tiles, such that the numbers written on the tiles are either all the same or consecutive. For example, $$$7, 7, 7$$$ is a valid triple, and so is $$$12, 13, 14$$$, but $$$2,2,3$$$ or $$$2,4,6$$$ are not. You can only use the tiles in your hand to form triples. Each tile can be used in at most one triple.To determine how close you are to the win, you want to know the maximum number of triples you can form from the tiles in your hand.

The first line contains two integers integer $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 10^6$$$) — the number of tiles in your hand and the number of tiles types. The second line contains integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le m$$$), where $$$a_i$$$ denotes the number written on the $$$i$$$-th tile.

Print one integer: the maximum number of triples you can form.

NoteIn the first example, we have tiles $$$2, 3, 3, 3, 4, 4, 4, 5, 5, 6$$$. We can form three triples in the following way: $$$2, 3, 4$$$; $$$3, 4, 5$$$; $$$4, 5, 6$$$. Since there are only $$$10$$$ tiles, there is no way we could form $$$4$$$ triples, so the answer is $$$3$$$.In the second example, we have tiles $$$1$$$, $$$2$$$, $$$3$$$ ($$$7$$$ times), $$$4$$$, $$$5$$$ ($$$2$$$ times). We can form $$$3$$$ triples as follows: $$$1, 2, 3$$$; $$$3, 3, 3$$$; $$$3, 4, 5$$$. One can show that forming $$$4$$$ triples is not possible.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

main :: IO ()
main = do
  [n,m] <- map readInt . words <$> getLine
  as <- take n . unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let cnt = A.accumArray (+) 0 (1,m) $ map (,1) as :: UArray Int Int
  print $ query cnt

query :: UArray Int Int -> Int
query cnt = (A.! (0,0))
  $! foldl' (\ !arr !height ->
               A.array ((0,0),(2,2))
               [(i, count arr height i) | i <- A.range ((0,0),(2,2))])
            (A.accumArray (\_->id) ng ((0,0),(2,2)) [((0,0),0)])
            (A.elems cnt)

  where
    ng = minBound :: Int
    count :: UArray (Int,Int) Int -> Int -> (Int,Int) -> Int
    count !arr !height (!l1, !l2)
      = maximum [if hremain >= 0
                  then arr A.! (l0, l1) + l2 + hremain `div` 3
                  else ng
                | l0 <- [0..2],
                  let hremain = height - l0 - l1 - l2]

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N


Hemose was shopping with his friends Samez, AhmedZ, AshrafEzz, TheSawan and O_E in Germany. As you know, Hemose and his friends are problem solvers, so they are very clever. Therefore, they will go to all discount markets in Germany.Hemose has an array of $$$n$$$ integers. He wants Samez to sort the array in the non-decreasing order. Since it would be a too easy problem for Samez, Hemose allows Samez to use only the following operation:Choose indices $$$i$$$ and $$$j$$$ such that $$$1 \le i, j \le n$$$, and $$$\lvert i - j \rvert \geq x$$$. Then, swap elements $$$a_i$$$ and $$$a_j$$$.Can you tell Samez if there's a way to sort the array in the non-decreasing order by using the operation written above some finite number of times (possibly $$$0$$$)?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ $$$(1 \leq t \leq 10^5)$$$. Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$x$$$ $$$(1 \leq x \leq n \leq 10^5)$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, ..., a_n$$$ $$$(1 \leq a_i \leq 10^9)$$$. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, you should output a single string.  If Samez can sort the array in non-decreasing order using the operation written above, output "YES" (without quotes). Otherwise, output "NO" (without quotes). You can print each letter of "YES" and "NO" in any case (upper or lower).

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

solve = do
    [n, x] <- map read.words <$> getLine :: IO [Int]
    a <- map read.words <$> getLine :: IO [Int]
    let v = drop (n - x) $ take x $ sort a
    let u = drop (n - x) $ take x a
    putStrLn $ if u == v then "YES" else "NO"

main = readLn >>= flip replicateM_ solve

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

solve = do
    [n, x] <- map read.words <$> getLine :: IO [Int]
    a <- map read.words <$> getLine :: IO [Int]
    let v = drop (n - x) $ take x $ sort a
    let u = drop (n - x) $ take x a
    if u == v then putStrLn "YES" else putStrLn "NO"

main = readLn >>= flip replicateM_ solve


In a small restaurant there are a tables for one person and b tables for two persons. It it known that n groups of people come today, each consisting of one or two people. If a group consist of one person, it is seated at a vacant one-seater table. If there are none of them, it is seated at a vacant two-seater table. If there are none of them, it is seated at a two-seater table occupied by single person. If there are still none of them, the restaurant denies service to this group.If a group consist of two people, it is seated at a vacant two-seater table. If there are none of them, the restaurant denies service to this group.You are given a chronological order of groups coming. You are to determine the total number of people the restaurant denies service to.

The first line contains three integers n, a and b (1 ≤ n ≤ 2·105, 1 ≤ a, b ≤ 2·105) — the number of groups coming to the restaurant, the number of one-seater and the number of two-seater tables. The second line contains a sequence of integers t1, t2, ..., tn (1 ≤ ti ≤ 2) — the description of clients in chronological order. If ti is equal to one, then the i-th group consists of one person, otherwise the i-th group consists of two people.

Print the total number of people the restaurant denies service to.

NoteIn the first example the first group consists of one person, it is seated at a vacant one-seater table. The next group occupies a whole two-seater table. The third group consists of one person, it occupies one place at the remaining two-seater table. The fourth group consists of one person, he is seated at the remaining seat at the two-seater table. Thus, all clients are served.In the second example the first group consists of one person, it is seated at the vacant one-seater table. The next group consists of one person, it occupies one place at the two-seater table. It's impossible to seat the next group of two people, so the restaurant denies service to them. The fourth group consists of one person, he is seated at the remaining seat at the two-seater table. Thus, the restaurant denies service to 2 clients.

main = interact $ f

f :: String -> String
f = show . g . map read . words

g :: [Int] -> Int
g (n:a:b:ts) = h a b 0 ts

h :: Int -> Int -> Int -> [Int] -> Int
h _ _ _ [] = 0
h 0 0 0 (1:ts) = 1 + h 0 0 0 ts
h 0 0 c (1:ts) = h 0 0 (c - 1) ts
h 0 b c (1:ts) = h 0 (b - 1) (c + 1) ts
h a b c (1:ts) = h (a - 1) b c ts
h a 0 c (2:ts) = 2 + h a 0 c ts
h a b c (2:ts) = h a (b - 1) c ts

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

main = print . solve . map read . tail . words =<< getContents

solve (a_:b_:ts_) = ans where
    ans = go 0 0 a_ b_ ts_
    go r _ _ _ []     = r
    go r 0 0 0 ts     = r + sum ts
    go r d 0 0 (1:ts) = go r (d-1) 0 0 ts
    go r d 0 b (1:ts) = go r (d+1) 0 (b-1) ts
    go r d a b (1:ts) = go r d (a-1) b ts
    go r d a 0 (2:ts) = go (r+2) d a 0 ts
    go r d a b (2:ts) = go r d a (b-1) ts

process a b c (1:listt)
    |(a == 0)&&(b == 0)&&(c == 0) = (process a b c listt) + 1
    |(a == 0)&&(b == 0)&&(c /= 0) = (process a b (c - 1) listt)
    |(a == 0)&&(b /= 0) = (process a (b - 1) (c + 1) listt)
    |(a /= 0) = (process (a - 1) b  c listt)

process a b c (2:listt)
    |(b == 0) = (process  a b c listt) + 2
    |(b /= 0) = (process  a (b - 1) c listt)

process _ _ _ [] = 0

solution [[n, a, b], listt] = process a b 0 listt

problem_data s = (map$map read).(map words).lines$s::[[Int]]
main = interact$(show.solution.problem_data)

{-# 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.Char8 as B

main = do
  [n, a, b] <- fmap readInts B.getLine
  ts <- fmap readInts B.getLine
  print $ solve n a b ts

solve n a b ts = (\(_, _, _, c) -> c) $ foldl go (a, 0, b, 0) ts
  where
    go (!c1, !c1', !c2, !c) t
      | t == 1 && c1 > 0 = (c1 - 1, c1', c2, c)
      | t == 1 && c2 > 0 = (c1, c1' + 1, c2 - 1, c)
      | t == 1 && c1' > 0 = (c1, c1' - 1, c2, c)
      | t == 2 && c2 > 0 = (c1, c1', c2 - 1, c)
      | otherwise = (c1, c1', c2, c + t)

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

-- words :: String -> [String] Source #
-- words breaks a string up into a list of words, which were delimited by white space.

-- read :: Read a => String -> a Source # (Here a is an int)
-- The read function reads input from a string, which must be completely consumed by the input process.

main = interact $ f

f :: String -> String
f = show . g . map read . words

g :: [Int] -> Int
-- g (n:a:b:ts) = h a b 0 ts  -- a is the number of 1-person tables,
-- b is the number of 2-person tables, c is the number of 2-person tables with 1 person
-- colon prepends a scalar to the front of a vector
g x = h (g_a x) (g_b x) 0 (g_ts x)

g_a :: [Int] -> Int
g_a x = head (tail x)

g_b :: [Int] -> Int
g_b x = head (tail (tail x))

g_ts :: [Int] -> [Int]
g_ts x = tail (tail (tail x))

h :: Int -> Int -> Int -> [Int] -> Int
h a b c ts =
    if ts == []
    then 0
    else if head ts == 1
         then (if a > 0
               then h (a-1) b c (tail ts)
               else (if b > 0
                     then h a (b-1) (c+1) (tail ts)
                     else (if c > 0
                           then h a b (c-1) (tail ts)
                           else 1 + h a b c (tail ts))))   --Each bracket () contains *one* value
         else -- i.e. else if head ts == 2
              if b > 0
              then h a (b-1) c (tail ts)
              else 2 + h a b c (tail ts)

-- words :: String -> [String] Source #
-- words breaks a string up into a list of words, which were delimited by white space.

-- read :: Read a => String -> a Source # (Here a is an int)
-- The read function reads input from a string, which must be completely consumed by the input process.

main = interact $ f

f :: String -> String
f = show . g . map read . words

g :: [Int] -> Int
g (n:a:b:ts) = h a b 0 ts  -- a is the number of 1-person tables,
-- b is the number of 2-person tables, c is the number of 2-person tables with 1 person

h :: Int -> Int -> Int -> [Int] -> Int
h a b c ts =
    if ts == []
    then 0
    else if head ts == 1
         then (if a > 0
               then h (a-1) b c (tail ts)
               else (if b > 0
                     then h a (b-1) (c+1) (tail ts)
                     else (if c > 0
                           then h a b (c-1) (tail ts)
                           else 1 + h a b c (tail ts))))   --Each bracket () contains *one* value
         else -- i.e. else if head ts == 2
              if b > 0
              then h a (b-1) c (tail ts)
              else 2 + h a b c (tail ts)

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

main = print . solve . map read . words =<< getContents

solve (n:a_:b_:ts_) = ans where
    ans = if n /= length ts_ then -1 else go 0 a_ b_ ts_
    go r _ _ []     = r
    go r 0 0 ts     = r + sum ts
    go r 0 b (1:ts) = go r 1 (b-1) ts
    go r a b (1:ts) = go r (a-1) b ts
    go r a 0 (2:ts) = go (r+2) a 0 ts
    go r a b (2:ts) = go r a (b-1) ts

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

main = print . solve . map read . tail . words =<< getContents

solve (a:b:ts) = go 0 a b ts where
    go r _ _ []     = r
    go r 0 0 ts     = r + sum ts
    go r 0 b (1:ts) = go r 1 (b-1) ts
    go r a b (1:ts) = go r (a-1) b ts
    go r a 0 (2:ts) = go (r+2) a 0 ts
    go r a b (2:ts) = go r a (b-1) ts

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

main = print . solve . map read . tail . words =<< getContents

solve (a:b:ts) = go 0 a b ts where
    go r _ _ []     = r
    go r 0 0 (1:ts) = r + sum ts
    go r 0 b (1:ts) = go r 1 (b-1) ts
    go r a b (1:ts) = go r (a-1) b ts
    go r a 0 (2:ts) = go (r+2) a b ts
    go r a b (2:ts) = go r a (b-1) ts

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

main = print . solve . map read . tail . words =<< getContents

solve (a_:b_:ts_) = go 0 a_ b_ ts_ where
    go r _ _ []     = r
    go r 0 0 (p:ts) = go (r+p) 0 0 ts
    go r 0 b (1:ts) = go r 1 (b-1) ts
    go r a b (1:ts) = go r (a-1) b ts
    go r a 0 (2:ts) = go (r+2) a 0 ts
    go r a b (2:ts) = go r a (b-1) ts

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

main = print . solve . map read . tail . words =<< getContents

solve (a:b:ts) = go 0 a b ts where
    go r _ _ []     = r
    go r 0 0 (1:ts) = r + 1 + sum ts
    go r 0 b (1:ts) = go r 1 (b-1) ts
    go r a b (1:ts) = go r (a-1) b ts
    go r a 0 (2:ts) = go (r+2) a b ts
    go r a b (2:ts) = go r a (b-1) ts

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

main = print . solve . map read . tail . words =<< getContents

solve (a_:b_:ts_) = go 0 a_ b_ ts_ where
    go r _ _ []     = r
    go r 0 0 ts     = r + sum ts
    go r 0 b (1:ts) = go r 1 (b-1) ts
    go r a b (1:ts) = go r (a-1) b ts
    go r a 0 (2:ts) = go (r+2) a 0 ts
    go r a b (2:ts) = go r a (b-1) ts


You are given a string $$$s$$$ consisting of $$$n$$$ lowercase Latin letters.Let's define a substring as a contiguous subsegment of a string. For example, "acab" is a substring of "abacaba" (it starts in position $$$3$$$ and ends in position $$$6$$$), but "aa" or "d" aren't substrings of this string. So the substring of the string $$$s$$$ from position $$$l$$$ to position $$$r$$$ is $$$s[l; r] = s_l s_{l + 1} \dots s_r$$$.You have to choose exactly one of the substrings of the given string and reverse it (i. e. make $$$s[l; r] = s_r s_{r - 1} \dots s_l$$$) to obtain a string that is less lexicographically. Note that it is not necessary to obtain the minimum possible string.If it is impossible to reverse some substring of the given string to obtain a string that is less, print "NO". Otherwise print "YES" and any suitable substring.String $$$x$$$ is lexicographically less than string $$$y$$$, if either $$$x$$$ is a prefix of $$$y$$$ (and $$$x \ne y$$$), or there exists such $$$i$$$ ($$$1 \le i \le min(|x|, |y|)$$$), that $$$x_i < y_i$$$, and for any $$$j$$$ ($$$1 \le j < i$$$) $$$x_j = y_j$$$. Here $$$|a|$$$ denotes the length of the string $$$a$$$. The lexicographic comparison of strings is implemented by operator < in modern programming languages.

The first line of the input contains one integer $$$n$$$ ($$$2 \le n \le 3 \cdot 10^5$$$) — the length of $$$s$$$. The second line of the input contains the string $$$s$$$ of length $$$n$$$ consisting only of lowercase Latin letters.

If it is impossible to reverse some substring of the given string to obtain a string which is lexicographically less, print "NO". Otherwise print "YES" and two indices $$$l$$$ and $$$r$$$ ($$$1 \le l < r \le n$$$) denoting the substring you have to reverse. If there are multiple answers, you can print any.

NoteIn the first testcase the resulting string is "aacabba".

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	getLine
	s <- getLine
	let
		res = solve ( 1 :: Int ) s
	case res of
		Nothing -> putStrLn "NO"
		Just res -> do
			putStrLn "YES"
			printf "%d %d\n" res $ succ res

solve _ [] = Nothing
solve _ [_] = Nothing
solve pos (a:b:s)
	| a > b = Just pos
	| otherwise = solve ( succ pos ) (b:s)

import Data.Maybe
main :: IO ()
main = do
  _ <- getLine
  s <- getLine
  case solve s of
    Nothing -> putStrLn "NO"
    Just i -> do
      putStrLn "YES"
      putStrLn $ (unwords.map show) [i,i+1]

solve :: String -> Maybe Int
solve s = (\(_,_,c) -> c) <$> m
  where m = listToMaybe $ filter (\(x,y,_) -> x>y) $ zip3 s (tail s) [(1::Int)..]

main = getLine >> getLine >>= answer

answer xs
    | n == 0 = putStrLn "NO"
    | otherwise = putStrLn $ "YES\n" ++ show n ++ " " ++ (show $ n + 1)
    where n = solve 0 (pred 'a') xs

solve _ _ [] = 0
solve n c (x:xs) = if c <= x then solve (n+1) x xs else n

import Control.Monad
-- import Data.List.HT      (mapAdjacent)

mapAdjacent :: (a -> a -> b) -> [a] -> [b]
mapAdjacent f xs = zipWith f xs (tail xs)

solve :: String -> String
solve s
    | c + 1 == length s = "NO"
    | otherwise         = "YES\n" ++ show (c+1) ++ " " ++ show (c+2)
        where c = length $ takeWhile (==False) $ mapAdjacent (>) s

main :: IO ()
main = do
    _ <- getLine
    s <- getLine
    putStrLn $ solve s

import Data.List

main :: IO ()
main = do
    n <- getLine
    s <- getLine
    putStrLn $ f2 $ h (f s) s
    return ()
{-
f :: String -> Maybe Int
f s =let r = reverse s in
     elemIndex True $ map (\x -> (compare x s)==LT) (tails r)

c :: Int -> Maybe Int -> String
c n (Just x) ="YES\n"++(show (n-x))++" "++(show n)
c n Nothing = "NO"
-}
f :: String -> Maybe Char
f (x:y:ys) =if x>y then Just (x) else f (y:ys)
f (y:ys) = Nothing

h :: Maybe Char -> String -> Maybe Int
h Nothing _ = Nothing
h (Just x) s = elemIndex x s

f2 :: Maybe Int -> String
f2 Nothing = "NO"
f2 (Just (x)) = "YES\n"++(show x)++" "++(show (x+1))

import Data.List

main :: IO ()
main = do
    n <- getLine
    s <- getLine
    putStrLn $ f2 $ h (f s) s
    return ()
{-
f :: String -> Maybe Int
f s =let r = reverse s in
     elemIndex True $ map (\x -> (compare x s)==LT) (tails r)

c :: Int -> Maybe Int -> String
c n (Just x) ="YES\n"++(show (n-x))++" "++(show n)
c n Nothing = "NO"
-}
f :: String -> Maybe Char
f (x:y:ys) =if x>y then Just (x) else f (y:ys)
f (y:ys) = Nothing

h :: Maybe Char -> String -> Maybe Int
h Nothing _ = Nothing
h (Just x) s = elemIndex x s

f2 :: Maybe Int -> String
f2 Nothing = "NO"
f2 (Just (x)) = "YES\n"++(show (x+1))++" "++(show (x+1+1))

import Control.Monad
-- import Data.List.HT (mapAdjacent)

mapAdjacent :: (a -> a -> b) -> [a] -> [b]
mapAdjacent f xs = zipWith f xs (tail xs)

solve :: String -> String
solve s
    | c + 1 == length s = "NO"
    | otherwise         = "YES\n" ++ show (c+1) ++ " " ++ show (c+2)
        where c = length $ takeWhile (==False) $ mapAdjacent (>) s

main :: IO ()
main = do
    s <- getLine
    putStrLn $ solve s


Pay attention to the non-standard memory limit in this problem.In order to cut off efficient solutions from inefficient ones in this problem, the time limit is rather strict. Prefer to use compiled statically typed languages (e.g. C++). If you use Python, then submit solutions on PyPy. Try to write an efficient solution.The array $$$a=[a_1, a_2, \ldots, a_n]$$$ ($$$1 \le a_i \le n$$$) is given. Its element $$$a_i$$$ is called special if there exists a pair of indices $$$l$$$ and $$$r$$$ ($$$1 \le l < r \le n$$$) such that $$$a_i = a_l + a_{l+1} + \ldots + a_r$$$. In other words, an element is called special if it can be represented as the sum of two or more consecutive elements of an array (no matter if they are special or not).Print the number of special elements of the given array $$$a$$$.For example, if $$$n=9$$$ and $$$a=[3,1,4,1,5,9,2,6,5]$$$, then the answer is $$$5$$$:  $$$a_3=4$$$ is a special element, since $$$a_3=4=a_1+a_2=3+1$$$;  $$$a_5=5$$$ is a special element, since $$$a_5=5=a_2+a_3=1+4$$$;  $$$a_6=9$$$ is a special element, since $$$a_6=9=a_1+a_2+a_3+a_4=3+1+4+1$$$;  $$$a_8=6$$$ is a special element, since $$$a_8=6=a_2+a_3+a_4=1+4+1$$$;  $$$a_9=5$$$ is a special element, since $$$a_9=5=a_2+a_3=1+4$$$. Please note that some of the elements of the array $$$a$$$ may be equal — if several elements are equal and special, then all of them should be counted in the answer.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. Each test case is given in two lines. The first line contains an integer $$$n$$$ ($$$1 \le n \le 8000$$$) — the length of the array $$$a$$$. The second line contains integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$). It is guaranteed that the sum of the values of $$$n$$$ for all test cases in the input does not exceed $$$8000$$$.

Print $$$t$$$ numbers — the number of special elements for each of the given arrays.

import Control.Monad
import Data.Array.IO.Safe
import Data.Array.Unboxed
import Data.List
import qualified Data.IntSet as IntSet
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

c n k = product [n-k+1..n] `div` product [1..k]

_mod = 1000000007

main = do
  [t] <- input
  replicateM_ t $ do
    [n] <- input
    a <- input
    let suffixSums = listArray (1, n+1) $ scanr (+) 0 a :: UArray Int Int
    good <- newArray (1, n) False :: IO (IOUArray Int Bool)
    forM_ [1..n+1] $ \i -> forM_ [i+2..n+1] $ \j -> do
      let d = suffixSums!i - suffixSums!j
      if d <= n then writeArray good d True else return ()
    good' <- freeze good :: IO (UArray Int Bool)
    print $ length $ filter (good'!) a

import qualified Data.IntSet as IS
import Data.IntSet (IntSet)

subSums :: Int -> [Int] -> IntSet
--subSums n (a1:a2:as) = IS.union (prefixSums n a1 (a2:as)) $ subSums n (a2:as)
subSums _ [_] = IS.empty
subSums n as = IS.unions $ suffixLists as
    where
        suffixLists [_] = []
        suffixLists lst = getPSums lst:suffixLists (tail lst)
        getPSums (l:ls) = IS.fromDistinctAscList $ prefixSums n l ls

prefixSums :: Int -> Int -> [Int] -> [Int]
prefixSums n offset [] = []
prefixSums n offset (a:as)
    | (offset+a) <= n = (offset+a) : prefixSums n (offset+a) as
    | otherwise     = []

solve :: [Int] -> Int
solve as = length $ filter (`IS.member` sums) as
    where sums = subSums (length as) as

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

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

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

import qualified Data.IntSet as IS
import Data.IntSet (IntSet)

subSums :: Int -> [Int] -> IntSet
--subSums n (a1:a2:as) = IS.union (prefixSums n a1 (a2:as)) $ subSums n (a2:as)
subSums _ [_] = IS.empty
subSums n as = IS.unions $ suffixLists as
    where
        suffixLists [_] = []
        suffixLists lst = getPSums lst:suffixLists (tail lst)
        getPSums (l:ls) = IS.fromDistinctAscList $ reverse $ prefixSums n l ls

prefixSums :: Int -> Int -> [Int] -> [Int]
prefixSums n offset [] = [0]
prefixSums n offset (a:as)
    | (offset+a) <= n = (offset+a) : prefixSums n (offset+a) as
    | otherwise     = []

solve :: [Int] -> Int
solve as = length $ filter (`IS.member` sums) as
    where sums = subSums (length as) as

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

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

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