There are $$$n$$$ armchairs, numbered from $$$1$$$ to $$$n$$$ from left to right. Some armchairs are occupied by people (at most one person per armchair), others are not. The number of occupied armchairs is not greater than $$$\frac{n}{2}$$$.For some reason, you would like to tell people to move from their armchairs to some other ones. If the $$$i$$$-th armchair is occupied by someone and the $$$j$$$-th armchair is not, you can tell the person sitting in the $$$i$$$-th armchair to move to the $$$j$$$-th armchair. The time it takes a person to move from the $$$i$$$-th armchair to the $$$j$$$-th one is $$$|i - j|$$$ minutes. You may perform this operation any number of times, but these operations must be done sequentially, i. e. you cannot tell a person to move until the person you asked to move in the last operation has finished moving to their destination armchair.You want to achieve the following situation: every seat that was initially occupied must be free. What is the minimum time you need to do it?

The first line contains one integer $$$n$$$ ($$$2 \le n \le 5000$$$) — the number of armchairs. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 1$$$). $$$a_i = 1$$$ means that the $$$i$$$-th armchair is initially occupied, $$$a_i = 0$$$ means that it is initially free. The number of occupied armchairs is at most $$$\frac{n}{2}$$$.

Print one integer — the minimum number of minutes you have to spend to achieve the following situation: every seat that was initially occupied must be free.

NoteIn the first test, you can perform the following sequence:  ask a person to move from armchair $$$1$$$ to armchair $$$2$$$, it takes $$$1$$$ minute;  ask a person to move from armchair $$$7$$$ to armchair $$$6$$$, it takes $$$1$$$ minute;  ask a person to move from armchair $$$4$$$ to armchair $$$5$$$, it takes $$$1$$$ minute. In the second test, you can perform the following sequence:  ask a person to move from armchair $$$1$$$ to armchair $$$4$$$, it takes $$$3$$$ minutes;  ask a person to move from armchair $$$2$$$ to armchair $$$6$$$, it takes $$$4$$$ minutes;  ask a person to move from armchair $$$4$$$ to armchair $$$5$$$, it takes $$$1$$$ minute;  ask a person to move from armchair $$$3$$$ to armchair $$$4$$$, it takes $$$1$$$ minute. In the third test, no seat is occupied so your goal is achieved instantly.

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.List
import Data.Maybe
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

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

inf :: Int
inf = 1 `shift` 29

writeMinArray :: (MArray a e m, Ix i, Ord e) => a i e -> i -> e -> m ()
writeMinArray a i v = do
    v' <- readArray a i
    writeArray a i $ min v v'

solve :: [Int] -> Int
solve xs =
    let
        r = runSTUArray $ do
            dp <- newArray (-2502,2502) inf :: ST s (STUArray s Int Int)
            writeArray dp 0 0
            forM_ xs $ \x -> do
                dp2 <- newArray (-2502, 2502) inf :: ST s (STUArray s Int Int)
                forM_ [-2501..2501] $ \i -> do
                    v <- readArray dp i
                    case x of
                        0 -> do
                            writeMinArray dp2 (i - 1) (v + abs (i-1))
                            writeMinArray dp2 i (v + abs i)
                        1 -> do
                            writeMinArray dp2 (i + 1) (v + abs (i+1))

                forM_ [-2502..2502] $ \i -> do
                    v <- readArray dp2 i
                    writeArray dp i v
            return dp
    in
        r ! 0

main = do
    a <- map parseInt . tail . BS.words <$> BS.getContents
    print $ solve a


Three years have passes and nothing changed. It is still raining in London, and Mr. Black has to close all the doors in his home in order to not be flooded. Once, however, Mr. Black became so nervous that he opened one door, then another, then one more and so on until he opened all the doors in his house.There are exactly two exits from Mr. Black's house, let's name them left and right exits. There are several doors in each of the exits, so each door in Mr. Black's house is located either in the left or in the right exit. You know where each door is located. Initially all the doors are closed. Mr. Black can exit the house if and only if all doors in at least one of the exits is open. You are given a sequence in which Mr. Black opened the doors, please find the smallest index $$$k$$$ such that Mr. Black can exit the house after opening the first $$$k$$$ doors.We have to note that Mr. Black opened each door at most once, and in the end all doors became open.

The first line contains integer $$$n$$$ ($$$2 \le n \le 200\,000$$$) — the number of doors. The next line contains $$$n$$$ integers: the sequence in which Mr. Black opened the doors. The $$$i$$$-th of these integers is equal to $$$0$$$ in case the $$$i$$$-th opened door is located in the left exit, and it is equal to $$$1$$$ in case it is in the right exit. It is guaranteed that there is at least one door located in the left exit and there is at least one door located in the right exit.

Print the smallest integer $$$k$$$ such that after Mr. Black opened the first $$$k$$$ doors, he was able to exit the house.

NoteIn the first example the first two doors are from the left exit, so when Mr. Black opened both of them only, there were two more closed door in the left exit and one closed door in the right exit. So Mr. Black wasn't able to exit at that moment.When he opened the third door, all doors from the right exit became open, so Mr. Black was able to exit the house.In the second example when the first two doors were opened, there was open closed door in each of the exit.With three doors opened Mr. Black was able to use the left exit.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = getLine >> readInts >>= print . sum . map length . init . group

import Data.Maybe
import Data.List

import qualified Data.ByteString.Char8 as B

getInts = map (fst . fromJust . B.readInt) . B.words

main = getLine >> B.getLine >>= print . sum . map( length ) . init . group . getInts

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

solve (n:a) = min (length b1) (length b2)
  where
    b = reverse $ take n a
    b1 = dropWhile (== 0) b
    b2 = dropWhile (== 1) b

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

main = interact $ show.helper.(map read).words

helper (x:xs) = x -  max (length $ takeWhile (==1) sx) (length $ takeWhile (==0) sx)
                      where sx = reverse xs

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

main = do
		getLine
		a<-reverse <$> map (fst.fromJust.C.readInt) <$> C.words <$> C.getLine ::IO [Int]
		let b= head a
		print $ length $ dropWhile (==b) a

--ghc 7.10

import Data.List(findIndices)

minExit xs = 1 + min (last is0) (last is1)
    where
        is0 = findIndices (==0) xs
        is1 = findIndices (==1) xs

main = do
    line1 <- getLine
    line2 <- getLine
    let xs = map read . words $ line2 :: [Int]
    print $ minExit xs

import Data.Maybe
import Data.List

import qualified Data.ByteString.Char8 as B

getInts = map (fst . fromJust . B.readInt) . B.words

main = B.getLine >>= print . sum . map( length ) . init . group . getInts


You are given a broken clock. You know, that it is supposed to show time in 12- or 24-hours HH:MM format. In 12-hours format hours change from 1 to 12, while in 24-hours it changes from 0 to 23. In both formats minutes change from 0 to 59.You are given a time in format HH:MM that is currently displayed on the broken clock. Your goal is to change minimum number of digits in order to make clocks display the correct time in the given format.For example, if 00:99 is displayed, it is enough to replace the second 9 with 3 in order to get 00:39 that is a correct time in 24-hours format. However, to make 00:99 correct in 12-hours format, one has to change at least two digits. Additionally to the first change one can replace the second 0 with 1 and obtain 01:39.

The first line of the input contains one integer 12 or 24, that denote 12-hours or 24-hours format respectively. The second line contains the time in format HH:MM, that is currently displayed on the clock. First two characters stand for the hours, while next two show the minutes.

The only line of the output should contain the time in format HH:MM that is a correct time in the given format. It should differ from the original in as few positions as possible. If there are many optimal solutions you can print any of them.

main :: IO ()
main = do
  n <- readLn :: IO Int
  [h1,h2,':',m1,m2] <- getLine
  let hh = read[h1, h2] :: Int
  let mm = read[m1, m2] :: Int
  let hh' = if n == 12 && 1<=hh && hh<=12 then [h1, h2]
            else if n == 12 && h2 == '0' then ['1', h2]
            else if n == 12 then ['0', h2]
            else if 0<=hh && hh<24 then [h1, h2]
            else ['0', h2]
  let mm' = if 0 <= mm && mm <60 then [m1,m2] else ['0',m2]
  putStrLn $ hh' ++ ":" ++ mm'


Naman has two binary strings $$$s$$$ and $$$t$$$ of length $$$n$$$ (a binary string is a string which only consists of the characters "0" and "1"). He wants to convert $$$s$$$ into $$$t$$$ using the following operation as few times as possible.In one operation, he can choose any subsequence of $$$s$$$ and rotate it clockwise once.For example, if $$$s = 1\textbf{1}101\textbf{00}$$$, he can choose a subsequence corresponding to indices ($$$1$$$-based) $$$\{2, 6, 7 \}$$$ and rotate them clockwise. The resulting string would then be $$$s = 1\textbf{0}101\textbf{10}$$$.A string $$$a$$$ is said to be a subsequence of string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deleting some characters without changing the ordering of the remaining characters.To perform a clockwise rotation on a sequence $$$c$$$ of size $$$k$$$ is to perform an operation which sets $$$c_1:=c_k, c_2:=c_1, c_3:=c_2, \ldots, c_k:=c_{k-1}$$$ simultaneously.Determine the minimum number of operations Naman has to perform to convert $$$s$$$ into $$$t$$$ or say that it is impossible.

The first line contains a single integer $$$n$$$ $$$(1 \le n \le 10^6)$$$ — the length of the strings. The second line contains the binary string $$$s$$$ of length $$$n$$$. The third line contains the binary string $$$t$$$ of length $$$n$$$.

If it is impossible to convert $$$s$$$ to $$$t$$$ after any number of operations, print $$$-1$$$. Otherwise, print the minimum number of operations required.

NoteIn the first test, Naman can choose the subsequence corresponding to indices $$$\{2, 6\}$$$ and rotate it once to convert $$$s$$$ into $$$t$$$.In the second test, he can rotate the subsequence corresponding to all indices $$$5$$$ times. It can be proved, that it is the minimum required number of operations.In the last test, it is impossible to convert $$$s$$$ into $$$t$$$.

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

