You have a large rectangular board which is divided into $$$n \times m$$$ cells (the board has $$$n$$$ rows and $$$m$$$ columns). Each cell is either white or black.You paint each white cell either red or blue. Obviously, the number of different ways to paint them is $$$2^w$$$, where $$$w$$$ is the number of white cells.After painting the white cells of the board, you want to place the maximum number of dominoes on it, according to the following rules:  each domino covers two adjacent cells;  each cell is covered by at most one domino;  if a domino is placed horizontally (it covers two adjacent cells in one of the rows), it should cover only red cells;  if a domino is placed vertically (it covers two adjacent cells in one of the columns), it should cover only blue cells. Let the value of the board be the maximum number of dominoes you can place. Calculate the sum of values of the board over all $$$2^w$$$ possible ways to paint it. Since it can be huge, print it modulo $$$998\,244\,353$$$.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 3 \cdot 10^5$$$; $$$nm \le 3 \cdot 10^5$$$) — the number of rows and columns, respectively. Then $$$n$$$ lines follow, each line contains a string of $$$m$$$ characters. The $$$j$$$-th character in the $$$i$$$-th string is * if the $$$j$$$-th cell in the $$$i$$$-th row is black; otherwise, that character is o.

Print one integer — the sum of values of the board over all $$$2^w$$$ possible ways to paint it, taken modulo $$$998\,244\,353$$$.

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

kMod :: Int
kMod = 998244353

toInt64 :: Int -> Int64
toInt64 = fromIntegral

fromInt64 :: Int64 -> Int
fromInt64 = fromIntegral

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

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

main :: IO ()
main = do
  [n, m] <- getInts
  ss <- replicateM n (fmap C.unpack C.getLine)
  let func xs = map length $ filter ((== 'o') . head) $ group xs
      result = sum $ map calc $ concat (map func ss) ++ concat (map func (transpose ss))
      f 1 = (Mint 0, [Mint 0])
      f 2 = (Mint 1, [Mint 1, Mint 0])
      f n = (p', 2 * f2 + f1 + p' : fs)
        where (p, fs@(f1 : f2 : _)) = f (n - 1)
              p' = p * 2
      arr = listArray (1, 300000) $ reverse $ snd $ f 300000
      num = length $ filter (== 'o') $ concat ss
      calc x = arr ! x * 2 ^ (num - x)
  putStrLn $ show result


Imagine that you have a twin brother or sister. Having another person that looks exactly like you seems very unusual. It's hard to say if having something of an alter ego is good or bad. And if you do have a twin, then you very well know what it's like.Now let's imagine a typical morning in your family. You haven't woken up yet, and Mom is already going to work. She has been so hasty that she has nearly forgotten to leave the two of her darling children some money to buy lunches in the school cafeteria. She fished in the purse and found some number of coins, or to be exact, n coins of arbitrary values a1, a2, ..., an. But as Mom was running out of time, she didn't split the coins for you two. So she scribbled a note asking you to split the money equally.As you woke up, you found Mom's coins and read her note. "But why split the money equally?" — you thought. After all, your twin is sleeping and he won't know anything. So you decided to act like that: pick for yourself some subset of coins so that the sum of values of your coins is strictly larger than the sum of values of the remaining coins that your twin will have. However, you correctly thought that if you take too many coins, the twin will suspect the deception. So, you've decided to stick to the following strategy to avoid suspicions: you take the minimum number of coins, whose sum of values is strictly more than the sum of values of the remaining coins. On this basis, determine what minimum number of coins you need to take to divide them in the described manner.

The first line contains integer n (1 ≤ n ≤ 100) — the number of coins. The second line contains a sequence of n integers a1, a2, ..., an (1 ≤ ai ≤ 100) — the coins' values. All numbers are separated with spaces.

In the single line print the single number — the minimum needed number of coins.

NoteIn the first sample you will have to take 2 coins (you and your twin have sums equal to 6, 0 correspondingly). If you take 1 coin, you get sums 3, 3. If you take 0 coins, you get sums 0, 6. Those variants do not satisfy you as your sum should be strictly more that your twins' sum.In the second sample one coin isn't enough for us, too. You can pick coins with values 1, 2 or 2, 2. In any case, the minimum number of coins equals 2.

import Data.List
main = interact $ show.g.f.reverse.sort.map read.words.last.lines

f = scanl1 (+)
g as = (+1).length.takeWhile (<=(last as/2)) $ as

import Data.List
loop :: [Int] -> Int -> Int -> Int
loop [] me he = 0
loop xl@(xh:xt) me he
     | me > he  = length xl
     | otherwise = loop xt (me + xh) (he - xh)

solve :: [Int] -> Int
solve coins = length coins - loop (reverse $ sort coins) 0 (sum coins)

main = do
  _ <- getLine
  coins <- (getLine >>= return . map (read::String->Int) . words)

  print $ solve coins

import Data.List as List
import Data.Maybe as Maybe

readAsInt :: String -> Int
readAsInt str = read str :: Int

isLargerAmount takenCoin coins = takenSum > restSum
	where takenSum = sum $ take takenCoin coins
	      restSum = sum $ drop takenCoin coins

getAnswer coins = foldl (\takenCoin elem ->
	if isLargerAmount takenCoin coins
	then takenCoin
	else takenCoin + 1) 1 coins

solveCase :: String -> IO ()
solveCase line = do
	let coins = map readAsInt $ words line
	let sortedCoin = reverse . sort $ coins
	let coinSum = sum sortedCoin
	print $ getAnswer sortedCoin

main = do
	line <- getLine
	sndLine <- getLine
	solveCase sndLine

import Data.List

solve :: [Int] -> Int
solve xs = fst $ (let s = sum xs in foldl (\(ct,sm) ar -> if sm <= (s-sm) then (ct+1, sm+ar) else (ct,sm)) (0, 0) xs)

run :: String -> String
run = show . solve . reverse . sort . tail . map read . words

main = interact run

import Data.List

solve :: [Int] -> Int
solve xs = fst $ (let s = sum xs in foldl (\(ct,sm) ar -> if sm <= (s-sm) then (ct+1, sm+ar) else (ct,sm)) (0, 0) xs)

run :: String -> String
run ls = show $ solve $ reverse $ sort  $ tail $ map read (words ls)

main = interact run

import Control.Monad
import Data.List (sort)

ans [] _ = 0
ans left@(x:xs) right = if sum left >= sum right then 1 + ans xs (x:right)
                                else 0

main = do
  getLine
  aa <- getLine
  let xs = reverse $ sort $ map read $ words aa :: [Int]
  print $ ans xs []

import Data.List
main=interact$show.f.map read.tail.words
f c = f' (sum c) (scanl1 (+) (reverse (sort c)))
	where f' s (x:xs)
		| s - x < x = 1
		| otherwise = 1 + f' s xs

module Main (main)
    where

import Data.Ord (compare)
import Data.List (sortBy, inits, tails)

main :: IO ()
main = print . solve . group' . map read . words =<< (getLine >> getLine)
    where solve = length . fst . head . dropWhile (\(a,b) -> sum a <= sum b)
          group' = (\xs -> zip (inits xs) (tails xs)) . sortBy (flip compare)

main = do
    getLine
    getLine>>=(\x->(putStr (solve (map read (words x)))))
solve x = show (result (qsort x) (sum x) 0 0)
qsort[]=[]
qsort(x:xs)=qsort[y|y<-xs,y>x]++[x]++qsort[y|y<-xs,y<=x]
result (x:xs) a b n
    |x+b>a-x        = n+1
    |x+b<=a-x       = result xs (a-x) (b+x) (n+1)

import Data.List (sort)

diff n xs =
  let (mine, theirs) = splitAt n xs in
      sum mine - sum theirs

f :: Int -> [Int] -> Int
f n xs = head [idx | idx <- [0..], diff idx xs > 0]

main = interact $ show . f 0 . reverse . sort . map read . tail . words

import Data.List
import Data.Maybe

-- Snippet: readItems
readItems = do
    line <- getLine
    return $ map read $ words line

main = do
    n <- getLine
    a <- readItems
    let sums = scanr (+) 0 (sort a)
    let defective = (< 1 + div (sum a) 2)
    putStrLn $ show $ 1 + length a - fromJust (findIndex defective sums)

import Data.List
fu xs s x | sum xs < s = x| otherwise = fu (tail xs) (head xs + s) (x+1)
solve xs = fu (reverse $ sort xs) 0 0
main = interact $ show . solve . tail. map read . words

import Data.List
solve :: [Int] -> Int
solve xs = solve_iter 0
    where xs' = sort xs
          sums = scanl (+) 0 xs'
          total = last sums
          l = length xs
          solve_iter i
              | sum2 > sum1 = i
              | otherwise = solve_iter (i+1)
              where (pre, suf) = splitAt (l - i + 1) sums
                    sum1 = last pre
                    sum2 = total - sum1
main = interact $ show .solve . map read . words . last . lines

import Data.List (sortBy)

solve :: Int -> Int -> [Int] -> Int -> Int
solve acc cnt (x:xs) s
	| acc > s = cnt
	| otherwise = solve (acc+x) (cnt+1) xs s
solve _ cnt [] _ = cnt

main :: IO ()
main = do
	_ <- getLine
	s <- getLine
	let ints = sortBy (flip compare) $ map read $ words s :: [Int]
	print $ solve 0 0 ints $ sum ints `div` 2

import Data.List

main = do
    getLine
    as <- fmap (map read . words) getLine
    let
        s = sum as
        ss = scanl1 (+) $ reverse $ sort as

    print $ (length $ takeWhile (\x -> 2*x <= s) ss) + 1

import Data.List
import Control.Applicative

main = do
    n <- readLn :: IO Int
    l <- map (read :: String -> Int) . words <$> getLine
    let sl = scanl (+) 0 $ reverse $ sort l
        s = sum l
        in print . length $ takeWhile (\x -> 2 * x <= s) sl

import Data.List

divToNum :: String -> [Int]
divToNum [] = []
divToNum l = (read h) : (divToNum t)
	where [(h,t)] = lex l

fL [x] f = x
fL (x:xs) f = f x $ fL xs f

solve l = solve' 0 0 (foldl (+) 0 l) l

solve' q s1 s2 l | (s1 + x > s2 - x) = q+1
                 | otherwise = solve' (q+1) (s1 + x) (s2 - x) (delete x l)
	where x = fL l max

main = getLine >> getLine >>= (print.solve.divToNum)

