Along the railroad there are stations indexed from $$$1$$$ to $$$10^9$$$. An express train always travels along a route consisting of $$$n$$$ stations with indices $$$u_1, u_2, \dots, u_n$$$, where ($$$1 \le u_i \le 10^9$$$). The train travels along the route from left to right. It starts at station $$$u_1$$$, then stops at station $$$u_2$$$, then at $$$u_3$$$, and so on. Station $$$u_n$$$ — the terminus.It is possible that the train will visit the same station more than once. That is, there may be duplicates among the values $$$u_1, u_2, \dots, u_n$$$.You are given $$$k$$$ queries, each containing two different integers $$$a_j$$$ and $$$b_j$$$ ($$$1 \le a_j, b_j \le 10^9$$$). For each query, determine whether it is possible to travel by train from the station with index $$$a_j$$$ to the station with index $$$b_j$$$.For example, let the train route consist of $$$6$$$ of stations with indices [$$$3, 7, 1, 5, 1, 4$$$] and give $$$3$$$ of the following queries:   $$$a_1 = 3$$$, $$$b_1 = 5$$$It is possible to travel from station $$$3$$$ to station $$$5$$$ by taking a section of the route consisting of stations [$$$3, 7, 1, 5$$$]. Answer: YES.  $$$a_2 = 1$$$, $$$b_2 = 7$$$You cannot travel from station $$$1$$$ to station $$$7$$$ because the train cannot travel in the opposite direction. Answer: NO.  $$$a_3 = 3$$$, $$$b_3 = 10$$$It is not possible to travel from station $$$3$$$ to station $$$10$$$ because station $$$10$$$ is not part of the train's route. Answer: NO.

The first line of the input contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) —the number of test cases in the test. The descriptions of the test cases follow. The first line of each test case is empty. The second line of each test case contains two integers: $$$n$$$ and $$$k$$$ ($$$1 \le n \le 2 \cdot 10^5, 1 \le k \le 2 \cdot 10^5$$$) —the number of stations the train route consists of and the number of queries. The third line of each test case contains exactly $$$n$$$ integers $$$u_1, u_2, \dots, u_n$$$ ($$$1 \le u_i \le 10^9$$$). The values $$$u_1, u_2, \dots, u_n$$$ are not necessarily different. The following $$$k$$$ lines contain two different integers $$$a_j$$$ and $$$b_j$$$ ($$$1 \le a_j, b_j \le 10^9$$$) describing the query with index $$$j$$$. It is guaranteed that the sum of $$$n$$$ values over all test cases in the test does not exceed $$$2 \cdot 10^5$$$. Similarly, it is guaranteed that the sum of $$$k$$$ values over all test cases in the test also does not exceed $$$2 \cdot 10^5$$$

For each test case, output on a separate line:   YES, if you can travel by train from the station with index $$$a_j$$$ to the station with index $$$b_j$$$ NO otherwise.  You can output YES and NO in any case (for example, strings yEs, yes, Yes and YES will be recognized as a positive response).

NoteThe first test case is explained in the problem statement.

module Main where

import Data.List
import Data.Maybe
import qualified Data.IntMap.Strict as M

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let problems = take t $ sep $ lines input
  let sols = problems >>= (map format . solve . parse)
  mapM_ putStrLn sols

sep [] = []
sep (_:x:y:xs) = (y,h):(sep t)
  where (h,t) = splitAt (read $ last $ words x) xs

parse :: (String, [String]) -> ([Int],[(Int,Int)])
parse (y,h) = (us,qs)
  where us = map read $ words y
        qs = map parseQ $ h
        parseQ = first2 . (map read) . words
        first2 (a:b:_) = (a,b)

format b
  | b = "YES"
  | otherwise = "NO"

solve (us,qs) = map (solve1 fs) qs
  where fs = M.fromListWith phi $ zip us (map dupe [0..])
        dupe x = (x,x)
        phi (x1,y1) (x2,y2) = (min x1 x2, max x1 x2)

solve1 fs (a,b)
  | Just (i,_) <- s, Just (_,j) <- t = i < j
  | otherwise = False
  where [s,t] = map (fs M.!?) [a,b]

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# LANGUAGE Safe                #-}
{-# LANGUAGE ImportQualifiedPost #-}

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L
import Data.Map.Strict       qualified as Map
import Data.Maybe

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

showYN False = "NO"
showYN True  = "YES"

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        []      <-              ri
        [_n,k]  <-              ri
        us      <-              ri
        qs      <- replicateM k ri
        return (us, qs)
    mapM_ (putStr . unlines . map showYN . solve) tcs

solve (us, qs) = map reachable qs
  where
    rt = Map.fromListWith minMax . (`zip`dinds) $ us

    (!?) = (Map.!?)
    reachable [a,b] = fromMaybe False $ liftA2 isOrdered (rt!?a) (rt!?b)
    reachable _     = error "Pair expected in query"

    isOrdered (leMin,_leMax) (_riMin,riMax) = (leMin <= riMax)

inds = [0..] :: [Int]
dinds = map (id &&& id) inds

minMax (a,b) (c,d) = (min a c, max b d)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.State
import Data.Bool
import qualified Data.ByteString.Char8 as C
import Data.Containers.ListUtils
import Data.List
import qualified Data.Map.Lazy as M
import Data.Maybe

solve :: ([Integer], [(Integer, Integer)]) -> [Bool]
solve (us, qs) = map solve' qs
 where
  us' = nubOrd us
  usrev = reverse us
  n = length us

  fs = M.fromList $ zip usrev [n - 1, n - 2 ..]
  ls = M.fromList $ zip us [0 ..]

  solve' (a, b) = case (<=) <$> fs M.!? a <*> ls M.!? b of
    Just True -> True
    _ -> False

main :: IO ()
main = C.interact $ C.unlines . map (output . solve) . runScanner (numberOf input)

input :: Scanner ([Integer], [(Integer, Integer)])
input = do
  n <- int
  k <- int
  us <- n >< integer
  qs <- k >< ((,) <$> integer <*> integer)
  pure (us, qs)

output :: [Bool] -> C.ByteString
output = C.intercalate "\n" . map (bool "NO" "YES")

type Scanner = State [C.ByteString]

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

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith sp sc = evalState sc . sp

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

read' :: (C.ByteString -> Maybe (a, C.ByteString)) -> Scanner a
read' q = fst . fromJust . q <$> bstr

int :: Scanner Int
int = read' C.readInt

integer :: Scanner Integer
integer = read' C.readInteger

(><) :: Int -> Scanner a -> Scanner [a]
(><) = replicateM

numberOf :: Scanner a -> Scanner [a]
numberOf = (int >>=) . flip (><)

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
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.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x

-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

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

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

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

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: Int -> Int -> [Int] -> [(Int, Int)] -> [Bool]
solve n k stations queries = map query' queries
    where
        minStationIndices :: IM.IntMap Int
        minStationIndices = IM.fromListWith min $ L.zip stations [1 .. n]

        maxStationIndices :: IM.IntMap Int
        maxStationIndices = IM.fromListWith max $ L.zip stations [1 .. n]

        query' :: (Int, Int) -> Bool
        query' (from, to) = fromMaybe False $ do
            minFromIndex <- IM.lookup from minStationIndices
            maxToIndex <- IM.lookup to maxStationIndices
            return $ minFromIndex <= maxToIndex

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        B8.getLine
        [n, k] <- B8.getLine <&> readIntB8s
        stations <- B8.getLine <&> readIntB8s
        queries <- replicateM k $ do
            [from, to] <- B8.getLine <&> readIntB8s
            return (from, to)
        let answers = solve n k stations queries
        forM_ answers putsYesNo


Iahub and Iahubina went to a date at a luxury restaurant. Everything went fine until paying for the food. Instead of money, the waiter wants Iahub to write a Hungry sequence consisting of n integers. A sequence a1, a2, ..., an, consisting of n integers, is Hungry if and only if:   Its elements are in increasing order. That is an inequality ai < aj holds for any two indices i, j (i < j).  For any two indices i and j (i < j), aj must not be divisible by ai. Iahub is in trouble, so he asks you for help. Find a Hungry sequence with n elements.

The input contains a single integer: n (1 ≤ n ≤ 105).

Output a line that contains n space-separated integers a1 a2, ..., an (1 ≤ ai ≤ 107), representing a possible Hungry sequence. Note, that each ai must not be greater than 10000000 (107) and less than 1. If there are multiple solutions you can output any one.

main :: IO ()
main = do
  n <- fmap read getLine
  putStrLn $ unwords $ map show $ take n [n ..]

import Control.Applicative((<$>))

main :: IO ()
main = unwords <$> map show <$> (\x -> take x $ [x..]) <$> read <$> getLine >>= putStrLn

import Data.List (intercalate)

main :: IO ()
main  =  do
    n  <-  readLn
    putStrLn $ intercalate " " $ map show [n + 1 .. 2 * n]

{-# LANGUAGE ScopedTypeVariables #-}

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Array.ST.Safe as A
import Control.Monad.ST.Safe
import Prelude
import qualified Data.ByteString.Char8 as B8

readInt :: String -> Int
readInt = Prelude.read

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

solve :: Int -> [Int]
solve n = take n [(n + 1) ..]

main :: IO ()
main = do
    n <- readB8Int <$> B8.getLine
    let answer = solve n
    forM_ answer $ printf "%d "

main :: IO ()
main = readLn >>= putStrLn . unwords . map show . solve

solve :: Integer -> [Integer]
solve n = [n .. 2 * n - 1]

main=interact$unwords.map show.f.read
f n=[n..2*n-1]

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray)

main = do
  n <- readLn
  putStr.unwords.map show $ take n primes

primes :: [Int]
primes =  2:[2*i+1|i<-[1.. 10000000 `quot`2], unsafeAt isPrime i]
   where
     !lim = (10000000 + 0xfffff * 0xfffff -1)`quot` 0xfffff * 0xfffff
     !isPrime = runSTUArray $ do
       isp <- newArray (0,lim`quot`2) True :: ST s (STUArray s Int Bool)
       forM_ [0, 0xfffff ..lim - 0xfffff] $ \l-> do
         let !l2 = l`quot`2
             !r  = l + 0xfffff
             !r2 = r`quot`2
         forM_ [1..intSqrt r`quot`2] $ \i-> do
           flg <- unsafeRead isp i
           when flg $ do
             let !p = 2*i+1
                 !ip1=i*(p+1)
                 go !i = when (i<r2) $ do
                   unsafeWrite isp i False
                   go $ i+p
             go $ ((l2-ip1+p-1)`quot`p)*p + ip1
       return isp

intSqrt :: Int -> Int
intSqrt x = floor . sqrt $ fromIntegral x

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

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

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

getInt :: IO Int
getInt = readInt <$> C.getLine

main :: IO ()
main = do
  n <- getInt
  putStrLn $ unwords $ map show $ take n [n..]

#!/usr/bin/env runghc
main = do
  c <- getContents
  putStr . unlines . solve . lines $ c

solve::[String]->[String]
solve (n:ns) = [unwords . map show . take (read n) $ p]
p = 2:f [3] [3,5..]
    where f (x:xs) ys = let (ps, qs) = span (< x^2) ys
                        in  ps ++ f (xs ++ ps) [z | z <- qs, mod z x /= 0]

module Main where

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  putStrLn $ rush n

large :: Int
large = 1000000

rush :: Int -> String
rush n = (unwords . map show) [(large - n  + 1)..large]


Acacius is studying strings theory. Today he came with the following problem.You are given a string $$$s$$$ of length $$$n$$$ consisting of lowercase English letters and question marks. It is possible to replace question marks with lowercase English letters in such a way that a string "abacaba" occurs as a substring in a resulting string exactly once?Each question mark should be replaced with exactly one lowercase English letter. For example, string "a?b?c" can be transformed into strings "aabbc" and "azbzc", but can't be transformed into strings "aabc", "a?bbc" and "babbc".Occurrence of a string $$$t$$$ of length $$$m$$$ in the string $$$s$$$ of length $$$n$$$ as a substring is a index $$$i$$$ ($$$1 \leq i \leq n - m + 1$$$) such that string $$$s[i..i+m-1]$$$ consisting of $$$m$$$ consecutive symbols of $$$s$$$ starting from $$$i$$$-th equals to string $$$t$$$. For example string "ababa" has two occurrences of a string "aba" as a substring with $$$i = 1$$$ and $$$i = 3$$$, but there are no occurrences of a string "aba" in the string "acba" as a substring.Please help Acacius to check if it is possible to replace all question marks with lowercase English letters in such a way that a string "abacaba" occurs as a substring in a resulting string exactly once.

First line of input contains an integer $$$T$$$ ($$$1 \leq T \leq 5000$$$), number of test cases. $$$T$$$ pairs of lines with test case descriptions follow. The first line of a test case description contains a single integer $$$n$$$ ($$$7 \leq n \leq 50$$$), length of a string $$$s$$$. The second line of a test case description contains string $$$s$$$ of length $$$n$$$ consisting of lowercase English letters and question marks.

For each test case output an answer for it. In case if there is no way to replace question marks in string $$$s$$$ with a lowercase English letters in such a way that there is exactly one occurrence of a string "abacaba" in the resulting string as a substring output "No". Otherwise output "Yes" and in the next line output a resulting string consisting of $$$n$$$ lowercase English letters. If there are multiple possible strings, output any. You may print every letter in "Yes" and "No" in any case you want (so, for example, the strings yEs, yes, Yes, and YES will all be recognized as positive answer).

6
7
abacaba
7
???????
11
aba?abacaba
11
abacaba?aba
15
asdf???f???qwer
11
abacabacaba

Yes
abacaba
Yes
abacaba
Yes
abadabacaba
Yes
abacabadaba
No
No

NoteIn first example there is exactly one occurrence of a string "abacaba" in the string "abacaba" as a substring.In second example seven question marks can be replaced with any seven lowercase English letters and with "abacaba" in particular.In sixth example there are two occurrences of a string "abacaba" as a substring.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}

