The only difference between the easy and hard versions is that the given string $$$s$$$ in the easy version is initially a palindrome, this condition is not always true for the hard version.A palindrome is a string that reads the same left to right and right to left. For example, "101101" is a palindrome, while "0101" is not.Alice and Bob are playing a game on a string $$$s$$$ (which is initially a palindrome in this version) of length $$$n$$$ consisting of the characters '0' and '1'. Both players take alternate turns with Alice going first.In each turn, the player can perform one of the following operations:   Choose any $$$i$$$ ($$$1 \le i \le n$$$), where $$$s[i] =$$$ '0' and change $$$s[i]$$$ to '1'. Pay 1 dollar.  Reverse the whole string, pay 0 dollars. This operation is only allowed if the string is currently not a palindrome, and the last operation was not reverse. That is, if Alice reverses the string, then Bob can't reverse in the next move, and vice versa. Reversing a string means reordering its letters from the last to the first. For example, "01001" becomes "10010" after reversing.The game ends when every character of string becomes '1'. The player who spends minimum dollars till this point wins the game and it is a draw if both spend equal dollars. If both players play optimally, output whether Alice wins, Bob wins, or if it is a draw.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^3$$$). Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^3$$$). The second line of each test case contains the string $$$s$$$ of length $$$n$$$, consisting of the characters '0' and '1'. It is guaranteed that the string $$$s$$$ is a palindrome and contains at least one '0'.  Note that there is no limit on the sum of $$$n$$$ over test cases.

For each test case print a single word in a new line:    "ALICE", if Alice will win the game,  "BOB", if Bob will win the game,  "DRAW", if the game ends in a draw.