{-# LANGUAGE BlockArguments #-}

import Control.Arrow
import Data.List

main = do { n <- getLine
          ; x <- getLine
          ; putStrLn $ (words >>> map read >>> solve >>> show) x
          }

count :: Int -> Int -> (Int,Int) -> (Int,Int)
count s z (a,n) | a > s     = (a+z,n)
                | otherwise = (a+z,n+1)

solve :: [Int] -> Int
solve x = let s = (foldr (+) 0 x) `div` 2
              y = sort x
          in (foldr (count s) (0,0) >>> snd) y

import Data.List
f xs = foldl (\acc x -> if (sum acc) <= ((sum xs)/2) then x:acc else acc) [] xs
main = do
	getLine
	str <- getLine
	putStrLn . show . length . f . reverse . sort . map read . words $ str

import Data.List

main = do
    counter <- getLine
    str <- getLine
    let xs = map read $ words str :: [Int]
    let solve xs = _solve (sum xs) 0 (reverse (sort xs)) 0 where
        _solve _ _ [] i = i
        _solve sumXs sum1 (x:xs) i
            |   sum1 <= sumXs = _solve (sumXs - x) (sum1 + x) xs (i + 1)
        _solve _ _ _ i = i
    print (solve xs)

import Data.List

main = interact $ solve . map read . words . head . tail . lines

solve s = (show $ solve' (reverse $ sort s) (div (sum s) 2) 0) ++ "\n"
solve' [] _ _ = 0
solve' (x:xs) p c
  | c > p = 0
  | otherwise = 1 + solve' xs p (c+x)

import Control.Applicative
import Data.List

psum :: [Int] -> [Int]
psum a = f a 0
    where
      f [] r = []
      f (x:xs) r = (r + x) : (f xs (r + x))

solve :: [Int] -> Int
solve a = let aa = reverse $ sort a
              bb = psum aa
              cc = map (* 2) bb
              ss = sum a
          in  1 + (length $ takeWhile (<= ss) cc)

main = do
  n <- getLine
  a <- map read <$> (words <$> getLine)
  print $ solve a

import List
getAns ::[Int] -> Int
getAns a= length$last$takeWhile ((>sum a).(*2).sum)$tails$sort a
main = interact$show.getAns.(map read).tail.words

import Data.List
main = readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show . solve.map read. words. last. take 2 . lines
solve :: [Int]->Int
solve xs = length $ takeWhile (\x -> fromIntegral x <= fromIntegral s/2) $ scanl (+) 0 $ reverse $ sort xs
  where s=sum xs

import List

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

solve :: [Int] -> Int
solve xs  =  solve' (0, sum xs, 0) (reverse (sort xs))
  where
    solve' :: (Int, Int, Int) -> [Int] -> Int
    solve' (n, s, s1) []      =  n
    solve' (n, s, s1) (x:xs)
      | s1 > s - s1  =  n
      | otherwise    =  solve' (n+1, s, s1+x) xs

main :: IO ()
main  =  getLine >> Main.reads >>= print . solve

-- Codeforces 160A

import Data.List

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    getLine >>= print . solve . sortBy (\a b -> compare b a) . map read . words

solve :: [Int] -> Int
solve xs = length $ takeWhile (\x -> x <= (sum xs) `div` 2) $ foldl (\x a -> x ++ [last x + a]) [0] xs

import Control.Monad
import Control.Applicative
import Data.List (sort)

main = do
  n <- read <$> getLine :: IO Int
  cs <- map read . words <$> getLine :: IO [Int]
  let scs = scanl1 (+) . reverse $ sort cs
      hsm = div (last scs + (n-n)) 2
      (rs,ls) = span (<=hsm) scs
      m = length rs
  print $ if null rs || last rs <= hsm then m + 1 else m

import List

solve xs = let ys = scanl (+) 0 $ reverse $ sort xs
               zs = zipWith (-) (repeat $ sum xs) ys
           in length $ takeWhile (\(y, z) -> y <= z) $ zip ys zs

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

import Data.Function
import Data.List

main = do
	n <- getLine
	coins <- getCoins
	let cap = (foldr (+) 0 coins) `div` 2
	let res = fix (\f sum i r -> if sum > cap || i < 0
								then r
								else f (coins !! i + sum) (i - 1) (r + 1)) 0 (length coins - 1) 0
	putStrLn $ show res

getCoins::IO [Int]
getCoins = do
	args <- getLine
	return . sort $ map readInt $ split args ' '

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

split::String -> Char -> [String]
split str sep = foldr (\c prev -> if c == sep
									then "":prev
									else (c:(head prev)):(tail prev)) [""] str

import Data.List (sort)

splitSpace::[Char] -> [Char] -> [[Char]] -> [[Char]]
splitSpace (l:xl) acc result | length(xl) == 0 = result ++ [acc ++ [l]]
                             | l == ' ' = splitSpace (xl) ("") (result ++ [acc])
                             | otherwise = splitSpace xl (acc ++ [l]) result

readInts a = reverse (sort $ map (\x -> read x :: Int) (splitSpace a [] []))

solve a b c | b > sum a = c
            | otherwise = solve (tail a) (b + head a) (c + 1)

doSolve a = putStrLn $ show (solve a 0 0)
main = getLine >>= (\a -> (\b -> getLine >>= (\c -> doSolve (readInts c)))(a))

import Control.Monad
import Data.Array
import Data.Char
import Data.List
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: [Int] -> Int
solve a = (+1) . length . takeWhile (<= sum a `div` 2) . scanl1 (+) . sortBy (flip compare) $ a

main :: IO ()
main = do
        _ <- getLine
        a <- getIntList
        putStrLn . show $ solve a

import Control.Monad
import Data.Array
import Data.Char
import Data.List
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: [Int] -> Int
solve a = (+1) . length . takeWhile (<= sum a `div` 2) . scanl1 (+) . reverse . sort $ a

main :: IO ()
main = do
        _ <- getLine
        a <- getIntList
        putStrLn . show $ solve a

import Data.List
import Control.Applicative

readInts :: IO [Int]
readInts = do
  getLine
  i <- getLine
  return $ map read $ words i

solve :: [Int] -> Int
solve coins = ans
  where c' = sort coins
        total = sum coins `div` 2
        (_, ans, _) = foldr (\e (s, n, out) -> if not out then (s + e, n + 1, s + e > total) else (s, n, out)) (0, 0, False) c'

main :: IO ()
main = print =<< solve <$> readInts

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

process::[Int]->Int->Int->Int->Int
process a sa sc n | sc>sa =n
                  | otherwise = process (tail a) (sa-head a) (sc+head a) (n+1)
main::IO ()
main=do
     getLine
     a<- reverse <$> sort <$> map read <$> words <$> getLine
     print $ process a (sum a) 0 0

main = do
	_ <- getLine
	line <- getLine
	let numbers = separate line
	let sorted = quicksort numbers
	let half = div (sum sorted) 2
	print $ calc sorted 0 0 half

separate :: String -> [Int]
separate = map read . words

quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) =
    let smallerSorted = quicksort [a | a <- xs, a <= x]
        biggerSorted = quicksort [a | a <- xs, a > x]
    in  biggerSorted ++ [x] ++ smallerSorted

calc :: [Int] -> Int -> Int -> Int -> Int
calc [] i _ _ = i
calc (t:tab) i sum half = if sum > half
	then i
	else calc tab (i+1) (sum+t) half

module Main(main) where

import Control.Arrow
import Data.List
import Data.Maybe

main = interact $ words >>> tail >>> map read >>> sortBy (flip compare) >>> scanl (+) 0 >>>
  ((last >>> (`div` 2) >>> (<)) >>= findIndex) >>> fromJust >>> show

module Main where

import Control.Arrow
import Data.List

main = interact $ words >>> tail >>> map read >>> sortBy (flip compare) >>> scanl (+) 0 >>>
  (\x -> takeWhile (<= (last x `div` 2)) x) >>> length >>> show

import Data.List (sort)

main :: IO ()
main = getContents >>= print . solve . map read . words . (!!1) . lines

solve :: [Int] -> Int
solve as = length as - length (takeWhile (<= ((sum as - 1) `div` 2)) (scanl1 (+) (sort as)))

import Prelude hiding (readList)
import Control.Monad
import Control.Applicative
import Data.List

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

readList' :: Read a => a -> IO [a]
readList' _ = readList

showList :: Show a => [a] -> IO ()
showList = putStrLn . unwords . map show

skipLine :: IO ()
skipLine = void $ getLine

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

divUp :: Integral a => a -> a -> a
divUp x y
  | x `mod` y /= 0 = x `div` y + 1
  | otherwise      = x `div` y

main :: IO ()
main = do
  skipLine
  as <- (reverse . sort) <$> readList' (undefined::Int)
  let sm = sum as
      ass = tail $ scanl (+) 0 as
  print $ (+1) $ length $ takeWhile (\a -> 2*a <= sm) ass

import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B

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

solve :: [Int] -> Int
solve xs = fst
         $ foldr (\b (c, tot) -> if tot > half
                                 then (c, tot)
                                 else (c+1, tot+b)) (0, 0)
         $ sort xs
    where half = div (sum xs) 2

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

import Data.List(sortBy)

solve' [] _ _ l     = l
solve' (x:xs) n m l = if (n + x > m - x) then l + 1 else solve' xs (n + x) (m - x) (l + 1)

solve :: [Int] -> Int
solve xs = solve' (sortBy (flip compare) xs) 0 (sum xs) 0

main = do
    getLine
    xs <- fmap (map read . words) getLine
    print $ solve xs

import Data.List

takeCoins :: [Int] -> Int -> Int -> Int -> Int
takeCoins [] s c n = n
takeCoins (x:xs) s c n
  | c * 2 > s = n
  | otherwise = takeCoins xs s (c + x) (n + 1)

main = do
  getLine
  s <- getLine
  let nums = map read $ words s
  print $ takeCoins (reverse $ sort nums) (sum nums) 0 0

import Data.List
main = print . solve . map read . tail . words =<< getContents
solve cs = succ $ length $ takeWhile ((<= s) . (*2)) $
           scanl1 (+) $ reverse $ sort cs
    where s = sum cs

import Data.List
main = do
    getLine
    s <- getLine
    print . solve . map read . words $ s
solve xs = length . takePartGT needMoreThan . reverse . sort $ xs
    where needMoreThan = sum xs `div` 2
takePartGT n (x:xs) | x > n = [x]
                    | otherwise = x : takePartGT (n-x) xs

-- Vicfred
-- https://codeforces.com/problemset/problem/160/A

import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as B

getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: [Int] -> Int
solve a = (+1) . length . takeWhile (<= sum a `div` 2) . scanl1 (+) . sortBy (flip compare) $ a

main = do
    _ <- getLine
    a <- getIntList
    putStrLn . show $ solve a

import Data.List
main = interact $ show . g . scanl1 (+) . reverse . sort . map read . tail . words
g l = (+1) . length . takeWhile (<= (last l)/2) $ l

import Data.List

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

solve (_:xs) = succ . length . takeWhile (<=(sum xs)`div`2) . scanl1 (+) . reverse $ sort xs

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

main :: IO ()
main = sortBy (flip compare) . map read . words . (!!1) <$> replicateM 2 getLine >>= print . (\ns -> solve (sum ns `div` 2) ns)
  where solve _ [] = 0
        solve n (x:xs) | n < x = 1
                       | otherwise = 1 + solve (n-x) xs

import Data.List

solve :: [Int] -> Int -> Int
solve [] left = 0
solve (x:xs) left
  | left < 0 = 0
  | otherwise = 1 + solve xs (left-x)

main = do
  str <- getLine
  str <- getLine
  let
    vs = reverse . sort . map read $ words str
    ans = solve vs $ (sum vs) `div` 2
  putStrLn $ show ans

f1 :: [Int] -> Int
f1 a =
  let t = div (sum a) 2 + 1
  in 1 + (length $ filter (\x -> x < t) $ scanl1 (+) $ msort' a)

msort' :: [Int] -> [Int]
msort' [] = []
msort' [x] = [x]
msort' x = merge' left right
  where left  = msort' $ take m x
        right = msort' $ drop m x
        m = div (length x + 1) 2

merge' :: [Int] -> [Int] -> [Int]
merge' [] [] = []
merge' (x:xs) [] = (x:merge' xs [])
merge' [] (y:ys) = (y:merge' ys [])
merge' (x:xs) (y:ys)
  | x >= y    = (x:merge' xs (y:ys))
  | otherwise = (y:merge' (x:xs) ys)

main = do
  _ <- getLine
  a <- readIntList
  putStrLn $ show $ f1 a

-- [Int] from line
readIntList :: IO [Int]
readIntList = do
  line <- getLine
  return $ map read $ words line

module Main where

import Control.Monad (sequence)
import Data.List (sortBy)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as BS

readNumber :: IO Int
readNumber =
  (fst
   . fromJust
   . BS.readInt) `fmap` BS.getLine

readNumbers :: IO [Int]
readNumbers =
 (fromJust
  . fmap (map fst)
  . sequence
  . map BS.readInt
  . BS.words) `fmap` BS.getLine

twinCoins :: [Int] -> Int
twinCoins coinList0 = step (0, 0, coinList)
  where
    coinList   = sortBy (flip compare) coinList0

    step (_, coinCount, []) = coinCount
    step (coinSum, coinCount, remainingCoins)
      | coinSum > sum (remainingCoins) = coinCount
      | otherwise = step ( coinSum + head remainingCoins
                         , succ coinCount
                         , tail remainingCoins )

main :: IO ()
main = do
  nCoins <- readNumber
  coinList <- take nCoins `fmap` readNumbers
  print (twinCoins coinList)

import Data.List
s l=length$last$takeWhile((>sum l).(*2).sum)$tails$sort l
main=interact$show.s.map read.tail.words

import Data.List

sanitize = reverse . sort

solve xs = fu (sanitize xs) 0 0

fu xs s count
  | sum xs < s = count
  | otherwise = fu (tail xs) (head xs + s) (count + 1)

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

import Data.List (sort)
main :: IO ()
main = do
    _      <- getLine
    coins' <- getLine
    print $ sneakyCoins $ (reverse . sort) $ map read $ words coins'
    return ()

sneakyCoins :: [Int] -> Int
sneakyCoins coins = snd $ foldl (\(amount, num) x -> if 2 * amount > total
                                                       then (amount, num)
                                                       else (amount + x, num + 1)) (0,0) coins
  where total = sum coins

import Data.List
--input Matrix test

inputIntArray :: IO [Int]
inputIntArray = getLine >>=
  \line -> return (map read $ words line)

nCoins :: [Int] -> IO ()
nCoins coins = print $ length coins - re 0 (sortOn (*(-1)) coins) (sum coins)
  where
    re :: Int -> [Int] -> Int -> Int
    re sum (c:cs) total
      | sum > total `div` 2 = length (c:cs)
      | True = re (sum + c) cs total
    re _ cs _ = length cs

main :: IO ()
main = getLine >> inputIntArray >>= nCoins

import Control.Applicative
import Data.Char
import Data.List

main= do
	getLine
 	s<-map read. words <$> getLine ::IO [Int]
	let s1 = tail $ scanl (+) 0 $ reverse $ sort s
	let sum1 = sum s
	let s2 = div sum1 2
	let ans=  length $ takeWhile (<=s2) s1
	print $  ans +1

{-
A. Twins
==========
time limit per test: 2 seconds
memory limit per test: 256 megabytes
input: standard input
output: standard output

Imagine that you have a twin brother or sister. Having another person that looks exactly like you seems very unusual. It's hard to say if having something of an alter ego is good or bad. And if you do have a twin, then you very well know what it's like.

Now let's imagine a typical morning in your family. You haven't woken up yet, and Mom is already going to work. She has been so hasty that she has nearly forgotten to leave the two of her darling children some money to buy lunches in the school cafeteria. She fished in the purse and found some number of coins, or to be exact, n coins of arbitrary values a1, a2, ..., an. But as Mom was running out of time, she didn't split the coins for you two. So she scribbled a note asking you to split the money equally.

As you woke up, you found Mom's coins and read her note. "But why split the money equally?" — you thought. After all, your twin is sleeping and he won't know anything. So you decided to act like that: pick for yourself some subset of coins so that the sum of values of your coins is strictly larger than the sum of values of the remaining coins that your twin will have. However, you correctly thought that if you take too many coins, the twin will suspect the deception. So, you've decided to stick to the following strategy to avoid suspicions: you take the minimum number of coins, whose sum of values is strictly more than the sum of values of the remaining coins. On this basis, determine what minimum number of coins you need to take to divide them in the described manner.

Input
-----
The first line contains integer n (1 ≤ n ≤ 100) — the number of coins. The second line contains a sequence of n integers a1, a2, ..., an (1 ≤ ai ≤ 100) — the coins' values. All numbers are separated with spaces.

Output
-------
In the single line print the single number — the minimum needed number of coins.

Sample test(s)
--------------
input
```
2
3 3
```
output
```
2
```

input
```
3
2 1 2
```
output
```
2
```

Note
-----
In the first sample you will have to take 2 coins (you and your twin have sums equal to 6, 0 correspondingly). If you take 1 coin, you get sums 3, 3. If you take 0 coins, you get sums 0, 6. Those variants do not satisfy you as your sum should be strictly more that your twins' sum.

In the second sample one coin isn't enough for us, too. You can pick coins with values 1, 2 or 2, 2. In any case, the minimum number of coins equals 2.
-}

import Data.List (sort)

reader :: String -> [Int]
reader s = map read $ words ss
  where _:ss:_ = lines s

numberOfTakingCoins :: [Int] -> Int
numberOfTakingCoins xs = (length . takeWhile (\k -> 2 * k <= total) $ scanl1 (+) ys) + 1
  where ys = reverse $ sort xs
        total = sum xs

main = do
  input <- getContents
  let coins = reader input
  print $ numberOfTakingCoins coins

import Control.Applicative
main = do
  getLine
  m <- getLine
  let n = (quicksort . map read . words) m
  print $ more n
quicksort :: Ord a => [a] -> [a]
quicksort [] = []
quicksort [x] = [x]
quicksort (x:xs) = (quicksort $ filter (>x) xs) ++ [x] ++ (quicksort $ filter (<=x) xs)
mid :: (Ord a, Num a) => Int -> [a] -> Bool
mid x = (>) <$> (sum . take x) <*> (sum . drop x)
-- some more beautiful way would exist
more :: (Ord a, Num a) => [a] -> Int
-- more [] = error
more x = (+) 1 $ length $ takeWhile (==False) [mid y x | y <- [1..]]

import           Data.List
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    coins <- sort . map (read :: String -> Int) . words <$> getLine
    let s = sum coins
    let sums = scanl (+) 0 coins
    let pos = length $ takeWhile (\x -> x < s - x) sums
    print $ n - (pos - 1)

import Data.List

main = interact $ show . f . sortBy (flip compare) . map read . words . (!! 1) . lines
         where f x = g x (sum x) 0 0
               g (x:xs) s c t = if c + c > s then t else g xs s (c + x) (t + 1)
               g [] _ _ t = t

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

f :: Int -> [Int] -> Int
f s [] = 0
f s xxs@(x:xs)
 | s > foldl (+) 0 xxs = 0
 | otherwise = 1 + (f (s+x) xs)

main :: IO ()
main = do
	nn <- getLine
	line <- getLine
	let
		n = read nn :: Int
		arr = reverse.sort. map (\x -> read x :: Int).words $ line
	print $ f 0 arr

import Data.List

main = getLine >> getLine >>= putStrLn.show.solve.reverse.sort.map read.words

solve :: [Int] -> Int
solve coins = search (sum coins) 0 coins

search :: Int -> Int -> [Int] -> Int
search sum s []    = 0
search sum s (c:oins)
       | sum < s   = 0
       | otherwise = succ $ search (sum-c) (s+c) oins

import Data.List (sort)

process :: [Int] -> Int
process xs = succ.length.takeWhile (<=mid).scanl1 (+).reverse.sort $ xs
    where mid = (sum xs) `div` 2

readInt :: String -> Int
readInt = read

main = do
    n <- fmap readInt getLine
    as <- fmap (map readInt.words) getLine
    print $ process as

import Data.List

ans xs = length.takeWhile (<m) $  scanl1 (+) xs
    where m=(sum xs+1) `div` 2

main = do
    m<-getLine
    n<-getLine
    let input = sort $ map (\x->read x::Int) $ words n
    print $ (read m)-(ans input)

import Data.List
main = do
    (_:t) <- fmap (map read . words) getContents :: IO [Int]
    let a = zip [1..] $ scanl1 (+) $ sortBy (\x y->compare y x) t
    let sum = snd $ last a
    print $ fst . head $ dropWhile (\x->snd x <= sum - snd x) a

qsort3 :: Ord a => [a] -> [a]
qsort3 x = qsort3' x []

qsort3' [] y     = y
qsort3' [x] y    = x:y
qsort3' (x:xs) y = part xs [] [x] []
    where
        part [] l e g = qsort3' l (e ++ qsort3' g y)
        part (z:zs) l e g
            | z < x     = part zs l e (z:g)
            | z > x     = part zs (z:l) e g
            | otherwise = part zs l (z:e) g

s x = s' x (sum x) 0 0  where
    s' [] _ t _ = t
    s' (x:xs) p t r | p < 2*r = t
                    | otherwise = s' xs p (t+1) (r+x)

main = interact $ show . s . qsort3 . map read . tail . words

import Data.List
import Data.Ord

coins :: [Int] -> Int
coins inp = length takenm1 + 1
    where sorted = sortBy (comparing Down) inp
          total = sum sorted
          partialSums = tail $ scanl (+) 0 sorted
          takenm1 = takeWhile (\x -> x <= total - x) partialSums

solve :: String -> String
solve = show . coins . map read . words . last . lines

main :: IO ()
main = interact solve

import Control.Monad
import Data.List (sort)

ans [] _ = 0
ans left@(x:xs) right = if sum left >= sum right then 1 + ans xs (x:right)
                                else 0

main = do
  getLine
  aa <- getLine
  let xs = map read $ words aa :: [Int]
  print $ ans xs []

import Control.Monad
import Data.List (sort)

ans [] _ = 0
ans left@(x:xs) right = if sum left >= sum right then 1 + ans xs (x:right)
                                else 0

main = do
  getLine
  aa <- getLine
  let xs = sort $ map read $ words aa :: [Int]
  print $ ans xs []

import Data.List
main=interact$show.f.map read.tail.words
f c = f' (sum c) (scanl1 (+) (sort c))
	where f' s (x:xs)
		| s - x < x = 1
		| otherwise = 1 + f' s xs

module Main (main)
    where

import Data.List (sort, inits, tails)

main :: IO ()
main = print . solve . group . sort . map read . words =<< (getLine >> getLine)
    where solve = length . fst . head . dropWhile (\(a,b) -> sum a <= sum b)
          group xs = zip (inits xs) (tails xs)

main = do
    getLine
    getLine>>=(\x->(putStr (solve (map read (words x)))))
solve x = show (result (qsort x) (sum x) 0 0)
qsort[]=[]
qsort(x:xs)=qsort[y|y<-xs,y<x]++[x]++qsort[y|y<-xs,y>=x]
result (x:xs) a b n
    |x+b>a-x        = n+1
    |x+b<=a-x       = result xs (a-x) (b+x) (n+1)

import Data.List (sort)

f :: Int -> [Int] -> Int
f n xs =
  let (mine, theirs) = splitAt n xs
  in if sum mine > sum theirs
    then n
    else f (n+1) xs

main = interact $ show . f 0 . sort . map read . tail . words

import Data.List

main = do
    getLine
    as <- fmap (map read . words) getLine
    let
        bs = reverse $ sort as
        s = sum as
        ss = scanl1 (+) bs

    print $ length $ takeWhile (\x -> 2*x <= s) ss

import Data.List

divToNum :: String -> [Int]
divToNum [] = []
divToNum l = (read h) : (divToNum t)
	where [(h,t)] = lex l

minL [x] = x
minL (x:xs) = min x $ minL xs

solve l = solve' ([],0) (l,foldl (+) 0 l)
solve' (l1,s1) (l2,s2) | (s1 > s2) = length l1
                       | otherwise = solve' ((x:l1),s1+x) (delete x l2, s2-x)
      where x = minL l2

main = getLine >> getLine >>= (print.solve.divToNum)

import Data.List

main = do
    counter <- getLine
    let n = read counter :: Int
    str <- getLine
    let xs = map read $ words str :: [Int]
    let sorted = reverse (sort xs)
    let sumXs = sum xs
    let solve sorted = _solve sumXs 0 xs 0 where
        _solve _ _ [] i = i
        _solve sumXs sum1 (x:xs) i
            |   sum1 <= sumXs = _solve (sumXs - x) (sum1 + x) xs (i + 1)
        _solve _ _ _ i = i
    print (solve sorted)

import Control.Monad
import Control.Applicative
import Data.List (sort)

main = do
  n <- read <$> getLine :: IO Int
  cs <- map read . words <$> getLine :: IO [Int]
  let scs = sort cs
      hsm = div (sum scs + (n-n)) 2
  print . length . takeWhile (<=hsm+1) $ scanl1 (+) scs

import Control.Monad
import Control.Applicative
import Data.List (sort)

main = do
  n <- read <$> getLine :: IO Int
  cs <- map read . words <$> getLine :: IO [Int]
  let scs = scanl1 (+) $ sort cs
      hsm = div (last scs + (n-n)) 2
      (rs,ls) = span (<=hsm) scs
      m = length rs
  print $ if last rs == hsm then m + 1 else m

import Data.List
import Control.Applicative

readInts :: IO [Int]
readInts = do
  getLine
  i <- getLine
  return $ map read $ words i

solve :: [Int] -> Int
solve coins = ans + 1
  where c' = sort coins
        total = sum coins `div` 2
        (_, ans) = foldr (\e (s, n) -> if s + e > total then (s, n) else (s + e, n + 1)) (0, 0) c'

main :: IO ()
main = print =<< solve <$> readInts

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

main::IO ()
main=do
     getLine
     a<- reverse <$> sort <$> map read <$> words <$> getLine
     let b = div ((sum a)+1) 2
     let c = scanl1 (+) a
     print $ (+) 1 $ length $ takeWhile (<=b) c

import Data.List (sort)

main :: IO ()
main = getContents >>= print . solve . map read . words . (!!1) . lines

solve :: [Int] -> Int
solve as = length as - length (takeWhile (< (sum as `div` 2)) (scanl1 (+) (sort as)))

import Data.List(sort)

solve' [] _ _ l     = l
solve' (x:xs) n m l = if (n + x > m - x) then l + 1 else solve' xs (n + x) (m - x) (l + 1)

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

main = do
    getLine
    xs <- fmap (map read . words) getLine
    print $ solve $ sort xs

import Data.List
main = do
    getLine
    s <- getLine
    print . solve . map read . words $ s
solve xs = length . takePartGT needMoreThan . sort $ xs
    where needMoreThan = sum xs `div` 2
takePartGT n (x:xs) | x > n = [x]
                    | otherwise = x : takePartGT (n-x) xs

import Data.List

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

solve :: [Int] -> Int
solve xs = length . dropWhile (<(sum xs)`div`2) $ scanl1 (+) xs

import Data.List

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

solve (_:xs) = succ . length . takeWhile (<=(sum xs)`div`2) . scanl1 (+) $ sort xs

import Data.List
--input Matrix test

inputIntArray :: IO [Int]
inputIntArray = getLine >>=
  \line -> return (map read $ words line)

nCoins :: [Int] -> IO ()
nCoins coins = print $ length coins - re 0 coins (sum coins)
  where
    re :: Int -> [Int] -> Int -> Int
    re sum (c:cs) total
      | sum > total `div` 2 = length (c:cs)
      | True = re (sum + c) cs total
    re _ cs _ = length cs

main :: IO ()
main = getLine >> inputIntArray >>= nCoins

import Control.Applicative
import Data.Char
import Data.List

main= do
	getLine
 	s<-map read. words <$> getLine ::IO [Int]
	let s1 = scanl (+) 0 $ reverse $ sort s
	let sum1 = sum s
	let s2 = (div sum1 2 ) + (if (even sum1) then 1 else 0)
	print $ length $ takeWhile (<=s2) s1

import Control.Applicative
import Data.Char
import Data.List

main= do
	getLine
 	s<-map read. words <$> getLine ::IO [Int]
	let s1 = tail $ scanl (+) 0 $ reverse $ sort s
	let sum1 = sum s
	let s2 = (div sum1 2 ) + (if (even sum1) then 1 else 0)
	print $ length $ takeWhile (<=s2) s1

import Control.Applicative
import Data.Char
import Data.List

main= do
	getLine
 	s<-map read. words <$> getLine ::IO [Int]
	let s1 = tail $ scanl (+) 0 $ reverse $ sort s
	let sum1 = sum s
	let s2 = (div sum1 2 ) + (if (even sum1) then 1 else 0)
	let ans=  length $ takeWhile (<s2) s1
	print $  ans + 1

import Data.List

main = interact $ show . f . sortBy (flip compare) . map read . words . (!! 1) . lines
         where f x = g x (sum x) 0 0
               g (x:xs) s c t = if c + c > s then t else g xs s (c + x) (t + 1)
               g [] _ _ _ = 0

qsort3 :: Ord a => [a] -> [a]
qsort3 x = qsort3' x []

qsort3' [] y     = y
qsort3' [x] y    = x:y
qsort3' (x:xs) y = part xs [] [x] []
    where
        part [] l e g = qsort3' l (e ++ qsort3' g y)
        part (z:zs) l e g
            | z > x     = part zs l e (z:g)
            | z < x     = part zs (z:l) e g
            | otherwise = part zs l (z:e) g