import Text.Printf
import Data.List
import Data.Functor
import Data.Bifunctor (bimap)
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.IArray
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad.State.Strict
import Data.Int
import Data.Tree
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

pattern :: B8.ByteString
pattern = "abacaba"

matchPattern :: B8.ByteString -> Bool
matchPattern string = and $ B8.zipWith (\patternChar stringChar -> (patternChar == stringChar) || (stringChar == '?')) pattern $ string

patternCounts :: B8.ByteString -> Int
patternCounts string = length $ filter (\tail -> pattern == B8.take (B8.length pattern) tail) . B8.tails $ string

fixString :: B8.ByteString -> B8.ByteString
fixString string = B8.map substitute string
    where
        substitute :: Char -> Char
        substitute '?' = 'z'
        substitute a = a

solve :: Int -> B8.ByteString -> Maybe B8.ByteString
solve stringLength string = find (\string -> patternCounts string == 1) validStrings
    where
        stringPrefix :: Int -> B8.ByteString
        stringPrefix index = B8.take index string

        stringSubstring :: Int -> B8.ByteString
        stringSubstring index = B8.take (B8.length pattern) . B8.drop index $ string

        stringSuffix :: Int -> B8.ByteString
        stringSuffix index = B8.drop (index + B8.length pattern) string

        splits :: [(B8.ByteString, B8.ByteString, B8.ByteString)]
        splits = (flip map) [0..(stringLength - B8.length pattern)] $ \index -> (stringPrefix index, stringSubstring index, stringSuffix index)

        validStrings :: [B8.ByteString]
        validStrings = map (\(prefix, _, suffix) -> B8.concat [fixString prefix, pattern, fixString suffix]) . filter (\(_, substring, _) -> matchPattern substring) $ splits

main :: IO ()
main = do
    testCount <- readB8Int <$> B8.getLine
    replicateM_ testCount $ do
        stringLength <- readB8Int <$> B8.getLine
        string <- B8.getLine
        let answer = solve stringLength string
        case answer of
            Just answer -> printf "Yes\n%s\n" $ B8.unpack answer
            Nothing -> printf "No\n"


Chef Monocarp has just put $$$n$$$ dishes into an oven. He knows that the $$$i$$$-th dish has its optimal cooking time equal to $$$t_i$$$ minutes.At any positive integer minute $$$T$$$ Monocarp can put no more than one dish out of the oven. If the $$$i$$$-th dish is put out at some minute $$$T$$$, then its unpleasant value is $$$|T - t_i|$$$ — the absolute difference between $$$T$$$ and $$$t_i$$$. Once the dish is out of the oven, it can't go back in.Monocarp should put all the dishes out of the oven. What is the minimum total unpleasant value Monocarp can obtain?

The first line contains a single integer $$$q$$$ ($$$1 \le q \le 200$$$) — the number of testcases. Then $$$q$$$ testcases follow. The first line of the testcase contains a single integer $$$n$$$ ($$$1 \le n \le 200$$$) — the number of dishes in the oven. The second line of the testcase contains $$$n$$$ integers $$$t_1, t_2, \dots, t_n$$$ ($$$1 \le t_i \le n$$$) — the optimal cooking time for each dish. The sum of $$$n$$$ over all $$$q$$$ testcases doesn't exceed $$$200$$$.

Print a single integer for each testcase — the minimum total unpleasant value Monocarp can obtain when he puts out all the dishes out of the oven. Remember that Monocarp can only put the dishes out at positive integer minutes and no more than one dish at any minute.

NoteIn the first example Monocarp can put out the dishes at minutes $$$3, 1, 5, 4, 6, 2$$$. That way the total unpleasant value will be $$$|4 - 3| + |2 - 1| + |4 - 5| + |4 - 4| + |6 - 5| + |2 - 2| = 4$$$.In the second example Monocarp can put out the dishes at minutes $$$4, 5, 6, 7, 8, 9, 10$$$.In the third example Monocarp can put out the dish at minute $$$1$$$.In the fourth example Monocarp can put out the dishes at minutes $$$5, 1, 2, 4, 3$$$.In the fifth example Monocarp can put out the dishes at minutes $$$1, 3, 4, 5$$$.

import Control.Arrow ((>>>))
import Data.List (sort)

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

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve = minimum . foldl upd (replicate 201 0) . sort
  where
    upd dp x = scanl1 min . zipWith (+) (inf : dp) . map (abs . (x -)) $ [0 ..]
    inf = 10 ^ 9

import Control.Arrow ((>>>))
import Data.List (sort)

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

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve = minimum . foldl upd (replicate 201 0) . sort

upd dp x = scanl1 min . zipWith (+) (inf : dp) . map (abs . (x -)) $ [0 ..] {- -}

inf = 10 ^ 9


Max wants to buy a new skateboard. He has calculated the amount of money that is needed to buy a new skateboard. He left a calculator on the floor and went to ask some money from his parents. Meanwhile his little brother Yusuf came and started to press the keys randomly. Unfortunately Max has forgotten the number which he had calculated. The only thing he knows is that the number is divisible by 4.You are given a string s consisting of digits (the number on the display of the calculator after Yusuf randomly pressed the keys). Your task is to find the number of substrings which are divisible by 4. A substring can start with a zero.A substring of a string is a nonempty sequence of consecutive characters.For example if string s is 124 then we have four substrings that are divisible by 4: 12, 4, 24 and 124. For the string 04 the answer is three: 0, 4, 04.As input/output can reach huge size it is recommended to use fast input/output methods: for example, prefer to use gets/scanf/printf instead of getline/cin/cout in C++, prefer to use BufferedReader/PrintWriter instead of Scanner/System.out in Java.

The only line contains string s (1 ≤ |s| ≤ 3·105). The string s contains only digits from 0 to 9.

Print integer a — the number of substrings of the string s that are divisible by 4. Note that the answer can be huge, so you should use 64-bit integer type to store it. In C++ you can use the long long integer type and in Java you can use long integer type.