main = do
  getLine
  x <- getLine
  y <- getLine
  if length (filter (== '1') x) /= length (filter (== '1') y)
    then print (-1)
    else print $ solve 0 0 0 $ zip x y

solve _ minLevel maxLevel [] = maxLevel - minLevel
solve level minLevel maxLevel (('1', '0') : ps) = solve (level + 1) minLevel (max maxLevel (level + 1)) ps
solve level minLevel maxLevel (('0', '1') : ps) = solve (level - 1) (min minLevel (level - 1)) maxLevel ps
solve level minLevel maxLevel (_ : ps) = solve level minLevel maxLevel ps


Consider a game with $$$n$$$ cards ($$$n$$$ is even). Each card has a number written on it, between $$$1$$$ and $$$n$$$. All numbers on the cards are different. We say that a card with number $$$x$$$ is stronger than a card with number $$$y$$$ if $$$x > y$$$.Two players, Alex and Boris, play this game. In the beginning, each of them receives exactly $$$\frac{n}{2}$$$ cards, so each card belongs to exactly one player. Then, they take turns. Alex goes first, then Boris, then Alex again, and so on.On a player's turn, he must play exactly one of his cards. Then, if the opponent doesn't have any cards stronger than the card played, the opponent loses, and the game ends. Otherwise, the opponent has to play a stronger card (exactly one card as well). These two cards are removed from the game, and the turn ends. If there are no cards left, the game ends in a draw; otherwise it's the opponent's turn.Consider all possible ways to distribute the cards between two players, so that each of them receives exactly half of the cards. You have to calculate three numbers:  the number of ways to distribute the cards so that Alex wins;  the number of ways to distribute the cards so that Boris wins;  the number of ways to distribute the cards so that the game ends in a draw. You may assume that both players play optimally (i. e. if a player can win no matter how his opponent plays, he wins). Two ways to distribute the cards are different if there is at least one card such that, in one of these ways, it is given to Alex, and in the other way, it is given to Boris.For example, suppose $$$n = 4$$$, Alex receives the cards $$$[2, 3]$$$, and Boris receives the cards $$$[1, 4]$$$. Then the game may go as follows:  if Alex plays the card $$$2$$$, then Boris has to respond with the card $$$4$$$. Then, Alex's turn ends, and Boris' turn starts. Boris has only one card left, which is $$$1$$$; he plays it, and Alex responds with the card $$$3$$$. So, the game ends in a draw;  if Alex plays the card $$$3$$$, then Boris has to respond with the card $$$4$$$. Then, Alex's turn ends, and Boris' turn starts. Boris has only one card left, which is $$$1$$$; he plays it, and Alex responds with the card $$$2$$$. So, the game ends in a draw. So, in this case, the game ends in a draw.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 30$$$) — the number of test cases. Then, $$$t$$$ lines follow. The $$$i$$$-th line contains one even integer $$$n$$$ ($$$2 \le n \le 60$$$).

For each test case, print three integers:   the number of ways to distribute the cards so that Alex wins;  the number of ways to distribute the cards so that Boris wins;  the number of ways to distribute the cards so that the game ends in a draw.  Since the answers can be large, print them modulo $$$998244353$$$.

NoteIn the first test case, Alex wins if he receives the card $$$2$$$ (he plays it, and Boris cannot respond). If Alex receives the card $$$1$$$, the game ends in a draw.In the second test case:   Alex wins if he receives the cards $$$[3, 4]$$$, $$$[2, 4]$$$ or $$$[1, 4]$$$;  Boris wins if Alex receives the cards $$$[1, 2]$$$ or $$$[1, 3]$$$;  the game ends in a draw if Alex receives the cards $$$[2, 3]$$$.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Control.Monad.Trans.State
import Data.Array.Base (UArray (UArray))
import Data.Array.Unboxed
import Data.Bits
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import qualified Data.ByteString.Lazy.Char8 as P
import Data.List
import Data.Maybe
import System.IO

mainFun :: SP Builder
mainFun = do
  casnum <- getInt
  ans <- forM [1 .. casnum] $ \_ -> do
    n <- getInt
    let m = div n 2
    let (w, l) = win !! m
    pure [w, l, 1]
  pure $ mconcat $ map putInts ans
  where
    win =
      map (\(a, b, c) -> (b, c)) $
        take (maxM + 1) $
          iterate
            ( \(i, w, l) ->
                (i + 1, l +! combine (2 * i + 1) i, w +! combine (2 * i) (i + 1))
            )
            (0, 0, 0)

maxN = 60

maxM = div maxN 2

facts :: UArray Int Int
facts = listArray (0, maxN) $ scanl' (*!) 1 [1 .. maxN]

ifacts :: UArray Int Int
ifacts = listArray (0, maxN) [inv (facts ! i) | i <- [0 .. maxN]]

combine :: Int -> Int -> Int
combine n m
  | n < m = 0
  | otherwise = (facts ! n) *! (ifacts ! m) *! (ifacts ! (n - m))

modulo :: Int
modulo = 998244353

infixl 6 +!

(+!) :: Int -> Int -> Int
x +! y = x + y -! modulo

infixl 6 -!

(-!) :: Int -> Int -> Int
x -! y =
  let raw = x - y
   in raw + (modulo .&. shiftR raw 63)

infixl 8 *!

(*!) :: Int -> Int -> Int
x *! y = mod (x * y) modulo
--   let raw = mod (x * y) modulo
--    in raw + (modulo .&. shiftR raw 63)

pow :: Int -> Int -> Int
pow =
  let -- I used to use stimes for this, but it seems that's 15x slower
      -- than just the hand-rolled loop, so no more is it used.
      go acc !x 0 = acc
      go !acc !x k =
        if even k
          then go acc (x *! x) (div k 2)
          else go (acc *! x) (x *! x) (div k 2)
   in go 1

inv :: Int -> Int
inv n = pow n (modulo - 2)

type SP = State P.ByteString

type S = StateT P.ByteString

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

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

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

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

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

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

p = 998244353
main = read <$> getLine >>=
       flip replicateM_ (scase (genGames 60 p))

scase g = read <$> getLine >>=
          \n -> case (g M.! n) of
                  (a, b, c) -> putStrLn (show a ++ " " ++ show b ++ " " ++ show c)

-- n is even > 4
genGames :: Int -> Int -> Map Int (Int, Int, Int)
genGames n p = let m = M.insert 2 (1, 0, 1) M.empty
               in foldl (f p) m [4, 6 .. n]

f :: Int -> Map Int (Int, Int, Int) -> Int -> Map Int (Int, Int, Int)
f p m n = let (a, b, c) = m M.! (n-2)
              n2 = div n 2
          in
            M.insert n ((b + comb (n-1) n2) `mod` p, (a + comb (n-2) n2) `mod` p, c) m

-- n C m
comb :: Int -> Int -> Int
comb n m = c60 M.! (n, m)

c60 :: Map (Int, Int) Int
c60 = let m = M.insert (0, 0) 1 M.empty
          f m (n, k) | k == 0 || k == n = M.insert (n, k) 1 m
                     | otherwise = M.insert (n, k)
                                   (m M.! (n-1, k-1) + m M.! (n-1, k)) m
      in
        foldl f m [(i, j) | i <- [1..60], j <- [0..i]]

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

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

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

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

showAns (a,b,c) = unwords . map show $ [a,b,c]

solve nn = f nn
  where
    c = ncomb

    f 2 = (1,0,1)
    f n = (c (n-1) (h-1)             .+. b (n-2),
           c (n-2) (h-2) .+. a (n-2)            ,
           c (n  ) (h  ) .-. a (n  ) .-. b (n  ))
      where
        h = n `div` 2

    a n = x  where  (x,_,_) = f n
    b n = x  where  (_,x,_) = f n

ncomb n k = cmap ! (n,k)  where  (!) = (Map.!)
cmap = Map.fromList [((n,k), cc n k) | n <- nvals,
                                       k <- nvals]
  where
    cc n k | (k == 0)  = 1 :: Int
           | (k == n)  = 1
           | otherwise  = ncomb (n-1) (k-1) .+. ncomb (n-1) k
nvals = [0..60] :: [Int]

modVal = 998244353

x .+. y = (x          + y) `mod` modVal
x .-. y = (x + modVal - y) `mod` modVal

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

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map solve >>> zip [1 ..] >>> map (uncurry output) >>> C.unlines

type TC = Int

type Output = [Int]

input :: Scanner TC
input = int

solve :: TC -> Output
solve n = calc n ++ [1]

output :: Int -> Output -> C.ByteString
output _ = map showB >>> C.unwords

calc :: Int -> [Int]
calc 2 = [1, 0]
calc n = let h = n `div` 2 in zipWith (+%) [(n - 1) `choose` h, (n - 2) `choose` h] (reverse $ calc (n - 2))

choose' :: [[Int]]
choose' =
  [ [ if n < r
        then 0
        else
          if r == 0 || r == n
            then 1
            else (n - 1) `choose` r +% (n - 1) `choose` (r - 1)
      | r <- [0 .. 60]
    ]
    | n <- [0 .. 60]
  ]

choose n r = choose' !! n !! r

modulo = 998244353

a +% b = (a + b) `mod` modulo
infixl 4 +%

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a

#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- helpers
(>$>) = flip ($)

infixl 0 >$>

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

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

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

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
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

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.Ratio
import Data.Function
import Data.Coerce
import Data.Array

class TypeMod a where
    modulo :: ModInt a

data MyMod = MyMod
instance TypeMod MyMod where
    modulo = Mod 998244353

newtype ModInt a = Mod Integer

instance Show (ModInt a) where
    show (Mod n) = show n

instance TypeMod a => Num (ModInt a) where

    Mod l + Mod r = Mod (mod (l + r) (coerce (modulo::ModInt a)))

    Mod l - Mod r = Mod (mod (l - r) (coerce (modulo::ModInt a)))

    Mod l * Mod r = Mod (mod (l * r) (coerce (modulo::ModInt a)))

    abs = id
    signum = const 1
    fromInteger n = Mod (mod n ((coerce (modulo::ModInt a))))

