This is the hard version of the problem. The difference is that in this version the array contains zeros. You can make hacks only if both versions of the problem are solved.You are given an array $$$[a_1, a_2, \ldots a_n]$$$ consisting of integers $$$-1$$$, $$$0$$$ and $$$1$$$. You have to build a partition of this array into the set of segments $$$[l_1, r_1], [l_2, r_2], \ldots, [l_k, r_k]$$$ with the following property:  Denote the alternating sum of all elements of the $$$i$$$-th segment as $$$s_i$$$: $$$s_i$$$ = $$$a_{l_i} - a_{l_i+1} + a_{l_i+2} - a_{l_i+3} + \ldots \pm a_{r_i}$$$. For example, the alternating sum of elements of segment $$$[2, 4]$$$ in array $$$[1, 0, -1, 1, 1]$$$ equals to $$$0 - (-1) + 1 = 2$$$.  The sum of $$$s_i$$$ over all segments of partition should be equal to zero. Note that each $$$s_i$$$ does not have to be equal to zero, this property is about sum of $$$s_i$$$ over all segments of partition.The set of segments $$$[l_1, r_1], [l_2, r_2], \ldots, [l_k, r_k]$$$ is called a partition of the array $$$a$$$ of length $$$n$$$ if $$$1 = l_1 \le r_1, l_2 \le r_2, \ldots, l_k \le r_k = n$$$ and $$$r_i + 1 = l_{i+1}$$$ for all $$$i = 1, 2, \ldots k-1$$$. In other words, each element of the array must belong to exactly one segment.You have to build a partition of the given array with properties described above or determine that such partition does not exist.Note that it is not required to minimize the number of segments in the partition.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10\,000$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \le n \le 200\,000$$$) — the length of array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$a_i$$$ is $$$-1$$$, $$$0$$$, or $$$1$$$) — the elements of the given array. It's guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$200\,000$$$.

For each test case print an integer $$$k$$$ — the number of segments in the partition. If required partition does not exist, print $$$-1$$$. If partition exists, in the $$$i$$$-th of the following $$$k$$$ lines print two integers $$$l_i$$$ and $$$r_i$$$ — description of the $$$i$$$-th segment. The following conditions should be satisfied:   $$$l_i \le r_i$$$ for each $$$i$$$ from $$$1$$$ to $$$k$$$.  $$$l_{i + 1} = r_i + 1$$$ for each $$$i$$$ from $$$1$$$ to $$$(k - 1)$$$.  $$$l_1 = 1, r_k = n$$$.  If there are multiple correct partitions of the array, print any of them.

NoteIn the first test case we can build a partition of $$$4$$$ segments — each of them will contain only one element of the array equals to $$$0$$$. So the sum will be equal to $$$0 + 0 + 0 + 0 = 0$$$.In the second test case we can build a partition of $$$4$$$ segments. The alternating sum of the first segment will be equal to $$$-1$$$, the alternating sum of the second segment will be equal to $$$1$$$, of the third segment — $$$0 - 1 + 0 = -1$$$, of the fourth segment — $$$1 - 0 = 1$$$. The sum will be equal to $$$-1 + 1 -1 + 1 = 0$$$.In the third test case it can be proved that the required partition does not exist.

