A new agent called Killjoy invented a virus COVID-2069 that infects accounts on Codeforces. Each account has a rating, described by an integer (it can possibly be negative or very large).Killjoy's account is already infected and has a rating equal to $$$x$$$. Its rating is constant. There are $$$n$$$ accounts except hers, numbered from $$$1$$$ to $$$n$$$. The $$$i$$$-th account's initial rating is $$$a_i$$$. Any infected account (initially the only infected account is Killjoy's) instantly infects any uninfected account if their ratings are equal. This can happen at the beginning (before any rating changes) and after each contest. If an account is infected, it can not be healed.Contests are regularly held on Codeforces. In each contest, any of these $$$n$$$ accounts (including infected ones) can participate. Killjoy can't participate. After each contest ratings are changed this way: each participant's rating is changed by an integer, but the sum of all changes must be equal to zero. New ratings can be any integer.Find out the minimal number of contests needed to infect all accounts. You can choose which accounts will participate in each contest and how the ratings will change.It can be proven that all accounts can be infected in some finite number of contests.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 100)$$$ — the number of test cases. The next $$$2t$$$ lines contain the descriptions of all test cases. The first line of each test case contains two integers $$$n$$$ and $$$x$$$ ($$$2 \le n \le 10^3$$$, $$$-4000 \le x \le 4000$$$) — the number of accounts on Codeforces and the rating of Killjoy's account. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ $$$(-4000 \le a_i \le 4000)$$$ — the ratings of other accounts.

For each test case output the minimal number of contests needed to infect all accounts.

NoteIn the first test case it's possible to make all ratings equal to $$$69$$$. First account's rating will increase by $$$1$$$, and second account's rating will decrease by $$$1$$$, so the sum of all changes will be equal to zero.In the second test case all accounts will be instantly infected, because all ratings (including Killjoy's account's rating) are equal to $$$4$$$.

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

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ if all (== k) as then 0 else if sum as == n * k || k `elem` as then 1 else 2

import Control.Monad
main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

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

solve :: Integer -> Integer -> [Integer] -> Integer
solve n x as
  | all (==x) as = 0
  | sum as == n*x = 1
  | any (==x) as = 1
  | otherwise = 2

import Data.List
import Data.Int
import Data.Char
import Control.Monad
import Data.Bits

readArray :: IO [Int64]
readArray = do
    line <- getLine
    return $ map (read::String->Int64) $ words line

readInt :: IO Int64
readInt = do
    line <- getLine
    return $ (read::String->Int64) $ line

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

f :: Int64 -> Int64 -> Int64
f curPower xLeft =
  let s = (curPower) * (curPower - 1) `div` 2 in
  if s > xLeft then 0 else 1 + f (curPower * 2) (xLeft - s)

solve :: IO ()
solve = do
    (n:x:_) <- readArray
    a <- readArray
    let s = sum a
    let cnt = (fromIntegral::Int->Int64) $ count x a
    if cnt == n then print 0 else if cnt > 0 then print 1 else if n * x == s then print 1 else print 2

main :: IO ()
main = do
    t <- readInt
    forM_ [0..t-1] $ (\i -> solve)

import Control.Monad

solve :: Int -> [Int] -> Int
solve x as = if  all (== x) as
  then  0
  else  if  elem x as
  then  1
  else  if  sum as == x * length as -- no overflow, inputs are small
  then  1
  else  2  -- infect one account round 1, the rest round 2
           -- always possible since n >= 2

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [_n, x] <- map read . words <$> getLine
    as      <- map read . words <$> getLine
    print $ solve x as

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

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ if all (== k) as then 0 else if sum as == n * k then 1 else 2

import Control.Monad
main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

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

solve :: Integer -> Integer -> [Integer] -> Integer
solve n x as
  | all (==x) as = 0
  | sum as == n*x = 1
  | otherwise = 2

import Control.Monad
main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

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

solve :: Int -> Int -> [Int] -> Int
solve n x as
  | all (==x) as = 0
  | sum as == n*x = 1
  | otherwise = 2


The All-Berland Team Programming Contest will take place very soon. This year, teams of four are allowed to participate.There are $$$a$$$ programmers and $$$b$$$ mathematicians at Berland State University. How many maximum teams can be made if:  each team must consist of exactly $$$4$$$ students,  teams of $$$4$$$ mathematicians or $$$4$$$ programmers are unlikely to perform well, so the decision was made not to compose such teams. Thus, each team must have at least one programmer and at least one mathematician.Print the required maximum number of teams. Each person can be a member of no more than one team.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) —the number of test cases. This is followed by descriptions of $$$t$$$ sets, one per line. Each set is given by two integers $$$a$$$ and $$$b$$$ ($$$0 \le a,b \le 10^9$$$).

Print $$$t$$$ lines. Each line must contain the answer to the corresponding set of input data — the required maximum number of teams.

NoteIn the first test case of the example, two teams can be composed. One way to compose two teams is to compose two teams of $$$2$$$ programmers and $$$2$$$ mathematicians.In the second test case of the example, only one team can be composed: $$$3$$$ programmers and $$$1$$$ mathematician in the team.

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as String
import qualified Data.ByteString.Builder.Prim as Prim
import Data.ByteString.Builder
import Control.Monad
import Control.Monad.ST
--import Control.Monad.Trans.State
import Data.Array.Base
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.MArray as Vector
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import Data.Function
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe
import System.Exit

import Data.IORef
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Fail
import Control.Applicative
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (msum)
import Data.Char (isNumber, isPunctuation)

import Control.Monad.Identity (Identity(..))

printLog :: Show a => a -> a
printLog a = unsafePerformIO $ do putStrLn $ "{отладка[ "++show a ++ " ]отладка}"
                                  pure a

binSearch :: Integral i => (i -> Bool) -> i -> i -> i
binSearch f = go where
    go l h
        | l > h     = l
        | f m       = go l (m - 1)
        | otherwise = go (m + 1) h
        where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l h where (l, h) = bounds a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

fita :: IO ()
fita = do
  ~[a,b] <- readInts
  let fun x = if x > min a b then True else (a+b-2*x) `div` 2 < x
  print $ (binSearch fun (0::Int) (1000000001::Int)) - 1

main :: IO ()
main = flip replicateM_ fita =<< readLn

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as String
import qualified Data.ByteString.Builder.Prim as Prim
import Data.ByteString.Builder
import Control.Monad
import Control.Monad.ST
--import Control.Monad.Trans.State
import Data.Array.Base
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.MArray as Vector
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import Data.Function
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe
import System.Exit

import Data.IORef
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Fail
import Control.Applicative
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (msum)
import Data.Char (isNumber, isPunctuation)

import Control.Monad.Identity (Identity(..))

printLog :: Show a => a -> a
printLog a = unsafePerformIO $ do putStrLn $ "{отладка[ "++show a ++ " ]отладка}"
                                  pure a

binSearch :: Integral i => (i -> Bool) -> i -> i -> i
binSearch f = go where
    go l h
        | l > h     = l
        | f m       = go l (m - 1)
        | otherwise = go (m + 1) h
        where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l h where (l, h) = bounds a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

fita :: IO ()
fita = do
  ~[a,b] <- readInts
  print $ min ((a+b) `div` 4) (min a b)

main :: IO ()
main = flip replicateM_ fita =<< readLn