instance TypeMod a => Fractional (ModInt a) where
    recip = (^(((coerce(modulo::ModInt a)::Integer) - 2)))
    fromRational r = (fromInteger . numerator) r * (recip . fromInteger . denominator) r

fac n = take (n+1) (iterate (\(y,x) -> (y+1,x*fromInteger (y+1))) ((0,1)::(Integer,ModInt MyMod)))

toShow (x,y,z) = show x ++ " " ++ show y ++ " " ++ show z

solve _ 2 = (1,0,1)
solve arr n = let (x,y,z) = solve arr (n-2) in (y+(arr!(n-1)/(arr!(div n 2) * (arr!(div n 2-1)))),x+(arr!(n-2)/(arr!(div n 2) * (arr!(div n 2-2)))) ,z)

main :: IO ()
main = do
    ts <- getLine
    replicateM (read ts::Int) $ do
        input <- getLine
        let n = read  input ::Int
        let arr = array (0,n) (map (\(x,y) -> (fromInteger x,y)) $ fac n)
        putStrLn .toShow .solve arr $ n
    return ()

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Control.Monad.Trans.State
import Data.Array.Base (UArray (UArray))
import Data.Array.Unboxed
import Data.Bits
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import qualified Data.ByteString.Lazy.Char8 as P
import Data.List
import Data.Maybe
import System.IO

mainFun :: SP Builder
mainFun = do
  casnum <- getInt
  ans <- forM [1 .. casnum] $ \_ -> do
    n <- getInt
    let m = div n 2
    let (w, l) = win !! m
    pure [w, l, 1]
  pure $ mconcat $ map putInts ans
  where
    win =
      map (\(a, b, c) -> (b, c)) $
        take (maxM + 1) $
          iterate
            ( \(i, w, l) ->
                (i + 1, l +! combine (2 * i + 1) i, w +! combine (2 * i) (i + 1))
            )
            (0, 0, 0)

maxN = 60

maxM = div maxN 2

facts :: UArray Int Int
facts = listArray (0, maxN) $ scanl' (*) 1 [1 .. maxN]

ifacts :: UArray Int Int
ifacts = listArray (0, maxN) [inv (facts ! i) | i <- [0 .. maxN]]

combine :: Int -> Int -> Int
combine n m
  | n < m = 0
  | otherwise = (facts ! n) *! (ifacts ! m) *! (ifacts ! (n - m))

modulo :: Int
modulo = 998244353

infixl 6 +!

(+!) :: Int -> Int -> Int
x +! y = x + y -! modulo

infixl 6 -!

(-!) :: Int -> Int -> Int
x -! y =
  let raw = x - y
   in raw + (modulo .&. shiftR raw 63)

infixl 8 *!

(*!) :: Int -> Int -> Int
x *! y =mod (x * y) modulo
--   let raw = mod (x * y) modulo
--    in raw + (modulo .&. shiftR raw 63)

pow :: Int -> Int -> Int
pow =
  let -- I used to use stimes for this, but it seems that's 15x slower
      -- than just the hand-rolled loop, so no more is it used.
      go acc !x 0 = acc
      go !acc !x k =
        if even k
          then go acc (x *! x) (div k 2)
          else go (acc *! x) (x *! x) (div k 2)
   in go 1

inv :: Int -> Int
inv n = pow n (modulo - 2)

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


There are n animals in the queue to Dr. Dolittle. When an animal comes into the office, the doctor examines him, gives prescriptions, appoints tests and may appoint extra examination. Doc knows all the forest animals perfectly well and therefore knows exactly that the animal number i in the queue will have to visit his office exactly ai times. We will assume that an examination takes much more time than making tests and other extra procedures, and therefore we will assume that once an animal leaves the room, it immediately gets to the end of the queue to the doctor. Of course, if the animal has visited the doctor as many times as necessary, then it doesn't have to stand at the end of the queue and it immediately goes home. Doctor plans to go home after receiving k animals, and therefore what the queue will look like at that moment is important for him. Since the doctor works long hours and she can't get distracted like that after all, she asked you to figure it out.

The first line of input data contains two space-separated integers n and k (1 ≤ n ≤ 105, 0 ≤ k ≤ 1014). In the second line are given space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109). Please do not use the %lld specificator to read or write 64-bit numbers in C++. It is recommended to use cin, cout streams (you can also use the %I64d specificator).

If the doctor will overall carry out less than k examinations, print a single number "-1" (without quotes). Otherwise, print the sequence of numbers — number of animals in the order in which they stand in the queue.  Note that this sequence may be empty. This case is present in pretests. You can just print nothing or print one "End of line"-character. Both will be accepted.

NoteIn the first sample test:  Before examination: {1, 2, 3}  After the first examination: {2, 3}  After the second examination: {3, 2}  After the third examination: {2} In the second sample test:  Before examination: {1, 2, 3, 4, 5, 6, 7}  After the first examination: {2, 3, 4, 5, 6, 7}  After the second examination: {3, 4, 5, 6, 7, 2}  After the third examination: {4, 5, 6, 7, 2, 3}  After the fourth examination: {5, 6, 7, 2, 3}  After the fifth examination: {6, 7, 2, 3, 5}  After the sixth examination: {7, 2, 3, 5, 6}  After the seventh examination: {2, 3, 5, 6}  After the eighth examination: {3, 5, 6, 2}  After the ninth examination: {5, 6, 2, 3}  After the tenth examination: {6, 2, 3}

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    k <- fromIntegral <$> readInteger
    a <- map fromIntegral <$> replicateM n readInt
    return (n, k, a)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = do
    (n, k, a) <- evalState parseInput <$> BS.getContents
    let s = sum a
    when (k > s) $ putStrLn "-1"
    when (k < s) $ putStrLn $ unwords . map show $ solve n k a

solve :: Int -> Int64 -> [Int64] -> [Int]
solve n k a = go pairs 0 k
  where
    intMap = foldl (\map v -> IntMap.insertWith (+) (fromIntegral v) 1 map) IntMap.empty a :: IntMap Int64
    ass = IntMap.assocs intMap
    pairs = scanr (\(k, v) (_,v') -> (fromIntegral k, v+v')) (maxBound,0) ass :: [(Int64, Int64)]

    go :: [(Int64,Int64)] -> Int64 -> Int64 -> [Int]
    go [] _ _ = []
    go ((k, v):xs) k' num
        | num >= tot = go xs k (num - tot)
        | otherwise  = map fst $ hi ++ lo'
      where
        tot = (k - k') * v
        a' = filter (\(id, num) -> num >= k) $ zip [1..] a
        (height, width) = num `divMod` fromIntegral (length a')
        (lo, hi) = splitAt (fromIntegral width) a'
        lo' = if height + 1 == k - k' then filter (\(id, num) -> num > k) lo else lo

--{{{ Start of a minimal State Monad
class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

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

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

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

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

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State
--}}} end of a minimal State Monad


Polycarp has recently got himself a new job. He now earns so much that his old wallet can't even store all the money he has.Berland bills somehow come in lots of different sizes. However, all of them are shaped as rectangles (possibly squares). All wallets are also produced in form of rectangles (possibly squares).A bill $$$x \times y$$$ fits into some wallet $$$h \times w$$$ if either $$$x \le h$$$ and $$$y \le w$$$ or $$$y \le h$$$ and $$$x \le w$$$. Bills can overlap with each other in a wallet and an infinite amount of bills can fit into a wallet. That implies that all the bills Polycarp currently have fit into a wallet if every single one of them fits into it independently of the others.Now you are asked to perform the queries of two types:  $$$+~x~y$$$ — Polycarp earns a bill of size $$$x \times y$$$;  $$$?~h~w$$$ — Polycarp wants to check if all the bills he has earned to this moment fit into a wallet of size $$$h \times w$$$. It is guaranteed that there is at least one query of type $$$1$$$ before the first query of type $$$2$$$ and that there is at least one query of type $$$2$$$ in the input data.For each query of type $$$2$$$ print "YES" if all the bills he has earned to this moment fit into a wallet of given size. Print "NO" otherwise.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 5 \cdot 10^5$$$) — the number of queries. Each of the next $$$n$$$ lines contains a query of one of these two types:   $$$+~x~y$$$ ($$$1 \le x, y \le 10^9$$$) — Polycarp earns a bill of size $$$x \times y$$$;  $$$?~h~w$$$ ($$$1 \le h, w \le 10^9$$$) — Polycarp wants to check if all the bills he has earned to this moment fit into a wallet of size $$$h \times w$$$.  It is guaranteed that there is at least one query of type $$$1$$$ before the first query of type $$$2$$$ and that there is at least one query of type $$$2$$$ in the input data.

NoteThe queries of type $$$2$$$ of the example:  Neither bill fits;  Both bills fit (just checking that you got that bills can overlap);  Both bills fit (both bills are actually the same);  All bills fit (too much of free space in a wallet is not a problem);  Only bill $$$1 \times 5$$$ fit (all the others don't, thus it's "NO").

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix, on)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve input = go input 0 0
    where go [] _ _ = []
          go (t:a:b:s) minl maxl
            | t == "+" = go s (max minl mink) (max maxl maxk)
            | t == "?" = (if maxk >= maxl && mink >= minl then "YES" else "NO"): go s minl maxl
            where ak = read a
                  bk = read b
                  mink = min ak bk
                  maxk = max ak bk

main = do
    input <- BS8.getContents
    let words = map BS8.unpack $ tail $ BS8.words input
    mapM_ putStrLn $ solve words

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix, on)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve input = go input 0 0
    where go [] _ _ = []
          go (t:a:b:s) minl maxl
            | t == "+" = go s (max minl mink) (max minl maxk)
            | t == "?" = (if maxk >= maxl && mink >= minl then "YES" else "NO"): go s minl maxl
            where ak = read a
                  bk = read b
                  mink = min ak bk
                  maxk = max ak bk

main = do
    input <- BS8.getContents
    let words = map BS8.unpack $ tail $ BS8.words input
    mapM_ putStrLn $ solve words


