You have a given picture with size $$$w \times h$$$. Determine if the given picture has a single "+" shape or not. A "+" shape is described below:  A "+" shape has one center nonempty cell.  There should be some (at least one) consecutive non-empty cells in each direction (left, right, up, down) from the center. In other words, there should be a ray in each direction.  All other cells are empty. Find out if the given picture has single "+" shape.

The first line contains two integers $$$h$$$ and $$$w$$$ ($$$1 \le h$$$, $$$w \le 500$$$) — the height and width of the picture. The $$$i$$$-th of the next $$$h$$$ lines contains string $$$s_{i}$$$ of length $$$w$$$ consisting "." and "*" where "." denotes the empty space and "*" denotes the non-empty space.

If the given picture satisfies all conditions, print "YES". Otherwise, print "NO". You can output each letter in any case (upper or lower).

NoteIn the first example, the given picture contains one "+".In the second example, two vertical branches are located in a different column.In the third example, there is a dot outside of the shape.In the fourth example, the width of the two vertical branches is $$$2$$$.In the fifth example, there are two shapes.In the sixth example, there is an empty space inside of the shape.

import Data.List

main = interact $ solve . tail . lines

solve :: [String] -> String
solve board =
    let goal = length . filter (=='*') $ concat board in
    let tBoard = transpose board in
    let populatedRows = filter ((>=2) . length . filter (=='*') . (!!) board) [0..length board-1] in
    let populatedCols = filter ((>=2) . length . filter (=='*') . (!!) tBoard) [0..length tBoard-1] in
    if length populatedRows == 1 && length populatedCols == 1
    then
        let r = head populatedRows in
        let c = head populatedCols in
        if board !! r !! c == '*'
            then
                let right = length . takeWhile (=='*') $ drop (c + 1) (board !! r) in
                let left = length . takeWhile (=='*') . reverse $ take c (board !! r) in
                let up = length . takeWhile (=='*') . reverse $ take r (tBoard !! c) in
                let down = length . takeWhile (=='*') $ drop (r + 1) (tBoard !! c) in
                if right + left + up + down + 1 == goal &&
                    right >= 1 && left >= 1 &&
                    up >= 1 && down >= 1
                then "YES\n"
                else "NO\n"
        else "NO\n"
    else "NO\n"

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}
#ifndef DEBUG
{-# LANGUAGE Safe              #-}
#endif

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as C
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import qualified Data.List                  as L
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word
#ifdef DEBUG
import           Debug.Trace
#endif
import Foreign

main :: IO ()
main = do
  [h, w]<- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
  cs <- filter (not.isSpace) <$> getContents
  putStrLn.bool"NO""YES" $ solve h w cs

solve :: Int -> Int -> String -> Bool
solve _ _ cs | all (== '.') cs = False
solve h w cs = minx < x && x < maxx && miny < y && y < maxy && set == cross
  where
    xys = [quotRem ij w|(ij, '*')<-zip[0..]cs]
    !set = S.fromList xys
    !minx = minimum $ map fst xys
    !maxx = maximum $ map fst xys
    !miny = minimum $ map snd xys
    !maxy = maximum $ map snd xys
    !x = fst . head $ filter ((==miny).snd) xys
    !y = snd . head $ filter ((==minx).fst) xys
    cross = S.fromList $ map ((,) x) [miny..maxy] ++ map (flip (,) y) [minx..maxx]

import Data.List

main = interact $ solve . tail . lines

solve :: [String] -> String
solve board =
    let goal = length . filter (=='*') $ concat board in
    let tBoard = transpose board in
    let populatedRows = filter ((>=2) . length . filter (=='*') . (!!) board) [0..length board-1] in
    let populatedCols = filter ((>=2) . length . filter (=='*') . (!!) tBoard) [0..length tBoard-1] in
    if length populatedRows == 1 && length populatedCols == 1
    then
        let r = head populatedRows in
        let c = head populatedCols in
        if board !! r !! c == '*'
            then
                let right = length . takeWhile (=='*') $ drop (c + 1) (board !! r) in
                let left = length . takeWhile (=='*') . reverse $ take c (board !! r) in
                let up = length . takeWhile (=='*') . reverse $ take r (tBoard !! c) in
                let down = length . takeWhile (=='*') $ drop (r + 1) (tBoard !! c) in
                if right + left + up + down + 1 == goal
                then "YES\n"
                else "NO\n"
        else "NO\n"
    else "NO\n"


Polycarp calls an array dense if the greater of any two adjacent elements is not more than twice bigger than the smaller. More formally, for any $$$i$$$ ($$$1 \le i \le n-1$$$), this condition must be satisfied: $$$$$$\frac{\max(a[i], a[i+1])}{\min(a[i], a[i+1])} \le 2$$$$$$For example, the arrays $$$[1, 2, 3, 4, 3]$$$, $$$[1, 1, 1]$$$ and $$$[5, 10]$$$ are dense. And the arrays $$$[5, 11]$$$, $$$[1, 4, 2]$$$, $$$[6, 6, 1]$$$ are not dense.You are given an array $$$a$$$ of $$$n$$$ integers. What is the minimum number of numbers you need to add to an array to make it dense? You can insert numbers anywhere in the array. If the array is already dense, no numbers need to be added.For example, if $$$a=[4,2,10,1]$$$, then the answer is $$$5$$$, and the array itself after inserting elements into it may look like this: $$$a=[4,2,\underline{\textbf{3}},\underline{\textbf{5}},10,\underline{\textbf{6}},\underline{\textbf{4}},\underline{\textbf{2}},1]$$$ (there are other ways to build such $$$a$$$).

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$). Then $$$t$$$ test cases follow. The first line of each test case contains one integer $$$n$$$ ($$$2 \le n \le 50$$$) — the length of the array $$$a$$$. The next line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 50$$$).

For each test case, output one integer — the minimum number of numbers that must be added to the array to make it dense.

NoteThe first test case is explained in the statements.In the second test case, you can insert one element, $$$a=[1,\underline{\textbf{2}},3]$$$.In the third test case, you can insert two elements, $$$a=[6,\underline{\textbf{4}},\underline{\textbf{2}},1]$$$.In the fourth test case, you can insert one element, $$$a=[1,\underline{\textbf{2}},4,2]$$$.In the fifth test case, the array $$$a$$$ is already dense.

module Main where

import Control.Monad
import Debug.Trace

main :: IO ()
main = do
    n <- ((read :: String -> Int) <$> getLine)
    replicateM_ n action

action = do
    getLine
    arr <- (map (read :: String -> Int) . words) <$> getLine
    print (calc arr)

calc :: [Int] -> Int
calc (first:rest) = magic 0 first rest
  where
    magic res _ [] = res
    magic res prev (cur:rest) = let p = fromIntegral prev
                                    c = fromIntegral cur
                                    f = (max p c - 1) / (min p c)
                                    x = max 0.0 $ logBase 2 f
                                in magic (res + floor x) cur rest

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

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

import Data.Bits

type SIO = StateT P.ByteString IO

ceilDiv :: Int -> Int -> Int
ceilDiv n k = div (n + k - 1) k

bitFloor :: Word -> Word
bitFloor v
  | v <= 1    = v
  | otherwise = 1 + shiftR (complement 0) (countLeadingZeros v + 1)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    putInts $ pure $ foldl' (+) 0 $ do
      (prev, curr) <- zip a (tail a)
      let
        res = ceilDiv (max prev curr) (min prev curr)
        steps = if  res > 1 -- typo, extra yikes
          then  countTrailingZeros $ bitFloor $ fromIntegral $ res - 1
          else  0 -- forgot about -1, silly move
      pure $ fromIntegral steps

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

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

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

chunksOf x [] = []
chunksOf x l = take x l : chunksOf x (drop x l)

toArr = map read . words

getInput [_, s] = toArr s

teto n d = 1 + ((n - 1) `div` d)

log2 0 = 0
log2 1 = 0
log2 x = 1 + log2 (x `div` 2)

solve [] = 0
solve [_] = 0
solve (x : y : xs) = log2 (z - 1) + solve (y : xs)
    where z = max (teto x y) (teto y x)

main = interact (unlines . map (show . solve . getInput) . chunksOf 2 . tail . lines)

import Control.Monad
readFloats = fmap (map read.words) getLine :: IO [Float]

solve [x] = 0
solve (x:y:xs) = solve (y:xs) + if h <= 1 then 0 else h - 1
            where
                h = ceiling $ logBase 2 (max x y / min x y)

printResult = do
    n <- readLn :: IO Int
    a <-readFloats
    print $ solve a

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

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

import Data.Map((!))

powerTwo :: Integer -> Integer -> Integer
powerTwo x y | 2 * x >= y = 0
powerTwo x y | 2 * x < y = 1+powerTwo (2*x) y

result [] = 0
result [x] = 0
result (x:y:xs)
	| x > y = powerTwo y x + result (y:xs)
	| otherwise = powerTwo x y + result (y:xs)

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		print $ result a
		loop $ t - 1
	loop t

module Main where
import Control.Monad ( replicateM_ )

solve :: [Int] -> Int
solve xs = sum $ zipWith go xs (tail xs)
  where
    go a b = length $ takeWhile (< max a b) (tail $ iterate (*2) (min a b))

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

main :: IO ()
main = do
  n <- read <$> getLine
  replicateM_ n (getLine >> readInts >>= print . solve)

module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

--------------------------------------------------------------------------------

process :: IO ()
process = do
    getLine
    a <- getIntList
    print $ f a

f :: [Int] -> Int
f a = sum . zipWith g a $ tail a

g :: Int -> Int -> Int
g x y
    | x > y = g y x
    | x * 2 >= y = 0
    | otherwise = g (x * 2) y + 1

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Exception (assert)
import Control.Monad
import Control.Monad.State
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Bits
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = do
  n <- popInt
  as <- popInts
  return $ bshow $ solve n as

solve n as = sum $ map (uncurry f) $ adjlist as
  where
    f a b | a > b = f b a
          | otherwise = fromJust $ findIndex (\x -> b <= x) $
                        iterate' (* 2) (a * 2)

