The Saratov State University Olympiad Programmers Training Center (SSU OPTC) has n students. For each student you know the number of times he/she has participated in the ACM ICPC world programming championship. According to the ACM ICPC rules, each person can participate in the world championship at most 5 times.The head of the SSU OPTC is recently gathering teams to participate in the world championship. Each team must consist of exactly three people, at that, any person cannot be a member of two or more teams. What maximum number of teams can the head make if he wants each team to participate in the world championship with the same members at least k times?

The first line contains two integers, n and k (1 ≤ n ≤ 2000; 1 ≤ k ≤ 5). The next line contains n integers: y1, y2, ..., yn (0 ≤ yi ≤ 5), where yi shows the number of times the i-th person participated in the ACM ICPC world championship.

Print a single number — the answer to the problem.

NoteIn the first sample only one team could be made: the first, the fourth and the fifth participants.In the second sample no teams could be created.In the third sample two teams could be created. Any partition into two teams fits.

import Control.Monad

readListLn :: IO [Int]
readListLn = (map (read :: String -> Int) . words) `liftM` getLine

main :: IO ()
main = do
    [_, k] <- readListLn
    y <- readListLn
    putStr $ show $ length (filter (<=5-k) y) `div` 3

import Data.List
import Data.Function
import Data.Char

main = interact $ show . getAns . map read . words

getAns :: [Int] -> Int
getAns (n:k:xs) = let ns = (length . filter (<=5) . map (+k)) xs
				in ns `div` 3

main = do
  [_, k] <- fmap (map read . words) getLine
  ys <- fmap (map read . words) getLine

  let c = length $ filter (\x -> x + k <= 5) ys
  print $ c `div` 3

main = do
  (n:k:_) <- fmap (map read . words) getLine :: IO [Int]
  nums <- fmap (map read . words) getLine
  let answer = length (filter (\a -> k+a <= 5) nums) `div` 3
  print answer

