People worry that computers will get too smart and take over the world, but the real problem is that they're too stupid and they've already taken over the world.— Pedro DomingosYou work for a well-known department store that uses leading technologies and employs mechanistic work — that is, robots!The department you work in sells $$$n \cdot k$$$ items. The first item costs $$$1$$$ dollar, the second item costs $$$2$$$ dollars, and so on: $$$i$$$-th item costs $$$i$$$ dollars. The items are situated on shelves. The items form a rectangular grid: there are $$$n$$$ shelves in total, and each shelf contains exactly $$$k$$$ items. We will denote by $$$a_{i,j}$$$ the price of $$$j$$$-th item (counting from the left) on the $$$i$$$-th shelf, $$$1 \le i \le n, 1 \le j \le k$$$.Occasionally robots get curious and ponder on the following question: what is the mean price (arithmetic average) of items $$$a_{i,l}, a_{i,l+1}, \ldots, a_{i,r}$$$ for some shelf $$$i$$$ and indices $$$l \le r$$$? Unfortunately, the old robots can only work with whole numbers. If the mean price turns out not to be an integer, they break down.You care about robots' welfare. You want to arrange the items in such a way that the robots cannot theoretically break. Formally, you want to choose such a two-dimensional array $$$a$$$ that:  Every number from $$$1$$$ to $$$n \cdot k$$$ (inclusively) occurs exactly once.  For each $$$i, l, r$$$, the mean price of items from $$$l$$$ to $$$r$$$ on $$$i$$$-th shelf is an integer. Find out if such an arrangement is possible, and if it is, give any example of such arrangement.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases. The first and only line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n, k \le 500$$$) — the number of shelves and length of each shelf, respectively. It is guaranteed that the sum $$$n$$$ over all test cases does not exceed $$$500$$$ and the sum $$$k$$$ over all test cases does not exceed $$$500$$$.

Print the answer for each test case. If such an arrangement exists, print "YES" on a single line. After that, print any example on $$$n$$$ lines of $$$k$$$ numbers each, one line per shelf. Each number from $$$1$$$ to $$$n \cdot k$$$ must occur exactly once in the output. If no good arrangement exists, print a single word "NO" on its own line.

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM t $ do
        line <- getLine
        let [n, k] = map read $ words line :: [Int]
        let (possible, solution) = solve n k
        if possible
           then do
               putStrLn "YES"
               mapM_ (putStrLn . spaceSeparate) solution
           else putStrLn "NO"
    return ()

solve :: Int -> Int -> (Bool, [[Int]])
solve n k
  | k == 1          = (True, map (:[]) [1..n])
  | mod n 2 == 0    = (True, makeGrid n k)
  | otherwise       = (False, [])

-- first all the even numbers from 2 to n*k
-- then all the odd numbers from 1 to n*k
makeGrid :: Int -> Int -> [[Int]]
makeGrid n k =
    evens ++ odds
      where
          evens = [map (2*i*k+) [2,4..2*k] | i <- [0..mid-1]]
          odds = [map (2*i*k+) [1,3..2*k] | i <- [0..mid-1]]
          mid = div n 2

spaceSeparate :: (Show a) => [a] -> String
spaceSeparate xs = foldr (++) "" $ intersperse " " $ map show xs

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM t $ do
        line <- getLine
        let [n, k] = map read $ words line :: [Int]
        let (possible, solution) = solve n k
        if possible
           then do
               putStrLn "YES"
               mapM_ putStrLn solution
           else putStrLn "NO"
    return ()

solve :: Int -> Int -> (Bool, [String])
solve n k
  | k == 1          = (True, map show [1..n])
  | mod n 2 == 0    = (True, map spaceSeparate $ makeGrid n k)
  | otherwise       = (False, [])

-- first all the even numbers from 2 to n*k
-- then all the odd numbers from 1 to n*k
makeGrid :: Int -> Int -> [[Int]]
makeGrid n k =
    evens ++ odds
      where
          evens = [map (2*i*k+) [2,4..2*k] | i <- [0..mid-1]]
          odds = [map (2*i*k+) [1,3..2*k] | i <- [0..mid-1]]
          mid = div n 2

spaceSeparate :: (Show a) => [a] -> String
spaceSeparate xs = foldr (++) "" $ intersperse " " $ map show xs

import Control.Monad (replicateM_)
import Data.Bits
import Data.Set (Set)
import qualified Data.Set as Set

getElem :: Read t => IO t
getElem = getLine >>= return . read

getElems :: Read t => IO [t]
getElems = getLine >>= return . map read . words