adjlist as@(_ : as') = zip as as'
adjlist _ = []

needed :: Integer -> Integer -> Integer
needed small big
  | 2 * small >= big = 0
  | otherwise        = 1 + needed (2 * small) big

solveTest :: [Integer] -> Integer
solveTest [] = 0
solveTest [_] = 0
solveTest (x:y:rest) = needed (min x y) (max x y) + solveTest (y:rest)

solve :: String -> String
solve = unlines . map solveStringTest . odds . drop 1 . lines
    where odds [] = []
          odds (_:x:xs) = x : odds xs
          solveStringTest = show . solveTest . map read . words

main :: IO ()
main = interact solve

import Control.Monad

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

readInts :: IO [Int]
readInts = readArray

readInt :: IO Int
readInt = readLn

interpolate :: Int -> Int -> Int
interpolate x y = if x > y then interpolate y x else
    if 2 * x >= y then 0 else 1 + interpolate (2 * x) y

solve :: [Int] -> Int
solve (x:y:xs) = interpolate x y + solve (y:xs)
solve _ = 0

main :: IO ()
main = readInt >>= flip replicateM_ (readInt >> fmap solve readInts >>= print)

module Main where

import Control.Monad

main :: IO ()
main = do
    n <- ((read :: String -> Int) <$> getLine)
    replicateM_ n action

action = do
    getLine
    arr <- (map (read :: String -> Int) . words) <$> getLine
    print (calc arr)

calc :: [Int] -> Int
calc (first:rest) = magic 0 first rest
  where
    magic :: Int -> Int -> [Int] -> Int
    magic res _ [] = res
    magic res prev (cur:rest) = let big = max prev cur
                                    smol = min prev cur
                                in magic (fst $ head $ dropWhile (\(_, s) -> s < big) $ iterate (\(cnt, upd) -> (cnt + 1, upd * 2)) (res - 1, smol)) cur rest

module Main where

import Control.Monad

main :: IO ()
main = do
    n <- ((read :: String -> Int) <$> getLine)
    replicateM_ n action

action = do
    getLine
    arr <- (map (read :: String -> Int) . words) <$> getLine
    print (calc arr)

calc :: [Int] -> Int
calc (first:rest) = magic 0 first rest
  where
    magic res _ [] = res
    magic res prev (cur:rest) = let p = fromIntegral prev
                                    c = fromIntegral cur
                                    f = (max p c - 1) / (min p c)
                                    x = logBase 2 f
                                in magic (res + floor x) cur rest

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

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

import Data.Bits

type SIO = StateT P.ByteString IO

ceilDiv :: Int -> Int -> Int
ceilDiv n k = div (n + k - 1) k

bitFloor :: Word -> Word
bitFloor v
  | v <= 1    = v
  | otherwise = 1 + shiftR (complement 0) (countLeadingZeros v + 1)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    putInts $ pure $ foldl' (+) 0 $ do
      (prev, curr) <- zip a (tail a)
      let
        res = ceilDiv (max prev curr) (min prev curr)
        steps = if  res > 0
          then  countTrailingZeros $ bitFloor $ fromIntegral $ res - 1
          else  0 -- forgot about -1, silly move
      pure $ fromIntegral steps

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

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

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

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

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

import Data.Bits

type SIO = StateT P.ByteString IO

ceilDiv :: Int -> Int -> Int
ceilDiv n k = div (n + k - 1) k

bitFloor :: Word -> Word
bitFloor v
  | v <= 1    = v
  | otherwise = 1 + shiftR (complement 0) (countLeadingZeros v + 1)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    putInts $ pure $ foldl' (+) 0 $ do
        (prev, curr) <- zip a (tail a)
        let
          res = ceilDiv (max prev curr) (min prev curr)
          steps = countTrailingZeros $ bitFloor $ fromIntegral $ res - 1
        pure $ fromIntegral steps

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

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

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


Alice and Bob received $$$n$$$ candies from their parents. Each candy weighs either 1 gram or 2 grams. Now they want to divide all candies among themselves fairly so that the total weight of Alice's candies is equal to the total weight of Bob's candies.Check if they can do that.Note that candies are not allowed to be cut in half.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains an integer $$$n$$$ ($$$1 \le n \le 100$$$) — the number of candies that Alice and Bob received. The next line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ — the weights of the candies. The weight of each candy is either $$$1$$$ or $$$2$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, output on a separate line:    "YES", if all candies can be divided into two sets with the same weight;  "NO" otherwise.  You can output "YES" and "NO" in any case (for example, the strings yEs, yes, Yes and YES will be recognized as positive).

NoteIn the first test case, Alice and Bob can each take one candy, then both will have a total weight of $$$1$$$.In the second test case, any division will be unfair.In the third test case, both Alice and Bob can take two candies, one of weight $$$1$$$ and one of weight $$$2$$$.In the fourth test case, it is impossible to divide three identical candies between two people.In the fifth test case, any division will also be unfair.

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

import Data.Maybe
import Control.Monad

answer :: [Bool] -> String
answer test
  | any (==True) test = "YES"
  | otherwise = "NO"

canSplit as (cnt1, cnt2) = do
  let sm = cnt1 + 2 * cnt2

  sm == sum(as) - sm

solve = do
  s1 <- B.getLine
  s2 <- B.getLine

  let n = fst $ fromJust $ C.readInt s1
  let as = map (fst . fromJust . C.readInt) (C.words s2)

  let cnt1 = length $ filter (1==) as
  let cnt2 = length $ filter (2==) as

  let pairs = [(x, y) | x <- [0..cnt1], y <- [0..cnt2]]

  putStrLn $ answer $ map (canSplit as) pairs

main = do
  str <- B.getLine

  let t = fst $ fromJust $ C.readInt str

  replicateM_ t solve

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

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

readInts :: IO [Integer]
readInts = readArray

readInt :: IO Integer
readInt = readLn

hist :: [Integer] -> (Integer, Integer)
hist [] = (0, 0)
hist (x:xs) = let (a, b) = hist xs in if x == 1 then (a + 1, b) else (a, b + 1)

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

solveInner :: Integer -> Bool -> Bool
solveInner sum any
  | sum `mod` 2 /= 0 = False
  | (sum `div` 2) `mod` 2 == 0 = True
  | otherwise = any

solve :: [Integer] -> Bool
solve l = let (a, b) = hist l in solveInner (a + 2 * b) (a > 0)

solveCase :: IO String
solveCase = readInt >> fmap (res . solve) readInts

main :: IO ()
main = readLn >>= flip replicateM_ (solveCase >>= putStrLn)

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

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.Array.ST(runSTArray, STArray)

import Data.Array((!))
import Control.Monad(replicateM, foldM, mapM, filterM) -- foldM est un foldl
import Data.Maybe

numOcc :: Ord a => [a] -> M.Map a Integer
numOcc (x:xs) = let m = numOcc xs in case M.lookup x m of
	Just i -> M.insert x (i+1) m
	Nothing -> M.insert x 1 m
numOcc [] = M.empty

numOcc' :: A.Ix a => (a, a) -> [a] -> A.Array a Integer
numOcc' size list = runSTArray $ do
	array <- MA.newArray size 0
	foldM (addElem array) () list
	return array

	where
		addElem :: A.Ix a=> STArray s a Integer -> () -> a -> ST s ()
		addElem array action a = do
			i <- MA.readArray array a
			MA.writeArray array a (i+1)

insertWithList :: Ord a => a -> b -> M.Map a [b] -> M.Map a [b]
insertWithList a b m = case M.lookup a m of
	Just l -> M.insert a (b:l) m
	Nothing -> M.insert a [b] m

deleteWithList :: Ord a => a -> M.Map a [b] -> M.Map a [b]
deleteWithList a m = case M.lookup a m of
	Just (x:y:xs) -> M.insert a (y:xs) m
	Just [x] -> M.delete a m

solve :: Integer -> [Integer] -> Bool

solve n a
	| mod num1 2 == 1 = False
	| mod num2 2 == 1 && num1 == 0 = False
	| otherwise = True
	where
	num1 = sum [1 | x<-a, x==1]
	num2 = sum [1 | x<-a, x==2]

plotResult True = putStrLn "Yes"
plotResult False = putStrLn "No"

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[n] <- fmap ((fmap read) . words) getLine :: IO [Integer]
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve n a

module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

--------------------------------------------------------------------------------

process :: IO ()
process = do
    getLine
    a <- getIntList
    putStrLn $ yesOrNo $ f a

f :: [Int] -> Bool
f a = fst b == snd b
    where b = foldl g (0, 0) $ reverse . sort $ a

g :: (Int, Int) -> Int -> (Int, Int)
g (x, y) z = if x < y then (x + z, y) else (x, y + z)

mainCase :: [Int] -> Int -> Int -> Bool
mainCase [] ones twos = and [even ones, or [even twos, ones >= 2]]
mainCase (1 : xs) ones twos = mainCase xs (ones+1) twos
mainCase (2 : xs) ones twos = mainCase xs ones (twos+1)

testCase :: [Int] -> String
testCase candies = if mainCase candies 0 0 then "yes" else "no"

main = do
	getLine
	contents <- getContents
	let importantLines = map (fst) $ filter (odd . snd) $ zip (lines contents) [0..]
	let testCases = map (map (read) . words) importantLines
	putStrLn $ unlines $ map (testCase) testCases

import Control.Arrow
main = interact $ lines >>> drop 1 >>> caser >>> unzip >>> snd >>> map (words >>> map read >>> solve) >>> unlines

caser :: [String] -> [(String, String)]
caser [a, b] = [(a, b)]
caser (a:b:cs) = [(a, b)] ++ caser cs

solve :: [Int] -> String
solve a = do
  let two = (filter (\x -> x == 2) >>> length) a
  let one = (filter (\x -> x == 1) >>> length) a
  if ((mod two 2) == 0 && (mod one 2) == 0)
    then "YES"
  else if ((mod one 2) == 0 && one > 0)
    then "YES"
  else "NO"

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import safe Control.Arrow ((>>>))
import qualified Data.Text as T
import qualified Data.Text.IO as TI
import Data.List
import Data.Function
import Data.Maybe

main :: IO ()
main = TI.getContents >>= (T.lines >>> drop 1 >>> tcio >>> (mapM_ putStrLn)) where
  tcio :: [T.Text] -> [String]
  tcio [] = []
  tcio (_ : ns : rest) = ((:[]). solve . linetois) (ns) ++ tcio (drop 0 rest)
  linetoi = toi; linetois = (map linetoi).(T.words); linestoiss = map linetois
  --itoline = show; istoline = unwords . (map itoline); isstolines = map istoline
  toi t = toi0 0 t where toi0 n t = if (T.null) t then n else toi0 (10*n + fromIntegral(on (-) fromEnum (T.head t) '0') ) (T.tail t) ;

solve :: [Int] -> String
solve ns = if odd c1 || (c1==0 && odd c2) then "NO" else "YES" where
  [c1,c2] = map (subtract 1) $ map length $ group $ sort $ ns ++ [1,2]

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             join, replicateM_)
import qualified Control.Monad.State.Strict as S
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (findIndices, intersect, elemIndices, find, isPrefixOf, nub,
                                             sort, sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           GHC.IO.Handle              (hDuplicateTo)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             openFile, stdin, stdout)