{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative ((<$>))
import Text.Printf
import Data.Maybe (Maybe, fromMaybe)
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  [n, k] <- readInts
  y <- readInts
  print . (`div` 3) . length . filter (<= 5 - k) $ y

toNumber = fst . fromMaybe (0, "")
readInt = toNumber . BS.readInt <$> BS.getLine
readInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  solve.tail.concat =<< (forM [1..2] $ \i-> map (fst.fromJust.C.readInt).C.words <$> C.getLine)

solve (x:xs) = let l = length $ filter (\a->a+x<=5) xs in print $ l `div` 3

import Control.Applicative
import Data.List (sort)

main = do
  [_, k] <- map read . words <$> getLine
  ss <- sort . map read . words <$> getLine
  let
    f xs
      | length xs < 3 = 0
      | all (<=5) . map (+k) $ take 3 xs = 1 + f (drop 3 xs)
      | otherwise = 0
    in putStrLn . show $ f ss

import Data.List

conv = map (read::String->Int) . words
g k xs = div ((length . sort) [x | x <- xs , 5 - x >= k]) 3

main = do
    i <- getLine
    x <- getLine
    let k = (conv i) !! 1
    let xs = conv x
    putStrLn $ show (g k xs)

import Control.Applicative
import Data.List

main=do
     [n,k]<-    map read <$> words <$> getLine::IO [Int]
     q<-map read <$> words <$> getLine::IO [Int]
     print $ div ( length $ filter (<=5-k) q) 3

main :: IO ()
main = getContents >>= print . solve . map read . words

solve :: [Int] -> Int
solve (_:k:ys) = length (filter (<=5-k) ys) `div` 3
solve _ = undefined

main = interact $ show . solve . map read . words
solve (n:k:ns) = (`div` 3) $ length $ filter (<= 5 - k) ns

import Data.List

strToList = (fmap (read :: (String -> Int))).words

f xs k = (length $ filter (<=5) $ map (+k) xs) `div` 3

main = do

    [n, k] <- fmap strToList getLine

    s <- fmap strToList getLine

    putStrLn $ show $ f s k

module Main where

import Data.List (sort, maximum)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

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

chunks0 _ [] = []
chunks0 n as = (take n as) : chunks0 n (drop n as)

chunks n = filter ((== n) . length) . chunks0 n

getTeamCount k n participants
  | n < 3 = 0
  | otherwise =
      length
        $ filter (<= 5)
        $ map ((+ k) . maximum)
        $ chunks 3 participants

main :: IO ()
main = do
  (n:k:_) <- readNumbers
  participants <- take n `fmap` readNumbers
  print (getTeamCount k n (sort participants))

import Text.Printf (printf)
import Control.Monad (forM_)

main :: IO ()
main = do
  [n, k] <- fmap (map read . words) getLine :: IO [Int]
  xs <- fmap (map read . words) getLine :: IO [Int]
  print $ length (filter (\x -> x + k <= 5) xs) `div` 3

solve :: String -> String
solve s = show $ quot cnt 3
  where (x:y:xs) = map read (words s)
        cnt = length (filter (\x -> 5 - y >= x) xs)

main = do
  interact solve

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

main :: IO ()
main = do
	[_,k] <- inputInts
	xs <- inputInts
	print . (`div` 3) . length . filter (<= 5 - k) $ xs

{-# LANGUAGE TupleSections #-}

-- For Input
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
--import qualified Data.ByteString.Lex.Double as BSD
import Data.Char (isSpace)
import Data.IORef
import Text.Printf

-- Data Structure Imports
import Data.Maybe
import Data.List
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

-- These should be imported by default... :)
import Control.Monad
import Control.Applicative
import Control.Arrow

--------------------------------------------------------------------------------
------------------------------- SOLUTION ---------------------------------------
--------------------------------------------------------------------------------

main :: IO ()
main = do
  all   <- BS.getContents
  input <- newIORef all
  let parse = next input
  (n,k) <- parse int2
  ys <- parse $ intMany n
  let solution = length (filter (\y -> y + k <= 5) ys) `div` 3
  putStrLn $ show solution

--------------------------------------------------------------------------------
-------------------------- IO Function Helpers ---------------------------------
--------------------------------------------------------------------------------

type Parser a = BSC.ByteString -> (a, BSC.ByteString)

int :: Parser Int
int = second (BSC.dropWhile isSpace) . fromJust . BSC.readInt

int2 :: Parser (Int, Int)
int2 = uncurry (first . (,)) . second int . int

int3 :: Parser (Int, Int, Int)
int3 = uncurry (first . (uncurry (,,))) . second int . int2

--double :: Parser Double
--double = second (BSC.dropWhile isSpace) . fromJust . BSD.readDouble

char :: Parser Char
char = BSC.head &&& BSC.tail

letter :: Parser Char
letter = second (BSC.dropWhile isSpace) . char

string :: Parser String
string = (BSC.unpack *** BSC.dropWhile isSpace) . BSC.span (not . isSpace)

readMany :: Parser a -> Int -> Parser [a]
readMany f n bs = first reverse $
                  foldr (\_ (l,bs) -> first (:l) $ f bs) ([],bs) [1..n]

intMany :: Int -> Parser [Int]
intMany = readMany int

next :: IORef BSC.ByteString -> Parser a -> IO a
next input parse = do
  bs <- readIORef input
  let (x, bs') = parse bs
  writeIORef input bs'
  return x

{- CODE JAM input

  cases <- parse int
  forM_ [1..cases] $ \caseNum -> do
         -- Read Data
         -- let solution =
         -- solution <-
         printf "Case #%d: %d\n" caseNum solution
-}

import Control.Applicative
import Data.List

main= do
	[_,k]<-  map read. words <$> getLine ::IO [Int]
	s<- sort.map read.words <$> getLine::IO [Int]
        print $ div (length (takeWhile (<=5-k) s)) 3

import Data.List
main = do
  [n, k] <- getLine >>= return. map read. words :: IO [Int]
  a <- getLine >>= return. filter (< (6 - k)). map read. words :: IO [Int]
  print. (`div` 3). length $ a

import Control.Applicative

main = do
    [n, k] <- map read . words <$> getLine
    ys <- map read . words <$> getLine
    print $ (length $ filter (<= (5-k)) ys) `div` 3

process :: Int -> [Int] -> Int
process k xs = length (filter (\x -> x+k<=5) xs) `div` 3

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,k] <- fmap (map readInt.words) getLine
    ys <- fmap (map readInt.words) getLine
    print $ process k ys

main = do
    [n,k] <- fmap (map read . words) getLine :: IO [Int]
    y <- fmap (map read . words) getLine :: IO [Int]
    print $ (length $ filter (<= 5 - k) y) `div` 3

main = do
    let i=fmap (map read.words) getLine::IO [Int]
    [n,k]<-i
    y<-i
    print $ (length $ filter (<6-k) y) `div` 3

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

solve :: [Int] -> Int
solve (_:k:xs) = flip div 3 $ length $ filter (5-k >= ) xs

import Control.Applicative

main :: IO ()
main=interact solve

solve :: String -> String
solve s = show $ answer k xs
    where (_:k:xs) = read<$>words s

answer :: Int -> [Int] -> Int
answer k xs = quot (sum [1 | i <- xs, k + i <= 5]) 3

import Control.Applicative
import Data.List

main=do
     [n,k]<-    map read <$> words <$> getLine::IO [Int]
     q<-map read <$> words <$> getLine::IO [Int]
     print $ div ( length $ takeWhile (>=5-k) q) 3

import Control.Applicative
import Data.List

main=do
     [n,k]<-    map read <$> words <$> getLine::IO [Int]
     q<-map read <$> words <$> getLine::IO [Int]
     print $ div ( length $ takeWhile (<=5-k) q) 3

import Data.List
main = do
  [n, k] <- getLine >>= return. map read. words :: IO [Int]
  a <- getLine >>= return. filter (< (4 - k)). map read. words :: IO [Int]
  print. (`div` 3). length $ a


Monocarp has just learned a new card trick, and can't wait to present it to you. He shows you the entire deck of $$$n$$$ cards. You see that the values of cards from the topmost to the bottommost are integers $$$a_1, a_2, \dots, a_n$$$, and all values are different.Then he asks you to shuffle the deck $$$m$$$ times. With the $$$j$$$-th shuffle, you should take $$$b_j$$$ topmost cards and move them under the remaining $$$(n - b_j)$$$ cards without changing the order.And then, using some magic, Monocarp tells you the topmost card of the deck. However, you are not really buying that magic. You tell him that you know the topmost card yourself. Can you surprise Monocarp and tell him the topmost card before he shows it?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. The first line of each testcase contains a single integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the number of cards in the deck. The second line contains $$$n$$$ pairwise distinct integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$) — the values of the cards. The third line contains a single integer $$$m$$$ ($$$1 \le m \le 2 \cdot 10^5$$$) — the number of shuffles. The fourth line contains $$$m$$$ integers $$$b_1, b_2, \dots, b_m$$$ ($$$1 \le b_j \le n - 1$$$) — the amount of cards that are moved on the $$$j$$$-th shuffle. The sum of $$$n$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$. The sum of $$$m$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$.

For each testcase, print a single integer — the value of the card on the top of the deck after the deck is shuffled $$$m$$$ times.

NoteIn the first testcase, each shuffle effectively swaps two cards. After three swaps, the deck will be $$$[2, 1]$$$.In the second testcase, the second shuffle cancels what the first shuffle did. First, three topmost cards went underneath the last card, then that card went back below the remaining three cards. So the deck remained unchanged from the initial one — the topmost card has value $$$3$$$.

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum [read x :: Int | x <- b] `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 return result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- sequence (replicate t ans)
 putStrLn (unwords results)

import Control.Monad

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum [read x :: Int | x <- b] `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 return result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- replicateM t (do ans)
 putStrLn (unwords results)

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum (map (\x -> read x :: Int) b) `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 putStrLn result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 let results = replicate t ans
 sequence results

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum [read x :: Int | x <- b] `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 putStrLn result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 let results = replicate t ans
 sequence results

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum [read x :: Int | x <- b] `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 putStrLn result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 let results = [ans | x <- [1 .. t]]
 sequence results

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import Data.Word (Word32)
import GHC.Conc (par, pseq)
import System.Environment (getArgs)

data TC = TC {n :: Int, m :: Int, a :: [Int], b :: [Int]}

aliceBob x = if x then "Alice" else "Bob"

solve TC {..} = a!!p
  where
    p = (sum b) `mod` n

main = C.interact $ runScanner scan >>> map solve >>> map show >>> map C.pack >>> C.unlines

scan =
  numberOf $
    ( do
        n <- int
        a <- n >< int
        m <- int
        b <- m >< int
        pure $ TC n m a b
    )

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

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

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

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

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

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 (,)


You have an n × m rectangle table, its cells are not initially painted. Your task is to paint all cells of the table. The resulting picture should be a tiling of the table with squares. More formally:  each cell must be painted some color (the colors are marked by uppercase Latin letters);  we will assume that two cells of the table are connected if they are of the same color and share a side; each connected region of the table must form a square. Given n and m, find lexicographically minimum coloring of the table that meets the described properties.

The first line contains two integers, n and m (1 ≤ n, m ≤ 100).

Print lexicographically minimum coloring of the table that meets the described conditions.  One coloring (let's call it X) is considered lexicographically less than the other one (let's call it Y), if:   consider all the table cells from left to right and from top to bottom (first, the first cell in the first row, then the second cell in the first row and so on);  let's find in this order the first cell that has distinct colors in two colorings;  the letter that marks the color of the cell in X, goes alphabetically before the letter that marks the color of the cell in Y.

{-# LANGUAGE MultiWayIf #-}

import Data.Array.IO
import qualified Data.Array.MArray as M
import qualified Data.Array.IArray as I
import Data.Array.Unboxed
import Control.Monad
import Data.Char
import Data.List
import Text.Printf

toChar :: Int -> Char
toChar a = chr (64+a)

solve' arr n m i j c0 k = do
  arr' <- M.freeze arr :: IO (UArray (Int,Int) Int)
  let c1 = arr' ! (i-1,j)
      c2 = if j+1 <= m then arr' ! (i,j+1) else 0
      ok c | c == c1 = False
           | c == c2 = False
           | c == c0 = k > 0 && i+k <= n && arr' ! (i+k,j-k) /= c
           | otherwise = True
      c = head [ c | c <- [1..], ok c ]
  if c == c0
    then do forM_ [0..k] $ \w -> writeArray arr (i+w,j) c
            forM_ [1..k] $ \w -> writeArray arr (i+k,j-w) c
            return (c,k+1)
    else do writeArray arr (i,j) c
            return (c,1)

firstM :: Monad m => (a -> m Bool) -> [a] -> m a
firstM p [] = error "oops"
firstM p (x:xs) = do b <- p x; if b then return x else firstM p xs

-- a version of solve' which does not use M.freeze
solve'' arr n m i j c0 k = do
  c1 <- readArray arr (i-1,j)
  c2 <- if j+1 <= m then readArray arr (i,j+1) else return 0
  let ok c | c == c1 = return False
           | c == c2 = return False
           | c == c0 = if k > 0 && i+k <= n
                         then do cx <- readArray (i+k,j-k); return $ cx /= c
                         else return False
           | otherwise = return True
  c <- firstM ok [1..]
  if c == c0
    then do forM_ [0..k] $ \w -> writeArray arr (i+w,j) c
            forM_ [1..k] $ \w -> writeArray arr (i+k,j-w) c
            return (c,k+1)
    else do writeArray arr (i,j) c
            return (c,1)

solve n m = do
  arr <- newArray ((0,0),(n,m)) 0 :: IO (IOUArray (Int,Int) Int)
  let go (c0,k) (i,j) = do
        x <- readArray arr (i,j)
        if x == 0 then solve' arr n m i j c0 k
                  else return (x,0)
  forM_ [1..n] $ \i -> do
    foldM_ go (0,0) [ (i,j) | j <- [1..m] ]
  M.freeze arr :: IO (UArray (Int,Int) Int)

main = do
  (n:m:_) <- fmap (map read . words) getLine
  arr <- solve n m
  forM_ [1..n] $ \i -> do
    putStrLn $ map (\j -> toChar $ (arr!(i,j))) [1..m]

{-# LANGUAGE MultiWayIf #-}

import Data.Array.IO
import qualified Data.Array.MArray as M
import qualified Data.Array.IArray as I
import Data.Array.Unboxed
import Control.Monad
import Data.Char
import Data.List
import Text.Printf

toChar :: Int -> Char
toChar a = chr (64+a)

solve' arr n m i j c0 k = do
  arr' <- M.freeze arr :: IO (UArray (Int,Int) Int)
  let c1 = arr' ! (i-1,j)
      ok c | c == c1 = False
           | c == c0 = k > 0 && i+k <= n && arr' ! (i+k,j-k) /= c
           | otherwise = True
      c = head [ c | c <- [1..], ok c ]
  if c == c0
    then do forM_ [0..k] $ \w -> writeArray arr (i+w,j) c
            forM_ [1..k] $ \w -> writeArray arr (i+k,j-w) c
            return (c,k+1)
    else do writeArray arr (i,j) c
            return (c,1)

firstM :: Monad m => (a -> m Bool) -> [a] -> m a
firstM p [] = error "oops"
firstM p (x:xs) = do b <- p x; if b then return x else firstM p xs

-- a version of solve' which does not use M.freeze
solve'' arr n m i j c0 k = do
  c1 <- readArray arr (i-1,j)
  let ok c | c == c1 = return False
           | c == c0 = if k > 0 && i+k <= n
                         then do cx <- readArray (i+k,j-k); return $ cx /= c
                         else return False
           | otherwise = return True
  c <- firstM ok [1..]
  if c == c0
    then do forM_ [0..k] $ \w -> writeArray arr (i+w,j) c
            forM_ [1..k] $ \w -> writeArray arr (i+k,j-w) c
            return (c,k+1)
    else do writeArray arr (i,j) c
            return (c,1)

solve n m = do
  arr <- newArray ((0,0),(n,m)) 0 :: IO (IOUArray (Int,Int) Int)
  let go (c0,k) (i,j) = do
        x <- readArray arr (i,j)
        if x == 0 then solve' arr n m i j c0 k
                  else return (x,0)
  forM_ [1..n] $ \i -> do
    foldM_ go (0,0) [ (i,j) | j <- [1..m] ]
  M.freeze arr :: IO (UArray (Int,Int) Int)

main = do
  (n:m:_) <- fmap (map read . words) getLine
  arr <- solve n m
  forM_ [1..n] $ \i -> do
    putStrLn $ map (\j -> toChar $ (arr!(i,j))) [1..m]


There is a badminton championship in which $$$n$$$ players take part. The players are numbered from $$$1$$$ to $$$n$$$. The championship proceeds as follows: player $$$1$$$ and player $$$2$$$ play a game, then the winner and player $$$3$$$ play a game, and then the winner and player $$$4$$$ play a game, and so on. So, $$$n-1$$$ games are played, and the winner of the last game becomes the champion. There are no draws in the games.You want to find out the result of championship. Currently, you only know the following information:  Each player has either won $$$x$$$ games or $$$y$$$ games in the championship. Given $$$n$$$, $$$x$$$, and $$$y$$$, find out if there is a result that matches this information.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. The only line of each test case contains three integers $$$n$$$, $$$x$$$, $$$y$$$ ($$$2 \le n \le 10^5$$$, $$$0 \le x, y < n$$$). It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^5$$$.

Print the answer for each test case, one per line. If there is no result that matches the given information about $$$n$$$, $$$x$$$, $$$y$$$, print $$$-1$$$. Otherwise, print $$$n-1$$$ space separated integers, where the $$$i$$$-th integer is the player number of the winner of the $$$i$$$-th game.  If there are multiple valid results, print any.

NoteIn the first test case, player $$$1$$$ and player $$$4$$$ won $$$x$$$ times, player $$$2$$$ and player $$$3$$$ won $$$y$$$ times.In the second, third, and fifth test cases, no valid result exists.

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

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
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))

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

{- aux -}
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

{- solution -}

solve :: Int -> Int -> Int -> Maybe [Int]
solve n x y | x > y = solve n y x
solve n 0 0 = Nothing
solve n 0 y | (n - 1) `mod` y == 0  = Just $ L.concatMap (L.replicate y) . L.take ((n - 1) `div` y) $ iterate (+ y) 2
solve n _ _ = Nothing

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s <&> map fromIntegral
        let answer = solve n x y
        case answer of
            Just results -> M.forM_ results (printf "%d ") >> printf "\n"
            Nothing -> printf "-1\n"

--
-- 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-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n,x,y] <- ri
        return (n,x,y)
    mapM_ (putStrLn.showAns.solve) tcs

showAns Nothing = "-1"
showAns (Just xs) = unwords . map show $ xs

solve (_,0,0) = Nothing
solve (n,0,y) = solve (n,y,0)
solve (n,x,0) | (n-1) `mod` x /= 0  = Nothing
              | otherwise           = Just ans
  where
    np = (n-1) `div` x
    winners = take np $ 1 : [x+2, 2*x+2 ..]
    ans = concatMap (replicate x) $ winners
solve _       = Nothing

import Data.Array
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = map read . words <$> getLine >>=
        \[n, x, y] -> case matchOf n x y of
                        Nothing -> putStrLn "-1"
                        Just as -> mapM_ (\a -> putStr (show a ++ " ")) as >>
                                   putStrLn ""

matchOf :: Int -> Int -> Int -> Maybe [Int]
matchOf n x y | (x /= 0 && y /= 0) || (x == 0 && y == 0) = Nothing
              | otherwise = let k = if x == 0 then y else x in
                              if (mod (n-1) k) == 0
                              then Just $ concatMap (replicate k) [2+k*i | i <- [0..(div (n-1) k)-1]]
                              else Nothing

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

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
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))

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

{- aux -}
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

{- solution -}

solve :: Int -> Int -> Int -> Maybe [Int]
solve n x y | x > y = solve n y x
solve n 0 0 = Nothing
solve n 0 y | (n - 1) `mod` y == 0  = Just $ L.concatMap (L.replicate y) . L.take ((n - 1) `div` y) $ iterate (+ (y + 1)) 1
solve n _ _ = Nothing

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s <&> map fromIntegral
        let answer = solve n x y
        case answer of
            Just results -> M.forM_ results (printf "%d ") >> printf "\n"
            Nothing -> printf "-1\n"

--
-- 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-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n,x,y] <- ri
        return (n,x,y)
    mapM_ (putStrLn.showAns.solve) tcs

showAns Nothing = "-1"
showAns (Just xs) = unwords . map show $ xs

solve (_,0,0) = Nothing
solve (n,0,y) = solve (n,y,0)
solve (n,x,0) | (n-1) `mod` x /= 0  = Nothing
              | otherwise           = Just ans
  where
    np = (n-1) `div` x
    winners = take np [1, 1+x+1 ..]
    ans = concatMap (replicate x) $ winners
solve _       = Nothing


Two semifinals have just been in the running tournament. Each semifinal had n participants. There are n participants advancing to the finals, they are chosen as follows: from each semifinal, we choose k people (0 ≤ 2k ≤ n) who showed the best result in their semifinals and all other places in the finals go to the people who haven't ranked in the top k in their semifinal but got to the n - 2k of the best among the others.The tournament organizers hasn't yet determined the k value, so the participants want to know who else has any chance to get to the finals and who can go home.

The first line contains a single integer n (1 ≤ n ≤ 105) — the number of participants in each semifinal. Each of the next n lines contains two integers ai and bi (1 ≤ ai, bi ≤ 109) — the results of the i-th participant (the number of milliseconds he needs to cover the semifinals distance) of the first and second semifinals, correspondingly. All results are distinct. Sequences a1, a2, ..., an and b1, b2, ..., bn are sorted in ascending order, i.e. in the order the participants finished in the corresponding semifinal.

Print two strings consisting of n characters, each equals either "0" or "1". The first line should correspond to the participants of the first semifinal, the second line should correspond to the participants of the second semifinal. The i-th character in the j-th line should equal "1" if the i-th participant of the j-th semifinal has any chances to advance to the finals, otherwise it should equal a "0".

NoteConsider the first sample. Each semifinal has 4 participants. The results of the first semifinal are 9840, 9860, 9930, 10040. The results of the second semifinal are 9920, 9980, 10020, 10090.  If k = 0, the finalists are determined by the time only, so players 9840, 9860, 9920 and 9930 advance to the finals.  If k = 1, the winners from both semifinals move to the finals (with results 9840 and 9920), and the other places are determined by the time (these places go to the sportsmen who run the distance in 9860 and 9930 milliseconds).  If k = 2, then first and second places advance from each seminfial, these are participants with results 9840, 9860, 9920 and 9980 milliseconds.

g (x:y:[]) = [(x, y)]
g (x:y:s) = (x, y) : g s
f 0 _ _ = (0, 0)
f n [] (b:bs) = (p, q + 1) where (p, q) = f (n - 1) [] bs
f n (a:as) [] = (p + 1, q) where (p, q) = f (n - 1) as []
f n (a:as) (b:bs)
  | a < b = let (p, q) = f (n - 1) as (b:bs) in (p + 1, q)
  | otherwise = (r, s + 1) where (r, s) = f(n - 1) (a:as) bs
main = do
  all <- getContents
  let ns = map read $ words all :: [Int]
  let n = head ns
  let (as, bs) = unzip $ g $ tail ns
  let (an, bn) = f n as bs
  let (man, mbn) = (max an (div n 2), max bn (div n 2))
  putStrLn $ (replicate man '1') ++ (replicate (n - man) '0')
  putStrLn $ (replicate mbn '1') ++ (replicate (n - mbn) '0')

g (x:y:[]) = [(x, y)]
g (x:y:s) = (x, y) : g s
f 0 _ _ = 0
f n as bs
  | (null bs) || (not (null as)) && ((head as) < (head bs)) = 1 + f (n - 1) (tail as) bs
  | otherwise = f(n - 1) as (tail bs)
main = do
  all <- getContents
  let ns = map read $ words all :: [Int]
  let n = head ns
  let (as, bs) = unzip $ g $ tail ns
  let k = f n as bs
  putStrLn $ [if x <= (max k (div n 2)) then '1' else '0' | x <- [1..n]]
  putStrLn $ [if x <= (max (n - k) (div n 2)) then '1' else '0' | x <- [1..n]]


One night, Mark realized that there is an essay due tomorrow. He hasn't written anything yet, so Mark decided to randomly copy-paste substrings from the prompt to make the essay.More formally, the prompt is a string $$$s$$$ of initial length $$$n$$$. Mark will perform the copy-pasting operation $$$c$$$ times. Each operation is described by two integers $$$l$$$ and $$$r$$$, which means that Mark will append letters $$$s_l s_{l+1} \ldots s_r$$$ to the end of string $$$s$$$. Note that the length of $$$s$$$ increases after this operation.Of course, Mark needs to be able to see what has been written. After copying, Mark will ask $$$q$$$ queries: given an integer $$$k$$$, determine the $$$k$$$-th letter of the final string $$$s$$$.

The first line contains a single integer $$$t$$$ ($$$1\leq t\leq 1000$$$) — the number of test cases. The first line of each test case contains three integers $$$n$$$, $$$c$$$, and $$$q$$$ ($$$1\leq n\leq 2\cdot 10^5$$$, $$$1\leq c\leq 40$$$, and $$$1\leq q\leq 10^4$$$) — the length of the initial string $$$s$$$, the number of copy-pasting operations, and the number of queries, respectively. The second line of each test case contains a single string $$$s$$$ of length $$$n$$$. It is guaranteed that $$$s$$$ only contains lowercase English letters. The following $$$c$$$ lines describe the copy-pasting operation. Each line contains two integers $$$l$$$ and $$$r$$$ ($$$1\leq l\leq r\leq 10^{18}$$$). It is also guaranteed that $$$r$$$ does not exceed the current length of $$$s$$$. The last $$$q$$$ lines of each test case describe the queries. Each line contains a single integer $$$k$$$ ($$$1\leq k\leq 10^{18}$$$). It is also guaranteed that $$$k$$$ does not exceed the final length of $$$s$$$. It is guaranteed that the sum of $$$n$$$ and $$$q$$$ across all test cases does not exceed $$$2\cdot 10^5$$$ and $$$10^4$$$, respectively.

For each query, print the $$$k$$$-th letter of the final string $$$s$$$.

NoteIn the first test case, the copy-paste process is as follows.   The first step is pasting string $$$\texttt{mark}$$$ at the end, yielding the string $$$\texttt{mark}\color{red}{\texttt{mark}}$$$.  The second step is pasting string $$$\texttt{mar}$$$ at the end, yielding the string $$$\texttt{markmark}\color{red}{\texttt{mar}}$$$.  The third step is pasting string $$$\texttt{rkmark}$$$ at the end, yielding the string $$$\texttt{markmarkmar}\color{red}{\texttt{rkmark}}$$$. In the second test case, the copy-paste process is as follows.   The first step is pasting string $$$\texttt{re}$$$ at the end, yielding the string $$$\texttt{creamii}\color{red}{\texttt{re}}$$$.  The second step is pasting string $$$\texttt{ea}$$$ at the end, yielding the string $$$\texttt{creamiire}\color{red}{\texttt{ea}}$$$.  The third step is pasting string $$$\texttt{reamiire}$$$ at the end, yielding the string $$$\texttt{creamiireea}\color{red}{\texttt{reamiire}}$$$.

{-# LANGUAGE
  ScopedTypeVariables,
  BangPatterns,
  FlexibleContexts,
  TypeApplications,
  MultiWayIf #-}

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

main = do
  [!t] <- readInts
  replicateM_ t solve

solve = do
  [!n, !c, !q] <- readInts
  s <- listArray @UArray (0,n-1) <$> getLine
  cs <- replicateM c $ do
    [!l, !r] <- readInts
    return (l,r)
  qs <- replicateM q (head <$> readInts)
  let go _ [] = []
      go !ind ((l,r):xs) = (ind,l-1,r-1) : go (ind+r-l+1) xs
      cs' = reverse $ go n cs
      find [] i = i
      find ((ind,l,r):xs) i
        | i >= ind = find xs (i - ind + l)
        | otherwise = find xs i
  mapM_ (putStrLn . (:[]) . (s!) . find cs' . subtract  1) qs

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

modifyArray :: (MArray a e m , Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr i f = readArray arr i >>= writeArray arr i . f

--
-- 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-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n,c,q] <- ri
        s        <- B.takeWhile isPrint <$> B.getLine
        [lrs,qs] <- mapM (`replicateM` ri) [c,q]
        return (s,lrs,qs)
    mapM_ (putStr.showChars.solve) tcs

showChars = unlines . map (:"")

solve (s,lrs,qs) = ans
  where
    (_,offMap) = foldl nxt (B.length s, Map.empty) . map lr2il $ lrs
      where
        lr2il = f  where  f [l,r] = (l, r+1-l)
                          f _     = error "Input error (LR pair)"

        nxt (len, imap) (si,slen) = (len+slen, (len+1) `Map.insert` (len+1-si) $ imap)

    ans = map (B.index s . pred . v2i) qs
      where
        v2i [i] = case (Map.lookupLE i offMap) of
            Nothing      -> i
            Just (_,off) -> v2i [i - off]

        v2i _ = error "Input error (single index expected)"


George decided to prepare a Codesecrof round, so he has prepared m problems for the round. Let's number the problems with integers 1 through m. George estimates the i-th problem's complexity by integer bi.To make the round good, he needs to put at least n problems there. Besides, he needs to have at least one problem with complexity exactly a1, at least one with complexity exactly a2, ..., and at least one with complexity exactly an. Of course, the round can also have problems with other complexities.George has a poor imagination. It's easier for him to make some already prepared problem simpler than to come up with a new one and prepare it. George is magnificent at simplifying problems. He can simplify any already prepared problem with complexity c to any positive integer complexity d (c ≥ d), by changing limits on the input data.However, nothing is so simple. George understood that even if he simplifies some problems, he can run out of problems for a good round. That's why he decided to find out the minimum number of problems he needs to come up with in addition to the m he's prepared in order to make a good round. Note that George can come up with a new problem of any complexity.

The first line contains two integers n and m (1 ≤ n, m ≤ 3000) — the minimal number of problems in a good round and the number of problems George's prepared. The second line contains space-separated integers a1, a2, ..., an (1 ≤ a1 < a2 < ... < an ≤ 106) — the requirements for the complexity of the problems in a good round. The third line contains space-separated integers b1, b2, ..., bm (1 ≤ b1 ≤ b2... ≤ bm ≤ 106) — the complexities of the problems prepared by George.

Print a single integer — the answer to the problem.

NoteIn the first sample the set of the prepared problems meets the requirements for a good round.In the second sample, it is enough to come up with and prepare two problems with complexities 2 and 3 to get a good round.In the third sample it is very easy to get a good round if come up with and prepare extra problems with complexities: 2, 3, 4.

main = do
    getLine
    a<-getLine
    b<-getLine
    putStr $ solve (reverse(map read (words a))) (reverse(map read (words b))) 0
solve::[Int]->[Int]->Int->String
solve [] _ acc = show acc
solve x [] acc = show (length x+acc)
solve (x:xs) (y:ys) acc
    |y<x        = solve xs (y:ys) (acc+1)
    |otherwise  = solve xs ys acc

import Control.Monad

deal [] _ = []
deal as [] = as
deal (a:as) (b:bs)
  | a <= b = deal as bs
  | True = deal (a:as) bs

main = do
  [n, m] <- liftM (map read . words) getLine :: IO [Int]
  as <- liftM (map read . words) getLine :: IO [Int]
  bs <- liftM (map read . words) getLine :: IO [Int]
  putStrLn . show . length $ deal as bs

import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.List
import Control.Monad
import Control.Monad.ST.Safe
-- import Debug.Trace

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

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f as [] = length as
    f [] _ = 0
    f (a:as) (b:bs) = if a <= b then f as bs else f (a:as) bs

  print $ f as bs

main = getContents >>= print . (\[[n, m], a, b] -> n - f a b) . map (map read . words) . lines
f _ [] = 0
f [] _ = 0
f (a:as) (b:bs)
  | b < a = f (a:as) bs
  | otherwise = 1 + f as bs

solve :: [Int] -> [Int] -> Int
solve [] wants = length wants
solve _ []     = 0
solve (h:ht) ws@(w:wt)
  | h >= w    = solve ht wt
  | otherwise = solve ht ws

(-->) = flip fmap

main = do
  (n:m:_) <- getLine --> words --> map read
  wants <- getLine --> words --> take n --> map read
  haves <- getLine --> words --> take m --> map read
  print $ solve haves wants

doprob [] ys = 0
doprob xs [] = length xs
doprob (x:xs) (y:ys)
  | x > y  = doprob (x:xs) ys
  | x == y = doprob xs ys
  | x < y  = doprob xs ys

tolist :: String -> [Int]
tolist = map read . words

main = do
  _ <- getLine
  reqd <- getLine
  george <- getLine
  putStrLn $ show $ doprob (tolist reqd) (tolist george)

main = do
   nm <- getLine
   an <- getLine
   bn <- getLine
   let xs = map read (words an) :: [Int]
       ys = map read (words bn) :: [Int]
       ans = solve xs ys
   print ans

solve [] _ = 0
solve xs [] = length xs
solve (x:xs) (y:ys)
   | x <= y    = solve xs ys
   | otherwise = solve (x:xs) ys

main = do
    getLine
    a<-getLine
    b<-getLine
    putStr $ solve (reverse(map read (words a))) (reverse(map read (words b))) 0
solve::[Int]->[Int]->Int->String
solve [] _ acc = show acc
solve x [] acc = show (length x+acc)
solve (x:xs) (y:ys) acc
    |y<x        = solve xs ys (acc+1)
    |otherwise  = solve xs ys acc

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

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f as _ = length as
    f _ [] = 0
    f (a:as) (b:bs) = (if b >= a then 0 else 1) + f as bs

  print $ f (reverse as) (reverse bs)

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

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f [] _ = 0
    f _ [] = 0
    f (a:as) (b:bs) = (if b >= a then 0 else 1) + f as bs

  print $ f (reverse as) (reverse bs)

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

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f as [] = length as
    f [] _ = 0
    f (a:as) (b:bs) = (if b >= a then 0 else 1) + f as bs

  print $ f (reverse as) (reverse bs)

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

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  print $ length $ as \\ bs

main = getContents >>= print . (\[[n, m], a, b] -> n - f a b) . map (map read . words) . lines
f _ [] = 0
f [] _ = 0
f (a:as) (b:bs)
  | b < a = f (a:as) bs
  | b > a = f as (b:bs)
  | b == a = 1 + f as bs

doprob [] ys = 0
doprob xs [] = length xs
doprob (x:xs) (y:ys)
  | x > y = 1 + doprob xs ys
  | x <= y = doprob xs ys

tolist :: String -> [Int]
tolist = map read . words

main = do
  _ <- getLine
  reqd <- getLine
  george <- getLine
  putStrLn $ show $ doprob (tolist reqd) (tolist george)


Petya recieved a gift of a string s with length up to 105 characters for his birthday. He took two more empty strings t and u and decided to play a game. This game has two possible moves:  Extract the first character of s and append t with this character.  Extract the last character of t and append u with this character. Petya wants to get strings s and t empty and string u lexicographically minimal.You should write a program that will help Petya win the game.

First line contains non-empty string s (1 ≤ |s| ≤ 105), consisting of lowercase English letters.

import Data.List
import qualified Data.IntMap as Map
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List
import Data.Char

decreaseElem Nothing = Nothing
decreaseElem (Just x) = if x > 1 then (Just (x - 1)) else Nothing

solve [] [] u _ = u
solve [] (t:ts) u f = solve [] ts (t:u) f
solve (s:ss) [] u f = solve ss [s] u (Map.alter decreaseElem s f)
solve (s:ss) (t:ts) u f
 | t <= (fst $ Map.findMin f) = solve (s:ss) ts (t:u) f
 | otherwise = solve ss (s:t:ts) u (Map.alter decreaseElem s f)

getFreq [] f = f
getFreq (x:xs) f = getFreq xs (Map.insertWith (+) x 1 f)

main = do
  v <- (map ord) <$> getLine
  putStrLn $ map chr $ reverse $ solve v [] [] (getFreq v Map.empty)

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (unpack, reverse, dropWhile)
import qualified Data.Map.Strict as M (adjust, insert, findMin, empty, alter, member, Map)
import qualified Data.List as L (sort)
import Data.Char (isSpace)

run [] _ [] = ""
run (t:ts) _ [] = t:run ts (M.empty) []
run [] mm (x:xs) = run [x] (M.alter f x mm) xs
run (t:ts) mm (x:xs) | t <= ms   = t:run ts mm (x:xs)
                     | otherwise = run (x:t:ts) (M.alter f x mm) xs where
    (ms, _) = M.findMin mm

f (Just 1) = Nothing
f (Just x) = Just (x - 1)

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

cmap [] m = m
cmap (x:xs) m | M.member x m = cmap xs (M.adjust succ x m)
              | otherwise    = cmap xs (M.insert x 1 m)

main = do
    (C.unpack . rstrip -> xs) <- B.getLine
    putStrLn $ run [] (cmap (L.sort xs) M.empty) xs

import Data.List
import qualified Data.IntMap as Map
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List
import Data.Char

solve [] [] u _ _ _ = u
solve [] (t:ts) u c nc f = solve [] ts (t:u) c nc f
solve (s:ss) t u c nc f
 | (not.null) t && (head t) <= c = solve (s:ss) (tail t) ((head t):u) c nc f
 | s == c
    = if nc > 1
        then solve ss t (s:u) c (nc - 1) f
        else solve ss t (s:u) (c + 1) (Map.findWithDefault 0 (c + 1) f) (Map.delete c f)
 | otherwise = solve ss (s:t) u c nc (Map.insertWith (+) c (-1) f)

getFreq [] f = f
getFreq (x:xs) f = getFreq xs (Map.insertWith (+) x 1 f)

main = do
  v <- (map ord) <$> getLine
  let f = getFreq v Map.empty
      a = ord 'a'
  putStrLn $ map chr $ reverse $ solve v [] [] a (f Map.! a) f

import Data.List
import qualified Data.IntMap as Map
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List
import Data.Char

solve [] [] u _ _ _ = u
solve [] (t:ts) u c nc f = solve [] ts (t:u) c nc f
solve (s:ss) t u c nc f
 | (not.null) t && (head t) <= c = solve (s:ss) (tail t) ((head t):u) c nc f
 | nc == 0 = solve (s:ss) t u (c + 1) (Map.findWithDefault 0 (c + 1) f) (Map.delete c f)
 | s == c = solve ss t (s:u) c (nc - 1) f
 | otherwise = solve ss (s:t) u c nc (Map.insertWith (+) c (-1) f)

getFreq [] f = f
getFreq (x:xs) f = getFreq xs (Map.insertWith (+) x 1 f)

main = do
  v <- (map ord) <$> getLine
  let f = getFreq v Map.empty
      a = ord 'a'
  putStrLn $ map chr $ reverse $ solve v [] [] a (Map.findWithDefault 0 a f) f

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (unpack)
import qualified Data.Map.Strict as M (adjust, insert, findMin, empty, alter, member, Map)
import qualified Data.List as L (sort)

run [] _ [] = ""
run (t:ts) _ [] = t:run ts (M.empty) []
run [] mm (x:xs) = run [x] (M.alter f x mm) xs
run (t:ts) mm (x:xs) | t <= ms   = t:run ts mm (x:xs)
                     | otherwise = run (x:t:ts) (M.alter f x mm) xs where
    (ms, _) = M.findMin mm

f (Just 1) = Nothing
f (Just x) = Just (x - 1)

cmap [] m = m
cmap (x:xs) m | M.member x m = cmap xs (M.adjust succ x m)
              | otherwise    = cmap xs (M.insert x 1 m)

main = do
    (C.unpack -> xs) <- B.getLine
    putStrLn $ run [] (cmap (L.sort xs) M.empty) xs

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (unpack)
import qualified Data.Map.Strict as M (adjust, insert, findMin, empty, alter, member, Map)
import qualified Data.List as L (sort)

run [] _ [] = ""
run (t:ts) _ [] = t:run ts (M.empty) []
run [] mm (x:xs) = run [x] (M.alter f x mm) xs
run (t:ts) mm (x:xs) | t <= ms   = t:run ts mm (x:xs)
                     | otherwise = run (x:t:ts) (M.alter f x mm) xs where
    (ms, _) = M.findMin mm

f (Just 1) = Nothing
f (Just x) = Just (x - 1)

cmap [] m = m
cmap (x:xs) m | M.member x m = cmap xs (M.adjust succ x m)
              | otherwise    = cmap xs (M.insert x 1 m)

main = do
    (C.unpack -> xs) <- B.getLine
    putStr $ run [] (cmap (L.sort xs) M.empty) xs


Three friends are going to meet each other. Initially, the first friend stays at the position $$$x = a$$$, the second friend stays at the position $$$x = b$$$ and the third friend stays at the position $$$x = c$$$ on the coordinate axis $$$Ox$$$.In one minute each friend independently from other friends can change the position $$$x$$$ by $$$1$$$ to the left or by $$$1$$$ to the right (i.e. set $$$x := x - 1$$$ or $$$x := x + 1$$$) or even don't change it.Let's introduce the total pairwise distance — the sum of distances between each pair of friends. Let $$$a'$$$, $$$b'$$$ and $$$c'$$$ be the final positions of the first, the second and the third friend, correspondingly. Then the total pairwise distance is $$$|a' - b'| + |a' - c'| + |b' - c'|$$$, where $$$|x|$$$ is the absolute value of $$$x$$$.Friends are interested in the minimum total pairwise distance they can reach if they will move optimally. Each friend will move no more than once. So, more formally, they want to know the minimum total pairwise distance they can reach after one minute.You have to answer $$$q$$$ independent test cases.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 1000$$$) — the number of test cases. The next $$$q$$$ lines describe test cases. The $$$i$$$-th test case is given as three integers $$$a, b$$$ and $$$c$$$ ($$$1 \le a, b, c \le 10^9$$$) — initial positions of the first, second and third friend correspondingly. The positions of friends can be equal.

For each test case print the answer on it — the minimum total pairwise distance (the minimum sum of distances between each pair of friends) if friends change their positions optimally. Each friend will move no more than once. So, more formally, you have to find the minimum total pairwise distance they can reach after one minute.

module Main where

import Control.Monad
import Data.List

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

getNLists :: (Read a) => Int -> IO [[a]]
getNLists n = sequence $ replicate n getList

main :: IO ()
main = do
    cas <- readLn
    replicateM_ cas $ do
        [a, b, c] <- sort <$> getList
        print $ cal a b c

cal :: Int -> Int -> Int -> Int
cal a b c
    | a == b && b == c = 0
    | otherwise = max 0 ((c - a) * 2 - 4)

import Control.Monad

solve :: [Int] -> Int
solve l = max 0 (2*(ma-mi-2))
  where
    ma= maximum l
    mi= minimum l

routine :: IO ()
routine = do
  l <- (map read.words) <$> getLine
  print $ solve l

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

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

findMin :: [Int] -> Int
findMin xs = max 0 (2*(mx - mn - 2)) where
    [mn, mid, mx] = sort xs

readLine :: IO [Int]
readLine = (map read) . words <$> getLine

main =
    read <$> getLine >>= \q ->
    replicateM_ q (findMin <$> readLine >>= print)


You are given a string $$$s$$$ of length $$$n$$$, which consists only of the first $$$k$$$ letters of the Latin alphabet. All letters in string $$$s$$$ are uppercase.A subsequence of string $$$s$$$ is a string that can be derived from $$$s$$$ by deleting some of its symbols without changing the order of the remaining symbols. For example, "ADE" and "BD" are subsequences of "ABCDE", but "DEA" is not.A subsequence of $$$s$$$ called good if the number of occurences of each of the first $$$k$$$ letters of the alphabet is the same.Find the length of the longest good subsequence of $$$s$$$.

The first line of the input contains integers $$$n$$$ ($$$1\le n \le 10^5$$$) and $$$k$$$ ($$$1 \le k \le 26$$$). The second line of the input contains the string $$$s$$$ of length $$$n$$$. String $$$s$$$ only contains uppercase letters from 'A' to the $$$k$$$-th letter of Latin alphabet.

Print the only integer — the length of the longest good subsequence of string $$$s$$$.

NoteIn the first example, "ACBCAB" ("ACAABCCAB") is one of the subsequences that has the same frequency of 'A', 'B' and 'C'. Subsequence "CAB" also has the same frequency of these letters, but doesn't have the maximum possible length.In the second example, none of the subsequences can have 'D', hence the answer is $$$0$$$.

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

main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  s <- getLine

  let count = [length $ filter (==c) s | c <- map (chr . (+(ord 'A'))) [0..k-1]]

  print $ minimum count * k

import Data.List

main = do
       e<-getLine
       e2<-getLine
       let (n:k:[])=map read (words e)::[Int]
           xs=map length $ group $ sort e2
       print $ if k==(length xs) then k*(minimum xs) else 0

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

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

count :: B8.ByteString -> MapS.Map Char Int
count string = B8.foldr' (flip update) MapS.empty string
    where update map char = MapS.alter (\value -> Just $ 1 + fromMaybe 0 value) char map

main :: IO ()
main = do
    [n, k] <- (map readB8Int) <$> B8.words <$> B8.getLine
    string <- B8.getLine
    let keys = take k ['A'..'Z']
    let counts = count string
    let charCount = foldr1 min . map (\x -> fromMaybe 0 $ MapS.lookup x counts) $ keys
    printf "%d\n" (charCount * k)

import Control.Applicative
import Control.Monad
import Data.Array
import Data.List
import Data.Ord

main = sol <$> get <*> getLine >>= print

get = map read . words <$> getLine

sol [n,k] s = (* k) . last . take k . sortBy (flip compare) . elems . accumArray (+) 0 ('A','Z') . zip s $ repeat 1

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

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

longestGoodSubsequence :: Int -> String -> Int
longestGoodSubsequence k s
    | c /= k    = 0
    | otherwise = c * b
        where a = map length $ group $ sort s
              b = minimum a
              c = length a

main :: IO ()
main = do
    [n, k] <- readInts
    s      <- getLine
    print $ longestGoodSubsequence k s

import Data.List
main = interact $ show . solve . tail . words
solve [k,s] | length fs < read k = 0
            | otherwise = read k * minimum fs
  where fs = map length $ group $ sort s

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

main = do
		[n,k]<-map read <$> words <$> getLine ::IO [Int]
		s<-getLine
		let m=  map length $ group $ sort s
		print $ if length m <k then 0 else k*minimum m

{-# LANGUAGE ViewPatterns #-}
module Main where
import Data.Array.Unboxed

main = interact exec
exec = show . (\[_, read -> k, xs] -> solve k xs) . words
solve k xs = (k *) $ minimum $ take k $ elems (accumArray (+) 0 ('A', 'Z') $ zip xs (repeat 1) :: UArray Char Int)

import Data.List (sort, group)

process :: Int -> [Char] -> Int
process k xs = k * minimum (take k $ ls ++ (repeat 0))
    where ls = map length $ group $ sort xs

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n, k] <- fmap (map readInt.words) getLine
    xs <- getLine
    print $ process k xs

import Data.List
main = interact $ show . solve . tail . words
solve (k:s) | length fs < read k = 0
            | otherwise = read k * minimum fs
  where fs = map length $ group $ sort s


Alice and Bob love playing one-dimensional battle ships. They play on the field in the form of a line consisting of n square cells (that is, on a 1 × n table).At the beginning of the game Alice puts k ships on the field without telling their positions to Bob. Each ship looks as a 1 × a rectangle (that is, it occupies a sequence of a consecutive squares of the field). The ships cannot intersect and even touch each other.After that Bob makes a sequence of "shots". He names cells of the field and Alice either says that the cell is empty ("miss"), or that the cell belongs to some ship ("hit").But here's the problem! Alice like to cheat. May be that is why she responds to each Bob's move with a "miss". Help Bob catch Alice cheating — find Bob's first move, such that after it you can be sure that Alice cheated.

The first line of the input contains three integers: n, k and a (1 ≤ n, k, a ≤ 2·105) — the size of the field, the number of the ships and the size of each ship. It is guaranteed that the n, k and a are such that you can put k ships of size a on the field, so that no two ships intersect or touch each other. The second line contains integer m (1 ≤ m ≤ n) — the number of Bob's moves. The third line contains m distinct integers x1, x2, ..., xm, where xi is the number of the cell where Bob made the i-th shot. The cells are numbered from left to right from 1 to n.

Print a single integer — the number of such Bob's first move, after which you can be sure that Alice lied. Bob's moves are numbered from 1 to m in the order the were made. If the sought move doesn't exist, then print "-1".

import Data.IntSet (insert,fromList, lookupGT, lookupLE)
import Control.Applicative ((<$>))

main = do
        [n,k,a] <- map read . words <$> getLine
        getLine
        map read .words <$> getLine >>= putStrLn . show . solve n k (a+1)

solve :: Int->Int->Int->[Int]->Int
solve n k a  = let  tot = (n+1) `div` a
                    check _ _ _ [] = -1
                    check s c t (x:xs) = if t'< k then c else check (insert x s) (c+1) t' xs
                                where Just r = lookupGT x s
                                      Just l = lookupLE x s
                                      t' = t + (x-l)`div`a + (r-x)`div`a - (r-l)`div`a
                in check (fromList [0, n+1]) 1 tot

import Data.IntSet (insert, fromList, lookupGT, lookupLE)

main = interact $ show. solve. map read.words

solve :: [Int]->Int
solve (n:k:a:_:x)  = let tot = (n+1) `div` (a+1)
                         check _ _ _ [] = -1
                         check s c t (x:xs) = if t'< k then c else check (insert x s) (c+1) t' xs
                                where Just r = lookupGT x s
                                      Just l = lookupLE x s
                                      t' = t + (x-l)`div`(a+1) + (r-x)`div`(a+1) - (r-l)`div`(a+1)
                     in check (fromList [0, n+1]) 1 tot x

import Data.IntSet (insert,fromList, lookupGT, lookupLE)
import Control.Applicative ((<$>))

main = do
        [n,k,a] <- map read . words <$> getLine
        getLine
        x <-  map read . words <$> getLine
        putStrLn $ show $ solve n k (a+1)  x

solve :: Int->Int->Int->[Int]->Int
solve n k a  = let  tot = (n+1) `div` a
                    check _ _ _ [] = -1
                    check s c t (x:xs) = if t'< k then c else check (insert x s) (c+1) t' xs
                                where Just r = lookupGT x s
                                      Just l = lookupLE x s
                                      t' = t + (x-l)`div`a + (r-x)`div`a - (r-l)`div`a
                in check (fromList [0, n+1]) 1 tot

import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Set (Set, fromList, lookupLT, lookupGT, insert)

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: Int -> Int -> Int -> [Int] -> Int
solve n k a xs = foldr loop (`seq` -1) xs init
    where
    init = (1, (n + 1) `div` (a + 1) - k, fromList [0, n + 1])
    count x y = (y - x) `div` (a + 1)

    loop i f (acc, buf, obs)
        | buf' < 0  = acc
        | otherwise = f (acc + 1, buf', i `insert` obs)
        where
        u = fromJust $ i `lookupLT` obs
        v = fromJust $ i `lookupGT` obs
        buf' = buf + count u i + count i v - count u v

main = do
    [n, k, a] <- parse <$> B.getLine
    B.getLine
    xs <- parse <$> B.getLine
    print $ solve n k a xs

import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Set (Set, fromList, lookupLT, lookupGT, insert)

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: Int -> Int -> Int -> [Int] -> Int
solve n k a xs = foldr loop (`seq` -1) xs init
    where
    init = (1, n `div` a - k, fromList [0, n + 1])
    count x y = (y - x - 1) `div` a

    loop i f (acc, buf, obs)
        | buf' < 0  = acc
        | otherwise = f (acc + 1, buf', i `insert` obs)
        where
        u = fromJust $ i `lookupLT` obs
        v = fromJust $ i `lookupGT` obs
        buf' = buf - count u v + count u i + count i v

main = do
    [n, k, a] <- parse <$> B.getLine
    B.getLine
    xs <- parse <$> B.getLine
    print $ solve n k a xs