main = do
    t <- getElem
    replicateM_ t $ do
        n:k:_ <- getElems :: IO [Int]
        if even n || k == 1 then do
            let odds = [1,3..n*k]
            let evens = [2,4..n*k]
            putStrLn "YES"
            showAns odds evens k
        else do
            putStrLn "NO"
            return ()
    where
        showAns :: [Int] -> [Int] -> Int -> IO ()
        showAns [] _ _ = return ()
        showAns this that k = do
            let (this1, this2) = splitAt k this
            putStrLn $ this1 >>= (' ' :) . show
            showAns that this2 k

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
import Control.Monad
solve :: Int -> Int -> Maybe [[Int]]
solve n k
  | k == 1 = Just [[i] | i <- [1..n]]
  | odd n = Nothing
  | otherwise = Just do
    i <- [0..n-1]
    return $ do
      let !(i', p) = divMod i 2
      j <- [0..k-1]
      return $! 2 * (i' * k + j) + p + 1

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    [n, k] <- map read . words <$> getLine
    case solve n k of
      Nothing -> putStrLn "NO"
      Just xss -> do
        putStrLn "YES"
        forM_ xss $ \xs -> putStrLn $ unwords $ map show xs

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

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

solve :: Int -> Int -> Maybe [[Int]]
solve n 1 = Just $ map pure [1 .. n]
solve n k = if  odd n
  then  Nothing
  else  Just $ do
  start <- [0, 2 .. n - 1]
  [take k [start*k + 1, start*k + 3 ..], take k [start*k + 2, start*k + 4 ..]]

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    k <- getInt
    pure $ case  solve n k  of
      Nothing -> string7 "NO\n"
      Just li -> string7 "YES\n" <> foldMap putInts li

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM t $ do
        line <- getLine
        let [n, k] = map read $ words line :: [Int]
        let (possible, solution) = solve n k
        if possible
           then do
               putStrLn "YES"
               mapM_ putStrLn solution
           else putStrLn "NO"
    return ()

solve :: Int -> Int -> (Bool, [String])
solve n k
  | k == 1          = (True, map show [1..n])
  | mod n 2 == 0    = (True, ans)
  | otherwise       = (False, [])
    where
        mid = div (n*k) 2
        ans = [spaceSeparate (map (i+) [2,4..k*2]) | i <- [0,2*k..mid-1]] ++
            [spaceSeparate (map (i+) [1,3..k*2]) | i <- [0,2*k..mid-1]]

spaceSeparate :: (Show a) => [a] -> String
spaceSeparate xs = foldr (++) "" $ intersperse " " $ map show xs

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM t $ do
        line <- getLine
        let [n, k] = map read $ words line :: [Int]
        let (possible, solution) = solve n k
        if possible
           then do
               putStrLn "YES"
               mapM_ putStrLn solution
           else putStrLn "NO"
    return ()

solve :: Int -> Int -> (Bool, [String])
solve n k
  | k == 1          = (True, map show [1..n])
  | mod n 2 == 0    = (True, ans)
  | otherwise       = (False, [])
    where
        mid = div (n*k) 2
        ans = [spaceSeparate (map (i+) [2,4..k*2]) | i <- [0,k..mid-1]] ++
            [spaceSeparate (map (i+) [1,3..k*2]) | i <- [0,k..mid-1]]

spaceSeparate :: (Show a) => [a] -> String
spaceSeparate xs = foldr (++) "" $ intersperse " " $ map show xs


The next lecture in a high school requires two topics to be discussed. The $$$i$$$-th topic is interesting by $$$a_i$$$ units for the teacher and by $$$b_i$$$ units for the students.The pair of topics $$$i$$$ and $$$j$$$ ($$$i < j$$$) is called good if $$$a_i + a_j > b_i + b_j$$$ (i.e. it is more interesting for the teacher).Your task is to find the number of good pairs of topics.

The first line of the input contains one integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the number of topics. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the interestingness of the $$$i$$$-th topic for the teacher. The third line of the input contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$1 \le b_i \le 10^9$$$), where $$$b_i$$$ is the interestingness of the $$$i$$$-th topic for the students.

Print one integer — the number of good pairs of topic.

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

main = do
  getLine
  as <- map read.words <$> getLine
  bs <- map read.words <$> getLine
  print $ (`div` 2) $ f 0.sort <*> sort.map negate $ zipWith (-) as bs

f x (a:as) bs = x' - toInteger (fromEnum (a > 0)) + f x' as gt where
  (lt, gt) = span (< a) bs
  x' = x + genericLength lt
f _ _ _ = 0

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

main = do
  getLine
  as <- map read.words <$> getLine
  bs <- map read.words <$> getLine
  print $ (`div` 2) $ f 0.sort <*> sort.map negate $ zipWith (-) as bs

f x (a:as) bs = x' - fromEnum (a > 0) + f x' as gt where
  (lt, gt) = span (< a) bs
  x' = x + length lt
f _ _ _ = 0

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

main = do
  getLine
  as <- map read.words <$> getLine
  bs <- map read.words <$> getLine
  print $ (`div` 2) $ f 0.sort <*> sort.map negate $ zipWith (-) as bs

f x (a:as) bs = x' - fromEnum (a > 0) + f x' as gt where
  (lt, gt) = span (< a) bs
  x' = x + genericLength lt
f _ _ _ = 0


The busses in Berland are equipped with a video surveillance system. The system records information about changes in the number of passengers in a bus after stops.If $$$x$$$ is the number of passengers in a bus just before the current bus stop and $$$y$$$ is the number of passengers in the bus just after current bus stop, the system records the number $$$y-x$$$. So the system records show how number of passengers changed.The test run was made for single bus and $$$n$$$ bus stops. Thus, the system recorded the sequence of integers $$$a_1, a_2, \dots, a_n$$$ (exactly one number for each bus stop), where $$$a_i$$$ is the record for the bus stop $$$i$$$. The bus stops are numbered from $$$1$$$ to $$$n$$$ in chronological order.Determine the number of possible ways how many people could be in the bus before the first bus stop, if the bus has a capacity equals to $$$w$$$ (that is, at any time in the bus there should be from $$$0$$$ to $$$w$$$ passengers inclusive).

The first line contains two integers $$$n$$$ and $$$w$$$ $$$(1 \le n \le 1\,000, 1 \le w \le 10^{9})$$$ — the number of bus stops and the capacity of the bus. The second line contains a sequence $$$a_1, a_2, \dots, a_n$$$ $$$(-10^{6} \le a_i \le 10^{6})$$$, where $$$a_i$$$ equals to the number, which has been recorded by the video system after the $$$i$$$-th bus stop.

Print the number of possible ways how many people could be in the bus before the first bus stop, if the bus has a capacity equals to $$$w$$$. If the situation is contradictory (i.e. for any initial number of passengers there will be a contradiction), print 0.

NoteIn the first example initially in the bus could be $$$0$$$, $$$1$$$ or $$$2$$$ passengers.In the second example initially in the bus could be $$$1$$$, $$$2$$$, $$$3$$$ or $$$4$$$ passengers.In the third example initially in the bus could be $$$0$$$ or $$$1$$$ passenger.

import qualified Data.ByteString.Lazy.Char8 as B
import Data.List

main = do
  inp <- fmap B.lines $ B.getContents
  let [n,w] = map readI $ B.words $ inp!!0
  let as = map readI $ B.words $ inp!!1
  print (solve w as)

readI :: B.ByteString -> Int
readI s = case B.readInt s of Just (n,_) -> n

solve :: Int -> [Int] -> Int
solve w as =
  max c 0
  where
    c = w - u1 + 1 + (min 0 u0)

    bs = scanl (+) 0 as

    u1 = maximum bs
    u0 = minimum bs

import Data.List
main = do
  [n, w] <- getLine >>= return. map read. words :: IO [Integer]
  a <- getLine >>= return. scanl (+) 0. map read. words
  print. max 0 $ 1 + w - maximum a + minimum a

import qualified Data.ByteString.Lazy.Char8 as B
import Data.List

main = do
  inp <- fmap B.lines $ B.getContents
  let [n,w] = map readI $ B.words $ inp!!0
  let as = map readI $ B.words $ inp!!1
  print (solve w as)

readI :: B.ByteString -> Int
readI s = case B.readInt s of Just (n,_) -> n

solve :: Int -> [Int] -> Int
solve w as =
  w - u1 + 1 + (min 0 u0)
  where
    bs = scanl (+) 0 as

    u1 = maximum bs
    u0 = minimum bs


You are given an array of integers $$$b_1, b_2, \ldots, b_n$$$.An array $$$a_1, a_2, \ldots, a_n$$$ of integers is hybrid if for each $$$i$$$ ($$$1 \leq i \leq n$$$) at least one of these conditions is true:   $$$b_i = a_i$$$, or  $$$b_i = \sum_{j=1}^{i} a_j$$$. Find the number of hybrid arrays $$$a_1, a_2, \ldots, a_n$$$. As the result can be very large, you should print the answer modulo $$$10^9 + 7$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$). The second line of each test case contains $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$-10^9 \le b_i \le 10^9$$$). It is guaranteed that the sum of $$$n$$$ for all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print a single integer: the number of hybrid arrays $$$a_1, a_2, \ldots, a_n$$$ modulo $$$10^9 + 7$$$.

import Data.Map (Map, singleton, findWithDefault, insert)
import Data.Int (Int64)

parseInt :: String -> Int
parseInt x = read x

parseInt64 :: String -> Int64
parseInt64 x = read x

split      :: Eq a => a -> [a] -> [[a]]
split d [] =  []
split d s  =  x : split d (drop 1 y) where (x,y) = span (/= d) s

addMod :: Int -> Int -> Int
addMod a b = mod (a + b) 1000000007

solve :: [Int64] -> Int
solve xs = go xs (singleton 0 1) 0 1 where
    go :: [Int64] -> Map Int64 Int -> Int64 -> Int -> Int
    go []     s d r = r
    go (x:xs) s d r = go xs s' d' r' where
        k  = addMod r (1000000007 - findWithDefault 0 (-d) s)
        r' = addMod r k
        d' = d + x
        s' = insert (-d) r s

run :: IO ()
run = do
    n <- getLine
    b <- getLine
    print $ solve $ map parseInt64 $ split ' ' b

runK :: Int -> IO ()
runK 1 = run
runK k = run >>= (\x -> runK (k-1))

main = do
    t <- getLine
    runK $ parseInt t

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

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

kMod :: Int64
kMod = 1000000007

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    bs <- map fromIntegral <$> getInts :: IO [Int64]
    let
      acc (total, totalSuf, sufs, offset) b = (total', totalSuf', sufs', offset')
        where
        totalSuf' = case M.lookup (-offset) sufs of
          Nothing -> (totalSuf * 2) `mod` kMod
          Just c -> (totalSuf * 2 + kMod - c) `mod` kMod
        sufs' = M.insert (-offset) totalSuf sufs
        offset' = offset + b
        total' = (total + totalSuf + kMod - M.findWithDefault 0 (-offset) sufs) `mod` kMod
      (result, _, _, _) = foldl' acc (1, 1, M.singleton 0 1, 0) bs
    C.putStrLn $ C.pack $ show result