import           Text.Printf                (printf)

-- import Debug.Trace (trace)
-- debug = flip trace

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

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

solve :: Int -> [Int] -> Bool
solve n as = not $ null $ intersect twoDiffs oneDiffs
    where
        twos = length . findIndices even $ as
        ones = length . findIndices odd $ as

        twoDiffs = [2 * k - 2 * (twos - k) | k <- [0 .. twos]]
        oneDiffs = [k - (ones - k) | k <- [0 .. ones]]

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> map readIntB8 . B8.words
        let answer = solve n as
        printf "%s\n" ((if answer then "YES" else "NO") :: String)

{-# LANGUAGE
    BangPatterns
  , BlockArguments
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , DerivingVia
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , NPlusKPatterns
  , NegativeLiterals
  , OverloadedLabels
  , OverloadedStrings
  , ParallelListComp
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , StrictData
  , TupleSections
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , ViewPatterns
  #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
import           System.IO
import           Data.Proxy
import           GHC.TypeLits
import           GHC.Generics                   ( Generic )
import           Data.Function
-- import           Data.List.HT                   ( mapAdjacent
--                                                 , isAscending
--                                                 )
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
import qualified Data.Set                      as S
-- import qualified Data.Vector.Algorithms.Radix  as VA
-- import           Text.Parsec.ByteString

-- #if defined(LOCAL_ZER0STAR)
-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}
-- #endif

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

both2 f (a1, b1) (a2, b2) = (f a1 a2, f b1 b2)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

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

main = do
  t <- getInt
  replicateM_
    t
    do
      n <- getInt
      a <- getInts
      let s   = sum a
          one = length $ filter (== 1) a
          two = length $ filter (== 2) a
      putStrLn if
        | odd s     -> "No"
        | even two  -> "Yes"
        | one >= 2  -> "Yes"
        | otherwise -> "No"

import Control.Monad
import Data.List

data V = V !Int !Bool

step :: V -> Char -> V
step (V tot one) c = case  c  of
  '1' -> V (tot + 1) True
  '2' -> V (tot + 2) one
  _ -> V tot one

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _n <- getLine
    ans <- foldl' step (V 0 False) <$> getLine
    putStrLn $ case  ans  of
      V x _ | odd x  -> "NO"
      V x c | (mod x 4 /= 0) <= c  -> "YES"
      _ -> "NO"

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

import Data.Maybe
import Control.Monad

answer :: [Bool] -> String
answer test
  | any (==True) test = "YES"
  | otherwise = "NO"

canSplit as cnt2 = do
  let cnt1 = length $ filter (1==) as
  let sum2 = sum $ filter (2==) as
  let num = abs $ 2 * cnt2 - (sum2 - 2 * cnt2)

  even (cnt1 - num) && cnt1 > 0

solve = do
  s1 <- B.getLine
  s2 <- B.getLine

  let n = fst $ fromJust $ C.readInt s1
  let as = map (fst . fromJust . C.readInt) (C.words s2)

  let cnt2 = length $ filter (2==) as

  putStrLn $ answer $ map (canSplit as) [0..cnt2]

main = do
  str <- B.getLine

  let t = fst $ fromJust $ C.readInt str

  replicateM_ t solve

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

import Data.Maybe
import Control.Monad

answer :: [Bool] -> String
answer test
  | any (==True) test = "YES"
  | otherwise = "NO"

canSplit as cnt2 = do
  let cnt1 = length $ filter (1==) as
  let sum2 = sum $ filter (2==) as
  let num = abs $ 2 * cnt2 - (sum2 - 2 * cnt2)

  even (cnt1 - num) && cnt1 > 0

solve = do
  s1 <- B.getLine
  s2 <- B.getLine

  let n = fst $ fromJust $ C.readInt s1
  let as = map (fst . fromJust . C.readInt) (C.words s2)

  let cnt2 = length $ filter (2==) as

  print $ answer $ map (canSplit as) [0..cnt2]

main = do
  str <- B.getLine

  let t = fst $ fromJust $ C.readInt str

  replicateM_ t solve

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

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

readInts :: IO [Integer]
readInts = readArray

readInt :: IO Integer
readInt = readLn

hist :: [Integer] -> (Integer, Integer)
hist [] = (0, 0)
hist (x:xs) = let (a, b) = hist xs in if x == 1 then (a + 1, b) else (a, b + 1)

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

solveInner :: Integer -> Bool -> Bool
solveInner sum any
  | sum `mod` 2 /= 0 = False
  | sum `div` 2 == 0 = True
  | otherwise = any

solve :: [Integer] -> Bool
solve l = let (a, b) = hist l in solveInner (a + 2 * b) (a > 0)

solveCase :: IO String
solveCase = readInt >> fmap (res . solve) readInts

main :: IO ()
main = readLn >>= flip replicateM_ (solveCase >>= putStrLn)


You are working as an analyst in a company working on a new system for big data storage. This system will store $$$n$$$ different objects. Each object should have a unique ID.To create the system, you choose the parameters of the system — integers $$$m \ge 1$$$ and $$$b_{1}, b_{2}, \ldots, b_{m}$$$. With these parameters an ID of some object in the system is an array of integers $$$[a_{1}, a_{2}, \ldots, a_{m}]$$$ where $$$1 \le a_{i} \le b_{i}$$$ holds for every $$$1 \le i \le m$$$.Developers say that production costs are proportional to $$$\sum_{i=1}^{m} b_{i}$$$. You are asked to choose parameters $$$m$$$ and $$$b_{i}$$$ so that the system will be able to assign unique IDs to $$$n$$$ different objects and production costs are minimized. Note that you don't have to use all available IDs.

In the only line of input there is one positive integer $$$n$$$. The length of the decimal representation of $$$n$$$ is no greater than $$$1.5 \cdot 10^{6}$$$. The integer does not contain leading zeros.

Print one number — minimal value of $$$\sum_{i=1}^{m} b_{i}$$$.

import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import System.IO
import Data.Bits
import Data.Maybe

main = do
        hSetBuffering stdout (BlockBuffering (Just 65536))
        n <- fst . fromMaybe undefined . B.readInteger <$> B.getLine
        if n==1 then
                print 1
        else do
                let l = log2 n
                let d = max 0 (round ( fromIntegral l * logBase 3 2 ) - 4)
                let n' = (n-1) `div` (3^d) + 1
                print $ 3*d + f n'

log2 n = bin (\i -> n >= bit i) 0 (10^7)

bin f lo hi
        | lo+1 == hi = lo
        | f mi = bin f mi hi
        | True = bin f lo mi
        where mi = (lo+hi)`div`2

log3 1 = 0
log3 n = 1 + log3 ((n+2)`div`3)

f n = minimum [
        3*log3 n,
        3*log3((n+1)`div`2)+2,
        3*log3((n+3)`div`4)+4 ]

import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import System.IO
import Data.Bits
import Data.Maybe

main = do
        hSetBuffering stdout (BlockBuffering (Just 65536))
        n <- fst . fromMaybe undefined . B.readInteger <$> B.getLine
        let l = log2 n
        let d = max 0 (round ( fromIntegral l * logBase 3 2 ) - 10)
        let n' = n `div` (3^d)
        print $ 3*d + f n'

log2 n = bin (\i -> n >= bit i) 0 (10^7)

bin f lo hi
        | lo+1 == hi = lo
        | f mi = bin f mi hi
        | True = bin f lo mi
        where mi = (lo+hi)`div`2

log3 1 = 0
log3 n = 1 + log3 ((n+2)`div`3)

f n = minimum [
        3*log3 n,
        3*log3((n+1)`div`2)+2,
        3*log3((n+3)`div`4)+4 ]

import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import System.IO
import Data.Bits
import Data.Maybe

main = do
        hSetBuffering stdout (BlockBuffering (Just 65536))
        n <- fst . fromMaybe undefined . B.readInteger <$> B.getLine
        if n==1 then
                print 1
        else do
                let l = log2 n
                let d = max 0 (round ( fromIntegral l * logBase 3 2 ) - 4)
                let n' = n `div` (3^d)
                print $ 3*d + f n'

log2 n = bin (\i -> n >= bit i) 0 (10^7)

bin f lo hi
        | lo+1 == hi = lo
        | f mi = bin f mi hi
        | True = bin f lo mi
        where mi = (lo+hi)`div`2

log3 1 = 0
log3 n = 1 + log3 ((n+2)`div`3)

f n = minimum [
        3*log3 n,
        3*log3((n+1)`div`2)+2,
        3*log3((n+3)`div`4)+4 ]

main = do
        n <- readLn :: IO Integer
        let l = log2 n
        let d = max 0 (round ( fromIntegral l * logBase 3 2 ) - 10)
        let n' = n `div` (3^d)
        print $ 3*d + f n'

log2 n = bin (\i -> n >= 2^i) 0 (10^7)