s x = s' x (sum x) 0 0  where
    s' [] _ t _ = t
    s' (x:xs) p t r | p < 2*r = t
                    | otherwise = s' xs p (t+1) (t+x)

main = interact $ show . s . qsort3 . map read . tail . words

qsort3 :: Ord a => [a] -> [a]
qsort3 x = qsort3' x []

qsort3' [] y     = y
qsort3' [x] y    = x:y
qsort3' (x:xs) y = part xs [] [x] []
    where
        part [] l e g = qsort3' l (e ++ qsort3' g y)
        part (z:zs) l e g
            | z < x     = part zs l e (z:g)
            | z > x     = part zs (z:l) e g
            | otherwise = part zs l (z:e) g

s x = s' x (sum x) 0 0  where
    s' [] _ t _ = t
    s' (x:xs) p t r | p < 2*r = t
                    | otherwise = s' xs p (t+1) (t+x)

main = interact $ show . s . qsort3 . map read . tail . words


Last summer, Feluda gifted Lalmohan-Babu a balanced bracket sequence $$$s$$$ of length $$$2 n$$$.Topshe was bored during his summer vacations, and hence he decided to draw an undirected graph of $$$2 n$$$ vertices using the balanced bracket sequence $$$s$$$. For any two distinct vertices $$$i$$$ and $$$j$$$ ($$$1 \le i < j \le 2 n$$$), Topshe draws an edge (undirected and unweighted) between these two nodes if and only if the subsegment $$$s[i \ldots j]$$$ forms a balanced bracket sequence.Determine the number of connected components in Topshe's graph.See the Notes section for definitions of the underlined terms.

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of opening brackets in string $$$s$$$. The second line of each test case contains a string $$$s$$$ of length $$$2 n$$$ — a balanced bracket sequence consisting of $$$n$$$ opening brackets "(", and $$$n$$$ closing brackets ")". It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, output a single integer — the number of connected components in Topshe's graph.