{-# LANGUAGE MultiWayIf #-}

import Control.Monad

main = do
  n <- readLn
  replicateM_ n $ do
    [p, m] <- fmap read . words <$> getLine
    print $ minimum [p, m, (p + m) `div` 4]

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

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

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC { a :: Int, b :: Int }

input :: Scanner TC
input = do
  a <- int
  b <- int
  return TC {..}

type Output = Int

output :: Output -> C.ByteString
output = showB

solve :: TC -> Output
solve TC {..} = minimum [a, b, (a + b) `div` 4]

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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


Iahub recently has learned Bubble Sort, an algorithm that is used to sort a permutation with n elements a1, a2, ..., an in ascending order. He is bored of this so simple algorithm, so he invents his own graph. The graph (let's call it G) initially has n vertices and 0 edges. During Bubble Sort execution, edges appear as described in the following algorithm (pseudocode). procedure bubbleSortGraph()    build a graph G with n vertices and 0 edges    repeat        swapped = false        for i = 1 to n - 1 inclusive do:            if a[i] > a[i + 1] then                add an undirected edge in G between a[i] and a[i + 1]                swap( a[i], a[i + 1] )                swapped = true            end if        end for    until not swapped     /* repeat the algorithm as long as swapped value is true. */ end procedureFor a graph, an independent set is a set of vertices in a graph, no two of which are adjacent (so there are no edges between vertices of an independent set). A maximum independent set is an independent set which has maximum cardinality. Given the permutation, find the size of the maximum independent set of graph G, if we use such permutation as the premutation a in procedure bubbleSortGraph.

The first line of the input contains an integer n (2 ≤ n ≤ 105). The next line contains n distinct integers a1, a2, ..., an (1 ≤ ai ≤ n).

Output a single integer — the answer to the problem.

NoteConsider the first example. Bubble sort swaps elements 3 and 1. We add edge (1, 3). Permutation is now [1, 3, 2]. Then bubble sort swaps elements 3 and 2. We add edge (2, 3). Permutation is now sorted. We have a graph with 3 vertices and 2 edges (1, 3) and (2, 3). Its maximal independent set is [1, 2].

import Data.Maybe (fromJust)
import qualified Data.Map as M
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, singleton, lookupGT, delete, insert, lookupLT)
-- import Debug.Trace (traceShow)

type Roll = Map Int Int -> [Int]

solve :: [Int] -> Int
solve a = maximum . foldr loop (`seq` []) a $ singleton minBound 0
    where
    loop :: Int -> Roll -> Roll
    loop i f m = r:f m''
        where
        r = (+1) . snd . fromJust $ i `lookupLT` m
        m' = insert i r m
        m'' = case i `lookupGT` m' of
            Nothing -> m'
            Just (k, r') -> if r < r' then m' else k `delete` m'

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = parse <$> B.getLine >>= \[n] -> parse <$> B.getLine >>= \a ->
    print $ solve a

import Data.Maybe (fromJust)
import qualified Data.Map as M
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, singleton, lookupGT, delete, insert, lookupLT)

-- longest increasing sequence (strictly so)
lis :: (Num a, Ord a, Bounded a) => [a] -> [Int]
lis a = foldr loop (`seq` []) a $ singleton minBound 0
    where
    loop :: (Num a, Ord a) => a -> (Map a Int -> [Int]) -> Map a Int -> [Int]
    loop i f m = (r:) . f $ case i `lookupGT` m' of
        Nothing -> m'
        Just (k, r') -> if r < r' then m' else k `delete` m'
        where
        r = (+1) . snd . fromJust $ i `lookupLT` m
        m' = insert i r m

solve :: [Int] -> Int
solve = maximum . lis

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = B.getLine >> parse <$> B.getLine >>= \a -> print $ solve a

import Data.Maybe (fromJust)
import qualified Data.Map as M
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, singleton, lookupGT, delete, insert, lookupLT)
-- import Debug.Trace (traceShow)

type Roll = Map Int Int -> [Int]

solve :: [Int] -> Int
solve a = maximum . foldr loop (`seq` []) a $ singleton maxBound 0
    where
    loop :: Int -> Roll -> Roll
    loop i f m = r:f m''
        where
        r = (+1) . snd . fromJust $ i `lookupGT` m
        m' = insert i r m
        m'' = case i `lookupLT` m' of
            Nothing -> m'
            Just (k, r') -> if r < r' then k `delete` m' else m'

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = parse <$> B.getLine >>= \[n] -> parse <$> B.getLine >>= \a ->
    print $ solve a


Once upon a time, Oolimry saw a suffix array. He wondered how many strings can produce this suffix array. More formally, given a suffix array of length $$$n$$$ and having an alphabet size $$$k$$$, count the number of strings that produce such a suffix array. Let $$$s$$$ be a string of length $$$n$$$. Then the $$$i$$$-th suffix of $$$s$$$ is the substring $$$s[i \ldots n-1]$$$. A suffix array is the array of integers that represent the starting indexes of all the suffixes of a given string, after the suffixes are sorted in the lexicographic order. For example, the suffix array of oolimry is $$$[3,2,4,1,0,5,6]$$$ as the array of sorted suffixes is $$$[\texttt{imry},\texttt{limry},\texttt{mry},\texttt{olimry},\texttt{oolimry},\texttt{ry},\texttt{y}]$$$. A string $$$x$$$ is lexicographically smaller than string $$$y$$$, if either $$$x$$$ is a prefix of $$$y$$$ (and $$$x\neq y$$$), or there exists such $$$i$$$ that $$$x_i < y_i$$$, and for any $$$1\leq j < i$$$ , $$$x_j = y_j$$$.

The first line contain 2 integers $$$n$$$ and $$$k$$$ ($$$1 \leq n \leq 200000,1 \leq k \leq 200000$$$) — the length of the suffix array and the alphabet size respectively. The second line contains $$$n$$$ integers $$$s_0, s_1, s_2, \ldots, s_{n-1}$$$ ($$$0 \leq s_i \leq n-1$$$) where $$$s_i$$$ is the $$$i$$$-th element of the suffix array i.e. the starting position of the $$$i$$$-th lexicographically smallest suffix. It is guaranteed that for all $$$0 \leq i< j \leq n-1$$$, $$$s_i \neq s_j$$$.

Print how many strings produce such a suffix array. Since the number can be very large, print the answer modulo $$$998244353$$$.

NoteIn the first test case, "abb" is the only possible solution. In the second test case, it can be easily shown no possible strings exist as all the letters have to be equal. In the fourth test case, one possible string is "ddbacef".Please remember to print your answers modulo $$$998244353$$$.

import Data.Maybe
import Data.Array
import qualified Data.ByteString.Char8 as C
import Data.Int

kMod :: Int
kMod = 998244353

toInt64 :: Int -> Int64
toInt64 = fromIntegral

fromInt64 :: Int64 -> Int
fromInt64 = fromIntegral

newtype Mint = Mint { mint :: Int }
  deriving (Eq, Ord)
instance Num Mint where
  (Mint a) + (Mint b) = Mint (let c = a + b in if c >= kMod then c - kMod else c)
  (Mint a) - (Mint b) = Mint a + Mint (kMod - b)
  (Mint a) * (Mint b) = Mint $ fromInt64 $ (toInt64 a * toInt64 b) `mod` (toInt64 kMod)
  fromInteger n = Mint (fromIntegral $ n `mod` fromIntegral kMod)
  abs = undefined
  signum = undefined
instance Show Mint where show = show . mint

mulInverse :: Int -> Array Int Mint
mulInverse n = a
  where a = listArray (1, n) $ 1 : [0 - Mint (kMod `div` i) * a ! (kMod `mod` i) | i <- [2..n]]

calcCombines :: Int -> Array Int Mint
calcCombines n = listArray (0, n) $ f n
  where f 0 = [1]
        f r = x * Mint (n - r + 1) * inv ! r : x : xs
          where (x : xs) = f (r - 1)
        inv = mulInverse n

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

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

main :: IO ()
main = do
  [n, k] <- getInts
  xs <- getInts
  let rk = array (0, n) $ (n, 0) : zip xs [1..] :: Array Int Int
      m = (+1) $ length $ filter id $ zipWith (\x y -> rk ! (x + 1) > rk ! (y + 1)) xs $ tail xs
      r = n - m
      c1 = calcCombines r
      c2 = calcCombines k
      result = sum $ 0 : [c1 ! i * c2 ! (m + i) | i <- [0 .. min r (k - m)]]
  print result


The elections in which three candidates participated have recently ended. The first candidate received $$$a$$$ votes, the second one received $$$b$$$ votes, the third one received $$$c$$$ votes. For each candidate, solve the following problem: how many votes should be added to this candidate so that he wins the election (i.e. the number of votes for this candidate was strictly greater than the number of votes for any other candidate)?Please note that for each candidate it is necessary to solve this problem independently, i.e. the added votes for any candidate do not affect the calculations when getting the answer for the other two candidates.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of one line containing three integers $$$a$$$, $$$b$$$, and $$$c$$$ ($$$0 \le a,b,c \le 10^9$$$).

For each test case, output in a separate line three integers $$$A$$$, $$$B$$$, and $$$C$$$ ($$$A, B, C \ge 0$$$) separated by spaces — the answers to the problem for the first, second, and third candidate, respectively.

import Data.Function (on)
import Data.List

yesNo False = "NO"
yesNo True = "YES"

readInt :: String -> Int
readInt = read

solve_task :: String -> String
solve_task line = let votes = map readInt $ words line
                      maxs = map (\x -> maximum $ delete x votes) votes
                      in unwords . map show $ zipWith (\m v -> max 0 (m-v+1)) maxs votes

solve_tasks (t:tasks) = map solve_task tasks

solve = unlines . solve_tasks . lines

main = interact solve

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

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

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC { xs :: [Int] }

input :: Scanner TC
input = do
  xs <- 3 >< int
  return TC{..}

output = map show >>> unwords >>> C.pack

solve :: TC -> [Int]
solve TC{..} = zipWith extra xs [max b c, max a c, max a b]
  where
    [a, b, c] = xs
    extra u v = max (v + 1 - u) 0

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

import Control.Monad

calc :: Int -> Int -> Int -> Int
calc max_votes extra curr = if curr < max_votes then max_votes - curr + 1 else extra

calcVotes :: (Int, Int, Int) -> (Int, Int, Int)
calcVotes (a, b, c) =
    let max_votes = a `max` b `max` c
        l = [a, b, c]
        is_maxs = map (== max_votes) l
        counts = foldr (\b -> \i -> if b then i + 1 else i) 0 is_maxs
        extra = if counts > 1 then 1 else 0
        calc' = calc max_votes extra
     in (calc' a, calc' b, calc' c)

getInputs :: IO (Int, Int, Int)
getInputs = do
    inputLine <- getLine
    let inputs = words inputLine
        a = read (inputs !! 0) :: Int
        b = read (inputs !! 1) :: Int
        c = read (inputs !! 2) :: Int
     in return (a, b, c)

output :: (Int, Int, Int) -> IO()
output (a, b, c) = do
    putStrLn (show a ++ " " ++ show b ++ " " ++ show c)

main :: IO [()]
main = do
    num_of_inputs <- getLine
    list_of_inputs <- replicateM (read (num_of_inputs) :: Int) getInputs
    let ans = map calcVotes list_of_inputs
     in traverse output ans

main = do
    t <- read <$> getLine :: IO Int
    mapM_ solve [1..t]

solve :: Int -> IO ()
solve _ = do
    [a, b, c] <- map read . words <$> getLine :: IO [Int]
    putStrLn $ let x = max 0 (max b c + 1 - a)
                   y = max 0 (max a c + 1 - b)
                   z = max 0 (max a b + 1 - c)
                in show x ++ " " ++ show y ++ " " ++ show z

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    nums@[_a,_b,_c] <- map read <$> words <$> getLine   :: IO [Int]
    return nums

solve xs = intercalate " " . map show . map (f is) $ is
  where
    is = zip [1::Int ..] xs

f is (i,v) = uncurry extra . (,) v . (+1) . maximum . map snd . filter ((/=i).fst) $ is

extra have need | (have < need) = need - have | otherwise = 0

import Control.Monad (replicateM_, forM_, forM)
import Control.Applicative ()

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

solve = do
    [a, b, c] <- nextList
    let ans = show <$> [max 0 $ (max b c + 1) - a, max 0 $ (max a c + 1) - b, max 0 $ (max a b + 1) - c]
    putStrLn $ unwords ans
    return ()

main = do
    [t] <- nextList
    replicateM_ t solve


John Doe started thinking about graphs. After some thought he decided that he wants to paint an undirected graph, containing exactly k cycles of length 3. A cycle of length 3 is an unordered group of three distinct graph vertices a, b and c, such that each pair of them is connected by a graph edge. John has been painting for long, but he has not been a success. Help him find such graph. Note that the number of vertices there shouldn't exceed 100, or else John will have problems painting it.

A single line contains an integer k (1 ≤ k ≤ 105) — the number of cycles of length 3 in the required graph.

In the first line print integer n (3 ≤ n ≤ 100) — the number of vertices in the found graph. In each of next n lines print n characters "0" and "1": the i-th character of the j-th line should equal "0", if vertices i and j do not have an edge between them, otherwise it should equal "1". Note that as the required graph is undirected, the i-th character of the j-th line must equal the j-th character of the i-th line. The graph shouldn't contain self-loops, so the i-th character of the i-th line must equal "0" for all i.

{-# language TupleSections #-}

module Main where

import Control.Monad
import Data.Array

import Debug.Trace

m = 100

type A = Array (Int,Int) Int
type Pos = (Int,Int)

decompose :: Int -> [Int]
decompose 0 = []
decompose n = x : decompose (n - pyth x)
  where
    x = opt pyth n

opt f x = length $ takeWhile (<=x) $ map f [1..]

pyth x = (x*(x-1))       `div` 2
ntr  x = ((x-2)*(x-1)*x) `div` 6

connectionEdges nfill nedges level
  | nfill < nedges = error "Not enought"
  | otherwise      = rev $
                     take nedges $
                     zip [1..] (repeat level)
  where
    rev l = l ++ map (\(x,y) -> (y,x)) l

solve :: Int -> Array (Int,Int) Int
solve n = arr'
  where
    nfill = opt ntr n
    rest  = n - ntr nfill
    arr   = array ((1,1),(m,m)) $
            [((i,j),0) | i <- [1..m], j <- [1..m]]
    fillEdges = map (,1)
                [ (x,y) | x <- [1..nfill], y <- [1..nfill], x/=y ]
    restEdges = map (,1) $
                concatMap (uncurry $ connectionEdges nfill) $
                zip (decompose rest) [m,m-1..0]
    arr' = arr // (fillEdges ++ restEdges)

showArr arr = unlines $ map row rows
  where
    ((i,j),(a,b)) = bounds arr
    rows = [i..a]
    cols = [j..b]
    row i = concat $ map show [arr ! (i,v) | v <- cols]

main = do
  n <- readLn
  print m
  putStrLn $ showArr (solve n)

import Control.Applicative
import Data.List

full2 :: Int -> Int
full2 x = (x * (x - 1)) `div` 2

full3 :: Int -> Int
full3 x = (x * (x - 1) * (x - 2)) `div` 6

findBase :: Int -> Int
findBase n = (head $ dropWhile (\x -> full3 x <= n) [1..]) - 1

toP2SumGreedy :: Int -> Int -> [Int]
toP2SumGreedy b n = toP2SumGreedy' n [b, b-1 .. 2]  where
    toP2SumGreedy' 0 _ = []
    toP2SumGreedy' n arr@(x:xs) = let f2x = full2 x in if n >= f2x
        then x:toP2SumGreedy' (n - f2x) arr
        else toP2SumGreedy' n xs

clique :: Int -> [(Int, Int)]
clique n = [(i, j) | i <- [0..n-1], j <- [i+1..n-1]]

newVertex :: Int -> Int -> [(Int, Int)]
newVertex id cnt = [(i, id) | i <- [0..cnt-1]]

toString :: Int -> Int -> [Int] -> String
toString n now xs
        | n == now = []
        | null xs = '0':toString n (now+1) []
        | head xs == now = '1':(toString n (now + 1) $ tail xs)
        | head xs > now = '0':toString n (now + 1) xs
        | head xs < now = toString n now $ tail xs

verticesFrom :: [(Int, Int)] -> Int -> [Int]
--verticesFrom edges v = [i | (v, i) <- edges] ++ [i | (i, v) <- edges]
verticesFrom [] v = []
verticesFrom ((x,y):xs) v
    | x == v = y:verticesFrom xs v
    | y == v = x:verticesFrom xs v
    | otherwise = verticesFrom xs v

buildRow :: Int -> [(Int, Int)] -> Int -> String
buildRow n edges v = toString n 0 $ sort $ verticesFrom edges v

toAdgMatrix :: [(Int, Int)] -> [String]
toAdgMatrix edges = res where
    n = 1 + max (maximum $ map fst edges) (maximum $ map snd edges)
    res = [buildRow n edges i | i <- [0..n-1]]

solve :: Int -> [String]
solve n = toAdgMatrix edges where
    b = findBase n
    restCnts = toP2SumGreedy b $ n - full3 b
    edges :: [(Int, Int)]
    edges = clique b ++ (concat $ map (\(id, cnt) -> newVertex id cnt) $ zip [b..] restCnts)

main = do
    n <- read <$> getLine
    let ans = solve n
    print $ length ans
    putStrLn $ concatMap (++"\n") ans


You still have partial information about the score during the historic football match. You are given a set of pairs $$$(a_i, b_i)$$$, indicating that at some point during the match the score was "$$$a_i$$$: $$$b_i$$$". It is known that if the current score is «$$$x$$$:$$$y$$$», then after the goal it will change to "$$$x+1$$$:$$$y$$$" or "$$$x$$$:$$$y+1$$$". What is the largest number of times a draw could appear on the scoreboard?The pairs "$$$a_i$$$:$$$b_i$$$" are given in chronological order (time increases), but you are given score only for some moments of time. The last pair corresponds to the end of the match.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10000$$$) — the number of known moments in the match. Each of the next $$$n$$$ lines contains integers $$$a_i$$$ and $$$b_i$$$ ($$$0 \le a_i, b_i \le 10^9$$$), denoting the score of the match at that moment (that is, the number of goals by the first team and the number of goals by the second team). All moments are given in chronological order, that is, sequences $$$x_i$$$ and $$$y_j$$$ are non-decreasing. The last score denotes the final result of the match.

Print the maximum number of moments of time, during which the score was a draw. The starting moment of the match (with a score 0:0) is also counted.

NoteIn the example one of the possible score sequences leading to the maximum number of draws is as follows: 0:0, 1:0, 2:0, 2:1, 3:1, 3:2, 3:3, 3:4.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = do
	n <- readInt
	[ as, bs ] <- transpose <$> replicateM n readInts
	print $ sum $ map ( uncurry subtract ) $ merge $ solve (0:as) (0:bs)

solve [_] _ = []
solve (a1:a2:as) (b1:b2:bs) = if p < q then ( p, q ) : r else r
	where
		p = max a1 b1
		q = min a2 b2 + 1
		r = solve (a2:as) (b2:bs)

merge [] = []
merge [a] = [a]
merge ( (a1,b1) : ( a2, b2 ) : rest )
	| a2 <= b1 = merge ( ( a1, b2 ) :  rest )
	| otherwise = ( a1, b1 ) : merge ( ( a2, b2 ) : rest )

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe

solve [_] = []
solve ([a,b]:x@[c,d]:xs) = y : rest
    where
        rest = solve $ x : xs
        e = min c d
        y = if a == b then e - a
            else if a < b && b <= e then e - b + 1
            else if a > b && a <= e then e - a + 1
            else 0

readInts = map (fst . fromJust . B.readInt) . B.words <$> B.getLine

main = do
    n <- readLn
    xs <- replicateM n $ readInts
    print . (+1) . sum . solve $ [0,0] : xs

import Control.Monad

solve [_] = []
solve ([a,b]:x@[c,d]:xs) = y : rest
    where
        rest = solve $ x : xs
        e = min c d
        y = if a == b then e - a
            else if a < b && b <= e then e - b + 1
            else if a > b && a <= e then e - a + 1
            else 0

--readInts = do
--    [a,b] <- (map read . words) <$> getLine
--    return (a,b)

main = do
    n <- readLn
    xs <- replicateM n $ (map read . words) <$> getLine
    print . (+1) . sum . solve $ [0,0] : xs

import Control.Monad

solve [_] = []
solve ((a,b):(c,d):xs) = x : rest
    where
        rest = solve $ (c,d) : xs
        e = min c d
        x = if a == b then e - a
            else if a < b && b <= e then e - b + 1
            else if a > b && a <= e then e - a + 1
            else 0

readInts :: IO ((Int,Int))
readInts = do
    [a,b] <- (map read . words) <$> getLine
    return (a,b)

main = do
    n <- readLn
    xs <- (:) (0,0) <$> replicateM n readInts
    print . (+1) . sum $ solve xs

calculate :: Int -> Int -> Int -> [[Int]] -> Int
calculate ans c d ([a,b]:xs)
    | c == d = calculate (ans + e - c) a b xs
    | c <  d && d <= e = calculate (ans + e - d + 1) a b xs
    | c >  d && c <= e = calculate (ans + e - c + 1) a b xs
    | otherwise = calculate ans a b xs
        where e = min a b
calculate ans c d [] = ans
main = do
    _ <- getLine
    interact $ show . calculate 1 0 0 . map (map read . words) . lines

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import qualified Data.ByteString.Char8 as B

import Data.Maybe
import Data.List

solve [_] _ = []
solve (a:c:xs) (b:d:ys) = ans : rest
    where
        rest = solve (c:xs) (d:ys)
        e = min c d
        ans = if a == b then e - a
              else if a < b && b <= e then e - b + 1
              else if a > b && a <= e then e - a + 1
              else 0

readInts = map (fst . fromJust . B.readInt) . B.words <$> B.getLine

main = do
    n <- readLn
    [as,bs] <- transpose <$> replicateM n readInts
    print . (+1) . sum $ solve (0:as) (0:bs)

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = do
	n <- readInt
	[ as, bs ] <- transpose . map head . group <$> replicateM n readInts
	print $ sum $ map ( uncurry subtract ) $ merge $ solve (0:as) (0:bs)
	print $ solve (0:as) (0:bs)

solve [_] _ = []
solve (a1:a2:as) (b1:b2:bs) = if p <= q then ( p, q ) : r else r
	where
		p = max a1 b1
		q = min a2 b2 + 1
		r = solve (a2:as) (b2:bs)

merge [] = []
merge [a] = [a]
merge ( (a1,b1) : ( a2, b2 ) : rest )
	| a2 <= b1 = ( a1, b2 ) : merge  rest
	| otherwise = ( a1, b1 ) : merge ( ( a2, b2 ) : rest )

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = do
	n <- readInt
	[ as, bs ] <- transpose . map head . group <$> replicateM n readInts
	print $ sum $ map ( uncurry subtract ) $ merge $ solve (0:as) (0:bs)

solve [_] _ = []
solve (a1:a2:as) (b1:b2:bs) = ( max a1 b1, min a2 b2 + 1 ) : solve (a2:as) (b2:bs)

merge [] = []
merge [a] = [a]
merge ( (a1,b1) : ( a2, b2 ) : rest )
	| a2 <= b1 = ( a1, b2 ) : merge  rest
	| otherwise = ( a1, b1 ) : merge ( ( a2, b2 ) : rest )

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = do
	n <- readInt
	[ as, bs ] <- transpose . map head . group <$> replicateM n readInts
	print $ solve (0:as) (0:bs)

solve [_] _ = 0
solve (a1:a2:as) (b1:b2:bs) = let d = min a2 b2 - max a1 b1 in max 0 ( d + 1 ) + solve (a2:as) (b2:bs)

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = do
	n <- readInt
	[ as, bs ] <- transpose . map head . group <$> replicateM n readInts
	print $ sum $ map ( uncurry subtract ) $ merge $ solve (0:as) (0:bs)

solve [_] _ = []
solve (a1:a2:as) (b1:b2:bs) = if p <= q then ( p, q ) : r else r
	where
		p = max a1 b1
		q = min a2 b2 + 1
		r = solve (a2:as) (b2:bs)

merge [] = []
merge [a] = [a]
merge ( (a1,b1) : ( a2, b2 ) : rest )
	| a2 <= b1 = ( a1, b2 ) : merge  rest
	| otherwise = ( a1, b1 ) : merge ( ( a2, b2 ) : rest )


You are given a system of pipes. It consists of two rows, each row consists of $$$n$$$ pipes. The top left pipe has the coordinates $$$(1, 1)$$$ and the bottom right — $$$(2, n)$$$.There are six types of pipes: two types of straight pipes and four types of curved pipes. Here are the examples of all six types:  Types of pipes You can turn each of the given pipes $$$90$$$ degrees clockwise or counterclockwise arbitrary (possibly, zero) number of times (so the types $$$1$$$ and $$$2$$$ can become each other and types $$$3, 4, 5, 6$$$ can become each other).You want to turn some pipes in a way that the water flow can start at $$$(1, 0)$$$ (to the left of the top left pipe), move to the pipe at $$$(1, 1)$$$, flow somehow by connected pipes to the pipe at $$$(2, n)$$$ and flow right to $$$(2, n + 1)$$$.Pipes are connected if they are adjacent in the system and their ends are connected. Here are examples of connected pipes:  Examples of connected pipes Let's describe the problem using some example:  The first example input And its solution is below:   The first example answer As you can see, the water flow is the poorly drawn blue line. To obtain the answer, we need to turn the pipe at $$$(1, 2)$$$ $$$90$$$ degrees clockwise, the pipe at $$$(2, 3)$$$ $$$90$$$ degrees, the pipe at $$$(1, 6)$$$ $$$90$$$ degrees, the pipe at $$$(1, 7)$$$ $$$180$$$ degrees and the pipe at $$$(2, 7)$$$ $$$180$$$ degrees. Then the flow of water can reach $$$(2, n + 1)$$$ from $$$(1, 0)$$$.You have to answer $$$q$$$ independent queries.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 10^4$$$) — the number of queries. Then $$$q$$$ queries follow. Each query consists of exactly three lines. The first line of the query contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of pipes in each row. The next two lines contain a description of the first and the second rows correspondingly. Each row description consists of $$$n$$$ digits from $$$1$$$ to $$$6$$$ without any whitespaces between them, each digit corresponds to the type of pipe in the corresponding cell. See the problem statement to understand which digits correspond to which types of pipes. It is guaranteed that the sum of $$$n$$$ over all queries does not exceed $$$2 \cdot 10^5$$$.

For the $$$i$$$-th query print the answer for it — "YES" (without quotes) if it is possible to turn some pipes in a way that the water flow can reach $$$(2, n + 1)$$$ from $$$(1, 0)$$$, and "NO" otherwise.

NoteThe first query from the example is described in the problem statement.

import Data.Char (isDigit)
import Data.Set (Set)
import qualified Data.Set as Set

inputNum = do
  line <- getLine
  return ((read line) :: Int)

inputArr = do
  line <- getLine
  let ar = ((map (\x -> read [x]) line) :: [Int])
  return ar

solve3 (_, b) [] [] = b
solve3 (p1, p2) (a:r1) (b:r2) = solve3 (newp1, newp2) r1 r2
  where newp1 = (p1 && (a==1)) || (p2 && (a==2) && (b==2))
        newp2 = (p2 && (b==1)) || (p1 && (a==2) && (b==2))

solve = do
  n <- inputNum
  r1 <- inputArr
  r2 <- inputArr
  let f x = map (\z -> if z<3 then 1 else 2) x
  let pos = solve3 (True, False) (f r1) (f r2)
  putStrLn (if pos then "YES" else "NO")

solveCases 0 = return ()
solveCases q = do
  solve
  solveCases (q-1)

main = do
  q <- inputNum
  solveCases q

import Data.List
import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    getLine
    [r1,r2] <- replicateM 2 getLine
    putStrLn $ if snd (foldl' adv (True,False) (zip r1 r2))
               then "YES"
               else "NO"
adv (fu,fd) (pu,pd) = (pu',pd') where
  pu' = fu && straight pu || fd && bent pu && bent pd
  pd' = fd && straight pd || fu && bent pu && bent pd
straight x = x <= '2'
bent x = x >= '3'

import Prelude hiding (Left, Right)
import Data.List (transpose)
import Control.Monad

data Pipe = Straight | Bent
  deriving (Show, Eq)

data Direction = Up | Left | Right
  deriving (Show, Eq)
data Pos = Lefty | Righty
  deriving (Show, Eq)

numToPipe :: Int -> Pipe
numToPipe x
  | x `elem` [1..2] = Straight
  | x `elem` [3..6] = Bent

canReach :: [[Pipe]] -> Bool
canReach pipes = solve Up Lefty pipes
  where
    solve :: Direction -> Pos -> [[Pipe]] -> Bool
    solve from currPos [] = currPos == Righty
    solve from currPos allPipes@([left, right]:rest)
      | from /= Up && currPipe == Straight = False
      | from /= Up && currPipe == Bent =
          solve Up currPos rest
      | from == Up = if currPipe == Straight then
          solve Up currPos rest
        else
          let comingFrom = if currPos == Lefty then Left else Right in
            solve comingFrom otherPipe allPipes
      where currPipe = if currPos == Lefty then left else right
            otherPipe = if currPos == Lefty then Righty else Lefty

main = do
  q <- read <$> getLine
  replicateM q $ do
    numPipes <- read <$> getLine :: IO Int
    rows <- transpose <$> replicateM 2 (fmap (numToPipe . read . (:[])) <$> getLine)
    putStrLn $
      if canReach rows then
        "YES"
      else
        "NO"
    return ()

import Data.List

boolToAns :: Bool -> String
boolToAns x = if (x == True) then "YES" else "NO"

getPipeType :: Integer -> Integer
getPipeType x = if (x < 3) then 1 else 2

getAnswer :: Integer -> Integer -> String -> String -> Bool
getAnswer n position string1 string2 =
    do
        if (n == 0 && position == 2) then True
        else if (n == 0) then False
        else if (position == 1 && (getPipeType (read [head string1] :: Integer)) == 1)
            then getAnswer (n - 1) position (drop 1 string1) (drop 1 string2)
        else if (position == 1 && (getPipeType (read [head string1] :: Integer)) == 2)
            then if ((getPipeType (read [head string2] :: Integer)) == 2) then getAnswer (n - 1) 2 (drop 1 string1) (drop 1 string2)
                                                                          else False
        else if (position == 2 && (getPipeType (read [head string2] :: Integer)) == 1)
            then getAnswer (n - 1) position (drop 1 string1) (drop 1 string2)
        else if (position == 2 && (getPipeType (read [head string2] :: Integer)) == 2)
            then if ((getPipeType (read [head string1] :: Integer)) == 2) then getAnswer (n - 1) 1 (drop 1 string1) (drop 1 string2)
                                                                          else False
        else True -- Theoretically it never enters in this else

--solver :: Integer
solver 0 = return ()
solver t =
    do
        line <- getLine
        let n = read line :: Integer
        string1 <- getLine
        string2 <- getLine
        --let ans = getAnswer n 1 string1 string2
        putStrLn (boolToAns (getAnswer n 1 string1 string2))
        solver (t-1)

main = do
    line <- getLine
    let t = read line :: Integer
    solver t

import Data.Char (isDigit)
import Data.Set (Set)
import qualified Data.Set as Set

inputNum = do
  line <- getLine
  return (read line)

inputArr = do
  line <- getLine
  let newL = filter isDigit line
  let ar = ((map (\x -> read [x]) newL) :: [Int])
  return ar

solve3 (_, b) [] [] = b
solve3 (p1, p2) (a:r1) (b:r2) = solve3 (newp1, newp2) r1 r2
  where newp1 = (p1 && (a==1)) || (p2 && (a==2) && (b==2))
        newp2 = (p2 && (a==1)) || (p1 && (a==2) && (b==2))

solve = do
  n <- inputNum
  r1 <- inputArr
  r2 <- inputArr
  let f x = map (\z -> if z<3 then 1 else 2) x
  let pos = solve3 (True, False) (f r1) (f r2)
  putStrLn (if pos then "YES" else "NO")

solveCases 0 = return ()
solveCases q = do
  solve
  solveCases (q-1)

main = do
  q <- inputNum
  solveCases q


Lunar New Year is approaching, and you bought a matrix with lots of "crosses".This matrix $$$M$$$ of size $$$n \times n$$$ contains only 'X' and '.' (without quotes). The element in the $$$i$$$-th row and the $$$j$$$-th column $$$(i, j)$$$ is defined as $$$M(i, j)$$$, where $$$1 \leq i, j \leq n$$$. We define a cross appearing in the $$$i$$$-th row and the $$$j$$$-th column ($$$1 < i, j < n$$$) if and only if $$$M(i, j) = M(i - 1, j - 1) = M(i - 1, j + 1) = M(i + 1, j - 1) = M(i + 1, j + 1) = $$$ 'X'.The following figure illustrates a cross appearing at position $$$(2, 2)$$$ in a $$$3 \times 3$$$ matrix. X.X.X.X.X Your task is to find out the number of crosses in the given matrix $$$M$$$. Two crosses are different if and only if they appear in different rows or columns.

The first line contains only one positive integer $$$n$$$ ($$$1 \leq n \leq 500$$$), denoting the size of the matrix $$$M$$$. The following $$$n$$$ lines illustrate the matrix $$$M$$$. Each line contains exactly $$$n$$$ characters, each of them is 'X' or '.'. The $$$j$$$-th element in the $$$i$$$-th line represents $$$M(i, j)$$$, where $$$1 \leq i, j \leq n$$$.

Output a single line containing only one integer number $$$k$$$ — the number of crosses in the given matrix $$$M$$$.

NoteIn the first sample, a cross appears at $$$(3, 3)$$$, so the answer is $$$1$$$.In the second sample, no crosses appear since $$$n < 3$$$, so the answer is $$$0$$$.In the third sample, crosses appear at $$$(3, 2)$$$, $$$(3, 4)$$$, $$$(4, 3)$$$, $$$(4, 5)$$$, so the answer is $$$4$$$.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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

main :: IO ()
main = do
  k <- read <$> getLine
  cs <- take (k*k) . map (=='X') . filter (`elem` ".X") <$> getContents
  let arr = A.listArray ((1,1),(k,k)) cs :: UArray (Int,Int) Bool
  print $ length $ [() | i <- [2..k-1], j <- [2..k-1],
                         and $ map (arr A.!)
                          $ (i,j):[(i+u,j+v)| u<-[1,-1], v<-[1,-1]]]

import Data.Array
main = do
  n <- readLn
  g <- listArray ((1,1),(n,n)) . concat . lines <$> getContents
  let cross (i,j) = i > 1 && i < n && j > 1 && j < n &&
        map (g!) [(i-1,j-1),(i-1,j+1),(i,j),(i+1,j-1),(i+1,j+1)] == "XXXXX"
  print $ length $ filter cross $ indices g

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

onecase n a (a1,a2)  		| a1==1 || a1==x || a2==1 || a2==x =0
                                | all (== 'X') [a!(a1,a2),a!(a1-1,a2-1),a!(a1-1,a2+1),a!(a1+1,a2-1),a!(a1+1,a2+1)]=1
                   	| otherwise =0
	where ((x1,y1),(x,y)) = bounds a
main = do
		n<- read<$> getLine ::IO Int
		a1<- concat <$> replicateM n getLine::IO [Char]
		let a = listArray ((1,1),(n,n)) a1
		print $ sum $ map (onecase n a)  [( a1,a2)|a1<-[1..n],a2<-[1..n]]

import Data.Array (listArray, (!))

process :: [[Char]] -> Int
process mat = sum [check (i,j) | i <- [2..(n-1)], j <- [2..(n-1)]]
    where
        n = length mat
        mat' = listArray ((1,1),(n,n)) $ concat mat
        check (i,j)
            | mat' ! (i,j) == 'X'
            && mat' ! (i-1,j-1) == 'X'
            && mat' ! (i-1,j+1) == 'X'
            && mat' ! (i+1,j-1) == 'X'
            && mat' ! (i+1,j+1) == 'X'= 1
            | otherwise = 0

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    mat <- fmap lines getContents
    print $ process mat

import Data.Array
main = do
  n <- readLn
  g <- listArray ((1,1),(n,n)) . concat . lines <$> getContents
  let cross (i,j) = i > 1 && i < n && j > 1 && j < n &&
        map (g!) [(i-1,j-1),(i-1,j+1),(i,j),(i+1,j-1),(i+1,j+1)] == "xxxxx"
  print $ length $ filter cross $ indices g

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

onecase n a i  		| any (<x)  [i-n-1,i-n+1]=0
			| any (>y)  [i+n+1,i+n-1]=0
                        | all (== 'X') [a!i,a!(i-n-1),a!(i-n+1),a!(i+n+1),a!(i+n-1)]=1
                   	| otherwise =0
	where (x,y) = bounds a
main = do
		n<- read<$> getLine ::IO Int
		a1<- concat <$> replicateM n getLine::IO [Char]
		let a = listArray (1,n*n) a1
		print $ sum $ map (onecase n a)  [0..(n*n)-1]


Немногие знают, что сотрудники ВКонтакте могут менять цвет подсветки в куполе знаменитого Дома Зингера, где расположена штаб-квартира ВКонтакте. Для этого нужно всего лишь отправить сообщение с цветом в специальный чат «Зингер | color», а бот его распознает и сменит подсветку. При этом на время городских мероприятий смена цвета блокируется.Формально, бот обрабатывает три типа сообщений:   lock: заблокировать изменение цвета. Если оно и так заблокировано на данный момент, сообщение игнорируется.  unlock: разблокировать изменение цвета. Если оно и так разблокировано на данный момент, сообщение игнорируется.  red / orange / yellow / green / blue / indigo / violet: изменить цвет купола на заданный, если изменение цвета на данный момент не заблокировано. Вам дана история сообщений, полученных ботом, в хронологическом порядке. Считайте, что перед получением первого сообщения купол подсвечивается голубым (blue), а изменение цвета не заблокировано.Определите, какой цвет будет у купола Дома Зингера после обработки этих сообщений.

В первой строке задано одно целое число $$$n$$$ ($$$1 \le n \le 100$$$) — число сообщений, полученных ботом. В следующих $$$n$$$ строках заданы сообщения, полученные ботом, в хронологическом порядке, по одному сообщению в строке. Каждое сообщение — строка из следующего набора: lock, unlock, red, orange, yellow, green, blue, indigo, violet.

Выведите цвет купола после обработки сообщений ботом.

7
red
violet
unlock
red
orange
lock
indigo

current :: (Bool, String) -> String -> (Bool, String)
current (_, s)      "lock"   = (True, s)
current (_, s)      "unlock" = (False, s)
current (False, _)  s        = (False, s)
current a           _        = a

main = do
    n <- fmap read getLine
    cmds <- sequence (replicate n getLine)
    putStr $ snd $ foldl current (False, "blue") cmds


For an array $$$b$$$ of $$$n$$$ integers, the extreme value of this array is the minimum number of times (possibly, zero) the following operation has to be performed to make $$$b$$$ non-decreasing:   Select an index $$$i$$$ such that $$$1 \le i \le |b|$$$, where $$$|b|$$$ is the current length of $$$b$$$.  Replace $$$b_i$$$ with two elements $$$x$$$ and $$$y$$$ such that $$$x$$$ and $$$y$$$ both are positive integers and $$$x + y = b_i$$$.  This way, the array $$$b$$$ changes and the next operation is performed on this modified array. For example, if $$$b = [2, 4, 3]$$$ and index $$$2$$$ gets selected, then the possible arrays after this operation are $$$[2, \underline{1}, \underline{3}, 3]$$$, $$$[2, \underline{2}, \underline{2}, 3]$$$, or $$$[2, \underline{3}, \underline{1}, 3]$$$. And consequently, for this array, this single operation is enough to make it non-decreasing: $$$[2, 4, 3] \rightarrow [2, \underline{2}, \underline{2}, 3]$$$.It's easy to see that every array of positive integers can be made non-decreasing this way.YouKn0wWho has an array $$$a$$$ of $$$n$$$ integers. Help him find the sum of extreme values of all nonempty subarrays of $$$a$$$ modulo $$$998\,244\,353$$$. If a subarray appears in $$$a$$$ multiple times, its extreme value should be counted the number of times it appears.An array $$$d$$$ is a subarray of an array $$$c$$$ if $$$d$$$ can be obtained from $$$c$$$ by deletion of several (possibly, zero or all) elements from the beginning and several (possibly, zero or all) elements from the end.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10\,000$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$). The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^5$$$). It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$10^5$$$.

For each test case, print a single integer  — the sum of extreme values of all subarrays of $$$a$$$ modulo $$$998\,244\,353$$$.

NoteLet $$$f(l, r)$$$ denote the extreme value of $$$[a_l, a_{l+1}, \ldots, a_r]$$$.In the first test case,   $$$f(1, 3) = 3$$$, because YouKn0wWho can perform the following operations on the subarray $$$[5, 4, 3]$$$ (the newly inserted elements are underlined):$$$[5, 4, 3] \rightarrow [\underline{3}, \underline{2}, 4, 3] \rightarrow [3, 2, \underline{2}, \underline{2}, 3] \rightarrow [\underline{1}, \underline{2}, 2, 2, 2, 3]$$$; $$$f(1, 2) = 1$$$, because $$$[5, 4] \rightarrow [\underline{2}, \underline{3}, 4]$$$; $$$f(2, 3) = 1$$$, because $$$[4, 3] \rightarrow [\underline{1}, \underline{3}, 3]$$$; $$$f(1, 1) = f(2, 2) = f(3, 3) = 0$$$, because they are already non-decreasing. So the total sum of extreme values of all subarrays of $$$a = 3 + 1 + 1 + 0 + 0 + 0 = 5$$$.

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

import Control.Monad
import Data.Int
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

p :: Int
p = 998244353

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
infixl 7 *!
x *! y = fromIntegral $ fromIntegral x * fromIntegral y `rem` p64

data SizeWeightArr = SWA !Int !(UArray Int Int) !(UArray Int Int)

step :: (Int, Int, SizeWeightArr) -> Int -> (Int, Int, SizeWeightArr)
-- Add 20 lines and write in an ugly imperative style and you, too, may get AC.
step (!prefs, !acc, SWA prevCt sizes weights) x = runST $ do
  newSizes   <- newArray_ (1, prevCt + 1) :: ST s (STUArray s Int Int)
  newWeights <- newArray_ (1, prevCt + 1) :: ST s (STUArray s Int Int)
  writeArray newSizes 1 maxBound
  writeArray newWeights 1 1
  (newCt, newAcc) <- (\fun -> foldM fun (1, acc) [1 .. prevCt])
    $ \(!currCt, !nacc) !ii -> let
    currSz = sizes ! ii
    currWeight = weights ! ii
    nParts = case  quotRem x currSz  of
      (exact, 0) -> exact
      (inexact, _) -> inexact + 1
    partSizes = quot x nParts
    currCost = currWeight *! prefs *! (nParts - 1)
    in  do
    prevPartSizes <- readArray newSizes currCt
    nextCt <- case  prevPartSizes == partSizes  of
      True -> do
        prevWeight <- readArray newWeights currCt
        writeArray newWeights currCt (prevWeight +! currWeight)
        pure currCt
      False -> do
        writeArray newSizes   (currCt + 1) partSizes
        writeArray newWeights (currCt + 1) currWeight
        pure (currCt + 1)
    pure (nextCt, nacc +! currCost)
  newSWA <- liftM2 (SWA newCt) (freeze newSizes) (freeze newWeights)
  pure (prefs - 1, newAcc, newSWA)

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    let
      initSWA = SWA 1
        (array (1, 1) [(1, maxBound)])
        (array (1, 1) [(1, 1)])
      (_, ans, _) = foldl' step (n, 0, initSWA) $ reverse a
    pure $ putInts [ans]

type SP = State [P.ByteString]

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

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

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

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


The Squareland national forest is divided into equal $$$1 \times 1$$$ square plots aligned with north-south and east-west directions. Each plot can be uniquely described by integer Cartesian coordinates $$$(x, y)$$$ of its south-west corner.Three friends, Alice, Bob, and Charlie are going to buy three distinct plots of land $$$A, B, C$$$ in the forest. Initially, all plots in the forest (including the plots $$$A, B, C$$$) are covered by trees. The friends want to visit each other, so they want to clean some of the plots from trees. After cleaning, one should be able to reach any of the plots $$$A, B, C$$$ from any other one of those by moving through adjacent cleared plots. Two plots are adjacent if they share a side.    For example, $$$A=(0,0)$$$, $$$B=(1,1)$$$, $$$C=(2,2)$$$. The minimal number of plots to be cleared is $$$5$$$. One of the ways to do it is shown with the gray color. Of course, the friends don't want to strain too much. Help them find out the smallest number of plots they need to clean from trees.

The first line contains two integers $$$x_A$$$ and $$$y_A$$$ — coordinates of the plot $$$A$$$ ($$$0 \leq x_A, y_A \leq 1000$$$). The following two lines describe coordinates $$$(x_B, y_B)$$$ and $$$(x_C, y_C)$$$ of plots $$$B$$$ and $$$C$$$ respectively in the same format ($$$0 \leq x_B, y_B, x_C, y_C \leq 1000$$$). It is guaranteed that all three plots are distinct.

On the first line print a single integer $$$k$$$ — the smallest number of plots needed to be cleaned from trees. The following $$$k$$$ lines should contain coordinates of all plots needed to be cleaned. All $$$k$$$ plots should be distinct. You can output the plots in any order. If there are multiple solutions, print any of them.

NoteThe first example is shown on the picture in the legend.The second example is illustrated with the following image:

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
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

main :: IO ()
main = do
  let re = map read . words <$> getLine :: IO [Int]
  [xA,yA] <- re
  [xB,yB] <- re
  [xC,yC] <- re
  let xs = [xA,xB,xC]
      ys = [yA,yB,yC]
      xmid = sort xs !! 1
      ymid = sort ys !! 1
      xsum = sum $ map (abs . subtract xmid) xs
      ysum = sum $ map (abs . subtract ymid) ys
      routeA = route (xmid,ymid) (xA,yA)
      routeB = route (xmid,ymid) (xB,yB)
      routeC = route (xmid,ymid) (xC,yC)
  print $ xsum + ysum + 1
  mapM_ (\(x,y) -> putStrLn $ shows x $ ' ' : show y)
    $ (xmid,ymid):routeA ++ routeB ++ routeC

route :: (Int, Int) -> (Int, Int) -> [(Int, Int)]
route (x0,y0) (x1,y1) = xroute ++ yroute
  where
    xroute = map (,y0) $ case compare x0 x1 of
               EQ -> []
               LT -> [x0+1,x0+2..x1]
               GT -> [x0-1,x0-2..x1]
    yroute = map (x1,) $ case compare y0 y1 of
               EQ -> []
               LT -> [y0+1,y0+2..y1]
               GT -> [y0-1,y0-2..y1]


The USA Construction Operation (USACO) recently ordered Farmer John to arrange a row of $$$n$$$ haybale piles on the farm. The $$$i$$$-th pile contains $$$a_i$$$ haybales. However, Farmer John has just left for vacation, leaving Bessie all on her own. Every day, Bessie the naughty cow can choose to move one haybale in any pile to an adjacent pile. Formally, in one day she can choose any two indices $$$i$$$ and $$$j$$$ ($$$1 \le i, j \le n$$$) such that $$$|i-j|=1$$$ and $$$a_i>0$$$ and apply $$$a_i = a_i - 1$$$, $$$a_j = a_j + 1$$$. She may also decide to not do anything on some days because she is lazy.Bessie wants to maximize the number of haybales in pile $$$1$$$ (i.e. to maximize $$$a_1$$$), and she only has $$$d$$$ days to do so before Farmer John returns. Help her find the maximum number of haybales that may be in pile $$$1$$$ if she acts optimally!

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \le t \le 100$$$)  — the number of test cases. Next $$$2t$$$ lines contain a description of test cases  — two lines per test case. The first line of each test case contains integers $$$n$$$ and $$$d$$$ ($$$1 \le n,d \le 100$$$) — the number of haybale piles and the number of days, respectively.  The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 100$$$)  — the number of haybales in each pile.

For each test case, output one integer: the maximum number of haybales that may be in pile $$$1$$$ after $$$d$$$ days if Bessie acts optimally.

NoteIn the first test case of the sample, this is one possible way Bessie can end up with $$$3$$$ haybales in pile $$$1$$$:   On day one, move a haybale from pile $$$3$$$ to pile $$$2$$$  On day two, move a haybale from pile $$$3$$$ to pile $$$2$$$  On day three, move a haybale from pile $$$2$$$ to pile $$$1$$$  On day four, move a haybale from pile $$$2$$$ to pile $$$1$$$  On day five, do nothing  In the second test case of the sample, Bessie can do nothing on the first day and move a haybale from pile $$$2$$$ to pile $$$1$$$ on the second day.

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

main = getLine >>= test.read
test :: Integer -> IO ()
test 0 = return ()
test t = do
  (n:d:_) <- map read.words <$> getLine
  (a:as) <- map read.words <$> getLine
  print $ a + solve d as 1
  test (t - 1)

solve d _ _ | d <= 0 = 0
solve _ [] _ = 0
solve d (a:as) n = let v = min a (div d n) in v + solve (d - v * n) as (n + 1)

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

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

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

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

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

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

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

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

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

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

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

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

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

f1 :: EIO ()
f1 = do
    (n, d) <- liftM2 (,) get get
    as <- replicateM n get
    putln $ f2 as n d

f2 :: [Int] -> Int -> Int -> Int
f2 [] n d = 0
f2 (x : l) n d = f3 l d x 1

f3 :: [Int] -> Int -> Int -> Int -> Int
f3 [] d s i = s
f3 (y : l) d s i = if y < (div d i) then
                        f3 l (d - (y * i)) (s + y) (i + 1)
                    else
                        s + (div d i)

import Control.Applicative
import Control.Monad
import Data.List

process su d x | x==[] = su
	       | d< z = su
	       | y==0 = process su d (tail x)
	       | otherwise = process (su + su1)  ( d-su1*z) (tail x)

	where 	(y,z)  = head x
             	dz = div d z
		su1 = min dz y

onecase = do
		[n,d]<-map read <$> words <$> getLine ::IO [Integer]
		s<-map read <$> words <$> getLine ::IO [Integer]
		let x = zip s [0..]
		print $ process (head s) d (tail x)
main = do
		n<-read<$> getLine ::IO Int
		replicateM_ n onecase

process :: Int -> [Int] -> Int
process d xs = fst $ foldl f (head xs,d) (zip (tail xs) [1..])
    where
        f :: (Int, Int) -> (Int, Int) -> (Int, Int)
        f acc@(s,n) (x,i)
            | n <= 0 = acc
            | n <= i*x = (s+(n`div`i),0)
            | otherwise = (s+x,n-i*x)

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    [n,d] <- fmap (map readInt.words) getLine
    a <- fmap (map readInt.words) getLine
    print $ process d a
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

import Control.Applicative
import Control.Monad
import Data.List

process su d x | x==[] = su
	       | d< y = su
	       | y==0 = process su d (tail x)
	       | otherwise = process (su + su1)  ( d-su1*z) (tail x)

	where 	(y,z)  = head x
             	dz = div d z
		su1 = min dz y

onecase = do
		[n,d]<-map read <$> words <$> getLine ::IO [Integer]
		s<-map read <$> words <$> getLine ::IO [Integer]
		let x = zip s [0..]
		print $ process (head s) d (tail x)
main = do
		n<-read<$> getLine ::IO Int
		replicateM_ n onecase


Game "Minesweeper 1D" is played on a line of squares, the line's height is 1 square, the line's width is n squares. Some of the squares contain bombs. If a square doesn't contain a bomb, then it contains a number from 0 to 2 — the total number of bombs in adjacent squares.For example, the correct field to play looks like that: 001*2***101*. The cells that are marked with "*" contain bombs. Note that on the correct field the numbers represent the number of bombs in adjacent cells. For example, field 2* is not correct, because cell with value 2 must have two adjacent cells with bombs.Valera wants to make a correct field to play "Minesweeper 1D". He has already painted a squared field with width of n cells, put several bombs on the field and wrote numbers into some cells. Now he wonders how many ways to fill the remaining cells with bombs and numbers are there if we should get a correct field in the end.

The first line contains sequence of characters without spaces s1s2... sn (1 ≤ n ≤ 106), containing only characters "*", "?" and digits "0", "1" or "2". If character si equals "*", then the i-th cell of the field contains a bomb. If character si equals "?", then Valera hasn't yet decided what to put in the i-th cell. Character si, that is equal to a digit, represents the digit written in the i-th square.

Print a single integer — the number of ways Valera can fill the empty cells and get a correct field. As the answer can be rather large, print it modulo 1000000007 (109 + 7).

NoteIn the first test sample you can get the following correct fields: 001**1, 001***, 001*2*, 001*10.

{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: ByteString -> Int
solve line = case C.foldl' loop (1, 1, 0) line of
        (i, _, j) -> i +: j
    where
    a +: b = (a + b) `mod` 1000000007
    aggr (a, b, c) (i, j, k) = (a +: i, b +: j, c +: k)

    -- (0, 2, *)
    loop :: (Int, Int, Int) -> Char -> (Int, Int, Int)
    loop (i, _, _) '0' = (i, 0, 0)
    loop (i, _, k) '1' = (k, i, 0)
    loop (_, _, k) '2' = (0, k, 0)
    loop (_, j, k) '*' = (0, 0, (j + k) `mod` 1000000007)
    loop acc       '?' = foldr1 aggr $ fmap (loop acc) "012*"

main = B.init <$> B.getLine >>= print . solve

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: ByteString -> Int
solve line = case C.foldl' loop (1, 1, 0) line of
        (i, _, j) -> i +: j
    where
    (+:) !a !b = (a + b) `mod` 1000000007
    aggr (!a, !b, !c) (!i, !j, !k) = (a +: i, b +: j, c +: k)

    -- (0, 2, *)
    loop :: (Int, Int, Int) -> Char -> (Int, Int, Int)
    loop (!i, _, _)  '0' = (i, 0, 0)
    loop (!i, _, !k) '1' = (k, i, 0)
    loop (_,  _, !k) '2' = (0, k, 0)
    loop (_, !j, !k) '*' = (0, 0, j +: k)
    loop !acc        '?' = foldr1 aggr $ fmap (loop acc) "012*"

main = B.init <$> B.getLine >>= print . solve

{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: ByteString -> Int
solve line = case C.foldl loop (1, 1, 0) line of
        (i, _, j) -> i +: j
    where
    a +: b = (a + b) `mod` 1000000007
    aggr (a, b, c) (i, j, k) = (a +: i, b +: j, c +: k)

    -- (0, 2, *)
    loop :: (Int, Int, Int) -> Char -> (Int, Int, Int)
    loop (i, _, _) '0' = (i, 0, 0)
    loop (i, _, k) '1' = (k, i, 0)
    loop (_, _, k) '2' = (0, k, 0)
    loop (_, j, k) '*' = (0, 0, j +: k)
    loop acc       '?' = foldr1 aggr $ fmap (loop acc) "012*"

main = B.init <$> B.getLine >>= print . solve


Pari has a friend who loves palindrome numbers. A palindrome number is a number that reads the same forward or backward. For example 12321, 100001 and 1 are palindrome numbers, while 112 and 1021 are not.Pari is trying to love them too, but only very special and gifted people can understand the beauty behind palindrome numbers. Pari loves integers with even length (i.e. the numbers with even number of digits), so she tries to see a lot of big palindrome numbers with even length (like a 2-digit 11 or 6-digit 122221), so maybe she could see something in them.Now Pari asks you to write a program that gets a huge integer n from the input and tells what is the n-th even-length positive palindrome number?

The only line of the input contains a single integer n (1 ≤ n ≤ 10100 000).

Print the n-th even-length palindrome number.

NoteThe first 10 even-length palindrome numbers are 11, 22, 33, ... , 88, 99 and 1001.

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

main=do

    q<-     getLine
    putStrLn $ q  ++ (reverse q)

main = putStrLn . (flip (++) =<< reverse) =<< getLine

main :: IO ()
main = getLine >>=
        \x -> putStrLn $ x ++ (reverse x)

main = do
    name <- getLine
    putStrLn (name ++ (reverse name))

import Control.Monad
import Control.Applicative
import Data.List

main = do
  n <- getLine
  putStrLn $ n ++ reverse n

main = do
    n <- getLine
    putStr $ n++(reverse n)

main = interact $ (\s -> s ++ reverse s) . head . words

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

main::IO ()
main=do
  t<-  getLine
  putStr t
  putStrLn $ reverse t

main = interact $ (\x -> x ++ (reverse x)).init

main = interact $ (\x -> (++) x.reverse $ x).head.lines

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
-- Meat
solve :: String-> String
solve s= s ++ reverse s

-- Shit
main :: IO ()
main = do
        [s]  <- readShit
        printShit [solve s]

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

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

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

main :: IO()
main = do
  s <- getLine
  putStrLn (s ++ reverse s)

main :: IO ()
main = do
  s <- getLine
  putStrLn $ s ++ reverse s

main :: IO()
main = do
    s <- getLine
    putStr s
    putStrLn $ reverse s

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

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

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

main = do
  s <- getLine

  putStrLn $ s ++ reverse s

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = (solve.C.init.head=<<forM [1..1] (\i->C.getLine) )
solve xs = C.putStr $ C.append xs (C.reverse xs)

main = print . (flip (++) =<< reverse) =<< getLine

main = interact (\x -> (++) x.reverse $ x)

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = (solve.head=<<forM [1..1] (\i->C.getLine) )
solve xs = C.putStr $ C.append xs (C.reverse xs)

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

main=do

    q<-     C.getLine
    putStrLn ""
    C.putStrLn $ C.append q   (C.reverse q)
    putStrLn ""

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

main=do

    q<-     C.getLine
    C.putStrLn $ C.append q   (C.reverse q)
    putStrLn ""

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

main=do

    q<-     C.getLine
    putStrLn $ C.unpack $ C.append q   (C.reverse q)


A ticket is a string consisting of six digits. A ticket is considered lucky if the sum of the first three digits is equal to the sum of the last three digits. Given a ticket, output if it is lucky or not. Note that a ticket can have leading zeroes.

The first line of the input contains an integer $$$t$$$ ($$$1 \leq t \leq 10^3$$$) — the number of testcases. The description of each test consists of one line containing one string consisting of six digits.

Output $$$t$$$ lines, each of which contains the answer to the corresponding test case. Output "YES" if the given ticket is lucky, 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).

NoteIn the first test case, the sum of the first three digits is $$$2 + 1 + 3 = 6$$$ and the sum of the last three digits is $$$1 + 3 + 2 = 6$$$, they are equal so the answer is "YES".In the second test case, the sum of the first three digits is $$$9 + 7 + 3 = 19$$$ and the sum of the last three digits is $$$8 + 9 + 4 = 21$$$, they are not equal so the answer is "NO".In the third test case, the sum of the first three digits is $$$0 + 4 + 5 = 9$$$ and the sum of the last three digits is $$$2 + 0 + 7 = 9$$$, they are equal so the answer is "YES".

module Main where

import Data.List
import Data.Maybe

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

sep = id

parse :: String -> [Int]
parse = map (read . singleton)

singleton a = [a]

format b
  | b = "YES"
  | otherwise = "NO"

solve xs = sum head == sum tail
  where (head,tail) = splitAt 3 xs

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: String -> Bool
solve str = L.sum (L.take 3 digits) == L.sum (L.take 3 $ L.reverse digits)
    where
        digits = L.map (\c -> ord c - ord '0') str

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        s <- B8.getLine <&> L.head . B8.words
        let answer = solve $ B8.unpack s
        putsYesNo answer

import Data.List
import Data.Char

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

solve :: Int -> Int -> IO ()
solve number 0 = return ()
solve number current = 	do
				l <- getLine
				if isHappy l then putStrLn "YES" else putStrLn "NO"
				solve number (current - 1)

isHappy :: String -> Bool
isHappy line = let
					digits = map digitToInt line
					left = foldr (+) 0 $ take 3 digits
					right = foldr (+) 0 $ drop 3 digits
					in left == right

import Control.Monad (replicateM)
import Data.List (intercalate)
import Data.Char (digitToInt)

sum' :: String -> Int
sum' = sum . map digitToInt

isLucky :: String -> Bool
isLucky s = sum' (take 3 s) == sum' (drop 3 s)

sol :: [String] -> String
sol = intercalate "\n" . map (\x -> if isLucky x then "yes" else "no")

readStrs :: IO [String]
readStrs = do
  n <- read <$> getLine
  replicateM n getLine

main :: IO ()
main = do
  inp <- readStrs
  putStrLn $ sol inp

import Data.Char(digitToInt)

f :: String -> Int

f "" = 0
f s = do
    (f (take ((length s)-1) (drop 1 s))) + (digitToInt (head s))

solve 0 = return ()
solve t = do
    s <- getLine
    let v1 = take 3 s
    let v2 = take 3 (drop 3 s)
    let x = f v1
    let y = f v2
    if x==y then putStrLn "YES" else putStrLn "NO"
    solve (t-1)

main :: IO()
main = do
    line <- getLine
    let t = (read (takeWhile (/= ' ') line) :: Int)
    solve t

import Control.Monad
main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    (n1:n2:n3:n4:n5:n6:[]) <- fmap (fmap read)
                         . fmap (fmap (\x -> [x]))
                         $ getLine
    if sum [n1,n2,n3] == sum [n4,n5,n6]
    then putStrLn "YES"
    else putStrLn "NO"

import Control.Arrow ((>>>))

solve :: [Int] -> String
solve [a,b,c,d,e,f] = if (a+b+c) == (d+e+f) then "YES" else "NO"

main =
  interact $
    lines >>>
    drop 1 >>>
    map (solve . map (read . pure :: Char -> Int)) >>>
    unlines

import Control.Monad (replicateM_, replicateM)

main :: IO ()
main = read <$> getLine >>= flip replicateM_ singleCase

singleCase :: IO ()
singleCase = read <$> getLine >>= \n -> if lucky n
                                        then putStrLn "YES"
                                        else putStrLn "NO"

lucky :: Int -> Bool
lucky n = let n1 = div n 1000
              n2 = mod n 1000
          in sumDigits n1 0 == sumDigits n2 0

sumDigits :: Int -> Int -> Int
sumDigits n acc = let nd = div n 10
                      nm = mod n 10
                  in if nd == 0
                     then acc + nm
                     else sumDigits nd (acc+nm)

for :: Int -> IO ()
for 0 = pure ()
for i = do
  s <- getLine
  let arr = map (\c -> read [c] :: Int) s
  if arr !! 0 + arr !! 1 + arr !! 2 == arr !! 3 + arr !! 4 + arr !! 5
    then putStrLn "YES"
    else putStrLn "NO"
  for $ i - 1

main = do
  t <- readLn :: IO Int
  for t


Ehab has an array a of n integers. He likes the bitwise-xor operation and he likes to bother Mahmoud so he came up with a problem. He gave Mahmoud q queries. In each of them, he gave Mahmoud 2 integers l and x, and asked him to find the number of subsequences of the first l elements of the array such that their bitwise-xor sum is x. Can you help Mahmoud answer the queries?A subsequence can contain elements that are not neighboring.

The first line contains integers n and q (1 ≤ n, q ≤ 105), the number of elements in the array and the number of queries. The next line contains n integers a1, a2, ..., an (0 ≤ ai < 220), the elements of the array. The next q lines, each contains integers l and x (1 ≤ l ≤ n, 0 ≤ x < 220), representing the queries.

For each query, output its answer modulo 109 + 7 in a newline.

NoteThe bitwise-xor sum of the empty set is 0 and the bitwise-xor sum of a set containing one element is that element itself.

{-# LANGUAGE BangPatterns #-}
module Main where

import Control.Exception
import Control.Monad
import Data.Array
import Data.Bits
import Data.Functor
import Data.Monoid
import Data.Word
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString as B
import System.IO

type I = Word32

{-# INLINE lsb #-}
lsb :: I -> I
lsb b = b `xor` (b .&. (b - 1))

decomp :: I -> [I] -> I
decomp = foldr $ \x w -> if w .&. lsb x /= 0 then w `xor` x else w

double :: Int -> Int
double b = let d = b + b in if d >= p then d - p else d

updateState :: I -> ([I], Int) -> ([I], Int)
updateState w (basis, ways) = (\y -> if y /= 0 then (y:basis, ways) else (basis, double ways)) $ decomp w basis

stateArray :: [I] -> Array Int ([I], Int)
stateArray a =
    let u = array (0, length a) ((0, ([], 1)):(zipWith (\i aa -> (i, updateState aa (u ! pred i))) [1..] a)) in u

p :: Int
p = 10^9+7

readInt :: Integral a => BS.ByteString -> a
readInt = fromInteger . fst . (\(Just i) -> i) . BS.readInteger

readIntList :: IO [Int]
readIntList = (map readInt . BS.words) <$> BS.getLine

main = do
  [n, q] <- readIntList
  a <- map fromIntegral <$> readIntList
  s <- evaluate $ stateArray a
  ans <- replicateM q $ do
    [l, x] <- readIntList
    let (basis, ways) = s ! l
    return $
      (B.intDec $ if decomp (fromIntegral x) basis /= 0 then 0 else ways) <> B.char8 '\n'
  B.hPutBuilder stdout $ mconcat ans

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad
import Data.Array
import Data.Bits
import Data.Functor
import Data.Word
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS

type I = Word32

{-# INLINE lsb #-}
lsb :: I -> I
lsb b = b `xor` (b .&. (b - 1))

-- Extends the linear space, returning True if a new element is created.
extend :: [I] -> I -> [I] -> (Bool, [I])
extend _ 0 ys = (False, reverse ys)
extend [] w ys = (True, reverse (w:ys))
extend (x:xs) w ys = case compare (lsb w) (lsb x) of
  LT -> (True, reverse (w:x:xs))
  EQ -> extend xs (w `xor` x) (x:ys)
  GT -> extend xs w (x:ys)

check :: [I] -> I -> Bool
check xs 0 = False
check [] w = True
check (x:xs) w = case compare (lsb w) (lsb x) of
  LT -> True
  EQ -> check xs (w `xor` x)
  GT -> check xs w

double :: Int -> Int
double b = let d = b + b in if d >= p then d - p else d

updateState :: ([I], Int) -> I -> ([I], Int)
updateState (basis, ways) w = (\(new, bas) -> (bas, if new then ways else double ways)) $ extend basis w []

-- | A strictly accumulating version of 'scanl'
scanl'           :: (b -> a -> b) -> b -> [a] -> [b]
-- This peculiar form is needed to prevent scanl' from being rewritten
-- in its own right hand side.
scanl' = scanlGo'
  where
    scanlGo'           :: (b -> a -> b) -> b -> [a] -> [b]
    scanlGo' f !q ls    = q : (case ls of
                            []   -> []
                            x:xs -> scanlGo' f (f q x) xs)

stateArray :: [I] -> Array Int ([I], Int)
stateArray a = listArray (0, length a) $ scanl' updateState ([], 1) a

p :: Int
p = 10^9+7

readInt :: Integral a => BS.ByteString -> a
readInt = fromInteger . fst . (\(Just i) -> i) . BS.readInteger

readIntList :: IO [Int]
readIntList = (map readInt . BS.words) <$> BS.getLine

main = do
  [n, q] <- readIntList
  a <- map fromIntegral <$> readIntList
  let s = stateArray a
  replicateM_ q $ do
    [l, x] <- readIntList
    let (basis, ways) = s ! l
    if check basis (fromIntegral x) then print 0 else print ways