bin f lo hi
        | lo+1 == hi = lo
        | f mi = bin f mi hi
        | True = bin f lo mi
        where mi = (lo+hi)`div`2

log3 1 = 0
log3 n = 1 + log3 ((n+2)`div`3)

f n = minimum [
        3*log3 n,
        3*log3((n+1)`div`2)+2,
        3*log3((n+3)`div`4)+4 ]

import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import System.IO
import Data.Bits
import Data.Maybe

main = do
        hSetBuffering stdout (BlockBuffering (Just 65536))
        n <- fst . fromMaybe undefined . B.readInteger <$> B.getLine
        let l = log2 n
        let d = max 0 (round ( fromIntegral l * logBase 3 2 ) - 4)
        let n' = (n-1) `div` (3^d) + 1
        print $ 3*d + f n'

log2 n = bin (\i -> n >= bit i) 0 (10^7)

bin f lo hi
        | lo+1 == hi = lo
        | f mi = bin f mi hi
        | True = bin f lo mi
        where mi = (lo+hi)`div`2

log3 1 = 0
log3 n = 1 + log3 ((n+2)`div`3)

f n = minimum [
        3*log3 n,
        3*log3((n+1)`div`2)+2,
        3*log3((n+3)`div`4)+4 ]


Luba needs your help again! Luba has n TV sets. She knows that i-th TV set will be working from moment of time li till moment ri, inclusive.Luba wants to switch off one of TV sets in order to free the socket. Let's call some TV set redundant if after switching it off the number of integer moments of time when at least one of TV sets is working won't decrease. Luba will be very upset if she has to switch off a non-redundant TV set.Help Luba by telling her the index of some redundant TV set. If there is no any, print -1.

The first line contains one integer number n (1 ≤ n ≤ 2·105) — the number of TV sets. Then n lines follow, each of them containing two integer numbers li, ri (0 ≤ li ≤ ri ≤ 109) denoting the working time of i-th TV set.

If there is no any redundant TV set, print -1. Otherwise print the index of any redundant TV set (TV sets are indexed from 1 to n). If there are multiple answers, print any of them.

NoteConsider the first sample. Initially all integer moments of time such that at least one TV set is working are from the segment [1;7]. It's easy to see that this segment won't change if we switch off the first TV set (or the second one).Note that in the fourth sample you can switch off the second TV set, since even without it all integer moments such that any of the TV sets is working denote the segment [1;4].

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import Control.Monad (replicateM)
import Data.List (sortBy)
import Data.Function (on)

readInt = fst . M.fromJust . C.readInt

run (ax:xs) [] = run xs [ax]
run (ax@(a, [i, f]):xs) (last -> sx@(sa, [si, sf])) | f <= sf = a | si == i && f > sf = sa
run (ax@(a, [i, f]):xs) (sx@(sa, [si, sf]):sta)
      | sf < i - 1 = run (ax:xs) sta | sta /= [] = fst (head sta)
      | otherwise = run xs (sx:ax:sta)
run [] _ = -1

main = do
    (readInt -> n) <- B.getLine
    (sortBy (compare `on` (head . snd)) . zip [1..] . map (map readInt . C.words) -> xs) <- replicateM n B.getLine
    print $ run xs []


For months Maxim has been coming to work on his favorite bicycle. And quite recently he decided that he is ready to take part in a cyclists' competitions.He knows that this year n competitions will take place. During the i-th competition the participant must as quickly as possible complete a ride along a straight line from point si to point fi (si < fi).Measuring time is a complex process related to usage of a special sensor and a time counter. Think of the front wheel of a bicycle as a circle of radius r. Let's neglect the thickness of a tire, the size of the sensor, and all physical effects. The sensor is placed on the rim of the wheel, that is, on some fixed point on a circle of radius r. After that the counter moves just like the chosen point of the circle, i.e. moves forward and rotates around the center of the circle.At the beginning each participant can choose any point bi, such that his bike is fully behind the starting line, that is, bi < si - r. After that, he starts the movement, instantly accelerates to his maximum speed and at time tsi, when the coordinate of the sensor is equal to the coordinate of the start, the time counter starts. The cyclist makes a complete ride, moving with his maximum speed and at the moment the sensor's coordinate is equal to the coordinate of the finish (moment of time tfi), the time counter deactivates and records the final time. Thus, the counter records that the participant made a complete ride in time tfi - tsi.  Maxim is good at math and he suspects that the total result doesn't only depend on his maximum speed v, but also on his choice of the initial point bi. Now Maxim is asking you to calculate for each of n competitions the minimum possible time that can be measured by the time counter. The radius of the wheel of his bike is equal to r.

The first line contains three integers n, r and v (1 ≤ n ≤ 100 000, 1 ≤ r, v ≤ 109) — the number of competitions, the radius of the front wheel of Max's bike and his maximum speed, respectively.  Next n lines contain the descriptions of the contests. The i-th line contains two integers si and fi (1 ≤ si < fi ≤ 109) — the coordinate of the start and the coordinate of the finish on the i-th competition.

Print n real numbers, the i-th number should be equal to the minimum possible time measured by the time counter. Your answer will be considered correct if its absolute or relative error will not exceed 10 - 6.  Namely: let's assume that your answer equals a, and the answer of the jury is b. The checker program will consider your answer correct if .

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

read' = foldl (\a x -> a * 10 + (fromEnum x - fromEnum '0')) 0

bsearch f a b =
  let c = (a + b) / 2 in if (b - a) < 1e-10 then c else  if f c then bsearch f a c else bsearch f c b

alpha rem = pi * rem * bsearch (\q -> let x = pi * rem * q in x + sin x > rem * pi) 0.5 1

s :: [[Int]] -> [Double]
s ([_, r', v'] : competitions) = map solve competitions where
  r = fromIntegral r'
  v = fromIntegral v'
  solve' d = case properFraction (d / (2 * r * pi)) of
    (n, rem) -> fromIntegral n * (2 * pi * r / v) + (2 * alpha rem * r / v)
  solve [s, f] = solve' (fromIntegral f - fromIntegral s)