NoteSample explanation:In the first test case, the graph constructed from the bracket sequence (), is just a graph containing nodes $$$1$$$ and $$$2$$$ connected by a single edge. In the second test case, the graph constructed from the bracket sequence ()(()) would be the following (containing two connected components):  Definition of Underlined Terms: A sequence of brackets is called balanced if one can turn it into a valid math expression by adding characters $$$+$$$ and $$$1$$$. For example, sequences (())(), (), and (()(())) are balanced, while )(, ((), and (()))( are not. The subsegment $$$s[l \ldots r]$$$ denotes the sequence $$$[s_l, s_{l + 1}, \ldots, s_r]$$$. A connected component is a set of vertices $$$X$$$ such that for every two vertices from this set there exists at least one path in the graph connecting these vertices, but adding any other vertex to $$$X$$$ violates this rule.

import qualified Data.Map.Strict as M
import Data.List (nub)
import Data.Maybe (fromJust)
import Data.Array
import Data.Map.Strict (Map(..))
import Control.Monad (replicateM_, foldM)
import Data.Array.ST
import Control.Monad.ST

data Paren = LP | RP deriving (Eq)

main = read <$> getLine >>= flip replicateM_ scase

scase = read <$> getLine >>= \n -> getLine >>= print . numComps n . map fC
  where fC '(' = LP
        fC ')' = RP

numComps :: Int -> [Paren] -> Int
numComps n ps = (numParents n . fst . fromJust . parensToPPT) ps
-- numComps n = numParents' . fromJust . parensToPPT' n
-- numComps = numParents''

numParents :: Int -> Map Int Int -> Int
numParents n = uniqueInts (2*n) . M.elems

-- fst is node->parent map (both are open brace indices)
-- snd is open node-> close node map
type MT = (Map Int Int, Map Int Int)
{-
  The closing paren for each node is not determined until it actually closes.
First we can just keep children and when the node actually closes we can mark the closing number.
-}
-- convert a list of 2n paranthesis to a parent pointer tree
parensToPPT :: [Paren] -> Maybe MT
parensToPPT xs = let m :: MT
                     m = (M.empty, M.empty)
                     f :: Int -> [Paren] -> [Int] -> MT -> Maybe MT
                     f _ [] [] m = Just m
                     f i (LP:xs) s m = f (i+1) xs (i:s) m
                     f _ (RP:_) [] _ = Nothing -- stack is empty and we have ')'
                     f i (RP:xs) (o:s) m = f (i+1) xs s (closeWith i o s m)
                     closeWith c o [] (pM, oM) = (M.insert o 0 pM, M.insert o c oM) -- top nodes have 0 as parent
                     closeWith c o (p:_) (pM, oM) = (M.insert o p pM, M.insert o c oM)
                 in f 1 xs [] m

numParents' :: Array Int Int -> Int
numParents' = length . nub . elems

parensToPPT' :: Int -> [Paren] -> Maybe (Array Int Int) -- direct array parent pointer tree
parensToPPT' n xs = let a = listArray (1, 2*n) [0,0..]
                        f :: Int -> [Paren] -> [Int] -> Array Int Int -> Maybe (Array Int Int)
                        f _ [] [] a = Just a
                        f i (LP:xs) s a = f (i+1) xs (i:s) a
                        f _ (RP:_) [] _ = Nothing
                        f i (RP:xs) (o:s) a = f (i+1) xs s (if null s then a else (a//[(o, head s)]))
                    in f 1 xs [] a

numParents'' :: Int -> [Paren] -> Int
numParents'' n xs = let f :: Int -> [Paren] -> [Int] -> ST s (STArray s Int Int) -> Maybe (ST s (STArray s Int Int))
                        f _ [] [] a = Just a
                        f i (LP:xs) s a = f (i+1) xs (i:s) a
                        f _ (RP:_) [] _ = Nothing
                        f i (RP:xs) (o:s) a = f (i+1) xs s (if null s then a else (a >>= \ai -> writeArray ai o (head s) >> return ai))
                    in uniqueInts (2*n) $ runST $ (fromJust $ f 1 xs [] (newArray (1, 2*n) 0 :: ST s (STArray s Int Int))) >>= getElems

uniqueInts :: Int -> [Int] -> Int
uniqueInts limit xs = let a = (newArray (0, limit) 0 :: ST s (STArray s Int Int)) in
                        sum . map (\e -> if e == 0 then 0 else 1) . elems $
                        runSTArray (a >>= \ai -> foldM (\ai x -> readArray ai x >>= \c -> writeArray ai x (c+1) >> return ai) ai xs)

import qualified Data.Map.Strict as M
import Data.List (nub)
import Data.Maybe (fromJust)
import Data.Array
import Data.Map.Strict (Map(..))
import Control.Monad (replicateM_, foldM)
import Data.Array.ST
import Control.Monad.ST

data Paren = LP | RP deriving (Eq)

main = read <$> getLine >>= flip replicateM_ scase

scase = read <$> getLine >>= \n -> getLine >>= print . numComps n . map fC
  where fC '(' = LP
        fC ')' = RP

numComps :: Int -> [Paren] -> Int
-- numComps _ ps = (numParents . fst . fromJust . parensToPPT) ps
-- numComps n = numParents' . fromJust . parensToPPT' n
numComps = numParents''

numParents :: Map Int Int -> Int
numParents = length . nub . M.elems

-- fst is node->parent map (both are open brace indices)
-- snd is open node-> close node map
type MT = (Map Int Int, Map Int Int)
{-
  The closing paren for each node is not determined until it actually closes.
First we can just keep children and when the node actually closes we can mark the closing number.
-}
-- convert a list of 2n paranthesis to a parent pointer tree
parensToPPT :: [Paren] -> Maybe MT
parensToPPT xs = let m :: MT
                     m = (M.empty, M.empty)
                     f :: Int -> [Paren] -> [Int] -> MT -> Maybe MT
                     f _ [] [] m = Just m
                     f i (LP:xs) s m = f (i+1) xs (i:s) m
                     f _ (RP:_) [] _ = Nothing -- stack is empty and we have ')'
                     f i (RP:xs) (o:s) m = f (i+1) xs s (closeWith i o s m)
                     closeWith c o [] (pM, oM) = (M.insert o 0 pM, M.insert o c oM) -- top nodes have 0 as parent
                     closeWith c o (p:_) (pM, oM) = (M.insert o p pM, M.insert o c oM)
                 in f 1 xs [] m

numParents' :: Array Int Int -> Int
numParents' = length . nub . elems

parensToPPT' :: Int -> [Paren] -> Maybe (Array Int Int) -- direct array parent pointer tree
parensToPPT' n xs = let a = listArray (1, 2*n) [0,0..]
                        f :: Int -> [Paren] -> [Int] -> Array Int Int -> Maybe (Array Int Int)
                        f _ [] [] a = Just a
                        f i (LP:xs) s a = f (i+1) xs (i:s) a
                        f _ (RP:_) [] _ = Nothing
                        f i (RP:xs) (o:s) a = f (i+1) xs s (if null s then a else (a//[(o, head s)]))
                    in f 1 xs [] a

numParents'' :: Int -> [Paren] -> Int
numParents'' n xs = let f :: Int -> [Paren] -> [Int] -> ST s (STArray s Int Int) -> Maybe (ST s (STArray s Int Int))
                        f _ [] [] a = Just a
                        f i (LP:xs) s a = f (i+1) xs (i:s) a
                        f _ (RP:_) [] _ = Nothing
                        f i (RP:xs) (o:s) a = f (i+1) xs s (if null s then a else (a >>= \ai -> writeArray ai o (head s) >> return ai))
                    in uniqueInts (2*n) $ runST $ (fromJust $ f 1 xs [] (newArray (1, 2*n) 0 :: ST s (STArray s Int Int))) >>= getElems

uniqueInts :: Int -> [Int] -> Int
uniqueInts limit xs = let a = (newArray (0, limit) 0 :: ST s (STArray s Int Int)) in
                        sum . map (\e -> if e == 0 then 0 else 1) . elems $
                        runSTArray (a >>= \ai -> foldM (\ai x -> readArray ai x >>= \c -> writeArray ai x (c+1) >> return ai) ai xs)

import Data.Char (chr, ord)
import Data.List (sort, partition)
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>= putStrLn . minStr

inc :: Char -> Char
inc c | c < '9' = chr (1+ord c)
      | c == '9'= '9'

minStr :: String -> String
minStr s = let (ms, rest) = minSubSeq s
           in
             sort (ms ++ map inc rest)

-- find the lexicographically smallest subsequence in a given string
minSubSeq :: String -> (String, String)
minSubSeq s = let mlss [] (stack, trash) = (reverse stack, trash)
                  mlss s (stack, trash) = let (i, c, count) = minCharCount s in
                                            mlss (drop i s) (replicate count c ++ stack, filter (/=c) (take i s) ++ trash)
              in
                mlss s ([], [])

minCharCount s = foldl f (1, head s, 1) (zip [2..] (tail s))
  where
    f (i, c, count) (ii, cc) = case compare c cc of
                                 EQ -> (ii, c, count+1)
                                 GT -> (ii, cc, 1)
                                 LT -> (i, c, count)

import Data.Array
import Control.Monad (replicateM_)

data Paren = LP | RP deriving (Eq)

main = read <$> getLine >>= flip replicateM_ scase

scase = read <$> getLine >>=
        \n -> getLine >>=
        print . numComps n . map fC
  where fC '(' = LP
        fC ')' = RP

numComps :: Int -> [Paren] -> Int
numComps n ps = n - numIndependents ps

numIndependents (LP:ps) = f 0 1 ps                  -- parens can start with ')'
  where f count weight (p:ps)  | weight == 0 && p == LP = f (count+1) 1 ps
                               | p == LP = f count (weight+1) ps
                               | p == RP = f count (weight-1) ps
        f count 0 [] = count


Pashmak has fallen in love with an attractive girl called Parmida since one year ago...Today, Pashmak set up a meeting with his partner in a romantic garden. Unfortunately, Pashmak has forgotten where the garden is. But he remembers that the garden looks like a square with sides parallel to the coordinate axes. He also remembers that there is exactly one tree on each vertex of the square. Now, Pashmak knows the position of only two of the trees. Help him to find the position of two remaining ones.

The first line contains four space-separated x1, y1, x2, y2 ( - 100 ≤ x1, y1, x2, y2 ≤ 100) integers, where x1 and y1 are coordinates of the first tree and x2 and y2 are coordinates of the second tree. It's guaranteed that the given points are distinct.

If there is no solution to the problem, print -1. Otherwise print four space-separated integers x3, y3, x4, y4 that correspond to the coordinates of the two other trees. If there are several solutions you can output any of them.  Note that x3, y3, x4, y4 must be in the range ( - 1000 ≤ x3, y3, x4, y4 ≤ 1000).

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

solve :: [Int] -> [Int]
solve (x1:y1:x2:y2:_)
  | x1 == x2 =
      let dx = y1 - y2 in [x1 + dx, y1, x2 + dx, y2]
  | y1 == y2 =
      let dy = x1 - x2 in [x1, y1 + dy, x2, y2 + dy]
  | otherwise =
        if abs (x1-x2) /= abs (y1-y2)
          then [-1]
          else [x1, y2, x2, y1]

{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

readInt = ( readLn :: IO Int )
getInts = map ( read :: String -> Int ) . words <$> getLine

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

main = do
	as <- getInts

	let
		solve [ x1, y1, x2, y2 ]
			| x1 == x2 = let d = y2 - y1 in [ x1 + d, y1, x2 + d, y2 ]
			| y1 == y2 = let d = x2 - x1 in [ x1, y2 + d, x2, y2 + d ]
			| abs( x2 - x1 ) == abs( y2 - y1 ) = let d = x2 - x1 in [ x1 + d, y1, x2 - d, y2 ]
			| otherwise = [ -1 ]

	putStrLn $ unwords $ map show $ solve as

main :: IO()
main = putStrLn . unwords . map show . solve . map read . words =<< getContents

solve :: [Int] -> [Int]
solve (x1:y1:x2:y2:_) = let a = abs (x1 - x2)
                            b = abs (y1 - y2)
                        in case () of _ | a == 0 -> [x1 + b, y1, x2 + b, y2]
                                        | b == 0 -> [x1, y1 + a, x2, y2 + a]
                                        | a /= b -> [-1]
                                        | otherwise -> [x1, y2, x2, y1]

import Data.List
import Data.Function
import Data.Char

main = interact $ unwords . map show . getAns . map read . words

getAns :: [Int] -> [Int]
getAns (x1:y1:x2:y2:_)
	| x1 == x2 = [x1 + y1 - y2, y1, x2 + y1 - y2, y2]
	| y1 == y2 = [x1, y1 + x1 - x2, x2, y2 + x1 - x2]
	| abs (x1 - x2) == abs (y1 - y2) = [x1, y2, x2, y1]
	| otherwise = [-1]

main = do
  [x1, y1, x2, y2] <- fmap (map read . words) getLine

  putStrLn $ unwords $ map show $
    if x1 == x2
       then [x1+abs (y2-y1), y1, x1+abs (y2-y1), y2]
       else
        if y1 == y2
           then [x1, y1+abs (x2-x1), x2, y2+abs (x2-x1)]
           else
            if abs (x2-x1) == abs (y2-y1)
               then [x1, y2, x2, y1]
               else [-1]

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = (solve.concat =<< forM [1 ..1] ( \i -> map (fst.fromJust.C.readInteger).C.words <$> C.getLine))
solve [x1,x2,y1,y2] | x1==y1 && x2/=y2 && (abs x1+y2-x2)<=1000 =putStrLn $ unwords $ map show $ [x1+y2-x2,x2,y1+y2-x2,y2]
                    | x1==y1 && x2/=y2 && (abs x1-y2+x2)<=1000 =putStrLn $ unwords $ map show $ [x1-y2+x2,x2,y1-y2+x2,y2]
                    | x2==y2 && x1/=y1 && (abs x2-y1+x1)<=1000 =putStrLn $ unwords $ map show $ [x1,x2-y1+x1,y1,y2-y1+x1]
                    | x2==y2 && x1/=y1 && (abs x2+y1-x1)<=1000 =putStrLn $ unwords $ map show $ [x1,x2+y1-x1,y1,y2+y1-x1]
                    | abs (x2-y2) == abs (x1-y1) &&  x2-y2 /=0 =putStrLn $ unwords $ map show $ [x1,y2,y1,x2]
                    | otherwise = print $ (-1)

import Control.Applicative

main = do
  [x1,y1,x2,y2] <- map read . words <$> getLine
  let
    ps1 = [x1,y2,x2,y1]
    diff_x = abs (x1-x2)
    diff_y = abs (y1-y2)
    l = max diff_x diff_y
    ps2 = [x1+l, y1, x2+l, y2]
    ps3 = [x1, y1+l, x2, y2+l]
   in putStrLn . unwords . map show $ if diff_x == diff_y
                                      then ps1
                                      else if diff_x == 0 then ps2 else (if diff_y == 0 then ps3 else [-1])

main :: IO ()
main = getLine >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve [ x1, y1, x2, y2 ] | x1 == x2 = [ x1 + y1 - y2, y1, x2 + y1 - y2, y2 ]
                         | y1 == y2 = [ x1, y1 + x1 - x2, x2, y2 + x1 - x2 ]
                         | abs (x1 - x2) == abs (y1 - y2) = [ x1, y2, x2, y1 ]
                         | otherwise = [ -1 ]
solve _ = undefined

main = interact $ unwords . map show . solve . map read . words
solve [a,b,c,d] | a == c = let a' = a + d - b in [a',b,a',d]
                | b == d = let b' = b + c - a in [a,b',c,b']
                | abs(c-a) == abs(d-b) = [a,d,c,b]
                | otherwise = [-1]

module Main where

import Data.List
type PointPair = [Integer]

data SquareSide = Hor | Vert | Diag

toInt :: String -> Integer
toInt = read

getSide :: PointPair -> Maybe (SquareSide, Integer)
getSide [x1, y1, x2, y2] =
    if xw == 0 then Just (Vert, yw) else
      if yw == 0 then Just (Hor,  xw) else
        if xw == yw then Just (Diag, xw) else Nothing
            where xw = abs $ x1 - x2
                  yw = abs $ y1 - y2

makeSquare :: PointPair -> Maybe PointPair
makeSquare pts@[x1, y1, x2, y2] = do
  (pos, side) <- getSide pts
  case pos of
   Diag -> return [x1, y2, x2, y1]
   Vert -> if x1 + side <= 1000 then return [x1 + side, y1, x2 + side, y2]
          else if x1 - side >= -1000 then return [x1 - side, y1, x2 - side, y2]
               else Nothing
   Hor -> if y1 + side <= 1000 then return [x1, y1 + side, x2, y2 + side]
           else if y1 - side >= -1000 then return [x1, y1 - side, x2, y2 - side]
                else Nothing

main :: IO ()
main = do
  str <- getLine
  let answer = makeSquare $ map toInt $ words str
  case answer of
    Just pts -> putStrLn $ concat . intersperse " " . map show $ pts
    Nothing -> putStrLn "-1"

import Control.Applicative
import Data.List

main=do
	[a,b,c,d]<- map read. words <$> getLine::IO [Int]
	if (a==c) then putStrLn $ intercalate " " $ map show [a+b-d, b, c+b-d, d]
                  else if (b==d) then putStrLn $ intercalate " " $ map show [a, b+a-c, c, d+a-c]
		                 else if (abs(a-c)/=abs(b-d)) then putStrLn "-1"
					            else  putStrLn $ intercalate " " $ map show [a, d, c, b]

parseList :: [String] -> [Int]
parseList [] = []
parseList (x:xs) = (read x::Int) : (parseList xs)

solve x
	| (abs ((x!!0) - (x!!2))) == (abs ((x!!1) - (x!!3))) = do
		print (x!!0)
		print (x!!3)
		print (x!!2)
		print (x!!1)
	| ((x!!0) - (x!!2) == 0) = do
		let diff = (x!!1) - (x!!3)
		print ((x!!0)-diff)
		print (x!!1)
		print ((x!!2)-diff)
		print (x!!3)
	| ((x!!1) - (x!!3) == 0) = do
		let diff = (x!!0) - (x!!2)
		print (x!!0)
		print ((x!!1)+diff)
		print (x!!2)
		print ((x!!3)+diff)
	| otherwise = do
		print (-1)

main = do
	str <- getLine
	let a = parseList (words str)
	solve a

main = do
    line <- getLine
    let coords = map read (words line) :: [Int]
    let x1 = coords !! 0
    let y1 = coords !! 1
    let x2 = coords !! 2
    let y2 = coords !! 3
    putStrLn $ solve x1 y1 x2 y2
    where solve x1 y1 x2 y2 =  let dx = abs (x1 - x2)
                                   dy = abs (y1 - y2)
                               in case (dx, dy) of
                                   (0, d) -> show (x1 + d) ++ " " ++ show y1 ++ " "++ show (x1 + d) ++ " " ++ show y2
                                   (d, 0) -> show x1 ++ " " ++ show (y1 + d) ++ " " ++ show x2 ++ " " ++ show (y2 + d)
                                   (d1, d2) -> if d1 == d2
                                    then show x1 ++ " " ++ show y2 ++ " " ++ show x2 ++ " " ++ show y1
                                    else "-1"

main = do
  line <- getLine
  let nums  = map read $ words line :: [Int]
  if(nums!!0==nums!!2) then do
    putStrLn $ show(nums!!0+abs(nums!!1-nums!!3)) ++ " "++
                      show(nums!!1)++" "++
                      show(nums!!0+abs(nums!!1-nums!!3))++ " "++
                      show(nums!!3)
  else
    if(nums!!1==nums!!3) then do
      putStrLn $ show(nums!!0)++" "++
                        show(nums!!1+abs(nums!!0-nums!!2))++" "++
                        show(nums!!2)++" "++
                        show(nums!!1+abs(nums!!0-nums!!2))
    else
      if (abs(nums!!0-nums!!2) == abs(nums!!1-nums!!3)) then do
        putStrLn $ show(nums!!0)++" "++
                   show(nums!!3)++" "++
                   show(nums!!2)++" "++
                   show(nums!!1)
      else do putStrLn "-1"

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
import qualified Data.ByteString.Lazy.Char8 as LC

main :: IO ()
main = do
        line <- LC.getContents
        let (x1:y1:x2:y2:[]) = readInts $ line
        mapM_ (putStr . (++" ") . show) $ solve x1 y1 x2 y2

solve :: Int -> Int -> Int -> Int -> [Int]
solve x1 y1 x2 y2
  | x1 == x2 =
      if y1 == y2
        then [-1]
        else let dx = y1 - y2 in (x1-dx):(y1):(x2-dx):(y2):[]
  | y1 == y2 =
      let dy = x1 - x2 in (x1):(y1-dy):(x2):(y2-dy):[]
  | otherwise =
        if abs (x1-x2) == abs (y1-y2)
          then [-1]
          else (x1):(y2):(x2):(y1):[]

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

readInt :: LC.ByteString -> Int
readInt = LC.foldl' (\x c -> 10 * x + fromEnum c - 48) 0

readInts :: LC.ByteString -> [Int]
readInts str = map readInt $ LC.words str

main = do
  [x1, y1, x2, y2] <- fmap (map read . words) getLine

  putStrLn $ unwords $ map show $
    if x1 == x2
       then [x1+abs (y2-y1), y1, x1+abs (y2-y1), y2]
       else
        if y1 == y2
           then [x1, y1+abs (x2-x1), y1, x2, y2+abs (y2-y1)]
           else
            if abs (x2-x1) == abs (y2-y1)
               then [x1, y2, x2, y1]
               else [-1]

main = do
  [x1, y1, x2, y2] <- fmap (map read . words) getLine

  putStrLn $ unwords $ map show $
    if x1 == x2
       then [x1+abs (y2-y1), y1, x1+abs (y2-y1), y2]
       else
        if y1 == y2
           then [x1, y1+abs (x2-x1), x2, y2+abs (y2-y1)]
           else
            if abs (x2-x1) == abs (y2-y1)
               then [x1, y2, x2, y1]
               else [-1]

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = (solve.concat =<< forM [1 ..1] ( \i -> map (fst.fromJust.C.readInteger).C.words <$> C.getLine))
solve [x1,x2,y1,y2] | x1==y1 && x2/=y2 && (abs x1+y2-x2)<=1000 =putStrLn $ unwords $ map show [x1+y2-x2,x1+y2-x2,y1,y2]
                    | x1==y1 && x2/=y2 && (abs x1-y2+x2)<=1000 =putStrLn $ unwords $ map show $ [x1-y2+x2,x1-y2+x2,y1,y2]
                    | x2==y2 && x1/=y1 && (abs x2-y1+x1)<=1000 =putStrLn $ unwords $ map show $ [x2-y1+x1,x2-y1+x1,y2,y1]
                    | x2==y2 && x1/=y1 && (abs x2+y1-x1)<=1000 =putStrLn $ unwords $ map show $ [x2+y1-x1,x2+y1-x1,y2,y1]
                    | abs (x2-y2) == abs (x1-y1) &&  x2-y2 /=0 =putStrLn $ unwords $ map show $ [x1,y2,y1,x2]
                    | otherwise = print $ (-1)

main :: IO ()
main = getLine >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve [ x1, y1, x2, y2 ] | x1 == x2 = [ x1 + y1 - y2, y1, x2 + y1 - y2, y2 ]
                         | y1 == y2 = [ x1, y1 + x1 - x2, x2, y2 + x1 - x2 ]
                         | x1 - x2 == y1 - y2 = [ x1, y2, x2, y1 ]
                         | otherwise = [ -1 ]
solve _ = undefined

main = interact $ unwords . map show . solve . map read . words
solve [a,b,c,d] | a == c = let a' = a + d - b in [a',b,a',d]
                | b == d = let b' = b + c - a in [a,b',c,b']
                | otherwise = [a,d,c,b]

import Control.Applicative
import Data.List

main=do
	[a,b,c,d]<- map read. words <$> getLine::IO [Int]
	if (a==c) then putStrLn $ intercalate " " $ map show [a+b-d, b, c+b-d, d]
                  else if (b==d) then putStrLn $ intercalate " " $ map show [a, b+a-c, c, d+a-c]
		                 else if  ( a==b) then putStrLn $ intercalate " " $ map show [a, d, c, b]
						  else putStrLn $ intercalate " " $ map show [a, d, b, c]

import Control.Applicative
import Data.List

main=do
	[a,b,c,d]<- map read. words <$> getLine::IO [Int]
	if (a==c) then putStrLn $ intercalate " " $ map show [a+b-d, b, c+b-d, d]
                  else if (b==d) then putStrLn $ intercalate " " $ map show [a, b+a-c, c, d+a-c]
		                 else if (a-c/=b-d) then putStrLn "-1"
					            else  putStrLn $ intercalate " " $ map show [a, d, c, b]

import Control.Applicative
import Data.List

main=do
	[a,b,c,d]<- map read. words <$> getLine::IO [Int]
	if (a==c) then putStrLn $ intercalate " " $ map show [a+b-d, b, c+b-d, d]
                  else if (b==d) then putStrLn $ intercalate " " $ map show [a, b+a-c, c, d+a-c]
		                 else if (a-c/=b-d) then putStrLn "-1"
					            else if  ( a==b) then putStrLn $ intercalate " " $ map show [a, d, c, b]
						                     else putStrLn $ intercalate " " $ map show [a, d, b, c]


An array $$$[b_1, b_2, \ldots, b_m]$$$ is a palindrome, if $$$b_i = b_{m+1-i}$$$ for each $$$i$$$ from $$$1$$$ to $$$m$$$. Empty array is also a palindrome.An array is called kalindrome, if the following condition holds: It's possible to select some integer $$$x$$$ and delete some of the elements of the array equal to $$$x$$$, so that the remaining array (after gluing together the remaining parts) is a palindrome. Note that you don't have to delete all elements equal to $$$x$$$, and you don't have to delete at least one element equal to $$$x$$$.For example :   $$$[1, 2, 1]$$$ is kalindrome because you can simply not delete a single element.  $$$[3, 1, 2, 3, 1]$$$ is kalindrome because you can choose $$$x = 3$$$ and delete both elements equal to $$$3$$$, obtaining array $$$[1, 2, 1]$$$, which is a palindrome.  $$$[1, 2, 3]$$$ is not kalindrome. You are given an array $$$[a_1, a_2, \ldots, a_n]$$$. Determine if $$$a$$$ is kalindrome or not.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$) — elements of the array. It's guaranteed that the sum of $$$n$$$ over all test cases won't exceed $$$2 \cdot 10^5$$$.

For each test case, print YES if $$$a$$$ is kalindrome and NO otherwise. You can print each letter in any case.

NoteIn the first test case, array $$$[1]$$$ is already a palindrome, so it's a kalindrome as well.In the second test case, we can choose $$$x = 2$$$, delete the second element, and obtain array $$$[1]$$$, which is a palindrome.In the third test case, it's impossible to obtain a palindrome.In the fourth test case, you can choose $$$x = 4$$$ and delete the fifth element, obtaining $$$[1, 4, 4, 1]$$$. You also can choose $$$x = 1$$$, delete the first and the fourth elements, and obtain $$$[4, 4, 4]$$$.

import Prelude

import qualified Data.ByteString.Char8 as B
import Data.Maybe (catMaybes)

main :: IO ()
main = B.interact processInput

processInput :: B.ByteString -> B.ByteString
processInput = B.unlines . map processTest . takeElementsWithOddIndices . drop 1 . B.lines

takeElementsWithOddIndices :: [a] -> [a]
takeElementsWithOddIndices elements = case elements of
    x1:x2:xs -> x2 : takeElementsWithOddIndices xs
    _ -> []

processTest :: B.ByteString -> B.ByteString
processTest input = output
    where
        input_sequence = map fst $ catMaybes $ map B.readInteger $ B.words $ input
        output = B.pack $ if isKalindrome input_sequence then "YES" else "NO"

isKalindrome :: [Integer] -> Bool
isKalindrome xs = result
    where
        wrong_pairs = filter (\ (l, r) -> l /= r) $ zip xs (reverse xs)
        variants_to_check = [xs] ++ case wrong_pairs of
            (l, r) : other_pairs -> [filter (/= l) xs, filter (/= r) xs]
            [] -> []
        result = any isPalindrome variants_to_check

isPalindrome :: [Integer] -> Bool
isPalindrome xs = xs == reverse xs

import Prelude

import qualified Data.ByteString.Char8 as B
import Data.Maybe (catMaybes)

main :: IO ()
main = B.interact processInput

processInput :: B.ByteString -> B.ByteString
processInput = B.unlines . map processTest . takeElementsWithOddIndices . drop 1 . B.lines

takeElementsWithOddIndices :: [a] -> [a]
takeElementsWithOddIndices elements = case elements of
    x1:x2:xs -> x2 : takeElementsWithOddIndices xs
    _ -> []

processTest :: B.ByteString -> B.ByteString
processTest input = output
    where
        input_sequence = map (fromIntegral . fst) $ catMaybes $ map B.readInt $ B.words $ input
        output = B.pack $ if isKalindrome input_sequence then "YES" else "NO"

isKalindrome :: [Integer] -> Bool
isKalindrome xs = result
    where
        wrong_pairs = filter (\ (l, r) -> l /= r) $ zip xs (reverse xs)
        variants_to_check = [xs] ++ case wrong_pairs of
            (l, r) : other_pairs -> [filter (/= l) xs, filter (/= r) xs]
            [] -> []
        result = any isPalindrome variants_to_check

isPalindrome :: [Integer] -> Bool
isPalindrome xs = xs == reverse xs

import qualified Data.ByteString.Char8 as B
import Data.Maybe (catMaybes)

main :: IO ()
main = do
    B.interact (\ input -> processInput input)

processInput :: B.ByteString -> B.ByteString
processInput = B.unlines . map processTest . takeElementsWithOddIndices . drop 1 . B.lines

takeElementsWithOddIndices :: [a] -> [a]
takeElementsWithOddIndices elements = case elements of
    x1:x2:xs -> x2 : takeElementsWithOddIndices xs
    _ -> []

processTest :: B.ByteString -> B.ByteString
processTest input = output
    where
        input_sequence = map (fromIntegral . fst) $ catMaybes $ map B.readInt $ B.words $ input
        output = B.pack $ if isKalindrome input_sequence then "YES" else "NO"

isKalindrome :: [Integer] -> Bool
isKalindrome xs = result
    where
        wrong_pairs = filter (\ (l, r) -> l /= r) $ zip xs (reverse xs)
        result = case wrong_pairs of
            [] -> True
            (l, r) : other_pairs -> isPalindrome (filter (/= l) xs) || isPalindrome (filter (/= r) xs)

isPalindrome :: [Integer] -> Bool
isPalindrome xs = xs == reverse xs

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

solve :: IO ()
solve = do
    ~[n] <- readInts
    xs <- readInts
    let dif = find (uncurry (/=)) $ zip xs (reverse xs)
        tryWo c = ys == reverse ys where ys = filter (/=c) xs
        tryBoth (c, d) = tryWo c || tryWo d
    putStrLn $ if maybe True tryBoth dif then "YES" else "NO"

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

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

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

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    let
      ra = reverse a
      issues = take 1 $ filter (uncurry (/=)) $ zip a ra
      tries = 0 : concatMap (\(x, y) -> [x, y]) issues
      opts = [filter (/= v) a | v <- tries]
      ans = any isPalindrome opts
      isPalindrome li = li == reverse li
    pure $ string7 $ if  ans
      then  "YES\n"
      else  "NO\n"

type SP = State [P.ByteString]

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

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

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

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


You're given an array $$$b$$$ of length $$$n$$$. Let's define another array $$$a$$$, also of length $$$n$$$, for which $$$a_i = 2^{b_i}$$$ ($$$1 \leq i \leq n$$$). Valerii says that every two non-intersecting subarrays of $$$a$$$ have different sums of elements. You want to determine if he is wrong. More formally, you need to determine if there exist four integers $$$l_1,r_1,l_2,r_2$$$ that satisfy the following conditions:   $$$1 \leq l_1 \leq r_1 \lt l_2 \leq r_2 \leq n$$$;  $$$a_{l_1}+a_{l_1+1}+\ldots+a_{r_1-1}+a_{r_1} = a_{l_2}+a_{l_2+1}+\ldots+a_{r_2-1}+a_{r_2}$$$. If such four integers exist, you will prove Valerii wrong. Do they exist?An array $$$c$$$ is a subarray of an array $$$d$$$ if $$$c$$$ can be obtained from $$$d$$$ by deletion of several (possibly, zero or all) elements from the beginning and several (possibly, zero or all) elements from the end.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The first line of every test case contains a single integer $$$n$$$ ($$$2 \le n \le 1000$$$). The second line of every test case contains $$$n$$$ integers $$$b_1,b_2,\ldots,b_n$$$ ($$$0 \le b_i \le 10^9$$$).

For every test case, if there exist two non-intersecting subarrays in $$$a$$$ that have the same sum, output YES on a separate line. Otherwise, output NO on a separate line.  Also, note that each letter can be in any case.

NoteIn the first case, $$$a = [16,8,1,2,4,1]$$$. Choosing $$$l_1 = 1$$$, $$$r_1 = 1$$$, $$$l_2 = 2$$$ and $$$r_2 = 6$$$ works because $$$16 = (8+1+2+4+1)$$$.In the second case, you can verify that there is no way to select to such subarrays.

import Control.Arrow ((>>>))
import Data.Bool (bool)
import Data.List (group, sort)

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

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

solve :: [Int] -> Bool
solve = any ((> 1) . length) . group . sort

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : l : rest) = (solve . linetois) l : tcio rest
  linetoi = read
  linetois = (map linetoi) . words

solve :: [Int] -> String
solve as | null $ filter ( not . null . (drop 1)) $  group $ sort as = "NO"
         | otherwise = "YES"

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : l : rest) = (itoline. solve . linetois) l : tcio rest
  linetoi = read
  itoline = show
  linetois = (map linetoi) . words

solve :: [Int] -> String
solve as | null $ filter ( not . null . (drop 1)) $  group $ sort as = "NO"
         | otherwise = "YES"


A bracket sequence is a string containing only characters "(" and ")".A regular bracket sequence is a bracket sequence that can be transformed into a correct arithmetic expression by inserting characters "1" and "+" between the original characters of the sequence. For example, bracket sequences "()()", "(())" are regular (the resulting expressions are: "(1)+(1)", "((1+1)+1)"), and ")(" and "(" are not.You are given $$$n$$$ bracket sequences $$$s_1, s_2, \dots , s_n$$$. Calculate the number of pairs $$$i, j \, (1 \le i, j \le n)$$$ such that the bracket sequence $$$s_i + s_j$$$ is a regular bracket sequence. Operation $$$+$$$ means concatenation i.e. "()(" + ")()" = "()()()".If $$$s_i + s_j$$$ and $$$s_j + s_i$$$ are regular bracket sequences and $$$i \ne j$$$, then both pairs $$$(i, j)$$$ and $$$(j, i)$$$ must be counted in the answer. Also, if $$$s_i + s_i$$$ is a regular bracket sequence, the pair $$$(i, i)$$$ must be counted in the answer.

The first line contains one integer $$$n \, (1 \le n \le 3 \cdot 10^5)$$$ — the number of bracket sequences. The following $$$n$$$ lines contain bracket sequences — non-empty strings consisting only of characters "(" and ")". The sum of lengths of all bracket sequences does not exceed $$$3 \cdot 10^5$$$.

In the single line print a single integer — the number of pairs $$$i, j \, (1 \le i, j \le n)$$$ such that the bracket sequence $$$s_i + s_j$$$ is a regular bracket sequence.

NoteIn the first example, suitable pairs are $$$(3, 1)$$$ and $$$(2, 2)$$$.In the second example, any pair is suitable, namely $$$(1, 1), (1, 2), (2, 1), (2, 2)$$$.

import Data.List
import Data.Int
import qualified Data.Array as A
import qualified Data.Map.Strict as M
import qualified Data.Maybe as MYB
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
    let nword:xs = words input
        n = fastRead nword
        maybeMap = map countBracket xs :: [Maybe Int64]
        mappedValues = MYB.catMaybes . filter MYB.isJust $ maybeMap
        answer = getAnswer (trace (show mappedValues) mappedValues)
    in show answer

countBracket::String -> Maybe Int64
countBracket xsP
    | MYB.isNothing folded = Nothing
    | forward > 0 && backward > 0 = Nothing
    | otherwise = Just . fromIntegral $ forward - backward
    where
        folder :: Maybe String -> Char -> Maybe String
        folder Nothing _ = Nothing
        folder (Just []) c = Just [c]
        folder (Just ('(':xs)) ')' = Just xs
        folder (Just xs) a = Just (a:xs)
        folded = foldl' folder (Just []) xsP
        Just arr = folded
        forward = length . filter (== ')') $ arr
        backward = length . filter (== '(') $ arr

getAnswer:: [Int64] -> Int64
getAnswer input =
    let folder :: (Int64, M.Map Int64 Int64) -> Int64 -> (Int64, M.Map Int64 Int64)
        folder (answer, stateMap) current = (answer + currentOppositeValue + eqVal, M.insert current (currentValue + 1) stateMap)
            where
                eqVal
                    | current == 0 = currentOppositeValue + 1
                    | otherwise = 0
                currentValue = M.findWithDefault 0 current stateMap :: Int64
                currentOppositeValue = M.findWithDefault 0 (-current) stateMap :: Int64
        (answer, stateMap) = foldl' folder (0, M.empty) input
    in trace (M.showTree stateMap) answer

trace _ a = a

module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

import qualified Data.Array as Array
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Char as C

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [String]
readInts = map C8.unpack . C8.words

simplify :: String -> String -> String
simplify [] stack = stack
simplify (x:xs) stack
  | x == '(' = simplify xs (x:stack)
  | List.null stack = simplify xs (x:stack)
  | otherwise = let (top:stack') = stack
                in if top == '(' then
                     simplify xs stack'
                   else
                     simplify xs (x:stack)

canBeValid :: String -> Bool
canBeValid [] = True
canBeValid (x:xs) = all (==x) xs

getNumber :: String -> Int
getNumber [] = 0
getNumber xs = if head xs == '(' then length xs else 0 - (length xs)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  bs <- input
  let brackets = readInts bs
      candidates = filter canBeValid $ map (flip simplify []) brackets
      candidates' = map getNumber candidates :: [Int]
      sorted = List.sort candidates'
      grouped = List.group sorted
      map' = Map.fromList $ map (\(x:xs) -> (x,length xs + 1)) grouped
      total = foldl (\acc (val,count) ->
                       case Map.lookup (-val) map' of
                         Nothing -> acc
                         Just count' -> acc + (toInteger count) * (toInteger count')
                    )
              0 $ filter (\(k,v) -> k <= 0) $ Map.assocs map' :: Integer
  print total

import Data.List
import Data.Int
import qualified Data.Array as A
import qualified Data.Map.Strict as M
import qualified Data.Maybe as MYB
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
    let nword:xs = words input
        n = fastRead nword
        maybeMap = map countBracket xs :: [Maybe Int64]
        mappedValues = MYB.catMaybes . filter MYB.isJust $ maybeMap
        answer = getAnswer mappedValues
    in show answer

countBracket::String -> Maybe Int64
countBracket xsP =
    let folder x '(' = x + 1
        folder x ')' = x - 1
        (initBack,remaining) = span (== ')') xsP
        remainingBack = length . filter (== ')') $ remaining
        remainingForward = length . filter (== '(') $ remaining
        remainingValue = -remainingBack + remainingForward
        initBackLength = length initBack
    in if initBackLength > 0 && remainingValue > 0 then
        Nothing
    else
        Just . fromIntegral $ (remainingValue - initBackLength)

getAnswer:: [Int64] -> Int64
getAnswer input =
    let folder :: (Int64, M.Map Int64 Int64) -> Int64 -> (Int64, M.Map Int64 Int64)
        folder (answer, stateMap) current = (answer + currentOppositeValue + eqVal, M.insert current (currentValue + 1) stateMap)
            where
                eqVal
                    | current == 0 = currentOppositeValue + 1
                    | otherwise = 0
                currentValue = M.findWithDefault 0 current stateMap :: Int64
                currentOppositeValue = M.findWithDefault 0 (-current) stateMap :: Int64
        (answer, stateMap) = foldl' folder (0, M.empty) input
    in trace (M.showTree stateMap) answer

trace _ s = s

import Data.List
import Data.Int
import qualified Data.Array as A
import qualified Data.Map.Strict as M
import qualified Data.Maybe as MYB
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
    let nword:xs = words input
        n = fastRead nword
        maybeMap = map countBracket xs :: [Maybe Int64]
        mappedValues = MYB.catMaybes . filter MYB.isJust $ maybeMap
        answer = getAnswer mappedValues
    in show answer

countBracket::String -> Maybe Int64
countBracket xsP =
    let folder x '(' = x + 1
        folder x ')' = x - 1
        (initBack,remaining) = span (== ')') xsP
        remainingBack = length . filter (== ')') $ remaining
        remainingForward = length . filter (== '(') $ remaining
        remainingValue = -remainingBack + remainingForward
        initBackLength = length initBack
    in if initBackLength > 0 && remainingValue > 0 then
        Nothing
    else
        Just . fromIntegral $ (remainingValue - initBackLength)

getAnswer:: [Int64] -> Int64
getAnswer input =
    let folder :: (Int64, M.Map Int64 Int64) -> Int64 -> (Int64, M.Map Int64 Int64)
        folder (answer, stateMap) current = (answer + currentOppositeValue * 2 + eqVal, M.insert current (currentValue + 1) stateMap)
            where
                eqVal
                    | current == 0 = 1
                    | otherwise = 0
                currentValue = M.findWithDefault 0 current stateMap :: Int64
                currentOppositeValue = M.findWithDefault 0 (-current) stateMap :: Int64
        (answer, stateMap) = foldl' folder (0, M.empty) input
    in trace (M.showTree stateMap) answer

trace _ s = s

module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

import qualified Data.Array as Array
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Char as C

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [String]
readInts = map C8.unpack . C8.words

simplify :: String -> String -> String
simplify [] stack = stack
simplify (x:xs) stack
  | x == '(' = simplify xs (x:stack)
  | List.null stack = simplify xs (x:stack)
  | otherwise = let (top:stack') = stack
                in if top == '(' then
                     simplify xs stack'
                   else
                     simplify xs (x:stack)

canBeValid :: String -> Bool
canBeValid [] = True
canBeValid (x:xs) = all (==x) xs

getNumber :: String -> Int
getNumber [] = 0
getNumber xs = if head xs == '(' then length xs else 0 - (length xs)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  bs <- input
  let brackets = readInts bs
      candidates = filter canBeValid $ map (flip simplify []) brackets
      candidates' = map getNumber candidates :: [Int]
      sorted = List.sort candidates'
      grouped = List.group sorted
      map' = Map.fromList $ map (\(x:xs) -> (x,length xs + 1)) grouped
      total = foldl (\acc (val,count) ->
                       case Map.lookup (-val) map' of
                         Nothing -> acc
                         Just count' -> acc + (toInteger $ count * count')
                    )
              0 $ filter (\(k,v) -> k <= 0) $ Map.assocs map' :: Integer
  print total

module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

import qualified Data.Array as Array
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Char as C

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [String]
readInts = map C8.unpack . C8.words

simplify :: String -> String -> String
simplify [] stack = stack
simplify (x:xs) stack
  | x == '(' = simplify xs (x:stack)
  | List.null stack = simplify xs (x:stack)
  | otherwise = let (top:stack') = stack
                in if top == '(' then
                     simplify xs stack'
                   else
                     simplify xs (x:stack)

canBeValid :: String -> Bool
canBeValid [] = True
canBeValid (x:xs) = all (==x) xs

getNumber :: String -> Int
getNumber [] = 0
getNumber xs = if head xs == '(' then length xs else 0 - (length xs)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  bs <- input
  let brackets = readInts bs
      candidates = filter canBeValid $ map (flip simplify []) brackets
      candidates' = map getNumber candidates :: [Int]
      sorted = List.sort candidates'
      grouped = List.group sorted
      map' = Map.fromList $ map (\(x:xs) -> (x,length xs + 1)) grouped
      total = foldl (\acc (val,count) ->
                       case Map.lookup (-val) map' of
                         Nothing -> acc
                         Just count' -> if val == 0 then
                                          acc + count * count
                                        else
                                          acc + count * count')
              0 $ filter (\(k,v) -> k <= 0) $ Map.assocs map'
  print candidates
  print grouped
  print total

module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

import qualified Data.Array as Array
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Char as C

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [String]
readInts = map C8.unpack . C8.words

simplify :: String -> String -> String
simplify [] stack = stack
simplify (x:xs) stack
  | x == '(' = simplify xs (x:stack)
  | List.null stack = simplify xs (x:stack)
  | otherwise = let (top:stack') = stack
                in if top == '(' then
                     simplify xs stack'
                   else
                     simplify xs (x:stack)

canBeValid :: String -> Bool
canBeValid [] = True
canBeValid (x:xs) = all (==x) xs

getNumber :: String -> Int
getNumber [] = 0
getNumber xs = if head xs == '(' then length xs else 0 - (length xs)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  bs <- input
  let brackets = readInts bs
      candidates = filter canBeValid $ map (flip simplify []) brackets
      candidates' = map getNumber candidates :: [Int]
      sorted = List.sort candidates'
      grouped = List.group sorted
      map' = Map.fromList $ map (\(x:xs) -> (x,length xs + 1)) grouped
      total = foldl (\acc (val,count) ->
                       case Map.lookup (-val) map' of
                         Nothing -> acc
                         Just count' -> if val == 0 then
                                          acc + count * count
                                        else
                                          acc + count * count')
              0 $ filter (\(k,v) -> k <= 0) $ Map.assocs map'
  print total

module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

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

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [String]
readInts = map C8.unpack . C8.lines

simplify :: String -> String -> String
simplify [] stack = stack
simplify (x:xs) stack
  | x == '(' = simplify xs (x:stack)
  | List.null stack = simplify xs (x:stack)
  | otherwise = let (top:stack') = stack
                in if top == '(' then
                     simplify xs stack'
                   else
                     simplify xs (x:stack)

canBeValid :: String -> Bool
canBeValid [] = True
canBeValid (x:xs) = all (==x) xs

getNumber :: String -> Int
getNumber [] = 0
getNumber xs = if head xs == '(' then length xs else 0 - (length xs)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  bs <- input
  let brackets = readInts bs
      candidates = filter canBeValid $ map (flip simplify []) brackets
      candidates' = map getNumber candidates :: [Int]
      sorted = List.sort candidates'
      grouped = List.group sorted
      map' = Map.fromList $ map (\(x:xs) -> (x,length xs + 1)) grouped
      total = foldl (\acc (val,count) ->
                       case Map.lookup (-val) map' of
                         Nothing -> acc
                         Just count' -> if val == 0 then
                                          acc + count * count
                                        else
                                          acc + count * count')
              0 $ filter (\(k,v) -> k <= 0) $ Map.assocs map'
  print total


You have a multiset containing several integers. Initially, it contains $$$a_1$$$ elements equal to $$$1$$$, $$$a_2$$$ elements equal to $$$2$$$, ..., $$$a_n$$$ elements equal to $$$n$$$.You may apply two types of operations:  choose two integers $$$l$$$ and $$$r$$$ ($$$l \le r$$$), then remove one occurrence of $$$l$$$, one occurrence of $$$l + 1$$$, ..., one occurrence of $$$r$$$ from the multiset. This operation can be applied only if each number from $$$l$$$ to $$$r$$$ occurs at least once in the multiset;  choose two integers $$$i$$$ and $$$x$$$ ($$$x \ge 1$$$), then remove $$$x$$$ occurrences of $$$i$$$ from the multiset. This operation can be applied only if the multiset contains at least $$$x$$$ occurrences of $$$i$$$. What is the minimum number of operations required to delete all elements from the multiset?

The first line contains one integer $$$n$$$ ($$$1 \le n \le 5000$$$). The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$0 \le a_i \le 10^9$$$).

Print one integer — the minimum number of operations required to delete all elements from the multiset.

isolve :: [Int] -> Int
-- solve when all elems are positive
isolve [] = 0
isolve li = let
  q = minimum li
  redAns = q + solve (map (subtract q) li)
  in  min (length li) redAns

solve :: [Int] -> Int
-- solve in general: O(n*n).
solve [] = 0
solve li = let
  (pos, rest) = span (> 0) li
  in  isolve pos + solve (dropWhile (== 0) rest)

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