Consider a football tournament where n teams participate. Each team has two football kits: for home games, and for away games. The kit for home games of the i-th team has color xi and the kit for away games of this team has color yi (xi ≠ yi).In the tournament, each team plays exactly one home game and exactly one away game with each other team (n(n - 1) games in total). The team, that plays the home game, traditionally plays in its home kit. The team that plays an away game plays in its away kit. However, if two teams has the kits of the same color, they cannot be distinguished. In this case the away team plays in its home kit.Calculate how many games in the described tournament each team plays in its home kit and how many games it plays in its away kit.

The first line contains a single integer n (2 ≤ n ≤ 105) — the number of teams. Next n lines contain the description of the teams. The i-th line contains two space-separated numbers xi, yi (1 ≤ xi, yi ≤ 105; xi ≠ yi) — the color numbers for the home and away kits of the i-th team.

For each team, print on a single line two space-separated integers — the number of games this team is going to play in home and away kits, correspondingly. Print the answers for the teams in the order they appeared in the input.

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

readListLn :: IO [Int]
readListLn = (map (fst . fromJust . B.readInt) . B.words) `liftM` B.getLine

main :: IO ()
main = do
    n <- readLn :: IO Int
    ss <- forM [1..n] (const readListLn)
    let arrHome = accumArray (+) 0 (1, 10^5) $ map (\[x, _] -> (x, 1)) ss :: UArray Int Int
--  let arrForeign = accumArray (+) 0 (1, 10^5) $ map (\[_, y] -> (y, 1)) ss :: UArray Int Int
    forM_ ss $ \[_, y] -> do
        putStrLn $ let native = 2 * (n - 1) - forgn
                       forgn = n - 1 - arrHome ! y
                   in (show native) ++ " " ++ (show forgn)

{-# LANGUAGE OverloadedStrings #-}

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

solve :: [(Int, Int)] -> [(Int, Int)]
solve s = map f s
  where (xs, ys) = unzip s
        xCnts = countof $ countup xs
        enemy = (length s) - 1
        f (x, y) = (enemy + dup, enemy - dup)
          where dup = xCnts y

main :: IO ()
main = do
  n <- readInt
  c <- replicateM n $ toTuple <$> readInts
  forM_ (solve c) $ \(a, b) -> do
    printf "%d %d\n" a b

toTuple [a, b] = (a, b)
toNumber = fst . fromMaybe (0, "")
readInt = toNumber . BS.readInt <$> BS.getLine
readInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))

countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