{-# LANGUAGE LambdaCase #-}

import Control.Monad

seg_should_be_long st x y =
	st /= 0 && st == 2 * (x + y) ||
	st /= 0 && x == 0 && y == st ||
	st == 0 && x /= 0 && x == y

alt_sum = \case
	[x] -> x
	[x, y] -> x - y
	_ -> undefined

sol = reverse . sol_rec [] 0
	where
		sol_rec segs st = \case
			[] -> segs
			[x] -> [x]:segs
			x:y:ls ->
				let (seg, ls') =
					if seg_should_be_long st x y
					then ([x, y], ls)
					else ([x], y:ls)
				in sol_rec (seg:segs) (st + alt_sum seg) ls'

main = do
	n <- readLn :: IO Int
	replicateM_ n $ do
		getLine
		ls <- sol <$> map read <$> words <$> getLine :: IO [[Int]]
		if sum (map alt_sum ls) == 0
		then do
			print $ length ls
			foldM_ print_segs 1 ls
		else
			print (-1)
	where
		print_segs tot seg = do
			putStrLn $ show tot ++ ' ':(show $ tot + length seg - 1)
			return $ tot + length seg

{-# LANGUAGE LambdaCase #-}

import Control.Monad

seg_should_be_long st x y =
	st /= 0 && st == 2 * (x + y) ||
	st /= 0 && x == 0 && y == st ||
	st == 0 && x /= 0 && x == y

alt_sum = \case
	[x] -> x
	[x, y] -> x - y
	_ -> undefined

sol = sol_rec 0
	where
		sol_rec st = \case
			[] -> []
			[x] -> [[x]]
			x:y:ls ->
				let (seg, ls') =
					if seg_should_be_long st x y
					then ([x, y], ls)
					else ([x], y:ls)
				in seg:(sol_rec (st + alt_sum seg) ls')

main = do
	n <- readLn :: IO Int
	replicateM_ n $ do
		getLine
		ls <- sol <$> map read <$> words <$> getLine :: IO [[Int]]
		if sum (map alt_sum ls) == 0
		then do
			print $ length ls
			foldM_ print_segs 1 ls
		else
			print (-1)
	where
		print_segs tot seg = do
			putStrLn $ show tot ++ ' ':(show $ tot + length seg - 1)
			return $ tot + length seg


Mihai has an $$$8 \times 8$$$ chessboard whose rows are numbered from $$$1$$$ to $$$8$$$ from top to bottom and whose columns are numbered from $$$1$$$ to $$$8$$$ from left to right.Mihai has placed exactly one bishop on the chessboard. The bishop is not placed on the edges of the board. (In other words, the row and column of the bishop are between $$$2$$$ and $$$7$$$, inclusive.)The bishop attacks in all directions diagonally, and there is no limit to the distance which the bishop can attack. Note that the cell on which the bishop is placed is also considered attacked.     An example of a bishop on a chessboard. The squares it attacks are marked in red. Mihai has marked all squares the bishop attacks, but forgot where the bishop was! Help Mihai find the position of the bishop.

The first line of the input contains a single integer $$$t$$$ ($$$1 \leq t \leq 36$$$) — the number of test cases. The description of test cases follows. There is an empty line before each test case. Each test case consists of $$$8$$$ lines, each containing $$$8$$$ characters. Each of these characters is either '#' or '.', denoting a square under attack and a square not under attack, respectively.

For each test case, output two integers $$$r$$$ and $$$c$$$ ($$$2 \leq r, c \leq 7$$$) — the row and column of the bishop.  The input is generated in such a way that there is always exactly one possible location of the bishop that is not on the edge of the board.

NoteThe first test case is pictured in the statement. Since the bishop lies in the intersection row $$$4$$$ and column $$$3$$$, the correct output is 4 3.

module Main where

import Data.List

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

sep [] = []
sep (_:xs) = head:(sep tail)
  where (head,tail) = splitAt 8 xs

parse xs = map (=='#') $ concat xs

format :: Int -> String
format x = show (i+1) ++ " " ++ show (j+1)
  where (i,j) = divMod x 8

solve :: [Bool] -> Int
solve xs = head $ filter isBishop squares
  where isBishop x = all (xs !!) [x, x-9, x+7] :: Bool
        squares = [x+8*y | x <- ids, y <- ids] :: [Int]
        ids = [1..6]

module Main where

import Control.Monad (replicateM_, replicateM)
import qualified Data.Map as M
import Data.Map.Internal ((!?))
import Data.Maybe (fromMaybe)

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

getPositionCharactersInString :: Char -> String -> [Int]
getPositionCharactersInString ch = map snd . filter ((== ch) . fst) . flip zip [1..]

getChessBoard :: IO [String]
getChessBoard = do
  _ <- getLine
  replicateM 8 getLine

lineBeforeBishop :: [Int] -> Bool
lineBeforeBishop [x, y] = y - x == 2
lineBeforeBishop _ = False

solution :: IO ()
solution = do
  board <- getChessBoard
  let ([x1, x2], y) = head $ filter (lineBeforeBishop . fst) $ zip (map (getPositionCharactersInString '#') board) [2..]
  putStrLn $ show y <> " " <> show ((x1 + x2) `div` 2)

main :: IO ()
main = do
  [t] <- getNumbers
  replicateM_ t solution

rd :: Int -> IO [String]
rd 0 = pure []
rd i = do
  s <- getLine
  ans <- rd $ i - 1
  pure (s: ans)

findH :: [String] -> Int -> Int -> (Int, Int)
findH a x y = if (&&) ((&&) (a !! (x - 1) !! (y - 1) == '#') (a !! (x - 1) !! (y + 1) == '#')) ((&&) (a !! (x + 1) !! (y - 1) == '#') (a !! (x + 1) !! (y + 1) == '#'))
  then (x, y)
  else if y == 6
    then findH a (x + 1) 1
    else findH a x (y + 1)

find :: [String] -> (Int, Int)
find a = findH a 1 1

solve :: Int -> IO ()
solve 0 = pure ()
solve i = do
  s <- tail <$> (rd 9)
  let (x, y) = find s
  putStrLn $ show (x + 1) ++ " " ++ show (y + 1)
  solve $ i - 1

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


You have $$$n$$$ barrels lined up in a row, numbered from left to right from one. Initially, the $$$i$$$-th barrel contains $$$a_i$$$ liters of water.You can pour water from one barrel to another. In one act of pouring, you can choose two different barrels $$$x$$$ and $$$y$$$ (the $$$x$$$-th barrel shouldn't be empty) and pour any possible amount of water from barrel $$$x$$$ to barrel $$$y$$$ (possibly, all water). You may assume that barrels have infinite capacity, so you can pour any amount of water in each of them. Calculate the maximum possible difference between the maximum and the minimum amount of water in the barrels, if you can pour water at most $$$k$$$ times.Some examples:   if you have four barrels, each containing $$$5$$$ liters of water, and $$$k = 1$$$, you may pour $$$5$$$ liters from the second barrel into the fourth, so the amounts of water in the barrels are $$$[5, 0, 5, 10]$$$, and the difference between the maximum and the minimum is $$$10$$$;  if all barrels are empty, you can't make any operation, so the difference between the maximum and the minimum amount is still $$$0$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k < n \le 2 \cdot 10^5$$$) — the number of barrels and the number of pourings you can make. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 10^{9}$$$), where $$$a_i$$$ is the initial amount of water the $$$i$$$-th barrel has. It's guaranteed that the total sum of $$$n$$$ over test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, print the maximum possible difference between the maximum and the minimum amount of water in the barrels, if you can pour water at most $$$k$$$ times.

{-# LANGUAGE Safe #-}

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

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

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

solve :: Int -> [Int] -> Integer
solve k = sum . map toInteger . take (k + 1) . reverse . sort

import Control.Monad
import Data.List
import Data.Int

main :: IO()
main = do
  t <- readLn
  replicateM_ t $ do
    inputs <- map (read) <$> words <$> getLine
    line <- getLine
    print $ sum $ take ((inputs!!1) + 1) $ reverse $ (sort $ map (read) $ words line :: [Int64])

import Control.Monad
import Data.List

main :: IO()
main = do
  t <- readLn
  replicateM_ t $ do
    inputs <- map (read) <$> words <$> getLine
    line <- getLine
    print $ sum $ take ((inputs!!1) + 1) $ reverse $ (sort $ map (read) $ words line :: [Integer])

import Data.List
import Control.Monad

main = do
  cases <- read <$> getLine
  replicateM cases $ do
    (n:k:_) <- map read <$> words <$> getLine
    barrels <- map read <$> words <$> getLine
    putStrLn $ show $ maximalPourDiff k barrels

maximalPourDiff :: Int -> [Integer] -> Integer
maximalPourDiff k barrels = sum $ take (k+1) $ reverse $ sort barrels

{-# LANGUAGE Safe #-}

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

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

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

solve :: Int -> [Int] -> Int
solve k = sum . take (k + 1) . reverse . sort

import Data.List
import Control.Monad

main = do
  cases <- read <$> getLine
  replicateM cases $ do
    (n:k:_) <- map read <$> words <$> getLine
    barrels <- map read <$> words <$> getLine
    putStrLn $ show $ maximalPourDiff k barrels

maximalPourDiff :: Int -> [Int] -> Int
maximalPourDiff k barrels = sum $ take (k+1) $ reverse $ sort barrels


An integer array $$$a_1, a_2, \ldots, a_n$$$ is being transformed into an array of lowercase English letters using the following prodecure:While there is at least one number in the array:   Choose any number $$$x$$$ from the array $$$a$$$, and any letter of the English alphabet $$$y$$$.  Replace all occurrences of number $$$x$$$ with the letter $$$y$$$. For example, if we initially had an array $$$a = [2, 3, 2, 4, 1]$$$, then we could transform it the following way:  Choose the number $$$2$$$ and the letter c. After that $$$a = [c, 3, c, 4, 1]$$$.  Choose the number $$$3$$$ and the letter a. After that $$$a = [c, a, c, 4, 1]$$$.  Choose the number $$$4$$$ and the letter t. After that $$$a = [c, a, c, t, 1]$$$.  Choose the number $$$1$$$ and the letter a. After that $$$a = [c, a, c, t, a]$$$. After the transformation all letters are united into a string, in our example we get the string "cacta".Having the array $$$a$$$ and the string $$$s$$$ determine if the string $$$s$$$ could be got from the array $$$a$$$ after the described transformation?

The first line contains a single integer $$$t$$$ $$$(1 \leq t \leq 10^3$$$) — the number of test cases. Then the description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 50$$$) — the length of the array $$$a$$$ and the string $$$s$$$. The second line of each test case contains exactly $$$n$$$ integers: $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 50$$$) — the elements of the array $$$a$$$. The third line of each test case contains a string $$$s$$$ of length $$$n$$$, consisting of lowercase English letters.

For each test case, output "YES", if we can get the string $$$s$$$ from the array $$$a$$$, and "NO" otherwise. You can output each letter in any case.

NoteThe first test case corresponds to the sample described in the statement.In the second test case we can choose the number $$$50$$$ and the letter a.In the third test case we can choose the number $$$11$$$ and the letter a, after that $$$a = [a, 22]$$$. Then we choose the number $$$22$$$ and the letter b and get $$$a = [a, b]$$$.In the fifth test case we can change all numbers one by one to the letter a.

module Main where

import Control.Monad (replicateM_)
import qualified Data.Map as M

transform :: [(Int, Char)] -> M.Map Int Char -> [Char]
transform [] _ = []
transform ((d, c):rs) m =
  case M.lookup d m of
    (Just c') -> c' : transform rs m
    Nothing  -> c : transform rs m'
                where m' = M.insert d c m

solveProblem :: [(Int, Char)] -> Bool
solveProblem rs = transform rs M.empty == map snd rs

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

handleProblem :: IO ()
handleProblem = do
  getLine
  numbers <- map read . words <$> getLine
  letters <- getLine
  putStrLn $ formatSolution $ solveProblem $ numbers `zip` letters

main :: IO ()
main = do
  numberProblems <- read <$> getLine
  replicateM_ numberProblems handleProblem

{-# LANGUAGE CPP #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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

#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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> B8.ByteString -> Bool
solve n as s = L.length counterExamples == 0
    where
        str = B8.unpack s
        counterExamples = do
            x1@(a1, c1) <- zip as str
            x2@(a2, c2) <- zip as str
            M.guard $ a1 == a2 && c1 /= c2
            M.guard $ not (x1 == x2)
            tracingM "x1" x1
            tracingM "x2" x2
            return True

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        s <- B8.getLine <&> B8.filter isAlphaNum
        let answer = solve n as s
        putsYesNo answer


Little Petya has a birthday soon. Due this wonderful event, Petya's friends decided to give him sweets. The total number of Petya's friends equals to n.Let us remind you the definition of the greatest common divisor: GCD(a1, ..., ak) = d, where d represents such a maximal positive number that each ai (1 ≤ i ≤ k) is evenly divisible by d. At that, we assume that all ai's are greater than zero.Knowing that Petya is keen on programming, his friends has agreed beforehand that the 1-st friend gives a1 sweets, the 2-nd one gives a2 sweets, ..., the n-th one gives an sweets. At the same time, for any i and j (1 ≤ i, j ≤ n) they want the GCD(ai, aj) not to be equal to 1. However, they also want the following condition to be satisfied: GCD(a1, a2, ..., an) = 1. One more: all the ai should be distinct.Help the friends to choose the suitable numbers a1, ..., an.

The first line contains an integer n (2 ≤ n ≤ 50).

If there is no answer, print "-1" without quotes. Otherwise print a set of n distinct positive numbers a1, a2, ..., an. Each line must contain one number. Each number must consist of not more than 100 digits, and must not contain any leading zeros. If there are several solutions to that problem, print any of them. Do not forget, please, that all of the following conditions must be true:  For every i and j (1 ≤ i, j ≤ n): GCD(ai, aj) ≠ 1 GCD(a1, a2, ..., an) = 1 For every i and j (1 ≤ i, j ≤ n, i ≠ j): ai ≠ aj  Please, do not use %lld specificator to read or write 64-bit integers in C++. It is preffered to use cout (also you may use %I64d).

import Data.List
probe x s = if all (\a -> x `mod` a /= 0) s then x else probe (x+1) s
prime k ss | length ss < k = prime k ((probe (head ss) ss):ss)
           | otherwise = reverse ss
main = do
    n <- readIO =<< getLine
    let p = prime n [2]
        m = 10^100
        l = map (\i -> product ((p!!(i-1))`delete`p)) [1..n]
    if n < 3 || any (>= m) l then putStrLn "-1" else mapM_ (putStrLn.show) l

import Data.List
probe x s = if all (\a -> x `mod` a /= 0) s then x else probe (x+1) s
prime k ss | length ss < k = prime k ((probe (head ss) ss):ss)
           | otherwise = reverse ss
main = do
    n <- readIO =<< getLine
    let p = prime n [2]
        l = map (\i -> product ((p!!(i-1))`delete`p)) [1..n]
        m = 10^100
    if n < 3 || any (>= m) l then putStrLn "-1" else mapM_ (putStrLn.show) l

import Data.List

primes = 2 : 3 : [p | p <- [5,7..],
                  all (\x -> p `mod` x /= 0) $ takeWhile (\x -> x*x<=p) primes]

ok xs = length xs /= 2 &&
        all (\x -> all (\y -> gcd x y /= 1) xs) xs &&
        all ((<=100).length.show) xs

main = do
  n <- readLn
  let ps = take (n+1) primes
      ps' = take n primes
      xs' = map product $ take (n-1) $ tails ps'
      xs = head xs' : map (last ps*) (tail xs') ++ [last ps * 2]
  if ok xs then mapM_ print xs else print (-1)

main :: IO ()
main = do
	n <- getLine
	let nn = read n :: Int
--	sequence (map print (solve nn))
	mapM_ print (solve nn)

solve :: Int -> [Integer]
solve 2 = [-1]
solve n = (product xs) : (map (2 * ) xs) where (x : xs) = take n er

er = erpr [2..]
erpr (x : xs) = x : erpr [y | y <- xs, y `mod` x /= 0]

main :: IO ()
main = do
	n <- getLine
	let nn = read n :: Int
	mapM_ print (solve nn)

solve :: Int -> [Int]
solve 2 = [-1]
solve n = 10 : 15 : map (6 *) [1..n-2]

import Data.Array

isPrime n = isPrime' n 2
    where
    isPrime' n i
        | i * i > n = True
        | n `mod` i == 0 = False
        | otherwise = isPrime' n (i + 1)

solve input =
    let n = (read input)::Int in
    let primes = filter isPrime [2..500] in
    let a = listArray (0, (length primes) - 1) primes in
    case n of
        2 -> show(-1)
        _ ->
            let res = ((a ! 0) * (a ! 1)) : ((a ! 0) * (a ! 2)) : ((a ! 1) * (a ! 2)) : (map (\x -> (a ! x) * (a ! 1) * (a ! 2)) [3..(n - 1)]) in
            let out = map (show) res in
            unlines out

main = interact(solve)

import Data.List
probe x s = if all (\a -> x `mod` a /= 0) s then x else probe (x+1) s
prime k ss | length ss < k = prime k ((probe (head ss) ss):ss)
           | otherwise = reverse ss
main = do
    n <- readIO =<< getLine
    let p = prime n [2]
        l = map (\i -> product ((p!!(i-1))`delete`p)) [1..n]
        m = 10^100
    if any (>= m) l then putStrLn "-1" else mapM_ (putStrLn.show) l

import Data.List

primes = 2 : 3 : [p | p <- [5,7..],
                  all (\x -> p `mod` x /= 0) $ takeWhile (\x -> x*x<=p) primes]

ok xs = all (\x -> all (\y -> gcd x y /= 1) xs) xs &&
        all ((<=100).length.show) xs

main = do
  n <- readLn
  let ps = take (n+1) primes
      x = product (last ps : take (n-1) ps)
      xs = map product $ take (n-1) $ tail (tails ps)
  if ok (x:xs) || True then mapM_ print (x:xs) else print (-1)


Berland National Library has recently been built in the capital of Berland. In addition, in the library you can take any of the collected works of Berland leaders, the library has a reading room.Today was the pilot launch of an automated reading room visitors' accounting system! The scanner of the system is installed at the entrance to the reading room. It records the events of the form "reader entered room", "reader left room". Every reader is assigned a registration number during the registration procedure at the library — it's a unique integer from 1 to 106. Thus, the system logs events of two forms:  "+ ri" — the reader with registration number ri entered the room;  "- ri" — the reader with registration number ri left the room. The first launch of the system was a success, it functioned for some period of time, and, at the time of its launch and at the time of its shutdown, the reading room may already have visitors.Significant funds of the budget of Berland have been spent on the design and installation of the system. Therefore, some of the citizens of the capital now demand to explain the need for this system and the benefits that its implementation will bring. Now, the developers of the system need to urgently come up with reasons for its existence.Help the system developers to find the minimum possible capacity of the reading room (in visitors) using the log of the system available to you.

The first line contains a positive integer n (1 ≤ n ≤ 100) — the number of records in the system log. Next follow n events from the system journal in the order in which the were made. Each event was written on a single line and looks as "+ ri" or "- ri", where ri is an integer from 1 to 106, the registration number of the visitor (that is, distinct visitors always have distinct registration numbers). It is guaranteed that the log is not contradictory, that is, for every visitor the types of any of his two consecutive events are distinct. Before starting the system, and after stopping the room may possibly contain visitors.

Print a single integer — the minimum possible capacity of the reading room.

NoteIn the first sample test, the system log will ensure that at some point in the reading room were visitors with registration numbers 1, 1200 and 12001. More people were not in the room at the same time based on the log. Therefore, the answer to the test is 3.

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

trans :: [String] -> [(Int, Int)]
trans []       = []
trans (op:r:s) | op == "+" = (1, (read r)):(trans s)
               | otherwise = (0, (read r)):(trans s)

solve :: [(Int, Int)] -> Int
solve r = solve' (reverse (complete (reverse r) [])) []
    where
        solve' :: [(Int, Int)] -> [Int] -> Int
        solve' []          a = length a
        solve' ((1, r):rs) a = solve' rs (insertTo a r)
        solve' ((0, r):rs) a = solve' rs (removeFrom a r)

removeElem :: [Int] -> Int -> [Int]
removeElem [] v     = []
removeElem (l:ls) v | l == v    = ls
                    | otherwise = l:(removeElem ls v)

complete :: [(Int, Int)] -> [Int] -> [(Int, Int)]
complete [] []         = []
complete [] (c:cs)     = (1, c):(complete [] cs)
complete ((0, r):rs) c = (0, r):(complete rs (r:c))
complete ((1, r):rs) c = (1, r):(complete rs (removeElem c r))

insertTo :: [Int] -> Int -> [Int]
insertTo []     v = [v]
insertTo (0:rs) v = v:rs
insertTo (r:rs) v = r:(insertTo rs v)

removeFrom :: [Int] -> Int -> [Int]
removeFrom (r:rs) v | r == v    = 0:rs
                    | otherwise = r:(removeFrom rs v)

import Control.Monad
import Data.List

main = do
    n <- fmap read getLine
    rs <- forM [1..n] (\_ -> fmap ((\[ch,v] -> (head ch, read v)) . words) getLine)
    print $ solve rs

solve :: [(Char, Int)] -> Int
solve (x:xs) = g [] 0 $ f [] x xs
    where f l1 (ch, v) (x:xs) = if ch == '-' && noPlus v l1 then f (('+', v):l1 ++ [('-', v)]) x xs
                                else f (l1 ++ [(ch, v)]) x xs
          f l1 (ch, v) [] = if ch == '-' && noPlus v l1 then (('+', v):l1 ++ [('-', v)])
                            else (l1 ++ [(ch, v)])
          g :: [Int] -> Int -> [(Char,Int)] -> Int
          g sys m (('+',v):xs) = g (v:sys) (max m $ length sys + 1) xs
          g sys m (('-',v):xs) = g (sys\\[v]) m xs
          g _ m [] = m

noPlus :: Int -> [(Char, Int)] -> Bool
noPlus v = all (\(ch,v1) -> ch /= '+' || v /= v1)

module Main where

import Control.Applicative
import Control.Monad
import Prelude hiding (id)

import qualified Data.Map as M

solve :: [(Int, String)] -> M.Map Int Int -> Int -> Int
solve [] _ acc = acc
solve ((id, sign) : xs) m acc
    | sign == "+" = let newacc = max (M.size newm) acc
                        newm = M.insert id 0 m
                     in solve xs newm newacc
    | otherwise = if M.member id m then solve xs (M.delete id m) acc
                                   else solve xs m (acc + 1)

main :: IO ()
main = do
    n <- (\s -> read s :: Int) <$> getLine
    xs <- replicateM n (do
                       (sign, id) <- ((\[s, i] -> (s, read i :: Int)) . words) <$> getLine
                       return (id, sign))
    print $ solve xs M.empty 0


There is an array with n elements a1, a2, ..., an and the number x.In one operation you can select some i (1 ≤ i ≤ n) and replace element ai with ai & x, where & denotes the bitwise and operation.You want the array to have at least two equal elements after applying some operations (possibly, none). In other words, there should be at least two distinct indices i ≠ j such that ai = aj. Determine whether it is possible to achieve and, if possible, the minimal number of operations to apply.

The first line contains integers n and x (2 ≤ n ≤ 100 000, 1 ≤ x ≤ 100 000), number of elements in the array and the number to and with. The second line contains n integers ai (1 ≤ ai ≤ 100 000), the elements of the array.

Print a single integer denoting the minimal number of operations to do, or -1, if it is impossible.

NoteIn the first example one can apply the operation to the last element of the array. That replaces 7 with 3, so we achieve the goal in one move.In the second example the array already has two equal elements.In the third example applying the operation won't change the array at all, so it is impossible to make some pair of elements equal.

import Data.Bits
import qualified Data.Map.Strict as Map

toint s = (read s) :: Int

agregar x m = Map.insertWith (+) x 1 m
quitar :: Integer -> (Map.Map Integer Integer) -> (Map.Map Integer Integer)
quitar x m = Map.insertWith (+) x (-1) m

asdasd [] = Map.fromList []
asdasd (x:xs) = agregar x (asdasd xs)

op = (.&.)

doit x [] w = False
doit x (a:as) w =
  let t = op a x in
  if t /= a && (Map.findWithDefault 0 t w) > 0 then
    True
  else
    doit x as w

solve::String -> String
solve ss =
  let (n:x:a) = Prelude.map toint $ words ss in
  let w = asdasd a in
  if (Map.size w) < n then
    "0\n"
  else
    if doit x a w then
      "1\n"
    else
      let ww = asdasd (map (\t -> op t x) a) in
      if (Map.size ww) < n then
        "2\n"
      else
        "-1\n"

main = interact solve

-- import Data.Counter (count, empty)
import qualified Data.Map as M
import Data.Bits ((.&.))

count :: [Int] -> M.Map Int Int
count = foldr (\k -> M.insertWith (+) k 1) M.empty

main = do
    n:x:[] <- fmap (map read . words) getLine
    a <- fmap (count . map read . words) getLine
    if M.size a < n
    then print 0
    else if any (\v -> (v /= v .&. x) && M.member (v .&. x) a) $ M.keys a
        then print 1
        else if n > (M.size $ M.mapKeys (.&. x) a)
            then print 2
            else print (-1)

import System.IO
import Control.Applicative
{-import Data.HashSet-}
import Data.Bits
import qualified Data.Map as Map
import Data.Tuple

parse :: String -> Int -> [Int]
parse input line_idx  = map read $ words $ lines input !! line_idx

solve :: String -> String
solve input = (show $ answer x as ) ++ "\n"
{-solve input = (show $ merged_map x as ) ++ "\n"-}
        where
          n = parse input 0 !! 0 :: Int
          x = parse input 0 !! 1 :: Int
          as = parse input 1 :: [Int]

type Mymap = Map.Map Int (Int, Int)

answer x as
    | pre_answer == 3  = -1
    | otherwise        = pre_answer
        where
            pre_answer = foldl min 3 (map extractEachAnswer ( Map.elems (counter (.&.x) as)) )

extractEachAnswer :: (Int, Int) -> Int
extractEachAnswer (a, b)
    | a>=2  = 0
    | a>=1 && b>=1 && a+b>=2 = 1
    | b>=2  = 2
    | otherwise = 3

{-counter :: [Int] -> Mymap-}
counter func as = foldr (addToMap func) Map.empty as

addToMap :: (Int -> Int) -> Int -> Mymap -> Mymap
addToMap func a = Map.alter modifier a . (if (func a) /= a then Map.alter modifier2 (func a) else id)
    where
    modifier2 = mswap . modifier . mswap
        where
        mswap = fmap swap

modifier :: Maybe (Int, Int) -> Maybe (Int, Int)
modifier Nothing = Just (1, 0)
modifier (Just (a, b)) = Just (a+1, b)

main = (solve <$> getContents) >>= putStr

import Data.Bits
import qualified Data.Map.Strict as Map

toint s = (read s) :: Int

agregar x m = Map.insertWith (+) x 1 m
quitar :: Integer -> (Map.Map Integer Integer) -> (Map.Map Integer Integer)
quitar x m = Map.insertWith (+) x (-1) m

asdasd [] = Map.fromList []
asdasd (x:xs) = agregar x (asdasd xs)

op = (.&.)

doit x [] w = False
doit x (a:as) w =
  let t = op a x in
  if t /= a && (Map.findWithDefault 0 t w) > 0 then
    True
  else
    doit x as w

solve::String -> String
solve ss =
  let (n:x:a) = Prelude.map toint $ words ss in
  let w = asdasd a in
  if (Map.size w) < n then
    "0\n"
  else
    if doit x a w then
      "1\n"
    else
      let ww = asdasd (map (\t -> op t x) a) in
      if (Map.size w) < n then
        "2\n"
      else
        "-1\n"

main = interact solve


Polycarpus works as a programmer in a start-up social network. His boss gave his a task to develop a mechanism for determining suggested friends. Polycarpus thought much about the task and came to the folowing conclusion. Let's say that all friendship relationships in a social network are given as m username pairs ai, bi (ai ≠ bi). Each pair ai, bi means that users ai and bi are friends. Friendship is symmetric, that is, if ai is friends with bi, then bi is also friends with ai. User y is a suggested friend for user x, if the following conditions are met:  x ≠ y;  x and y aren't friends;  among all network users who meet the first two conditions, user y has most of all common friends with user x. User z is a common friend of user x and user y (z ≠ x, z ≠ y), if x and z are friends, and y and z are also friends. Your task is to help Polycarpus to implement a mechanism for determining suggested friends.

The first line contains a single integer m (1 ≤ m ≤ 5000) — the number of pairs of friends in the social network. Next m lines contain pairs of names of the users who are friends with each other. The i-th line contains two space-separated names ai and bi (ai ≠ bi). The users' names are non-empty and consist of at most 20 uppercase and lowercase English letters.  It is guaranteed that each pair of friends occurs only once in the input. For example, the input can't contain x, y and y, x at the same time. It is guaranteed that distinct users have distinct names. It is guaranteed that each social network user has at least one friend. The last thing guarantees that each username occurs at least once in the input.

In the first line print a single integer n — the number of network users. In next n lines print the number of suggested friends for each user. In the i-th line print the name of the user ci and the number of his suggested friends di after a space.  You can print information about the users in any order.

5
Mike Gerald
Kate Mike
Kate Tank
Gerald Tank
Gerald David

4
valera vanya
valera edik
pasha valera
igor valera

5
valera 0
vanya 3
edik 3
pasha 3
igor 3

NoteIn the first test case consider user David. Users Mike and Tank have one common friend (Gerald) with David. User Kate has no common friends with David. That's why David's suggested friends are users Mike and Tank.

import Control.Monad (forM, forM_)
import Data.Array (accumArray, array, assocs, (!))
import Data.Graph (flattenSCC, stronglyConnComp)
import Data.Int ()
import Data.List (group, sort)
import qualified Data.Array.Unboxed as A
import qualified Data.Map as M

inf = 10000

fromList a = M.fromList $ zip b [0 ..]
  where
    b = map head $ group $ sort a

pairs (x:y:z) = (x, y): pairs z
pairs _ = []

count f = length . filter f

main = do
  getLine
  a <- fmap words getContents
  let m = fromList a
      n = M.size m
      v = array (0,n-1) $ map (\(i, j) -> (j, i)) $ M.assocs m
      e = accumArray (flip (:)) [] (0,n-1) $
        concat [[(i, j), (j, i)] | (i, j) <- pairs $ map (m M.!) a]
      scc = map flattenSCC $ stronglyConnComp [(i, i, t)  | (i, t) <- assocs e]

  ans <- fmap concat $ forM scc $ \g -> do
    let mg = fromList g
        ng = M.size mg
        sub i = (mg M.! i, map (mg M.!) $ e!i)
        w :: A.UArray (Int, Int) Int
        w = A.accumArray (+) 0 ((0,0),(ng-1,ng-1)) $ concat $ [((i,i),-inf) | i <- [0 .. ng-1]]:
          [((i,j),-inf): [((j,k),1) | k <- t] | (i, t) <- map sub g, j <- t]
    forM (M.assocs mg) $ \(k, i) -> do
      let a = [w A.! (i,j) | j <- [0 .. ng-1]]
          d = maximum a
          c = case compare d 0 of
                GT -> count (==d) a
                EQ -> count (==0) a + (n - ng)
                LT -> n - ng
      return (v!k, c)

  print n
  forM_ ans $ \(i, j) -> do
    putStrLn $ i ++ " " ++ show j

import Control.Monad
import Data.Array
import Data.Array.IO
import Data.Array.MArray
import Data.List
import Data.Int
import qualified Data.Map as M

main = do
  getLine
  a <- fmap words getContents
  let v = map head $ group $ sort a
      n = length v
      m = M.fromList $ zip v [0 ..]
      go [] = []
      go (x:y:z) = (m M.! x, m M.! y): go z
      e = accumArray (flip (:)) [] (0,n-1) $ concat [[(i, j), (j, i)] | (i, j) <- go a]

  w <- newArray ((0,0),(n-1,n-1)) 0 :: IO (IOUArray (Int, Int) Int)
  forM_ (assocs e) $ \(i, v) -> do
    writeArray w (i, i) $ -9999
    forM_ v $ \j -> do
      writeArray w (i, j) $ -9999
      forM_ v $ \k -> do
        c <- readArray w (j, k)
        writeArray w (j, k) $ c + 1
  w <- unsafeFreeze w

  forM_ (zip [0 .. n-1] v) $ \(i, v) -> do
    let c = [w!(i,j) | j <- [0 .. n-1]]
        d = maximum c
    putStr $ v ++ " "
    if d >= 0
      then print $ length $ filter (==d) c
      else print $ 0

import Control.Monad (forM, forM_)
import Data.Array (accumArray, array, assocs, (!))
import Data.Graph (flattenSCC, stronglyConnComp)
import Data.Int ()
import Data.List (group, sort)
import qualified Data.Array.Unboxed as A
import qualified Data.Map as M

inf = 10000

fromList a = M.fromList $ zip b [0 ..]
  where
    b = map head $ group $ sort a

pairs (x:y:z) = (x, y): pairs z
pairs _ = []

count f = length . filter f

main = do
  getLine
  a <- fmap words getContents
  let m = fromList a
      n = M.size m
      v = array (0,n-1) $ map (\(i, j) -> (j, i)) $ M.assocs m
      e = accumArray (flip (:)) [] (0,n-1) $
        concat [[(i, j), (j, i)] | (i, j) <- pairs $ map (m M.!) a]
      scc = map flattenSCC $ stronglyConnComp [(i, i, t)  | (i, t) <- assocs e]

  ans <- fmap concat $ forM scc $ \g -> do
    let mg = fromList g
        ng = M.size mg
        sub i = (mg M.! i, map (mg M.!) $ e!i)
        w :: A.UArray (Int, Int) Int
        w = A.accumArray (+) 0 ((0,0),(ng-1,ng-1)) $ concat $ [((i,i),-inf) | i <- [0 .. ng-1]]:
          [((i,j),-inf): [((j,k),1) | k <- t] | (i, t) <- map sub g, j <- t]
    forM (M.assocs mg) $ \(k, i) -> do
      let a = [w A.! (i,j) | j <- [0 .. ng-1]]
          d = maximum a
          c = case compare d 0 of
                GT -> count (==d) a
                EQ -> count (==0) a + (n - ng)
                LT -> 0
      return (v!k, c)

  print n
  forM_ ans $ \(i, j) -> do
    putStrLn $ i ++ " " ++ show j

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

main = do
  getLine
  a <- fmap words getContents
  let v = map head $ group $ sort a
      n = length v
      m = M.fromList $ zip v [0 ..]
      go [] = []
      go (x:y:z) = (m M.! x, m M.! y): go z
      e = accumArray (flip (:)) [] (0,n-1) $ concat [[(i, j), (j, i)] | (i, j) <- go a]
      w = accumArray (+) 0 ((0,0),(n-1,n-1)) $ concat
        [((i,j),-n): [((j,k),1) | k <- s, j /= k] | (i,s) <- assocs e, j <- s]
  print $ n
  forM_ (zip [0 .. n-1] v) $ \(i, v) -> do
    let c = [w!(i,j) | j <- [0 .. n-1]]
        d = maximum c
    putStr $ v ++ " "
    if d > 0
      then print $ length $ filter (==d) c
      else print $ 0

import Control.Monad (forM, forM_)
import Data.Array (accumArray, array, assocs, (!))
import Data.Graph (flattenSCC, stronglyConnComp)
import Data.Int ()
import Data.List (group, sort)
import qualified Data.Array.Unboxed as A
import qualified Data.Map as M

inf = 10000

fromList a = M.fromList $ zip b [0 ..]
  where
    b = map head $ group $ sort a

pairs (x:y:z) = (x, y): pairs z
pairs _ = []

main = do
  getLine
  a <- fmap words getContents
  let m = fromList a
      n = M.size m
      v = array (0,n-1) $ map (\(i, j) -> (j, i)) $ M.assocs m
      e = accumArray (flip (:)) [] (0,n-1) $
        concat [[(i, j), (j, i)] | (i, j) <- pairs $ map (m M.!) a]
      scc = map flattenSCC $ stronglyConnComp [(i, i, t)  | (i, t) <- assocs e]

  ans <- fmap concat $ forM scc $ \g -> do
    let m = fromList g
        n = M.size m
        sub i = (m M.! i, map (m M.!) $ e!i)
        w :: A.UArray (Int, Int) Int
        w = A.accumArray (+) 0 ((0,0),(n-1,n-1)) $ concat $ [((i,i),-inf) | i <- [0 .. n - 1]]:
          [((i,j),-inf): [((j,k),1) | k <- t] | (i, t) <- map sub g, j <- t]
    forM (M.assocs m) $ \(k, i) -> do
      let c = [w A.! (i,j) | j <- [0 .. n-1]]
          d = maximum c
      if d < 0
        then return (v!k, -n)
        else return (v!k, subtract n $ length $ filter (==d) c)

  forM_ ans $ \(i, j) -> do
    putStrLn $ i ++ " " ++ show (j + n)

import Control.Monad (forM, forM_)
import Data.Array (accumArray, array, assocs, (!))
import Data.Graph (flattenSCC, stronglyConnComp)
import Data.Int ()
import Data.List (group, sort)
import qualified Data.Array.Unboxed as A
import qualified Data.Map as M

inf = 10000

fromList a = M.fromList $ zip b [0 ..]
  where
    b = map head $ group $ sort a

pairs (x:y:z) = (x, y): pairs z
pairs _ = []

main = do
  getLine
  a <- fmap words getContents
  let m = fromList a
      n = M.size m
      v = array (0,n-1) $ map (\(i, j) -> (j, i)) $ M.assocs m
      e = accumArray (flip (:)) [] (0,n-1) $
        concat [[(i, j), (j, i)] | (i, j) <- pairs $ map (m M.!) a]
      scc = map flattenSCC $ stronglyConnComp [(i, i, t)  | (i, t) <- assocs e]

  ans <- fmap concat $ forM scc $ \g -> do
    let m = fromList g
        n = M.size m
        sub i = (m M.! i, map (m M.!) $ e!i)
        w :: A.UArray (Int, Int) Int
        w = A.accumArray (+) 0 ((0,0),(n-1,n-1)) $ concat $ [((i,i),-inf) | i <- [0 .. n - 1]]:
          [((i,j),-inf): [((j,k),1) | k <- t] | (i, t) <- map sub g, j <- t]
    forM (M.assocs m) $ \(k, i) -> do
      let c = [w A.! (i,j) | j <- [0 .. n-1]]
          d = maximum c
      if d < 0
        then return (v!k, -n)
        else return (v!k, subtract n $ length $ filter (==d) c)

  print n
  forM_ ans $ \(i, j) -> do
    putStrLn $ i ++ " " ++ show (j + n)


An array is sorted if it has no inversionsA Young BoyYou are given an array of $$$n$$$ positive integers $$$a_1,a_2,\ldots,a_n$$$. In one operation you do the following:   Choose any integer $$$x$$$.  For all $$$i$$$ such that $$$a_i = x$$$, do $$$a_i := 0$$$ (assign $$$0$$$ to $$$a_i$$$). Find the minimum number of operations required to sort the array in non-decreasing order.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$). The second line of each test case contains $$$n$$$ positive integers $$$a_1,a_2,\ldots,a_n$$$ ($$$1 \le a_i \le n$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print one integer — the minimum number of operations required to sort the array in non-decreasing order.

NoteIn the first test case, you can choose $$$x = 3$$$ for the operation, the resulting array is $$$[0, 0, 2]$$$.In the second test case, you can choose $$$x = 1$$$ for the first operation and $$$x = 3$$$ for the second operation, the resulting array is $$$[0, 0, 0, 0]$$$.

--
-- 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
import Data.Set              qualified as Set

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], xs] <- replicateM 2 ri
        return xs
    mapM_ (putStrLn.show.solve) tcs

solve xs = ops
  where
    rev = reverse xs
    withPrev = zip rev (head rev : rev)
    maxGoodSuff = takeWhile (uncurry (<=)) withPrev
    zeroingLen = length xs - length maxGoodSuff
    (pref, _suff) = splitAt zeroingLen xs

    byVal = Map.fromListWith (++) . map (second (:[])) . (xs `zip`) . (`zip` xs) $ inds

    ops = doOps (xs,byVal) (Set.fromList pref)

doOps (xs,byVal) rmVals
    | (Set.size newRmVals > Set.size rmVals)  = doOps (xs,byVal) newRmVals
    | otherwise                               = Set.size rmVals
  where
    (!) = (Map.!)
    rmPoints = concatMap (byVal!) . Set.toList $ rmVals
    maxZeroedInd | null rmPoints  = 0
                 | otherwise      = maximum . map fst $ rmPoints

    newRmVals = Set.fromList . take maxZeroedInd $ xs

inds = [1..] :: [Int]


Since the giant heads have appeared in the sky all humanity is in danger, so all Ricks and Mortys from all parallel universes are gathering in groups to find a solution to get rid of them. There are n parallel universes participating in this event (n Ricks and n Mortys). I. e. each of n universes has one Rick and one Morty. They're gathering in m groups. Each person can be in many groups and a group can contain an arbitrary number of members.Ricks and Mortys have registered online in these groups. So, a person can have joined a group more than once (developer of this website hadn't considered this possibility).  Summer from universe #1 knows that in each parallel universe (including hers) exactly one of Rick and Morty from that universe is a traitor and is loyal, but no one knows which one. She knows that we are doomed if there's a group such that every member in that group is a traitor (they will plan and destroy the world). Summer knows that if there's a possibility that world ends (there's a group where all members are traitors) she should immediately cancel this event. So she wants to know if she should cancel the event. You have to tell her yes if and only if there's at least one scenario (among all 2n possible scenarios, 2 possible scenarios for who a traitor in each universe) such that in that scenario the world will end.

The first line of input contains two integers n and m (1 ≤ n, m ≤ 104) — number of universes and number of groups respectively. The next m lines contain the information about the groups. i-th of them first contains an integer k (number of times someone joined i-th group, k > 0) followed by k integers vi, 1, vi, 2, ..., vi, k. If vi, j is negative, it means that Rick from universe number  - vi, j has joined this group and otherwise it means that Morty from universe number vi, j has joined it. Sum of k for all groups does not exceed 104.

In a single line print the answer to Summer's question. Print "YES" if she should cancel the event and "NO" otherwise.

NoteIn the first sample testcase, 1st group only contains the Rick from universe number 3, so in case he's a traitor, then all members of this group are traitors and so Summer should cancel the event.

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

main = do
  [nu, ng] <- fmap readInts B.getLine
  gs <- replicateM ng $ fmap (tail . readInts) B.getLine
  putStr $ if solve gs then "YES" else "NO"

solve = any (\g -> let s = S.fromList g in all (\m -> S.notMember (-m) s) g)

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

import Data.List
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = output . solve . drop 2 . map (fst . fromJust . C.readInt) . C.words =<< B.getContents

output :: Bool -> IO ()
output True = putStrLn "NO"
output False = putStrLn "YES"

solve :: [Int] -> Bool
solve [] = True
solve (n:x) = let (a, s) = splitAt n x
                  r = sort $ filter (> 0) a
                  m = sort $ map abs $ filter (< 0) a
              in check r m && solve s

check :: [Int] -> [Int] -> Bool
check [] _ = False
check _ [] = False
check (a:ax) (b:bx) | a == b    = True
                    | a < b     = check ax (b:bx)
                    | otherwise = check (a:ax) bx

{-# LANGUAGE ViewPatterns #-}
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.IntSet           (fromList, intersection, null)
import           Data.List             (partition, unfoldr)
import           Prelude               hiding (null)

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

main :: IO ()
main = do
  [_, m] <- getInts
  groups <- replicateM m getInts
  putStrLn $ if any traitor groups then "YES" else "NO" where
    traitor nums = let (pos, fmap negate -> neg) = partition (> 0) $ tail nums
                   in null (fromList pos `intersection` fromList neg)

{-# LANGUAGE ViewPatterns #-}
import Data.Set
import Control.Monad
import Data.Set as S
import Prelude as P

f (b, set) x | S.member (-1*x) set = (b && False, insert x set)
    | otherwise = (b || False, insert x set)

main = do
    (fmap (read::String -> Int) . words -> [n, m]) <- getLine
    (P.map  (P.map (read :: String -> Int) . tail. words) -> ls) <- replicateM m getLine
    let g = P.foldl f (True, S.empty)
    let res =  P.map (fst . (\ xs -> if (size $ snd $ g xs) == 1 then (True, S.empty) else g xs))  ls
    if (or res)
        then putStrLn "YES"
        else putStrLn "NO"

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

import Control.Monad (forM)
import Data.List (nub)

main = do
    (map (read :: String -> Int) . words -> [n, m]) <- getLine
    xs <- forM [1..m] $ \i -> do
        (map abs . nub . map (read :: String -> Int) . tail . words -> x) <- getLine
        return x
    let f True _ = True
        f False x = length x == length (nub x)
    if foldl f False xs then
        putStrLn "YES"
    else
        putStrLn "NO"

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

main = do
  [nu, ng] <- fmap readInts B.getLine
  gs <- replicateM ng $ fmap (tail . readInts) B.getLine
  print $ if solve gs then "YES" else "NO"

solve = any (\g -> let s = S.fromList g in all (\m -> S.notMember (-m) s) g)

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

{-# LANGUAGE ViewPatterns #-}
import Data.Set
import Control.Monad
import Data.Set as S
import Prelude as P

f (b, set) x | S.member (-1*x) set = (b && False, set)
    | otherwise = (b || False, insert x set)

main = do
    (fmap (read::String -> Int) . words -> [n, m]) <- getLine
    (P.map  (P.map (read :: String -> Int) . tail. words) -> ls) <- replicateM m getLine
    let g = P.foldl f (True, S.empty)
    let res =  P.map (fst . (\ xs -> if (size $ snd $ g xs) == 1 then (True, S.empty) else g xs))  ls

    if (or res)
        then putStrLn "YES"
        else putStrLn "NO"

{-# LANGUAGE ViewPatterns #-}
import Data.Set
import Control.Monad
import Data.Set as S
import Prelude as P

f (b, set) x | S.member (-1*x) set = (b && False, insert x set)
    | otherwise = (b || False, insert x set)

main = do
    (fmap (read::String -> Int) . words -> [n, m]) <- getLine
    (P.map  (P.map (read :: String -> Int) . tail. words) -> ls) <- replicateM m getLine
    let g = P.foldl f (True, S.empty)
    let res =  P.map (fst . (\ xs -> if (size $ snd $ g xs) == 1 then (True, S.empty) else g xs))  ls
    print res
    if (or res)
        then putStrLn "YES"
        else putStrLn "NO"

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

import Control.Monad (forM_, forM)
import Data.List (nub)

main = do
    (map (read :: String -> Int) . words -> [n, m]) <- getLine
    xs <- forM [1..m] $ \i -> do
        (map (abs . (read :: String -> Int)) . tail . words -> x) <- getLine
        return x
    let f True _ = True
        f False x = length x == length (nub x)
    if foldl f False xs then
        putStrLn "YES"
    else
        putStrLn "NO"


Recently, Duff has been practicing weight lifting. As a hard practice, Malek gave her a task. He gave her a sequence of weights. Weight of i-th of them is 2wi pounds. In each step, Duff can lift some of the remaining weights and throw them away. She does this until there's no more weight left. Malek asked her to minimize the number of steps.  Duff is a competitive programming fan. That's why in each step, she can only lift and throw away a sequence of weights 2a1, ..., 2ak if and only if there exists a non-negative integer x such that 2a1 + 2a2 + ... + 2ak = 2x, i. e. the sum of those numbers is a power of two.Duff is a competitive programming fan, but not a programmer. That's why she asked for your help. Help her minimize the number of steps.

The first line of input contains integer n (1 ≤ n ≤ 106), the number of weights. The second line contains n integers w1, ..., wn separated by spaces (0 ≤ wi ≤ 106 for each 1 ≤ i ≤ n), the powers of two forming the weights values.

Print the minimum number of steps in a single line.

NoteIn the first sample case: One optimal way would be to throw away the first three in the first step and the rest in the second step. Also, it's not possible to do it in one step because their sum is not a power of two.In the second sample case: The only optimal way is to throw away one weight in each step. It's not possible to do it in less than 4 steps because there's no subset of weights with more than one weight and sum equal to a power of two.

import Control.Applicative
import Data.Array.Unboxed
import Data.Bits
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
	_ <- readLn :: IO Int
	w <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine
	putStrLn . show $ solve w

solve :: [Int] -> Int
solve w = f 0 0 . elems $ arr
	where
		arr					= accumArray (+) 0 (0, 100 + 10 ^ 6) $ [(x, 1) | x <- w] :: UArray Int Int
		f ans _ []			= ans
		f ans k (x : xs)	= f (ans + ((k + x) .&. 1)) ((k + x) `shiftR` 1) xs

{--import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array.IO

solve :: [Int] -> IO Int
solve w = do
    arr <- newArray (0,2*10^6) False :: IO (IOArray Int Bool)
    mapM (add arr) w
    length . filter id <$> getElems arr
    where
        add arr i = do
            x <- readArray arr i
            if x
                then do
                    writeArray arr i False
                    add arr (i+1)
                else writeArray arr i True

main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve w--}

import Control.Applicative
import Data.Array.Unboxed
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
	_ <- readLn :: IO Int
	w <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine
	putStrLn . show $ solve w

solve :: [Int] -> Int
solve w = f 0 0 . elems $ arr
	where
		arr					= accumArray (+) 0 (0, 100 + 10 ^ 6) $ [(x, 1) | x <- w] :: UArray Int Int
		f ans _ []			= ans
		f ans k (x : xs)	= f (ans + ((k + x) `mod` 2)) ((k + x) `div` 2) xs

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

process::Int->[Int]->Int
process n [] = n
process n [0] = n
process n (a:b:as) | a==0 = process n (b:as)
                   | even a = process n ((b+ div a 2):as)
	           | otherwise = process (n+1) ((b+ div a 2):as)

main= do
	getLine
	s<-    map ( fst.fromJust.C.readInt).C.words <$> C.getLine ::IO [Int]
	let q = 50+(maximum s)
	let a= accumArray (+) 0 (0,(min q 1000050)) $  zip s (repeat 1)
	print $   process 0 $ elems a

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

solve :: [Int] -> Int -> Int
solve [] _ = 0
solve (x:xs) pre
    | x == pre = solve xs (pre+1)
    | x == pre-1 = 1 + solve xs pre
    | otherwise = 1 + solve xs x

main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w (-1)

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

solve :: [Int] -> Int -> Int -> Int
solve [] cnt _
    | cnt > 2 = (cnt-1) `div` 2
    | otherwise = 0
solve (x:xs) cnt pre
    | x == pre = solve xs (cnt+1) x
    | cnt > 1 && x == pre + 1 = (cnt-1) `div` 2 + solve xs 2 x
    | otherwise = 1 + solve xs 1 x
main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w 0 (-1)

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

solve :: [Int] -> Int -> Int
solve [] _ = 0
solve (x:xs) pre
    | x == pre = solve xs (pre+1)
    | otherwise = 1 + solve xs x

main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w (-1)

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

solve :: [Int] -> Int -> Int -> Int
solve [] cnt _
    | cnt > 2 = cnt `div` 2
    | otherwise = 0
solve (x:xs) cnt pre
    | x == pre = solve xs (cnt+1) x
    | cnt > 1 && x == pre + 1 = (cnt-1) `div` 2 + solve xs 2 x
    | otherwise = 1 + solve xs 1 x
main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w 0 (-1)

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

solve :: [Int] -> Int -> Int -> Int
solve [] _ _ = 0
solve (x:xs) cnt pre
    | x == pre = solve xs (cnt+1) x
    | cnt > 0 && x == pre + 1 = cnt `div` 2 + solve xs 1 x
    | otherwise = 1 + solve xs 0 x
main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w 0 (-1)

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

solve :: [Int] -> Int -> Int -> Int
solve [] cnt _
    | cnt > 2 = (cnt-1) `div` 2
    | otherwise = 0
solve (x:xs) cnt pre
    | x == pre = solve xs (cnt+1) x
    | cnt > 1 && x == pre + 1 = (cnt-1) `div` 2 + solve xs 2 x
    | otherwise = 1 + (cnt-1) `div` 2 + solve xs 1 x
main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w 1 (-1)


On a cold winter evening our hero Vasya stood in a railway queue to buy a ticket for Codeforces championship final. As it usually happens, the cashier said he was going to be away for 5 minutes and left for an hour. Then Vasya, not to get bored, started to analyze such a mechanism as a queue. The findings astonished Vasya.Every man is characterized by two numbers: ai, which is the importance of his current task (the greater the number is, the more important the task is) and number ci, which is a picture of his conscience. Numbers ai form the permutation of numbers from 1 to n.Let the queue consist of n - 1 people at the moment. Let's look at the way the person who came number n behaves. First, he stands at the end of the queue and the does the following: if importance of the task ai of the man in front of him is less than an, they swap their places (it looks like this: the man number n asks the one before him: "Erm... Excuse me please but it's very important for me... could you please let me move up the queue?"), then he again poses the question to the man in front of him and so on. But in case when ai is greater than an, moving up the queue stops. However, the man number n can perform the operation no more than cn times.In our task let us suppose that by the moment when the man number n joins the queue, the process of swaps between n - 1 will have stopped. If the swap is possible it necessarily takes place.Your task is to help Vasya model the described process and find the order in which the people will stand in queue when all the swaps stops.

The first input line contains an integer n which is the number of people who has joined the queue (1 ≤ n ≤ 105). In the next n lines descriptions of the people are given in order of their coming — space-separated integers ai and ci (1 ≤ ai ≤ n, 0 ≤ ci ≤ n). Every description is located on s single line. All the ai's are different.

Output the permutation of numbers from 1 to n, which signifies the queue formed according to the above described rules, starting from the beginning to the end. In this succession the i-th number stands for the number of a person who will stand in line on the place number i after the swaps ends. People are numbered starting with 1 in the order in which they were given in the input. Separate numbers by a space.

{-# LANGUAGE BangPatterns #-}
import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits
import System.Random

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

tsomenode x i !seed = Node x seed x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node !x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ !y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ !mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ !sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ !i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) 0 0 (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t !left !right
 | tnull t = -infinit
 | left > right = -infinit
 | (left == 1) && (right == (tsize t)) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead !left !right
 | left > right = rhead
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t _ = t
solve ((a,c):acs) !n t g =
  let pos = (binSrch t a n (max 1 (n - c)) n)
      (nr, ng) = randomR (1, 32767) g in
      solve acs (n + 1) (tadd t (tsomenode a n nr) pos) ng

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers !n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  g <- newStdGen
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil g) [])

{-# LANGUAGE BangPatterns #-}
import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits
import System.Random

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

seedme !seed = (.&.) (shiftR (seed * 214013 + 2531011) 16) 32767

tsomenode x i !seed = Node x (seedme seed) x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node !x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ !y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ !mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ !sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ !i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) 0 0 (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t !left !right
 | tnull t = -infinit
 | left > right = -infinit
 | (left == 1) && (right == (tsize t)) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead !left !right
 | left > right = rhead
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t _ = t
solve ((a,c):acs) !n t g =
  let pos = (binSrch t a n (max 1 (n - c)) n)
      (nr, ng) = randomR (1, 10000000) g in
      solve acs (n + 1) (tadd t (tsomenode a n nr) pos) ng

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers !n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  g <- newStdGen
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil g) [])

{-# LANGUAGE BangPatterns #-}
import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits
import System.Random

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

tsomenode x i !seed = Node x seed x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node !x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ !y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ !mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ !sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ !i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) 0 0 (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t !left !right
 | tnull t = -infinit
 | left > right = -infinit
 | (left == 1) && (right == (tsize t)) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead !left !right
 | left > right = rhead
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t _ = t
solve ((a,c):acs) !n t g =
  let pos = (binSrch t a n (max 1 (n - c)) n)
      (nr, ng) = randomR (1, 10000000) g in
      solve acs (n + 1) (tadd t (tsomenode a n nr) pos) ng

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers !n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  g <- newStdGen
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil g) [])

import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

seedme (s1,s2,s3) = xor (1237 * s1 + 5129 * s2 + 3287 * s3 + 12485) 73813

tsomenode x i seed = Node x (seedme seed) x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) (tmax n) (tsize n) (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t left right
 | tnull t = -infinit
 | left > right = -infinit
 | (left == 1) && (right == (tsize t)) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead left right
 | left > right = rhead
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t = t
solve ((a,c):acs) n t =
  let pos = (binSrch t a n (max 1 (n - c - 1)) n) in
      solve acs (n + 1) (tadd t (tsomenode a n (a,c,n)) pos)

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil) [])

import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

seedme (s1,s2,s3) = xor (1237 * s1 + 5129 * s2 + 3287 * s3 + 12485) 73813

tsomenode x i seed = Node x (seedme seed) x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) (tmax n) (tsize n) (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t left right
 | tnull t = -infinit
 | left > right = -infinit
 | (right - left + 1) == (tsize t) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead left right
 | left > right = infinit
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t = t
solve ((a,c):acs) n t =
  let pos = (binSrch t a n (max 1 (n - c)) n) in
      solve acs (n + 1) (tadd t (tsomenode a n (a,c,n)) pos)

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil) [])