{-# LANGUAGE BangPatterns #-}
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.Int
import qualified Data.Map.Strict as M

type SIO = StateT P.ByteString IO

type Map = M.Map Int64 Int

p :: Int
p = 10 ^ (9 :: Int) + 7

-- Partitions into (nonempty) intervals, of which only the last may have sum 0
solve :: Map -> Int64 -> Int -> [Int] -> Int
solve _ _ prevOptsTot [_] = prevOptsTot -- extend each prevOpt to end
solve !excls !prevSum !prevOptsTot (b : bs) = let
  currExcl = M.findWithDefault 0 currSum excls
  currOpts = prevOptsTot - currExcl
  -- prevOptsTot = currOpts + currExcl
  nextExcls = M.insert currSum prevOptsTot excls
  currSum = prevSum + fromIntegral b
  currOptsTot = mod (prevOptsTot + currOpts) p
  in  solve nextExcls currSum currOptsTot bs
solve _ _ _ [] = 1

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  let  initMap = M.fromAscList [(0, 1)]
  replicateM_ t $ do
    [_n] <- readInts
    b <- readInts
    putInts [solve initMap 0 1 b]

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

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.Int
import qualified Data.Map.Strict as M

type SIO = StateT P.ByteString IO

type Map = M.Map Int64 Int

p :: Int
p = 10 ^ (9 :: Int) + 7

-- Partitions into (nonempty) intervals, of which only the last may have sum 0
solve :: Map -> Int64 -> Int -> [Int] -> Int
solve _ _ prevOptsTot [_] = prevOptsTot -- extend each prevOpt to end
solve excls prevSum prevOptsTot (b : bs) = let
  currExcl = M.findWithDefault 0 currSum excls
  currOpts = prevOptsTot - currExcl
  -- prevOptsTot = currOpts + currExcl
  nextExcls = M.insert currSum prevOptsTot excls
  currSum = prevSum + fromIntegral b
  currOptsTot = mod (prevOptsTot + currOpts) p
  in  solve nextExcls currSum currOptsTot bs
solve _ _ _ [] = 1

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  let  initMap = M.fromAscList [(0, 1)]
  replicateM_ t $ do
    [_n] <- readInts
    b <- readInts
    putInts [solve initMap 0 1 b]

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

import Data.Map (Map, singleton, findWithDefault, insert)

parseInt :: String -> Int
parseInt x = read x

split      :: Eq a => a -> [a] -> [[a]]
split d [] =  []
split d s  =  x : split d (drop 1 y) where (x,y) = span (/= d) s

addMod :: Int -> Int -> Int
addMod a b = mod (a + b) 1000000007

solve :: [Int] -> Int
solve xs = go xs (singleton 0 1) 0 1 where
    go :: [Int] -> Map Int Int -> Int -> Int -> Int
    go []     s d r = r
    go (x:xs) s d r = go xs s' d' r' where
        k  = addMod r (1000000007 - findWithDefault 0 (-d) s)
        r' = addMod r k
        d' = d + x
        s' = insert (-d) r s

run :: IO ()
run = do
    n <- getLine
    b <- getLine
    print $ solve $ map parseInt $ split ' ' b

runK :: Int -> IO ()
runK 1 = run
runK k = run >>= (\x -> runK (k-1))

main = do
    t <- getLine
    runK $ parseInt t

import Data.Map (Map, singleton, findWithDefault, insertWith)

parseInt :: String -> Int
parseInt x = read x

split      :: Eq a => a -> [a] -> [[a]]
split d [] =  []
split d s  =  x : split d (drop 1 y) where (x,y) = span (/= d) s

addMod :: Int -> Int -> Int
addMod a b = mod (a + b) 1000000007

solve :: [Int] -> Int
solve xs = go xs (singleton 0 1) 0 1 where
    go :: [Int] -> Map Int Int -> Int -> Int -> Int
    go []     s d r = r
    go (x:xs) s d r = go xs s' d' r' where
        k  = addMod r (1000000007 - findWithDefault 0 (-d) s)
        r' = addMod r k
        d' = d + x
        s' = insertWith addMod (-d) k s

run :: IO ()
run = do
    n <- getLine
    b <- getLine
    print $ solve $ map parseInt $ split ' ' b

runK :: Int -> IO ()
runK 1 = run
runK k = run >>= (\x -> runK (k-1))

main = do
    t <- getLine
    runK $ parseInt t

import Data.Map (Map, singleton, findWithDefault, insertWith)

parseInt :: String -> Int
parseInt x = read x

split      :: Eq a => a -> [a] -> [[a]]
split d [] =  []
split d s  =  x : split d (drop 1 y) where (x,y) = span (/= d) s

addMod :: Int -> Int -> Int
addMod a b = mod (a + b) 1000000007

solve :: [Int] -> Int
solve xs = go xs (singleton 0 1) 0 1 where
    go :: [Int] -> Map Int Int -> Int -> Int -> Int
    go []     s d r = r
    go (x:xs) s d r = go xs s' d' r' where
        k  = r - findWithDefault 0 (-d) s
        r' = addMod r k
        d' = d + x
        s' = insertWith addMod (-d) k s

run :: IO ()
run = do
    n <- getLine
    b <- getLine
    print $ solve $ map parseInt $ split ' ' b

runK :: Int -> IO ()
runK 1 = run
runK k = run >>= (\x -> runK (k-1))

main = do
    t <- getLine
    runK $ parseInt t

import Data.Map (Map, singleton, findWithDefault, insertWith)

parseInt :: String -> Int
parseInt x = read x

split      :: Eq a => a -> [a] -> [[a]]
split d [] =  []
split d s  =  x : split d (drop 1 y) where (x,y) = span (/= d) s

addMod :: Int -> Int -> Int
addMod a b = mod (a + b) 1000000007

solve :: [Int] -> Int
solve xs = go xs (singleton 0 1) 0 1 where
    go :: [Int] -> Map Int Int -> Int -> Int -> Int
    go []     s d r = r
    go (x:xs) s d r = go xs s' d' r' where
        k  = r + 1000000007 - findWithDefault 0 (-d) s
        r' = addMod r k
        d' = d + x
        s' = insertWith addMod (-d) k s

run :: IO ()
run = do
    n <- getLine
    b <- getLine
    print $ solve $ map parseInt $ split ' ' b

runK :: Int -> IO ()
runK 1 = run
runK k = run >>= (\x -> runK (k-1))

main = do
    t <- getLine
    runK $ parseInt t

import Data.List

parseInt :: String -> Int
parseInt x = read x

split :: Eq a => a -> [a] -> [[a]]
split chr = unfoldr sep where
    sep [] = Nothing
    sep l  = Just . fmap (drop 1) . break (== chr) $ l

solve :: [Int] -> Int
solve (x:xs) = x

run :: IO ()
run = do
    n <- getLine
    b <- getLine
    print $ solve $ map parseInt $ split ' ' b

main = do
    t <- getLine
    run
    run
    run
    run

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

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

kMod :: Int64
kMod = 1000000007

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    bs <- getInts
    let
      acc (total, totalSuf, sufs, offset) b = (total', totalSuf', sufs', offset')
        where
        totalSuf' = case IM.lookup (-offset) sufs of
          Nothing -> (totalSuf * 2) `mod` kMod
          Just c -> (totalSuf * 2 + kMod - c) `mod` kMod
        sufs' = IM.insert (-offset) totalSuf sufs
        offset' = offset + b
        total' = (total + totalSuf + kMod - IM.findWithDefault 0 (-offset) sufs) `mod` kMod
      (result, _, _, _) = foldl' acc (1, 1, IM.singleton 0 1, 0) bs
    C.putStrLn $ C.pack $ show result

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

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

kMod :: Int
kMod = 1000000007

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    bs <- getInts
    let
      acc (total, totalSuf, sufs, offset) b = (total', totalSuf', sufs', offset')
        where
        totalSuf' = case IM.lookup (-offset) sufs of
          Nothing -> (totalSuf * 2) `mod` kMod
          Just c -> (totalSuf * 2 + kMod - c) `mod` kMod
        sufs' = IM.insert (-offset) totalSuf sufs
        offset' = offset + b
        total' = (total + totalSuf + kMod - IM.findWithDefault 0 (-offset) sufs) `mod` kMod
      (result, _, _, _) = foldl' acc (1, 1, IM.singleton 0 1, 0) bs
    C.putStrLn $ C.pack $ show result


Bob is preparing to pass IQ test. The most frequent task in this test is to find out which one of the given n numbers differs from the others. Bob observed that one number usually differs from the others in evenness. Help Bob — to check his answers, he needs a program that among the given n numbers finds one that is different in evenness.

The first line contains integer n (3 ≤ n ≤ 100) — amount of numbers in the task. The second line contains n space-separated natural numbers, not exceeding 100. It is guaranteed, that exactly one of these numbers differs from the others in evenness.

Output index of number that differs from the others in evenness. Numbers are numbered from 1 in the input order.

import Data.List

answer :: [Integer] ->Int
answer xs =   if length xs == ans && odd (head xs - last xs) then ans +1 else ans
        where ans = snd $ foldl1 (\old@(e,ind) new@(ne, nin)-> if even (e - ne) then old else new ) (zip xs [1..])

someFunc :: IO ()
someFunc = getLine >> getLine >>= print . subtract 1 . answer . fmap read . words

main :: IO ()
main = someFunc

import Data.List (partition)

process :: [Int] -> Int
process xs
    | length es == 1 = snd.head $ es
    | otherwise = snd.head $ os
    where
        (es,os) = partition (even.fst) $ zip xs [1..]

readInt :: String -> Int
readInt = read

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

import Data.List
import Data.Maybe

answer :: [Int] -> Int
answer xs = fromJust (findIndex (\x-> x `rem` 2 == parity) xs) + 1
    where oddCount = length . filter odd $ xs
          parity = fromEnum (oddCount == 1)

solve :: String -> String
solve s = show . answer $ xs
    where _:xs = fmap read . words $ s

main :: IO ()
main = interact $ solve

import Data.List
main = do
	dummy <- getLine
	l <- fmap (map read . words) getLine
	putStrLn $ show $ snd $ head $ (\(a,b) -> if length a == 1 then a else b) $ partition (odd . fst) $ zip l [1 ..]

main = do
	n<-getLine
	rest<-getLine
	putStrLn $ show $ solve $ (map read) (words rest)
solve m | length (filter (odd) m)==1 = length (takeWhile (even) m)+1
	    | otherwise = length (takeWhile (odd) m) +1

import Data.List

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

removeMaybe :: Maybe a -> a
removeMaybe (Just a) = a

solve :: [Int] -> Int
solve a | length (filter odd a) == 1 = 1 + removeMaybe (findIndex odd a)
        | otherwise                  = 1 + removeMaybe (findIndex even a)

-- comment functions to understand
-- and verbalize the problem solving
-- process

-- converts list of strings to list of integers
conv lst jj
  | (null lst) = jj
  | otherwise = conv (tail lst) (jj ++ [(read (head lst))::Int])

-- determine if the weird element is even
weird [e,o]
  | (e == 1) = True
  | otherwise = False

-- convert a Bool to an Int
booltoint boo
  | (boo == True) = 1
  | otherwise = 0

-- count the parity of the elements in the list
countParity ss e o
  | (null ss) = [e,o]
  | otherwise = countParity (tail ss)
    (e + (booltoint (even (head ss))))
    (o + (booltoint (odd  (head ss))))

-- search the list for the first instance
-- of the "weird" element which has a unique
-- parity
searchlist lst rr indx
  | (rr == True) = if (even (head lst))
    then indx
    else searchlist (tail lst) rr (indx+1)
  | otherwise = if(odd (head lst))
    then indx
    else searchlist (tail lst) rr (indx+1)

main = do
  ff <- getLine
  oo <- getLine
  let ss = (conv (words oo) [])
      uu = (countParity ss 0 0)

  if (weird uu)
    then putStrLn (show ((searchlist ss (weird uu) 0)+1))
    else putStrLn (show ((searchlist ss (weird uu) 0)+1))

main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let l = take 3 a
        eL = length . filter even $ l
        oL = length . filter odd $ l
        fn = if eL > oL then odd else even
    print $ solve 1 fn a
        where solve _ _ [] = -1
              solve i fn (a:as) = if fn a then i else solve (i+1) fn as

import Data.Maybe
import Data.List

main = do
  getLine
  xs <- fmap (map read . words) getLine
  let (a, b) = partition even xs

  print $ (fromJust $ elemIndex (head $ if length a == 1 then a else b) xs) + 1

main = getContents >>= putStrLn . show . func . map read . words . last . lines

func :: [Int] -> Int
func [] = 0
func xs = findNumber xs $ if length oddX > length evenX then head evenX else head oddX
			where
			oddX = [y | y <- xs , odd y]
			evenX = [y | y <- xs , even y]

findNumber :: (Eq a, Num b) => [a]-> a -> b
findNumber [] m = 0
findNumber (x:xs) m = 1 + if x == m
								then 0
								else findNumber xs m

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve. map read. words.head.tail.lines
solve :: [Int]->String
solve xs = show $ (1+) $ fromJust $ findIndex (slv1) $ zip ( cycle xs)  $ zip (tail $ cycle xs) ( tail $ tail $ cycle xs)
  where slv1 (x,(y,z)) = let x1 = x `mod` 2; y1 = y `mod` 2; z1 = z `mod` 2 in y1==z1 && x1/=y1

main :: IO ()
main = interact func

func :: String -> String
func s = show.func' 1.map (`mod` 2).map read.words.head.tail$lines s

func' :: Int -> [Int] -> Int
func' _ [] = error ""
func' n (0:0:1:_) = n+2
func' n (0:1:0:_) = n+1
func' n (1:0:0:_) = n
func' n (1:1:0:_) = n+2
func' n (1:0:1:_) = n+1
func' n (0:1:1:_) = n
func' n (_:xs) = func' (n+1) xs

main :: IO ()
main = interact func

func :: String -> String
func s = show.func' 1.map (`mod` 2).map read.words.head.tail$lines s

func' :: Int -> [Int] -> Int
func' n (a:b:c:xs)
  | a == b && b /= c = n + 2
  | a == c && b /= c = n+1
  | a /= b && b == c = n
  | otherwise = func' (n+1) (b:c:xs)
func' _ _ = error ""

readInts :: IO [Int]
readInts = do
  line <- getLine
  return (map read (words line))

solve :: Int -> [Bool] -> Int
solve 1 (a:b:c:as)
  | a /= b && b == c  =  1
  | otherwise         =  solve 2 (a:b:c:as)
solve n (a:b:[])      =  n
solve n (a:b:c:as)
  | a /= b && b /= c  =  n
  | otherwise         =  solve (n + 1) (b:c:as)
solve _ _             =  error "Owibka v dannyh."

main = do
  getLine
  as <- readInts
  print (solve 1 (map odd as))

import System.IO
import Control.Monad
import Data.List
import Data.Maybe

myFunc ::(Integral a,Enum a)=>[a]->([a],[a])
myFunc []=([],[])
myFunc x =partition (\a ->mod a 2 ==0) x

main = do
    number <-getLine
    numberStr <- getLine
    let n=number
    let numberString=numberStr
    let ori=map read (words numberString)
    let k=myFunc ori
    if (==1).length.fst $ k
    then mapM_ print $ [1+ ( head $ maybeToList (elemIndex (head $ fst k) ori))]
    else mapM_ print $ [1+ ( head $ maybeToList (elemIndex (head $ snd k) ori))]

import Data.List (groupBy)

main :: IO ()
main = do
    getLine
    s <- getLine
    let xs = map read . words $ s :: [Int]
    print $ fst . head . filter (if (sum . map (`mod` 2) . take 3) xs < 2 then (\(_, x) -> odd x) else (\(_, x) -> even x)) $ zip [1..] xs

import Control.Monad
import Data.Array
import Data.Char
import Data.Functor
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
-- import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = map (read . B.unpack) . B.words <$> B.getLine
getIntList :: IO [Int]
getIntList = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

maj :: [Bool] -> Bool
maj (True:True:_)   = True
maj (False:False:_) = False
maj (_:_:a:_)       = a
maj _ = error "WTF"

solve :: [Int] -> Int
solve = (+1) . fromJust . (elemIndex =<< not . maj) . map odd

main :: IO ()
main = do
    _ <- getLine
    a <- getIntList
    print $ solve a

differentParity list = if onlyOneEven list
                       then findIndexWithParity 0 list
                       else findIndexWithParity 1 list

onlyOneEven list = length (filter even list) == 1

findIndexWithParity p (x:xs)
    | p == mod x 2 = 1
    | otherwise = 1 + findIndexWithParity p xs

main = do
       dummy <- getLine
       inputLine <- getLine
       let inputWords = words inputLine
       let list = map read inputWords :: [Int]
       putStrLn (show (differentParity list))

par::[Int]->Int
par xs = if x'>y' then 1 else 0
 where
       (x',y') = par' xs 0 0
       par' [] a b = (a,b)
       par' (x:xs) a b
                     | (mod x 2)==0 = par' xs (a+1) b
                     | (mod x 2)==1 = par' xs a (b+1)

foundans::Int->[Int]->Int->Int
foundans _ [] _= 0
foundans p (x:xs) q
               | p==(mod x 2) = q
               | otherwise    = foundans p xs (q+1)

main = do
 n<-getLine
 m<-getContents
 print . (\xs->foundans (par xs) xs 1) . map (read::String->Int) . words $ m

par'::[Int]->(Int,Int)
par' xs = (sum (map (\x->mod x 2) xs), sum (map (\x->mod (x+1) 2) xs) )

par::[Int]->(Int->Bool)
par xs = if x>y then odd else even
 where (x,y)=par' xs

foundans::(a->Bool)->[a]->Int
foundans f xs = 1+(length $ takeWhile f xs)

main = do
 n<-getLine
 m<-getContents
 print . (\xs->foundans (par xs) xs) . map (read::String->Int) . words $ m

import Data.List
choose ([a], _) = a
choose (_, [b]) = b
solve s = fst . choose . partition (odd.snd) $ zip [1..] s
main = getLine >> getLine >>= print . solve . map read . words

import Control.Applicative
import Data.List

check n | le >1 = snd $ head $ filter (\z-> odd (fst z)) $ zip n [1..]
        | otherwise = snd $ head $ filter (\z-> even (fst z)) $ zip n [1..]
  where le = length $ filter even n

main=do
    getLine
    n<- map read <$> words <$> getLine ::IO [Int]
    print $ check n

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

main = do
  _ <- getLine
  xs <- fmap (map read . words) getLine :: IO [Int]
  let p = partition (\x -> x `mod` 2 == 0) xs
      number = if length (fst p) == 1 then head (fst p) else head (snd p)
      answer = fromJust $ findIndex (\x -> x == number) xs
      in print (answer + 1)

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

solve :: [Int] -> Int
solve ns = head [ i | (i, n) <- zip [1..] ns, length [ m | m <- ns, even n == even m ] == 1 ]

import Data.List
main = do
  getLine
  (es,os) <- fmap (partition (even . snd) . zip [1..] . map read . words) getLine
  print $ case es of
            [(n,_)] -> n
            _ -> fst (head os)

import Data.List
import Data.Maybe
main = do
    getLine
    s <- getLine
    let task = map read $ words s
    print $ solve task
solve :: [Integer] -> Int
solve task | trueCount == 1 = (fromJust $ elemIndex True bools) + 1
           | otherwise = (fromJust $ elemIndex False bools) + 1
           where bools = map even task
                 trueCount = length . filter (==True) $ bools

import Data.List

main :: IO()
main = do
  _ <- getLine
  line <- getLine
  putStrLn $ show $ gao $ map read $ words line

gao :: [Int] -> Int
gao a = let key = if length x == 1 then head x else head y in (\(Just x) -> x + 1) $ findIndex (==key) a
  where (x, y) = partition even a

-- Vicfred
-- https://codeforces.com/problemset/problem/25/A

import Data.List
import Data.Maybe

solve :: [Int] -> Int
solve a | length (filter odd a) == 1 = 1 + fromJust (findIndex odd a)
        | otherwise                  = 1 + fromJust (findIndex even a)

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

solve :: [Int] -> Int
solve (a:b:rest) | odd a && even b = if odd (head rest) then 2 else 1
                 | even a && odd b = if even (head rest) then 2 else 1
                 | even a     = (+ 3) . length . takeWhile even $ rest
                 | otherwise  = (+ 3) . length . takeWhile odd $ rest
main = interact $ show . solve . map read . tail . words

solve :: [Int] -> Int
solve (a:b:rest) | even a && even b = (+ 3) . length . takeWhile even $ rest
                 | odd a && even b = if odd (head rest) then 2 else 1
                 | even a && odd b = if even (head rest) then 2 else 1
                 | otherwise  = (+ 3) . length . takeWhile odd $ rest
main = interact $ show . solve . map read . tail . words

import Data.List

solve :: [Int] -> Int
solve a = let
            b = [x | x <- a, mod x 2 == 0];
            c = [x | x <- a, odd x];
            in
                let mb = elemIndex (head (f b c)) a in
                    case mb of
                        Nothing -> error "oo"
                        Just a -> a + 1

f :: [Int] -> [Int] -> [Int]
f a b = if (length a == 1) then a else b

main = do {
    z1 <- getLine;
    z2 <- getLine;
    putStrLn $ show $ solve $ map read (words z2)
}

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

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import Text.Printf

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n : _ <- readData
  (as, bs) <- partition (odd . snd) . zip [1 ..] . take n <$> readData
  case (as, bs) of
    ([(i, _)], _) -> print i
    (_, [(i, _)]) -> print i

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

get num | length (filter odd num) == 1 = odd
        | otherwise = even

find num = fst . head . filter snd . zip [1..] $ map f num
    where f = get num

main = do
    s <- getLine
    print . find =<< getnum

import Control.Applicative
import Data.Char

main= do
	getLine
	n<- map read.words <$> getLine::IO [Int]
	let x = length $ take 3 ( filter even  n)
	print $  snd $ head $ (filter (\z-> (if x>1 then odd else even)  (fst z)) $ (zip n [1..]))

main = do
  getLine
  m <- getLine
  let m2 = map (even.read) $ words m
  print $ diff m2
th :: Int -> [a] -> a
th 1 y = head y
th n (x:xs) = th (n-1) xs
diff :: Eq a => [a] -> Int
diff (x:x2:x3:[]) = if (x == x2) then 3 else (if (x==x3) then 2 else 1)
diff (x:x2:x3:xs) = if (x == x2) then (diff (x2:x3:xs) + 1) else diff (x:x2:x3:[])

deleteN _ []     = []
deleteN i (a:as)
   | i == 0    = as
   | otherwise = a : deleteN (i - 1) as

getIndex :: [Int] -> Int -> Int
getIndex nums i
    | all odd withoutEl || all even withoutEl = i
    | otherwise = getIndex nums (i + 1)
    where withoutEl = deleteN i nums

main = do
    getLine
    nums_ln <- getLine

    let nums = map (read :: String -> Int) (words nums_ln)
    putStrLn . show $ (getIndex nums 0) + 1

import Data.List

answer :: [Integer] ->Integer
answer xs =  snd $ foldl1 (\old@(e,ind) new@(ne, nin)-> if even (e - ne) then old else new ) (zip xs [1..])

someFunc :: IO ()
someFunc = getLine >> getLine >>= print . subtract 1 . answer . fmap read . words

main :: IO ()
main = someFunc

import Data.List

answer :: [Integer] ->Int
answer xs =  if res /= length xs then res - 1 else res
                    where res = snd $ foldl1 (\old@(e,ind) new@(ne, nin)-> if even (e - ne) then old else new ) (zip xs [1..])

someFunc :: IO ()
someFunc = getLine >> getLine >>= print  . answer . fmap read . words

main :: IO ()
main = someFunc

import Data.List

answer :: [Integer] ->Int
answer xs =  if length xs == ans && even (head xs - last xs) then ans - 1 else ans
        where ans = snd $ foldl1 (\old@(e,ind) new@(ne, nin)-> if even (e - ne) then old else new ) (zip xs [1..])

someFunc :: IO ()
someFunc = getLine >> getLine >>= print . subtract 1 . answer . fmap read . words

main :: IO ()
main = someFunc

import Data.List

answer :: [Integer] ->Int
answer xs =  if length xs == ans && even (head xs - last xs) then ans - 1 else ans
        where ans = snd $ foldl1 (\old@(e,ind) new@(ne, nin)-> if even (e - ne) then old else new ) (zip xs [1..])

someFunc :: IO ()
someFunc = getLine >> getLine >>= print  . answer . fmap read . words

main :: IO ()
main = someFunc

main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let l = take 3 a
        eL = length . filter even $ l
        oL = length . filter odd $ l
        fn = if eL == 1 then even else odd
    print $ solve 1 fn a
        where solve _ _ [] = -1
              solve i fn (a:as) = if fn a then i else solve (i+1) fn as

main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let l = take 3 a
        eL = length . filter even $ l
        oL = length . filter odd $ l
        fn = if eL > oL then even else odd
    print $ solve 1 fn a
        where solve _ _ [] = -1
              solve i fn (a:as) = if fn a then i else solve (i+1) fn as

main = getContents >>= putStrLn . show . func . map read . words . last . lines

func :: [Int] -> Int
func [] = 0
func xs = if length oddX > length evenX then head evenX else head oddX
			where
			oddX = [y | y <- xs , odd y]
			evenX = [y | y <- xs , even y]

par::[Int]->Int
par xs = if x'>y' then 1 else 0
 where
       (x',y') = par' xs 0 0
       par' [] a b = (a,b)
       par' (x:xs) a b
                     | (mod x 2)==0 = par' xs (a+1) b
                     | (mod x 2)==1 = par' xs a (b+1)

foundans::Int->[Int]->Int
foundans _ [] = 0
foundans p (x:xs)
               | p==(mod x 2) = x
               | otherwise    = foundans p xs

main = do
 n<-getLine
 m<-getContents
 print . (\xs->foundans (par xs) xs) . map (read::String->Int) . words $ m

par'::[Int]->(Int,Int)
par' xs = (sum (map (\x->mod x 2) xs), sum (map (\x->mod (x+1) 2) xs) )

par::[Int]->(Int->Bool)
par xs = if x>y then odd else even
 where (x,y)=par' xs

foundans::(a->Bool)->[a]->Int
foundans f xs = length $ takeWhile f xs

main = do
 n<-getLine
 m<-getContents
 print . (\xs->foundans (par xs) xs) . map (read::String->Int) . words $ m

import Data.List
split s = map (map snd) . groupBy  (\(a,_) (b,_) -> div a 3 == div b 3) . zip [0..] $ s
solve s = intercalate "-" . reverse . adjust . reverse . split $ s
    where adjust ([x]:[a,b,c]:xs) = [a,b,'-',c,x]:xs
          adjust xs = xs

main = getLine >> getLine >>= putStrLn . solve

import Control.Applicative
import Data.List

check n | le >1 = head $ filter odd n
        | otherwise = head $ filter even n
  where le = length $ filter even n

main=do
    getLine
    n<- map read <$> words <$> getLine ::IO [Int]
    print $ check n

solve :: [Int] -> Int
solve (a:b:rest) | even a && even b = (+ 3) . length . takeWhile even $ rest
                 | odd a && even b = if odd (head rest) then 2 else 1
                 | otherwise  = (+ 3) . length . takeWhile odd $ rest
main = interact $ show . solve . map read . tail . words

import Data.List

solve :: [Int] -> Int
solve a = let
            b = [x | x <- a, mod x 2 == 0];
            c = [x | x <- a, odd x];
            in
                if (length b) == 1 then head b else head c

main = do {
    z1 <- getLine;
    z2 <- getLine;
    putStrLn $ show $ solve $ map read (words z2)
}

getIndex :: [Int] -> Int -> Int -> Int
getIndex (x:xs) curSum ind
    | newSum `mod` 2 == 1 = ind
    | otherwise = getIndex xs newSum newInd
    where newSum = curSum + x
          newInd = ind + 1

main = do
    getLine
    ln <- getLine
    nums <- return . map (read :: String -> Int) $ words ln
    putStrLn . show $ getIndex (tail nums) (head nums) 2

getIndex :: [Int] -> Int -> Int
getIndex (x:xs) ind
    | null xs = ind
    | x `mod` 2 /= head xs `mod` 2 = ind
    | otherwise = getIndex xs (ind + 1)

main = do
    n_ln <- getLine
    nums_ln <- getLine

    let n = read n_ln :: Int
    let nums = map (read :: String -> Int) (words nums_ln)

    let ia = getIndex nums 1
    let ib = n - getIndex (reverse nums) 0

    putStrLn . show $ (ia + ib) `div` 2


You came to a local shop and want to buy some chocolate bars. There are $$$n$$$ bars in the shop, $$$i$$$-th of them costs $$$a_i$$$ coins (and you want to buy all of them).You have $$$m$$$ different coupons that allow you to buy chocolate bars. $$$i$$$-th coupon allows you to buy $$$q_i$$$ chocolate bars while you have to pay only for the $$$q_i - 1$$$ most expensive ones (so, the cheapest bar of those $$$q_i$$$ bars is for free).You can use only one coupon; if you use coupon $$$i$$$, you have to choose $$$q_i$$$ bars and buy them using the coupon, and buy all the remaining $$$n - q_i$$$ bars without any discounts.To decide which coupon to choose, you want to know what will be the minimum total amount of money you have to pay if you use one of the coupons optimally.

The first line contains one integer $$$n$$$ ($$$2 \le n \le 3 \cdot 10^5$$$) — the number of chocolate bars in the shop. The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the cost of $$$i$$$-th chocolate bar. The third line contains one integer $$$m$$$ ($$$1 \le m \le n - 1$$$) — the number of coupons you have. The fourth line contains $$$m$$$ integers $$$q_1$$$, $$$q_2$$$, ..., $$$q_m$$$ ($$$2 \le q_i \le n$$$), where $$$q_i$$$ is the number of chocolate bars you have to buy using $$$i$$$-th coupon so that the least expensive of them will be for free. All values of $$$q_i$$$ are pairwise distinct.

Print $$$m$$$ integers, $$$i$$$-th of them should be the minimum amount of money you have to pay if you buy $$$q_i$$$ bars with $$$i$$$-th coupon, and all the remaining bars one by one for their full price.

NoteConsider the first example.If we use the first coupon, we may choose chocolate bars having indices $$$1$$$, $$$6$$$ and $$$7$$$, and we pay $$$18$$$ coins for them and $$$9$$$ coins for all other bars.If we use the second coupon, we may choose chocolate bars having indices $$$1$$$, $$$5$$$, $$$6$$$ and $$$7$$$, and we pay $$$25$$$ coins for them and $$$5$$$ coins for all other bars.

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

main :: IO ()
main = do
   n <- readLn
   as <- (map read.words) <$> getLine
   _ <- getLine
   let arr = listArray (1,n) (sort as)
   let s = sum arr
   qs <- (map read.words) <$> getLine
   forM_ qs (print.solve arr s n)

solve :: Array Integer Integer -> Integer -> Integer -> Integer -> Integer
solve arr s n q = s - arr!(n-q+1)

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List
import Data.Array
import Control.Monad

main = do
    let int =  fst . fromJust . B.readInteger
        ints = map int . B.words
    n <- int <$> B.getLine
    as'' <- ints <$> B.getLine
    let as' = sort as''
        as = array(0,n-1) $ zip [0..n-1] $ as'
        bs = array(0,n-1) $ zip [0..n-1] $ scanr (+) 0 as'
        cs = array(0,n-1) $ zip [0..n-1] $ scanl (+) 0 as'
    B.getLine
    (ints <$> B.getLine) >>=  mapM_ (\i -> print $ bs!(n - i) - as!(n-i) + cs!(n-i))

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  as <- A.listArray (0,n-1) . sort . map toI64 .
    unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  m <- readInt <$> getLine
  qs <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let s = sum (A.elems as)
  forM_ qs $ print . query n as s m

query :: Int -> UArray Int Int64 -> Int64 -> Int -> Int -> Int64
query n as sumas m q = sumas - (as A.! (n-q))

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

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

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

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

main :: IO ()
main = do
   n <- readLn
   as <- (map read.words) <$> getLine
   _ <- getLine
   let arr = listArray (1,n) (sort as)
   let s = sum arr
   qs <- (map read.words) <$> getLine
   forM_ qs (print.solve arr s n)

solve :: Array Int Int -> Int -> Int -> Int -> Int
solve arr s n q = s - arr!(n-q+1)

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List
import Data.Array
import Control.Monad

main = do
    let int =  fst . fromJust . B.readInt
        ints = map int . B.words
    n <- int <$> B.getLine
    as'' <- ints <$> B.getLine
    let as' = sort as''
        as = array(0,n-1) $ zip [0..n-1] $ as'
        bs = array(0,n-1) $ zip [0..n-1] $ scanr (+) 0 as'
        cs = array(0,n-1) $ zip [0..n-1] $ scanl (+) 0 as'
    B.getLine
    (ints <$> B.getLine) >>=  mapM_ (\i -> print $ bs!(n - i) - as!(n-i) + cs!(n-i))

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  as <- A.listArray (0,n-1) . sort .
    unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  m <- readInt <$> getLine
  qs <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let s = sum (A.elems as)
  forM_ qs $ print . query n as s m

query :: Int -> UArray Int Int -> Int -> Int -> Int -> Int
query n as sumas m q = sumas - (as A.! (n-q))

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

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

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


You are given an array a of size n, and q queries to it. There are queries of two types:   1 li ri — perform a cyclic shift of the segment [li, ri] to the right. That is, for every x such that li ≤ x < ri new value of ax + 1 becomes equal to old value of ax, and new value of ali becomes equal to old value of ari;  2 li ri — reverse the segment [li, ri].  There are m important indices in the array b1, b2, ..., bm. For each i such that 1 ≤ i ≤ m you have to output the number that will have index bi in the array after all queries are performed.

The first line contains three integer numbers n, q and m (1 ≤ n, q ≤ 2·105, 1 ≤ m ≤ 100).  The second line contains n integer numbers a1, a2, ..., an (1 ≤ ai ≤ 109).  Then q lines follow. i-th of them contains three integer numbers ti, li, ri, where ti is the type of i-th query, and [li, ri] is the segment where this query is performed (1 ≤ ti ≤ 2, 1 ≤ li ≤ ri ≤ n).  The last line contains m integer numbers b1, b2, ..., bm (1 ≤ bi ≤ n) — important indices of the array.

Print m numbers, i-th of which is equal to the number at index bi after all queries are done.

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import Control.Monad (replicateM)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)