main = interact $ unlines . map show . s . map (map read' . words) . lines

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

read' = foldl (\a x -> a * 10 + (fromEnum x - fromEnum '0')) 0

bsearch f a b =
  let c = (a + b) / 2 in if (b - a) < 1e-10 then c else if f c then bsearch f a c else bsearch f c b

alpha rem = bsearch (\x -> x + sin x > rem * pi) 0 pi

s :: [[Int]] -> [Double]
s ([_, r', v'] : competitions) = map solve competitions where
  r = fromIntegral r'
  v = fromIntegral v'
  solve' d = case properFraction (d / (2 * r * pi)) of
    (n, rem) -> fromIntegral n * (2 * pi * r / v) + (2 * alpha rem * r / v)
  solve [s, f] = solve' (fromIntegral f - fromIntegral s)

main = interact $ unlines . map show . s . map (map read' . words) . lines


You are given two integers $$$n$$$ and $$$k$$$.Your task is to construct such a string $$$s$$$ of length $$$n$$$ that for each $$$i$$$ from $$$1$$$ to $$$k$$$ there is at least one $$$i$$$-th letter of the Latin alphabet in this string (the first letter is 'a', the second is 'b' and so on) and there are no other letters except these. You have to maximize the minimal frequency of some letter (the frequency of a letter is the number of occurrences of this letter in a string). If there are several possible answers, you can print any.You have to answer $$$t$$$ independent queries.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of queries. The next $$$t$$$ lines are contain queries, one per line. The $$$i$$$-th line contains two integers $$$n_i$$$ and $$$k_i$$$ ($$$1 \le n_i \le 100, 1 \le k_i \le min(n_i, 26)$$$) — the length of the string in the $$$i$$$-th query and the number of characters in the $$$i$$$-th query.

Print $$$t$$$ lines. In the $$$i$$$-th line print the answer to the $$$i$$$-th query: any string $$$s_i$$$ satisfying the conditions in the problem statement with constraints from the $$$i$$$-th query.

NoteIn the first example query the maximum possible minimal frequency is $$$2$$$, it can be easily seen that the better answer doesn't exist. Other examples of correct answers: "cbcabba", "ccbbaaa" (any permutation of given answers is also correct).In the second example query any permutation of first four letters is acceptable (the maximum minimal frequency is $$$1$$$).In the third example query any permutation of the given answer is acceptable (the maximum minimal frequency is $$$3$$$).

main = getContents >>= putStr . solve . tail . map read . words

solve [] = []
solve (n:k:xs) = (take n $ concat $ repeat $ take k ['a' .. 'z']) ++ ('\n' : solve xs)

f2::Int->String->String->String
f2 0 _ _=""
f2 a [] t=f2 a t t
f2 a (x:xs) t=x:f2 (a-1) xs t

f::[String]->[String]
f [] =[]
f (x:xs)=let (a:b:[])=map read (words x)::[Int]
             t=(take b "abcdefghijklmnopqrstuvwxyz")
         in (f2 a t t):f xs
main = do
       e<-getLine
       es<-getContents
       mapM_ putStrLn $ f (lines es)

import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    [n,k] <- map read . words <$> getLine
    putStrLn $ take n $ cycle $ enumFromTo 'a' $ toEnum $ fromEnum 'a' + k - 1

import Control.Monad
-- import Data.List (flatten)

fpow n = foldr (.) id . replicate n

solve :: Int -> Int -> String
solve n k = zipWith const reps [1..n]
  where reps = concat $ repeat ['a'.. fpow (pred k) succ 'a']

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

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

onecase = do
		[a,b]<-map read <$> words <$> getLine ::IO [Int]
		putStrLn $ take a $ cycle $ take b "abcdefghijklmnopqrstuvwxyz"

main = do
		n<-read<$> getLine ::IO Int
		replicateM_ n onecase

process :: Int -> Int -> [Char]
process n k = take n . concat . repeat . take k $ ['a'..]

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    t <- fmap readInt getLine
    ts <- fmap (map (map readInt.words).lines) getContents
    mapM_ putStrLn $ map (\[n,k] -> process n k) ts

solve [n, k] =
  map ((['a'..'z'] !!) . (`mod` k)) [0..n-1]
solve _ = error "bad format"

main = interact $ unlines
  . map (solve . map read . words)
  . tail . lines


You are given matrix with n rows and n columns filled with zeroes. You should put k ones in it in such a way that the resulting matrix is symmetrical with respect to the main diagonal (the diagonal that goes from the top left to the bottom right corner) and is lexicographically maximal.One matrix is lexicographically greater than the other if the first different number in the first different row from the top in the first matrix is greater than the corresponding number in the second one.If there exists no such matrix then output -1.

The first line consists of two numbers n and k (1 ≤ n ≤ 100, 0 ≤ k ≤ 106).

If the answer exists then output resulting matrix. Otherwise output -1.

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

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

solve n k
  | k > n * n = listArray ((1, 1), (1, 1)) [-1] :: UArray (Int, Int) Int
  | otherwise = listArray ((1, 1), (n, n)) (repeat 0) // concat (go k [if r == c then [((r, c), 1)] else [((r, c), 1), ((c, r), 1)] | r <- [1..n], c <- [r..n]])
  where
    go k uus@(~(u:us)) = case k of
      0 -> []
      1 -> [maybe undefined id $ find ((== 1) . length) uus]
      _ -> u:go (k - length u) us

main = do
  [n, k] <- fmap readInts B.getLine
  B.putStr $ (\m -> let ((lr, lc), (rr, rc)) = bounds m in B.unlines [B.unwords [B.pack $ show $ m!(r, c) | c <- [lc..rc]] | r <- [lr..rr]]) $ solve n k

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

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

solve n k
  | k > n && odd (k - n) = listArray ((1, 1), (1, 1)) [-1] :: UArray (Int, Int) Int
  | otherwise = listArray ((1, 1), (n, n)) (repeat 0) // take k ([((i, i), 1) | i <- [1..n]] ++ concat [[((r, c), 1), ((c, r), 1)] | r <- [n - 1, n - 2..1], c <- [n, n - 1..r + 1]])

main = do
  [n, k] <- fmap readInts B.getLine
  B.putStr $ (\m -> let ((lr, lc), (rr, rc)) = bounds m in B.unlines [B.unwords [B.pack $ show $ m!(r, c) | c <- [lc..rc]] | r <- [lr..rr]]) $ solve n k


While Duff was resting in the beach, she accidentally found a strange array b0, b1, ..., bl - 1 consisting of l positive integers. This array was strange because it was extremely long, but there was another (maybe shorter) array, a0, ..., an - 1 that b can be build from a with formula: bi = ai mod n where a mod b denoted the remainder of dividing a by b.  Duff is so curious, she wants to know the number of subsequences of b like bi1, bi2, ..., bix (0 ≤ i1 < i2 < ... < ix < l), such that:   1 ≤ x ≤ k  For each 1 ≤ j ≤ x - 1,   For each 1 ≤ j ≤ x - 1, bij ≤ bij + 1. i.e this subsequence is non-decreasing. Since this number can be very large, she want to know it modulo 109 + 7.Duff is not a programmer, and Malek is unavailable at the moment. So she asked for your help. Please tell her this number.

The first line of input contains three integers, n, l and k (1 ≤ n, k, n × k ≤ 106 and 1 ≤ l ≤ 1018). The second line contains n space separated integers, a0, a1, ..., an - 1 (1 ≤ ai ≤ 109 for each 0 ≤ i ≤ n - 1).

Print the answer modulo 1 000 000 007 in one line.

NoteIn the first sample case, . So all such sequences are: , , , , , , , ,  and .

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import Data.Array.IO
import Data.List
import Data.IORef
import Debug.Trace

md :: Integer
md = 1000000007

solve :: Integer -> Integer -> Integer -> [Int] -> IO Integer
solve n l k a = do
    let parr = listArray (1,n) . map snd . sort $ zip a [1..n]
    let aarr = listArray (1,n) a
    dp <- newArray ((0,0),(min height k,n)) 0 :: IO (IOArray (Integer,Integer) Integer)
    forM [1..n] $ \j -> writeArray dp (1,j) 1
    forM [2..min height k] $ \i -> do
        let rep x j sm
                | j > n = return ()
                | x <= n && aarr ! (parr ! x) <= aarr ! (parr ! j) = do
                    y <- readArray dp (i-1,parr!x)
                    rep (x+1) j $ (sm+y) `mod` md
                | otherwise = do
                    writeArray dp (i,parr ! j) sm
                    rep x (j+1) sm
        rep 1 1 0
    lst <- getElems dp
    foldl' (((`mod` md) .) . (+)) 0 <$> (forM [1..n] $ \j -> do
        let plus = if j <= rest then 1 else 0
        foldl' (((`mod` md) .) . (+)) 0 <$> (forM [1..min k $ height+plus-1] $ \i ->
            (`mod` md) . ((height - i + plus) *) <$> readArray dp (i,j)
            )
        )
    where
        height = (l-1) `div` n + 1
        rest = (l-1) `mod` n + 1

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInteger . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a

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

solve :: Integer -> Integer -> Integer -> [Int] -> IO Integer
solve n l k a = do
    dp <- newArray ((0,0),(k,n)) 0 :: IO (IOArray (Integer,Integer) Integer)
    forM [1..n] $ \j -> writeArray dp (1,j) 1
    forM [2..k] $ \i ->
        forM [1..n] $ \j ->
            writeArray dp (i,j) =<< ((`mod` 1000000007) .) . (+) <$> readArray dp (i-1,j) <*> readArray dp (i,j-1)
    let rest = l `mod` n
    sm <- foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> forM [1..min k $ height] (\i ->
        forM [1..n] (\j ->
            (`mod` 1000000007) . ((height - i + 1) *) <$> (readArray dp (i,j))))
    if rest > 0
        then (sm-) . foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> (forM (zip [1..n] . map snd . sort $ zip a [1..n]) $ \(j,x) -> do
            if x > rest
                then do
                    forM [1..k] $ \i -> readArray dp (i,j)
                else
                    return [])
        else return sm
    where
        rest = l `mod` n
        height = (l-1) `div` n + 1

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInteger . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a

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

solve :: Int -> Int -> Int -> [Int] -> IO Int
solve n l k a = do
    dp <- newArray ((0,0),(k,n)) 1 :: IO (IOArray (Int,Int) Int)
    forM [2..k] $ \i ->
        forM [1..n] $ \j ->
            writeArray dp (i,j) =<< (+) <$> readArray dp (i-1,j) <*> readArray dp (i,j-1)
    let rest = l `mod` n
    sm <- sum . concat <$> forM [1..min k (l`div`n)] (\i ->
        forM [1..n] (\j ->
            readArray dp (i,j)))
    if l `div` n < k
        then foldM (\s (i,x) -> if x <= rest then (+s) <$> readArray dp (l`div`n+1,i) else return sm) sm . zip [1..n] . map snd $ sort (zip a [1..n])
        else return sm

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a

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

solve :: Integer -> Integer -> Integer -> [Int] -> IO Integer
solve n l k a = do
    dp <- newArray ((0,0),(k,n)) 0 :: IO (IOArray (Integer,Integer) Integer)
    forM [1..n] $ \j -> writeArray dp (1,j) 1
    forM [2..k] $ \i ->
        forM [1..n] $ \j ->
            writeArray dp (i,j) =<< ((`mod` 1000000007) .) . (+) <$> readArray dp (i-1,j) <*> readArray dp (i,j-1)
    let rest = l `mod` n
    sm <- foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> forM [1..min k height] (\i ->
        forM [1..n] (\j ->
            (`mod` 1000000007) . ((height - i + 1) *) <$> (readArray dp (i,j))))
    if height <= k && rest > 0
        then (sm-) . foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> (forM (zip [1..n] . map snd . sort $ zip a [1..n]) $ \(j,x) -> do
            if x > rest
                then do
                    forM [1..min k $ height] $ \i -> readArray dp (i,j)
                else
                    return [])
        else return sm
    where
        rest = l `mod` n
        height = (l-1) `div` n + 1

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInteger . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import Data.Array.IO
import Data.List
import Data.IORef
import Debug.Trace

md :: Integer
md = 1000000007

solve :: Integer -> Integer -> Integer -> [Int] -> IO Integer
solve n l k a = do
    let parr = listArray (1,n) . map snd . sort $ zip a [1..n]
    let aarr = listArray (1,n) a
    dp <- newArray ((0,0),(k,n)) 0 :: IO (IOArray (Integer,Integer) Integer)
    forM [1..n] $ \j -> writeArray dp (1,j) 1
    forM [2..min height k] $ \i -> do
        let rep x j sm
             | j > n = return ()
             | x <= n && aarr ! (parr ! x) <= aarr ! (parr ! j) = do
                 y <- readArray dp (i-1,x)
                 rep (x+1) j $ (sm+y) `mod` md
             | otherwise = do
                 writeArray dp (i,parr ! j) sm
                 rep x (j+1) sm
        rep 1 1 0
    lst <- getElems dp
    foldl1' (((`mod` md) .) . (+)) <$> (forM [1..n] $ \j -> do
        let plus = if j <= rest then 1 else 0
        foldl1' (((`mod` md) .) . (+)) <$> (forM [1..min k $ height+plus-1] $ \i ->
            (`mod` md) . ((height - i + plus) *) <$> readArray dp (i,j)
            )
        )
    where
        height = (l-1) `div` n + 1
        rest = (l-1) `mod` n + 1

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInteger . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a

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