You want to perform the combo on your opponent in one popular fighting game. The combo is the string $$$s$$$ consisting of $$$n$$$ lowercase Latin letters. To perform the combo, you have to press all buttons in the order they appear in $$$s$$$. I.e. if $$$s=$$$"abca" then you have to press 'a', then 'b', 'c' and 'a' again.You know that you will spend $$$m$$$ wrong tries to perform the combo and during the $$$i$$$-th try you will make a mistake right after $$$p_i$$$-th button ($$$1 \le p_i < n$$$) (i.e. you will press first $$$p_i$$$ buttons right and start performing the combo from the beginning). It is guaranteed that during the $$$m+1$$$-th try you press all buttons right and finally perform the combo.I.e. if $$$s=$$$"abca", $$$m=2$$$ and $$$p = [1, 3]$$$ then the sequence of pressed buttons will be 'a' (here you're making a mistake and start performing the combo from the beginning), 'a', 'b', 'c', (here you're making a mistake and start performing the combo from the beginning), 'a' (note that at this point you will not perform the combo because of the mistake), 'b', 'c', 'a'.Your task is to calculate for each button (letter) the number of times you'll press it.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n \le 2 \cdot 10^5$$$, $$$1 \le m \le 2 \cdot 10^5$$$) — the length of $$$s$$$ and the number of tries correspondingly. The second line of each test case contains the string $$$s$$$ consisting of $$$n$$$ lowercase Latin letters. The third line of each test case contains $$$m$$$ integers $$$p_1, p_2, \dots, p_m$$$ ($$$1 \le p_i < n$$$) — the number of characters pressed right during the $$$i$$$-th try. It is guaranteed that the sum of $$$n$$$ and the sum of $$$m$$$ both does not exceed $$$2 \cdot 10^5$$$ ($$$\sum n \le 2 \cdot 10^5$$$, $$$\sum m \le 2 \cdot 10^5$$$). It is guaranteed that the answer for each letter does not exceed $$$2 \cdot 10^9$$$.