You are given an array $$$a$$$ consisting of $$$n$$$ integers $$$a_1, a_2, \dots , a_n$$$.In one operation you can choose two elements of the array and replace them with the element equal to their sum (it does not matter where you insert the new element). For example, from the array $$$[2, 1, 4]$$$ you can obtain the following arrays: $$$[3, 4]$$$, $$$[1, 6]$$$ and $$$[2, 5]$$$.Your task is to find the maximum possible number of elements divisible by $$$3$$$ that are in the array after performing this operation an arbitrary (possibly, zero) number of times.You have to answer $$$t$$$ independent queries.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of queries. The first line of each query contains one integer $$$n$$$ ($$$1 \le n \le 100$$$). The second line of each query contains $$$n$$$ integers $$$a_1, a_2, \dots , a_n$$$ ($$$1 \le a_i \le 10^9$$$).

For each query print one integer in a single line — the maximum possible number of elements divisible by $$$3$$$ that are in the array after performing described operation an arbitrary (possibly, zero) number of times.

NoteIn the first query of the example you can apply the following sequence of operations to obtain $$$3$$$ elements divisible by $$$3$$$: $$$[3, 1, 2, 3, 1] \rightarrow [3, 3, 3, 1]$$$.In the second query you can obtain $$$3$$$ elements divisible by $$$3$$$ with the following sequence of operations: $$$[1, 1, 1, 1, 1, 2, 2] \rightarrow [1, 1, 1, 1, 2, 3] \rightarrow [1, 1, 1, 3, 3] \rightarrow [2, 1, 3, 3] \rightarrow [3, 3, 3]$$$.

import Control.Monad

solve :: Int -> Int -> Int -> [Integer] -> Int
solve grp0 grp1 grp2 [] = grp0 + pairs + rest
  where pairs = min grp1 grp2
        rest = (grp1 - pairs) `div` 3 + (grp2 - pairs) `div` 3
solve grp0 grp1 grp2 (x:xs)
  | x `mod` 3 == 0 = solve (grp0 + 1) grp1 grp2 xs
  | x `mod` 3 == 1 = solve grp0 (grp1 + 1) grp2 xs
  | x `mod` 3 == 2 = solve grp0 grp1 (grp2 + 1) xs

process :: Int -> [[Integer]] -> IO [[Integer]]
process 0 result = return $ reverse result
process counter result = do
  [_, queries] <- replicateM 2 $ map read . words <$> getLine
  process next (queries:result)
    where next = counter - 1

main :: IO ()
main = do
  n <- readLn
  result <- process n []
  mapM_ (print . solve 0 0 0) $ result

import Data.List
import Control.Monad

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

solve :: Int -> [Int] -> Int -> Int
solve 0 xs w = w
solve x xs w
    | head xs == 0 = solve (x - 1) (tail xs) (w + 1)
    | head xs == 1 && last xs == 2 = solve (x - 2) (init (tail xs)) (w + 1)
    | x >= 3 = solve (x - 3) (drop 3 xs) (w + 1)
    | otherwise = solve 0 xs w

subproblem :: IO ()
subproblem = do
  n <- getLine
  a <- getLine
  print $ solve (toInt n) (sort (map (`mod` 3) (map toInt (words a)))) 0

main = do
    n <- getLine
    replicateM (toInt n) subproblem

import Data.List
import Control.Monad

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

solve :: Int -> [Int] -> Int -> String
solve 0 xs w = show w
solve x xs w
    | head xs == 0 = solve (x - 1) (tail xs) (w + 1)
    | head xs == 1 && last xs == 2 = solve (x - 2) (init (tail xs)) (w + 1)
    | x >= 3 = solve (x - 3) (drop 3 xs) (w + 1)
    | otherwise = solve 0 xs w

--subproblem :: IO ()
--subproblem = do
--  n <- getLine
--  a <- getLine
--  print $ solve (toInt n) (sort (map (`mod` 3) (map toInt (words a)))) 0

fff :: String -> String
fff x = unlines (process (tail (lines x)))

process :: [String] -> [String]
process [] = []
process input = do
    let x = toInt (input !! 0)
    let xs = sort (map (`mod` 3) (map toInt (words (input !! 1))))
    (solve x xs 0 ++ "\n") : process (drop 2 input)

--printAll :: [String] -> IO()
--printAll [] = print []
--printAll x:xs = do

main :: IO()
main = interact fff

calc :: [Int] -> Int
calc xs = let a = xs!!0
              b = xs!!1
              c = xs!!2
          in a + min b c + (div (max b c - min b c) 3)

count :: Int -> [Int] -> [Int]
count x cl
    | mod x 3 == 0 = [a + 1, b, c]
    | mod x 3 == 2 = [a, b + 1, c]
    | mod x 3 == 1 = [a, b, c + 1]
    | otherwise = cl
    where a = cl!!0
          b = cl!!1
          c = cl!!2

solve' :: [Int] -> [Int] -> Int -> Int -> [Int] -> [Int]
solve' (x:xs) cl n curr res
    | n == (curr - 1) = solve' xs [0,0,0] x 1 (res ++ [(calc cl)])
    | curr > 0 = solve' xs (count x cl) n (curr + 1) res
    | otherwise = solve' xs [0,0,0] x 1 res

solve' _ cl n curr res
    | cl == [0,0,0] = res
    | otherwise = (tail res) ++ [(calc cl)]

solve :: [Int] -> [Int]
solve xs = solve' xs [0,0,0] (-1) 0 []

main = interact $ unlines . map show . solve . map (read::String->Int) . tail . words

calc :: [Int] -> Int
calc xs = let a = xs!!0
              b = xs!!1
              c = xs!!2
          in a + min b c + (div (max b c - min b c) 3)

count :: Int -> [Int] -> [Int]
count x cl
    | mod x 3 == 0 = [a + 1, b, c]
    | mod x 2 == 0 = [a, b + 1, c]
    | mod x 1 == 0 = [a, b, c + 1]
    | otherwise = cl
    where a = cl!!0
          b = cl!!1
          c = cl!!2

solve' :: [Int] -> [Int] -> Int -> Int -> [Int] -> [Int]
solve' (x:xs) cl n curr res
    | n == (curr - 1) = solve' xs [0,0,0] x 1 (res ++ [(calc cl)])
    | curr > 0 = solve' xs (count x cl) n (curr + 1) res
    | otherwise = solve' xs [0,0,0] x 1 res

solve' _ cl n curr res
    | cl == [0,0,0] = res
    | otherwise = (tail res) ++ [(calc cl)]

solve :: [Int] -> [Int]
solve xs = solve' xs [0,0,0] (-1) 0 []

main = interact $ unlines . map show . solve . map (read::String->Int) . tail . words

calc :: [Int] -> Int
calc xs = let a = xs!!0
              b = xs!!1
              c = xs!!2
          in a + max b c - min b c

count :: Int -> [Int] -> [Int]
count x cl
    | mod x 3 == 0 = [a + 1, b, c]
    | mod x 2 == 0 = [a, b + 1, c]
    | mod x 1 == 0 = [a, b, c + 1]
    | otherwise = cl
    where a = cl!!0
          b = cl!!1
          c = cl!!2

solve' :: [Int] -> [Int] -> Int -> Int -> [Int] -> [Int]
solve' (x:xs) cl n curr res
    | n == (curr - 1) = solve' xs [0,0,0] x 1 (res ++ [(calc cl)])
    | curr > 0 = solve' xs (count x cl) n (curr + 1) res
    | otherwise = solve' xs [0,0,0] x 1 res

solve' _ cl n curr res
    | cl == [0,0,0] = res
    | otherwise = (tail res) ++ [(calc cl)]

solve :: [Int] -> [Int]
solve xs = solve' xs [0,0,0] (-1) 0 []

main = interact $ unlines . map show . solve . map (read::String->Int) . tail . words


You are going to the beach with the idea to build the greatest sand castle ever in your head! The beach is not as three-dimensional as you could have imagined, it can be decribed as a line of spots to pile up sand pillars. Spots are numbered 1 through infinity from left to right. Obviously, there is not enough sand on the beach, so you brought n packs of sand with you. Let height hi of the sand pillar on some spot i be the number of sand packs you spent on it. You can't split a sand pack to multiple pillars, all the sand from it should go to a single one. There is a fence of height equal to the height of pillar with H sand packs to the left of the first spot and you should prevent sand from going over it. Finally you ended up with the following conditions to building the castle:  h1 ≤ H: no sand from the leftmost spot should go over the fence;  For any  |hi - hi + 1| ≤ 1: large difference in heights of two neighboring pillars can lead sand to fall down from the higher one to the lower, you really don't want this to happen;  : you want to spend all the sand you brought with you. As you have infinite spots to build, it is always possible to come up with some valid castle structure. Though you want the castle to be as compact as possible. Your task is to calculate the minimum number of spots you can occupy so that all the aforementioned conditions hold.

The only line contains two integer numbers n and H (1 ≤ n, H ≤ 1018) — the number of sand packs you have and the height of the fence, respectively.

Print the minimum number of spots you can occupy so the all the castle building conditions hold.

NoteHere are the heights of some valid castles:   n = 5, H = 2, [2, 2, 1, 0, ...], [2, 1, 1, 1, 0, ...], [1, 0, 1, 2, 1, 0, ...]  n = 6, H = 8, [3, 2, 1, 0, ...], [2, 2, 1, 1, 0, ...], [0, 1, 0, 1, 2, 1, 1, 0...] (this one has 5 spots occupied) The first list for both cases is the optimal answer, 3 spots are occupied in them.And here are some invalid ones:  n = 5, H = 2, [3, 2, 0, ...], [2, 3, 0, ...], [1, 0, 2, 2, ...]  n = 6, H = 8, [2, 2, 2, 0, ...], [6, 0, ...], [1, 4, 1, 0...], [2, 2, 1, 0, ...]

check h n | n <= h = n * (n + 1) `div` 2
    | (n - h) `mod` 2 == 0 = k * (k + 1) `div` 2 + (h + k - 1) * (n - k) `div` 2
    | otherwise = k * (k + 1) `div` 2 + (h + k) * (n - k) `div` 2 where k = (n + h) `div` 2
bin f a b | b - a == 1 = b | f m = bin f a m | otherwise = bin f m b where m = (a + b + 1) `div` 2
main = do
    [n, h] <- fmap (map (read) . words) getLine
    print $ bin ((>= n) . check h) 0 n