readInt = fst . M.fromJust . C.readInt

f [1, l, r] i | i == l = r | i > l && i <= r = i - 1 | otherwise = i
f [2, l, r] i | i >=l && i <= r = r - (i - l) | otherwise = i

main = do
    (map readInt . C.words -> [n, q, _]) <- B.getLine
    (listArray (1, n) . map readInt . C.words -> as :: UArray Int Int) <- B.getLine
    (map (map readInt . C.words) -> qs) <- replicateM q B.getLine
    (map readInt . C.words -> bs) <- B.getLine
    putStrLn . unwords . map (show . (as !)) $ map (flip (foldr f) qs) bs


There is a grid, consisting of $$$n$$$ rows and $$$m$$$ columns. Each cell of the grid is either free or blocked. One of the free cells contains a lab. All the cells beyond the borders of the grid are also blocked.A crazy robot has escaped from this lab. It is currently in some free cell of the grid. You can send one of the following commands to the robot: "move right", "move down", "move left" or "move up". Each command means moving to a neighbouring cell in the corresponding direction.However, as the robot is crazy, it will do anything except following the command. Upon receiving a command, it will choose a direction such that it differs from the one in command and the cell in that direction is not blocked. If there is such a direction, then it will move to a neighbouring cell in that direction. Otherwise, it will do nothing.We want to get the robot to the lab to get it fixed. For each free cell, determine if the robot can be forced to reach the lab starting in this cell. That is, after each step of the robot a command can be sent to a robot such that no matter what different directions the robot chooses, it will end up in a lab.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of testcases. The first line of each testcase contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 10^6$$$; $$$n \cdot m \le 10^6$$$) — the number of rows and the number of columns in the grid. The $$$i$$$-th of the next $$$n$$$ lines provides a description of the $$$i$$$-th row of the grid. It consists of $$$m$$$ elements of one of three types:    '.' — the cell is free;  '#' — the cell is blocked;  'L' — the cell contains a lab.  The grid contains exactly one lab. The sum of $$$n \cdot m$$$ over all testcases doesn't exceed $$$10^6$$$.