{-# OPTIONS_GHC -O2 #-}

import Data.List (tails)
import Data.Char (ord)
import Data.Int (Int64)

main = do
  s <- getLine

  let
    r = sum $ map f $ zip (init $ tails $ reverse s) (reverse [1..length s])
      where
        f :: (String, Int) -> Int64
        f ([a], i) = if (ord a - 48) `mod` 4 == 0 then 1 else 0
        f ((a:b:_), l) =
          (if (ord a - 48) `mod` 4 == 0 then 1 else 0) +
            (if ((ord b - 48) * 10 + ord a - 48) `mod` 4 == 0 then (fromIntegral l) - 1 else 0)

  print r

import Data.List
main=interact$show.f.map ((read::String->Int).(:[])).reverse.head.lines
f::[Int]->Integer
f a=p a 0 (toInteger(length a))
p::[Int]->Integer->Integer->Integer
p [a] b _=if mod a 4 == 0 then (b+1) else b
p (a:b:c) d e=if mod a 4 == 0 then (if mod (a+b*10) 4 == 0 then p (b:c) (d+e) (e-1) else p (b:c) (d+1) (e-1))else(if mod (a+b*10) 4 == 0 then p (b:c) (d+e-1) (e-1) else p (b:c) d (e-1))

import Data.List
main=interact$show.f.map (read.(:[])).reverse.head.lines
f::[Int]->Integer
f a=p a 0 (toInteger(length a))
p [a] b _=if mod a 4 == 0 then (b+1) else b
p (a:b:c) d e=if mod a 4 == 0 then (if mod (a+b*10) 4 == 0 then p (b:c) (d+e) (e-1) else p (b:c) (d+1) (e-1))else(if mod (a+b*10) 4 == 0 then p (b:c) (d+e-1) (e-1) else p (b:c) d (e-1))

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function
import           Data.Array.Unboxed
-- import           Data.ByteString (ByteString)
-- import qualified Data.ByteString.Char8 as C
-- import           Data.ByteString.Char8 ()
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S

myread = fromIntegral::Int -> Int64
main = do
  s <- map (myread . digitToInt) <$> getLine
  print $ solve s

solve :: [Int64] -> Int64
solve xs = go (reverse xs) 0 (pred . myread $! length xs) where
  go [x] v _ = v + divisible x
  go (x:y:xs) v l = go (y:xs) (v + divisible x + if (x+10*y)`mod`4==0 then l else 0::Int64) (pred l)
  divisible x = if x`mod`4==0 then 1::Int64 else 0::Int64

import qualified Data.ByteString.Char8 as B
import Control.Applicative

main = interact $ show . sol . head . words

sol nums = l1+l2
    where
    l1 :: Integer
    l1 = fromIntegral . length . filter (\c -> c == '0' || c == '4' || c == '8') $ nums
    idxs _ [] = []
    idxs _ [_] = []
    idxs idx (a:b:xs)
        | (read $ [a, b]) `mod` 4 == 0 = idx:(idxs (idx+1) (b:xs))
        | otherwise = idxs (idx+1) (b:xs)
    fidx = idxs 1 nums
    l2 :: Integer
    l2 = sum fidx

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

main = do
    nums' <- B.unpack <$> B.getLine
    let nums = filter isDigit nums'
    let
        l1 :: Integer
        l1 = fromIntegral . length . filter (\c -> c == '0' || c == '4' || c == '8') $ nums
        idxs _ [] = []
        idxs _ [_] = []
        idxs idx (a:b:xs)
            | (read $ [a, b]) `mod` 4 == 0 = idx:(idxs (idx+1) (b:xs))
            | otherwise = idxs (idx+1) (b:xs)
        fidx = idxs 1 nums
        l2 :: Integer
        l2 = sum fidx
    putStrLn . show $ l1+l2

{-
instructions go here...
-}

module Main where
import Data.Char (ord)

solve :: String -> Integer
solve number = fst3 $ foldl aggr (0,0,0) number
  where aggr (total,pos,last2) digit = (total',pos',last2')
          where total' = total + totalInc
                pos' = pos + 1
                totalInc = if divisibleBy4 last2'
                             then   1                 -- the whole number ...xy up to pos'
                                  + max 0 (pos' - 2)  -- all prefixes of the xy number
                                  + if divisibleBy4 digit' && pos' >= 2
                                      then 1 -- number y
                                      else 0
                             else if divisibleBy4 digit'
                               then 1
                               else 0
                last2' = (last2 `mod` 10) * 10 + digit'
                digit' = fromIntegral $ ord digit - ord '0'
        fst3 (x,_,_) = x
        divisibleBy4 x = x `mod` 4 == 0

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

{-
5
58         -> 8
581
5810       -> 0
58104      -> 58104, 8104, 104, 04, 4
581043
5810438    -> 8
58104381
581043817
5810438174 -> 4
-}

import Data.List
main=interact$show.f.map read .group.reverse.head.lines
f::[Int]->Integer
f a=p a 0 (toInteger(length a))
p::[Int]->Integer->Integer->Integer
p [a] b _=if mod a 4 == 0 then (b+1) else b
p (a:b:c) d e=if mod a 4 == 0 then (if mod (a+b*10) 4 == 0 then p (b:c) (d+e) (e-1) else p (b:c) (d+1) (e-1))else(if mod (a+b*10) 4 == 0 then p (b:c) (d+e-1) (e-1) else p (b:c) d (e-1))

import qualified Data.ByteString.Char8 as B
import Control.Applicative

main = do
    nums <- B.unpack <$> B.getLine
    let
        l1 :: Integer
        l1 = fromIntegral . length . filter (\c -> c == '0' || c == '4' || c == '8') $ nums
        idxs _ [] = []
        idxs _ [_] = []
        idxs idx (a:b:xs)
            | (read $ [a, b]) `mod` 4 == 0 = idx:(idxs (idx+1) (b:xs))
            | otherwise = idxs (idx+1) (b:xs)
        fidx = idxs 1 nums
        l2 :: Integer
        l2 = sum fidx
    putStrLn . show $ l1+l2

import qualified Data.ByteString.Char8 as B
import Control.Applicative

main = do
    nums <- B.unpack <$> B.getLine
    let
        l1 = length . filter (\c -> c == '0' || c == '4' || c == '8') $ nums
        idxs _ [] = []
        idxs _ [_] = []
        idxs idx (a:b:xs)
            | (read $ [a, b]) `mod` 4 == 0 = idx:(idxs (idx+1) (b:xs))
            | otherwise = idxs (idx+1) (b:xs)
        fidx = idxs 1 nums
        l2 = sum fidx
    putStrLn . show $ l1+l2


Amugae has a hotel consisting of $$$10$$$ rooms. The rooms are numbered from $$$0$$$ to $$$9$$$ from left to right.The hotel has two entrances — one from the left end, and another from the right end. When a customer arrives to the hotel through the left entrance, they are assigned to an empty room closest to the left entrance. Similarly, when a customer arrives at the hotel through the right entrance, they are assigned to an empty room closest to the right entrance.One day, Amugae lost the room assignment list. Thankfully Amugae's memory is perfect, and he remembers all of the customers: when a customer arrived, from which entrance, and when they left the hotel. Initially the hotel was empty. Write a program that recovers the room assignment list from Amugae's memory.

The first line consists of an integer $$$n$$$ ($$$1 \le n \le 10^5$$$), the number of events in Amugae's memory. The second line consists of a string of length $$$n$$$ describing the events in chronological order. Each character represents:    'L': A customer arrives from the left entrance.  'R': A customer arrives from the right entrance.  '0', '1', ..., '9': The customer in room $$$x$$$ ($$$0$$$, $$$1$$$, ..., $$$9$$$ respectively) leaves.  It is guaranteed that there is at least one empty room when a customer arrives, and there is a customer in the room $$$x$$$ when $$$x$$$ ($$$0$$$, $$$1$$$, ..., $$$9$$$) is given. Also, all the rooms are initially empty.

In the only line, output the hotel room's assignment status, from room $$$0$$$ to room $$$9$$$. Represent an empty room as '0', and an occupied room as '1', without spaces.

NoteIn the first example, hotel room's assignment status after each action is as follows.   First of all, all rooms are empty. Assignment status is 0000000000.  L: a customer arrives to the hotel through the left entrance. Assignment status is 1000000000.  L: one more customer from the left entrance. Assignment status is 1100000000.  R: one more customer from the right entrance. Assignment status is 1100000001.  L: one more customer from the left entrance. Assignment status is 1110000001.  1: the customer in room $$$1$$$ leaves. Assignment status is 1010000001.  R: one more customer from the right entrance. Assignment status is 1010000011.  L: one more customer from the left entrance. Assignment status is 1110000011.  1: the customer in room $$$1$$$ leaves. Assignment status is 1010000011. So after all, hotel room's final assignment status is 1010000011.In the second example, hotel room's assignment status after each action is as follows.   L: a customer arrives to the hotel through the left entrance. Assignment status is 1000000000.  0: the customer in room $$$0$$$ leaves. Assignment status is 0000000000.  L: a customer arrives to the hotel through the left entrance. Assignment status is 1000000000 again.  0: the customer in room $$$0$$$ leaves. Assignment status is 0000000000.  L: a customer arrives to the hotel through the left entrance. Assignment status is 1000000000.  L: one more customer from the left entrance. Assignment status is 1100000000.  R: one more customer from the right entrance. Assignment status is 1100000001.  R: one more customer from the right entrance. Assignment status is 1100000011.  9: the customer in room $$$9$$$ leaves. Assignment status is 1100000010. So after all, hotel room's final assignment status is 1100000010.

import Data.List

data Event = EnterLeft | EnterRight | Leave Int
data RoomStatus = Free | Occupied deriving (Eq)
type HotelStatus = [RoomStatus]

instance Show RoomStatus where
    show Free = "0"
    show Occupied = "1"

showHotelStatus :: HotelStatus -> String
showHotelStatus [] = ""
showHotelStatus (x:xs) = (show x) ++ (showHotelStatus xs)

getEvent :: Char -> Event
getEvent ch
    | ch == 'L' = EnterLeft
    | ch == 'R' = EnterRight
    | otherwise = Leave (read [ch])

tryToOccupy :: (RoomStatus, Bool) -> (RoomStatus, Bool)
tryToOccupy original@(status, needToOccupy)
    | status == Free && needToOccupy = (Occupied, False)
    | otherwise = original

change :: Event -> HotelStatus -> HotelStatus
change EnterLeft status =
    let pairs = scanl (\(_, needed) roomStatus -> tryToOccupy (roomStatus, needed)) (Occupied, True) status
    in map fst (tail pairs)
change EnterRight status =
    let pairs = scanr (\roomStatus (_, needed) -> tryToOccupy (roomStatus, needed)) (Occupied, True) status
    in map fst (init pairs)
change (Leave roomNumber) status = map (\(num, roomStatus) -> if num == roomNumber then Free else roomStatus) (zip [0..] status)

solve :: [Event] -> HotelStatus
solve events =
    let hotelStatus = take 10 (repeat Free)
    in foldl (\status event -> change event status) hotelStatus events

main = do
    getLine
    events <- (map getEvent) <$> getLine
    putStrLn . showHotelStatus . solve $ events

import Data.Char

fromLeft ('1':rest) = '1':(fromLeft rest)
fromLeft ('0':rest) = '1':rest

update :: String -> Char -> String
update roomstates 'L'   = fromLeft roomstates
update roomstates 'R'   = reverse . fromLeft . reverse $ roomstates
update roomstates charN = leftPart ++ ['0'] ++ rightPart
                            where
                                n = ord(charN) - ord('0')
                                (splitedl, splitedr) = splitAt n roomstates
                                rightPart = tail splitedr
                                leftPart = splitedl

main :: IO ()
main = do
    getLine
    eventSeries <- getLine
    putStrLn $ foldl update "0000000000" eventSeries

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

updl x = (takeWhile (==1) x) ++[1] ++ (tail (dropWhile (==1) x))
updr x = reverse $ updl $ reverse x
upd x a  = (take a1 x) ++ [0] ++ (drop (a1+1) x)
	where a1 = digitToInt a

process x [] = x
process x (a:as) | a=='L' = process (updl x) as
                 | a=='R' = process (updr x) as
		 | otherwise = process (upd x a) as

main = do
		n<-getLine
		x<-getLine
		putStrLn $ concat $ map show $ process [0,0,0,0,0,0,0,0,0,0] x


The numbers $$$1, \, 2, \, \dots, \, n \cdot k$$$ are colored with $$$n$$$ colors. These colors are indexed by $$$1, \, 2, \, \dots, \, n$$$. For each $$$1 \le i \le n$$$, there are exactly $$$k$$$ numbers colored with color $$$i$$$.Let $$$[a, \, b]$$$ denote the interval of integers between $$$a$$$ and $$$b$$$ inclusive, that is, the set $$$\{a, \, a + 1, \, \dots, \, b\}$$$. You must choose $$$n$$$ intervals $$$[a_1, \, b_1], \, [a_2, \, b_2], \, \dots, [a_n, \, b_n]$$$ such that:   for each $$$1 \le i \le n$$$, it holds $$$1 \le a_i < b_i \le n \cdot k$$$;  for each $$$1 \le i \le n$$$, the numbers $$$a_i$$$ and $$$b_i$$$ are colored with color $$$i$$$;  each number $$$1 \le x \le n \cdot k$$$ belongs to at most $$$\left\lceil \frac{n}{k - 1} \right\rceil$$$ intervals. One can show that such a family of intervals always exists under the given constraints.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 100$$$, $$$2 \le k \le 100$$$) — the number of colors and the number of occurrences of each color. The second line contains $$$n \cdot k$$$ integers $$$c_1, \, c_2, \, \dots, \, c_{nk}$$$ ($$$1 \le c_j \le n$$$), where $$$c_j$$$ is the color of number $$$j$$$. It is guaranteed that, for each $$$1 \le i \le n$$$, it holds $$$c_j = i$$$ for exactly $$$k$$$ distinct indices $$$j$$$.

Output $$$n$$$ lines. The $$$i$$$-th line should contain the two integers $$$a_i$$$ and $$$b_i$$$. If there are multiple valid choices of the intervals, output any.

NoteIn the first sample, each number can be contained in at most $$$\left\lceil \frac{4}{3 - 1} \right\rceil = 2$$$ intervals. The output is described by the following picture:  In the second sample, the only interval to be chosen is forced to be $$$[1, \, 2]$$$, and each number is indeed contained in at most $$$\left\lceil \frac{1}{2 - 1} \right\rceil = 1$$$ interval.In the third sample, each number can be contained in at most $$$\left\lceil \frac{3}{3 - 1} \right\rceil = 2$$$ intervals. The output is described by the following picture:

{-# LANGUAGE LambdaCase #-}

import Control.Monad (foldM, forM, forM_, replicateM)
import Control.Monad.ST (ST, runST)
import Control.Monad.State (State, evalState, get, put)
import Data.Array.ST (STUArray, newArray, readArray, writeArray)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (groupBy, sort, sortBy)
import Data.Maybe (fromJust)
import Data.Ord (comparing)

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

testCase :: Scanner String
testCase = do
  n <- int
  k <- int
  cs <- (n * k) >< int
  return . unlines $ do
    (a, b) <- solve n k cs
    return $ show a ++ " " ++ show b

solve :: Int -> Int -> [Int] -> [(Int, Int)]
solve n k =
  map (\(l, r, _) -> (l, r))
    . sortOn thd3
    . pick
    . sortOn snd3
    . map (\((c, l), (_, r)) -> (l, r, c))
    . concatMap adjacents
    . groupOn fst
    . sort
    . (`zip` [1 ..])
  where
    nk = n * k
    fmax = 1 + (n - 1) `div` (k - 1)
    pick xs = runST $ do
      fs <- newArray (1, nk) 0 :: ST s (STUArray s Int Int)
      cs <- newArray (1, n) False :: ST s (STUArray s Int Bool)
      foldM' [] xs $ \ranges (l, r, c) -> do
        done <- readArray cs c
        mf <- maximum <$> forM [l .. r] (readArray fs)
        if not done && mf + 1 <= fmax
          then do
            writeArray cs c True
            forM_ [l .. r] $ \i -> do
              v <- readArray fs i
              writeArray fs i (v + 1)
            return $ (l, r, c) : ranges
          else do
            return ranges

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn p = groupBy (\u v -> p u == p v)

sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn = sortBy . comparing

foldM' :: (Foldable t, Monad m) => b -> t a -> (b -> a -> m b) -> m b
foldM' b ta f = foldM f b ta

fst3 :: (a, b, c) -> a
fst3 (a, _, _) = a
snd3 :: (a, b, c) -> b
snd3 (_, b, _) = b
thd3 :: (a, b, c) -> c
thd3 (_, _, c) = c

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

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

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

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

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

times, (><) :: Int -> Scanner a -> Scanner [a]
times = replicateM
(><) = times

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict #-}

import Control.Applicative (liftA2)
import Control.Monad (foldM, foldM_, forM, forM_, guard, replicateM, unless, when)
import Control.Monad.ST (ST, runST)
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.ST (STUArray, newArray, readArray, writeArray)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (groupBy, sort, sortBy)
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Debug.Trace (trace)

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

testCase :: Scanner String
testCase = do
  n <- int
  k <- int
  cs <- (n * k) >< int
  return . unlines $ do
    (a, b) <- solve n k cs
    return $ show a ++ " " ++ show b

solve :: Int -> Int -> [Int] -> [(Int, Int)]
solve n k =
  map (\(l, r, _) -> (l, r))
    . sortOn thd3
    . pick
    . sortOn snd3
    . map (\((c, l), (_, r)) -> (l, r, c))
    . concatMap adjacents
    . groupOn fst
    . sort
    . (`zip` [1 ..])
  where
    nk = n * k
    fmax = 1 + (n - 1) `div` (k - 1)
    pick xs = runST $ do
      fs <- newArray (1, nk) 0 :: ST s (STUArray s Int Int)
      cs <- newArray (1, n) False :: ST s (STUArray s Int Bool)
      foldM' [] xs $ \ranges (l, r, c) -> do
        done <- readArray cs c
        mf <- maximum <$> forM [l .. r] (readArray fs)
        if not done && mf + 1 <= fmax
          then do
            writeArray cs c True
            forM_ [l .. r] $ \i -> do
              v <- readArray fs i
              writeArray fs i (v + 1)
            return $ (l, r, c) : ranges
          else do
            return ranges

adjacents xs = zip xs (tail xs)
groupOn p = groupBy (\u v -> p u == p v)
sortOn = sortBy . comparing

foldM' b ta f = foldM f b ta

fst3 (x, _, _) = x
snd3 (_, y, _) = y
thd3 (_, _, z) = z

debug a = trace (show a) a

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

import Control.Monad
import Control.Monad.State
import Data.Array
import Data.List
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Sequence as Seq

solve :: IO ()
solve = do
    [n, k] <- readMany :: IO [Int]
    xa <- listArray (1, n * k) <$> readMany
    let lim = (n + k - 2) `div` (k - 1)
        go :: IS.IntSet -> Int -> IM.IntMap Int -> State (Seq.Seq Int) [(Int, Int, Int)]
        go pend i prv
            | IS.null pend          = return []
            | i == n * k + 1        = go pend 1 IM.empty
            | x `IS.notMember` pend = go pend (i + 1) prv
            | otherwise             = go' $ x `IM.lookup` prv
          where
            x = xa!i
            prv' = IM.insert x i prv
            go' Nothing  = go pend (i + 1) prv'
            go' (Just j) = do
                m <- gets $ maximum . (<$> [j..i]) . Seq.index
                if m >= lim
                    then go pend (i + 1) prv'
                    else do
                        mapM_ (modify . Seq.adjust' (+1)) [j..i]
                        ((x, j, i):) <$> go (x `IS.delete` pend) (i + 1) prv
        rs = evalState (go (IS.fromList [1..n]) 1 IM.empty) $ Seq.fromFunction (n * k + 1) $ const 0
    putStr $ unlines $ map (\(_, i, j) -> show i ++ " " ++ show j) $ sort rs

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

main :: IO ()
main = solve

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

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

import Data.Array.Unboxed
import Data.Function

ceilDiv n k = div (n + k - 1) k

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, k] <- readInts
  c <- readInts
  let
    cr :: Array Int (UArray Int Int)
    cr = fmap (listArray (1, k) . ($ [])) $ accumArray (.) id (1, n) $ do
      (i, ci) <- zip [1 ..] c
      pure (ci, (i :))
    chunkSize = ceilDiv n (k - 1)
    extract :: ([Int], [Int]) -> Int -> ([Int], [Int])
    extract (_, is) j = splitAt chunkSize $ sortOn (\i -> cr ! i ! j) is

    vals :: [[Int]]
    vals = map fst $ tail $ scanl extract ([], [1 .. n]) [2 .. k]
    ans :: Array Int (Int, Int)
    ans = array (1, n) $ do
      (j, is) <- zip [2 ..] vals
      i <- is
      pure (i, (cr ! i ! (j - 1), cr ! i ! j))
  forM_ (elems ans) $ \(ai, bi) -> putInts [ai, bi]

type SIO = StateT P.ByteString IO

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

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

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


At the school where Vasya is studying, preparations are underway for the graduation ceremony. One of the planned performances is a ball, which will be attended by pairs of boys and girls.Each class must present two couples to the ball. In Vasya's class, $$$a$$$ boys and $$$b$$$ girls wish to participate. But not all boys and not all girls are ready to dance in pairs.Formally, you know $$$k$$$ possible one-boy-one-girl pairs. You need to choose two of these pairs so that no person is in more than one pair.For example, if $$$a=3$$$, $$$b=4$$$, $$$k=4$$$ and the couples $$$(1, 2)$$$, $$$(1, 3)$$$, $$$(2, 2)$$$, $$$(3, 4)$$$ are ready to dance together (in each pair, the boy's number comes first, then the girl's number), then the following combinations of two pairs are possible (not all possible options are listed below):   $$$(1, 3)$$$ and $$$(2, 2)$$$;  $$$(3, 4)$$$ and $$$(1, 3)$$$; But the following combinations are not possible:   $$$(1, 3)$$$ and $$$(1, 2)$$$ — the first boy enters two pairs;  $$$(1, 2)$$$ and $$$(2, 2)$$$ — the second girl enters two pairs; Find the number of ways to select two pairs that match the condition above. Two ways are considered different if they consist of different pairs.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains three integers $$$a$$$, $$$b$$$ and $$$k$$$ ($$$1 \le a, b, k \le 2 \cdot 10^5$$$) — the number of boys and girls in the class and the number of couples ready to dance together. The second line of each test case contains $$$k$$$ integers $$$a_1, a_2, \ldots a_k$$$. ($$$1 \le a_i \le a$$$), where $$$a_i$$$ is the number of the boy in the pair with the number $$$i$$$. The third line of each test case contains $$$k$$$ integers $$$b_1, b_2, \ldots b_k$$$. ($$$1 \le b_i \le b$$$), where $$$b_i$$$ is the number of the girl in the pair with the number $$$i$$$. It is guaranteed that the sums of $$$a$$$, $$$b$$$, and $$$k$$$ over all test cases do not exceed $$$2 \cdot 10^5$$$. It is guaranteed that each pair is specified at most once in one test case.

For each test case, on a separate line print one integer — the number of ways to choose two pairs that match the condition above.

NoteIn the first test case, the following combinations of pairs fit:   $$$(1, 2)$$$ and $$$(3, 4)$$$;  $$$(1, 3)$$$ and $$$(2, 2)$$$;  $$$(1, 3)$$$ and $$$(3, 4)$$$;  $$$(2, 2)$$$ and $$$(3, 4)$$$. There is only one pair in the second test case.In the third test case, the following combinations of pairs fit:   $$$(1, 1)$$$ and $$$(2, 2)$$$;  $$$(1, 2)$$$ and $$$(2, 1)$$$.

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

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.Array.ST(runSTArray)

import Data.Array((!))
import Control.Monad(replicateM, foldM)
import Data.Maybe

numOcc :: Ord a => [a] -> M.Map a Integer
numOcc (x:xs) = let m = numOcc xs in case M.lookup x m of
	Just i -> M.insert x (i+1) m
	Nothing -> M.insert x 1 m
numOcc [] = M.empty

numOcc' :: A.Ix a => (a, a) -> [a] -> A.Array a Integer
numOcc' size list = runSTArray $ do
	array <- MA.newArray size 0
	let addElem action a = do
		i <- MA.readArray array a
		MA.writeArray array a (i+1)
	foldM addElem () list
	return $ array

insertWithList :: Ord a => a -> b -> M.Map a [b] -> M.Map a [b]
insertWithList a b m = case M.lookup a m of
	Just l -> M.insert a (b:l) m
	Nothing -> M.insert a [b] m

deleteWithList :: Ord a => a -> M.Map a [b] -> M.Map a [b]
deleteWithList a m = case M.lookup a m of
	Just (x:y:xs) -> M.insert a (y:xs) m
	Just [x] -> M.delete a m

solve :: Integer -> Integer -> [Integer] -> [Integer] -> Integer
solve na nb a b = div result 2 where
	deg_a = numOcc' (0, na) a

	deg_b = numOcc' (0, nb) b

	n = toInteger $ length a

	edges = zip a b

	sum_deg_b = foldr (+) 0 deg_b

	result = sum $ fmap (\(a, b) -> sum_deg_b + 1 - (deg_a ! a) - (deg_b ! b)) edges

plotResult i = print i

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[na, nb, _] <- fmap ((fmap read) . words) getLine :: IO [Integer]
		a <- fmap ((fmap read) . words) getLine :: IO [Integer]
		b <- fmap ((fmap read) . words) getLine :: IO [Integer]
		plotResult $ solve na nb a b

-- Trying to use only ByteString I/O with a state monad this contest

import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.ByteString.Lazy.Char8 as P

import Data.Int
import Data.List

getSLine :: Monad m => StateT P.ByteString m P.ByteString
getSLine = do
  (out, next) <- P.break (== '\n') <$> get
  put $ P.tail next
  pure out

readInts :: Monad m => StateT P.ByteString m [Int]
readInts = do
  currLine <- getSLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

-- There has to be a combinator for this. But where?
outLine :: P.ByteString -> StateT P.ByteString IO ()
outLine v = StateT $ \s -> ((), s) <$ P.putStrLn v

main :: IO ()
main = (P.getContents >>=) $ evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [a, b, k] <- readInts
    ai <- readInts
    bi <- readInts
    let
      nc2 :: Int -> Int64
      nc2 x = let  y = fromIntegral x  in  div (y * (y-1)) 2
      excl :: [Int] -> Int64
      excl li = sum $ [nc2 $ length s | s <- group $ sort li]
      ans :: Int64
      ans = nc2 k - sum (excl <$> [ai, bi])
    outLine . P.pack $ show ans


Little Nastya has a hobby, she likes to remove some letters from word, to obtain another word. But it turns out to be pretty hard for her, because she is too young. Therefore, her brother Sergey always helps her.Sergey gives Nastya the word t and wants to get the word p out of it. Nastya removes letters in a certain order (one after another, in this order strictly), which is specified by permutation of letters' indices of the word t: a1... a|t|. We denote the length of word x as |x|. Note that after removing one letter, the indices of other letters don't change. For example, if t = "nastya" and a = [4, 1, 5, 3, 2, 6] then removals make the following sequence of words "nastya"  "nastya"  "nastya"  "nastya"  "nastya"  "nastya"  "nastya".Sergey knows this permutation. His goal is to stop his sister at some point and continue removing by himself to get the word p. Since Nastya likes this activity, Sergey wants to stop her as late as possible. Your task is to determine, how many letters Nastya can remove before she will be stopped by Sergey.It is guaranteed that the word p can be obtained by removing the letters from word t.

The first and second lines of the input contain the words t and p, respectively. Words are composed of lowercase letters of the Latin alphabet (1 ≤ |p| < |t| ≤ 200 000). It is guaranteed that the word p can be obtained by removing the letters from word t. Next line contains a permutation a1, a2, ..., a|t| of letter indices that specifies the order in which Nastya removes letters of t (1 ≤ ai ≤ |t|, all ai are distinct).

Print a single integer number, the maximum number of letters that Nastya can remove.

NoteIn the first sample test sequence of removing made by Nastya looks like this:"ababcba"  "ababcba"  "ababcba"  "ababcba" Nastya can not continue, because it is impossible to get word "abb" from word "ababcba".So, Nastya will remove only three letters.

import Data.List

main = do
  t <- getLine
  p <- getLine
  a <- fmap (map read . words) getLine
  print $ f 0 (length t - length p) (zip [1..] t) p (sort $ zip a [1..])

f l r _ _ _ | l == r = l
f l r t p a =
  if h t' p
  then f m r t p a
  else f l (m - 1) t p a
  where m = div (l + r + 1) 2
        t' = g t a m

g t [] _ = t
g ((i,j):t) ((x,y):a) m | y > m  = g ((i,j):t) a m
                        | i == x = g t a m
                        | i < x  = (i,j):g t ((x,y):a) m
                        | i > x  = (i,j):g t a m

h _ [] = True
h [] _ = False
h ((_,j):t) (p:q) | p == j = h t q
                  | p /= j = h t (p:q)

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

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import           Data.List
import           Data.List.Split
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
  t <- getLine
  p <- getLine
  ps <- map readInt.B.words <$> B.getLine
  print $ solve t p ps

solve :: String -> String -> [Int] -> Int
solve t p ps = upperBound predicate 0 (length t)
  where
    predicate i = go 1 t p
      where
        !invalid = IS.fromList $ take i ps
        go i (x:xs) (y:ys)
          | x == y && IS.notMember i invalid = go (i+1) xs ys
          | otherwise = go (i+1) xs (y:ys)
        go _ _ [] = True
        go _ _ _ = False

upperBound :: (Integral i) => (i -> Bool) -> i -> i -> i
upperBound p low high = go low high
   where
     go !low !high
       | high <= low = low
       | p mid       = go mid high
       | otherwise   = go low (mid - 1)
      where
        mid = (low + high + 1) `quot` 2
{-# INLINE upperBound #-}


Maksim has $$$n$$$ objects and $$$m$$$ boxes, each box has size exactly $$$k$$$. Objects are numbered from $$$1$$$ to $$$n$$$ in order from left to right, the size of the $$$i$$$-th object is $$$a_i$$$.Maksim wants to pack his objects into the boxes and he will pack objects by the following algorithm: he takes one of the empty boxes he has, goes from left to right through the objects, and if the $$$i$$$-th object fits in the current box (the remaining size of the box is greater than or equal to $$$a_i$$$), he puts it in the box, and the remaining size of the box decreases by $$$a_i$$$. Otherwise he takes the new empty box and continues the process above. If he has no empty boxes and there is at least one object not in some box then Maksim cannot pack the chosen set of objects.Maksim wants to know the maximum number of objects he can pack by the algorithm above. To reach this target, he will throw out the leftmost object from the set until the remaining set of objects can be packed in boxes he has. Your task is to say the maximum number of objects Maksim can pack in boxes he has.Each time when Maksim tries to pack the objects into the boxes, he will make empty all the boxes he has before do it (and the relative order of the remaining set of objects will not change).

The first line of the input contains three integers $$$n$$$, $$$m$$$, $$$k$$$ ($$$1 \le n, m \le 2 \cdot 10^5$$$, $$$1 \le k \le 10^9$$$) — the number of objects, the number of boxes and the size of each box. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le k$$$), where $$$a_i$$$ is the size of the $$$i$$$-th object.

Print the maximum number of objects Maksim can pack using the algorithm described in the problem statement.

NoteIn the first example Maksim can pack only $$$4$$$ objects. Firstly, he tries to pack all the $$$5$$$ objects. Distribution of objects will be $$$[5], [2, 1]$$$. Maxim cannot pack the next object in the second box and he has no more empty boxes at all. Next he will throw out the first object and the objects distribution will be $$$[2, 1], [4, 2]$$$. So the answer is $$$4$$$.In the second example it is obvious that Maksim cannot pack all the objects starting from first, second, third and fourth (in all these cases the distribution of objects is $$$[4]$$$), but he can pack the last object ($$$[1]$$$).In the third example Maksim can pack all the objects he has. The distribution will be $$$[1, 2], [3], [1, 1]$$$.

import Data.List
import Data.Array

main = do
    [n, m, k] <- fmap (map (read::String->Int) . words) getLine
    v <- fmap (map (read::String->Int) . words) getLine

    let ans = binarySearch m k v n (-1)
    putStrLn $ show $ n-ans

binarySearch:: Int -> Int -> [Int] -> Int -> Int -> Int
binarySearch m k v l r
    | l == r+1 = l
    | otherwise = if pack m k (drop mid v)
                      then binarySearch m k v mid r
                      else binarySearch m k v l mid
                  where mid = (l + r) `div` 2

pack:: Int -> Int -> [Int] -> Bool
pack m k v = (snd $ foldl' f (k, m-1) v) >= 0
    where f (x,y) z
              | z > k = (0, -1)
              | z > x = (k-z, y-1)
              | otherwise = (x-z, y)

main = do
    [n, m, k] <- fmap (map (read::String->Int) . words) getLine
    v <- fmap (map (read::String->Int) . words) getLine

    let ans = binarySearch m k v n (-1)
    putStrLn $ show $ n-ans

binarySearch:: Int -> Int -> [Int] -> Int -> Int -> Int
binarySearch m k v l r
    | l == r+1 = l
    | otherwise = if pack m k (drop mid v)
                      then binarySearch m k v mid r
                      else binarySearch m k v l mid
                  where mid = (l + r) `div` 2

pack:: Int -> Int -> [Int] -> Bool
pack m k v = (snd $ foldl f (k, m-1) v) >= 0
    where f (x,y) z
              | z > k = (0, -1)
              | z > x = (k-z, y-1)
              | otherwise = (x-z, y)


Yelisey has an array $$$a$$$ of $$$n$$$ integers.If $$$a$$$ has length strictly greater than $$$1$$$, then Yelisei can apply an operation called minimum extraction to it:   First, Yelisei finds the minimal number $$$m$$$ in the array. If there are several identical minima, Yelisey can choose any of them.  Then the selected minimal element is removed from the array. After that, $$$m$$$ is subtracted from each remaining element. Thus, after each operation, the length of the array is reduced by $$$1$$$.For example, if $$$a = [1, 6, -4, -2, -4]$$$, then the minimum element in it is $$$a_3 = -4$$$, which means that after this operation the array will be equal to $$$a=[1 {- (-4)}, 6 {- (-4)}, -2 {- (-4)}, -4 {- (-4)}] = [5, 10, 2, 0]$$$.Since Yelisey likes big numbers, he wants the numbers in the array $$$a$$$ to be as big as possible.Formally speaking, he wants to make the minimum of the numbers in array $$$a$$$ to be maximal possible (i.e. he want to maximize a minimum). To do this, Yelisey can apply the minimum extraction operation to the array as many times as he wants (possibly, zero). Note that the operation cannot be applied to an array of length $$$1$$$.Help him find what maximal value can the minimal element of the array have after applying several (possibly, zero) minimum extraction operations to the array.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The next $$$2t$$$ lines contain descriptions of the test cases. In the description of each test case, the first line contains an integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the original length of the array $$$a$$$. The second line of the description lists $$$n$$$ space-separated integers $$$a_i$$$ ($$$-10^9 \leq a_i \leq 10^9$$$) — elements of the array $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

Print $$$t$$$ lines, each of them containing the answer to the corresponding test case. The answer to the test case is a single integer — the maximal possible minimum in $$$a$$$, which can be obtained by several applications of the described operation to it.

NoteIn the first example test case, the original length of the array $$$n = 1$$$. Therefore minimum extraction cannot be applied to it. Thus, the array remains unchanged and the answer is $$$a_1 = 10$$$.In the second set of input data, the array will always consist only of zeros.In the third set, the array will be changing as follows: $$$[\color{blue}{-1}, 2, 0] \to [3, \color{blue}{1}] \to [\color{blue}{2}]$$$. The minimum elements are highlighted with $$$\color{blue}{\text{blue}}$$$. The maximal one is $$$2$$$.In the fourth set, the array will be modified as $$$[2, 10, \color{blue}{1}, 7] \to [\color{blue}{1}, 9, 6] \to [8, \color{blue}{5}] \to [\color{blue}{3}]$$$. Similarly, the maximum of the minimum elements is $$$5$$$.

import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as B
import Data.List (sort)
import Data.Maybe (fromJust)

main :: IO ()
main = do
  t <- fst . fromJust . B.readInt <$> B.getLine
  replicateM_ t $ do
    _ <- B.getLine
    a <- sort . map (fst . fromJust . B.readInt) . B.words <$> B.getLine :: IO [Int]
    print $ maximum $ zipWith (-) a (0 : a)

import Control.Monad (forM_)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List (sort)
import Data.Maybe (fromJust)

readInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Int
solve xs@(x : _) = go xs 0 x
  where
    go (x : xs) delta best = do
      let y = x + delta
      go xs (delta - y) (max best y)
    go [] delta best = best
solve [] = -1

main = do
  n <- readInt <$> BS.getLine
  forM_ [1 .. n] $ \_ -> do
    _ <- BS.getLine
    xs <- sort . map readInt . BS8.words <$> BS.getLine
    print $ solve xs

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

solve :: IO ()
solve = do
    ~[n] <- readInts
    xs <- (0:) . sort <$> readInts
    print $ maximum $ zipWith (-) (tail xs) xs

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

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

import Debug.Trace

solve :: IO ()
solve = do
    ~[n] <- readInts
    xs <- readInt64s
    let go [_]          best = best
        go (x:xs@(y:_)) best = go xs $! (y - x) `max` best
    print $ go (0 : sort xs) minBound

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

readInt64s :: IO [Int64]
readInt64s = map (fromInteger . fst . fromJust . C.readInteger) . C.words <$> C.getLine

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as B
import Data.List (sort)
import Data.Maybe (fromJust)

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _ <- getLine
    a <- sort . map (fst . fromJust . B.readInt) . B.words <$> B.getLine :: IO [Int]
    print $ maximum $ zipWith (-) a (0 : a)


In Arcady's garden there grows a peculiar apple-tree that fruits one time per year. Its peculiarity can be explained in following way: there are n inflorescences, numbered from 1 to n. Inflorescence number 1 is situated near base of tree and any other inflorescence with number i (i > 1) is situated at the top of branch, which bottom is pi-th inflorescence and pi < i.Once tree starts fruiting, there appears exactly one apple in each inflorescence. The same moment as apples appear, they start to roll down along branches to the very base of tree. Each second all apples, except ones in first inflorescence simultaneously roll down one branch closer to tree base, e.g. apple in a-th inflorescence gets to pa-th inflorescence. Apples that end up in first inflorescence are gathered by Arcady in exactly the same moment. Second peculiarity of this tree is that once two apples are in same inflorescence they annihilate. This happens with each pair of apples, e.g. if there are 5 apples in same inflorescence in same time, only one will not be annihilated and if there are 8 apples, all apples will be annihilated. Thus, there can be no more than one apple in each inflorescence in each moment of time.Help Arcady with counting number of apples he will be able to collect from first inflorescence during one harvest.

First line of input contains single integer number n (2 ≤ n ≤ 100 000)  — number of inflorescences. Second line of input contains sequence of n - 1 integer numbers p2, p3, ..., pn (1 ≤ pi < i), where pi is number of inflorescence into which the apple from i-th inflorescence rolls down.

Single line of output should contain one integer number: amount of apples that Arcady will be able to collect from first inflorescence during one harvest.

NoteIn first example Arcady will be able to collect only one apple, initially situated in 1st inflorescence. In next second apples from 2nd and 3rd inflorescences will roll down and annihilate, and Arcady won't be able to collect them.In the second example Arcady will be able to collect 3 apples. First one is one initially situated in first inflorescence. In a second apple from 2nd inflorescence will roll down to 1st (Arcady will collect it) and apples from 3rd, 4th, 5th inflorescences will roll down to 2nd. Two of them will annihilate and one not annihilated will roll down from 2-nd inflorescence to 1st one in the next second and Arcady will collect it.

data Tree a = Leaf a | Branch (Tree a) (Tree a)

instance Functor Tree where
    fmap f (Leaf a) = Leaf $ f a
    fmap f (Branch l r) = Branch (fmap f l) (fmap f r)

myshow :: (Show a) => Tree a -> String
myshow (Leaf a) = show a
myshow (Branch l r) = "(" ++ myshow l ++ ") (" ++ myshow r ++ ")"

myfoldl :: (b -> a -> b) -> b -> Tree a -> b
myfoldl f z (Leaf a) = f z a
myfoldl f z (Branch l r) = myfoldl f (myfoldl f z l) r

build :: [a] -> Int -> Int -> Tree a

build (a:[]) l r | l == r = Leaf a
                 | otherwise = error "Error when building tree"
build as l r = Branch (build ls l mid) $ build rs (mid + 1) r
               where mid = (l + r) `div` 2
                     ls = take (mid - l + 1) as
                     rs = drop (mid - l + 1) as
at :: Tree a -> Int -> Int -> Int -> a

at (Leaf a) l r x = a
at (Branch ls rs) l r x | x <= mid = at ls l mid x
                        | otherwise = at rs (mid+1) r x
                          where mid = (l + r) `div` 2

update :: Tree a -> Int -> Int -> Int -> (a -> a) -> Tree a

update (Leaf a) l r x f = Leaf $ f a
update (Branch ls rs) l r x f | x <= mid = Branch (update ls l mid x f) rs
                              | otherwise = Branch ls (update rs (mid+1) r x f)
                                where mid = (l + r) `div` 2

main = do
          n <- getLine
          a <- getLine
          putStrLn(show. f (read n) $ (map read.words $ a))

f :: Int -> [Int] -> Int

f n a = myfoldl (+) 0.fmap (`mod` 2).myfoldl (h n) (build (replicate n 0) 0 (n - 1)).fst.foldl (g n) (build (replicate n 0) 0 (n - 1), 1) $ a

g :: Int -> (Tree Int, Int) -> Int -> (Tree Int, Int)

g n (t, i) x = (update t 0 (n - 1) i (\y -> (at t 0 (n - 1) (x - 1)) + 1), i + 1)

h :: Int -> Tree Int -> Int -> Tree Int

h n t a = update t 0 (n - 1) a (+ 1)

data Tree a = Leaf a | Branch (Tree a) (Tree a)

instance Functor Tree where
    fmap f (Leaf a) = Leaf $ f a
    fmap f (Branch l r) = Branch (fmap f l) (fmap f r)

myshow :: (Show a) => Tree a -> String
myshow (Leaf a) = show a
myshow (Branch l r) = "(" ++ myshow l ++ ") (" ++ myshow r ++ ")"

myfoldl :: (b -> a -> b) -> b -> Tree a -> b
myfoldl f z (Leaf a) = f z a
myfoldl f z (Branch l r) = myfoldl f (myfoldl f z l) r

build :: [a] -> Int -> Int -> Tree a

build (a:[]) l r | l == r = Leaf a
                 | otherwise = error "Error when building tree"
build as l r = Branch (build ls l mid) $ build rs (mid + 1) r
               where mid = (l + r) `div` 2
                     ls = take (mid - l + 1) as
                     rs = drop (mid - l + 1) as
at :: Tree a -> Int -> Int -> Int -> a

at (Leaf a) l r x = a
at (Branch ls rs) l r x | x <= mid = at ls l mid x
                        | otherwise = at rs (mid+1) r x
                          where mid = (l + r) `div` 2

update :: Tree a -> Int -> Int -> Int -> (a -> a) -> Tree a

update (Leaf a) l r x f = Leaf $ f a
update (Branch ls rs) l r x f | x <= mid = Branch (update ls l mid x f) rs
                              | otherwise = Branch ls (update rs (mid+1) r x f)
                                where mid = (l + r) `div` 2

main = do
          n <- getLine
          a <- getLine
          putStrLn(show. f (read n) $ (map read.words $ a))

f :: Int -> [Int] -> Int

f n a = myfoldl (+) 0.fmap (`mod` 2).myfoldl (h n) (build (replicate n 0) 0 (n - 1)).foldr (g n) (build (replicate n 0) 0 (n - 1)) $ a

g :: Int -> Int -> Tree Int -> Tree Int

g n x t = update t 0 (n - 1) y g
          where y = at t 0 (n - 1) x
                g a = y + 1

h :: Int -> Tree Int -> Int -> Tree Int

h n t a = update t 0 (n - 1) a (+ 1)

data Tree a = Leaf a | Branch (Tree a) (Tree a)

instance Functor Tree where
    fmap f (Leaf a) = Leaf $ f a
    fmap f (Branch l r) = Branch (fmap f l) (fmap f r)

myshow :: (Show a) => Tree a -> String
myshow (Leaf a) = show a
myshow (Branch l r) = "(" ++ myshow l ++ ") (" ++ myshow r ++ ")"

myfoldl :: (b -> a -> b) -> b -> Tree a -> b
myfoldl f z (Leaf a) = f z a
myfoldl f z (Branch l r) = myfoldl f (myfoldl f z l) r

build :: [a] -> Int -> Int -> Tree a

build (a:[]) l r | l == r = Leaf a
                 | otherwise = error "Error when building tree"
build as l r = Branch (build ls l mid) $ build rs (mid + 1) r
               where mid = (l + r) `div` 2
                     ls = take (mid - l + 1) as
                     rs = drop (mid - l + 1) as
at :: Tree a -> Int -> Int -> Int -> a

at (Leaf a) l r x = a
at (Branch ls rs) l r x | x <= mid = at ls l mid x
                        | otherwise = at rs (mid+1) r x
                          where mid = (l + r) `div` 2

update :: Tree a -> Int -> Int -> Int -> (a -> a) -> Tree a

update (Leaf a) l r x f = Leaf $ f a
update (Branch ls rs) l r x f | x <= mid = Branch (update ls l mid x f) rs
                              | otherwise = Branch ls (update rs (mid+1) r x f)
                                where mid = (l + r) `div` 2

main = do
          n <- getLine
          a <- getLine
          putStrLn(show. f (read n) $ (map read.words $ a))

f :: Int -> [Int] -> Int

f n a = myfoldl (+) 0.fmap (`mod` 2).myfoldl (h n) (build (replicate n 0) 0 (n - 1)).foldl (g n) (build (replicate n 0) 0 (n - 1)) $ a

g :: Int -> Tree Int -> Int -> Tree Int

g n t x = update t 0 (n - 1) y g
          where y = at t 0 (n - 1) x
                g a = y + 1

h :: Int -> Tree Int -> Int -> Tree Int

h n t a = update t 0 (n - 1) a (+ 1)

data Tree a = Leaf a | Branch (Tree a) (Tree a)

instance Functor Tree where
    fmap f (Leaf a) = Leaf $ f a
    fmap f (Branch l r) = Branch (fmap f l) (fmap f r)

myshow :: (Show a) => Tree a -> String
myshow (Leaf a) = show a
myshow (Branch l r) = "(" ++ myshow l ++ ") (" ++ myshow r ++ ")"

myfoldl :: (b -> a -> b) -> b -> Tree a -> b
myfoldl f z (Leaf a) = f z a
myfoldl f z (Branch l r) = myfoldl f (myfoldl f z l) r

build :: [a] -> Int -> Int -> Tree a

build (a:[]) l r | l == r = Leaf a
                 | otherwise = error "Error when building tree"
build as l r = Branch (build ls l mid) $ build rs (mid + 1) r
               where mid = (l + r) `div` 2
                     ls = take (mid - l + 1) as
                     rs = drop (mid - l + 1) as
at :: Tree a -> Int -> Int -> Int -> a

at (Leaf a) l r x = a
at (Branch ls rs) l r x | x <= mid = at ls l mid x
                        | otherwise = at rs (mid+1) r x
                          where mid = (l + r) `div` 2

update :: Tree a -> Int -> Int -> Int -> (a -> a) -> Tree a

update (Leaf a) l r x f = Leaf $ f a
update (Branch ls rs) l r x f | x <= mid = Branch (update ls l mid x f) rs
                              | otherwise = Branch ls (update rs (mid+1) r x f)
                                where mid = (l + r) `div` 2

main = do
          n <- getLine
          a <- getLine
          putStrLn(show. f (read n) $ (map read.words $ a))

f :: Int -> [Int] -> Int

f n a = myfoldl (+) 0.fmap (`mod` 2).myfoldl (h n) (build (replicate n 0) 0 (n - 1)).fst.foldl (g n) (build (replicate n 0) 0 (n - 1), 1) $ a

g :: Int -> (Tree Int, Int) -> Int -> (Tree Int, Int)

g n (t, i) x = (update t 0 (n - 1) i (\y -> (at t 0 (n - 1) x) + 1), i + 1)

h :: Int -> Tree Int -> Int -> Tree Int

h n t a = update t 0 (n - 1) a (+ 1)


You are a usual chat user on the most famous streaming platform. Of course, there are some moments when you just want to chill and spam something.More precisely, you want to spam the emote triangle of size $$$k$$$. It consists of $$$2k-1$$$ messages. The first message consists of one emote, the second one — of two emotes, ..., the $$$k$$$-th one — of $$$k$$$ emotes, the $$$k+1$$$-th one — of $$$k-1$$$ emotes, ..., and the last one — of one emote.For example, the emote triangle for $$$k=3$$$ consists of $$$5$$$ messages:  Of course, most of the channels have auto moderation. Auto moderator of the current chat will ban you right after you spam at least $$$x$$$ emotes in succession (you can assume you are the only user in the chat). Now you are interested — how many messages will you write before getting banned? Or maybe you will not get banned at all (i.e. will write all $$$2k-1$$$ messages and complete your emote triangle successfully)? Note that if you get banned as a result of writing a message, this message is also counted.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The next $$$t$$$ lines describe test cases. The only line of the test case contains integers $$$k$$$ and $$$x$$$ ($$$1 \le k \le 10^9; 1 \le x \le 10^{18}$$$).

For each test case, print the number of messages you will write before getting banned for the corresponding values $$$k$$$ and $$$x$$$.

NoteLet's analyze the test cases of the example.  In the first test case, you write three messages containing $$$1$$$, $$$2$$$ and $$$3$$$ emotes respectively, and since $$$1 + 2 + 3 \ge 6$$$, you get banned after that.  In the second test case, you write four messages containing $$$1$$$, $$$2$$$, $$$3$$$ and $$$4$$$ emotes respectively, and since $$$1 + 2 + 3 + 4 \ge 7$$$, you get banned after that.  In the third test case, you write one message containing exactly $$$1$$$ emote. It doesn't get you banned, since $$$1 < 2$$$, but you have already finished posting your emote triangle. So you wrote one message successfully.  In the fourth test case, you write four messages containing $$$1$$$, $$$2$$$, $$$3$$$ and $$$2$$$ emotes respectively, and since $$$1 + 2 + 3 + 2 \ge 7$$$, you get banned after that.  In the fifth test case, you write three messages containing $$$1$$$, $$$2$$$ and $$$1$$$ emote respectively. It doesn't get you banned, since $$$1 + 2 + 1 < 5$$$, but you have already finished posting your emote triangle. So you wrote three messages successfully.  In the sixth test case, since $$$x = 1$$$, you get banned as soon as you send your first message.  The seventh test case is too large to analyze, so we'll skip it.

{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import qualified Data.List as DL
import Debug.Trace
import System.IO

trisum :: Integral a => a -> a
trisum r = r*(r+1)`div`2

solve :: IO ()
solve = do
  ~[k,x] <- readv
  let ans = binarySearch (exhaust k $ min x $ trisum $ 2*k-1) 0 (2*k-1)
  print ans

exhaust :: Integer -> Integer -> Integer -> Bool
exhaust k x m = let -- do m messages use up at least x emotes
  total = if m<=k then trisum m else trisum k + trisum (k-1) - trisum (2*k-1-m)
  in
    --traceShow (k,x,m,total) $
    total >= x

binarySearch :: (Integer -> Bool) -> Integer -> Integer -> Integer
binarySearch can lo hi   -- Assumption: f <$> [lo,hi] === [False,True]. Suggestion: Start with hi = n+1
  | lo + 1 == hi = hi
  | otherwise = if can mid then binarySearch can lo mid else binarySearch can mid hi
                where  mid = lo + (hi-lo) `div` 2

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x <> DBB.char8 ' ' | x <- xs] <> DBB.char8 '\n'

readv :: IO [Integer]
readv = map (maybe 0 fst . DBC.readInteger) <$> (DBC.words <$> DBC.getLine)

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ (fromIntegral nTc) solve

import Data.List (delete)

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [triangle_height, emotes_before_ban] = map read $ words input
        result = howManyMessagesCanSendBeforeBan triangle_height emotes_before_ban
        output = show result

howManyMessagesCanSendBeforeBan :: Integer -> Integer -> Integer
howManyMessagesCanSendBeforeBan triangle_height emotes_before_ban = result_messages_n
    where
        result_messages_n = binarySearch 0 (2 * triangle_height - 1)
        binarySearch l r
            | l == r
                = mid
            | emotesNumberByMessagesNumber mid triangle_height >= emotes_before_ban
                = binarySearch l mid
            | otherwise
                = binarySearch (mid + 1) r
            where
                mid = (l + r) `div` 2

emotesNumberByMessagesNumber :: Integer -> Integer -> Integer
emotesNumberByMessagesNumber messages_n triangle_height = emotes_n
    where
        emotes_n = if messages_n < triangle_height
                   then messages_n * (messages_n + 1) `div` 2
                   else max_emotes_n - messages_before_max * (messages_before_max + 1) `div` 2
        max_emotes_n = triangle_height * (triangle_height + 1) `div` 2 * 2 - triangle_height
        messages_before_max = 2 * triangle_height - 1 - messages_n


You've got array A, consisting of n integers and a positive integer k. Array A is indexed by integers from 1 to n.You need to permute the array elements so that value  became minimal possible. In particular, it is allowed not to change order of elements at all.

The first line contains two integers n, k (2 ≤ n ≤ 3·105, 1 ≤ k ≤ min(5000, n - 1)).  The second line contains n integers A[1], A[2], ..., A[n] ( - 109 ≤ A[i] ≤ 109), separate by spaces — elements of the array A.

Print the minimum possible value of the sum described in the statement.

NoteIn the first test one of the optimal permutations is 1 4 2. In the second test the initial order is optimal. In the third test one of the optimal permutations is 2 3 4 4 3 5.

module Main(main) where

import qualified Data.ByteString.Char8 as B
import Data.Functor
import Data.List
import Data.Array
import Data.Maybe
import qualified Data.Map.Strict as Map

getNums :: B.ByteString -> [Int]
getNums =
	let
		f1 = (map ((fst.fromJust) . B.readInt))
		f2 = (B.split ' ')
	in f1.f2
readInts :: IO [Int]
readInts = getNums <$> B.getLine

deepEval a = deepEval' a [] where
	deepEval' [] b = reverse b
	deepEval' (a:as) b = deepEval' as $! ((:) $! eval a) $ b

dpRunner g x_lim y_lim =
	let
		f2 lst y =
			let
				next = undefined : (map (\(x, y_last, x_last) -> g x y x_last y_last) $ zip3 [0..x_lim] lst next)
			in
				deepEval $ tail next
	in
		last $ foldl' (\lst y -> f2 lst y) (take (x_lim+1) $ repeat undefined) [0..y_lim]

contrib :: Int -> Int -> Array Int Int -> Int -> Int -> Int
contrib l1 l2 a c1 c2 = dpRunner solve c1 c2 where
	solve 0 0 _ _ = 0
	solve 0 1 _ _ = 0
	solve 1 0 _ _ = 0
	solve x y xp yp =
		let
			opt1 = if x>0 then (a ! ((x-1)*l1+y*l2-1)) + xp else 0
			opt2 = if y>0 then (a ! (x*l1+(y-1)*l2-1)) + yp else 0
		in
			max opt1 opt2

eval x = if x == x then x else error "meh"

diffs :: (Num t, Eq t) => [t] -> [t]
diffs (a:b:as) = (eval b-a):(diffs $ b:as)
diffs _ = []

main :: IO ()
main = do
	nk <- readInts
	let [n, k] = nk
	a <- sort <$> readInts
	let c1 = ((n-1) `mod` k)+1
	let l1=(n+k-1) `div` k
	let c2 = k-c1
	let l2=l1-1
	let dffs = (listArray (0, n-2) $ diffs a)
	let ans = (last a) - (head a) - (contrib l1 l2 dffs c1 c2)
	print ans


Little Artem has invented a time machine! He could go anywhere in time, but all his thoughts of course are with computer science. He wants to apply this time machine to a well-known data structure: multiset.Artem wants to create a basic multiset of integers. He wants these structure to support operations of three types:  Add integer to the multiset. Note that the difference between set and multiset is that multiset may store several instances of one integer.  Remove integer from the multiset. Only one instance of this integer is removed. Artem doesn't want to handle any exceptions, so he assumes that every time remove operation is called, that integer is presented in the multiset.  Count the number of instances of the given integer that are stored in the multiset. But what about time machine? Artem doesn't simply apply operations to the multiset one by one, he now travels to different moments of time and apply his operation there. Consider the following example.  First Artem adds integer 5 to the multiset at the 1-st moment of time.  Then Artem adds integer 3 to the multiset at the moment 5.  Then Artem asks how many 5 are there in the multiset at moment 6. The answer is 1.  Then Artem returns back in time and asks how many integers 3 are there in the set at moment 4. Since 3 was added only at moment 5, the number of integers 3 at moment 4 equals to 0.  Then Artem goes back in time again and removes 5 from the multiset at moment 3.  Finally Artyom asks at moment 7 how many integers 5 are there in the set. The result is 0, since we have removed 5 at the moment 3. Note that Artem dislikes exceptions so much that he assures that after each change he makes all delete operations are applied only to element that is present in the multiset. The answer to the query of the third type is computed at the moment Artem makes the corresponding query and are not affected in any way by future changes he makes.Help Artem implement time travellers multiset.

The first line of the input contains a single integer n (1 ≤ n ≤ 100 000) — the number of Artem's queries. Then follow n lines with queries descriptions. Each of them contains three integers ai, ti and xi (1 ≤ ai ≤ 3, 1 ≤ ti, xi ≤ 109) — type of the query, moment of time Artem travels to in order to execute this query and the value of the query itself, respectively. It's guaranteed that all moments of time are distinct and that after each operation is applied all operations of the first and second types are consistent.

For each ask operation output the number of instances of integer being queried at the given moment of time.

{-# LANGUAGE Safe, FlexibleContexts #-}
import Control.Applicative
import Control.Monad.Identity hiding (forM_)
import Control.Monad.State.Strict hiding (forM_)
import Data.Array.IO.Safe
import Data.Array.Unboxed
import Data.Bits
import Data.Foldable
import Data.List (sort)
import Data.Functor
import Data.Maybe
import qualified Data.ByteString.Char8 as B

int = fst . fromJust . B.readInt

-- | Backport

a & f = f a
infixl 1 &

-- | Lens

type ASetter s t a b = (a -> Identity b) -> s -> Identity t
_1 f (a, b, c) = (\a' -> (a', b, c)) <$> f a
_2 f (a, b, c) = (\b' -> (a, b', c)) <$> f b
_3 f (a, b, c) = (\c' -> (a, b, c')) <$> f c

(%~) :: ASetter s t a b -> (a -> b) -> s -> t
l %~ f = runIdentity . l (Identity . f)
infixr 4 %~

(.~) :: ASetter s t a b -> b -> s -> t
l .~ b = l %~ const b
infixr 4 .~

type Getting r s a = (a -> Const r a) -> s -> Const r s
(^.) :: s -> Getting a s a -> a
x ^. l = getConst $ l Const x
infixl 8 ^.

bisect :: (MArray a e m, Ord e) => a Int e -> Int -> Int -> e -> m Int
bisect a l h x = go l h
  where
    go l h | l == h = return l
           | otherwise = do
               let m = (l+h) `quot` 2
               t <- readArray a m
               if t < x then go (m+1) h else go l m

{-# INLINABLE sort3ByIndex #-}
sort3ByIndex :: (MArray a e m, Ord e) => a Int e -> Int -> Int -> Int -> m ()
sort3ByIndex a i j k = do
  a0 <- readArray a i
  a1 <- readArray a j
  a2 <- readArray a k
  case compare a0 a1 of
    GT -> case compare a0 a2 of
            GT -> case compare a2 a1 of
                    LT -> do writeArray a i a2
                             writeArray a k a0
                    _  -> do writeArray a i a1
                             writeArray a j a2
                             writeArray a k a0
            _  -> do writeArray a i a1
                     writeArray a j a0
    _  -> case compare a1 a2 of
            GT -> case compare a0 a2 of
                    GT -> do writeArray a i a2
                             writeArray a j a0
                             writeArray a k a1
                    _  -> do writeArray a j a2
                             writeArray a k a1
            _  -> return ()

{-# INLINABLE swap #-}
swap :: (MArray a Int IO) => a Int Int -> Int -> Int -> IO ()
swap a i j = do
  a0 <- readArray a i
  a1 <- readArray a j
  writeArray a i a1
  writeArray a j a0

{-# SPECIALIZE qsort :: IOUArray Int Int -> Int -> Int -> IO () #-}
qsort :: (MArray a Int IO) => a Int Int -> Int -> Int -> IO ()
qsort a l h = go l h
  where
    go l h | h-l < 2 = return ()
           | otherwise = do
             sort3ByIndex a c l (h-1)
             p <- readArray a l
             mid <- partition p (l+1) h
             swap a l (mid-1)
             go l (mid-1)
             go mid h
      where
        c = (l+h) `quot` 2
    partition = up
      where
        up p l h
          | l < h = do
            e <- readArray a l
            if e < p
               then up p (l+1) h
               else down p l (h-1)
          | otherwise = return l
        down p l h
          | l < h = do
            e <- readArray a h
            if p < e
               then down p l (h-1)
               else swap a l h >> up p (l+1) h
          | otherwise = return l

{-# INLINABLE add #-}
add :: (MArray a e m, Num e) => a Int e -> Int -> Int -> Int -> e -> m ()
add fenwick base n' i delta = do
  let n = n' - base
      go i | i >= n = return ()
           | otherwise = do
             v <- readArray fenwick (base+i)
             writeArray fenwick (base+i) $ v+delta
             go $ i .|. (i+1)
  go $ i-base

{-# INLINABLE getSum #-}
getSum :: (MArray a e m, Num e) => a Int e -> Int -> Int -> m e
getSum fenwick base i = do
  let go i acc | i == 0 = return acc
               | otherwise = do
                 v <- readArray fenwick (base+i-1)
                 go (i .&. (i-1)) $ acc + v
  go (i-base) 0

meow :: Int -> IOArray Int (Int,Int,Int) -> IO ()
meow n a = do
  posa <- newListArray (0, n-1) [0..n-1] :: IO (IOUArray Int Int)
  za <- newArray_ (0, n-1) :: IO (IOUArray Int Int)
  forM_ [0..n-1] $ \i -> do
    t <- readArray a i
    writeArray za i $ t^._3
  qsort za 0 n
  ya <- newArray_ (0, n-1) :: IO (IOUArray Int Int)
  let go i | i == n = return ()
           | otherwise = do
             t <- readArray a i
             base <- bisect za 0 n $ t^._3
             pos <- readArray posa base
             writeArray posa base $ pos+1
             writeArray ya pos $ t ^. _2
             writeArray a i $ t & _3 .~ base
             go $ i+1
  go 0
  let go i | i == n = return ()
           | otherwise = do
             j <- readArray posa i
             when (i < j) $ qsort ya i j
             go $ i+1
  go 0
  fenwick <- newArray (0, n-1) 0 :: IO (IOUArray Int Int)
  let go i | i == n = return ()
           | otherwise = do
             t <- readArray a i
             let base = t^._3
             ub <- readArray posa base
             j <- bisect ya base ub (t^._2)
             case t^._1 of
                  1 ->
                    add fenwick base ub j 1
                  2 ->
                    add fenwick base ub j (-1)
                  3 ->
                    getSum fenwick base (j+1) >>= print
             go $ i+1

  go 0

main = do
  n <- readLn
  as <- replicateM n $ ((\[x,y,z] -> (x,y,z)) . map int . B.words) <$> B.getLine
  a <- newListArray (0, n-1) as :: IO (IOArray Int (Int,Int,Int))
  meow n a


Slavic has an array of length $$$n$$$ consisting only of zeroes and ones. In one operation, he removes either the first or the last element of the array. What is the minimum number of operations Slavic has to perform such that the total sum of the array is equal to $$$s$$$ after performing all the operations? In case the sum $$$s$$$ can't be obtained after any amount of operations, you should output -1.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$s$$$ ($$$1 \leq n, s \leq 2 \cdot 10^5$$$) — the length of the array and the needed sum of elements. The second line of each test case contains $$$n$$$ integers $$$a_i$$$ ($$$0 \leq a_i \leq 1$$$) — the elements of the array. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, output a single integer — the minimum amount of operations required to have the total sum of the array equal to $$$s$$$, or -1 if obtaining an array with sum $$$s$$$ isn't possible.

NoteIn the first test case, the sum of the whole array is $$$1$$$ from the beginning, so we don't have to make any operations.In the second test case, the sum of the array is $$$2$$$ and we want it to be equal to $$$1$$$, so we should remove the first element. The array turns into $$$[1, 0]$$$, which has a sum equal to $$$1$$$.In the third test case, the sum of the array is $$$5$$$ and we need it to be $$$3$$$. We can obtain such a sum by removing the first two elements and the last element, doing a total of three operations. The array turns into $$$[0, 1, 1, 1, 0, 0]$$$, which has a sum equal to $$$3$$$.

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

import Data.Maybe
import Control.Monad
import Data.List (nub, reverse, group, sort)
import Data.Array

solve :: Int -> Int -> [Int] -> Int
solve n s as
    | sum as < s = -1
    | sum as == s = 0
    | otherwise =
        let sm  = sum as
            psL = array (0, n - 1) $ zip [0..n-1] (scanl1 (+) as)
            psR = array (0, n - 1) $ zip [0..n-1] (scanl1 (+) (reverse as))
        in minimum $ map (test sm s psL psR) [0..length as]

test :: (Ord a, Num a) => a -> a -> Array Int a -> Array Int a -> Int -> Int
test sm s psL psR cntL
    | cntL == 0 =
        let idxR = binarySearch psR (sm - s)
        in idxR + 1
    | otherwise =
        let idxR = binarySearch psR (sm - s - psL!(cntL - 1))
        in cntL + idxR + 1

binarySearch :: (Ord a, Num a) => Array Int a -> a -> Int
binarySearch xs x
    | x <= 0 = -1
    | xs ! 0 >= x = 0
    | otherwise = helper xs x 0 (length xs)
    where
        helper xs x l r
            | l == r - 1   = r
            | xs ! mid < x = helper xs x mid r
            | otherwise    = helper xs x l mid
            where mid = div (l + r) 2

read :: IO()
read = do
    s <- C.getLine

    let a = map (fst . fromJust . C.readInt) (C.words s)

    s <- C.getLine

    print $ solve (a !! 0) (a !! 1) (map (fst . fromJust . C.readInt) (C.words s))

main :: IO()
main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) Main.read

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

import Data.Maybe
import Control.Monad
import Data.List (nub, reverse, group, sort)
import Data.Array

--solve :: Int -> Int -> Int
solve n s as
    | sum as < s = -1
    | sum as == s = 0
    | otherwise =
        let sm  = sum as
            psL = array (0, n - 1) $ zip [0..n-1] (scanl1 (+) as)
            -- psL = scanl1 (+) as
            -- psR = scanl1 (+) (reverse as)
            psR = array (0, n - 1) $ zip [0..n-1] (scanl1 (+) (reverse as))
        in minimum $ map (test sm s as psL psR) [0..length as]
        -- Сумму можно достичь
        -- 1. Перебрать l
        -- 2. Подобрать оптимальную r
        -- 3. Выбрать лучший ответ среди всех переборов

-- Перебор
--test :: Int -> [Int] -> [Int] -> Int -> Int
test sm s as psL psR cntL
    | cntL == 0 =
        -- нужно взять 0 элементов слева
        let idxR = binarySearch psR (sm - s)
        in idxR + 1
    | otherwise =
        -- я взял cntL элементов слева
        -- теперь мне нужно взять какое-то количество элементов справа
        let idxR = binarySearch psR (sm - s - psL!(cntL - 1))
        in cntL + idxR + 1

-- Search in xs index i such that (xs !! i) >= x
-- lowerBound :: [Int] -> Int -> Int
binarySearch xs x
    | x <= 0 = -1 -- то есть ничего брать не нужно
    | xs ! 0 >= x = 0
    | otherwise = helper xs x 0 (length xs)
    where
        helper xs x l r
            | l == r - 1   = r
            | xs ! mid < x = helper xs x mid r
            | otherwise    = helper xs x l mid
            where mid = div (l + r) 2

read = do
    s <- C.getLine

    let a = map (fst . fromJust . C.readInt) (C.words s)

    s <- C.getLine

    print $ solve (a !! 0) (a !! 1) (map (fst . fromJust . C.readInt) (C.words s))

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) Main.read

import Data.Array (Array, listArray, (!))

readArr :: IO [Int]
readArr = (map (\s -> read s :: Int)) <$> (words <$> getLine)

calcSmH :: [Int] -> Int -> [Int]
calcSmH [] _ = []
calcSmH (0: xs) i = calcSmH xs (i + 1)
calcSmH (1: xs) i = (i: calcSmH xs (i + 1))

calcSm :: [Int] -> [Int]
calcSm a = (0: calcSmH a 1)

calcH :: Array Int Int -> Array Int Int -> Int -> Int -> Int
calcH p s 0 j = p ! 0 + s ! j
calcH p s i j = min (p ! i + s ! j) (calcH p s (i - 1) (j + 1))

calc :: Array Int Int -> Array Int Int -> Int -> Int
calc p s d = calcH p s d 0

solve :: Int -> IO ()
solve 0 = pure ()
solve i = do
  (n: k: _) <- readArr
  a <- readArr
  let s = sum a
  let (pr, sf) = (listArray (0, s - 1) (calcSm a), listArray (0, s - 1) (calcSm $ reverse a))
  let d = s - k
  if d < 0
    then print $ -1
    else print $ calc pr sf d
  solve $ i - 1

main :: IO ()
main = do
  n <- readLn :: IO Int
  solve n


Polycarpus just has been out of luck lately! As soon as he found a job in the "Binary Cat" cafe, the club got burgled. All ice-cream was stolen.On the burglary night Polycarpus kept a careful record of all club visitors. Each time a visitor entered the club, Polycarpus put down character "+" in his notes. Similarly, each time a visitor left the club, Polycarpus put character "-" in his notes. We know that all cases of going in and out happened consecutively, that is, no two events happened at the same time. Polycarpus doesn't remember whether there was somebody in the club at the moment when his shift begun and at the moment when it ended.Right now the police wonders what minimum number of distinct people Polycarpus could have seen. Assume that he sees anybody coming in or out of the club. Each person could have come in or out an arbitrary number of times.

The only line of the input contains a sequence of characters "+" and "-", the characters are written one after another without any separators. The characters are written in the order, in which the corresponding events occurred. The given sequence has length from 1 to 300 characters, inclusive.

Print the sought minimum number of people

solve :: String -> Int
solve s  =  maximum d - minimum d
  where
    d  =  scanl f 0 s
    f x '-'  =  x - 1
    f x '+'  =  x + 1

main :: IO ()
main  =  getLine >>= print . solve

main=interact$show.f 0 0 0
f l h cur ('+':rest) = f l (max(cur+1)h) (cur+1) rest
f l h cur ('-':rest) = f (min(cur-1)l) h (cur-1) rest
f l h _ _ = h+abs l

solve :: String -> Int
solve  =  maximum . map abs . scanl f 0
  where
    f x '-'  =  x - 1
    f x '+'  =  x + 1

main :: IO ()
main  =  getLine >>= print . solve