NoteIn the first test case of the example,   in the $$$1$$$-st move Alice has to perform the $$$1$$$-st operation, since the string is currently a palindrome.  in the $$$2$$$-nd move Bob reverses the string.  in the $$$3$$$-rd move Alice again has to perform the $$$1$$$-st operation. All characters of the string are '1', game over.  Alice spends $$$2$$$ dollars while Bob spends $$$0$$$ dollars. Hence, Bob always wins.

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | numZero == 0 = "DRAW"
                     | numZero == 1 = "BOB"
                     | (odd . length $ l) && (odd numZero) = "ALICE"
                     | (odd . length $ l) && (even numZero) = "BOB"
                     | (even . length $ l) = "BOB"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn (caseString l numZero)

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    return $ stringUtf8 (if odd n && C.index str (n `div` 2) == '0' && C.count '0' str > 1 then "ALICE" else "BOB") `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Arrow ((>>>))

main = interact $ words >>> drop 1 >>> chunksOf 2 >>> map solve >>> unlines

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs =
  let (fs, xs') = splitAt k xs
   in fs : chunksOf k xs'

solve :: [String] -> String
solve [_, s]
  | even fz || fz == 1 = "BOB"
  | otherwise = "ALICE"
  where
    fz = count '0' s
    count c = length . filter (== c)

main = interact (unlines . g . tail .  lines)

g [] = []
g (x:y:xs) = (f y: g xs)
f::String->String
f y | rem t 2 == 0 = "BOB"
  | t == 1 = "BOB"
  |otherwise = "ALICE"
  where t = count '0' y

count x [] = 0
count x (y:ys) |x==y = 1 + count x ys
count x y = count x (tail y)

module Main where

    solve :: IO ()
    solve = do
        getLine
        s <- getLine
        let cnt = length $ filter (== '0') s
        putStrLn $ if cnt == 1 then
                "BOB"
            else if cnt `mod` 2 == 1 then
                "ALICE"
            else
                "BOB"

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

import           Control.Monad

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        _ <- getLine
        s <- getLine
        let z = length $ filter (== '0') s
        putStrLn $ if even z || z == 1 then "BOB" else "ALICE"

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | numZero == 0 = "DRAW"
                     | ((length l) == 1) && (numZero == 1) = "BOB"
                     | (odd . length $ l) && (odd numZero) = "ALICE"
                     | (odd . length $ l) && (even numZero) = "BOB"
                     | (even . length $ l) = "BOB"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn (caseString l numZero)

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | (odd . length $ l) && (odd numZero) = "ALICE"
                     | (odd . length $ l) && (even numZero) = "BOB"
                     | (even . length $ l) && (numZero == length l) = "DRAW"
                     | (even . length $ l) && (numZero /= length l) = "BOB"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn (caseString l numZero)

import Control.Monad (replicateM)
import Data.Sequence (mapWithIndex)

main = do t <- read <$> getLine
          replicateM t solve

solve = do xs <- getLine
           putStrLn (show (countBeautiful xs (length xs)))

countBeautiful :: String -> Int -> Int
indicativeFunc :: (Int, Char) -> Int
indicativeFunc (i,a) | a == '1' && (even i) = 0
                     | a == '1' && (odd i) = 1
                     | a == '0' && (even i) = 1
                     | a == '0' && (odd i) = 0
                     | otherwise = 2
createIndicator :: [Char] -> [Int]
createIndicator x = (map indicativeFunc (zip [0..length x -1] x)) ++ [3]
--evenFunc :: [Int] -> Int -> Int
--evenFunc indi i | (indi !! i == 1 || indi !! i == 2) = evenFunc indi (i+1)
--                | otherwise = i

evenFunc :: [Int] -> [Int] -> Int -> Int -> [Int]
evenFunc indi acc idx prev | idx == length indi = reverse acc
                           | indi !! (length indi - idx - 1) == 0 = evenFunc indi (acc++[length indi - idx - 1]) (idx+1) (length indi - idx - 1)
                           | otherwise = evenFunc indi (acc ++ [prev]) (idx + 1) (prev)

oddFunc :: [Int] -> [Int] -> Int -> Int -> [Int]
oddFunc indi acc idx prev | idx == length indi = reverse acc
                          | indi !! (length indi - idx - 1) == 1 = oddFunc indi (acc++[length indi - idx - 1]) (idx+1) (length indi - idx - 1)
                          | otherwise = oddFunc indi (acc ++ [prev]) (idx + 1) (prev)
--oddFunc :: [Int] -> Int -> Int
--oddFunc indi i | (indi !! i == 0 || indi !! i == 2) = oddFunc indi (i+1)
--               | otherwise = i
countBeautiful x n = sum maxOfTwo - (n*(n+1) `div` 2)
                      where indicator = createIndicator x
                            evenLs = evenFunc indicator [] 0 (n)
                            oddLs = oddFunc indicator [] 0 (n)
                            maxOfTwo = [max x y | (x,y) <- zip evenLs oddLs]

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | (odd . length $ l) && (odd numZero) && (odd ((numZero-1) `div` 2)) = "ALICE"
                     | (odd . length $ l) && (odd numZero) && (even ((numZero-1) `div` 2)) = "BOB"
                     | (odd . length $ l) && (even numZero) && (odd (numZero `div` 2)) = "BOB"
                     | (odd . length $ l) && (even numZero) && (even (numZero `div` 2)) = "DRAW"
                     | (even . length $ l) && (odd (numZero `div` 2)) = "BOB"
                     | (even . length $ l) && (even (numZero `div` 2)) = "DRAW"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn (caseString l numZero)

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | (odd . length $ l) && (odd numZero) && (odd ((numZero-1) `div` 2)) = "ALICE"
                     | (odd . length $ l) && (odd numZero) && (even ((numZero-1) `div` 2)) = "BOB"
                     | (odd . length $ l) && (even numZero) && (odd (numZero `div` 2)) = "BOB"
                     | (odd . length $ l) && (even numZero) && (even (numZero `div` 2)) = "DRAW"
                     | (even . length $ l) && (odd (numZero `div` 2)) = "BOB"
                     | (even . length $ l) && (even (numZero `div` 2)) = "DRAW"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn . show $ (caseString l numZero)

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.take n <$> C.getLine
    let zeroNum = C.count '0' str
        isMiddleZero = odd n && C.index str (n `div` 2) == '0'
        level = zeroNum `div` 2
    return $ stringUtf8 (if isMiddleZero then (if odd level then "ALICE" else "BOB") else (if even level then "DRAW" else "BOB")) `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let zeroNum = C.count '0' str
        isMiddleZero = odd n && C.index str (n `div` 2) == '0'
        level = zeroNum `div` 2
    return $ stringUtf8 (if isMiddleZero then (if odd level then "ALICE" else "BOB") else (if even level then "DRAW" else "BOB")) `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let zeroNum = C.count '0' str
        isMiddleZero = odd n && C.index str (n `div` 2) == '0'
        level = zeroNum `div` 2
    return $ string7 (if isMiddleZero then (if odd level then "ALICE" else "BOB") else (if even level then "DRAW" else "BOB")) `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let zeroNum = C.count '0' str
    return $ string7 (if odd n && C.index str (n `div` 2) == '0' || zeroNum /= 0 && zeroNum `mod` 4 /= 0 then "BOB" else "DRAW") `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Arrow ((>>>))

main = interact $ words >>> drop 1 >>> chunksOf 2 >>> map solve >>> unlines

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs =
  let (fs, xs') = splitAt k xs
   in fs : chunksOf k xs'

solve :: [String] -> String
solve [ns, s]
  | even n = "BOB"
  | (s !! (n `div` 2)) == '1' = "BOB"
  | length (filter (== '0') s) == 1 = "BOB"
  | otherwise = "DRAW"
  where
    n = read ns


You are given array $$$a_1, a_2, \dots, a_n$$$. Find the subsegment $$$a_l, a_{l+1}, \dots, a_r$$$ ($$$1 \le l \le r \le n$$$) with maximum arithmetic mean $$$\frac{1}{r - l + 1}\sum\limits_{i=l}^{r}{a_i}$$$ (in floating-point numbers, i.e. without any rounding).If there are many such subsegments find the longest one.

The first line contains single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — length of the array $$$a$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 10^9$$$) — the array $$$a$$$.

Print the single integer — the length of the longest subsegment with maximum possible arithmetic mean.

NoteThe subsegment $$$[3, 4]$$$ is the longest among all subsegments with maximum arithmetic mean.

import Data.List
import Control.Monad

main = do
  n <- readLn :: (IO Int)
  v <- (map (read :: String->Int)) . words <$> getLine
  print $ maximum $ map length $ filter (\x -> head x == maximum v) $ group v

import Data.List

main = do
  n <- getLine
  v <- (map (read :: String->Int)) . words <$> getLine
  print $ maximum $ map length $ filter (\x -> head x == maximum v) $ group v

import Data.List
main=getContents>>=print.snd.maximum.map(\x->(head x::Int,length x)).group.map read.tail.words

import Data.List
main=do
 _<-getLine
 v<-map read.words<$>getLine
 print$foldr(max.length.filter(==maximum v))0$group(v::[Int])

import Data.List
main=interact$show.snd.maximum.map(\x->(read$head x::Int,length x)).group.tail.words

import Data.List
main=interact$show.snd.maximum.map(\x->(head x::Int,length x)).group.map read.tail.words

import Data.List
main=do
 v<-map read.tail.words<$>getContents
 print$foldr(max.length.filter(==(maximum v::Int)))0$group v

import Data.List
main=do
 v<-map read.tail.words<$>getContents
 print$foldr(max.length.filter(==maximum v))0$group(v::[Int])

import Data.List
main=do
 _<-getLine
 v<-(map read).words<$>getLine
 print$maximum$map length$filter(\x->head x==maximum v)$group(v::[Int])

import Data.List
main=map read.tail.words<$>getContents>>=(\v->print$snd$maximum$map(\x->(head x::Int,length x))$group v)

import Data.List
main=do
 _<-getLine
 v<-map read.words<$>getLine
 print$maximum$map(length.filter(==maximum v))$group(v::[Int])

import Data.List
main = interact $ show . process . map read . tail. words
process :: [Int] -> Int
process x = maximum $ map (\z -> if head z then length z else 0) $ group $ map (== mm) x
    where mm = maximum x

import Data.List
main=map read.tail.words<$>getContents>>=(print.snd.maximum.map(\x->(head x::Int,length x)).group)

import Data.List
main=do
 v<-map read.words<$>getContents
 print$foldr(max.length.filter(==maximum v))0$group(v::[Int])

import Data.List
main=do
 v<-map read.words.tail<$>getContents
 print$foldr(max.length.filter(==maximum v))0$group(v::[Int])

import Data.List
main = interact $ show . process . map read . tail. words
process :: [Int] -> Int
process [_] = 1
process x = 1 + (maximum $ map (\z -> if head z then length z else 0) $ group $ zipWith (==) x $ tail x)

import Data.List
main=do
 v<-map read.words<$>getContents
 print$foldr(max.length.filter(==maximum v))0$group$tail(v::[Int])


Tokitsukaze has a sequence $$$a$$$ of length $$$n$$$. For each operation, she selects two numbers $$$a_i$$$ and $$$a_j$$$ ($$$i \ne j$$$; $$$1 \leq i,j \leq n$$$).   If $$$a_i = a_j$$$, change one of them to $$$0$$$.  Otherwise change both of them to $$$\min(a_i, a_j)$$$. Tokitsukaze wants to know the minimum number of operations to change all numbers in the sequence to $$$0$$$. It can be proved that the answer always exists.

The first line contains a single positive integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. For each test case, the first line contains a single integer $$$n$$$ ($$$2 \leq n \leq 100$$$) — the length of the sequence $$$a$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \leq a_i \leq 100$$$) — the sequence $$$a$$$.

For each test case, print a single integer — the minimum number of operations to change all numbers in the sequence to $$$0$$$.

NoteIn the first test case, one of the possible ways to change all numbers in the sequence to $$$0$$$:In the $$$1$$$-st operation, $$$a_1 < a_2$$$, after the operation, $$$a_2 = a_1 = 1$$$. Now the sequence $$$a$$$ is $$$[1,1,3]$$$.In the $$$2$$$-nd operation, $$$a_1 = a_2 = 1$$$, after the operation, $$$a_1 = 0$$$. Now the sequence $$$a$$$ is $$$[0,1,3]$$$.In the $$$3$$$-rd operation, $$$a_1 < a_2$$$, after the operation, $$$a_2 = 0$$$. Now the sequence $$$a$$$ is $$$[0,0,3]$$$.In the $$$4$$$-th operation, $$$a_2 < a_3$$$, after the operation, $$$a_3 = 0$$$. Now the sequence $$$a$$$ is $$$[0,0,0]$$$.So the minimum number of operations is $$$4$$$.

import Data.List

main :: IO ()
main = do
	n <- getLine
	let number = read n :: Int
	solve number number

solve :: Int -> Int -> IO ()
solve number 0 = return ()
solve number current = 	do
				huita <- getLine
				let h = read huita :: Int
				line <- getLine
				let briga = (map read $ words line) :: [Int]
				let isZero = any (== 0) briga
				if isZero then putStrLn $ show $ poschitat (/= 0) briga
				else if allDifferent briga then putStrLn $ show $ h + 1 else putStrLn $ show $ h
				solve number (current - 1)

poschitat :: (a -> Bool) -> [a] -> Int
poschitat predicate = foldr (\s -> \acc -> if predicate s then acc + 1 else acc) 0

allDifferent :: Ord a => [a] -> Bool
allDifferent kinch = let
						sortir = sort kinch
					 in all (==False) $ zipWith (==) sortir $ tail sortir


You are given $$$n$$$ elements numbered from $$$1$$$ to $$$n$$$, the element $$$i$$$ has value $$$a_i$$$ and color $$$c_i$$$, initially, $$$c_i = 0$$$ for all $$$i$$$.The following operation can be applied:  Select three elements $$$i$$$, $$$j$$$ and $$$k$$$ ($$$1 \leq i < j < k \leq n$$$), such that $$$c_i$$$, $$$c_j$$$ and $$$c_k$$$ are all equal to $$$0$$$ and $$$a_i = a_k$$$, then set $$$c_j = 1$$$. Find the maximum value of $$$\sum\limits_{i=1}^n{c_i}$$$ that can be obtained after applying the given operation any number of times.

The first line contains an integer $$$n$$$ ($$$3 \leq n \leq 2 \cdot 10^5$$$) — the number of elements. The second line consists of $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq n$$$), where $$$a_i$$$ is the value of the $$$i$$$-th element.

Print a single integer in a line — the maximum value of $$$\sum\limits_{i=1}^n{c_i}$$$ that can be obtained after applying the given operation any number of times.

NoteIn the first test, it is possible to apply the following operations in order:

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

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

mainFun :: SP Builder
mainFun = do
  n <- getInt
  aLi <- replicateM n getInt
  let
    a :: UArray Int Int
    a = listArray (1, n) aLi
    rightmostByVal :: UArray Int Int
    rightmostByVal = accumArray max minBound (1, n)
      $ [(ai, i) | (i, ai) <- assocs a]
    rightmostByIx :: UArray Int Int
    rightmostByIx = listArray (1, n) $ map (rightmostByVal !) $ elems a
    go :: Int -> Int -> Int -> Int
    go currCt next0 currIx = if currIx > n
      then  currCt
      else  let
      bestR = foldl' max next0 [rightmostByIx ! ix | ix <- [currIx .. next0]]
      nextCt = currCt + bestR - next0 - 1 -- next0 is 0 for life...
      in  if  nextCt > currCt
      then  go nextCt bestR next0
      else  go currCt (next0 + 1) (next0 + 1)
  pure $ putInts [go 0 1 1]

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

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

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

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

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

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


You are given $$$k$$$ sequences of integers. The length of the $$$i$$$-th sequence equals to $$$n_i$$$.You have to choose exactly two sequences $$$i$$$ and $$$j$$$ ($$$i \ne j$$$) such that you can remove exactly one element in each of them in such a way that the sum of the changed sequence $$$i$$$ (its length will be equal to $$$n_i - 1$$$) equals to the sum of the changed sequence $$$j$$$ (its length will be equal to $$$n_j - 1$$$).Note that it's required to remove exactly one element in each of the two chosen sequences.Assume that the sum of the empty (of the length equals $$$0$$$) sequence is $$$0$$$.

The first line contains an integer $$$k$$$ ($$$2 \le k \le 2 \cdot 10^5$$$) — the number of sequences. Then $$$k$$$ pairs of lines follow, each pair containing a sequence. The first line in the $$$i$$$-th pair contains one integer $$$n_i$$$ ($$$1 \le n_i < 2 \cdot 10^5$$$) — the length of the $$$i$$$-th sequence. The second line of the $$$i$$$-th pair contains a sequence of $$$n_i$$$ integers $$$a_{i, 1}, a_{i, 2}, \dots, a_{i, n_i}$$$. The elements of sequences are integer numbers from $$$-10^4$$$ to $$$10^4$$$. The sum of lengths of all given sequences don't exceed $$$2 \cdot 10^5$$$, i.e. $$$n_1 + n_2 + \dots + n_k \le 2 \cdot 10^5$$$.

If it is impossible to choose two sequences such that they satisfy given conditions, print "NO" (without quotes). Otherwise in the first line print "YES" (without quotes), in the second line — two integers $$$i$$$, $$$x$$$ ($$$1 \le i \le k, 1 \le x \le n_i$$$), in the third line — two integers $$$j$$$, $$$y$$$ ($$$1 \le j \le k, 1 \le y \le n_j$$$). It means that the sum of the elements of the $$$i$$$-th sequence without the element with index $$$x$$$ equals to the sum of the elements of the $$$j$$$-th sequence without the element with index $$$y$$$. Two chosen sequences must be distinct, i.e. $$$i \ne j$$$. You can print them in any order. If there are multiple possible answers, print any of them.

NoteIn the first example there are two sequences $$$[2, 3, 1, 3, 2]$$$ and $$$[1, 1, 2, 2, 2, 1]$$$. You can remove the second element from the first sequence to get $$$[2, 1, 3, 2]$$$ and you can remove the sixth element from the second sequence to get $$$[1, 1, 2, 2, 2]$$$. The sums of the both resulting sequences equal to $$$8$$$, i.e. the sums are equal.

module Main where

import Control.Monad
import Data.List as L
import Data.Map as M
import Data.ByteString.Char8 as C
import Data.ByteString as BS

readInts :: Int -> ByteString -> ([Int],ByteString)
readInts n bs =
  L.foldl (\(ints, bs') _ -> let
              bs'' = C.dropWhile (\x -> x == ' ' || x == '\r' || x == '\n') bs'
              Just (int, bs''') = C.readInt bs''
              in (int : ints, bs''')) ([], bs) [1..n]

main :: IO ()
main = do
  n <- fmap read Prelude.getLine
  input <- BS.getContents
  let (sequences, _) = L.foldl (\(xs, bs) _ ->
                                 let ([si], bs') = readInts 1 bs
                                     (xi, bs'') = readInts si bs'
                                 in (xi : xs, bs'')) ([], input) [1..n]
      sequences' = L.zip [1..n] $ L.reverse $ L.map L.reverse sequences
      mutations = L.map (\(i, seqq) ->
                           let sum = L.sum seqq
                               seqEnum = L.zip [1..(L.length seqq)] seqq
                           in [(sum - x, i, ix) | (ix, x) <- seqEnum]) sequences'
      orderedBySum = sortBy (\(sum,_,_) (sum',_,_) -> compare sum sum') $ Prelude.concat mutations
      groupedMatches = L.groupBy (\(sum,i,_) (sum',i',_) -> sum == sum' && i == i') orderedBySum
      noDuplicates = L.map L.head groupedMatches
      finalGrouping = L.groupBy (\(sum,_,_) (sum',_,_) -> sum == sum') noDuplicates
      matches = L.filter ((<=) 2 . L.length) finalGrouping
  if L.null matches then
    Prelude.putStrLn "NO"
  else do
    Prelude.putStrLn "YES"
    let match = L.take 2 . L.head $ matches
    forM_ match (\(_,ii,i) -> Prelude.putStrLn $ show ii ++ " " ++ show i)

module Main where

import Data.List as L
import Data.Map as M
import Control.Monad
import Data.ByteString.Char8 as C
import Data.ByteString as BS

readInts :: Int -> ByteString -> ([Int],ByteString)
readInts n bs =
  L.foldl (\(ints,bs') _ -> let
              bs'' = C.dropWhile (\x -> x == ' ' || x == '\r' || x == '\n') bs'
              Just (int,bs''') = C.readInt bs''
              in (int:ints,bs''')) ([],bs) [1..n]

main :: IO ()
main = do
  n <- fmap read Prelude.getLine
  input <- BS.getContents
  let (sequences,_) = L.foldl (\(xs, bs) _ ->
                                 let ([si],bs') = readInts 1 bs
                                     (xi,bs'') = readInts si bs'
                                 in (xi:xs,bs'')) ([],input) [1..n]
      sequences' = L.zip [1..n] $ L.reverse $ L.map L.reverse sequences
      mutations = L.map (\(i,seqq) ->
                           let sum = L.sum seqq
                               seqEnum = L.zip [1..(L.length seqq)] seqq
                           in [(sum - x,i,ix) | (ix,x) <- seqEnum]) sequences'
      orderedBySum = sortBy (\(sum,_,_) (sum',_,_) -> compare sum sum') $ Prelude.concat mutations
      groupedMatches = L.groupBy (\(sum,i,_) (sum',i',_) -> sum == sum' && i == i') orderedBySum
      noDuplicates = L.map L.head groupedMatches
      finalGrouping = L.groupBy (\(sum,_,_) (sum',_,_) -> sum == sum') noDuplicates
      matches = L.filter ((<=) 2 . L.length) finalGrouping
  if L.null matches then
    Prelude.putStrLn "NO"
  else do
    Prelude.putStrLn "YES"
    let match = L.take 2 . L.head $ matches
    forM_ match (\(_,ii,i) -> Prelude.putStrLn $ show ii ++ " " ++ show i)


Simon has a rectangular table consisting of n rows and m columns. Simon numbered the rows of the table from top to bottom starting from one and the columns — from left to right starting from one. We'll represent the cell on the x-th row and the y-th column as a pair of numbers (x, y). The table corners are cells: (1, 1), (n, 1), (1, m), (n, m).Simon thinks that some cells in this table are good. Besides, it's known that no good cell is the corner of the table. Initially, all cells of the table are colorless. Simon wants to color all cells of his table. In one move, he can choose any good cell of table (x1, y1), an arbitrary corner of the table (x2, y2) and color all cells of the table (p, q), which meet both inequations: min(x1, x2) ≤ p ≤ max(x1, x2), min(y1, y2) ≤ q ≤ max(y1, y2).Help Simon! Find the minimum number of operations needed to color all cells of the table. Note that you can color one cell multiple times.

The first line contains exactly two integers n, m (3 ≤ n, m ≤ 50). Next n lines contain the description of the table cells. Specifically, the i-th line contains m space-separated integers ai1, ai2, ..., aim. If aij equals zero, then cell (i, j) isn't good. Otherwise aij equals one. It is guaranteed that at least one cell is good. It is guaranteed that no good cell is a corner.

Print a single number — the minimum number of operations Simon needs to carry out his idea.

NoteIn the first sample, the sequence of operations can be like this:    For the first time you need to choose cell (2, 2) and corner (1, 1).  For the second time you need to choose cell (2, 2) and corner (3, 3).  For the third time you need to choose cell (2, 2) and corner (3, 1).  For the fourth time you need to choose cell (2, 2) and corner (1, 3). In the second sample the sequence of operations can be like this:    For the first time you need to choose cell (3, 1) and corner (4, 3).  For the second time you need to choose cell (2, 3) and corner (1, 1).

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

solve :: [Int] -> Int
solve (n:m:a) = solve' a 1 1
    where
        solve' :: [Int] -> Int -> Int -> Int
        solve' []     _ _ = 4
        solve' (1:ax) i j | i == 1 || i == n = 2
                          | j == 1 || j == m = 2
        solve' (_:ax) i j | j == m           = solve' ax (i + 1) 1
                          | otherwise        = solve' ax i (j + 1)

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

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

  let
    xys = map fst $ filter ((== 1) . snd) $ zip [(x, y) | x <- [1..n], y <- [1..m]] $ concat as

  print $
    if not . null $ filter (\(x, y) -> x == 1 || x == n || y == 1 || y == m) xys
     then 2
     else 4

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = 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)
itof :: Int -> Double
itof = fromIntegral

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m] <- readLns
    l <- replicateM n readLns :: IO [[Int]]
    let a = head l
        b = last l
        c = head $ transpose l
        d = last $ transpose l
    if any (==1) $ concat [a,b,c,d] then
        print 2
    else
        print 4

import Control.Monad (liftM, replicateM)
import Data.Array (Array, (!), array, bounds)
import Data.Char (ord)
import Data.List (intercalate)

solve :: Array (Int, Int) Bool -> Int
solve array
  | any (array !) [(1,j) | j <- [1..m]]  =  2
  | any (array !) [(i,1) | i <- [1..n]]  =  2
  | any (array !) [(n,j) | j <- [1..m]]  =  2
  | any (array !) [(i,m) | i <- [1..n]]  =  2
  | otherwise  =  4
  where
    (n, m)  =  snd $ bounds array

main :: IO ()
main  =  do
    [n, m]  <-  reads
    xss  <-  replicateM n reads
    let array  =  Data.Array.array ((1,1), (n,m)) $ map (\(i, x) -> ((i `div` m + 1, i `mod` m + 1), x == 1)) $ zip [0..] $ concat xss
    print $ solve array
  where

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' (10 * a + fromIntegral (ord c - ord '0')) s

module Main where
import Control.Applicative
import Data.List
import qualified Data.Map as Map
main :: IO ()
main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  -- _ <- getLine
  l1:board <- lines <$> getContents
  if '1' `elem` (l1 ++ head (reverse board) ++ concatMap (\(x:xs) -> [x, head $ reverse xs]) board)
    then print 2
    else print 4

import Control.Monad
import Control.Applicative

check :: [ [ Int ] ] -> Bool
check mat
  = elem 1 (mat !! 0)       ||
    elem 1 (mat !! (n - 1)) ||
    elem 1 (map (!! 0) mat) ||
    elem 1 (map (!! (m-1)) mat)
    where
      n = length mat
      m = length (mat !! 0)

main :: IO ()
main = do

  [ x, y ] <- map read <$> words <$> getLine

  mat <- replicateM x $
    map read <$> words <$> getLine

  if check mat
    then print 2
    else print 4

fn:: String -> Int
fn str = if existAtEdge then 2 else 4
    where
        existAtEdge = oneExist (head table) || oneExist (last table) || oneExist (map head table) || oneExist (map last table)
        oneExist:: [Char] -> Bool
        oneExist = any (== '1')
        n:: Int
        n = read $ (words $ head ls) !! 0
        m:: Int
        m = read $ (words $ head ls) !! 1
        table:: [[Char]]
        table = map lineEntries (tail ls)
            where
                lineEntries:: String -> [Char]
                lineEntries line = map (!! 0) $ words line
        ls = lines str

main = do
    input <- getContents
    output <- return $ show $ fn input
    putStrLn output

import Data.Tuple
import Data.List
cal ls = let ns = map words $ tail ls
	     t = transpose ns
	     edges = (head ns) ++ (last ns) ++ (head t) ++ (last t)
	 in if (any (\s ->read s==1) edges) then 2 else 4

main = interact (show . cal . lines)

module Main where
import Control.Applicative
import Data.List
import qualified Data.Map as Map
main :: IO ()
main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  -- _ <- getLine
  board <- map ((==1) . read) . words . intercalate " " . lines <$> getContents :: IO [Bool]
  let doit candoit (b,i) =
        candoit || (b && ((row `elem` [0,n-1]) || (col `elem` [0,m-1])))
        where row = i `div` n
              col = i `mod` n
      can = foldl doit False $ zip board [0..]
  -- print $ map (\i -> (i `div` n, i`mod`n)) [0..n*m]
  print (if can then 2 else 4)
  -- cs <- map read . words <$> getLine :: IO [Int]
  -- [x,y] <- map read . words <$> getLine :: IO [Int]
  -- let beginnerSizes = scanl1 (+) cs
  --     numKids = sum cs
  --     intermediateSizes = map (numKids -) beginnerSizes
  -- print (case find (\(bSize,iSize,_) ->
  --                     x <= bSize && bSize <= y && x <= iSize && iSize <= y) $
  --             zip3 beginnerSizes intermediateSizes ([1..] :: [Int]) of
  --          Just (_,_,a) -> a + 1
  --          Nothing -> 0)


The Travelling Salesman spends a lot of time travelling so he tends to get bored. To pass time, he likes to perform operations on numbers. One such operation is to take a positive integer x and reduce it to the number of bits set to 1 in the binary representation of x. For example for number 13 it's true that 1310 = 11012, so it has 3 bits set and 13 will be reduced to 3 in one operation.He calls a number special if the minimum number of operations to reduce it to 1 is k.He wants to find out how many special numbers exist which are not greater than n. Please help the Travelling Salesman, as he is about to reach his destination!Since the answer can be large, output it modulo 109 + 7.

The first line contains integer n (1 ≤ n < 21000). The second line contains integer k (0 ≤ k ≤ 1000). Note that n is given in its binary representation without any leading zeros.

Output a single integer — the number of special numbers not greater than n, modulo 109 + 7.

NoteIn the first sample, the three special numbers are 3, 5 and 6. They get reduced to 2 in one operation (since there are two set bits in each of 3, 5 and 6) and then to 1 in one more operation (since there is only one set bit in 2).

module Main where
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.List
import Data.Char

main = putStr . exec =<< getContents
exec = show . (\[n, k] -> solve n (read k :: Int)) . words
solve n0 k
  | k == 0 = 1
  | otherwise
    = fromIntegral (fromEnum $ s!sum n == k - 1) +% case n of { (1:_) | k == 1 -> mbase - 1; _ -> 0 }
    +% foldl' (+%) 0
      [ i `choose` (o - o')
      | o <- map fst $ filter ((== k - 1) . snd) $ assocs s
      , (i, o', b) <- zip3 [d - 1, d - 2..] (scanl (+) 0 n) n
      , b == 1, i >= o - o', o >= o'
      ]
  where
  n = map digitToInt n0
  d = length n
  s = tbl
    where
    tbl = listArray rng $ map go $ range rng :: Array Int Int
    rng = (1, d)
    go 1 = 0
    go i = 1 + tbl!popCount i

mbase = 10^9 + 7 :: Int64
a +% b = (a + b) `rem` mbase
infixl 6 +%
a *% b = (a * b) `rem` mbase
infixl 7 *%

fs = listArray (0, 1000) $ scanl (*%) 1 [1..1000] :: Array Int Int64

n `choose` k = fs!n *% inv (fs!k *% fs!(n - k))

inv x = fst (exgcd x mbase) `mod` mbase

exgcd a b = go a b 1 0 0 1
  where
  go r r' s s' t t'
    | r' == 0 = (s, t)
    | otherwise = go r' r1 s' (s - q * s') t' (t - q * t')
    where (q, r1) = r `quotRem` r'

module Main where
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.List
import Data.Char

main = putStr . exec =<< getContents
exec = show . (\[n, k] -> solve n (read k :: Int)) . words
solve n0 k
  | k == 0 = 1
  | otherwise
    = fromIntegral (fromEnum $ s!sum n == k - 1)
    +% foldl' (+%) 0
      [ i `choose` (o - o')
      | o <- map fst $ filter ((== k - 1) . snd) $ assocs s
      , (i, o', b) <- zip3 [d - 1, d - 2..] (scanl (+) 0 n) n
      , b == 1, i >= o - o', o >= o'
      ]
  where
  n = map digitToInt n0
  d = length n
  s = tbl
    where
    tbl = listArray rng $ map go $ range rng :: Array Int Int
    rng = (1, d)
    go 1 = 0
    go i = 1 + tbl!popCount i

mbase = 10^9 + 7 :: Int64
a +% b = (a + b) `rem` mbase
infixl 6 +%
a *% b = (a * b) `rem` mbase
infixl 7 *%

fs = listArray (0, 1000) $ scanl (*%) 1 [1..1000] :: Array Int Int64

n `choose` k = fs!n *% inv (fs!k *% fs!(n - k))

inv x = fst (exgcd x mbase) `mod` mbase

exgcd a b = go a b 1 0 0 1
  where
  go r r' s s' t t'
    | r' == 0 = (s, t)
    | otherwise = go r' r1 s' (s - q * s') t' (t - q * t')
    where (q, r1) = r `quotRem` r'

module Main where
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.List
import Data.Char

main = putStr . exec =<< getContents
exec = show . (\[n, k] -> solve n (read k :: Int)) . words
solve n0 k
  = fromIntegral (fromEnum $ s!sum n == k - 1)
  +% foldl' (+%) 0
    [ i `choose` (o - o')
    | o <- map fst $ filter ((== k - 1) . snd) $ assocs s
    , (i, o', b) <- zip3 [d - 1, d - 2..] (scanl (+) 0 n) n
    , b == 1, i >= o - o', o >= o'
    ]
  where
  n = map digitToInt n0
  d = length n
  s = tbl
    where
    tbl = listArray rng $ map go $ range rng :: Array Int Int
    rng = (1, d)
    go 1 = 0
    go i = 1 + tbl!popCount i

mbase = 10^9 + 7 :: Int64
a +% b = (a + b) `rem` mbase
infixl 6 +%
a *% b = (a * b) `rem` mbase
infixl 7 *%

fs = listArray (0, 1000) $ scanl (*%) 1 [1..1000] :: Array Int Int64

n `choose` k = fs!n *% inv (fs!k *% fs!(n - k))

inv x = fst (exgcd x mbase) `mod` mbase

exgcd a b = go a b 1 0 0 1
  where
  go r r' s s' t t'
    | r' == 0 = (s, t)
    | otherwise = go r' r1 s' (s - q * s') t' (t - q * t')
    where (q, r1) = r `quotRem` r'

module Main where
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.List
import Data.Char

main = putStr . exec =<< getContents
exec = show . (\[n, k] -> solve n (read k :: Int)) . words
solve n0 k
  | k == 0 = 1
  | otherwise
    = fromIntegral (fromEnum $ n /= [1] && s!sum n == k - 1)
    +% foldl' (+%) 0
      [ i `choose` (o - o')
      | o <- map fst $ filter ((== k - 1) . snd) $ assocs s
      , (i, o', b) <- zip3 [d - 1, d - 2..] (scanl (+) 0 n) n
      , b == 1, i >= o - o', o >= o'
      ]
  where
  n = map digitToInt n0
  d = length n
  s = tbl
    where
    tbl = listArray rng $ map go $ range rng :: Array Int Int
    rng = (1, d)
    go 1 = 0
    go i = 1 + tbl!popCount i

mbase = 10^9 + 7 :: Int64
a +% b = (a + b) `rem` mbase
infixl 6 +%
a *% b = (a * b) `rem` mbase
infixl 7 *%

fs = listArray (0, 1000) $ scanl (*%) 1 [1..1000] :: Array Int Int64

n `choose` k = fs!n *% inv (fs!k *% fs!(n - k))

inv x = fst (exgcd x mbase) `mod` mbase

exgcd a b = go a b 1 0 0 1
  where
  go r r' s s' t t'
    | r' == 0 = (s, t)
    | otherwise = go r' r1 s' (s - q * s') t' (t - q * t')
    where (q, r1) = r `quotRem` r'


Greg has an array a = a1, a2, ..., an and m operations. Each operation looks as: li, ri, di, (1 ≤ li ≤ ri ≤ n). To apply operation i to the array means to increase all array elements with numbers li, li + 1, ..., ri by value di.Greg wrote down k queries on a piece of paper. Each query has the following form: xi, yi, (1 ≤ xi ≤ yi ≤ m). That means that one should apply operations with numbers xi, xi + 1, ..., yi to the array.Now Greg is wondering, what the array a will be after all the queries are executed. Help Greg.

The first line contains integers n, m, k (1 ≤ n, m, k ≤ 105). The second line contains n integers: a1, a2, ..., an (0 ≤ ai ≤ 105) — the initial array. Next m lines contain operations, the operation number i is written as three integers: li, ri, di, (1 ≤ li ≤ ri ≤ n), (0 ≤ di ≤ 105). Next k lines contain the queries, the query number i is written as two integers: xi, yi, (1 ≤ xi ≤ yi ≤ m). The numbers in the lines are separated by single spaces.

On a single line print n integers a1, a2, ..., an — the array after executing all the queries. Separate the printed numbers by spaces. Please, do not use the %lld specifier to read or write 64-bit integers in C++. It is preferred to use the cin, cout streams of the %I64d specifier.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List

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

main :: IO ()
main = do
  [n,m,k] <- map read.words <$> getLine
  arr0 <- map(fromIntegral.readInt).B.words <$> B.getLine
  (ops,queries) <- splitAt (3*m).map readInt.B.words <$> B.getContents
  let go (l:r:d:rest) (q:qs) = fromIntegral l:fromIntegral r:fromIntegral d*q : go rest qs
      go _ _ = []
  putStr.unwords.map show.zipWith(+)arr0.imos n.go ops $ imos1 m queries

imos :: Int -> [Int64] -> [Int64]
imos n lrds = scanl1 (+) $ map (fromIntegral.unsafeAt cnt) [0..n-1]
   where
     cnt :: UArray Int Int64
     !cnt = unsafeAccumArray (+) 0 (0,n-1) $ go lrds
     go (l:r:d:rest) = (fromIntegral(l-1),d):(fromIntegral r,-d):go rest
     go _ = []

imos1 :: Int -> [Int] -> [Int64]
imos1 n lrs = scanl1 (+) $ map (fromIntegral.unsafeAt cnt) [0..n-1]
   where
     cnt :: UArray Int Int64
     !cnt = unsafeAccumArray (+) 0 (0,n-1) $ go lrs
     go (l:r:rest) = (l-1,1):(r,-1):go rest
     go _ = []


Polycarp came up with a new programming language. There are only two types of statements in it:   "x := s": assign the variable named x the value s (where s is a string). For example, the statement var := hello assigns the variable named var the value hello. Note that s is the value of a string, not the name of a variable. Between the variable name, the := operator and the string contains exactly one space each. "x = a + b": assign the variable named x the concatenation of values of two variables a and b. For example, if the program consists of three statements a := hello, b := world, c = a + b, then the variable c will contain the string helloworld. It is guaranteed that the program is correct and the variables a and b were previously defined. There is exactly one space between the variable names and the = and + operators. All variable names and strings only consist of lowercase letters of the English alphabet and do not exceed $$$5$$$ characters.The result of the program is the number of occurrences of string haha in the string that was written to the variable in the last statement.Polycarp was very tired while inventing that language. He asks you to implement it. Your task is — for given program statements calculate the number of occurrences of string haha in the last assigned variable.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^3$$$). Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 50$$$) — the number of statements in the program. All variable names and strings are guaranteed to consist only of lowercase letters of the English alphabet and do not exceed $$$5$$$ characters. This is followed by $$$n$$$ lines describing the statements in the format described above. It is guaranteed that the program is correct.

For each set of input data, output the number of occurrences of the haha substring in the string that was written to the variable in the last statement.

4
6
a := h
b := aha
c = a + b
c = c + c
e = c + c
d = a + c
15
x := haha
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
x = x + x
1
haha := hah
5
haahh := aaaha
ahhhh = haahh + haahh
haahh = haahh + haahh
ahhhh = ahhhh + haahh
ahhaa = haahh + ahhhh

NoteIn the first test case the resulting value of d is hhahahaha.

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (tails)
import qualified Data.Map as M
import Data.Maybe (fromJust, fromMaybe)

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

type I64 = Integer

process :: [String] -> [I64]
process [] = []
process (n:ss) =
  let (hs, ts) = splitAt (read n) ss
   in solve hs : process ts

-- Left = Small, Right = Large
type Value = Either String (String, I64, String)

type Id = String

type Env = M.Map Id Value

count :: Value -> I64
count (Left _) = 0
count (Right (_, c, _)) = c

build :: String -> Value
build s
  | length s <= 3 = Left s
  | otherwise =
    Right
      ( take 3 s
      , toInteger . length . filter ((== "haha") . take 4) $ tails s
      , reverse . take 3 . reverse $ s)

combine :: Value -> Value -> Value
combine (Left l) (Left r) = build (l ++ r)
combine (Left l) (Right (rl, c, rr)) =
  case build (l ++ rl) of
    (Left l') -> Right (l', c, rr)
    (Right (l', c', _)) -> Right (l', c' + c, rr)
combine (Right (ll, c, lr)) (Left r) =
  case build (lr ++ r) of
    (Left r') -> Right (ll, c, r')
    (Right (_, c', r')) -> Right (ll, c + c', r')
combine (Right (ll, cl, lr)) (Right (rl, cr, rr)) =
  Right (ll, cl + (count . build $ lr ++ rl) + cr, rr)

solve :: [String] -> I64
solve ss =
  count . fromJust $
  M.lookup
    (takeWhile (/= ' ') $ last ss)
    (foldl (flip (update . words)) M.empty ss)
  where
    update [var, ":=", val] env = M.insert var (build val) env
    update [var, "=", lhs, "+", rhs] env =
      M.insert
        var
        (fromJust $ combine <$> M.lookup lhs env <*> M.lookup rhs env)
        env


Alice got an array of length $$$n$$$ as a birthday present once again! This is the third year in a row! And what is more disappointing, it is overwhelmengly boring, filled entirely with zeros. Bob decided to apply some changes to the array to cheer up Alice.Bob has chosen $$$m$$$ changes of the following form. For some integer numbers $$$x$$$ and $$$d$$$, he chooses an arbitrary position $$$i$$$ ($$$1 \le i \le n$$$) and for every $$$j \in [1, n]$$$ adds $$$x + d \cdot dist(i, j)$$$ to the value of the $$$j$$$-th cell. $$$dist(i, j)$$$ is the distance between positions $$$i$$$ and $$$j$$$ (i.e. $$$dist(i, j) = |i - j|$$$, where $$$|x|$$$ is an absolute value of $$$x$$$).For example, if Alice currently has an array $$$[2, 1, 2, 2]$$$ and Bob chooses position $$$3$$$ for $$$x = -1$$$ and $$$d = 2$$$ then the array will become $$$[2 - 1 + 2 \cdot 2,~1 - 1 + 2 \cdot 1,~2 - 1 + 2 \cdot 0,~2 - 1 + 2 \cdot 1]$$$ = $$$[5, 2, 1, 3]$$$. Note that Bob can't choose position $$$i$$$ outside of the array (that is, smaller than $$$1$$$ or greater than $$$n$$$).Alice will be the happiest when the elements of the array are as big as possible. Bob claimed that the arithmetic mean value of the elements will work fine as a metric.What is the maximum arithmetic mean value Bob can achieve?

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 10^5$$$) — the number of elements of the array and the number of changes. Each of the next $$$m$$$ lines contains two integers $$$x_i$$$ and $$$d_i$$$ ($$$-10^3 \le x_i, d_i \le 10^3$$$) — the parameters for the $$$i$$$-th change.

Print the maximal average arithmetic mean of the elements Bob can achieve. Your answer is considered correct if its absolute or relative error doesn't exceed $$$10^{-6}$$$.

import Data.List

toint s = (read s) :: Integer

g n = div (n * (n+1)) 2

f::Integer->Integer->Integer
f d n =
    if d > 0 then
        d * (div (n*(n-1)) 2)
    else
        if mod n 2 == 1 then
            d * ((div n 2) * ((div n 2) + 1))
        else
            d * ((g (div n 2)) + (g ((div n 2) - 1)))

doit [] n r = r
doit (x:d:xs) n r =
    doit xs n (r+x*n+(f d n))

solve::String -> String
solve sss =
    let (n:m:s) = map toint $ words sss in
    let r = doit s n 0 in
    (show (((fromInteger r)::Double) / ((fromInteger n)::Double))) ++ "\n"

main = do
  interact $ solve

{-# LANGUAGE BangPatterns #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad.Trans.State.Strict
import qualified Data.ByteString.Char8            as B
import           Data.Char
import           Data.Int
import qualified Data.List                        as L

main :: IO ()
main = do
    [n, _m] <- map read.words <$> getLine
    xds <- map (fromIntegral *** fromIntegral).L.unfoldr (runStateT parseInt2) <$> B.getContents
    print $ solve n xds

solve :: Int64 -> [(Int64, Int64)] -> Double
solve n xds = (fromIntegral . sum $ map diff ds) / fromIntegral n + fromIntegral (sum xs)
  where
    !up = sum[1..n-1]
    !down | odd n = 2 * sum[1..div n 2]
          | otherwise = 2 * sum[1..div n 2] - div n 2

    (xs, ds) = unzip xds
    diff d
        | d > 0 = d * up
        | d == 0 = 0
        | otherwise = d * down

type Parser a = StateT B.ByteString Maybe a

parseInt :: Parser Int
parseInt = StateT $ B.readInt . B.dropWhile isSpace

parseInt2 :: Parser (Int, Int)
parseInt2 = (,) <$> parseInt <*> parseInt

parseInt3 :: Parser (Int, Int, Int)
parseInt3 = (,,) <$> parseInt <*> parseInt <*> parseInt


In the Bus of Characters there are $$$n$$$ rows of seat, each having $$$2$$$ seats. The width of both seats in the $$$i$$$-th row is $$$w_i$$$ centimeters. All integers $$$w_i$$$ are distinct.Initially the bus is empty. On each of $$$2n$$$ stops one passenger enters the bus. There are two types of passengers:   an introvert always chooses a row where both seats are empty. Among these rows he chooses the one with the smallest seats width and takes one of the seats in it;  an extrovert always chooses a row where exactly one seat is occupied (by an introvert). Among these rows he chooses the one with the largest seats width and takes the vacant place in it. You are given the seats width in each row and the order the passengers enter the bus. Determine which row each passenger will take.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 200\,000$$$) — the number of rows in the bus. The second line contains the sequence of integers $$$w_1, w_2, \dots, w_n$$$ ($$$1 \le w_i \le 10^{9}$$$), where $$$w_i$$$ is the width of each of the seats in the $$$i$$$-th row. It is guaranteed that all $$$w_i$$$ are distinct. The third line contains a string of length $$$2n$$$, consisting of digits '0' and '1' — the description of the order the passengers enter the bus. If the $$$j$$$-th character is '0', then the passenger that enters the bus on the $$$j$$$-th stop is an introvert. If the $$$j$$$-th character is '1', the the passenger that enters the bus on the $$$j$$$-th stop is an extrovert. It is guaranteed that the number of extroverts equals the number of introverts (i. e. both numbers equal $$$n$$$), and for each extrovert there always is a suitable row.

Print $$$2n$$$ integers — the rows the passengers will take. The order of passengers should be the same as in input.

NoteIn the first example the first passenger (introvert) chooses the row $$$2$$$, because it has the seats with smallest width. The second passenger (introvert) chooses the row $$$1$$$, because it is the only empty row now. The third passenger (extrovert) chooses the row $$$1$$$, because it has exactly one occupied seat and the seat width is the largest among such rows. The fourth passenger (extrovert) chooses the row $$$2$$$, because it is the only row with an empty place.

{-# LANGUAGE ViewPatterns #-}
module Main where
import Control.Monad
import Data.List
import qualified Data.IntMap.Strict as M

main = getLine >> liftM2 solve (fmap (fmap read . words) getLine) (fmap (map (== '0')) getLine) >>= putStr . unwords . map show

solve ws = snd . mapAccumL (flip go) (M.fromList $ zip ws [(1 :: Int)..], M.empty)
  where
  go False (e, M.deleteFindMax -> ((_, i), o)) = ((e, o), i)
  go True (M.deleteFindMin -> (r@(_, i), e), uncurry M.insert r -> o) = ((e, o), i)

import Data.List

solve :: [(Int, Int)] -> [(Int, Int)] -> String -> [Int]
solve [] [] [] = []
solve ((valA, indA) : tailA) b ('0' : tailS) = indA : solve tailA ((valA, indA) : b) tailS
solve a ((valB, indB) : headB) ('1' : tailS) = indB : solve a headB tailS
solve _ _ _ = []

main = do
    s <- getLine
    let n = read s :: Int
    s <- getLine
    let weights = map (read::String->Int) (words s)
    s <- getLine
    let arr = sort $ zip weights [1..]
    let ans = solve arr [] s
    putStrLn $ intercalate " " $ map show ans

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words, unpack)
import qualified Data.Maybe as M (fromJust)
import qualified Data.List as L (sort)

readInt = fst . M.fromJust . C.readInt

main = do
    (readInt -> n) <- B.getLine
    (map snd . L.sort . (flip zip) [1..] . map readInt . C.words -> xs) <- B.getLine
    (C.unpack -> p) <- B.getLine
    let f ('0':ps) (x:xs) ys rs = f ps xs (x:ys) (x:rs)
        f ('1':ps) xs (y:ys) rs = f ps xs ys (y:rs)
        f _ _ _ rs = reverse rs
    putStrLn . unwords . map show $ f p xs [] []

module Main (main) where

import Data.List (maximumBy, minimumBy, sortBy)
import qualified Data.Map.Lazy as M
import Data.Map.Lazy (fromList)

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

-- seatOccupation :: [Bool] -> [(Int, (Int, Int))] -> [Int]
-- seatOccupation [] _ = []
-- seatOccupation (isExtravert:xs) currentSeating =
--   let (n, (weight, taken)) = selectWeight . selectOccupancy $ currentSeating
--         where selectWeight = (if isExtravert then maximumBy else minimumBy)
--                 (\(_, (w, _)) (_, (w', _)) -> compare w w')
--               selectOccupancy = filter (\(_, (_, taken)) ->
--                                           (isExtravert && taken == 1)
--                                           || ((not isExtravert) && taken == 0))
--       newSeating toList . insert n (weight, taken + 1) . fromList $ currentSeating
--   in n : seatOccupation xs newSeating

-- main' :: IO ()
-- main' = do
--   _ <- getLine
--   seatWidths <- getIntegers
--   passengers <- fmap (fmap (== '1')) $ getLine
--   let rows = fmap  (\(n, w) -> (n, (w, 0)))
--         . sortBy (\(_, w) (_, w') -> compare w w')
--         . zip [1..] $ seatWidths
--   mapM_ (\n -> putStr $ show n ++ " ") $ seatOccupation passengers rows

selectSeats :: [Bool] -> Int -> [Int] -> [Int]
selectSeats [] _ _ = []
selectSeats (isExtravert:nextPassengers) nextFreeRow introvertRows =
  if isExtravert then
    let (row:newIntrovertRows) = introvertRows
    in row : selectSeats nextPassengers nextFreeRow newIntrovertRows
  else
    nextFreeRow : selectSeats nextPassengers (nextFreeRow + 1) (nextFreeRow : introvertRows)

main :: IO ()
main = do
  _ <- getLine
  seatWidths <- getIntegers
  passengers <- fmap (fmap (== '1')) getLine
  let rows = map (\(n, _) -> n)
        . sortBy (\(_, w) (_, w') -> compare w w')
        . zip [1..] $ seatWidths
      weightedOrder = selectSeats passengers 1 []
      weightedToOriginal = zip [1..] rows
      restoredOrder = map (\nW ->
                             let (Just n) = M.lookup nW $ M.fromList weightedToOriginal
                             in n) weightedOrder
    in mapM_ (\n -> putStr $ (show n) ++ " ") restoredOrder

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Data.Array.IArray
import Data.Array.Unboxed
import Data.Char
import Data.Functor
import Data.List
import Data.Int
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

indexed :: Int -> [a] -> [(a, Int)]
indexed _ [] = []
indexed i (x:xs) = (x, i) : (indexed (succ i) xs)

solve :: String -> [(Int, Int)] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (x:xs) [] (y:ys) = (snd y) : (solve xs [] ys)
solve (x:xs) (y:ys) [] = (snd y) : (solve xs ys (return y))
solve (x:xs) free@(y:ys) taken@(z:zs)
  | x == '0' = (snd y) : (solve xs ys (y : taken))
  | x == '1' = (snd z) : (solve xs free zs)

main :: IO ()
main = do
	[n] <- getInts
	w <- getInts
	s <- getLine
	putStrLn $ intercalate " " $ map show $ solve s (sort (indexed 1 w)) []

module Main (main) where

import Data.List (maximumBy, minimumBy, sortBy)
import Data.Map.Lazy (insert, toList, fromList)

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

seatOccupation :: [Bool] -> [(Int, (Int, Int))] -> [Int]
seatOccupation [] _ = []
seatOccupation (isExtravert:xs) currentSeating =
  let (n, (weight, taken)) = selectWeight . selectOccupancy $ currentSeating
        where selectWeight = (if isExtravert then maximumBy else minimumBy)
                (\(_, (w, _)) (_, (w', _)) -> compare w w')
              selectOccupancy = filter (\(_, (_, taken)) ->
                                          (isExtravert && taken == 1)
                                          || ((not isExtravert) && taken == 0))
      newSeating = toList . insert n (weight, taken + 1) . fromList $ currentSeating
  in n : seatOccupation xs newSeating

main :: IO ()
main = do
  _ <- getLine
  seatWidths <- getIntegers
  passengers <- fmap (fmap (== '1')) $ getLine
  let rows = fmap  (\(n, w) -> (n, (w, 0)))
        . zip [1..] $ seatWidths
  print $ seatOccupation passengers rows

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Data.Array.IArray
import Data.Array.Unboxed
import Data.Char
import Data.Functor
import Data.List
import Data.Int
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

indexed :: Int -> [a] -> [(a, Int)]
indexed _ [] = []
indexed i (x:xs) = (x, i) : (indexed (succ i) xs)

solve :: String -> [(Int, Int)] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (x:xs) [] (y:ys) = (snd y) : (solve xs [] ys)
solve (x:xs) (y:ys) [] = (snd y) : (solve xs ys (return y))
solve (x:xs) free@(y:ys) taken@(z:zs)
  | x == '0' = (snd y) : (solve xs ys (y : taken))
  | x == '1' = (snd z) : (solve xs free zs)

main :: IO ()
main = do
	[n] <- getInts
	w <- getInts
	s <- getLine
	putStrLn $ intersperse ' ' $ concatMap show $ solve s (sort (indexed 1 w)) []


Omkar is building a waterslide in his water park, and he needs your help to ensure that he does it as efficiently as possible.Omkar currently has $$$n$$$ supports arranged in a line, the $$$i$$$-th of which has height $$$a_i$$$. Omkar wants to build his waterslide from the right to the left, so his supports must be nondecreasing in height in order to support the waterslide. In $$$1$$$ operation, Omkar can do the following: take any contiguous subsegment of supports which is nondecreasing by heights and add $$$1$$$ to each of their heights. Help Omkar find the minimum number of operations he needs to perform to make his supports able to support his waterslide!An array $$$b$$$ is a subsegment of an array $$$c$$$ if $$$b$$$ can be obtained from $$$c$$$ by deletion of several (possibly zero or all) elements from the beginning and several (possibly zero or all) elements from the end.An array $$$b_1, b_2, \dots, b_n$$$ is called nondecreasing if $$$b_i\le b_{i+1}$$$ for every $$$i$$$ from $$$1$$$ to $$$n-1$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \leq t \leq 100$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the number of supports Omkar has. The second line of each test case contains $$$n$$$ integers $$$a_{1},a_{2},...,a_{n}$$$ $$$(0 \leq a_{i} \leq 10^9)$$$ — the heights of the supports. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a single integer — the minimum number of operations Omkar needs to perform to make his supports able to support his waterslide.

NoteThe subarray with which Omkar performs the operation is bolded.In the first test case:First operation:$$$[5, 3, \textbf{2}, 5] \to [5, 3, \textbf{3}, 5]$$$Second operation:$$$[5, \textbf{3}, \textbf{3}, 5] \to [5, \textbf{4}, \textbf{4}, 5]$$$Third operation:$$$[5, \textbf{4}, \textbf{4}, 5] \to [5, \textbf{5}, \textbf{5}, 5]$$$In the third test case, the array is already nondecreasing, so Omkar does $$$0$$$ operations.

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

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  print $ sum $ map (max 0) $ zipWith (-) as (tail as)

{-# LANGUAGE OverloadedStrings #-}

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

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

readInt64B8 :: B8.ByteString -> Int64
readInt64B8 = fromInteger . fst . fromJust . B8.readInteger

solve :: Int -> [Int64] -> Int64
solve n hs = sum steps
    where
        steps = map (\(x, y) -> max 0 $ x - y) adjacentHs
        adjacentHs = zip hs $ tail hs

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        n <- readIntB8 <$> B8.getLine
        hs <- map readInt64B8 <$> B8.words <$> B8.getLine
        let answer = solve n hs
        printf "%s\n" $ show answer

import Control.Monad (replicateM_)
import Data.Int (Int64)

solve :: [Int64] -> Int64
solve li = sum . map (max 0) $ zipWith (-) li (tail li)

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    a <- map read . words <$> getLine
    print (solve a)


Vova promised himself that he would never play computer games... But recently Firestorm — a well-known game developing company — published their newest game, World of Farcraft, and it became really popular. Of course, Vova started playing it.Now he tries to solve a quest. The task is to come to a settlement named Overcity and spread a rumor in it.Vova knows that there are n characters in Overcity. Some characters are friends to each other, and they share information they got. Also Vova knows that he can bribe each character so he or she starts spreading the rumor; i-th character wants ci gold in exchange for spreading the rumor. When a character hears the rumor, he tells it to all his friends, and they start spreading the rumor to their friends (for free), and so on.The quest is finished when all n characters know the rumor. What is the minimum amount of gold Vova needs to spend in order to finish the quest?Take a look at the notes if you think you haven't understood the problem completely.

The first line contains two integer numbers n and m (1 ≤ n ≤ 105, 0 ≤ m ≤ 105) — the number of characters in Overcity and the number of pairs of friends. The second line contains n integer numbers ci (0 ≤ ci ≤ 109) — the amount of gold i-th character asks to start spreading the rumor. Then m lines follow, each containing a pair of numbers (xi, yi) which represent that characters xi and yi are friends (1 ≤ xi, yi ≤ n, xi ≠ yi). It is guaranteed that each pair is listed at most once.

Print one number — the minimum amount of gold Vova has to spend in order to finish the quest.

NoteIn the first example the best decision is to bribe the first character (he will spread the rumor to fourth character, and the fourth one will spread it to fifth). Also Vova has to bribe the second and the third characters, so they know the rumor.In the second example Vova has to bribe everyone.In the third example the optimal decision is to bribe the first, the third, the fifth, the seventh and the ninth characters.

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Graph
import Data.Array.Unboxed
import Data.Int
import Data.Tree

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  cs <- replicateM n poi
  ps <- replicateM m $ liftM2 (,) poi poi
  return $ show $ solve n cs ps
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n cs0 = sum . map (minimum . map (cs!) . flatten) . components . buildG (1, n)
  where cs = listArray (1, n) $ map fromIntegral cs0 :: UArray Int Int64

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Graph
import Data.Array ((!))
import qualified Data.Array as A
import qualified Data.Tree as T

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

readIntegers :: IO [Integer]
readIntegers = map (fst . fromJust . C.readInteger) <$> C.words <$> C.getLine

main :: IO ()
main = do
    [n, m] <- readInts
    amounts <- A.listArray (1, n) <$> readIntegers
    friends <- replicateM m readInts
    let f = dff $ buildG (1, n) $ [x | [a, b] <- friends, x <- [(a, b), (b, a)]]
    let xs = map T.flatten f
    let ans = sum $ map (minimum . map (amounts!)) xs
    print ans

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Graph
import Data.Array ((!))
import qualified Data.Array as A
import qualified Data.Tree as T

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

main :: IO ()
main = do
    [n, m] <- readInts
    amounts <- A.listArray (1,n) <$> readInts
    friends <- replicateM m readInts
    let f = dff $ buildG (1, n) $ map (\[a, b] -> (a, b)) friends
    let xs = map T.flatten f
    let ans = sum $ map (minimum . map (\x -> amounts ! x)) xs
    print ans

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Graph
import Data.Array ((!))
import qualified Data.Array as A
import qualified Data.Tree as T

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

main :: IO ()
main = do
    [n, m] <- readInts
    amounts <- A.listArray (1, n) <$> readInts
    friends <- replicateM m readInts
    let f = dff $ buildG (1, n) $ [x | [a, b] <- friends, x <- [(a, b), (b, a)]]
    let xs = map T.flatten f
    let ans = sum $ map (minimum . map (amounts!)) xs
    print ans

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Graph
import Data.Array ((!))
import qualified Data.Array as A
import qualified Data.Tree as T

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

main :: IO ()
main = do
    [n, m] <- readInts
    amounts <- A.listArray (0, n) <$> (0:) <$> readInts
    friends <- replicateM m readInts
    let f = dff $ buildG (0, n) $ map (\[a, b] -> (a, b)) friends
    let xs = map T.flatten f
    let ans = sum $ map (minimum . map (\x -> amounts ! x)) xs
    print ans


Soroush and Keshi each have a labeled and rooted tree on $$$n$$$ vertices. Both of their trees are rooted from vertex $$$1$$$.Soroush and Keshi used to be at war. After endless decades of fighting, they finally became allies to prepare a Codeforces round. To celebrate this fortunate event, they decided to make a memorial graph on $$$n$$$ vertices.They add an edge between vertices $$$u$$$ and $$$v$$$ in the memorial graph if both of the following conditions hold:   One of $$$u$$$ or $$$v$$$ is the ancestor of the other in Soroush's tree.  Neither of $$$u$$$ or $$$v$$$ is the ancestor of the other in Keshi's tree. Here vertex $$$u$$$ is considered ancestor of vertex $$$v$$$, if $$$u$$$ lies on the path from $$$1$$$ (the root) to the $$$v$$$.Popping out of nowhere, Mashtali tried to find the maximum clique in the memorial graph for no reason. He failed because the graph was too big. Help Mashtali by finding the size of the maximum clique in the memorial graph.As a reminder, clique is a subset of vertices of the graph, each two of which are connected by an edge.

The first line contains an integer $$$t$$$ $$$(1\le t\le 3 \cdot 10^5)$$$ — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ $$$(2\le n\le 3 \cdot 10^5)$$$. The second line of each test case contains $$$n-1$$$ integers $$$a_2, \ldots, a_n$$$ $$$(1 \le a_i < i)$$$, $$$a_i$$$ being the parent of the vertex $$$i$$$ in Soroush's tree. The third line of each test case contains $$$n-1$$$ integers $$$b_2, \ldots, b_n$$$ $$$(1 \le b_i < i)$$$, $$$b_i$$$ being the parent of the vertex $$$i$$$ in Keshi's tree. It is guaranteed that the given graphs are trees. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$3 \cdot 10^5$$$.

For each test case print a single integer — the size of the maximum clique in the memorial graph.

NoteIn the first and third test cases, you can pick any vertex.In the second test case, one of the maximum cliques is $$$\{2, 3, 4, 5\}$$$.In the fourth test case, one of the maximum cliques is $$$\{3, 4, 6\}$$$.

{-# OPTIONS_GHC -XStrict -XStrictData #-}
{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import qualified Data.IntSet as IS
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

getRanges :: Graph -> (UArray Int Int, UArray Int Int)
getRanges g = runST $ do
    s <- newArray (bounds g) 0 :: ST s (STUArray s Int Int)
    e <- newArray (bounds g) 0 :: ST s (STUArray s Int Int)
    cur <- newSTRef 1
    let dfs x = do
        i <- readSTRef cur
        writeArray s x i
        modifySTRef' cur (+1)
        forM_ (g!x) dfs
        readSTRef cur >>= \t -> writeArray e i t
    dfs 1
    rs <- unsafeFreezeSTUArray s
    re <- unsafeFreezeSTUArray e
    return (rs, re)

solve :: Graph -> UArray Int Int -> UArray Int Int -> Int
solve g ss ee = dfs IS.empty 0 1
    where
        dfs w r x =
            let s = ss ! x
                e = ee ! s
                a = IS.lookupLT s w
                b = IS.lookupGT s w
                (w',r') =
                    if maybe True (>= e) b then
                        case a of
                            Just a ->
                                if ee ! a > s then
                                    (IS.delete a . IS.insert s $ w, r)
                                else
                                    (IS.insert s w, r+1)
                            Nothing -> (IS.insert s w, r+1)
                    else
                        (w,r)
            in
                maximum $ r' : map (dfs w' r') (g ! x)

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        let readG = buildG (1,n) . flip zip [2..] . map parseInt . BS.words <$> BS.getLine
        g1 <- readG
        g2 <- readG
        let (s,e) = getRanges g2
        print $ solve g1 s e

{-# OPTIONS_GHC -XStrict -XStrictData #-}
{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

getRanges :: Graph -> (UArray Int Int, UArray Int Int)
getRanges g = runST $ do
    s <- newArray (bounds g) 0 :: ST s (STUArray s Int Int)
    e <- newArray (bounds g) 0 :: ST s (STUArray s Int Int)
    cur <- newSTRef 1
    let dfs x = do
        i <- readSTRef cur
        writeArray s x i
        modifySTRef' cur (+1)
        forM_ (g!x) dfs
        readSTRef cur >>= \t -> writeArray e i t
    dfs 1
    rs <- unsafeFreezeSTUArray s
    re <- unsafeFreezeSTUArray e
    return (rs, re)

solve :: Graph -> UArray Int Int -> UArray Int Int -> Int
solve g ss ee = dfs Set.empty 1
    where
        dfs w x =
            let s = ss ! x
                e = ee ! s
                a = Set.lookupLT s w
                b = Set.lookupGT s w
                w' =
                    if maybe True (>= e) b then
                        case a of
                            Just a ->
                                if ee ! a > s then
                                    Set.delete a . Set.insert s $ w
                                else
                                    Set.insert s w
                            Nothing -> Set.insert s w
                    else
                        w
            in
                maximum $ Set.size w' : map (dfs w') (g ! x)

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        let readG = buildG (1,n) . flip zip [2..] . map parseInt . BS.words <$> BS.getLine
        g1 <- readG
        g2 <- readG
        let (s,e) = getRanges g2
        print $ solve g1 s e


You are given n points on a plane. All points are different.Find the number of different groups of three points (A, B, C) such that point B is the middle of segment AC. The groups of three points are considered unordered, that is, if point B is the middle of segment AC, then groups (A, B, C) and (C, B, A) are considered the same.

The first line contains a single integer n (3 ≤ n ≤ 3000) — the number of points.  Next n lines contain the points. The i-th line contains coordinates of the i-th point: two space-separated integers xi, yi ( - 1000 ≤ xi, yi ≤ 1000). It is guaranteed that all given points are different.

Print the single number — the answer to the problem.

import Data.Array.Unboxed
m = 3000
top s = (x, y) where [x, y] = map read $ words s
solve ps = (sum [a ! (2*x-z, 2*y-w) | (x,y) <- ps, (z,w) <- ps] - length ps) `div` 2 where a = accumArray (+) 0 ((-m, -m), (m, m)) (zip ps $ repeat 1) :: UArray (Int, Int) Int
main = print . solve . map top . tail . lines =<< getContents

import Data.Array.Unboxed
n = 3000
f m=(sum[a!(2*x-z,2*y-w)|(x,y)<-m,(z,w)<-m]-length m)`div`2 where a=accumArray(+)0((-n,-n),(n,n))$zip m$repeat 1::UArray(Int,Int)Int
t[x,y]=(x,y)
main=interact$show.f.map(t.map read.words).tail.lines

import Data.Array.Unboxed
n=3000
f m=sum[a!(x+x-z,y+y-w)|p@(x,y)<-m,q@(z,w)<-m,p<q]where a=accumArray(+)0((-n,-n),(n,n))$zip m$repeat 1::UArray(Int,Int)Int
t[x,y]=(x,y)
main=interact$show.f.map(t.map read.words).tail.lines

import Data.Map (Map, fromList, member)

{-
import HUnit

emptyTest :: Test
emptyTest  =  Test "EmptyTest" $
    assertEq 0 (solve [])

inputTest :: Test
inputTest  =  TestList "InputTest"
    [Test "1" $ assertEq 1 (solve [(1,1), (2,2), (3,3)]),
     Test "2" $ assertEq 0 (solve [(0,0), (1,0), (0,1)])]

testFourPoints :: Test
testFourPoints  =  Test "TestFourPoints" $
    assertEq 2 (solve [(-2,-2), (0,0), (2,2), (4,4)])

testSquare :: Test
testSquare  =  TestList "TestSquare"
    [Test "3x3" $ assertEq 8 (solve [(1,1),(1,2),(1,3),
                                   (2,1),(2,2),(2,3),
                                   (3,1),(3,2),(3,3)]),
     Test "4x4" $ assertEq 24 (solve [(i,j) | i <- [1..4], j <- [1..4]])]

bigTest :: Test
bigTest  =  Test "BigTest" $
    assertEq (div (3000 * 3000 - 2 * 3000) 4) (solve [(2*i,2*i) | i <- [1..3000]])

testRectangle :: Test
testRectangle  =  Test "TestRectangle 3x7" $
    assertEq 52 (solve [(i, j) | i <- [1..3], j <- [1..7]])

test :: IO ()
test  =  mapM_ run
    [emptyTest,
     inputTest,
     testFourPoints,
     testSquare,
     bigTest,
     testRectangle]

--------------------------------------------------------------------------------
-}

type Point  =  (Int, Int)
type PointsMap  =  Map Point Bool

getPoint :: IO Point
getPoint  =  do
    line  <-  getLine
    let [x, y]  =  map read $ words line
    return (x, y)

solve :: [Point] -> Int
solve points  =  length [undefined | (x1, y1) <- points, (x2, y2) <- points,
    (x1,y1) < (x2,y2),
    even x1 == even x2,
    even y1 == even y2,
    member (quot (x1 + x2) 2, quot (y1 + y2) 2) pointsMap]
  where
    pointsMap :: PointsMap
    pointsMap  =  fromList [(k, undefined) | k <- points]

main :: IO ()
main  =  do
    n  <-  readLn
    points  <-  mapM (const getPoint) [1..n]
    print $ solve points


You have an axis-aligned rectangle room with width $$$W$$$ and height $$$H$$$, so the lower left corner is in point $$$(0, 0)$$$ and the upper right corner is in $$$(W, H)$$$.There is a rectangular table standing in this room. The sides of the table are parallel to the walls, the lower left corner is in $$$(x_1, y_1)$$$, and the upper right corner in $$$(x_2, y_2)$$$.You want to place another rectangular table in this room with width $$$w$$$ and height $$$h$$$ with the width of the table parallel to the width of the room.The problem is that sometimes there is not enough space to place the second table without intersecting with the first one (there are no problems with tables touching, though).You can't rotate any of the tables, but you can move the first table inside the room.   Example of how you may move the first table. What is the minimum distance you should move the first table to free enough space for the second one?

The first line contains the single integer $$$t$$$ ($$$1 \le t \le 5000$$$) — the number of the test cases. The first line of each test case contains two integers $$$W$$$ and $$$H$$$ ($$$1 \le W, H \le 10^8$$$) — the width and the height of the room. The second line contains four integers $$$x_1$$$, $$$y_1$$$, $$$x_2$$$ and $$$y_2$$$ ($$$0 \le x_1 < x_2 \le W$$$; $$$0 \le y_1 < y_2 \le H$$$) — the coordinates of the corners of the first table. The third line contains two integers $$$w$$$ and $$$h$$$ ($$$1 \le w \le W$$$; $$$1 \le h \le H$$$) — the width and the height of the second table.

For each test case, print the minimum distance you should move the first table, or $$$-1$$$ if there is no way to free enough space for the second table. Your answer will be considered correct if its absolute or relative error doesn't exceed $$$10^{-6}$$$.

NoteThe configuration of the first test case is shown in the picture. But the movement of the first table is not optimal. One of the optimal movement, for example, is to move the table by $$$(0, -1)$$$, so the lower left corner will move from $$$(2, 1)$$$ to $$$(2, 0)$$$. Then you can place the second table at $$$(0, 3)-(4, 5)$$$.In the second test case, there is no way to fit both tables in the room without intersecting.In the third test case, you can move the first table by $$$(0, 2)$$$, so the lower left corner will move from $$$(0, 3)$$$ to $$$(0, 5)$$$.

import Control.Monad

solve :: IO ()
solve = do
    [w, h] <- readMany :: IO [Int]
    [x1, y1, x2, y2] <- readMany :: IO [Int]
    [w', h'] <- readMany :: IO [Int]
    let rs = concat (
            [[w' - x1, x2 - (w - w')] | w' + x2 - x1 <= w] ++
            [[h' - y1, y2 - (h - h')] | h' + y2 - y1 <= h])
    print $ if null rs then -1 else minimum $ map (max 0) rs

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

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

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

import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)

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

testCase :: Scanner String
testCase = do
  (wr, hr) <- pair int int
  (x1, y1) <- pair int int
  (x2, y2) <- pair int int
  (w, h) <- pair int int
  let wt = x2 - x1
  let ht = y2 - y1
  let inf = 10^9
  let dw = if wt + w > wr then inf else w - max x1 (wr - x2)
  let dh = if ht + h > hr then inf else h - max y1 (hr - y2)
  let ans = max 0 $ min dw dh
  return . show $ if ans == inf then -1 else ans

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

import Control.Monad

solve :: IO ()
solve = do
    [w, h] <- readMany :: IO [Int]
    [x1, y1, x2, y2] <- readMany :: IO [Int]
    [w', h'] <- readMany :: IO [Int]
    let isect (l1, h1) (l2, h2) = max 0 $ min h1 h2 - max l1 l2
        fitW = w' + x2 - x1 <= w
        fitH = h' + y2 - y1 <= h
        chk xx yy | ix > 0 && iy > 0 = [ix | fitW] ++ [iy | fitH]
                  | otherwise = [0]
                  where ix = isect (x1, x2) xx
                        iy = isect (y1, y2) yy
        rs = chk (0, w') (0, h')
           ++ chk (w - w', w) (0, h')
           ++ chk (0, w') (h - h', h)
           ++ chk (w - w', w) (h - h', h)
    print $ if null rs then -1 else minimum rs

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

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

import Control.Monad

solve :: IO ()
solve = do
    [w, h] <- readMany :: IO [Int]
    [x1, y1, x2, y2] <- readMany :: IO [Int]
    [w', h'] <- readMany :: IO [Int]
    let isect (l1, h1) (l2, h2) = max 0 $ min h1 h2 - max l1 l2
        fitW = w' + x2 - x1 <= w
        fitH = h' + y2 - y1 <= h
        chk xx yy | ix + iy > 0 = [ix | fitW] ++ [iy | fitH]
                  | otherwise = [0]
                  where ix = isect (x1, x2) xx
                        iy = isect (y1, y2) yy
        rs = chk (0, w') (0, h')
           ++ chk (w - w', w) (0, h')
           ++ chk (0, w') (h - h', h)
           ++ chk (w - w', w) (h - h', h)
    print $ if null rs then -1 else minimum rs

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

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

import Control.Monad

solve :: IO ()
solve = do
    [w, h] <- readMany :: IO [Int]
    [x1, y1, x2, y2] <- readMany :: IO [Int]
    [w', h'] <- readMany :: IO [Int]
    let isect (l1, h1) (l2, h2) = max 0 $ min h1 h2 - max l1 l2
        chkW xx = [isect (x1, x2) xx | w' + x2 - x1 <= w]
        chkH yy = [isect (y1, y2) yy | h' + y2 - y1 <= h]
        rs = chkW (0, w')      ++ chkH (0, h')
           ++ chkW (w - w', w) ++ chkH (0, h')
           ++ chkW (0, w')     ++ chkH (h - h', h)
           ++ chkW (w - w', w) ++ chkH (h - h', h)
        ans | null rs = -1
            | otherwise = minimum rs
    print ans

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

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


We have a secret array. You don't know this array and you have to restore it. However, you know some facts about this array:  The array consists of $$$n$$$ distinct positive (greater than $$$0$$$) integers.  The array contains two elements $$$x$$$ and $$$y$$$ (these elements are known for you) such that $$$x < y$$$.  If you sort the array in increasing order (such that $$$a_1 < a_2 < \ldots < a_n$$$), differences between all adjacent (consecutive) elements are equal (i.e. $$$a_2 - a_1 = a_3 - a_2 = \ldots = a_n - a_{n-1})$$$. It can be proven that such an array always exists under the constraints given below.Among all possible arrays that satisfy the given conditions, we ask you to restore one which has the minimum possible maximum element. In other words, you have to minimize $$$\max(a_1, a_2, \dots, a_n)$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of the test case contains three integers $$$n$$$, $$$x$$$ and $$$y$$$ ($$$2 \le n \le 50$$$; $$$1 \le x < y \le 50$$$) — the length of the array and two elements that are present in the array, respectively.

For each test case, print the answer: $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the $$$i$$$-th element of the required array. If there are several answers, you can print any (it also means that the order of elements doesn't matter). It can be proven that such an array always exists under the given constraints.

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
module Main (main) where
import System.IO
import Data.Ord
import Data.Int
import Data.Bits
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict (StateT)
import qualified Control.Monad.Trans.State.Strict as StateT
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C

getNewLine :: SIO ByteString
getNewLine = (lift $ C.hGetLine stdin) >>= (\z -> let x = C.dropWhile isSpace z in if C.null x then getNewLine else return x)

getRemain :: ByteString -> SIO ByteString
getRemain b = let bns = C.dropWhile isSpace b in
                if C.null bns then getNewLine >>= liftM2 (>>=) StateT.put (const . return)
                else return bns

data HInt
data HInt64
data HNormal
data HString
data HList

type SIO a = StateT ByteString IO a

class IOInteract a where
    convert :: ByteString -> (a, ByteString)
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

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

type family IOType x where
    IOType Int = HInt
    IOType Int64 = HInt64
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertp :: flag -> ByteString -> (a, ByteString)
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertp _ x = let (a, b) = C.break isSpace x in (read $ C.unpack a, b)
    toShowSp _ x = shows x

instance IOInteractp HInt Int where
    convertp _ x = fromMaybe (error "parse") $ C.readInt x
    toShowSp _ x = shows x

instance IOInteractp HInt64 Int64 where
    convertp _ x = let (a, b) = fromMaybe (error "parse") $ C.readInteger x in (fromIntegral a, b)
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertp _ x = let (a, b) = C.break isSpace x in (C.unpack a, b)
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertp _ x = let (a, b) = convert x in ([a], b)
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => SIO a
get = uncurry (flip (liftM2 seq . StateT.put) . return) =<< fmap convert . getRemain =<< StateT.get
put :: IOInteract a => a -> SIO ()
put = lift . (hPutStr stdout) . toShow
putln :: IOInteract a => a -> SIO ()
putln = lift . (hPutStrLn stdout) . toShow
flush :: SIO ()
flush = lift (hFlush stdout)

main :: IO ()
main = StateT.evalStateT main_ C.empty

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

f1 :: SIO ()
f1 = do
  (n, x, y) <- liftM3 (,,) get get get
  putln $ f2 n x y

f2 :: Int64 -> Int64 -> Int64 -> [Int64]
f2 n x y = let d = y - x in
           let dividers = f3 d in
           let candidate = map (\d ->
                                  let cnt = div (y - x) d + 1 in
                                  if cnt > n then Nothing
                                  else
                                  let k = div (x - 1) d in
                                  if cnt + k >= n then Just [y-(n-1)*d,y-(n-2)*d..y]
                                  else let max = y + (n - (cnt + k)) * d in Just [max-(n-1)*d, max-(n-2)*d..max]
                               ) dividers in
           let maxc = foldl (\b a -> case a of
                                      Nothing -> b
                                      Just aa -> if maximum aa > maximum b then b else aa)
                      [1000000000000000] candidate
           in
           maxc

f3 :: Int64 -> [Int64]
f3 d =
  let aux i = if i > d then [] else if mod d i == 0 then i : aux (i + 1) else aux (i + 1) in
  aux 1

import Control.Monad
import Data.List

factors :: Int -> [Int]
factors n = [x | x <- [1..n],  mod n x == 0]

solve :: Int -> Int -> Int -> [Int]
solve n x y = let
  opts = do
    inc <- factors (y - x)
    let
      decrs = take n $ takeWhile (> 0) $ iterate (subtract inc) y
      start = minimum decrs
    [take n (iterate (+ inc) start) | start <= x]
  in  head . sort $ map reverse opts

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, x, y] <- map read . words <$> getLine
    putStrLn $ unwords (map show (solve n x y))


Young wilderness explorers set off to their first expedition led by senior explorer Russell. Explorers went into a forest, set up a camp and decided to split into groups to explore as much interesting locations as possible. Russell was trying to form groups, but ran into some difficulties...Most of the young explorers are inexperienced, and sending them alone would be a mistake. Even Russell himself became senior explorer not long ago. Each of young explorers has a positive integer parameter $$$e_i$$$ — his inexperience. Russell decided that an explorer with inexperience $$$e$$$ can only join the group of $$$e$$$ or more people.Now Russell needs to figure out how many groups he can organize. It's not necessary to include every explorer in one of the groups: some can stay in the camp. Russell is worried about this expedition, so he asked you to help him.

The first line contains the number of independent test cases $$$T$$$($$$1 \leq T \leq 2 \cdot 10^5$$$). Next $$$2T$$$ lines contain description of test cases. The first line of description of each test case contains the number of young explorers $$$N$$$ ($$$1 \leq N \leq 2 \cdot 10^5$$$). The second line contains $$$N$$$ integers $$$e_1, e_2, \ldots, e_N$$$ ($$$1 \leq e_i \leq N$$$), where $$$e_i$$$ is the inexperience of the $$$i$$$-th explorer. It's guaranteed that sum of all $$$N$$$ doesn't exceed $$$3 \cdot 10^5$$$.

Print $$$T$$$ numbers, each number on a separate line. In $$$i$$$-th line print the maximum number of groups Russell can form in $$$i$$$-th test case.

NoteIn the first example we can organize three groups. There will be only one explorer in each group. It's correct because inexperience of each explorer equals to $$$1$$$, so it's not less than the size of his group.In the second example we can organize two groups. Explorers with inexperience $$$1$$$, $$$2$$$ and $$$3$$$ will form the first group, and the other two explorers with inexperience equal to $$$2$$$ will form the second group.This solution is not unique. For example, we can form the first group using the three explorers with inexperience equal to $$$2$$$, and the second group using only one explorer with inexperience equal to $$$1$$$. In this case the young explorer with inexperience equal to $$$3$$$ will not be included in any group.

import Control.Monad
import Data.List

main = do
    t <- read <$> getLine
    replicateM_ t test

test = do
    getLine
    es <- map read . words <$> getLine
    print $ solve 1 $ sort es

solve _ [] = 0
solve c (e:es)
    | e <= c = 1 + solve 1 es
    | otherwise = solve (c + 1) es

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- readI
  replicateM_ t $ do
    n <- readI
    es <- readIs
    print $ solve n es

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

readIs :: IO [Int]
readIs = fmap read . words <$> getLine

solve :: Int -> [Int] -> Int
solve n es = go (sort es) [] n 0 0
  where
    go es0 (c:_) en cn result | c == cn = go es0 [] en 0 (result+1)
    go (e:es) _ en _ result | e > en = result
    go (e:es) cs0 en cn result = go es (e:cs0) en (cn+1) result
    go [] _ _ _ result = result

import qualified Data.List as L

type Long = Int

solve :: [Int] -> Int
solve es = formGroups (L.sort es) 0

formGroups :: [Int] -> Int -> Int
formGroups [] _ = 0
formGroups (a:rest) curSize
    | a <= curSize + 1  = 1 + formGroups rest 0
    | otherwise         = formGroups rest (curSize+1)

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

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

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

--module Test where
import Data.List

solve :: IO ()
solve = do
    nLine <- getLine
    let n = read nLine :: Int
    line <- getLine
    let list = sort $ read <$> words line :: [Int]
    let ans = getAns list
    putStrLn $ show ans

getAns :: [Int] -> Int
getAns [] = 0
getAns (x : xs) = if sz == 0 then 0
                  else 1 + getAns (drop sz list) where
                      sz = tmp x 1 xs
                      list = (x : xs)

tmp :: Int -> Int -> [Int] -> Int
tmp last sz list | sz >= last = sz
                 | otherwise  = if list == [] then 0
                                else tmp (head list) (sz + 1) (tail list)

main :: IO ()
main = do
    line <- getLine
    let t = read line :: Int
    sequence_ (take t $ repeat solve)

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- readI
  replicateM_ t $ do
    n <- readI
    es <- readIs
    print $ solve n es

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

readIs :: IO [Int]
readIs = fmap read . words <$> getLine

solve :: Int -> [Int] -> Int
solve n es = go n (sortBy (flip compare) es) (0 :: Int)
  where
    go n [] result = result
    go n (e:_) result | n < e = result
    go n (e:es) result = go (n-e) (drop (e-1) es) (result+1)

type Long = Int

solve :: Int -> [Int] -> Int
solve n es = formGroups es 0

formGroups :: [Int] -> Int -> Int
formGroups [] _ = 0
formGroups (a:rest) curSize
    | a <= curSize + 1  = 1 + formGroups rest 0
    | otherwise         = formGroups rest (curSize+1)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:_) <- readWords
    es <- readWords
    print $ solve n es
    testCases (t-1)

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

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