solve :: Integer -> Integer -> Integer -> [Int] -> IO Integer
solve n l k a = do
    dp <- newArray ((0,0),(k,n)) 0 :: IO (IOArray (Integer,Integer) Integer)
    forM [1..n] $ \j -> writeArray dp (1,j) 1
    forM [2..k] $ \i ->
        forM [1..n] $ \j ->
            writeArray dp (i,j) =<< ((`mod` 1000000007) .) . (+) <$> readArray dp (i-1,j) <*> readArray dp (i,j-1)
    let rest = l `mod` n
    sm <- foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> forM [1..min k height] (\i ->
        forM [1..n] (\j ->
            (`mod` 1000000007) . ((min k height - i + 1) *) <$> (readArray dp (i,j))))
    if height <= k && rest > 0
        then (sm-) . foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> (forM (zip [1..n] . map snd . sort $ zip a [1..n]) $ \(j,x) -> do
            if x > rest
                then do
                    forM [1..min k $ height] $ \i -> readArray dp (i,j)
                else
                    return [])
        else return sm
    where
        rest = l `mod` n
        height = (l-1) `div` n + 1

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInteger . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a

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

solve :: Integer -> Integer -> Integer -> [Int] -> IO Integer
solve n l k a = do
    dp <- newArray ((0,0),(k,n)) 0 :: IO (IOArray (Integer,Integer) Integer)
    forM [1..n] $ \j -> writeArray dp (1,j) 1
    forM [2..k] $ \i ->
        forM [1..n] $ \j ->
            writeArray dp (i,j) =<< ((`mod` 1000000007) .) . (+) <$> readArray dp (i-1,j) <*> readArray dp (i,j-1)
    let rest = l `mod` n
    sm <- foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> forM [1..height] (\i ->
        forM [1..n] (\j ->
            ((height - i + 1) *) <$> (readArray dp (i,j))))
    if height <= k && rest > 0
        then (sm-) . foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> (forM (zip [1..n] . map snd . sort $ zip a [1..n]) $ \(j,x) -> do
            if x > rest
                then do
                    forM [1..height] $ \i -> readArray dp (i,j)
                else
                    return [])
        else return sm
    where
        rest = l `mod` n
        height = min k . (+1) $ (l-1) `div` n

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInteger . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a

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

solve :: Integer -> Integer -> Integer -> [Int] -> IO Integer
solve n l k a = do
    dp <- newArray ((0,0),(k,n)) 0 :: IO (IOArray (Integer,Integer) Integer)
    forM [1..n] $ \j -> writeArray dp (1,j) 1
    forM [2..k] $ \i ->
        forM [1..n] $ \j ->
            writeArray dp (i,j) =<< ((`mod` 1000000007) .) . (+) <$> readArray dp (i-1,j) <*> readArray dp (i,j-1)
    let rest = l `mod` n
    sm <- foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> forM [1..min k height] (\i ->
        forM [1..n] (\j ->
            (`mod` 1000000007) . ((height - i + 1) *) <$> (readArray dp (i,j))))
    if rest > 0
        then (sm-) . foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> (forM (zip [1..n] . map snd . sort $ zip a [1..n]) $ \(j,x) -> do
            if x > rest
                then do
                    forM [1..min k $ height] $ \i -> readArray dp (i,j)
                else
                    return [])
        else return sm
    where
        rest = l `mod` n
        height = (l-1) `div` n + 1

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInteger . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a

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

solve :: Int -> Int -> Int -> [Int] -> IO Int
solve n l k a = do
    dp <- newArray ((0,0),(k,n)) 0 :: IO (IOArray (Int,Int) Int)
    forM [1..k] $ \i ->
        forM [1..n] $ \j ->
            writeArray dp (i,j) =<< (+) <$> readArray dp (i-1,j) <*> readArray dp (i,j-1)
    let rest = l `mod` n
    sm <- sum . concat <$> forM [1..l`div`n] (\i ->
        forM [1..n] (\j ->
            readArray dp (i,j)))
    foldM (\s x -> (+s) <$> readArray dp (l`div`n+1,x)) sm . map snd $ sort (zip a [1..n])

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a

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

solve :: Integer -> Integer -> Integer -> [Int] -> IO Integer
solve n l k a = do
    dp <- newArray ((0,0),(k,n)) 0 :: IO (IOArray (Integer,Integer) Integer)
    forM [1..n] $ \j -> writeArray dp (1,j) 1
    forM [2..k] $ \i ->
        forM [1..n] $ \j ->
            writeArray dp (i,j) =<< ((`mod` 1000000007) .) . (+) <$> readArray dp (i-1,j) <*> readArray dp (i,j-1)
    let rest = l `mod` n
    sm <- foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> forM [1..min k $ height] (\i ->
        forM [1..n] (\j ->
            (`mod` 1000000007) . ((height - i + 1) *) <$> (readArray dp (i,j))))
    if rest > 0
        then (sm-) . foldl1' (((`mod` 1000000007) .) . (+)) . concat <$> (forM (zip [1..n] . map snd . sort $ zip a [1..n]) $ \(j,x) -> do
            if x > rest
                then do
                    forM [1..min k $ height] $ \i -> readArray dp (i,j)
                else
                    return [])
        else return sm
    where
        rest = l `mod` n
        height = (l-1) `div` n + 1

main :: IO ()
main = do
    [n,l,k] <- map fst . mapMaybe C.readInteger . C.words <$> C.getLine
    a <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve n l k a


Polycarpus has an array, consisting of n integers a1, a2, ..., an. Polycarpus likes it when numbers in an array match. That's why he wants the array to have as many equal numbers as possible. For that Polycarpus performs the following operation multiple times:  he chooses two elements of the array ai, aj (i ≠ j);  he simultaneously increases number ai by 1 and decreases number aj by 1, that is, executes ai = ai + 1 and aj = aj - 1. The given operation changes exactly two distinct array elements. Polycarpus can apply the described operation an infinite number of times. Now he wants to know what maximum number of equal array elements he can get if he performs an arbitrary number of such operation. Help Polycarpus.

The first line contains integer n (1 ≤ n ≤ 105) — the array size. The second line contains space-separated integers a1, a2, ..., an (|ai| ≤ 104) — the original array.

Print a single integer — the maximum number of equal array elements he can get if he performs an arbitrary number of the given operation.

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

main = do
  (n:a) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let m = sum a `mod` n
  print $ if m == 0 then n else n - 1

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	let n = read str1
	let list = map read (words str2)
	if (mod (sum list) n == 0)
		then putStrLn (show n)
		else putStrLn (show (n - 1))

import Control.Monad (liftM)

solve :: Int -> [Int] -> Int
solve n as
  | mod (sum as) n == 0  =  n
  | otherwise  =  n - 1

main :: IO ()
main  =  do
    n  <-  readLn
    as  <-  liftM (map read . words) getLine
    print $ solve n as

import Control.Monad (liftM)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Int -> [Int] -> Int
solve n xs
  | sum xs `mod` n == 0  =  n
  | otherwise  =  n - 1

main :: IO ()
main  =  do
    n   <-  readLn
    xs  <-  Main.reads
    print $ solve n xs

-- Codeforces 246B

import qualified Data.ByteString.Char8 as BC
import Data.Maybe

main :: IO ()
main = BC.getContents >>= print . solve . map (fst . fromJust . BC.readInt) . BC.words

solve :: [Int] -> Int
solve (n:xs) = if (sum xs) `mod` n  == 0 then n else (n-1)

import Data.List

solve (n:xs)
  | mod s n == 0 = n
  | True = (n - 1)
  where s = foldl'(+) 0 xs

main = interact $ show . solve . map read . words

solve (n:xs)
  | mod s n == 0 = n
  | True = (n - 1)
  where s = sum xs

main = interact $ show . solve . map read . words

answer n w = if rem (sum w) n == 0 then n else n-1

main = do
 n<-getLine
 m<-getContents
 print . (answer ((read::String->Int)n)  ) . map (read::String->Int) . words $ m

main = do
  n <- readLn
  s<-fmap(sum.map read.words)getLine
  if mod s n == 0 then print n else print $ n-1

main = interact $ show . solve . map (map read . words) . lines
solve [[n], xs] = n - l
    where l = if (sum xs) `mod` n == 0 then 0 else 1

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

main = do
    (n:a) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
    print $ solve n a

solve n xs = n - l
    where l = if (sum xs) `mod` n == 0 then 0 else 1

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

main = do
  (n:a) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let m = sum a `mod` n
  print $ max m $ n - m

main = do
  n <- readLn
  s<-fmap(sum.map read.words)getLine
  let (q,r) = divMod s n
  print $ max r (n-r)


During one of the space missions, humans have found an evidence of previous life at one of the planets. They were lucky enough to find a book with birth and death years of each individual that had been living at this planet. What's interesting is that these years are in the range $$$(1, 10^9)$$$! Therefore, the planet was named Longlifer.In order to learn more about Longlifer's previous population, scientists need to determine the year with maximum number of individuals that were alive, as well as the number of alive individuals in that year. Your task is to help scientists solve this problem!

The first line contains an integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of people. Each of the following $$$n$$$ lines contain two integers $$$b$$$ and $$$d$$$ ($$$1 \le b \lt d \le 10^9$$$) representing birth and death year (respectively) of each individual.

Print two integer numbers separated by blank character, $$$y$$$  — the year with a maximum number of people alive and $$$k$$$  — the number of people alive in year $$$y$$$. In the case of multiple possible solutions, print the solution with minimum year.

NoteYou can assume that an individual living from $$$b$$$ to $$$d$$$ has been born at the beginning of $$$b$$$ and died at the beginning of $$$d$$$, and therefore living for $$$d$$$ - $$$b$$$ years.

import Control.Monad
import Data.List (sortBy, sort, groupBy, maximumBy)
import Data.Ord (comparing)
import Data.Function (on)

main :: IO ()
main = do
    n <- read <$> getLine
    a <- replicateM n $ map read . words <$> getLine :: IO [[Int]]
    let b = map (\x -> (head x, 1 :: Int)) a
        d = map (\x -> (last x, -1 :: Int)) a
        c = map (foldl1 (\(x, y) (_, w) -> (x, y + w))) $ groupBy ((==) `on` fst) $ sortBy (comparing fst) $ b ++ d
        e = scanl1 (\(_, y) (z, w) -> (z, y + w)) c
    putStrLn $ (\(x, y) -> unwords [show x, show y]) $ maximumBy (comparing snd) $ reverse e