The Olympic Games have just started and Federico is eager to watch the marathon race.There will be $$$n$$$ athletes, numbered from $$$1$$$ to $$$n$$$, competing in the marathon, and all of them have taken part in $$$5$$$ important marathons, numbered from $$$1$$$ to $$$5$$$, in the past. For each $$$1\le i\le n$$$ and $$$1\le j\le 5$$$, Federico remembers that athlete $$$i$$$ ranked $$$r_{i,j}$$$-th in marathon $$$j$$$ (e.g., $$$r_{2,4}=3$$$ means that athlete $$$2$$$ was third in marathon $$$4$$$).Federico considers athlete $$$x$$$ superior to athlete $$$y$$$ if athlete $$$x$$$ ranked better than athlete $$$y$$$ in at least $$$3$$$ past marathons, i.e., $$$r_{x,j}<r_{y,j}$$$ for at least $$$3$$$ distinct values of $$$j$$$.Federico believes that an athlete is likely to get the gold medal at the Olympics if he is superior to all other athletes.Find any athlete who is likely to get the gold medal (that is, an athlete who is superior to all other athletes), or determine that there is no such athlete.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1\le n\le 50\,000$$$) — the number of athletes. Then $$$n$$$ lines follow, each describing the ranking positions of one athlete. The $$$i$$$-th of these lines contains the $$$5$$$ integers $$$r_{i,1},\,r_{i,2},\,r_{i,3},\,r_{i,4},\, r_{i,5}$$$ ($$$1\le r_{i,j}\le 50\,000$$$) — the ranking positions of athlete $$$i$$$ in the past $$$5$$$ marathons. It is guaranteed that, in each of the $$$5$$$ past marathons, the $$$n$$$ athletes have distinct ranking positions, i.e., for each $$$1\le j\le 5$$$, the $$$n$$$ values $$$r_{1,j},\, r_{2, j},\, \dots,\, r_{n, j}$$$ are distinct. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$50\,000$$$.

For each test case, print a single integer — the number of an athlete who is likely to get the gold medal (that is, an athlete who is superior to all other athletes). If there are no such athletes, print $$$-1$$$. If there is more than such one athlete, print any of them.

NoteExplanation of the first test case: There is only one athlete, therefore he is superior to everyone else (since there is no one else), and thus he is likely to get the gold medal.Explanation of the second test case: There are $$$n=3$$$ athletes.   Athlete $$$1$$$ is superior to athlete $$$2$$$. Indeed athlete $$$1$$$ ranks better than athlete $$$2$$$ in the marathons $$$1$$$, $$$2$$$ and $$$3$$$.  Athlete $$$2$$$ is superior to athlete $$$3$$$. Indeed athlete $$$2$$$ ranks better than athlete $$$3$$$ in the marathons $$$1$$$, $$$2$$$, $$$4$$$ and $$$5$$$.  Athlete $$$3$$$ is superior to athlete $$$1$$$. Indeed athlete $$$3$$$ ranks better than athlete $$$1$$$ in the marathons $$$3$$$, $$$4$$$ and $$$5$$$. Explanation of the third test case: There are $$$n=3$$$ athletes.   Athlete $$$1$$$ is superior to athletes $$$2$$$ and $$$3$$$. Since he is superior to all other athletes, he is likely to get the gold medal.  Athlete $$$2$$$ is superior to athlete $$$3$$$.  Athlete $$$3$$$ is not superior to any other athlete. Explanation of the fourth test case: There are $$$n=6$$$ athletes.   Athlete $$$1$$$ is superior to athletes $$$3$$$, $$$4$$$, $$$6$$$.  Athlete $$$2$$$ is superior to athletes $$$1$$$, $$$4$$$, $$$6$$$.  Athlete $$$3$$$ is superior to athletes $$$2$$$, $$$4$$$, $$$6$$$.  Athlete $$$4$$$ is not superior to any other athlete.  Athlete $$$5$$$ is superior to athletes $$$1$$$, $$$2$$$, $$$3$$$, $$$4$$$, $$$6$$$. Since he is superior to all other athletes, he is likely to get the gold medal.  Athlete $$$6$$$ is only superior to athlete $$$4$$$.

import Control.Monad (replicateM)
import Data.List ( elemIndex )
import Data.Maybe ( fromJust )
import Data.Function (on)

main :: IO [()]
main = do
  t <- readLn :: IO Int
  replicateM t $ do
    n <- readLn :: IO Int
    z <- replicateM n $ do
      map read . words <$> getLine
    print $ solve z

solve :: (Ord a, Num a) => [[a]] -> Int
solve list = if best m then i else -1
  where
    (i, m) = foldl1 (\a b -> if (better `on` snd) a b then a else b) $ zip [1..] list
    better a b = length (filter id $ zipWith (<=) a b) >= 3
    best a = all (better a) list

import Control.Monad (replicateM)
import Data.List ( elemIndex )
import Data.Maybe ( fromJust )
import Data.Function (on)

main :: IO [()]
main = do
  t <- readLn :: IO Int
  replicateM t $ do
    n <- readLn :: IO Int
    z <- replicateM n $ do
      map read . words <$> getLine
    print $ solve z

solve :: (Ord a, Num a) => [[a]] -> Int
solve list = if best m then i else -1
  where
    (i, m) = foldl1 (\a b -> if (better `on` snd) a b then a else b) $ zip [1..] list
    better a b = length (filter id $ zipWith (<) a b) >= 3
    best a = length (filter id $ map (better a) list) == length list - 1

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Data.Maybe
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified Data.Ratio as Rat

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

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

issuperior :: [Int] -> [Int] -> Bool
issuperior xs ys = length (filter (==True) $ zipWith (<) xs ys) > div total 2
  where total = length xs

superior :: [Int] -> [Int] -> [Int]
superior xs ys = if issuperior xs ys then xs else ys

winner :: [[Int]] -> [Int]
winner [xs] = xs
winner xxs = winner $ [a] ++ b
  where (a,b) = foldl (\(prev, acc) xs -> if null prev then (xs, acc) else ([], (superior xs prev : acc))) ([], []) xxs

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  a <- readintrows n
  let best = winner a
      cnt = length $ filter (issuperior best) a
      bestidx = if cnt < n-1 then -1 else (fromMaybe 0 $ findIndex (==best) a) + 1
    in print bestidx

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

----------------------------------------------------------------------------------------
readrows :: (Integral b) => b -> IO [String]
readrows 0 = return []
readrows n = do
  row <- getLine
  l <- readrows $ n-1
  return (row : l)

readintrows :: (Integral a, Integral b) => b -> IO [[a]]
readintrows 0 = return []
readintrows n = do
  row <- readInts
  l <- readintrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs

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

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

import Data.Array.Unboxed

better :: Array Int (UArray Int Int) -> Int -> Int -> Int
better arr x y = let
  gt = (!! 2) $ sort $ zipWith (<) (elems $ arr ! x) (elems $ arr ! y)
  in  if  gt  then  x  else  y

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    r <- listArray (1, n) <$> replicateM n (listArray (1, 5) <$> readInts)
    let
      opt = foldl' (better r) n $ [1 .. n] ++ [1 .. n]
      isOK = and [better r opt i == opt | i <- [1 .. n]]
    putInts [if  isOK  then  opt  else  0-1]

type SIO = StateT P.ByteString IO

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

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

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

import Control.Monad
import Data.Function

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    r <- replicateM n readMany :: IO [[Int]]
    let sup a b = length (filter id $ zipWith (<) a b) >= 3
        allSup a = length (filter id $ map (sup a) r) == n - 1
        (i, m) = foldr1 (\a b -> if (sup `on` snd) a b then a else b) $ zip [1..] r
    print $ if allSup m then i else -1

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

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