{-# LANGUAGE BangPatterns #-}

import Data.Maybe
import Data.List
import qualified Data.IntMap.Strict as IM
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Control.Applicative ((<$>))
import Control.Arrow ((&&&), first, second)
import Control.Monad
import Text.Printf (printf)

main :: IO ()
main = do
  n <- readLn :: IO Int
  teams <- replicateM n $ (map (fst . fromJust . BS.readInt) . BS.words) <$> BS.getLine :: IO [[Int]]
  let !table = IM.fromList . map (head &&& length) . group . sort . map head $ teams
  forM_ (zip [1..] teams) $ \(i, [_, away]) -> do
    let !c = n - 1 + IM.findWithDefault 0 away table
    printf "%d %d\n" c (2 * (n - 1) - c)

{-# LANGUAGE TupleSections #-}

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

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

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

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

main :: IO ()
main = do
  all   <- BS.getContents
  input <- newIORef all
  let parse = next input
  n <- parse int
  (hs,as) <- fmap unzip $ parse $ readMany int2 n
  let home = Map.fromList . map (head &&& length) . group $ sort hs
  forM_ as $ \a ->
      let extraHome = Map.findWithDefault 0 a home
      in putStrLn $ show (n + extraHome - 1) ++ " " ++ show (n - extraHome - 1)

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

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

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

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

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

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

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

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

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

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

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

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

{- CODE JAM input

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


Each day in Berland consists of $$$n$$$ hours. Polycarp likes time management. That's why he has a fixed schedule for each day — it is a sequence $$$a_1, a_2, \dots, a_n$$$ (each $$$a_i$$$ is either $$$0$$$ or $$$1$$$), where $$$a_i=0$$$ if Polycarp works during the $$$i$$$-th hour of the day and $$$a_i=1$$$ if Polycarp rests during the $$$i$$$-th hour of the day.Days go one after another endlessly and Polycarp uses the same schedule for each day.What is the maximal number of continuous hours during which Polycarp rests? It is guaranteed that there is at least one working hour in a day.

The first line contains $$$n$$$ ($$$1 \le n \le 2\cdot10^5$$$) — number of hours per day. The second line contains $$$n$$$ integer numbers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 1$$$), where $$$a_i=0$$$ if the $$$i$$$-th hour in a day is working and $$$a_i=1$$$ if the $$$i$$$-th hour is resting. It is guaranteed that $$$a_i=0$$$ for at least one $$$i$$$.

Print the maximal number of continuous hours during which Polycarp rests. Remember that you should consider that days go one after another endlessly and Polycarp uses the same schedule for each day.

NoteIn the first example, the maximal rest starts in last hour and goes to the first hour of the next day.In the second example, Polycarp has maximal rest from the $$$4$$$-th to the $$$5$$$-th hour.In the third example, Polycarp has maximal rest from the $$$3$$$-rd to the $$$5$$$-th hour.In the fourth example, Polycarp has no rest at all.

longestOnesSequence ans cur [] = ans
longestOnesSequence ans cur (0:xs) = longestOnesSequence ans 0 xs
longestOnesSequence ans cur (1:xs) = longestOnesSequence (max ans $ cur + 1) (cur + 1) xs

main = do
    line' <- getLine
    line <- getLine
    let arr = map read $ words line
    putStrLn . show $ longestOnesSequence 0 0 $ arr ++ arr

foldInt :: (Int, Int) -> Char -> (Int, Int)
foldInt (a,b) '0' = (0,b)
foldInt (a,b) '1' = (a+1, max b (a+1))
foldInt (a,b) _ = (a,b)

calc :: [Char] -> Int
calc c = snd $ foldl foldInt (0,0) c

main = do {
    n <- getLine;
    a <- getLine;
    putStrLn $ show $ calc (a++a);
}

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

process0 [] = 0
process0 (x:xs) = case x of
  0 -> process0 xs
  1 -> process1 1 xs

process1 n [] = n
process1 n (x:xs) = case x of
  1 -> process1 (n + 1) xs
  0 -> max n (process0 xs)

main = do
  throwaway <- getLine
  line <- getLine
  let
    info :: [Integer]
    info = map read $ words line
  print (process0 (info ++ info))

module Main where
-- import qualified Data.ByteString.Char8 as C
import Control.Monad
import Data.List
{- main =  do
    C.getLine
    a <-  C.filter (\x -> x /= ' ')  <$> C.getLine
    let  b = map C.length $ filter (C.elem '1') $ C.group $ C.concat $ [a,a]
    print $ if null b then 0 else maximum b
-}

main =  do
    getLine
    a <-  filter (\x -> x /= ' ')  <$> getLine
    let  b = map length $ filter ('1' `elem`) $ group $ concat $ [a,a]
    print $ if null b then 0 else maximum b

solve [] res cur = max res cur
solve (0:xs) res cur = solve xs (max res cur) 0
solve (1:xs) res cur = solve xs res (cur + 1)

main = do
    n <- (read :: String -> Int) <$> getLine
    lst <- (map read :: [String] -> [Int]) <$> words <$> getLine
    putStrLn (show (min n (solve (lst ++ lst) 0 0)))

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

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

solve :: [Int] -> Int
solve xs
    | all (==0) xs = 0
    | otherwise    = (maximum . map length . filter ((==1) . head) . group) ys
    where ys = xs ++ xs

main :: IO ()
main = do
    _ <- readInt
    xs <- readInts
    print $ solve xs

import Data.List
main = interact $ show . solve . map read . tail . words
solve as = maximum $ (0 :) $ map length $ filter ((> 0) . head) $ group $ as ++ as

-- import Debug.Trace
import Text.Printf
import Control.Monad

glwr :: Read a => IO [a]
glwr = fmap (map read . words) getLine

main :: IO ()
main = do
  _ <- getLine
  ls <- glwr
  print $ maxConRest ls

maxConRest xs = uncurry max $ foldr accMax (length h, 0) ls
  where
    (h, ls) = break (< 1) xs

accMax n (r, m)
  | n < 1 = (0, max r m)
  | 0 < 1 = (r+1, m)

import Data.List

main :: IO ()
main = interact $ show . solve . map read . drop 1 . words

solve :: [Int] ->  Int
solve = maximum . map sum . group . duplList

duplList :: [Int] -> [Int]
duplList l = l ++ l

{-# LANGUAGE 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
import Data.List

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 :: [Int] -> Int
solve (n:a')
  | all (== 0) a = 0
  | otherwise = maximum $map length $ filter ( ( == 1) . head) $ group $ a ++ a
  where
    a = take n a'

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

import Data.List

solve :: [Int] -> Int
solve xs = ts where
  ts = if all (\x -> x == 0) xs then 0
       else maximum . map length .
            filter (all (\x -> x == 1)) . group $ (xs ++ xs)

rInt :: String -> Int
rInt = read

main :: IO ()
main = interact $ show. solve . head . (map . map) rInt .  map words . tail . lines

import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe
main=getLine>>map(fst.fromJust.B.readInt).B.words<$>B.getLine>>=print.maximum.map(\l->if head l==0 then 0 else length l).group.take 400000.cycle

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Bits

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()
printList = putStrLn . intercalate " " . map show :: [Int] -> IO ()

---- Answer Code Section ----

process :: [Int] -> Int
process hours = maximum . map (\l -> if head l == 0 then 0 else length l) . group . take (length hours * 2) . cycle $ hours

main = do
    n <- getInt
    hours <- getInts
    print $ process hours

import Data.List
f ("0":_)=0
f l=length l
main=getLine>>getLine>>=print.maximum.map f.group.take 400000.cycle.words

import Data.List
main=getLine>>map read.words<$>getLine>>=print.maximum.map(\l->if head l==0 then 0 else length l).group.take 400000.cycle

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Bits

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()
printList = putStrLn . intercalate " " . map show :: [Int] -> IO ()

---- Answer Code Section ----

main = getInt >> getInts >>= print . maximum . map (\l -> if head l == 0 then 0 else length l) . group . take 400000 . cycle

readBool a = if (read a) == 0 then True else False

solve sch = (pre + head l) : (tail l)
  where
    findPre (True : _) = 0
    findPre (False : l) = 1 + findPre l
    pre = findPre sch
    calcL [] acc res = acc : res
    calcL (True : l) acc res = calcL l 0 (acc : res)
    calcL (False : l) acc res = calcL l (acc + 1) res
    l = calcL sch 0 []

main = do
  a <- getLine
  sch <- fmap ((map readBool) . words) getLine
  putStrLn . show . maximum $ solve sch

module Main where
import qualified Data.ByteString.Char8 as C
import Control.Monad

main =  do
    C.getLine
    a <-  C.filter (\x -> x /= ' ')  <$> C.getLine
    let  b = map C.length $ filter (C.elem '1') $ C.group $ C.concat $ [a,a]
    print $ if null b then 0 else maximum b

import Data.List
main=getLine>>getLine>>=print.maximum.groupBy(\a b->a==b&&b=="1").take 400000.cycle.words


A has a string consisting of some number of lowercase English letters 'a'. He gives it to his friend B who appends some number of letters 'b' to the end of this string. Since both A and B like the characters 'a' and 'b', they have made sure that at this point, at least one 'a' and one 'b' exist in the string.B now gives this string to C and he appends some number of letters 'c' to the end of the string. However, since C is a good friend of A and B, the number of letters 'c' he appends is equal to the number of 'a' or to the number of 'b' in the string. It is also possible that the number of letters 'c' equals both to the number of letters 'a' and to the number of letters 'b' at the same time.You have a string in your hands, and you want to check if it is possible to obtain the string in this way or not. If it is possible to obtain the string, print "YES", otherwise print "NO" (without the quotes).

The first and only line consists of a string $$$S$$$ ($$$ 1 \le |S| \le 5\,000 $$$). It is guaranteed that the string will only consist of the lowercase English letters 'a', 'b', 'c'.

Print "YES" or "NO", according to the condition.

NoteConsider first example: the number of 'c' is equal to the number of 'a'. Consider second example: although the number of 'c' is equal to the number of the 'b', the order is not correct.Consider third example: the number of 'c' is equal to the number of 'b'.

import Data.List
import Data.Either
import Control.Monad

isgood :: [String] -> Bool
isgood s@[a,b,c] = "abc" == (map head s) && (length c `elem` map length [a, b])
isgood _ = False

main = do
  s <- fmap group getLine
  putStrLn $ if isgood s then "YES" else "NO"

import Data.List

main = do
  s <- getLine
  let ta = length . elemIndices 'a' $ s
  let tb = length . elemIndices 'b' $ s
  let tc = length . elemIndices 'c' $ s
  let p1 = ta > 0 && tb > 0 && (tc == ta || tc == tb)
  let p2 = s == sort s
  putStrLn $ if p1 && p2 then "YES" else "NO"

main = interact $ f.g.head.lines

g :: String -> Bool
g s = length a > 0 && length b > 0 && length d == 0 && (length a == length c || length b == length c)
      where (a, bcd) = span (== 'a') s
            (b, cd)  = span (== 'b') bcd
            (c, d)   = span (== 'c') cd

f :: Bool -> String
f True = "YES\n"
f False = "NO\n"

main = interact $ f.g.head.lines

g :: String -> Bool
g s = length d == 0 && (length a == length c || length b == length c)
      where (a, bcd) = span (== 'a') s
            (b, cd)  = span (== 'b') bcd
            (c, d)   = span (== 'c') cd

f :: Bool -> String
f True = "YES\n"
f False = "NO\n"

main = interact $ f.g

g :: String -> Bool
g s = length d == 0 && (length a == length c || length b == length c)
      where (a, bcd) = span (== 'a') s
            (b, cd)  = span (== 'b') bcd
            (c, d)   = span (== 'c') cd

f :: Bool -> String
f True = "YES\n"
f False = "NO\n"


Vasya is developing his own programming language VPL (Vasya Programming Language). Right now he is busy making the system of exceptions. He thinks that the system of exceptions must function like that.The exceptions are processed by try-catch-blocks. There are two operators that work with the blocks: The try operator. It opens a new try-catch-block.  The catch(<exception_type>, <message>) operator. It closes the try-catch-block that was started last and haven't yet been closed. This block can be activated only via exception of type <exception_type>. When we activate this block, the screen displays the <message>. If at the given moment there is no open try-catch-block, then we can't use the catch operator.The exceptions can occur in the program in only one case: when we use the throw operator. The throw(<exception_type>) operator creates the exception of the given type.Let's suggest that as a result of using some throw operator the program created an exception of type a. In this case a try-catch-block is activated, such that this block's try operator was described in the program earlier than the used throw operator. Also, this block's catch operator was given an exception type a as a parameter and this block's catch operator is described later that the used throw operator. If there are several such try-catch-blocks, then the system activates the block whose catch operator occurs earlier than others. If no try-catch-block was activated, then the screen displays message "Unhandled Exception".To test the system, Vasya wrote a program that contains only try, catch and throw operators, one line contains no more than one operator, the whole program contains exactly one throw operator.Your task is: given a program in VPL, determine, what message will be displayed on the screen.

The first line contains a single integer: n (1 ≤ n ≤ 105) the number of lines in the program. Next n lines contain the program in language VPL. Each line contains no more than one operator. It means that input file can contain empty lines and lines, consisting only of spaces. The program contains only operators try, catch and throw. It is guaranteed that the program is correct. It means that each started try-catch-block was closed, the catch operators aren't used unless there is an open try-catch-block. The program has exactly one throw operator. The program may have spaces at the beginning of a line, at the end of a line, before and after a bracket, a comma or a quote mark. The exception type is a nonempty string, that consists only of upper and lower case english letters. The length of the string does not exceed 20 symbols. Message is a nonempty string, that consists only of upper and lower case english letters, digits and spaces. Message is surrounded with quote marks. Quote marks shouldn't be printed. The length of the string does not exceed 20 symbols. Length of any line in the input file does not exceed 50 symbols.

Print the message the screen will show after the given program is executed.

8
try
    try
        throw ( AE )
    catch ( BE, "BE in line 3")

    try
    catch(AE, "AE in line 5")
catch(AE,"AE somewhere")

8
try
    try
        throw ( AE )
    catch ( AE, "AE in line 3")

    try
    catch(BE, "BE in line 5")
catch(AE,"AE somewhere")

8
try
    try
        throw ( CE )
    catch ( BE, "BE in line 3")

    try
    catch(AE, "AE in line 5")
catch(AE,"AE somewhere")

AE somewhere
AE in line 3
Unhandled Exception

NoteIn the first sample there are 2 try-catch-blocks such that try operator is described earlier than throw operator and catch operator is described later than throw operator: try-catch(BE,"BE in line 3") and try-catch(AE,"AE somewhere"). Exception type is AE, so the second block will be activated, because operator catch(AE,"AE somewhere") has exception type AE as parameter and operator catch(BE,"BE in line 3") has exception type BE.In the second sample there are 2 try-catch-blocks such that try operator is described earlier than throw operator and catch operator is described later than throw operator: try-catch(AE,"AE in line 3") and try-catch(AE,"AE somewhere"). Exception type is AE, so both blocks can be activated, but only the first one will be activated, because operator catch(AE,"AE in line 3") is described earlier than catch(AE,"AE somewhere")In the third sample there is no blocks that can be activated by an exception of type CE.

import Data.Char
import qualified Data.ByteString.Char8 as C

data Result
  = Ex C.ByteString
  | Msg C.ByteString
  | Nil
  | End
  deriving (Eq, Show)

type Parser = State C.ByteString

next :: (Char -> Bool) -> Parser C.ByteString
next f = do
  modify $ C.dropWhile $ not . f
  (x, y) <- gets $ C.span f
  put y
  return x

parseMany :: Parser Result
parseMany = do
  first <- parse
  if first == End
    then return Nil
    else do
      rest <- parseMany
      return $ if first /= Nil then first else rest

parse :: Parser Result
parse = do
  modify $ C.dropWhile $ not . isLetter
  h <- gets C.head
  if h /= 't'
    then return End
    else do
      key <- next $ isLetter
      if key == C.pack "throw"
        then do
          ex <- next $ isLetter
          return $ Ex ex
        else do
          result <- parseMany
          _ <- next $ isLetter    -- "catch"
          ex <- next $ isLetter
          _ <- next $ (=='"')
          msg <- next $ (/='"')
          if result == Ex ex
            then return $ Msg msg
            else return result

main :: IO ()
main = do
  _ <- C.getLine
  s <- C.getContents
  let ans = case fst $ runState parseMany $ C.append s $ C.pack " return" of
              Ex _ -> "Unhandled Exception"
              Msg msg -> C.unpack msg
              _ -> "Error"
  putStrLn ans

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

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

get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put s = State $ \_ -> ((), s)

modify :: (s -> s) -> State s ()
modify f = State $ \s -> ((), f s)

gets :: (s -> a) -> State s a
gets f = State $ \s -> (f s, s)

{-# LANGUAGE BangPatterns #-}

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

import Data.Char
import Data.List

newtype Parser a = Parser { runParser :: String -> (a,String) }

instance Functor Parser where
    fmap f (Parser a) = Parser (a >>> first f)

instance Monad Parser where
    Parser p >>= f =  Parser (\s ->
        let (a,s') = p s in runParser (f a) s')
    return a = Parser (\s -> (a,s))

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

data Op = Try | Throw String | Catch String String | Nop deriving(Show)

parseLine :: Parser Op
parseLine = do
    spaces
    tk <- token
    case tk of
        "try" -> return Try
        "throw" -> do
            s <- paren token
            return (Throw s)
        "catch" -> paren $ do
            ex <- token
            comma
            ms <- dquoted letters
            return $ Catch ex ms
        _ -> return Nop

peek :: Parser Char
peek = Parser $ \cs -> (if null cs then '\0' else head cs,cs)

consume :: Parser ()
consume = Parser $ \cs -> ((),if null cs then cs else tail cs)

spaces = do
    ch <- peek
    if ch == ' ' then consume >> spaces else return ()

token = do
    c <- peek
    if isAlphaNum c then do
        consume
        cs <- token
        return (c:cs)
    else spaces >> return ""

paren p = do
    consume
    spaces
    a <- p
    consume
    spaces
    return a

comma = consume >> spaces
dquoted p = do
    consume
    l <- p
    consume
    return l

letters = do
    c <- peek
    if c == '"' then return "" else do
        consume
        cs <- letters
        return (c:cs)

main = do
    n':ss <- lines <$> getContents
    let n = read n'
    let p = map (fst . runParser parseLine) (take n ss)
    let !ps = fst $ parsePrograms p
    let !res = execProgram ps
    case res of
        Message s -> putStrLn s
        Exception ex -> putStrLn "Unhandled Exception"

data Program = PTryCatch String String [Program]
             | PThrow String
             | PNop deriving(Show)

parsePrograms :: [Op] -> ([Program],[Op])
parsePrograms [] =  ([],[])
parsePrograms ops@(Catch _ _:_) = ([],ops)
parsePrograms ops = (p:ps,ops'')
    where
    (p,ops') = parseProgram ops
    (ps,ops'') = parsePrograms ops'

parseProgram :: [Op] -> (Program,[Op])
parseProgram (Throw ex:ops) = (PThrow ex,ops)
parseProgram (Nop:ops) = (PNop,ops)
parseProgram (Try:ops) = (PTryCatch ex ms ps,ops')
    where
    (ps,Catch ex ms:ops') = parsePrograms ops

data RVal = Unit | Exception String | Message String
    deriving(Show)

execProgram :: [Program] -> RVal
execProgram ps = go ps
    where
    go [] = Unit
    go (PNop:ps) = go ps
    go (PThrow ex:ps) = Exception ex
    go (PTryCatch ex ms p:ps) = case execProgram p of
        Exception ex' | ex == ex' -> Message ms
        Unit -> go ps
        v -> v

{-# LANGUAGE BangPatterns #-}

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

import Data.Char
import Data.List

newtype Parser a = Parser { runParser :: String -> (a,String) }

instance Functor Parser where
    fmap f (Parser a) = Parser (a >>> first f)

instance Monad Parser where
    Parser p >>= f =  Parser (\s ->
        let (a,s') = p s in runParser (f a) s')
    return a = Parser (\s -> (a,s))

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

data Op = Try | Throw String | Catch String String | Nop deriving(Show)

parseLine :: Parser Op
parseLine = do
    spaces
    tk <- token
    case tk of
        "try" -> return Try
        "throw" -> do
            s <- paren token
            return (Throw s)
        "catch" -> paren $ do
            ex <- token
            comma
            ms <- dquoted letters
            return $ Catch ex ms
        _ -> return Nop

peek :: Parser Char
peek = Parser $ \(c:cs) -> (c,c:cs)

consume :: Parser ()
consume = Parser $ \(c:cs) -> ((),cs)

spaces = do
    ch <- peek
    if ch == ' ' then consume >> spaces else return ()

token = do
    c <- peek
    if isAlphaNum c then do
        consume
        cs <- token
        return (c:cs)
    else spaces >> return ""

paren p = do
    consume
    spaces
    a <- p
    consume
    spaces
    return a

comma = consume >> spaces
dquoted p = do
    consume
    l <- p
    consume
    return l

letters = do
    c <- peek
    if c == '"' then return "" else do
        consume
        cs <- letters
        return (c:cs)

main = do
    n':ss <- lines <$> getContents
    let n = read n'
    let p = flip map (take n ss) (\s -> fst $ runParser parseLine (s++"\n"))
    let !ps = fst $ parsePrograms p
    let !res = execProgram ps
    case res of
        Message s -> putStrLn s
        Exception ex -> putStrLn "Unhandled Exception"

data Program = PTryCatch String String [Program]
             | PThrow String
             | PNop deriving(Show)

parsePrograms :: [Op] -> ([Program],[Op])
parsePrograms [] =  ([],[])
parsePrograms ops@(Catch _ _:_) = ([],ops)
parsePrograms ops = (p:ps,ops'')
    where
    (p,ops') = parseProgram ops
    (ps,ops'') = parsePrograms ops'

parseProgram :: [Op] -> (Program,[Op])
parseProgram (Throw ex:ops) = (PThrow ex,ops)
parseProgram (Nop:ops) = (PNop,ops)
parseProgram (Try:ops) = (PTryCatch ex ms ps,ops')
    where
    (ps,Catch ex ms:ops') = parsePrograms ops

data RVal = Unit | Exception String | Message String
    deriving(Show)

execProgram :: [Program] -> RVal
execProgram ps = go ps
    where
    go [] = Unit
    go (PNop:ps) = go ps
    go (PThrow ex:ps) = Exception ex
    go (PTryCatch ex ms p:ps) = case execProgram p of
        Exception ex' | ex == ex' -> Message ms
        Unit -> go ps
        v -> v

import Maybe (fromMaybe)
import Monad (liftM)

{-
import HUnit

testParseLine :: Test
testParseLine  =  TestList "TestParseLine"
  [
    Test "#1" $ assertEq EmptyLine $ parseLine "",
    Test "#2" $ assertEq EmptyLine $ parseLine "    ",
    Test "#3" $ assertEq Try $ parseLine "try",
    Test "#4" $ assertEq Try $ parseLine "  try    ",
    Test "#5" $ assertEq (Throw "abc") $ parseLine "throw(abc)",
    Test "#6" $ assertEq (Throw "abc") $ parseLine "throw (   abc   )   ",
    Test "#7" $ assertEq (Throw "abc") $ parseLine "    throw (abc)",
    Test "#8" $ assertEq (Catch "abc" "is abc") $ parseLine "catch(abc,\"is abc\")",
    Test "#9" $ assertEq (Catch "abc" "is abc") $ parseLine "  catch   ( abc  ,  \"is abc\"  )  ",
    Test "#10" $ assertEq (Catch "abc" "is abc") $ parseLine "  catch   (abc,\"is abc\")",
    Test "#11" $ assertEq (Catch "abc" "fdfd") $ parseLine "  catch   (abc,\"fdfd\")"

  ]

testInput :: Test
testInput  =  Test "TestInput" $ assertEq (Just "is something") $ solve
  [
    "try                        ",
    "    try                    ",
    "        throw(A)           ",
    "    catch(B,\"is B\")      ",
    "    try                    ",
    "                           ",
    "    catch(A,\"is A\")      ",
    "catch(A,\"is something\")  "
  ]

test :: IO ()
test  =  mapM_ run
  [
    testParseLine,
    testInput
  ]
-}

type Type  =  String
type Message  =  String

data Line  =  EmptyLine | Try | Throw Type | Catch Type Message
  deriving
    (Eq, Show)

(?) :: Bool -> a -> a -> a
(?) True   =  const
(?) False  =  flip const

replace :: Eq a => [a] -> a -> [a] -> [a]
replace cs c s  =  map (\x -> (elem x cs) ? c $ x) s

parseLine :: String -> Line
parseLine line  =  case words (replace "()," ' ' line) of
    []  ->  EmptyLine
    ["try"]  ->  Try
    ["throw", s]  ->  Throw s
    ("catch" : s1 : _)  ->  Catch s1 (getMessage line)
  where
    getMessage  =  takeWhile (/= '\"') . tail . dropWhile (/= '\"')

solve :: [String] -> Maybe String
solve lines  =  solve' Nothing 0 (map parseLine lines)
  where
    solve' _ _ []  =  Nothing
    solve' Nothing n (line : lines)  =  case line of
        EmptyLine  ->  solve' Nothing        n    lines
        Try        ->  solve' Nothing       (n+1) lines
        Throw t    ->  solve' (Just (t, n))  n    lines
        Catch _ _  ->  solve' Nothing       (n-1) lines
    solve' f@(Just (t', n')) n (Catch t m : lines)
      | n' /= n  =  solve' f (n-1) lines
      | t' /= t  =  solve' (Just (t', n'-1)) (n-1) lines
      | otherwise  =  Just m
    solve' f@(Just (t', n')) n (line : lines)  =  case line of
        EmptyLine  ->  solve' f n lines
        Try        ->  solve' f (n+1) lines
        Throw t    ->  error $ concat ["find two throw in lines: ", show n', ", ", show n]

main :: IO ()
main  =  do
    n  <-  readLn
    lines'  <-  liftM (take n . lines) getContents
    putStrLn $ fromMaybe "Unhandled Exception" $ solve lines'

import Data.Char
import Data.List

main=interact$solve.filter(not.null).map(dropWhile(' '==)).tail.lines

solve :: [String] -> String
solve (x:xs)
  | isPrefixOf "try" x = solve xs
  | isPrefixOf "catch" x = solve xs
  | otherwise = throw etype xs
   where
     etype = filter isAlpha.dropWhile('('/=)$x

throw etype [] = "Unhandled Exception"
throw etype (x:xs)
  | isPrefixOf "try" x = throw etype $ go 1 xs
  | etype == ctype = cmsg
  | otherwise = throw etype xs
   where
     (y,('\"':z)) = break('\"'==).dropWhile('('/=)$x
     ctype = filter isAlpha y
     cmsg = takeWhile ('\"' /=)z

go 0 xs = xs
go try (x:xs)
 | isPrefixOf "try" x = go (try+1) xs
 | otherwise = go (try-1) xs

{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Char

main :: IO ()
main = do
  _ <- getLine
  ans <- solve <$> B.getContents
  case ans of
    Catched msg -> B.putStrLn msg
    _ -> putStrLn "Unhandled Exception"

solve :: B.ByteString -> Val
solve bs = evalExpr $ evalParser expr bs

type Exception = B.ByteString
type Message = B.ByteString

data Expr = Throw Exception | TryCatch [Expr] Exception Message
data Val = Bottom | Catched Message | UnCatched Exception

evalParser :: Parser [Expr] -> State -> [Expr]
evalParser expr st = case runParser expr st of
                       Just (result,_) -> result
                       Nothing -> error "parse error"

evalExpr :: [Expr] -> Val
evalExpr (Throw excp : _) = UnCatched excp
evalExpr (TryCatch es excp0 msg : rest) =
  case evalExpr es of
    Bottom -> evalExpr rest
    Catched msg -> Catched msg
    UnCatched excp1
      | excp0 == excp1 -> Catched msg
      | otherwise -> UnCatched excp1
evalExpr [] = Bottom

expr :: Parser [Expr]
expr = many (trycatch <|> throw)

throw = do
  spaces
  string "throw"
  spaces
  char '('
  spaces
  excp <- letters
  spaces
  char ')'
  spaces
  return $ Throw excp

trycatch = do
  spaces
  string "try"
  spaces
  exprs <- expr
  spaces
  string "catch"
  spaces
  char '('
  spaces
  excp <- letters
  spaces
  char ','
  spaces
  msg <- between '\"' '\"'
  spaces
  char ')'
  spaces
  return $ TryCatch exprs excp msg

type State = B.ByteString
data Parser t = Parser {runParser :: State -> Maybe (t, State)}

instance Monad Parser where
  return t = Parser $ \st -> Just (t,st)
  m >>= f = Parser $ \st -> do
    (t,rest) <- runParser m st
    runParser (f t) rest

instance MonadPlus Parser where
  mzero = Parser $ const Nothing
  mplus p q = Parser $ \st ->
    runParser p st `mplus` runParser q st

instance Functor Parser where
  fmap f m = Parser $ \st ->
    fmap (\(t,rest) -> (f t,rest)) $ runParser m st

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

instance Alternative Parser where
  empty = mzero
  (<|>) = mplus

getState :: Parser State
getState = Parser $ \st -> Just (st,st)

putState :: State -> Parser ()
putState st = Parser $ const $ Just ((),st)

modifyState :: (State -> State) -> Parser ()
modifyState f = Parser $ \st -> Just ((),f st)

char :: Char -> Parser ()
char c = do
  bs <- getState
  guard (not (B.null bs) && B.index bs 0 == c)
  modifyState B.tail

string :: B.ByteString -> Parser ()
string bs = do
  cs <- getState
  guard $ bs `B.isPrefixOf` cs
  modifyState . B.drop $ B.length bs

spaces :: Parser ()
spaces = do
  bs <- getState
  putState $ B.dropWhile isSpace bs

letters :: Parser B.ByteString
letters = do
  (xs,ys) <- B.span isLetter <$> getState
  putState ys
  return xs

between :: Char -> Char -> Parser B.ByteString
between c d = do
  char c
  (xs,ys) <- B.break (d==) <$> getState
  putState ys
  char d
  return xs

eof :: Parser ()
eof = do
  spaces
  rest <- getState
  guard $ B.null rest

data Statement = Try | Throw String | Catch String String deriving Show

data Program = Trycatch String String Program | ThrowProg String | EmptyProg | SeqProg Program Program deriving Show

trim = reverse . dropWhile (==' ') . reverse . dropWhile (==' ')

unbrace l = case trim l of
  '(':l' -> case reverse l' of
    ')':l'' -> reverse l''

unquote l = case trim l of
  '"':l' -> case reverse l' of
    '"':l'' -> reverse l''

parse :: [String] -> [Statement]
parse s = s >>= \l -> case (dropWhile (==' ') l) of
  ('t':'r':'y':_) -> [Try]
  ('t':'h':'r':'o':'w':l) -> [Throw $ trim $ unbrace l]
  ('c':'a':'t':'c':'h':l) -> case span (/=',') $ unbrace l of
    (l, ',':r) -> [Catch (trim l) (unquote r)]
  [] -> []

go :: [Statement] -> Maybe (String, Int) -> String
go (Try : t) Nothing = go t Nothing
go (Catch ex msg : t) (Just (err, 0)) | err == ex = msg
  | otherwise = go t (Just (err, 0))
go (Catch _ _ : t) Nothing = go t Nothing
go (Catch _ _ : t) (Just (err, i)) = go t (Just (err, i-1))
go (Throw err : t) Nothing = go t (Just (err, 0))
go (Try : t) (Just (err, i)) = go t (Just (err, i+1))
go [] (Just (err, 0)) = "Unhandled Exception"

main = interact $ (`go` Nothing) . parse . tail . lines

import Data.Char
import qualified Data.ByteString.Char8 as C

data Result
  = Ex C.ByteString
  | Msg C.ByteString
  | Nil
  | End
  deriving (Eq, Show)

type Parser = State C.ByteString

next :: (Char -> Bool) -> Parser C.ByteString
next f = do
  modify $ C.dropWhile $ not . f
  (x, y) <- gets $ C.span f
  put y
  return x

parseMany :: Parser Result
parseMany = do
  first <- parse
  if first == End
    then return Nil
    else do
      rest <- parseMany
      return $ if first /= Nil then first else rest

parse :: Parser Result
parse = do
  modify $ C.dropWhile $ not . isLetter
  h <- gets C.head
  if h /= 't'
    then return End
    else do
      key <- next $ isLetter
      if key == C.pack "throw"
        then do
          ex <- next $ isLetter
          return $ Ex ex
        else do
          result <- parseMany
          _ <- next $ isLetter    -- "catch"
          ex <- next $ isLetter
          _ <- next $ (=='"')
          msg <- next $ (/='"')
          if result == Ex ex
            then return $ Msg msg
            else return result

main :: IO ()
main = do
  _ <- C.getLine
  s <- C.getContents
  let ans = case fst $ runState parse $ C.append s $ C.pack " return" of
              Ex _ -> "Unhandled Exception"
              Msg msg -> C.unpack msg
              _ -> "Error"
  putStrLn ans

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

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

get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put s = State $ \_ -> ((), s)

modify :: (s -> s) -> State s ()
modify f = State $ \s -> ((), f s)

gets :: (s -> a) -> State s a
gets f = State $ \s -> (f s, s)

data Statement = Try | Throw String | Catch String String deriving Show

data Program = Trycatch String String Program | ThrowProg String | EmptyProg | SeqProg Program Program deriving Show

trim = reverse . dropWhile (==' ') . reverse . dropWhile (==' ')

unbrace l = case trim l of
  '(':l' -> case reverse l' of
    ')':l'' -> reverse l''

unquote l = case trim l of
  '"':l' -> case reverse l' of
    '"':l'' -> reverse l''

parse :: [String] -> [Statement]
parse s = s >>= \l -> case (dropWhile (==' ') l) of
  ('t':'r':'y':_) -> [Try]
  ('t':'h':'r':'o':'w':l) -> [Throw $ trim $ unbrace l]
  ('c':'a':'t':'c':'h':l) -> case span (/=',') $ unbrace l of
    (l, ',':r) -> [Catch (trim l) (unquote r)]
  [] -> []

go :: [Statement] -> Maybe (String, Int) -> String
go (Try : t) Nothing = go t Nothing
go (Catch ex msg : t) (Just (err, 0)) | err == ex = msg
  | otherwise = go t (Just (err, 0))
go (Catch _ _ : t) Nothing = go t Nothing
go (Catch _ _ : t) (Just (err, i)) = go t (Just (err, i-1))
go (Throw err : t) Nothing = go t (Just (err, 0))
go (Try : t) (Just (err, i)) = go t (Just (err, i+1))
go [] (Just (err, 0)) = "Unhandled exception"

run :: [Statement] -> String
run (Throw ex : t) = go ex t where
  go ex (Catch ex' msg : _) | ex == ex' = msg
  go ex (_ : t) = go ex t
  go _ [] = "Unhandled exception"
run (_ : t) = run t

main = interact $ show . (`go` Nothing) . parse . tail . lines

data Statement = Try | Throw String | Catch String String deriving Show

data Program = Trycatch String String Program | ThrowProg String | EmptyProg | SeqProg Program Program deriving Show

trim = reverse . dropWhile (==' ') . reverse . dropWhile (==' ')

unbrace l = case trim l of
  '(':l' -> case reverse l' of
    ')':l'' -> reverse l''

unquote l = case trim l of
  '"':l' -> case reverse l' of
    '"':l'' -> reverse l''

parse :: [String] -> [Statement]
parse s = s >>= \l -> case (dropWhile (==' ') l) of
  ('t':'r':'y':_) -> [Try]
  ('t':'h':'r':'o':'w':l) -> [Throw $ trim $ unbrace l]
  ('c':'a':'t':'c':'h':l) -> case span (/=',') $ unbrace l of
    (l, ',':r) -> [Catch (trim l) (unquote r)]
  [] -> []

go :: [Statement] -> Maybe (String, Int) -> String
go (Try : t) Nothing = go t Nothing
go (Catch ex msg : t) (Just (err, 0)) | err == ex = msg
  | otherwise = go t (Just (err, 0))
go (Catch _ _ : t) Nothing = go t Nothing
go (Catch _ _ : t) (Just (err, i)) = go t (Just (err, i-1))
go (Throw err : t) Nothing = go t (Just (err, 0))
go (Try : t) (Just (err, i)) = go t (Just (err, i+1))
go [] (Just (err, 0)) = "Unhandled exception"

run :: [Statement] -> String
run (Throw ex : t) = go ex t where
  go ex (Catch ex' msg : _) | ex == ex' = msg
  go ex (_ : t) = go ex t
  go _ [] = "Unhandled exception"
run (_ : t) = run t

main = interact $ (`go` Nothing) . parse . tail . lines


Hilbert's Hotel is a very unusual hotel since the number of rooms is infinite! In fact, there is exactly one room for every integer, including zero and negative integers. Even stranger, the hotel is currently at full capacity, meaning there is exactly one guest in every room. The hotel's manager, David Hilbert himself, decides he wants to shuffle the guests around because he thinks this will create a vacancy (a room without a guest).For any integer $$$k$$$ and positive integer $$$n$$$, let $$$k\bmod n$$$ denote the remainder when $$$k$$$ is divided by $$$n$$$. More formally, $$$r=k\bmod n$$$ is the smallest non-negative integer such that $$$k-r$$$ is divisible by $$$n$$$. It always holds that $$$0\le k\bmod n\le n-1$$$. For example, $$$100\bmod 12=4$$$ and $$$(-1337)\bmod 3=1$$$.Then the shuffling works as follows. There is an array of $$$n$$$ integers $$$a_0,a_1,\ldots,a_{n-1}$$$. Then for each integer $$$k$$$, the guest in room $$$k$$$ is moved to room number $$$k+a_{k\bmod n}$$$.After this shuffling process, determine if there is still exactly one guest assigned to each room. That is, there are no vacancies or rooms with multiple guests.

Each test consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1\le t\le 10^4$$$) — the number of test cases. Next $$$2t$$$ lines contain descriptions of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1\le n\le 2\cdot 10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_0,a_1,\ldots,a_{n-1}$$$ ($$$-10^9\le a_i\le 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot 10^5$$$.

For each test case, output a single line containing "YES" if there is exactly one guest assigned to each room after the shuffling process, or "NO" otherwise. You can print each letter in any case (upper or lower).

NoteIn the first test case, every guest is shifted by $$$14$$$ rooms, so the assignment is still unique.In the second test case, even guests move to the right by $$$1$$$ room, and odd guests move to the left by $$$1$$$ room. We can show that the assignment is still unique.In the third test case, every fourth guest moves to the right by $$$1$$$ room, and the other guests move to the right by $$$5$$$ rooms. We can show that the assignment is still unique.In the fourth test case, guests $$$0$$$ and $$$1$$$ are both assigned to room $$$3$$$.In the fifth test case, guests $$$1$$$ and $$$2$$$ are both assigned to room $$$2$$$.

import qualified Data.List as L
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)

pmod :: Integer -> Integer -> Integer
pmod n p
    | md < 0    = md + p
    | otherwise = md
    where
        md = n `mod` p

allUnique :: [Integer] -> Bool
--allUnique lst = length lst == length (map head $ L.group $ L.sort lst)
allUnique = go IS.empty . map fromIntegral
    where
        go set [] = True
        go set (i:is)
            | IS.member i set   = False
            | otherwise         = go (IS.insert i set) is

valid :: [Integer] -> Bool
valid as = allUnique $ map (`pmod` fromIntegral (length as)) $ zipWith (+) [0..] as

solve :: [Integer] -> String
solve as
    | valid as = "YES"
    | otherwise= "NO"

testCases :: Integer -> IO ()
testCases 0 = return ()
testCases t = do
    _ <- getLine
    as <- readNums
    putStrLn $ solve as
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- parseNums <$> getLine
    testCases t

parseNums :: (Read a) => String -> [a]
parseNums = map read . words

readNums :: (Read a) => IO [a]
readNums = parseNums <$> getLine

import Control.Monad
import Data.Bool
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
    n <- read <$> getLine
    as <- map read . words <$> getLine
    putStrLn $ bool "NO" "YES" $ [0 .. n - 1] == sort ((`mod` n) <$> zipWith (+) [0 .. n - 1] as)

import Control.Monad
import qualified Data.Set as S

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

routine :: IO ()
routine = do
    n <- readLn
    as <- (map read.words) <$> getLine
    putStrLn $ if solve n as
      then "No"
      else "Yes"

solve :: Int -> [Int] -> Bool
solve n as = hasDupesWith S.empty xs
  where
    xs = map (`mod` n) $ zipWith (-) as [0,(-1)..]

hasDupesWith :: S.Set Int ->  [Int] -> Bool
hasDupesWith _ [] = False
hasDupesWith seen (x:xs) = x `S.member` seen || hasDupesWith (S.insert x seen) xs

import qualified Data.List as L

pmod :: Integer -> Integer -> Integer
pmod n p
    | n < 0     = (n `mod` p) + p
    | otherwise = n `mod` p

allUnique :: [Integer] -> Bool
allUnique lst = length lst == length (map head $ L.group $ L.sort lst)

valid :: [Integer] -> Bool
valid as = allUnique $ map (`pmod` fromIntegral (length as)) $ zipWith (+) [0..] as

solve :: [Integer] -> String
solve as
    | valid as = "YES"
    | otherwise= "NO"

testCases :: Integer -> IO ()
testCases 0 = return ()
testCases t = do
    _ <- getLine
    as <- readNums
    putStrLn $ solve as
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- parseNums <$> getLine
    testCases t

parseNums :: (Read a) => String -> [a]
parseNums = map read . words

readNums :: (Read a) => IO [a]
readNums = parseNums <$> getLine

import qualified Data.List as L

pmod :: Int -> Int -> Int
pmod n p
    | n < 0     = (n `mod` p) + p
    | otherwise = n `mod` p

allUnique :: [Int] -> Bool
allUnique lst = length lst == length (map head $ L.group $ L.sort lst)

valid :: [Int] -> Bool
valid as = allUnique $ map (`pmod` length as) $ zipWith (+) [0..] as

solve :: [Int] -> String
solve as
    | valid as = "YES"
    | otherwise= "NO"

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    _ <- getLine
    as <- readNums
    putStrLn $ solve as
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- parseNums <$> getLine
    testCases t

parseNums :: (Read a) => String -> [a]
parseNums = map read . words

readNums :: (Read a) => IO [a]
readNums = parseNums <$> getLine


School holidays come in Berland. The holidays are going to continue for n days. The students of school №N are having the time of their lives and the IT teacher Marina Sergeyevna, who has spent all the summer busy checking the BSE (Berland State Examination) results, has finally taken a vacation break! Some people are in charge of the daily watering of flowers in shifts according to the schedule. However when Marina Sergeyevna was making the schedule, she was so tired from work and so lost in dreams of the oncoming vacation that she perhaps made several mistakes. In fact, it is possible that according to the schedule, on some days during the holidays the flowers will not be watered or will be watered multiple times. Help Marina Sergeyevna to find a mistake.

The first input line contains two numbers n and m (1 ≤ n, m ≤ 100) — the number of days in Berland holidays and the number of people in charge of the watering respectively. The next m lines contain the description of the duty schedule. Each line contains two integers ai and bi (1 ≤ ai ≤ bi ≤ n), meaning that the i-th person in charge should water the flowers from the ai-th to the bi-th day inclusively, once a day. The duty shifts are described sequentially, i.e. bi ≤ ai + 1 for all i from 1 to n - 1 inclusively.

Print "OK" (without quotes), if the schedule does not contain mistakes. Otherwise you have to find the minimal number of a day when the flowers will not be watered or will be watered multiple times, and output two integers — the day number and the number of times the flowers will be watered that day.

NoteKeep in mind that in the second sample the mistake occurs not only on the second day, but also on the sixth day, when nobody waters the flowers. However, you have to print the second day, i.e. the day with the minimal number.

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

getA = fmap (map read . words) getLine

main = do
	[n, m] <- getA
	a <- replicateM m getA
	putStrLn $ toS $ find ((/=1) . snd) $ assocs $ accumArray (+) 0 (1, n) $ concat $ map (\[i, j] -> zip [i .. j] $ repeat 1) a where
		toS Nothing = "OK"
		toS (Just (i, j)) = show i ++ " " ++ show j

import Array
import Maybe
import Prelude hiding (print)

parse :: String -> (Int, Int)
parse line  =  case words line of
    [s1, s2]  ->  (read s1, read s2)

solve :: Int -> [(Int, Int)] -> Maybe (Int, Int)
solve n xs  =  listToMaybe $ filter ((/= 1) . snd) $ assocs array
  where
    array :: Array Int Int
    array  =  accumArray (+) 0 (1, n) $ concatMap (\(a,b) -> [(i,1) | i <- [a..b]]) xs

print :: Maybe (Int, Int) -> IO ()
print Nothing  =  putStrLn "OK"
print (Just (a, b))  =  putStrLn $ show a ++ " " ++ show b

main :: IO ()
main  =  do
    (n, m)  <-  fmap parse getLine
    xs  <-  fmap (map parse . lines) getContents
    print $ solve n xs

main = interact solve
solve input = output where
  [n,m]:s = map (map (read::String->Int)) $ map words $ lines input
  output = ans s
  ans ([x,y]:xs) = if x==1 then ans0 y xs else "1 0"
  ans0 x [] = if x==n then "OK" else f (x+1) 0
  ans0 x ([y,z]:xs)
    | x + 1== y = ans0 z xs
    | x + 1 < y = f (x+1) 0
    | y < z     = f x 2
    | otherwise = f x (ans1 y xs)
  ans1 _ [] = 2
  ans1 x ([y,z]:xs) = if x<y then 2 else ans1 x xs + 1
  f x y = unwords $ map show [x,y]

main = do interact (show . gao . map (map read . words) . tail . lines)
gao (p:q) = minimum [p # i + p # j + i # j | i <- q, j <- q, i /= j] / 2
(#) a = sqrt . sum . zipWith (\i j -> (i - j) ^ 2) a


Given an array $$$a=[a_1,a_2,\dots,a_n]$$$ of $$$n$$$ positive integers, you can do operations of two types on it:  Add $$$1$$$ to every element with an odd index. In other words change the array as follows: $$$a_1 := a_1 +1, a_3 := a_3 + 1, a_5 := a_5+1, \dots$$$.  Add $$$1$$$ to every element with an even index. In other words change the array as follows: $$$a_2 := a_2 +1, a_4 := a_4 + 1, a_6 := a_6+1, \dots$$$.Determine if after any number of operations it is possible to make the final array contain only even numbers or only odd numbers. In other words, determine if you can make all elements of the array have the same parity after any number of operations.Note that you can do operations of both types any number of times (even none). Operations of different types can be performed a different number of times.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$2 \leq n \leq 50$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq 10^3$$$) — the elements of the array. Note that after the performed operations the elements in the array can become greater than $$$10^3$$$.

Output $$$t$$$ lines, each of which contains the answer to the corresponding test case. As an answer, output "YES" if after any number of operations it is possible to make the final array contain only even numbers or only odd numbers, and "NO" otherwise. You can output the answer in any case (for example, the strings "yEs", "yes", "Yes" and "YES" will be recognized as a positive answer).

NoteFor the first test case, we can increment the elements with an even index, obtaining the array $$$[1, 3, 1]$$$, which contains only odd numbers, so the answer is "YES".For the second test case, we can show that after performing any number of operations we won't be able to make all elements have the same parity, so the answer is "NO".For the third test case, all elements already have the same parity so the answer is "YES".For the fourth test case, we can perform one operation and increase all elements at odd positions by $$$1$$$, thus obtaining the array $$$[1001, 1, 1001, 1, 1001]$$$, and all elements become odd so the answer is "YES".

{-# LANGUAGE BangPatterns , BlockArguments ,FlexibleContexts ,FlexibleInstances ,OverloadedStrings ,TypeApplications ,MultiParamTypeClasses ,TupleSections #-}
import Control.Monad (replicateM,forM_,when,(<=<))

main :: IO ()
main = do
  n <- readLn @Int
  query <- replicateM n $ do
    b <- readLn @Int
    a <- map (read @Int) . words <$> getLine
    return (b,a)
  solve n query
solve :: Int -> [(Int,[Int])] -> IO ()
solve n query = do
  forM_ query \(n,x) -> do
    let oddIndex = map snd$filter(\(index,val)->odd index) $zip[1..]x
        evenIndex = map snd$filter(\(index,val)->even index) $zip[1..]x
    let ho = head oddIndex
        he = head evenIndex
    putStrLn$
      if(even ho && even he)then do
        if(all even oddIndex && all even evenIndex)then "YES"else "NO"
      else if(even ho && odd he) then do
        if(all even oddIndex && all odd evenIndex)then "YES"else "NO"
      else if(odd ho && even he) then do
        if(all odd oddIndex && all even evenIndex)then "YES"else "NO"
      else if(odd ho && odd he) then do
        if(all odd oddIndex && all odd evenIndex)then "YES"else "NO"
      else "NO"

import Data.List

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

readInt :: IO Int
readInt = parseInt <$> getLine

readIntArr :: IO [Int]
readIntArr = do
  arr <- words <$> getLine
  pure $ map parseInt arr

check :: Int -> Int
check x = if x `mod` 2 == 0
  then 1
  else -1

calc :: [Int] -> (Int, Int) -> Bool -> String
calc [] _ _ = "YES"
calc (x: xs) (c1, c2) p = if p
  then if (abs c1) > (abs $ c1 + check x)
    then "NO"
    else calc xs (c1 + check x, c2) False
  else if (abs c2) > (abs $ c2 + check x)
    then "NO"
    else calc xs (c1, c2 + check x) True

solve :: IO ()
solve = do
  n <- readInt
  arr <- readIntArr
  putStrLn $ calc arr (0, 0) True

for :: Int -> IO () -> IO ()
for 0 _ = pure ()
for i f = do
  f
  for (i - 1) f

main :: IO ()
main = do
  n <- readInt
  for n solve


Eleven wants to choose a new name for herself. As a bunch of geeks, her friends suggested an algorithm to choose a name for her. Eleven wants her name to have exactly n characters.   Her friend suggested that her name should only consist of uppercase and lowercase letters 'O'. More precisely, they suggested that the i-th letter of her name should be 'O' (uppercase) if i is a member of Fibonacci sequence, and 'o' (lowercase) otherwise. The letters in the name are numbered from 1 to n. Fibonacci sequence is the sequence f where  f1 = 1,  f2 = 1,  fn = fn - 2 + fn - 1 (n > 2). As her friends are too young to know what Fibonacci sequence is, they asked you to help Eleven determine her new name.

The first and only line of input contains an integer n (1 ≤ n ≤ 1000).

Print Eleven's new name on the first and only line of output.

main = putStr . flip (foldr (\i g fs@(f:_) -> if i == f then 'O':g (dropWhile (== i) fs) else 'o':g fs) (const [])) fibs . enumFromTo 1 . read =<< getLine
fibs = 1:1:zipWith (+) fibs (tail fibs)

main = getLine >>= putStrLn . solve . read

solve n = foldr (\x acc -> (genName 'o' x):acc) [] [1 .. n]

genName 'o' num
    | elem num fib = 'O'
    | otherwise = 'o'

fib = f [2,1] 2
    where f (a:b:x) num
              | num < 15 = f ((a+b):a:b:x) (num+1)
              | otherwise = a:b:x

import Data.List

g::Bool->Char
g True='O'
g False='o'

f :: Int->Int->[Int]
f a b
   |a>1000=[]
   |otherwise=a:(f b (a+b))

h::Int->Int->[Int]->[Bool]
h p n xs
  |p>n=[]
  |otherwise=(elem p xs):h (p+1) n xs

main=do
     e1<-getLine
     let n=read e1::Int
         xs=f 1 1
     putStrLn $ map g $ h 1 n xs

import Data.List
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
eleven = intercalate "O" $ map (flip replicate 'o' . pred) fibs
main = interact $ flip take eleven . read

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

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

process x n = map (\z-> if elem z x then 'O' else 'o') [1..n]

main = do
		n<- read <$> getLine:: IO Int
		let x = takeWhile (<=n) fibs
		putStrLn $ process x n

process :: Int -> [Char]
process n = take n $ f 1 1 0
    where
        f a b i
            | i == 0 = 'O':f b (a+b) (a-1)
            | otherwise = 'o':f a b (i-1)

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    putStrLn $ process n


You are given an array $$$a$$$ of $$$n$$$ positive integers.You can use the following operation as many times as you like: select any integer $$$1 \le k \le n$$$ and do one of two things:   decrement by one $$$k$$$ of the first elements of the array.  decrement by one $$$k$$$ of the last elements of the array. For example, if $$$n=5$$$ and $$$a=[3,2,2,1,4]$$$, then you can apply one of the following operations to it (not all possible options are listed below):   decrement from the first two elements of the array. After this operation $$$a=[2, 1, 2, 1, 4]$$$;  decrement from the last three elements of the array. After this operation $$$a=[3, 2, 1, 0, 3]$$$;  decrement from the first five elements of the array. After this operation $$$a=[2, 1, 1, 0, 3]$$$; Determine if it is possible to make all the elements of the array equal to zero by applying a certain number of operations.

The first line contains one positive integer $$$t$$$ ($$$1 \le t \le 30000$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case begins with a line containing one integer $$$n$$$ ($$$1 \le n \le 30000$$$) — the number of elements in the array. The second line of each test case contains $$$n$$$ integers $$$a_1 \ldots a_n$$$ ($$$1 \le a_i \le 10^6$$$). The sum of $$$n$$$ over all test cases does not exceed $$$30000$$$.

For each test case, output on a separate line:    YES, if it is possible to make all elements of the array equal to zero by applying a certain number of operations.  NO, otherwise.  The letters in the words YES and NO can be outputed in any case.

import Control.Arrow ((>>>))
import Data.Bool (bool)

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>>
  map (words >>> map read) >>> process >>> map (bool "NO" "YES") >>> unlines

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

solve :: [Int] -> Bool
solve xs = minimum pre >= 0 && minimum suf >= 0
  where
    gaps = zipWith (-) (tail xs) xs
    decs = map (min 0) gaps
    pre = scanl (+) (head xs) decs
    suf = zipWith (-) xs pre

import Control.Arrow ((>>>))
import Data.Bool (bool)

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>>
  map (words >>> map read) >>> process >>> map (bool "NO" "YES") >>> unlines

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

solve :: [Int] -> Bool
solve xs = minimum suf >= 0
  where
    gaps = zipWith (-) (tail xs) xs
    decs = map (min 0) gaps
    pre = scanl (+) (head xs) decs
    suf = zipWith (-) xs pre


This is an interactive problem!An arithmetic progression or arithmetic sequence is a sequence of integers such that the subtraction of element with its previous element ($$$x_i - x_{i - 1}$$$, where $$$i \ge 2$$$) is constant — such difference is called a common difference of the sequence.That is, an arithmetic progression is a sequence of form $$$x_i = x_1 + (i - 1) d$$$, where $$$d$$$ is a common difference of the sequence.There is a secret list of $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$.It is guaranteed that all elements $$$a_1, a_2, \ldots, a_n$$$ are between $$$0$$$ and $$$10^9$$$, inclusive.This list is special: if sorted in increasing order, it will form an arithmetic progression with positive common difference ($$$d > 0$$$). For example, the list $$$[14, 24, 9, 19]$$$ satisfies this requirement, after sorting it makes a list $$$[9, 14, 19, 24]$$$, which can be produced as $$$x_n = 9 + 5 \cdot (n - 1)$$$.Also you are also given a device, which has a quite discharged battery, thus you can only use it to perform at most $$$60$$$ queries of following two types: Given a value $$$i$$$ ($$$1 \le i \le n$$$), the device will show the value of the $$$a_i$$$. Given a value $$$x$$$ ($$$0 \le x \le 10^9$$$), the device will return $$$1$$$ if an element with a value strictly greater than $$$x$$$ exists, and it will return $$$0$$$ otherwise.Your can use this special device for at most $$$60$$$ queries. Could you please find out the smallest element and the common difference of the sequence? That is, values $$$x_1$$$ and $$$d$$$ in the definition of the arithmetic progression. Note that the array $$$a$$$ is not sorted.

NoteNote that the example interaction contains extra empty lines so that it's easier to read. The real interaction doesn't contain any empty lines and you shouldn't print any extra empty lines as well.The list in the example test is $$$[14, 24, 9, 19]$$$.

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  (rest,maxval) <- binMax (n-2) (10^9) 60
  rands <- SR.randomRs (1,n) <$> SR.newStdGen
  let noDupRands =
        take rest $ map fst
        $ filter (uncurry IS.notMember)
        $ scanl (\(prev,set0) now -> (now, IS.insert prev set0))
            (-1,IS.singleton (-1))
        $ rands
      is | n < shiftL rest 1 = [1..rest `min` n]
         | otherwise         = noDupRands
  as <- fmap sort $ forM is $ \i -> do
    putStrLn $ '?':' ': show i
    hFlush stdout
    ai <- readInt <$> getLine
    if ai < 0 then exitFailure else return ai
  let diffs = zipWith (-) (tail as) as
      d = foldl1' gcd diffs
  putStrLn $ ('!':) $ (' ':) $ shows (maxval - (n-1)*d) $ ' ' : show d

binMax :: Int -> Int -> Int -> IO (Int,Int)
binMax !lt !ge !rest
  | ge - lt <= 1 = return (rest,ge)
  | otherwise    = do
      let mid = lt + shiftR (ge - lt) 1
      putStrLn $ '>':' ': show mid
      hFlush stdout
      i <- readInt <$> getLine
      case i of
        1 -> binMax mid ge (rest-1)
        0 -> binMax lt mid (rest-1)
        _ -> exitFailure

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

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

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

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  (rest,maxval) <- binMax (n-2) (10^9) 60
  rands <- SR.randomRs (1,n) <$> SR.newStdGen
  let noDupRands =
        take rest $ map fst
        $ filter (uncurry IS.notMember)
        $ scanl (\(prev,set0) now -> (now, IS.insert prev set0))
            (-1,IS.singleton (-1))
        $ rands
      is | n < shiftL rest 1 = [1..rest `min` n]
         | otherwise         = noDupRands
  as <- fmap (sort . (maxval:)) $ forM is $ \i -> do
    putStrLn $ '?':' ': show i
    hFlush stdout
    ai <- readInt <$> getLine
    if ai < 0 then exitFailure else return ai
  let diffs = zipWith (-) (tail as) as
      d = foldl1' gcd diffs
  putStrLn $ ('!':) $ (' ':) $ shows (maxval - (n-1)*d) $ ' ' : show d

binMax :: Int -> Int -> Int -> IO (Int,Int)
binMax !lt !ge !rest
  | ge - lt <= 1 = return (rest,ge)
  | otherwise    = do
      let mid = lt + shiftR (ge - lt + 1) 1
      putStrLn $ '>':' ': show mid
      hFlush stdout
      i <- readInt <$> getLine
      case i of
        1 -> binMax mid ge (rest-1)
        0 -> binMax lt mid (rest-1)
        _ -> exitFailure

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

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

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

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

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

ulimit = 10^9 :: Int
over = ulimit + 10

main :: IO ()
main = do
  n <- readInt <$> getLine
  (!rest,!amax) <- binMax (n-2) ulimit 60
  rands <- SR.randomRs (1,n) <$> SR.newStdGen
  let noDupRands
        = take rest $ map fst $ filter (uncurry IS.notMember)
          $ scanl (flip (,) . uncurry IS.insert) (over,IS.singleton over) rands
      is | n < shiftL rest 1 = [1..rest `min` n]
         | otherwise         = noDupRands
  as <- fmap (sort . (amax:)) $ forM is $ \i -> do
    putStrLn $ '?':' ': show i
    hFlush stdout
    ai <- readInt <$> getLine
    if ai < 0 then exitFailure else return ai
  let diffs = zipWith (-) (tail as) as
      d = foldl1' gcd diffs
  putStrLn $ ('!':) $ (' ':) $ shows (amax - (n-1)*d) $ ' ' : show d

binMax :: Int -> Int -> Int -> IO (Int,Int)
binMax !lt !ge !rest
  | ge - lt <= 1 = return (rest,ge)
  | otherwise    = do
      let mid = lt + shiftR (ge - lt + 1) 1
      putStrLn $ '>':' ': show mid
      hFlush stdout
      i <- readInt <$> getLine
      case i of
        1 -> binMax mid ge (rest-1)
        0 -> binMax lt mid (rest-1)
        _ -> exitFailure

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

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

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


A PIN code is a string that consists of exactly $$$4$$$ digits. Examples of possible PIN codes: 7013, 0000 and 0990. Please note that the PIN code can begin with any digit, even with 0.Polycarp has $$$n$$$ ($$$2 \le n \le 10$$$) bank cards, the PIN code of the $$$i$$$-th card is $$$p_i$$$.Polycarp has recently read a recommendation that it is better to set different PIN codes on different cards. Thus he wants to change the minimal number of digits in the PIN codes of his cards so that all $$$n$$$ codes would become different.Formally, in one step, Polycarp picks $$$i$$$-th card ($$$1 \le i \le n$$$), then in its PIN code $$$p_i$$$ selects one position (from $$$1$$$ to $$$4$$$), and changes the digit in this position to any other. He needs to change the minimum number of digits so that all PIN codes become different.Polycarp quickly solved this problem. Can you solve it?

The first line contains integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases in the input. Then test cases follow. The first line of each of $$$t$$$ test sets contains a single integer $$$n$$$ ($$$2 \le n \le 10$$$) — the number of Polycarp's bank cards. The next $$$n$$$ lines contain the PIN codes $$$p_1, p_2, \dots, p_n$$$ — one per line. The length of each of them is $$$4$$$. All PIN codes consist of digits only.

Print the answers to $$$t$$$ test sets. The answer to each set should consist of a $$$n + 1$$$ lines In the first line print $$$k$$$ — the least number of changes to make all PIN codes different. In the next $$$n$$$ lines output the changed PIN codes in the order corresponding to their appearance in the input. If there are several optimal answers, print any of them.

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

main = getLine >>= test.read
test 0 = return ()
test i = do
  n <- read <$> getLine
  ps <- getPins n
  print $ sum $ subtract 1.length <$> group (sort ps)
  putStr $ unlines $ change ps
  test (i - 1)

change ps = snd <$> sortOn fst changed where
  sorted = sortOn snd $ zip [1..] ps
  grouped = groupBy (\(_, a) (_, b) -> a == b) sorted
  changed = grouped >>= (\(a:as) -> a : alter '0' as)
  alter _ [] = []
  alter c ((i, [p, q, r, s]):as) = let c' = if c == '9' then '0' else succ c in
    if elem [c, q, r, s] ps
      then if elem [p, c, r, s] ps
        then if elem [p, q, c, s] ps
          then if elem [p, q, r, c] ps
            then alter c' ((i, [p, q, r, s]):as)
            else (i, [p, q, r, c]) : alter c' as
          else (i, [p, q, c, s]) : alter c' as
        else (i, [p, c, r, s]) : alter c' as
      else (i, [c, q, r, s]) : alter c' as

getPins 0 = return []
getPins i = do
  p <- getLine
  (p:) <$> getPins (i - 1)

import Data.List
import Data.Maybe
import Control.Monad
{-solve :: [String] -> ([String],Int)
solve l = (result,howoften)
	where
		zipped=zip l [0..]
		firstelem = map (\(x,y)-> (fromJust $ elemIndex x l)==y) zipped
		--newpins=filter (\x -> not (x `elem` l)) (map show [1000..])
		--result=zipWith (\x (y,z) -> if x then y else newpins!!z) firstelem zipped
		--howoften= foldr (\x c-> if x then c else c+1) 0 firstelem
-}
{-
routine :: IO ()
routine = do
	n <- readLn
	l <- replicateM n getLine
	let (list,c)=solve l
	print c

-}
helper :: [String] -> [String] -> String -> ([String],Int)
helper total li str = if str `elem` li then (newStr:li,1) else (str:li,0)
	where
		unused = head $ filter (\x -> not (x `elem` (map head li))) $ filter (\x -> not (x `elem` (map head total))) (map (head.show) [0..9])
		newStr = (unused):(tail str)

solve :: [String] -> ([String],Int)
solve li = foldr (\str (list,count) -> let (x,y)=helper li list str in (x,y+count)) ([],0) li

routine :: IO ()
routine = do
	n <- readLn
	l <- replicateM n getLine
	let (list,c)=solve l
	print c
	forM_ list putStrLn

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

import Data.List
import Data.Maybe
import Control.Monad
{-solve :: [String] -> ([String],Int)
solve l = (result,howoften)
	where
		zipped=zip l [0..]
		firstelem = map (\(x,y)-> (fromJust $ elemIndex x l)==y) zipped
		--newpins=filter (\x -> not (x `elem` l)) (map show [1000..])
		--result=zipWith (\x (y,z) -> if x then y else newpins!!z) firstelem zipped
		--howoften= foldr (\x c-> if x then c else c+1) 0 firstelem
-}
{-
routine :: IO ()
routine = do
	n <- readLn
	l <- replicateM n getLine
	let (list,c)=solve l
	print c

-}
helper :: [String] -> String -> ([String],Int)
helper li str = if str `elem` li then (newStr:li,1) else (str:li,0)
	where
		unused = head $ filter (\x -> not (x `elem` (map head li))) (map (head.show) [0..9])
		newStr = (unused):(tail str)

solve :: [String] -> ([String],Int)
solve li = foldr (\str (list,count) -> let (x,y)=helper list str in (x,y+count)) ([],0) li

routine :: IO ()
routine = do
	n <- readLn
	l <- replicateM n getLine
	let (list,c)=solve l
	print c
	forM_ list putStrLn

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

import Data.List
import Data.Maybe
import Control.Monad
{-solve :: [String] -> ([String],Int)
solve l = (result,howoften)
	where
		zipped=zip l [0..]
		firstelem = map (\(x,y)-> (fromJust $ elemIndex x l)==y) zipped
		--newpins=filter (\x -> not (x `elem` l)) (map show [1000..])
		--result=zipWith (\x (y,z) -> if x then y else newpins!!z) firstelem zipped
		--howoften= foldr (\x c-> if x then c else c+1) 0 firstelem
-}
{-
routine :: IO ()
routine = do
	n <- readLn
	l <- replicateM n getLine
	let (list,c)=solve l
	print c

-}
helper :: [String] -> [String] -> String -> ([String],Int)
helper total li str = if str `elem` li then (newStr:li,1) else (str:li,0)
	where
		unused = head $ filter (\x -> not (x `elem` (map head total))) (map (head.show) [0..9])
		newStr = (unused):(tail str)

solve :: [String] -> ([String],Int)
solve li = foldr (\str (list,count) -> let (x,y)=helper li list str in (x,y+count)) ([],0) li

routine :: IO ()
routine = do
	n <- readLn
	l <- replicateM n getLine
	let (list,c)=solve l
	print c
	forM_ list putStrLn

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


You are given a tree consisting of $$$n$$$ vertices, and $$$m$$$ simple vertex paths. Your task is to find how many pairs of those paths intersect at exactly one vertex. More formally you have to find the number of pairs $$$(i, j)$$$ $$$(1 \leq i < j \leq m)$$$ such that $$$path_i$$$ and $$$path_j$$$ have exactly one vertex in common.

First line contains a single integer $$$n$$$ $$$(1 \leq n \leq 3 \cdot 10^5)$$$. Next $$$n - 1$$$ lines describe the tree. Each line contains two integers $$$u$$$ and $$$v$$$ $$$(1 \leq u, v \leq n)$$$ describing an edge between vertices $$$u$$$ and $$$v$$$. Next line contains a single integer $$$m$$$ $$$(1 \leq m \leq 3 \cdot 10^5)$$$. Next $$$m$$$ lines describe paths. Each line describes a path by it's two endpoints $$$u$$$ and $$$v$$$ $$$(1 \leq u, v \leq n)$$$. The given path is all the vertices on the shortest path from $$$u$$$ to $$$v$$$ (including $$$u$$$ and $$$v$$$).

Output a single integer — the number of pairs of paths that intersect at exactly one vertex.

NoteThe tree in the first example and paths look like this. Pairs $$$(1,4)$$$ and $$$(3,4)$$$ intersect at one vertex.In the second example all three paths contain the same single vertex, so all pairs $$$(1, 2)$$$, $$$(1, 3)$$$ and $$$(2, 3)$$$ intersect at one vertex.The third example is the same as the first example with two additional paths. Pairs $$$(1,4)$$$, $$$(1,5)$$$, $$$(2,5)$$$, $$$(3,4)$$$, $$$(3,5)$$$, $$$(3,6)$$$ and $$$(5,6)$$$ intersect at one vertex.

-- Hopefully this can squeak past the time limit. It may be fairly tight.

-- used to specify the internal IArray instance for stableBucketSort
{-# LANGUAGE ScopedTypeVariables #-}

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

type Graph = Array Int [Int]
type UA = UArray Int Int

data SparseTable = SparseTable (Int -> Int -> Int) (Array Int UA)

getLayerNum :: Int -> Int -> Int
getLayerNum li ri =
  max 0 $ countLeadingZeros (1 :: Int) - countLeadingZeros (xor li ri)

query :: SparseTable -> Int -> Int -> Int
query (SparseTable combiningFunc arr) li ri = let
  layer = getLayerNum li ri
  in  if  li == ri
  then  arr ! 0 ! ri
  else  combiningFunc (arr ! layer ! li) (arr ! layer ! ri)

sparseTable :: (Int -> Int -> Int) -> UA -> SparseTable
sparseTable combiningFunc arr = let
  (start, stop) = bounds arr
  maxLayer = getLayerNum start stop
  combine _ [] = []
  combine fun is@(i : js) = let
    step prev j = fun prev $ arr ! j
    in  zip is $ scanl' step (arr ! i) js
  in  SparseTable combiningFunc $ listArray (0, maxLayer) $ do
  currLayer <- [0 .. maxLayer]
  let
    currBit = bit currLayer
    recenter x = x .&. complement (currBit - 1) .|. currBit
    cstart = recenter start
    cstop  = recenter stop
  pure $ array (start, stop) $ do
    center <- [cstart, cstart + 2 * currBit .. cstop]
    let
      forwards = [max start center .. min stop (center + currBit - 1)]
      backStart = min stop (center - 1)
      backStop = max start (center - currBit)
      backwards = [backStart, backStart - 1 .. backStop]
    combine combiningFunc forwards ++ combine (flip combiningFunc) backwards

stableBucketSortOn :: forall t. (t -> Int) -> (Int, Int) -> [t] -> [t]
stableBucketSortOn fun bnds li = let
  buckets :: Array Int ([t] -> [t])
  buckets = accumArray (.) id bnds [(fun v, (:) v) | v <- li]
  in  foldr ($) [] $ elems buckets

(*!) :: Int -> Int -> Int64
infixl 7 *!
x *! y = fromIntegral x * fromIntegral y

eulerTourDFS :: Graph -> Int -> Int -> [Int] -> [Int]
-- Computes an Euler cycle on the given tree
-- The extra [Int] parameter "later" is for efficient O(1) concatenation
eulerTourDFS adj parent curr later = let
  children = [v | v <- adj ! curr, v /= parent]
  in  curr : foldr (eulerTourDFS adj curr) (parent : later) children

type PathNum = Int

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n] <- readInts
  rawEdges <- replicateM (n-1) $ do
    [u, v] <- readInts
    pure (u, v)
  let
    edges = concatMap (\(u, v) -> [(u, v), (v, u)]) rawEdges
    adj :: Graph
    adj = accumArray (flip (:)) [] (1, n) edges

    root = 1
    -- It's a bit redundant to write this rather than just
    -- tourList = eulerTourDFS adj root root []
    -- but I like not having an extra 1 at the end, and  init  is slow
    tourList = root : foldr (eulerTourDFS adj root) [] (adj ! root)
    tour :: UA
    tour = listArray (1, length tourList) tourList

    entries :: UA
    entries = accumArray min maxBound (1, n) [(v, i) | (i, v) <- assocs tour]
    exits :: UA
    exits = accumArray max minBound (1, n) [(v, i) | (i, v) <- assocs tour]
    greaterWidth x y = if  exits ! x - entries ! x >= exits ! y - entries ! y
      then  x
      else  y

    -- This sparse table is constructed in O(n log n).
    -- It can be optimized to O(n), but that's hacky and nasty.
    -- It is about 50% of runtime in my local profiling! Very oof.
    -- Every other step fits in O(n + m).
    st = sparseTable greaterWidth tour

    parent x = if  x == root
      then  Nothing
      else  Just $ tour ! (exits ! x + 1)
    children x = case  parent x  of
      Nothing   -> adj ! x
      Just parx -> filter (/= parx) $ adj ! x
    lca x y = let
      ex = exits ! x
      ey = exits ! y
      in  if  ex <= ey
      then  query st ex ey
      else  query st ey ex

  [m] <- readInts
  pathLi <- replicateM m $ do
    [u, v] <- readInts
    pure (u, v)
  let
    pathArr :: Array PathNum (Int, Int)
    pathArr = listArray (1, m) pathLi
    pathLCAs :: UArray PathNum Int
    pathLCAs = listArray (1, m) $ map (uncurry lca) pathLi

    -- find the vertices just below the LCA along each path
    sortedLCAapproaches :: Array Int [(Int, Int)]
    sortedLCAapproaches = accumArray (flip (:)) [] (1, n) $ let
      unsorted = do
        (pathNum, (x, y)) <- assocs pathArr
        let  currLCA = pathLCAs ! pathNum
        [(currLCA, (exits ! v, pathNum)) | v <- [x, y]]
      exitTimeDescending = negate . fst . snd -- descending because flip (:)
      (negStop, negStart) = bounds tour
      bnds = (negate negStart, negate negStop)
      in  stableBucketSortOn exitTimeDescending bnds unsorted
    pathLCAapproaches :: Array PathNum [Int]
    pathLCAapproaches = accumArray (flip (:)) [] (1, m) $ let
      go apps@((pathET, pathNum) : tapps) chs@(currChild : tchs)
        =  if  pathET <= exits ! currChild
        then  (pathNum, currChild) : go tapps chs
        else  go apps tchs
      go _ _ = []
      in  do
      (currLCA, approaches) <- assocs sortedLCAapproaches
      go approaches $ children currLCA

    vertexCountArray :: [Int] -> UA
    vertexCountArray = accumArray (\x _ -> x+1) 0 (1, n) . flip zip (repeat ())
    pathEndpointUses = vertexCountArray $ concatMap (\(u, v) -> [u, v]) pathLi
    pathLCAuses = vertexCountArray $ elems pathLCAs
    parentEdgeUses :: Array Int Int
    parentEdgeUses = array (1, n) $ do
      currVertex <- [1 .. n]
      let
        startVal = pathEndpointUses ! currVertex - 2 * pathLCAuses ! currVertex
        step acc v = acc + parentEdgeUses ! v
      pure (currVertex, foldl' step startVal $ children currVertex)
    vertexUses = zipWith (+) (elems pathLCAuses) (elems parentEdgeUses)
    twoAscentUses :: UA
    twoAscentUses = accumArray (+) 0 (1, n) $ assocs parentEdgeUses
      ++ zip (concat $ elems pathLCAapproaches) (repeat (0-1))
    wedges = stableBucketSortOn fst (1, n) . stableBucketSortOn snd (1, n) $ do
      [x, y] <- elems pathLCAapproaches
      pure $ if  x <= y  then  (x, y)  else  (y, x)
    wedgeUses = map length $ group wedges

    totalOptions = foldl' (\acc x -> acc + x *! (x-1)) 0
    [opts1, opts2, opts3] = map totalOptions [
      vertexUses,
      elems parentEdgeUses,
      elems twoAscentUses ++ wedgeUses
      ]
  putInt64 $ div (opts1 - 2 * opts2 + opts3) 2

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]

putInt64 :: Int64 -> SIO ()
putInt64 x = lift $ B.hPutBuilder stdout $ B.int64Dec x <> B.char7 '\n'


Alicia has an array, $$$a_1, a_2, \ldots, a_n$$$, of non-negative integers. For each $$$1 \leq i \leq n$$$, she has found a non-negative integer $$$x_i = max(0, a_1, \ldots, a_{i-1})$$$. Note that for $$$i=1$$$, $$$x_i = 0$$$.For example, if Alicia had the array $$$a = \{0, 1, 2, 0, 3\}$$$, then $$$x = \{0, 0, 1, 2, 2\}$$$.Then, she calculated an array, $$$b_1, b_2, \ldots, b_n$$$: $$$b_i = a_i - x_i$$$.For example, if Alicia had the array $$$a = \{0, 1, 2, 0, 3\}$$$, $$$b = \{0-0, 1-0, 2-1, 0-2, 3-2\} = \{0, 1, 1, -2, 1\}$$$.Alicia gives you the values $$$b_1, b_2, \ldots, b_n$$$ and asks you to restore the values $$$a_1, a_2, \ldots, a_n$$$. Can you help her solve the problem?

The first line contains one integer $$$n$$$ ($$$3 \leq n \leq 200\,000$$$) – the number of elements in Alicia's array. The next line contains $$$n$$$ integers, $$$b_1, b_2, \ldots, b_n$$$ ($$$-10^9 \leq b_i \leq 10^9$$$). It is guaranteed that for the given array $$$b$$$ there is a solution $$$a_1, a_2, \ldots, a_n$$$, for all elements of which the following is true: $$$0 \leq a_i \leq 10^9$$$.

Print $$$n$$$ integers, $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \leq a_i \leq 10^9$$$), such that if you calculate $$$x$$$ according to the statement, $$$b_1$$$ will be equal to $$$a_1 - x_1$$$, $$$b_2$$$ will be equal to $$$a_2 - x_2$$$, ..., and $$$b_n$$$ will be equal to $$$a_n - x_n$$$. It is guaranteed that there exists at least one solution for the given tests. It can be shown that the solution is unique.

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

main = do
  getLine
  bs <- map read.words <$> getLine
  let vs = solve 0 bs
  let m = minimum vs
  putStrLn $ unwords.map show $ (+ (head bs - head vs)) <$> vs

solve _ [] = []
solve a (b:bs)
  | b > 0 = (a + b) : solve (a + b) bs
  | otherwise = (a + b) : solve a bs

module Main where
import Data.List

getA :: [Int] -> [Int]
getA b = f b 0
  where f (bi:br) m = bi+m : f br (max m (bi+m))

solve :: String -> String
solve s = let ((n:_):b:_) = map (map read . words) $ lines s
              in (unwords $ map show $ take n $ getA (b ++ repeat 0)) ++ "\n"

main = interact solve

import Control.Monad
import Data.List
import Data.Ord

main = do
    getLine
    inp <- getLine
    let nums = map read $ words inp
    putStrLn $ intercalate " " $ map show $ ans 0 nums

ans :: Int -> [Int] -> [Int]
ans m [] = []
ans m (b:bs) =
  let a = b + m in
  a : ans (if b > 0 then a else m) bs

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

process n [] = []
process n (a:b) | a>=0 = (n+a): (process (n+a) b)
                | otherwise = (n+a) : (process n b)

main::IO ()
main=do
  getLine
  a<-  map read <$> words <$> getLine::IO [Integer]
  putStrLn $ intercalate " " $ map show $process  0 a

import Data.List (mapAccumL)

process :: [Int] -> [Int]
process = snd . mapAccumL (\x b -> let b' = b+x in (max x b', b')) 0

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    bs <- fmap (map readInt.words) getLine
    putStrLn.unwords.map show $ process bs


Santa has $$$n$$$ candies and he wants to gift them to $$$k$$$ kids. He wants to divide as many candies as possible between all $$$k$$$ kids. Santa can't divide one candy into parts but he is allowed to not use some candies at all.Suppose the kid who recieves the minimum number of candies has $$$a$$$ candies and the kid who recieves the maximum number of candies has $$$b$$$ candies. Then Santa will be satisfied, if the both conditions are met at the same time:  $$$b - a \le 1$$$ (it means $$$b = a$$$ or $$$b = a + 1$$$);  the number of kids who has $$$a+1$$$ candies (note that $$$a+1$$$ not necessarily equals $$$b$$$) does not exceed $$$\lfloor\frac{k}{2}\rfloor$$$ (less than or equal to $$$\lfloor\frac{k}{2}\rfloor$$$). $$$\lfloor\frac{k}{2}\rfloor$$$ is $$$k$$$ divided by $$$2$$$ and rounded down to the nearest integer. For example, if $$$k=5$$$ then $$$\lfloor\frac{k}{2}\rfloor=\lfloor\frac{5}{2}\rfloor=2$$$.Your task is to find the maximum number of candies Santa can give to kids so that he will be satisfied.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 5 \cdot 10^4$$$) — the number of test cases. The next $$$t$$$ lines describe test cases. The $$$i$$$-th test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n, k \le 10^9$$$) — the number of candies and the number of kids.

For each test case print the answer on it — the maximum number of candies Santa can give to kids so that he will be satisfied.

NoteIn the first test case, Santa can give $$$3$$$ and $$$2$$$ candies to kids. There $$$a=2, b=3,a+1=3$$$.In the second test case, Santa can give $$$5, 5, 4$$$ and $$$4$$$ candies. There $$$a=4,b=5,a+1=5$$$. The answer cannot be greater because then the number of kids with $$$5$$$ candies will be $$$3$$$.In the third test case, Santa can distribute candies in the following way: $$$[1, 2, 2, 1, 1, 2, 1]$$$. There $$$a=1,b=2,a+1=2$$$. He cannot distribute two remaining candies in a way to be satisfied.In the fourth test case, Santa can distribute candies in the following way: $$$[3, 3]$$$. There $$$a=3, b=3, a+1=4$$$. Santa distributed all $$$6$$$ candies.

import Control.Monad

import Data.Char
import Data.List

solve :: (Integer, Integer) -> Integer
solve (n, k) = k * (n `div` k) + min (k `div` 2) (n `rem` k)

main :: IO ()
main = do
    input <- getContents
    putStrLn $ unlines . map (show . solve) $ zip (a input) (b input)
    where a            = map snd . filter (odd . fst) . zip [1..] . map (read :: String -> Integer) . tail . words
          b            = map snd . filter (even . fst) . zip [1..] . map (read :: String -> Integer) . tail . words

import Control.Monad

solve :: [Int] -> Int
solve (n:k:_) = n - (max 0 $ (n `mod` k) - (k `div` 2))

main :: IO ()
main = ids >>= mapM_ (fn >=> print)
  where ids   = enumFromTo 1 . read <$> getLine
        fn tc = solve . map read . words <$> getLine

import Control.Monad

solve :: Int -> Int -> Int
solve n k = a + (min b (k `div` 2))
    where
        a = (n `div` k) * k
        b = n `mod` k

routine :: IO ()
routine = do
    [h,m] <- (map read.words) <$> getLine
    print $ solve h m

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

import Control.Monad

solve :: Int -> Int -> Int
solve n k = (q * k) + min rem (k `quot` 2)
  where
    (q, rem) = n `quotRem` k

main = do
  numCases <- read <$> getLine

  replicateM_ numCases $ do
    [n, k] <- fmap read <$> words <$> getLine
    print $ solve n k

sol :: [Int] -> Int
sol [n, k] = min n $ k * a + k `div` 2
  where a = n `div` k

main = interact (unlines . map show . map (sol . map read) . map words .  tail . lines)

import Control.Applicative
import Control.Monad

solve n k = (d * k) + (min (k `div` 2) r)
    where
        d = n `div` k
        r = n `rem` k

readInt :: String -> Integer
readInt = read

main = do
    n <- read <$> getLine
    replicateM_ n $ do
        [h, m] <- map readInt . words <$> getLine
        print $ solve h m

main :: IO ()

main = interact solve

solve :: String -> String
solve = buildup . map solver . breakdown
solver :: (Int, Int) -> Int
solver (x,y) = min (x `div` y * y + (y `div` 2)) x

breakdown :: String -> [(Int, Int)]
breakdown = map (f . words) . tail . lines
    where   f :: [String] -> (Int,Int)
            f (x:y:[]) = (read x, read y)

buildup :: [Int] -> String
buildup = unlines . map show

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

main :: IO ()

main = interact solve

solve :: String -> String
solve = buildup . map solver . breakdown
solver :: (Int, Int) -> Int
solver (x,y) = max (x `div` y * y + (y `div` 2)) x

breakdown :: String -> [(Int, Int)]
breakdown = map (f . words) . tail . lines
    where   f :: [String] -> (Int,Int)
            f (x:y:[]) = (read x, read y)

buildup :: [Int] -> String
buildup = unlines . map show

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

main :: IO ()

main = interact solve

solve :: String -> String
solve = buildup . map solver . breakdown
solver :: (Int, Int) -> Int
solver (x,y) = x `div` y * y + (y `div` 2)

breakdown :: String -> [(Int, Int)]
breakdown = map (f . words) . tail . lines
    where   f :: [String] -> (Int,Int)
            f (x:y:[]) = (read x, read y)

buildup :: [Int] -> String
buildup = unlines . map show

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

main :: IO ()

main = interact solve

solve :: String -> String
solve = buildup . map solver . breakdown
solver :: (Int, Int) -> Int
solver (x,y) = x - (( x `mod` y) `div` 2)

breakdown :: String -> [(Int, Int)]
breakdown = map (f . words) . tail . lines
    where   f :: [String] -> (Int,Int)
            f (x:y:[]) = (read x, read y)

buildup :: [Int] -> String
buildup = unlines . map show

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