You have $$$n$$$ stacks of blocks. The $$$i$$$-th stack contains $$$h_i$$$ blocks and it's height is the number of blocks in it. In one move you can take a block from the $$$i$$$-th stack (if there is at least one block) and put it to the $$$i + 1$$$-th stack. Can you make the sequence of heights strictly increasing?Note that the number of stacks always remains $$$n$$$: stacks don't disappear when they have $$$0$$$ blocks.

First line contains a single integer $$$t$$$ $$$(1 \leq t \leq 10^4)$$$ — the number of test cases. The first line of each test case contains a single integer $$$n$$$ $$$(1 \leq n \leq 100)$$$. The second line of each test case contains $$$n$$$ integers $$$h_i$$$ $$$(0 \leq h_i \leq 10^9)$$$ — starting heights of the stacks. It's guaranteed that the sum of all $$$n$$$ does not exceed $$$10^4$$$.

For each test case output YES if you can make the sequence of heights strictly increasing and NO otherwise. You may print each letter in any case (for example, YES, Yes, yes, yEs will all be recognized as positive answer).

NoteIn the first test case there is no need to make any moves, the sequence of heights is already increasing.In the second test case we need to move one block from the first stack to the second. Then the heights become $$$0$$$ $$$1$$$.In the third test case we could move one block from the first stack to the second and then from the second to the third, which would make the heights $$$3$$$ $$$4$$$ $$$5$$$.In the fourth test case we can't make a move, but the sequence is not increasing, so the answer is NO.In the fifth test case we can only make one move (from the second to the third stack), which would make the heights $$$0$$$ $$$0$$$ $$$1$$$. Both $$$0$$$ $$$1$$$ $$$0$$$ and $$$0$$$ $$$0$$$ $$$1$$$ are not increasing sequences, so the answer is NO.