For each testcase find the free cells that the robot can be forced to reach the lab from. Given the grid, replace the free cells (marked with a dot) with a plus sign ('+') for the cells that the robot can be forced to reach the lab from. Print the resulting grid.

NoteIn the first testcase there is no free cell that the robot can be forced to reach the lab from. Consider a corner cell. Given any direction, it will move to a neighbouring border grid that's not a corner. Now consider a non-corner free cell. No matter what direction you send to the robot, it can choose a different direction such that it ends up in a corner.In the last testcase, you can keep sending the command that is opposite to the direction to the lab and the robot will have no choice other than move towards the lab.

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe

solve :: UArray (Int, Int) Char -> UArray (Int, Int) Char
solve inpArr = runSTUArray $ do
  status <- thaw inpArr
  let
    bnds = bounds inpArr
    neighbors (i, j)
      = filter (inRange bnds) [(i+1, j), (i, j+1), (i-1, j), (i, j-1)]
    vacant  pos = (/= '#') <$> readArray status pos
    useless pos = (== '.') <$> readArray status pos
    visit [] = pure ()
    visit (pos : rest) = do
      w <- readArray status pos
      case  w  of
        '.' -> do
          let  ns = neighbors pos -- maybe just a bit less laziness will help?
          v <- length <$> filterM vacant  ns
          u <- length <$> filterM useless ns
          if  u < min 2 v
            then  writeArray status pos '+' >> visit (ns ++ rest)
            else  visit rest
        _ -> visit rest
    labs = [pos | (pos, 'L') <- assocs inpArr]
  visit (concatMap neighbors labs)
  pure status