For each test case, print the answer — $$$26$$$ integers: the number of times you press the button 'a', the number of times you press the button 'b', $$$\dots$$$, the number of times you press the button 'z'.

3
4 2
abca
1 3
10 5
codeforces
2 8 3 2 9
26 10
qwertyuioplkjhgfdsazxcvbnm
20 10 1 2 3 5 10 5 9 4

NoteThe first test case is described in the problem statement. Wrong tries are "a", "abc" and the final try is "abca". The number of times you press 'a' is $$$4$$$, 'b' is $$$2$$$ and 'c' is $$$2$$$.In the second test case, there are five wrong tries: "co", "codeforc", "cod", "co", "codeforce" and the final try is "codeforces". The number of times you press 'c' is $$$9$$$, 'd' is $$$4$$$, 'e' is $$$5$$$, 'f' is $$$3$$$, 'o' is $$$9$$$, 'r' is $$$3$$$ and 's' is $$$1$$$.

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import Data.Ord
import Data.Char
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (n, m) <- liftM2 (,) get get
    s <- get
    p <- replicateM m get
    putln $ f2 n m p s

f2 :: Int -> Int -> [Int] -> String -> [Int64]
f2 n m p s =
    let ps = sort p in
    let ans = runSTUArray $ do
                cache <- newArray (0, 25) 0 :: ST s (STUArray s Int Int64)
                a <- newArray (0, 25) 0 :: ST s (STUArray s Int Int64)
                foldlM (\(i, px) c ->
                    let idx = (ord c) - (ord 'a') in
                        do
                            k <- readArray cache idx
                            writeArray cache idx (k + 1)
                            np <- f3 a cache i px
                            return (i + 1, np)
                    ) (1, ps) s
                forM_ [0..25] (\k -> do
                    x <- readArray cache k
                    y <- readArray a k
                    writeArray a k (x + y))
                return a
    in
    fmap ((!) ans) [0..25]