{-# LANGUAGE BlockArguments #-}
{-# OPTIONS_GHC -O2 #-}

module Main ( main ) where

import Control.Monad
import Data.Foldable

main :: IO ()
main = nCases do
  _ <- getLine
  m <- line
  let
    fld have (ix, cur)
      | have == -1       = -1
      | ix <= cur        = have + cur - ix
      | ix - cur <= have = have - ix + cur
      | otherwise        = -1
  putBoolLn $ -1 /= foldl' fld 0 (zip [0..] m)

-- lib

nCases :: IO a -> IO ()
nCases m = do
  n <- readLn
  replicateM_ n m

line :: Read a => IO [a]
line = fmap read . words <$> getLine

putBool :: Bool -> IO ()
putBool b = putStr if b then "Yes" else "No"

putBoolLn :: Bool -> IO ()
putBoolLn b = putStrLn if b then "Yes" else "No"

import Control.Monad

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

readIntegers :: IO [Integer]
readIntegers = readArray

readInteger :: IO Integer
readInteger = readLn

ans :: Bool -> [Char]
ans True = "YES"
ans False = "NO"

rec :: Integer -> Integer -> [Integer] -> Bool
rec _ _ [] = True
rec have least (x:xs) =
    if x + have < least then False else rec (x + have - least) (least + 1) xs

solve :: [Integer] -> [Char]
solve = ans . rec 0 0

main :: IO ()
main = readLn >>= flip replicateM_ (readInteger >> fmap solve readIntegers >>= putStrLn)

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = do
  n <- popInt
  h <- popIntegers
  return $ if solve n h then "YES" else "NO"

solve n hs = go 0 0 hs
  where
    go _ _ [] = True
    go i carry (h : hs) = let carry' = carry + h - i in
                            if carry' < 0 then False else go (i + 1) carry' hs

strictlyIncreasing :: [Integer] -> Bool
strictlyIncreasing [] = True
strictlyIncreasing [_] = True
strictlyIncreasing (x:y:xs) = x < y && strictlyIncreasing (y:xs)

reshape :: [Integer] -> [Integer]
reshape = foldl moveRight []
    where moveRight [] h = [h]
          moveRight l h = newL ++ [h + extra]
            where extra = max 0 (last l - toInteger (length l) + 1)
                  newL = init l ++ [last l - extra]

solveTest :: [Integer] -> String
solveTest nums = if strictlyIncreasing $ reshape nums
                    then "YES"
                    else "NO"

solve :: String -> String
solve = unlines . map (solveTest . map read . words) . odds . drop 1 . lines
    where odds (_:x:xs) = x : odds xs
          odds [] = []

main :: IO ()
main = interact solve

import qualified Data.ByteString.Lazy.Char8 as P

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import Data.Int

solve :: [Int] -> Int -> Int64 -> Bool
solve [] _ spare = spare >= 0
solve (y:ys) tar spare = spare >= 0
  && solve ys (tar+1) (spare + fromIntegral (y - tar))

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    h <- readInts
    lift $ P.putStr $ if  solve h 0 0
      then  P.pack "YES\n"
      else  P.pack "NO\n"

type SIO = StateT P.ByteString IO

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

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

{-# LANGUAGE BlockArguments #-}
{-# OPTIONS_GHC -O2 #-}

module Main ( main ) where

import Control.Monad

main :: IO ()
main = nCases do
  [n] <- line
  m   <- line
  putBoolLn $ n * (n - 1) `div` 2 <= sum m

-- lib

nCases :: IO a -> IO ()
nCases m = do
  n <- readLn
  replicateM_ n m

line :: Read a => IO [a]
line = fmap read . words <$> getLine

putBool :: Bool -> IO ()
putBool b = putStr if b then "Yes" else "No"

putBoolLn :: Bool -> IO ()
putBoolLn b = putStrLn if b then "Yes" else "No"

{-# LANGUAGE BlockArguments, ExtendedDefaultRules #-}
{-# OPTIONS_GHC -O2 #-}

module Main ( main ) where

import Control.Monad

main :: IO ()
main = nCases do
  [n] <- line
  m   <- line
  putBoolLn $ n * (n - 1) `div` 2 <= sum m

-- lib

nCases :: IO a -> IO ()
nCases m = do
  n <- readLn
  replicateM_ n m

line :: Read a => IO [a]
line = fmap read . words <$> getLine

putBool :: Bool -> IO ()
putBool b = putStr if b then "Yes" else "No"

putBoolLn :: Bool -> IO ()
putBoolLn b = putStrLn if b then "Yes" else "No"

default ( Int )

{-# LANGUAGE BlockArguments, ExtendedDefaultRules #-}
{-# OPTIONS_GHC -O2 #-}

module Main ( main ) where

import Control.Monad

main :: IO ()
main = nCases do
  [n] <- line
  m   <- line
  putBoolLn $ n * (n + 1) `div` 2 >= sum m

nCases :: IO a -> IO ()
nCases m = do
  n <- readLn
  replicateM_ n m

line :: Read a => IO [a]
line = fmap read . words <$> getLine

putBool :: Bool -> IO ()
putBool b = putStr if b then "Yes" else "No"

putBoolLn :: Bool -> IO ()
putBoolLn b = putStrLn if b then "Yes" else "No"

default ( Int )

import Control.Monad

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

readInts :: IO [Int]
readInts = readArray

readInt :: IO Int
readInt = readLn

ans :: Bool -> [Char]
ans True = "YES"
ans False = "NO"

rec :: Int -> Int -> [Int] -> Bool
rec _ _ [] = True
rec have least (x:xs) =
    if x + have < least then False else rec (x + have - least) (least + 1) xs

solve :: [Int] -> [Char]
solve a = ans $ rec 0 0 a

main :: IO ()
main = readInt >>= flip replicateM_ (readInt >> fmap solve readInts >>= putStrLn)

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = do
  n <- popInteger
  h <- popIntegers
  return $ if solve n h then "YES" else "NO"

solve n h = sum h >= n * (n - 1) `quot` 2

strictlyIncreasing :: [Int] -> Bool
strictlyIncreasing nums
  | length nums < 2 = True
  | otherwise = x < y && strictlyIncreasing (tail nums)
    where x = head nums
          y = head $ tail nums

reshape :: [Int] -> [Int]
reshape = foldl moveRight []
    where moveRight [] h = [h]
          moveRight l h = newL ++ [h + extra]
            where extra = max 0 (last l - length l + 1)
                  newL = init l ++ [last l - extra]

solveTest :: [Int] -> String
solveTest nums = if strictlyIncreasing . reshape $ nums
                    then "YES"
                    else "NO"

solve :: String -> String
solve = unlines . map (solveTest . map read . words) . odds . drop 1 . lines
    where odds (_:x:xs) = x : odds xs
          odds [] = []

main :: IO ()
main = interact solve


You are walking through a parkway near your house. The parkway has $$$n+1$$$ benches in a row numbered from $$$1$$$ to $$$n+1$$$ from left to right. The distance between the bench $$$i$$$ and $$$i+1$$$ is $$$a_i$$$ meters.Initially, you have $$$m$$$ units of energy. To walk $$$1$$$ meter of distance, you spend $$$1$$$ unit of your energy. You can't walk if you have no energy. Also, you can restore your energy by sitting on benches (and this is the only way to restore the energy). When you are sitting, you can restore any integer amount of energy you want (if you sit longer, you restore more energy). Note that the amount of your energy can exceed $$$m$$$.Your task is to find the minimum amount of energy you have to restore (by sitting on benches) to reach the bench $$$n+1$$$ from the bench $$$1$$$ (and end your walk).You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n \le 100$$$; $$$1 \le m \le 10^4$$$). The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 100$$$), where $$$a_i$$$ is the distance between benches $$$i$$$ and $$$i+1$$$.

For each test case, print one integer — the minimum amount of energy you have to restore (by sitting on benches) to reach the bench $$$n+1$$$ from the bench $$$1$$$ (and end your walk) in the corresponding test case.

NoteIn the first test case of the example, you can walk to the bench $$$2$$$, spending $$$1$$$ unit of energy, then restore $$$2$$$ units of energy on the second bench, walk to the bench $$$3$$$, spending $$$2$$$ units of energy, restore $$$1$$$ unit of energy and go to the bench $$$4$$$.In the third test case of the example, you have enough energy to just go to the bench $$$6$$$ without sitting at all.

-- ID : 1697A (Parkway Walk)
-- URL: https://codeforces.com/problemset/problem/1697/A

import Control.Monad

readInt = read `fmap` getLine :: IO Int
readInts = map read `fmap` words `fmap` getLine :: IO [Int]

main = readInt >>= \t -> replicateM_ t $ readInts >>= \[n,m] -> readInts >>= \as -> print (max (sum as - m) 0)

-- ID:  1697A (A. Parkway Walk)
-- URL: https://codeforces.com/problemset/problem/1697/A

import Control.Monad

-- Fast IO
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
getInt64 = parseInt `fmap` BS8.getLine :: IO Int64
getInt64s = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int64]
parseInt = fromIntegral . fst . fromJust . BS8.readInt

main = do
    t <- read `fmap` getLine :: IO Int
    replicateM_ t solve

solve = do
    [n,m] <- getInt64s
    xs <- getInt64s
    print $ max (sum xs - m) 0

import Control.Monad (forM_)

readInts :: IO [Int]
readInts = getLine >>= pure . map read . words

main = do
    [t] <- readInts
    forM_ [1..t] (\_ -> do
        [n,m] <- readInts
        l <- readInts
        print $ max 0 (sum l - m))

(>>>) = flip (.)

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

solve :: [[Int]] -> Int
solve [[_, m], as] = max 0 $ sum as - m

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

-- ID : 1697A (Parkway Walk)
-- URL: https://codeforces.com/problemset/problem/1697/A

import Control.Monad

readInt = read `fmap` getLine :: IO Int
readInts = map read `fmap` words `fmap` getLine :: IO [Int]

main = readInt >>= \t -> replicateM_ t $ do
    [n,m] <- readInts
    as <- readInts
    print $ max (sum as) 0


AquaMoon and Cirno are playing an interesting game with arrays. Cirno has prepared two arrays $$$a$$$ and $$$b$$$, both consist of $$$n$$$ non-negative integers. AquaMoon can perform the following operation an arbitrary number of times (possibly zero):  She chooses two indices $$$i$$$ and $$$j$$$ ($$$1 \le i, j \le n$$$), then decreases the $$$i$$$-th element of array $$$a$$$ by $$$1$$$, and increases the $$$j$$$-th element of array $$$a$$$ by $$$1$$$. The resulting values at $$$i$$$-th and $$$j$$$-th index of array $$$a$$$ are $$$a_i - 1$$$ and $$$a_j + 1$$$, respectively. Each element of array $$$a$$$ must be non-negative after each operation. If $$$i = j$$$ this operation doesn't change the array $$$a$$$. AquaMoon wants to make some operations to make arrays $$$a$$$ and $$$b$$$ equal. Two arrays $$$a$$$ and $$$b$$$ are considered equal if and only if $$$a_i = b_i$$$ for all $$$1 \leq i \leq n$$$.Help AquaMoon to find a sequence of operations that will solve her problem or find, that it is impossible to make arrays $$$a$$$ and $$$b$$$ equal.Please note, that you don't have to minimize the number of operations.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 100$$$). The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \leq a_i \leq 100$$$). The sum of all $$$a_i$$$ does not exceed $$$100$$$. The third line of each test case contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$0 \leq b_i \leq 100$$$). The sum of all $$$b_i$$$ does not exceed $$$100$$$.

For each test case print "-1" on the only line if it is impossible to make two arrays equal with some sequence of operations. Otherwise, print an integer $$$m$$$ ($$$0 \leq m \leq 100$$$) in the first line — the number of operations. Then print $$$m$$$ lines, each line consists of two integers $$$i$$$ and $$$j$$$ — the indices you choose for the operation. It can be proven that if it is possible to make two arrays equal with some sequence of operations, there exists a sequence with $$$m \leq 100$$$. If there are multiple possible solutions, you can print any.

NoteIn the first example, we do the following operations:  $$$i = 2$$$, $$$j = 1$$$: $$$[1, 2, 3, 4] \rightarrow [2, 1, 3, 4]$$$;  $$$i = 3$$$, $$$j = 1$$$: $$$[2, 1, 3, 4] \rightarrow [3, 1, 2, 4]$$$; In the second example, it's impossible to make two arrays equal.

import Control.Arrow((>>>))
import Control.Monad (replicateM_, forM_)

main :: IO ()
main = readLn >>= (`replicateM_` testCase)

testCase :: IO ()
testCase = do
  _ <- getLine
  as <- map read . words <$> getLine
  bs <- map read . words <$> getLine
  case solve as bs of
    Nothing -> putStrLn "-1"
    Just ops -> do
      print $ length ops
      forM_ ops (\(i, j) -> putStrLn $ show i ++ " " ++ show j)

type Answer = Maybe [(Int, Int)]

solve :: [Int] -> [Int] -> Answer
solve as bs
  | length ps /= length ns = Nothing
  | otherwise = Just $ ps `zip` ns
  where
    xs = zipWith (-) as bs `zip` [1..]
    ps = idxs (> 0)
    ns = idxs (< 0)
    idxs f = concatMap (\(n, i) -> replicate (abs n) i) $ filter (f . fst) xs

import Control.Monad

solve a b = do
    guard (sum a == sum b)
    let ds = zip [1..] (zipWith (-) b a)
    let low = concat [replicate d i | (i, d) <- ds, d > 0]
    let high = concat [replicate (-d) i | (i, d) <- ds, d < 0]
    pure (zip high low)

interactCase = do
    _ <- getLine
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    case solve a b of
        Just l -> do
            print (length l)
            forM_ l $ \(i, j) -> putStrLn (show i ++ " " ++ show j)
        Nothing ->
            print (-1)

main = do
    testCount <- read <$> getLine
    replicateM_ testCount interactCase

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
import Data.Bits as B
import System.IO as Io
--import Data.Char as C
--import Data.IntSet as S

lower _ [] [] = []
lower idx (x:a) (y:b)
  | y > x = replicate (y-x) idx ++ lower (idx+1) a b
  | otherwise = lower (idx+1) a b

higher _ [] [] = []
higher idx (x:a) (y:b)
  | x > y = replicate (x-y) idx ++ higher (idx+1) a b
  | otherwise = higher (idx+1) a b

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = map read $ words sa :: [Int]
      b = map read $ words sb :: [Int]
      good = sum a == sum b
      res = (if good then zip (higher 1 a b) (lower 1 a b) else [])
      cnt = (if good then length res else -1)
      out = intercalate "\n" $ map (\(x,y) -> show x ++ " " ++ show y) res
    in mapM_ putStr [show cnt ++ "\n", if cnt > 0 then out ++ "\n" else ""]

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

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}

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.IO.Safe         as IOA
import qualified Data.Array.MArray.Safe     as MA
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.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import           Debug.Trace                (trace, traceM, traceShowM)
import           GHC.IO.Handle              (hDuplicateTo)

debug :: c -> String -> c
debug = flip trace
traced x = trace (show x) x
withTrace s x = trace (s ++ " -> " ++ show x) x

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

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

type Move = (Int, Int)

solve :: Int -> [Int] -> [Int] -> Maybe [Move]
solve n a b | sum a /= sum b = Nothing
solve n a b =
        Just $ zip decIdxs incIdxs
    where
        diffs = zipWith (-) a b
        indexedDiffs = zip diffs [1 ..]
        incIdxs = concatMap (\(e, i) -> replicate (max (-e) 0) i) indexedDiffs
        decIdxs = concatMap (\(e, i) -> replicate (max   e  0) i) indexedDiffs

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ \i -> do
        n <- B8.getLine <&> readIntB8
        a <- B8.getLine <&> map readIntB8 . B8.words
        b <- B8.getLine <&> map readIntB8 . B8.words

        let answer = solve n a b

        case answer of
          Nothing -> putStrLn "-1"
          Just moves -> do
              printf "%d\n" $ length moves
              forM_ moves $ uncurry (printf "%d %d\n")

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

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    b <- readInts
    let
      is = do
        (ix, ai, bi) <- zip3 [1..] a b
        replicate (ai - bi) ix
      js = do
        (ix, ai, bi) <- zip3 [1..] a b
        replicate (bi - ai) ix
    if  sum a /= sum b
      then  putInts [0-1]
      else  do
      putInts [length is]
      forM_ (zip is js) $ \(i, j) -> putInts [i, j]

type SIO = StateT P.ByteString IO

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

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

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

import Control.Arrow((>>>))
import Control.Monad (replicateM_, forM_)

main :: IO ()
main = readLn >>= (`replicateM_` testCase)

testCase :: IO ()
testCase = do
  _ <- getLine
  as <- map read . words <$> getLine
  bs <- map read . words <$> getLine
  case solve as bs of
    Nothing -> putStrLn "-1"
    Just ops -> do
      print $ length ops
      forM_ ops (\(i, j) -> putStrLn $ show i ++ " " ++ show j)

type Answer = Maybe [(Int, Int)]

solve :: [Int] -> [Int] -> Answer
solve as bs
  | length ps /= length ns = Nothing
  | otherwise = Just $ ps `zip` ns
  where
    xs = zipWith (-) as bs `zip` [1..]
    ps = idxs (> 0)
    ns = idxs (< 0)
    idxs f = map snd $ filter (f . fst) xs

import Control.Arrow((>>>))
import Control.Monad (replicateM_, forM_)

main :: IO ()
main = readLn >>= (`replicateM_` testCase)

testCase :: IO ()
testCase = do
  _ <- getLine
  as <- map read . words <$> getLine
  bs <- map read . words <$> getLine
  case solve as bs of
    Nothing -> putStrLn "-1"
    Just ops -> do
      print $ length ops
      forM_ ops (\(i, j) -> print $ show i ++ " " ++ show j)

type Answer = Maybe [(Int, Int)]

solve :: [Int] -> [Int] -> Answer
solve as bs
  | length ps /= length ns = Nothing
  | otherwise = Just $ ps `zip` ns
  where
    xs = zipWith (-) as bs `zip` [1..]
    ps = idxs (> 0)
    ns = idxs (< 0)
    idxs f = map snd $ filter (f . fst) xs