chunksOf :: Int -> [t] -> [[t]]
chunksOf n = unfoldr $ \li -> do
  guard $ not (null li)
  pure $ splitAt n li

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    cells <- concatMap P.unpack <$> getNext n
    let
      ans = solve $ listArray ((1, 1), (n, m)) cells
    pure $ foldMap (\s -> string7 s <> char7 '\n') $ chunksOf m $ elems ans

type SP = State [P.ByteString]

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

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

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

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


In the army, it isn't easy to form a group of soldiers that will be effective on the battlefield. The communication is crucial and thus no two soldiers should share a name (what would happen if they got an order that Bob is a scouter, if there are two Bobs?).A group of soldiers is effective if and only if their names are different. For example, a group (John, Bob, Limak) would be effective, while groups (Gary, Bob, Gary) and (Alice, Alice) wouldn't.You are a spy in the enemy's camp. You noticed n soldiers standing in a row, numbered 1 through n. The general wants to choose a group of k consecutive soldiers. For every k consecutive soldiers, the general wrote down whether they would be an effective group or not.You managed to steal the general's notes, with n - k + 1 strings s1, s2, ..., sn - k + 1, each either "YES" or "NO".   The string s1 describes a group of soldiers 1 through k ("YES" if the group is effective, and "NO" otherwise).  The string s2 describes a group of soldiers 2 through k + 1.  And so on, till the string sn - k + 1 that describes a group of soldiers n - k + 1 through n. Your task is to find possible names of n soldiers. Names should match the stolen notes. Each name should be a string that consists of between 1 and 10 English letters, inclusive. The first letter should be uppercase, and all other letters should be lowercase. Names don't have to be existing names — it's allowed to print "Xyzzzdj" or "T" for example.Find and print any solution. It can be proved that there always exists at least one solution.