f3 :: (STUArray s Int Int64) -> (STUArray s Int Int64) -> Int -> [Int] -> ST s [Int]
f3 a cache i [] = return []
f3 a cache i (hd : tl) = if i == hd then
    do
        forM_ [0..25] (\k -> do
            x <- readArray cache k
            y <- readArray a k
            writeArray a k (x + y)
            )
        f3 a cache i tl
    else
        return (hd : tl)

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (n, m) <- liftM2 (,) get get
    a <- replicateM n get
    p <- replicateM m get
    putln $ if f2 a p then "YES" else "NO"

f2 :: [Int] -> [Int] -> Bool
f2 a p =    let pk = runSTUArray $ do
                a <- newArray (1, 101) 0 :: ST s (STUArray s Int Int)
                forM_ p (\c -> writeArray a c 1)
                return a
            in
            let ax = zip a [1..] in
            all (\(ai, i) ->
                all (\(aj, j) ->
                    if i < j && ai > aj then
                        all (\k ->
                            pk ! k /= 0)
                        [i..j-1]
                    else True
                ) ax
            ) ax


Everybody knows that the Berland citizens are keen on health, especially students. Berland students are so tough that all they drink is orange juice!Yesterday one student, Vasya and his mates made some barbecue and they drank this healthy drink only. After they ran out of the first barrel of juice, they decided to play a simple game. All n people who came to the barbecue sat in a circle (thus each person received a unique index bi from 0 to n - 1). The person number 0 started the game (this time it was Vasya). All turns in the game were numbered by integers starting from 1. If the j-th turn was made by the person with index bi, then this person acted like that:  he pointed at the person with index (bi + 1) mod n either with an elbow or with a nod (x mod y is the remainder after dividing x by y);  if j ≥ 4 and the players who had turns number j - 1, j - 2, j - 3, made during their turns the same moves as player bi on the current turn, then he had drunk a glass of juice;  the turn went to person number (bi + 1) mod n. The person who was pointed on the last turn did not make any actions.The problem was, Vasya's drunk too much juice and can't remember the goal of the game. However, Vasya's got the recorded sequence of all the participants' actions (including himself). Now Vasya wants to find out the maximum amount of juice he could drink if he played optimally well (the other players' actions do not change). Help him.You can assume that in any scenario, there is enough juice for everybody.

The first line contains a single integer n (4 ≤ n ≤ 2000) — the number of participants in the game. The second line describes the actual game: the i-th character of this line equals 'a', if the participant who moved i-th pointed at the next person with his elbow, and 'b', if the participant pointed with a nod. The game continued for at least 1 and at most 2000 turns.

Print a single integer — the number of glasses of juice Vasya could have drunk if he had played optimally well.

NoteIn both samples Vasya has got two turns — 1 and 5. In the first sample, Vasya could have drunk a glass of juice during the fifth turn if he had pointed at the next person with a nod. In this case, the sequence of moves would look like "abbbb". In the second sample Vasya wouldn't drink a single glass of juice as the moves performed during turns 3 and 4 are different.

{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,TypeSynonymInstances #-}

import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

newtype State s a = State { runState :: s -> (a,s) }

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

instance Monad (State s) where
    return x = State $ \s -> (x,s)
    x >>= f  = State $ \s ->
        let (a,s') = runState x s in runState (f a) s'

instance Applicative (State s) where
    pure = return
    (<*>) = ap

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    n <- readLine
    s <- getLine
    print $ solve n s

solve :: Int -> String -> Int
solve n s = length $ filter (check n) (split n (tail s))

split n [] = []
split n l  = take n l:split n (drop n l)

check n l | length l < n = False
          | otherwise = case reverse l of
    _:'a':'a':'a':_ -> True
    _:'b':'b':'b':_ -> True
    _               -> False

main = interact ( show . af . conv . lines )
conv l = ( read . head $ l, last l )
h = splitAt
f n l | length l < n = 0
      | otherwise    = g ( reverse $ fst ( h n l ) ) + f n ( snd ( h n l ) )
g ( a:b:c:d:t ) | b == c && c == d = 1
                | otherwise        = 0
af ( x,y ) = f x ( tail y )

main = interact $ show . fi . lines
fi (n:s:[]) = go (read n) s
go n s | length s > n = (if eq == True then 1 else 0) + (go n $ drop n s)
       | otherwise = 0
       where eq = foldl (\i x -> i || all x (drop (n-3) $ take n s)) False [(=='b'),(=='a')]

solve :: Int -> String -> Int
solve n s  =  length $ filter good $ init $ group s
  where
    good as  =  case reverse as of
        (a1 : a2 : a3 : _)  ->  a1 == a2 && a2 == a3
    group []  =  []
    group xs  =  take n xs : group (drop n xs)

main :: IO ()
main  =  do
    n  <-  readLn
    s  <-  getLine
    print $ solve n s

import Control.Applicative

main = f <$> readLn <*> getLine >>= print

f n (_:cs) = length.filter (p.drop (n-4)) $ slices n cs

p [x,y,z,_] = x==y && y==z
p _ = False

slices :: Int -> [a] -> [[a]]
slices n xs = map(take n).takeWhile(not.null) $ iterate (drop n) xs

import Control.Applicative

slice n xs = map (take n) $ takeWhile (\x -> x /= []) (iterate (drop n) xs)

parse (x : y : z : xs) = if (x == y && y == z) then 1 else 0
parse _ = 0

solve n s = sum $ (map (parse . reverse) $ init (slice n s))

main =
	do n <- read <$> getLine
	   s <- getLine
	   print $ solve n s

{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,TypeSynonymInstances #-}

import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

newtype State s a = State { runState :: s -> (a,s) }

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

instance Monad (State s) where
    return x = State $ \s -> (x,s)
    x >>= f  = State $ \s ->
        let (a,s') = runState x s in runState (f a) s'

instance Applicative (State s) where
    pure = return
    (<*>) = ap

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    n <- readLine
    s <- getLine
    print $ solve n s

solve :: Int -> String -> Int
solve n s = length $ filter (check n) (split n (tail s))

split n [] = []
split n l  = take n l:split n (drop n l)

check n l | length l < n = False
          | otherwise = (==1) $ length $ group $ take (n-1) l

main = interact $ show . fi . lines
fi (n:s:[]) = go (read n) s
go n s | length s >= n = (if eq == True then 1 else 0) + (go n $ drop n s)
       | otherwise = 0
       where eq = foldl (\i x -> i || all x (drop (n-3) $ take n s)) False [(=='b'),(=='a')]