{-# LANGUAGE Strict #-}
{-# LANGUAGE LambdaCase #-}
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, fromMaybe)

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

testCase :: Scanner String
testCase = do
  n <- int
  xs <- n >< (5 >< int)
  return . show . fromMaybe (-1) . solve $ xs `zip` [1..]

solve :: [([Int], Int)] -> Maybe Int
solve xs
  | all (win cs . fst) xs = Just i
  | otherwise = Nothing
  where
    (cs, i) = foldl1 better xs
    better ps qs = if win (fst ps) (fst qs) then ps else qs
    win ls rs = ls == rs || count True (zipWith (<) ls rs) >= 3

count :: Eq a => a -> [a] -> Int
count a = length . filter (== a)

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Data.Maybe
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified Data.Ratio as Rat

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

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

issuperior :: [Int] -> [Int] -> Bool
issuperior xs ys = length (filter (==True) $ zipWith (<) xs ys) > div total 2
  where total = length xs

superior :: [Int] -> [Int] -> [Int]
superior xs ys = if issuperior xs ys then xs else ys

winner [xs] = xs
winner xxs = winner $ snd $ foldl (\(prev, acc) xs -> if null prev then (xs, acc) else ([], (superior xs prev : acc))) ([], []) xxs

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  a <- readintrows n
  let best = winner a
      cnt = length $ filter (issuperior best) a
      bestidx = if cnt < n-1 then -1 else (fromMaybe 0 $ findIndex (==best) a) + 1
    in print bestidx

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

----------------------------------------------------------------------------------------
readrows :: (Integral b) => b -> IO [String]
readrows 0 = return []
readrows n = do
  row <- getLine
  l <- readrows $ n-1
  return (row : l)

readintrows :: (Integral a, Integral b) => b -> IO [[a]]
readintrows 0 = return []
readintrows n = do
  row <- readInts
  l <- readintrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs


Bashar was practicing for the national programming contest. Because of sitting too much in front of the computer without doing physical movements and eating a lot Bashar became much fatter. Bashar is going to quit programming after the national contest and he is going to become an actor (just like his father), so he should lose weight.In order to lose weight, Bashar is going to run for $$$k$$$ kilometers. Bashar is going to run in a place that looks like a grid of $$$n$$$ rows and $$$m$$$ columns. In this grid there are two one-way roads of one-kilometer length between each pair of adjacent by side cells, one road is going from the first cell to the second one, and the other road is going from the second cell to the first one. So, there are exactly $$$(4 n m - 2n - 2m)$$$ roads.Let's take, for example, $$$n = 3$$$ and $$$m = 4$$$. In this case, there are $$$34$$$ roads. It is the picture of this case (arrows describe roads):Bashar wants to run by these rules:  He starts at the top-left cell in the grid;  In one move Bashar may go up (the symbol 'U'), down (the symbol 'D'), left (the symbol 'L') or right (the symbol 'R'). More formally, if he stands in the cell in the row $$$i$$$ and in the column $$$j$$$, i.e. in the cell $$$(i, j)$$$ he will move to:   in the case 'U' to the cell $$$(i-1, j)$$$;  in the case 'D' to the cell $$$(i+1, j)$$$;  in the case 'L' to the cell $$$(i, j-1)$$$;  in the case 'R' to the cell $$$(i, j+1)$$$;   He wants to run exactly $$$k$$$ kilometers, so he wants to make exactly $$$k$$$ moves;  Bashar can finish in any cell of the grid;  He can't go out of the grid so at any moment of the time he should be on some cell;  Bashar doesn't want to get bored while running so he must not visit the same road twice. But he can visit the same cell any number of times. Bashar asks you if it is possible to run by such rules. If it is possible, you should tell him how should he run.You should give him $$$a$$$ steps to do and since Bashar can't remember too many steps, $$$a$$$ should not exceed $$$3000$$$. In every step, you should give him an integer $$$f$$$ and a string of moves $$$s$$$ of length at most $$$4$$$ which means that he should repeat the moves in the string $$$s$$$ for $$$f$$$ times. He will perform the steps in the order you print them.For example, if the steps are $$$2$$$ RUD, $$$3$$$ UUL then the moves he is going to move are RUD $$$+$$$ RUD $$$+$$$ UUL $$$+$$$ UUL $$$+$$$ UUL $$$=$$$ RUDRUDUULUULUUL.Can you help him and give him a correct sequence of moves such that the total distance he will run is equal to $$$k$$$ kilometers or say, that it is impossible?

The only line contains three integers $$$n$$$, $$$m$$$ and $$$k$$$ ($$$1 \leq n, m \leq 500$$$, $$$1 \leq k \leq 10 ^{9}$$$), which are the number of rows and the number of columns in the grid and the total distance Bashar wants to run.

If there is no possible way to run $$$k$$$ kilometers, print "NO" (without quotes), otherwise print "YES" (without quotes) in the first line. If the answer is "YES", on the second line print an integer $$$a$$$ ($$$1 \leq a \leq 3000$$$) — the number of steps, then print $$$a$$$ lines describing the steps. To describe a step, print an integer $$$f$$$ ($$$1 \leq f \leq 10^{9}$$$) and a string of moves $$$s$$$ of length at most $$$4$$$. Every character in $$$s$$$ should be 'U', 'D', 'L' or 'R'. Bashar will start from the top-left cell. Make sure to move exactly $$$k$$$ moves without visiting the same road twice and without going outside the grid. He can finish at any cell. We can show that if it is possible to run exactly $$$k$$$ kilometers, then it is possible to describe the path under such output constraints.

NoteThe moves Bashar is going to move in the first example are: "RRLL".It is not possible to run $$$1000000000$$$ kilometers in the second example because the total length of the roads is smaller and Bashar can't run the same road twice.The moves Bashar is going to move in the third example are: "RRDDLLRR".The moves Bashar is going to move in the fifth example are: "RRRLLLDRRRDULLLD". It is the picture of his run (the roads on this way are marked with red and numbered in the order of his running):

import Control.Monad
import Prelude
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Identity

main = do
    testCases <- getLine
    return ()
    let
        [n, m, k] = map read (words testCases) in do
    solution n m k

data Path = Path { path :: String
                 , count :: Int }
type Eval ev = WriterT [Path] (Reader (Int, Int)) ev

instance Show Path where
    show (Path p c) = show c ++ " " ++ p

runEval m n ev = runReader (execWriterT ev) (m, n)

gM :: Eval Int
gM = do
    (m, n) <- ask
    return m

gN :: Eval Int
gN = do
    (m, n) <- ask
    return n

emit :: Path -> Eval ()
emit arg@(Path p c) = do
    when (c > 0)
        (tell [arg])

start = do
    n <- gN
    emit $ Path "D" (n-1)
    emit $ Path "U" (n-1)

colStep = do
    n <- gN
    emit $ Path "R" 1
    emit $ Path "DLR" (n-1)
    emit $ Path "U" (n-1)

finish = do
    m <- gM
    emit $ Path "L" (m-1)

moves :: Eval ()
moves = do
    start
    m <- gM
    replicateM_ (m-1) colStep
    finish

takeP :: Int -> [Path] -> [Path]
takeP 0 l = []
takeP i (pat@(Path p c):t) | (length p * c)  < i  = (pat:(takeP (i-(length p * c)) t))
                         | otherwise =  result where
                         isOkPath (Path "" _) = False
                         isOkPath (Path _ 0) = False
                         isOkPath _ = True
                         lp = length p
                         fullCount = div i lp
                         partialLen = mod i lp
                         fc = Path p fullCount
                         par = Path (take partialLen p) 1
                         result = filter isOkPath [fc, par]

solution n m k | ((4*n*m) - (2*n) - (2*m)) < k = bad
               | otherwise = good $ takeP k (runEval m n moves)

bad = putStrLn "NO"

good l = do
    putStrLn "YES"
    print $ length l
    mapM_ (print) l


For god's sake, you're boxes with legs! It is literally your only purpose! Walking onto buttons! How can you not do the one thing you were designed for?Oh, that's funny, is it? Oh it's funny? Because we've been at this for twelve hours and you haven't solved it either, so I don't know why you're laughing. You've got one hour! Solve it!  Wheatley decided to try to make a test chamber. He made a nice test chamber, but there was only one detail absent — cubes.For completing the chamber Wheatley needs $$$n$$$ cubes. $$$i$$$-th cube has a volume $$$a_i$$$.Wheatley has to place cubes in such a way that they would be sorted in a non-decreasing order by their volume. Formally, for each $$$i>1$$$, $$$a_{i-1} \le a_i$$$ must hold.To achieve his goal, Wheatley can exchange two neighbouring cubes. It means that for any $$$i>1$$$ you can exchange cubes on positions $$$i-1$$$ and $$$i$$$.But there is a problem: Wheatley is very impatient. If Wheatley needs more than $$$\frac{n \cdot (n-1)}{2}-1$$$ exchange operations, he won't do this boring work.Wheatly wants to know: can cubes be sorted under this conditions?

Each test contains multiple test cases. The first line contains one positive integer $$$t$$$ ($$$1 \le t \le 1000$$$), denoting the number of test cases. Description of the test cases follows. The first line of each test case contains one positive integer $$$n$$$ ($$$2 \le n \le 5 \cdot 10^4$$$) — number of cubes. The second line contains $$$n$$$ positive integers $$$a_i$$$ ($$$1 \le a_i \le 10^9$$$) — volumes of cubes. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, print a word in a single line: "YES" (without quotation marks) if the cubes can be sorted and "NO" (without quotation marks) otherwise.

NoteIn the first test case it is possible to sort all the cubes in $$$7$$$ exchanges.In the second test case the cubes are already sorted.In the third test case we can make $$$0$$$ exchanges, but the cubes are not sorted yet, so the answer is "NO".

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve >>= mapM_ ( putStrLn . which "YES" "NO" )

solve = do
	n <- readInt
	as <- readInts
	let
		sorted = sort as
	return $ ( length $ group $ sorted ) /= n || sorted /= reverse as

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

same :: [Int] -> Bool
same [] = False
same [x] = False
same (a : b : xs) = a == b || same (b : xs)

sorted :: [Int] -> Bool
sorted [] = True
sorted [x] = True
sorted (a : b : xs) = a >= b && sorted (b : xs)

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _ <- getLine
    v <- map read . words <$> getLine
    if (not (same (sort v)) && sorted v)
      then putStrLn "NO"
      else putStrLn "YES"

import Control.Monad
import Data.List

solve :: [Int] -> Bool
solve li = let
  sli = reverse $ sort li
  uli = map head $ group sli
  in  li /= uli

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    a <- map read . words <$> getLine
    putStrLn $ if  solve a
      then "YES"
      else "NO"

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve >>= mapM_ ( putStrLn . which "YES" "NO" )

solve = do
	n <- readInt
	as <- readInts
	let
		sorted = sort as
	return $ ( length $ group $ sorted ) == n && sorted == reverse as

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

same :: [Int] -> Bool
same [] = True
same [x] = True
same (a : b : xs) = a == b && same (b : xs)

sorted :: [Int] -> Bool
sorted [] = True
sorted [x] = True
sorted (a : b : xs) = a <= b && sorted (b : xs)

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _ <- getLine
    v <- map read . words <$> getLine
    if (not (same v) && sorted (reverse v))
      then putStrLn "NO"
      else putStrLn "YES"


Programmers working on a large project have just received a task to write exactly m lines of code. There are n programmers working on a project, the i-th of them makes exactly ai bugs in every line of code that he writes. Let's call a sequence of non-negative integers v1, v2, ..., vn a plan, if v1 + v2 + ... + vn = m. The programmers follow the plan like that: in the beginning the first programmer writes the first v1 lines of the given task, then the second programmer writes v2 more lines of the given task, and so on. In the end, the last programmer writes the remaining lines of the code. Let's call a plan good, if all the written lines of the task contain at most b bugs in total.Your task is to determine how many distinct good plans are there. As the number of plans can be large, print the remainder of this number modulo given positive integer mod.

The first line contains four integers n, m, b, mod (1 ≤ n, m ≤ 500, 0 ≤ b ≤ 500; 1 ≤ mod ≤ 109 + 7) — the number of programmers, the number of lines of code in the task, the maximum total number of bugs respectively and the modulo you should use when printing the answer. The next line contains n space-separated integers a1, a2, ..., an (0 ≤ ai ≤ 500) — the number of bugs per line for each programmer.

Print a single integer — the answer to the problem modulo mod.

{-# LANGUAGE BangPatterns #-}
module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List (foldl')

modSum :: Int -> Int -> Int -> Int
modSum m a b = (a + b) `rem` m

solve :: Int -> Int -> UArray Int Int -> Int -> Int
solve numLines numErrors errors modulo =
    runST $ do
      let coders      = bounds errors
          msum        = modSum modulo
          tableBounds = ((0, 0), (numLines, numErrors))
      table <- newArray tableBounds 0 :: ST s (STUArray s (Int, Int) Int)
      writeArray table (0, 0) 1
      forM_ (range coders) $ \c ->
          do forM_ (range tableBounds) $ \ix@(l, e) ->
                 do let ce = errors ! c
                    a <- readArray table ix
                    b <- if l >= 1 && ce <= e
                         then readArray table (l - 1, e - ce)
                         else return 0
                    writeArray table ix (a `msum` b)
      foldM (\r v -> liftM (msum r) (readArray table (numLines, v))) 0 [0 .. numErrors]

readInts :: IO [Int]
readInts = liftM (map read . words) getLine

main :: IO ()
main =
    do [numCoders, numLines, numErrors, modulo] <- readInts
       errors <- liftM (listArray (0, numCoders - 1)) readInts
       print $ solve numLines numErrors errors modulo

{-# LANGUAGE BangPatterns #-}
module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List (foldl')

readInts :: IO [Int]
readInts = liftM (map read . words) getLine

modSum :: Int -> Int -> Int -> Int
modSum m a b = (a + b) `rem` m

solve :: Int -> Int -> Int -> [Int] -> Int
solve numLines numErrors modulo errors =
    runST $ do
      let numCoders = length errors
          verrors   = listArray (0, numCoders - 1) errors :: UArray Int Int
          msum      = modSum modulo
          bounds    = ((0, 0), (numLines, numErrors))
      table <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

      writeArray table (0, 0) 1
      forM_ [0 .. numCoders - 1] $ \c ->
          do forM_ (range bounds) $ \ix@(l, r) ->
                 do a <- readArray table ix
                    b <- if l >= 1 && verrors ! c <= r
                         then readArray table (l - 1, r - verrors ! c)
                         else return 0
                    writeArray table ix (a `msum` b)
      vs <- forM [0 .. numErrors] $ \e -> readArray table (numLines, e)
      return $ foldl' msum 0 vs

main :: IO ()
main =
    do [numCoders, numLines, numErrors, modulo] <- readInts
       errors                                   <- readInts
       when (numCoders /= length errors) $ fail "Wrong input format"
       print $ solve numLines numErrors modulo errors

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad hiding (foldM, foldM_)
import Control.Monad.ST
import Data.Array.Base hiding (readArray, writeArray)
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

main :: IO ()
main = do
  [n,m,b,v] <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  print $ solve n m b v xs

solve :: Int -> Int -> Int -> Int -> [Int] -> Int
solve n m b v xs = runST $ do

  let x +% y = (x + y) `rem` v

  dp <- newArray ((0, 0), (m, b)) 0 :: ST s (STUArray s (Int, Int) Int)

  writeArray dp (0, 0) 1

  forM_ xs $ \x -> do
    rep (m + 1) $ \i -> do
      rep (b + 1) $ \j -> do
        when (i + 1 <= m && j + x <= b) $ do
          (+%) <$> readArray dp (i, j) >>= modifyArray dp (i + 1, j + x)

  foldM 0 [0..b] $ \ !acc i -> do
    (acc+%) <$> readArray dp (m, i)

------------------------------------------------------------------------------
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
foldM :: (Monad m) => a -> [b] -> (a -> b -> m a) -> m a
foldM a xs f=foldr((>=>).flip f)return xs$a
{-# INLINE foldM #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=unsafeAt a$unsafeIndex(bounds a)i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=do lr<-getBounds a;unsafeModify a(unsafeIndex lr i)f
{-# INLINE modifyArray #-}

{-# LANGUAGE BangPatterns #-}
module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List (foldl')

modSum :: Int -> Int -> Int -> Int
modSum m a b = (a + b) `rem` m

solve :: Int -> Int -> UArray Int Int -> Int -> Int
solve numLines numErrors errors modulo =
    runST $ do
      let coders      = bounds errors
          msum        = modSum modulo
          tableBounds = ((0, 0), (numLines, numErrors))
      table <- newArray tableBounds 0 :: ST s (STUArray s (Int, Int) Int)
      writeArray table (0, 0) 1
      forM_ (range coders) $ \c ->
          do forM_ (range tableBounds) $ \ix@(l, e) ->
                 do let ce = errors ! c
                    a <- readArray table ix
                    b <- if l >= 1 && ce <= e
                         then readArray table (l - 1, e - ce)
                         else return 0
                    writeArray table ix (a `msum` b)
      foldM (\r v -> liftM (r+) (readArray table (numLines, v))) 0 [0 .. numErrors]

readInts :: IO [Int]
readInts = liftM (map read . words) getLine

main :: IO ()
main =
    do [numCoders, numLines, numErrors, modulo] <- readInts
       errors <- liftM (listArray (0, numCoders - 1)) readInts
       print $ solve numLines numErrors errors modulo


Once Vasya played bricks. All the bricks in the set had regular cubical shape. Vasya vas a talented architect, however the tower he built kept falling apart.Let us consider the building process. Vasya takes a brick and puts it on top of the already built tower so that the sides of the brick are parallel to the sides of the bricks he has already used. Let's introduce a Cartesian coordinate system on the horizontal plane, where Vasya puts the first brick. Then the projection of brick number i on the plane is a square with sides parallel to the axes of coordinates with opposite corners in points (xi, 1, yi, 1) and (xi, 2, yi, 2). The bricks are cast from homogeneous plastic and the weight of a brick a × a × a is a3 grams.It is guaranteed that Vasya puts any brick except the first one on the previous one, that is the area of intersection of the upper side of the previous brick and the lower side of the next brick is always positive.We (Vasya included) live in a normal world where the laws of physical statics work. And that is why, perhaps, if we put yet another brick, the tower will collapse under its own weight. Vasya puts the cubes consecutively one on top of the other until at least one cube loses the balance and falls down. If it happens, Vasya gets upset and stops the construction. Print the number of bricks in the maximal stable tower, that is the maximal number m satisfying the condition that all the towers consisting of bricks 1, 2, ..., k for every integer k from 1 to m remain stable.

The first input file contains an integer n (1 ≤ n ≤ 100) which is the number of bricks. Each of the next n lines contains four numbers xi, 1, yi, 1, xi, 2, yi, 2 (xi, 1 ≠ xi, 2, |xi, 1 - xi, 2| = |yi, 1 - yi, 2|) which are the coordinates of the opposite angles of the base of the brick number i. The coordinates are integers and their absolute value does not exceed 50.  The cubes are given in the order Vasya puts them. It is guaranteed that the area of intersection of the upper side of the brick number i - 1 and the lower side of the brick number i is strictly strictly greater than zero for all i ≥ 2.

Print the number of bricks in the maximal stable tower.

import Control.Monad
import Data.List

_in l r x = l <= x && x <= r
getA = fmap (map read . words) getLine
std [a,b,c,d] = map fromIntegral [min a c, min b d, max a c, max b d]
gao l = and $ zipWith3 (\i j [a,b,c,d] -> _in a c i && _in b d j) (f x z) (f y z) (head l:l) where
	(x,y,z) = unzip3 $ map (\[a,b,c,d] -> ((a+c)/2, (b+d)/2, (c-a)^3)) l
	f p m = zipWith (/) (scanr1 (+) $ zipWith (*) p m) (scanr1 (+) m)
main = do
	[n] <- getA
	a <- replicateM n getA
	putStrLn $ show $ maximum $ map length $ takeWhile gao $ inits $ map std a

main = interact f
f input = output where
  n0:bricks0 = lines input
  n = read n0::Int
  bricks = map (map (read::String->Float)) $ map words bricks0
  output = show ans
  center [[x1,y1,x2,y2]] = ((x1+x2)/2,(y1+y2)/2,abs((x2-x1)^3))
  center (x:xs) = (g x1 x2,g y1 y2,w1+w2) where
    (x1,y1,w1) = center [x]
    (x2,y2,w2) = center xs
    g x y = (x*w1+y*w2)/(w1+w2)
  stable [_] = True
  stable ([x1,y1,x2,y2]:xs) = stable xs && (x-x1)*(x-x2)<=0 && (y-y1)*(y-y2)<=0 where
    (x,y,_) = center xs
  ans = length $ takeWhile id [stable $ take i bricks|i<-[1..n]]

cdg (a,b,w) (x,y,z,t) = (a + (x + z) * nw, b + (y + t) * nw, w + nw) where nw = (z-x)*(z-x)*(z-x)

isOK [] _ = True
isOK ((h0x,h0y,h1x,h1y):hs) (x,y,w)
  | x < h0x * 2 * w = False
  | x > h1x * 2 * w = False
  | y < h0y * 2 * w = False
  | y > h1y * 2 * w = False
  | otherwise = isOK hs (cdg (x,y,w) (h0x,h0y,h1x,h1y))

solve v n = [t | t <- [1..n], isOK ( reverse (take (t - 1) v) ) (cdg (0,0,0) (v !! (t - 1)))]

intrprt [] n = n
intrprt (x:xs) n
  | x == n = intrprt xs (n + 1)
  | otherwise = n

prc (x1,y1,x2,y2) = ((min x1 x2), (min y1 y2), (max x1 x2), (max y1 y2))

readVector 0 = return []
readVector n = do
  [x,y,z,t] <- fmap ( (map (\x -> read x::Integer)) . words ) getLine
  rest <- (readVector (n - 1))
  return ((prc (x,y,z,t)):rest)

main = do
  n <- readLn::IO Int
  v <- (readVector n)
  print $ (intrprt (solve v n) 1) - 1

import Control.Monad
import Data.List

_in l r x = l <= x && x <= r
getA = fmap (map read . words) getLine
std [a,b,c,d] = map fromIntegral [min a c, min b d, max a c, max b d]
gao l = and $ zipWith3 (\i j [a,b,c,d] -> _in a c i && _in b d j) (f x z) (f y z) (head l:l) where
	(x,y,z) = unzip3 $ map (\[a,b,c,d] -> ((a+c)/2, (b+d)/2, (c-a)^3)) l
	f p m = zipWith (/) (scanr1 (+) $ zipWith (*) p m) (scanr1 (+) m)
main = do
	[n] <- getA
	a <- replicateM n getA
	putStrLn $ show $ maximum $ map length $ filter gao $ inits $ map std a

import Data.Char (ord)

cdg (a,b,w) (x,y,z,t) = (a + (x + z) * nw, b + (y + t) * nw, w + nw) where nw = (z-x)*(z-x)

isOK [] _ = True
isOK ((h0x,h0y,h1x,h1y):hs) (x,y,w)
  | x < h0x * 2 * w = False
  | x > h1x * 2 * w = False
  | y < h0y * 2 * w = False
  | y > h1y * 2 * w = False
  | otherwise = isOK hs (cdg (x,y,w) (h0x,h0y,h1x,h1y))

solve v n = maximum [t | t <- [1..n], isOK ( reverse (take (t - 1) v) ) (cdg (0,0,0) (v !! (t - 1)))]

prc (x1,y1,x2,y2) = ((min x1 x2), (min y1 y2), (max x1 x2), (max y1 y2))

readVector 0 = return []
readVector n = do
  [x,y,z,t] <- fmap ( (map (\x -> read x::Int)) . words ) getLine
  rest <- (readVector (n - 1))
  return ((prc (x,y,z,t)):rest)

main = do
  n <- readLn::IO Int
  v <- (readVector n)
  print $ solve v n

cdg (a,b,w) (x,y,z,t) = (a + (x + z) * nw, b + (y + t) * nw, w + nw) where nw = (z-x)*(z-x)*(z-x)

isOK [] _ = True
isOK ((h0x,h0y,h1x,h1y):hs) (x,y,w)
  | x < h0x * 2 * w = False
  | x > h1x * 2 * w = False
  | y < h0y * 2 * w = False
  | y > h1y * 2 * w = False
  | otherwise = isOK hs (cdg (x,y,w) (h0x,h0y,h1x,h1y))

solve v n = maximum [t | t <- [1..n], isOK ( reverse (take (t - 1) v) ) (cdg (0,0,0) (v !! (t - 1)))]

prc (x1,y1,x2,y2) = ((min x1 x2), (min y1 y2), (max x1 x2), (max y1 y2))

readVector 0 = return []
readVector n = do
  [x,y,z,t] <- fmap ( (map (\x -> read x::Integer)) . words ) getLine
  rest <- (readVector (n - 1))
  return ((prc (x,y,z,t)):rest)

main = do
  n <- readLn::IO Int
  v <- (readVector n)
  print $ solve v n

import Data.Char (ord)

cdg (a,b,w) (x,y,z,t) = (a + (x + z) * nw, b + (y + t) * nw, w + nw) where nw = (z-x)*(z-x)*(z-x)

isOK [] _ = True
isOK ((h0x,h0y,h1x,h1y):hs) (x,y,w)
  | x < h0x * 2 * w = False
  | x > h1x * 2 * w = False
  | y < h0y * 2 * w = False
  | y > h1y * 2 * w = False
  | otherwise = isOK hs (cdg (x,y,w) (h0x,h0y,h1x,h1y))

solve v n = maximum [t | t <- [1..n], isOK ( reverse (take (t - 1) v) ) (cdg (0,0,0) (v !! (t - 1)))]

prc (x1,y1,x2,y2) = ((min x1 x2), (min y1 y2), (max x1 x2), (max y1 y2))

readVector 0 = return []
readVector n = do
  [x,y,z,t] <- fmap ( (map (\x -> read x::Int)) . words ) getLine
  rest <- (readVector (n - 1))
  return ((prc (x,y,z,t)):rest)

main = do
  n <- readLn::IO Int
  v <- (readVector n)
  print $ solve v n

import Data.Char (ord)

cdg (a,b) (x,y,z,t) = (a + x + z, b + y + t)

isOK [] _ _ = True
isOK ((h0x,h0y,h1x,h1y):hs) (x,y) n
  | x < h0x * 2 * n = False
  | x > h1x * 2 * n = False
  | y < h0y * 2 * n = False
  | y > h1y * 2 * n = False
  | otherwise = isOK hs (cdg (x,y) (h0x,h0y,h1x,h1y)) (n + 1)

solve v n = maximum [t | t <- [1..n], isOK ( reverse (take (t - 1) v) ) (cdg (0,0) (v !! (t - 1))) 1]

readVector 0 = return []
readVector n = do
  [x,y,z,t] <- fmap ( (map (\x -> read x::Int)) . words ) getLine
  rest <- (readVector (n - 1))
  return ((x,y,z,t):rest)

main = do
  n <- readLn::IO Int
  v <- (readVector n)
  print $ solve v n

cdg::(Integer,Integer,Integer)->(Integer,Integer,Integer,Integer)->(Integer,Integer,Integer)
cdg (a,b,w) (x,y,z,t) = (a + (x + z) * nw, b + (y + t) * nw, w + nw) where nw = (z-x)*(z-x)*(z-x)

isOK::[(Integer,Integer,Integer,Integer)]->(Integer,Integer,Integer)->Bool
isOK [] _ = True
isOK ((h0x,h0y,h1x,h1y):hs) (x,y,w)
  | x < h0x * 2 * w = False
  | x > h1x * 2 * w = False
  | y < h0y * 2 * w = False
  | y > h1y * 2 * w = False
  | otherwise = isOK hs (cdg (x,y,w) (h0x,h0y,h1x,h1y))

solve::[(Integer,Integer,Integer,Integer)]->Int->Int
solve v n = maximum [t | t <- [1..n], isOK ( reverse (take (t - 1) v) ) (cdg (0,0,0) (v !! (t - 1)))]

prc::(Integer,Integer,Integer,Integer)->(Integer,Integer,Integer,Integer)
prc (x1,y1,x2,y2) = ((min x1 x2), (min y1 y2), (max x1 x2), (max y1 y2))

readVector::Int->IO [(Integer,Integer,Integer,Integer)]
readVector 0 = return []
readVector n = do
  [x,y,z,t] <- fmap ( (map (\x -> read x::Integer)) . words ) getLine
  rest <- (readVector (n - 1))
  return ((prc (x,y,z,t)):rest)

main = do
  n <- readLn::IO Int
  v <- (readVector n)
  print $ solve v n

import Data.Char (ord)

cdg (a,b) (x,y,z,t) = (a + x + z, b + y + t)

isOK [] _ _ = True
isOK ((h0x,h0y,h1x,h1y):hs) (x,y) n
  | x < h0x * 2 * n = False
  | x > h1x * 2 * n = False
  | y < h0y * 2 * n = False
  | y > h1y * 2 * n = False
  | otherwise = isOK hs (cdg (x,y) (h0x,h0y,h1x,h1y)) (n + 1)

solve v n = maximum [t | t <- [1..n], isOK ( reverse (take (t - 1) v) ) (cdg (0,0) (v !! (t - 1))) 1]

prc (x1,y1,x2,y2) = ((min x1 x2), (min y1 y2), (max x1 x2), (max y1 y2))

readVector 0 = return []
readVector n = do
  [x,y,z,t] <- fmap ( (map (\x -> read x::Int)) . words ) getLine
  rest <- (readVector (n - 1))
  return ((prc (x,y,z,t)):rest)

main = do
  n <- readLn::IO Int
  v <- (readVector n)
  print $ solve v n


The only difference between this problem and D1 is the bound on the size of the tree.You are given an unrooted tree with $$$n$$$ vertices. There is some hidden vertex $$$x$$$ in that tree that you are trying to find.To do this, you may ask $$$k$$$ queries $$$v_1, v_2, \ldots, v_k$$$ where the $$$v_i$$$ are vertices in the tree. After you are finished asking all of the queries, you are given $$$k$$$ numbers $$$d_1, d_2, \ldots, d_k$$$, where $$$d_i$$$ is the number of edges on the shortest path between $$$v_i$$$ and $$$x$$$. Note that you know which distance corresponds to which query.What is the minimum $$$k$$$ such that there exists some queries $$$v_1, v_2, \ldots, v_k$$$ that let you always uniquely identify $$$x$$$ (no matter what $$$x$$$ is).Note that you don't actually need to output these queries.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2\cdot10^5$$$)  — the number of vertices in the tree. Each of the next $$$n-1$$$ lines contains two integers $$$x$$$ and $$$y$$$ ($$$1 \le x, y \le n$$$), meaning there is an edges between vertices $$$x$$$ and $$$y$$$ in the tree. It is guaranteed that the given edges form a tree. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot10^5$$$.

For each test case print a single nonnegative integer, the minimum number of queries you need, on its own line.

NoteIn the first test case, there is only one vertex, so you don't need any queries.In the second test case, you can ask a single query about the node $$$1$$$. Then, if $$$x = 1$$$, you will get $$$0$$$, otherwise you will get $$$1$$$.

{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
import Control.Monad
import Data.Bits
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import qualified Data.IntSet as S

solve :: Int -> [[Int]] -> Int
solve n edges
  | n == 1     = 0
  | isBamboo   = 1
  | otherwise  = length leaves - numBranches
  where
    deg :: UArray Int Int
    deg = accumArray (+) 0 (0,n-1) $ map (,1) $ concat edges

    adj :: UArray Int Int
    adj = accumArray xor 0 (0,n-1) $ concatMap (\[a,b] -> [(a,b),(b,a)]) edges

    rise :: Int -> Int
    rise a = go a (adj ! a)
      where
        go a b = if deg ! b >= 3 then b else go b (adj ! b `xor` a)

    isBamboo = maximum (elems deg) <= 2
    leaves = filter (\x -> deg ! x == 1) [0 .. n-1]
    numBranches = S.size $ S.fromList $ map rise leaves

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

main :: IO ()
main = do
  [tc] <- readInts
  replicateM_ tc $ do
    [n] <- readInts
    edges <- replicateM (n-1) $ map (-1+) <$> readInts
    print $ solve n edges