The first line of the input contains two integers n and k (2 ≤ k ≤ n ≤ 50) — the number of soldiers and the size of a group respectively. The second line contains n - k + 1 strings s1, s2, ..., sn - k + 1. The string si is "YES" if the group of soldiers i through i + k - 1 is effective, and "NO" otherwise.

Find any solution satisfying all given conditions. In one line print n space-separated strings, denoting possible names of soldiers in the order. The first letter of each name should be uppercase, while the other letters should be lowercase. Each name should contain English letters only and has length from 1 to 10. If there are multiple valid solutions, print any of them.

Adam Bob Bob Cpqepqwer Limak Adam Bob Adam

R Q Ccccccccc Ccocc Ccc So Strong Samples Ccc

NoteIn the first sample, there are 8 soldiers. For every 3 consecutive ones we know whether they would be an effective group. Let's analyze the provided sample output:  First three soldiers (i.e. Adam, Bob, Bob) wouldn't be an effective group because there are two Bobs. Indeed, the string s1 is "NO".  Soldiers 2 through 4 (Bob, Bob, Cpqepqwer) wouldn't be effective either, and the string s2 is "NO".  Soldiers 3 through 5 (Bob, Cpqepqwer, Limak) would be effective, and the string s3 is "YES".  ...,  Soldiers 6 through 8 (Adam, Bob, Adam) wouldn't be effective, and the string s6 is "NO".

import Data.Char (toUpper)
import Data.List (elemIndex)
import Data.Functor ((<$>))
import Control.Arrow (first, second)

-- `futher state xs uniq` -- get list that must be appeded to xs to satisfy uniq
further :: Int -> [Int] -> [Bool] -> [Int]
further state xs [] = []
further state xs (u:us) =
  ans : further state' (tail xs ++ [ans]) us where
    (ans, state') = if u then (state, succ state) else (head $ tail xs, state)

main' :: Int -> [Bool] -> [Int]
main' k uniq = case True `elemIndex` uniq of
  Just idx -> let
    (left, right) = second tail $ splitAt idx uniq
    init = [0 .. k - 1]
   in
    reverse (further k (reverse init) (reverse left))
      ++ init
      ++ further (k + 1000) init right
  Nothing  -> take (k + length uniq - 1) $ repeat 0

name :: Int -> String
name = toTitle . name' where
  toTitle [] = []
  toTitle (x:xs) = toUpper x : xs

  name' 0 = "a"
  name' x = toEnum (fromEnum 'a' + mod x 26) : name' (x `div` 26)

main = do
  _:k:[] <- map read <$> words <$> getLine
  uniq <- map (=="YES") <$> words <$> getLine
  putStrLn $ unlines $ map name $ main' k uniq


As a human, she can erase history of its entirety. As a Bai Ze (Hakutaku), she can create history out of nothingness.—Perfect Memento in Strict SenseKeine has the ability to manipulate history. The history of Gensokyo is a string $$$s$$$ of length $$$1$$$ initially. To fix the chaos caused by Yukari, she needs to do the following operations $$$n$$$ times, for the $$$i$$$-th time:  She chooses a non-empty substring $$$t_{2i-1}$$$ of $$$s$$$. She replaces $$$t_{2i-1}$$$ with a non-empty string, $$$t_{2i}$$$. Note that the lengths of strings $$$t_{2i-1}$$$ and $$$t_{2i}$$$ can be different.Note that if $$$t_{2i-1}$$$ occurs more than once in $$$s$$$, exactly one of them will be replaced.For example, let $$$s=$$$"marisa", $$$t_{2i-1}=$$$"a", and $$$t_{2i}=$$$"z". After the operation, $$$s$$$ becomes "mzrisa" or "marisz".After $$$n$$$ operations, Keine got the final string and an operation sequence $$$t$$$ of length $$$2n$$$. Just as Keine thinks she has finished, Yukari appears again and shuffles the order of $$$t$$$. Worse still, Keine forgets the initial history. Help Keine find the initial history of Gensokyo!Recall that a substring is a sequence of consecutive characters of the string. For example, for string "abc" its substrings are: "ab", "c", "bc" and some others. But the following strings are not its substring: "ac", "cba", "acb".HacksYou cannot make hacks in this problem.

Each test contains multiple test cases. The first line contains a single integer $$$T$$$ ($$$1 \leq T \leq 10^3$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n < 10 ^ 5$$$) — the number of operations. The next $$$2n$$$ lines contains one non-empty string $$$t_{i}$$$ — the $$$i$$$-th string of the shuffled sequence $$$t$$$. The next line contains one non-empty string $$$s$$$ — the final string. It is guaranteed that the total length of given strings (including $$$t_i$$$ and $$$s$$$) over all test cases does not exceed $$$2 \cdot 10 ^ 5$$$. All given strings consist of lowercase English letters only. It is guaranteed that the initial string exists. It can be shown that the initial string is unique.

For each test case, print the initial string in one line.

2

2

a

ab

b

cd

acd

3

z

a

a

aa

yakumo

ran

yakumoran

NoteTest case 1:Initially $$$s$$$ is "a". In the first operation, Keine chooses "a", and replaces it with "ab". $$$s$$$ becomes "ab". In the second operation, Keine chooses "b", and replaces it with "cd". $$$s$$$ becomes "acd".So the final string is "acd", and $$$t=[$$$"a", "ab", "b", "cd"$$$]$$$ before being shuffled.Test case 2:Initially $$$s$$$ is "z". In the first operation, Keine chooses "z", and replaces it with "aa". $$$s$$$ becomes "aa". In the second operation, Keine chooses "a", and replaces it with "ran". $$$s$$$ becomes "aran". In the third operation, Keine chooses "a", and replaces it with "yakumo". $$$s$$$ becomes "yakumoran".So the final string is "yakumoran", and $$$t=[$$$"z", "aa", "a", "ran", "a", "yakumo"$$$]$$$ before being shuffled.

import Data.Char
import Data.Bits

solveTestCase :: Int -> IO Int
solveTestCase cnt | cnt <= 0 = return 0
                  | otherwise = do s <- getLine
                                   let lineXor = foldr xor 0 (map ord s)
                                   tailXor <- solveTestCase (cnt - 1)
                                   return (lineXor `xor` tailXor)

mainLoop :: Int -> IO ()
mainLoop t | t <= 0 = return ()
           | otherwise = do n <- (readLn :: IO Int)
                            result <- solveTestCase (2 * n + 1)
                            putStrLn [chr result]
                            mainLoop (t - 1)

main :: IO ()
main = do t <- (readLn :: IO Int)
          mainLoop t


Methodius received an email from his friend Polycarp. However, Polycarp's keyboard is broken, so pressing a key on it once may cause the corresponding symbol to appear more than once (if you press a key on a regular keyboard, it prints exactly one symbol).For example, as a result of typing the word "hello", the following words could be printed: "hello", "hhhhello", "hheeeellllooo", but the following could not be printed: "hell", "helo", "hhllllooo".Note, that when you press a key, the corresponding symbol must appear (possibly, more than once). The keyboard is broken in a random manner, it means that pressing the same key you can get the different number of letters in the result.For each word in the letter, Methodius has guessed what word Polycarp actually wanted to write, but he is not sure about it, so he asks you to help him.You are given a list of pairs of words. For each pair, determine if the second word could be printed by typing the first one on Polycarp's keyboard.

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of pairs to check. Further input contains $$$n$$$ descriptions of pairs. The first line of each description contains a single non-empty word $$$s$$$ consisting of lowercase Latin letters. The second line of the description contains a single non-empty word $$$t$$$ consisting of lowercase Latin letters. The lengths of both strings are not greater than $$$10^6$$$. It is guaranteed that the total length of all words $$$s$$$ in the input is not greater than $$$10^6$$$. Also, it is guaranteed that the total length of all words $$$t$$$ in the input is not greater than $$$10^6$$$.

Output $$$n$$$ lines. In the $$$i$$$-th line for the $$$i$$$-th pair of words $$$s$$$ and $$$t$$$ print YES if the word $$$t$$$ could be printed by typing the word $$$s$$$. Otherwise, print NO.

4
hello
hello
hello
helloo
hello
hlllloo
hello
helo

5
aa
bb
codeforces
codeforce
polycarp
poolycarpp
aaaa
aaaab
abcdefghijklmnopqrstuvwxyz
zabcdefghijklmnopqrstuvwxyz

{-# LANGUAGE ScopedTypeVariables #-}

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Prelude
import qualified Data.ByteString.Char8 as B8

type CompressedString = [(Char, Int)]

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

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

compressFold :: Char -> CompressedString -> CompressedString
compressFold c [] = [(c, 1)]
compressFold c cs@((fc, flen):other)
    | fc == c   = (fc, flen + 1):other
    | otherwise = (c, 1):cs

compress :: B8.ByteString -> CompressedString
compress = B8.foldr' compressFold []

main :: IO ()
main = do
    n <- readB8Int <$> B8.getLine
    replicateM_ n $ do
        stra <- head <$> B8.words <$> B8.getLine
        strb <- head <$> B8.words <$> B8.getLine
        let cstra = compress stra
        let cstrb = compress strb
        let isleneq = ((==) `on` length) cstra cstrb
        let isok = all (\((ca, la), (cb, lb)) -> (ca == cb) && (la <= lb)) $ zip cstra cstrb
        let answer = if isok && isleneq then "YES" else "NO"
        printf "%s\n" $ answer

solve :: String -> String -> Bool
solve a b = solve' a b '\0'

solve' :: String -> String -> Char -> Bool
solve' "" "" _ = True
solve' _  "" _ = False
solve' "" (b:bs) c = b == c && solve' "" bs c
solve' (a:as) (b:bs) c
    | a == b    = solve' as bs a
    | b == c    = solve' (a:as) bs c
    | otherwise = False

boolstr :: Bool -> String
boolstr True  = "YES"
boolstr False = "NO"

main :: IO ()
main = do
        n <- read <$> getLine
        let readans = (solve <$> getLine <*> getLine) >>= (putStrLn . boolstr)
        sequence $ replicate n readans
        return ()

import Data.List
main = interact $ unlines . map res . process . tail . lines

res True = "YES"
res False = "NO"

process [] = []
process (x:y:t) = check (group x) (group y) : process t

check [] [] = True
check _ [] = False
check [] _ = False
check (a1:t1) (a2:t2)
  | ((head a1) == (head a2)) && ((length a1) <= (length a2)) = check t1 t2
  | otherwise = False


There are $$$n$$$ workers and $$$m$$$ tasks. The workers are numbered from $$$1$$$ to $$$n$$$. Each task $$$i$$$ has a value $$$a_i$$$ — the index of worker who is proficient in this task.Every task should have a worker assigned to it. If a worker is proficient in the task, they complete it in $$$1$$$ hour. Otherwise, it takes them $$$2$$$ hours.The workers work in parallel, independently of each other. Each worker can only work on one task at once.Assign the workers to all tasks in such a way that the tasks are completed as early as possible. The work starts at time $$$0$$$. What's the minimum time all tasks can be completed by?

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 two integers $$$n$$$ and $$$m$$$ ($$$1 \le n \le m \le 2 \cdot 10^5$$$) — the number of workers and the number of tasks. The second line contains $$$m$$$ integers $$$a_1, a_2, \dots, a_m$$$ ($$$1 \le a_i \le n$$$) — the index of the worker proficient in the $$$i$$$-th task. The sum of $$$m$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$.

For each testcase, print a single integer — the minimum time all tasks can be completed by.

NoteIn the first testcase, the first worker works on tasks $$$1$$$ and $$$3$$$, and the second worker works on tasks $$$2$$$ and $$$4$$$. Since they both are proficient in the corresponding tasks, they take $$$1$$$ hour on each. Both of them complete $$$2$$$ tasks in $$$2$$$ hours. Thus, all tasks are completed by $$$2$$$ hours.In the second testcase, it's optimal to assign the first worker to tasks $$$1, 2$$$ and $$$3$$$ and the second worker to task $$$4$$$. The first worker spends $$$3$$$ hours, the second worker spends $$$2$$$ hours (since they are not proficient in the taken task).In the third example, each worker can be assigned to the task they are proficient at. Thus, each of them complete their task in $$$1$$$ hour.

import Data.IntMap (IntMap, empty, alter, elems, findWithDefault)

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

fromList :: [Int] -> IntMap Int
fromList [] = empty
fromList (x: xs) = alter (\x -> case x of
  Nothing -> Just 1
  Just a -> Just (a + 1)) x (fromList xs)

calcH :: [Int] -> Int -> Int
calcH a x = if sum (map (\i -> if i < x then (x - i) `div` 2 else (x - i)) a) >= 0
  then x
  else calcH a (x + 1)

calc :: [Int] -> Int
calc a = calcH a 1

for :: Int -> IO ()
for 0 = pure ()
for i = do
  (n: m: _) <- readArr
  a <- readArr
  let x = map (\i -> findWithDefault 0 i (fromList a)) [1..n]
  print $ calc x
  for $ i - 1

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

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

findLowerBound :: (Int -> Bool) -> (Int, Int) -> Int
findLowerBound f (l, r) | l == r = l
findLowerBound f (l, r) = if f c
        then findLowerBound f (l, c)
        else findLowerBound f (c + 1, r)
    where
        c = (l + r) `div` 2

solve :: Int -> Int -> [Int] -> Int
solve n m as = answer
    where
        answer = findLowerBound canSchedule (1, 2 * m)

        canSchedule :: Int -> Bool
        canSchedule t = ST.runST $ do
            timeLeftA <- MA.newArray (1, n) t :: ST.ST s (STA.STUArray s Int Int)
            tasksLeft <- flip S.execStateT 0 $ do
                forM_ as $ \a -> do
                    workerTimeLeft <- T.lift $ MA.readArray timeLeftA a
                    if workerTimeLeft > 0
                        then T.lift $ modifyArray timeLeftA a pred
                        else S.modify succ
            workersTasksLeft <- MA.getElems timeLeftA <&> sum . map (`div` 2)
            return $ tasksLeft <= workersTasksLeft

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        let answer = solve n m as
        printf "%d\n" answer

import Data.IntMap (IntMap, empty, alter, elems, findWithDefault)

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

fromList :: [Int] -> IntMap Int
fromList [] = empty
fromList (x: xs) = alter (\x -> case x of
  Nothing -> Just 1
  Just a -> Just (a + 1)) x (fromList xs)

calcH :: [Int] -> Int -> Int
calcH a x = if sum (map (\i -> if i < x then x - i else 2 * (x - i)) a) >= 0
  then x
  else calcH a (x + 1)

calc :: [Int] -> Int
calc a = calcH a 1

shrinkH :: Int -> [Int]
shrinkH 0 = []
shrinkH i = (0: shrinkH (i - 1))

shrink :: Int -> [Int] -> [Int]
shrink n a = shrinkH (n - length a) ++ a

for :: Int -> IO ()
for 0 = pure ()
for i = do
  (n: m: _) <- readArr
  a <- readArr
  let x = map (\i -> findWithDefault 0 i (fromList a)) [1..n]
  print $ calc x
  for $ i - 1

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

import Data.IntMap (IntMap, empty, alter, elems)

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

fromList :: [Int] -> IntMap Int
fromList [] = empty
fromList (x: xs) = alter (\x -> case x of
  Nothing -> Just 1
  Just a -> Just (a + 1)) x (fromList xs)

calcH :: [Int] -> Int -> Int
calcH a x = if sum (map (\i -> if i < x then x - i else 2 * (x - i)) a) >= 0
  then x
  else calcH a (x + 1)

calc :: [Int] -> Int
calc a = calcH a 0

shrinkH :: Int -> [Int]
shrinkH 0 = []
shrinkH i = (0: shrinkH (i - 1))

shrink :: Int -> [Int] -> [Int]
shrink n a = shrinkH (n - length a) ++ a

for :: Int -> IO ()
for 0 = pure ()
for i = do
  (n: m: _) <- readArr
  a <- readArr
  let x = shrink n (elems $ fromList a)
  print $ calc x
  for $ i - 1

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