import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
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 = getLine  >> (solve =<< map (fst.fromJust.C.readInt).C.words<$>C.getLine)
--solve::Int->IO()
solve xs = print $ fst $ foldl f (0,0) xs
 where
 f (b1,b2) a = if a<0 && b2==0 then (b1+1,b2) else (b1,b2+a)

solve :: [Int] -> Int -> Int -> Int
solve [] _ up = up
solve (x : xs) rr up
  | x == -1   = if rr >= 1 then solve xs (rr - 1) up else solve xs rr (up + 1)
  | otherwise = solve xs (rr + x) up

prepare :: [Int] -> Int
prepare crimes = solve crimes 0 0

main :: IO ()
main = interact $ show . prepare . tail . map read . words

#!/usr/bin/env runghc
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (n:p:ss) = (:solve ss)$ show . foldr f 0 . map (read::String->Int) . words $ p
  where f p t = max 0 (t-p)

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

solve :: [Int] -> Int
solve = go 0 0
	where
		go u _ [] = u
		go u 0 (-1:xs) = go (u+1) 0 xs
		go u p (-1:xs) = go u (p-1) xs
		go u p ( x:xs) = go u (p+x) xs

main :: IO ()
main = void getLine >> inputInts >>= print . solve

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

process _ c []  = c
process a c (d:ds)   | d>0 && a>0 = process (d+a) c ds
                     | d>0  = process d c ds
		     | a>0 = process (a-1) c ds
                     | otherwise = process (a-1) (c+1) ds
main=do
	getLine
	s<- map (fst.fromJust.C.readInteger). C.words <$>  C.getLine  ::IO [Integer]
	print $ process 0 0 s

import Data.List

process :: [Int] -> Int
process = length . filter (<0) . scanl' (\acc x -> if x > 0 && acc < 0 then x else acc + x) 0

readInt :: String -> Int
readInt = read

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

module Main
    where

import System.IO

main = do
    first <- getLine
    second <- getLine
    print . solve 0 0 . map read . words $ second
    where
        solve crimes _ [] =
            crimes
        solve crimes officers (event : events) =
            if officers' < 0 then
                solve (crimes + 1) 0 events
            else
                solve crimes officers' events
            where
                officers' = officers + event

main = do
    getLine
    con<-getLine
    putStr $ (show.solve 0 0.map read.words) con

solve _ k [] = k
solve p k (x:xs)
    |x>0        = solve (p+x) k xs
    |p-1<0      = solve p (k+1) xs
    |otherwise  = solve (p-1) k xs

main = do line <- getLine
          let n = (read line) :: Int
          line <- getLine
          let xs = (map read $ words line) :: [Int]
          putStrLn $ show $ countCrime xs 0 0

countCrime [] pol acc = acc
countCrime (x : xs) pol acc
    | x == -1   = if pol > 0 then countCrime xs (pol - 1) acc
                             else countCrime xs pol (acc + 1)
    | x > 0     = countCrime xs (pol + x) acc
    | otherwise = error "shit"

parseInput :: String -> [Int]
parseInput input = xs where
    ls = lines input
    ys = words $ last ls
    xs = map read ys

solve :: Int -> [Int] -> Int
solve n [] = 0
solve n (x:xs)
    | x > 0     = solve (n + x) xs
    | otherwise = case n of
        0 -> 1 + solve n xs
        _ -> solve (n - 1) xs

main :: IO ()
main = do
    input <- getContents
    let xs = parseInput input
    print $ solve 0 xs

solve2 events = negate $ minimum $ scanl (+) 0 events

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

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

solve :: [Int] -> Int
solve (n:a) = solve' a 0

solve' :: [Int] -> Int -> Int
solve' []     sum | sum < 0   = abs sum
                  | otherwise = 0
solve' (a:ax) sum | sum < 0   = max (abs sum) (solve' ax (sum + a))
                  | otherwise = solve' ax (sum + a)

-- time limit exceeded
-- use faster list operations

police lst crm pol
  | (null lst) = crm
  | otherwise = if (head lst) == (-1)
                then if pol > 0
                     then police (tail lst) crm (pol-1)
                     else police (tail lst) (crm+1) pol
                else police (tail lst) crm (pol+(head lst))

conv lst cc
  | (null lst) = reverse cc
  | otherwise = conv (tail lst) (((read (head lst))::Int) : cc)

main = do
  ff <- getLine
  ww <- getLine

  let ans = police (conv (words ww) []) 0 0
  putStrLn (show ans)

untreated :: [Int] -> Int
untreated = fst . foldl go (0, 0)
            where go (untr, officers) k | k == -1 && officers > 0 = (untr, officers-1)
                                        | k == -1 = (untr+1, 0)
                                        | otherwise = (untr, officers + k)

main = getLine >> getLine >>= (print . untreated . map read . words)

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

  let
    (x, _) = foldl f (0, 0) xs
      where
        f (a, b) (-1)
          | b > 0 = (a, b-1)
          | otherwise = (a+1, b)
        f (a, b) x = (a, b+x)

  print x

main=interact$f.map read.words
f (x:xs)=show.negate.minimum.scanl(+)0$0:xs

main=interact$f.map read.words
f (x:xs)=show.g.minimum.scanl1 (+)$xs
g x |x<0= -x
g x=0

main = do
  _ <- getLine
  xs <- (map read . words) `fmap` getLine
  let f x = if x < 0 then (-1)*x else 0
  print . f . minimum . scanl1 (+) $ xs

main = interact $ f . map read . words
f (x:xs) = show . g . minimum . scanl1 (+) $ xs
g x | x < 0 = -x
g x = 0

import Control.Applicative
import Data.List (foldl')

main = do
  _ <- getLine
  xs <- map read . words <$> getLine
  let
    f (n, t) x
      | x == (-1) && n == 0 = (n, t+1)
      | x == (-1) = (n-1, t)
      | otherwise = (n+x, t)
   in putStrLn . show . snd $ foldl' f (0, 0) xs

solve :: [Int] -> Int -> Int
solve [] _ = 0
solve (-1:xs) 0 = 1 + solve xs 0
solve (-1:xs) num = solve xs (num - 1)
solve (x:xs) num = solve xs (num + x)

main = do
  _ <- getLine
  l <- getLine
  putStrLn $ show $ solve (map read $ words l) 0

import Control.Applicative
import Data.List

process [] _ ni = ni
process (q:qs) np ni | q>0 = process qs (np+q) ni
                    | np>0 = process qs (np-1) ni
                    |otherwise = process qs np (ni+1)

main=do
    n<-     read  <$> getLine::IO Integer
    q<-    map read <$> words <$> getLine::IO [Integer]
    print $  process q 0 0

f (crimes,officers) x
	| x == -1 = if officers ==0 then (crimes+1,0) else (crimes,officers-1)
	| otherwise = (crimes,officers+x)

main = do
	_ <- getLine
	events <- getLine >>= return . map (read :: String -> Int). words
	print . fst $ foldl f (0,0) events

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

solve :: [Int] -> Int
solve = sum . map snd . scanl f (0, 0)
  where f (x, _) z = (max (x + z) 0, max (- x - z) 0)

import Data.List (foldl')
main = interact $ show . fst . foldl' solve (0,0) . map read . tail . words
solve (c,0) (-1) = (c+1,0)
solve (c,p) (-1) = (c,p-1)
solve (c,p) q = (c,p+q)

module Main where

main = interact readAndSolve

readAndSolve :: String -> String
readAndSolve input = show . solve . convert $ input

convert :: String -> [Int]
convert input = let	numbers = (lines input) !! 1 in
				map read (words numbers)

solve :: [Int] -> Int
solve list = abs $ min 0 $ minimum . calcPrefixSums $ list

calcPrefixSums :: [Int] -> [Int]
calcPrefixSums = foldLP (+) 0

foldLP :: (a -> b -> a) -> a -> [b] -> [a]
foldLP _ _ [] = []
foldLP f s (x:xs) = let curS = f s x in curS : foldLP f curS xs

foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' _ z [] = z
foldl' f s (x:xs) = foldl' f (f s x)  xs

import Data.List
strToList = (map (read :: (String -> Integer))).words
f xs = length $ filter (<0) $ snd $ mapAccumL (\x y -> (max 0 (x + y), x + y)) 0 xs
main = do
    n <- fmap strToList getLine
    s <- fmap strToList getLine
    putStrLn $ show $ f s

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  print $ solve xs

solve :: [Int] -> Int
solve xs = go 0 0 xs
   where
     go !res !police ((-1):xs)
       | police > 0 = go res (police-1) xs
       | otherwise = go (res+1) 0 xs
     go res police (x:xs) = go res (police+x) xs
     go res _ _ = res

main = interact $ show.fst.foldl op (0,0).map read.tail.words

op :: (Int,Int) -> Int -> (Int,Int)
op (ans,cum) num
	| num == -1 && cum > 0 = (ans,cum-1)
	| num == -1 && cum == 0 = (ans+1,cum)
	| otherwise = (ans,cum+num)

countNegativesStart [] = 0
countNegativesStart (x:xs) = if x < 0 then (1 + countNegativesStart xs) else 0

dropNegativesStart [] = []
dropNegativesStart (x:xs) = if x < 0 then dropNegativesStart xs else (x:xs)

dropPositivesEnd [] = []
dropPositivesEnd xs = if last xs > 0 then dropPositivesEnd (init xs) else xs

solve :: [Int] -> Int
solve events = if si < 0 then (abs si) + countNegativesStart events
                 else countNegativesStart events
  where
    si = sum (dropNegativesStart (dropPositivesEnd events))

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

countNegativesStart [] = 0
countNegativesStart (x:xs) = if x < 0 then (1 + countNegativesStart xs) else 0

dropNegativesStart [] = []
dropNegativesStart (x:xs) = if x < 0 then dropNegativesStart xs else (x:xs)

dropPositivesEnd [] = []
dropPositivesEnd xs = if last xs > 0 then dropPositivesEnd (init xs) else xs

solve :: [Int] -> Int
solve events = if si < 0 then ( (abs si) + countNegativesStart events)
                 else countNegativesStart events
  where
    si = sum (inner events)
    inner xs = dropNegativesStart (dropPositivesEnd xs)

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

main = do
  _ <- getLine
  xs <- (map read . words) `fmap` getLine
  print . (*(-1)) . minimum . scanl1 (+) $ xs

main = do
  _ <- getLine
  xs <- (map read . words) `fmap` getLine
  let f x = if x < 0 then (-1)*x else 0
  print . f . minimum . scanr1 (+) $ xs

module Main where

main = interact readAndSolve

readAndSolve :: String -> String
readAndSolve input = show . solve . convert $ input

convert :: String -> [Int]
convert input = let	numbers = (lines input) !! 1 in
				map read (words numbers)

solve :: [Int] -> Int
solve = abs . minimum . calcPrefixSums

calcPrefixSums :: [Int] -> [Int]
calcPrefixSums = foldLP (+) 0

foldLP :: (a -> b -> a) -> a -> [b] -> [a]
foldLP _ _ [] = []
foldLP f s (x:xs) = let curS = f s x in curS : foldLP f curS xs

foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' _ z [] = z
foldl' f s (x:xs) = foldl' f (f s x)  xs

solve :: [Int] -> Int -> Int -> Int
solve [] _ up = up
solve (x:xs) rr up
  | rr >= 1 = solve xs (rr-1) up
  | otherwise = solve xs rr (up+1)

prepare :: [Int] -> Int
prepare crimes = solve crimes 0 0

main :: IO ()
main = interact $ show . prepare . tail . map read . words

solve :: [Int] -> Int -> Int -> Int
solve [] _ up = up
solve (x : xs) rr up
  | x == -1   = if rr >= 1 then solve xs (rr - 1) up else solve xs rr (up + 1)
  | otherwise = solve xs (rr + 1) up

prepare :: [Int] -> Int
prepare crimes = solve crimes 0 0

main :: IO ()
main = interact $ show . prepare . tail . map read . words

solve :: [Int] -> Int -> Int -> Int
solve [] _ up = up
solve (x:xs) rr up
  | rr >= 1 = solve xs (rr-1) up
  | otherwise = solve xs rr (up+1)

prepare :: [Int] -> Int
prepare crimes = solve crimes 0 0

main :: IO ()
main = interact $ show . prepare . map read .  words


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

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

main :: IO ()
main = do
  n <- readLn
  (m,arr) <- uniqueSort 1000000 n.listArray (0,n-1).map readInt.B.words <$> B.getLine
  print $ solve m arr

solve :: Int -> UArray Int Int -> Int
solve 1 _ = 0
solve n arr = go 0 0
   where
     !ub = unsafeAt arr (n-1)
     go !acc !i
       | i < n = let !ai = unsafeAt arr i
                     step acc q = max acc $ unsafeAt memo (min 1000001 $ (q+1)*ai) - q*ai
                 in go (foldl' step acc [1..ub`quot`ai]) (i+1)
       | otherwise = acc

     !memo = runSTUArray $ do
       memo <- newArray (0,1000001) 0 :: ST s (STUArray s Int Int)

       rep (unsafeAt arr 0+1) $ \i -> do
         unsafeWrite memo i 0
       rep (n-1) $ \i -> do
         let !ai = unsafeAt arr i
         for (ai+1) (unsafeAt arr (i+1)) $ \j -> do
           unsafeWrite memo j ai
       let !lst = unsafeAt arr (n-1)
       for (unsafeAt arr (n-1)+1) 1000001 $ \j -> do
         unsafeWrite memo j lst

       return memo

uniqueSort :: Int -> Int -> UArray Int Int -> (Int, UArray Int Int)
uniqueSort ub n arr = runST $ do
  inArray <- newArray (0,ub) False :: ST s (STUArray s Int Bool)
  rep n $ \i -> do
    unsafeWrite inArray (unsafeAt arr i) True

  res <- newArray_ (0,n-1) :: ST s (STUArray s Int Int)

  let go !cnt !i
        | i <= ub = do
            flg <- unsafeRead inArray i
            if flg then unsafeWrite res cnt i >> go (cnt+1) (i+1)
            else go cnt (i+1)
        | otherwise = (,) cnt <$> unsafeFreeze res
  go 0 0

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

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

upperBound :: (Integral i, Bits i) => (i -> Bool) -> i -> i -> i
upperBound p low high = go low high
   where
     go !low !high
       | low < high = case (low + high + 1) `unsafeShiftR` 1 of
                        mid | p mid -> go mid high
                            | otherwise -> go low (mid-1)
       | otherwise = low
{-# INLINE upperBound #-}

main :: IO ()
main = do
  n <- readLn
  (m,arr) <- uniqueSort 1000000 n.listArray (0,n-1).map readInt.B.words <$> B.getLine
  print $ solve m arr

solve :: Int -> UArray Int Int -> Int
solve 1 _ = 0
solve n arr = go 0 0
   where
     !ub = unsafeAt arr (n-1)
     go !acc !i
       | i < n  = let !ai = unsafeAt arr i
                      step (acc, j) q = (acc',j')
                       where
                         !qai = q * ai
                         !j' = upperBound (\x -> unsafeAt arr x - qai < ai) j $ min (j+ai) (n-1)
                         !acc' = max acc $ unsafeAt arr j' - qai
                  in go (fst $ foldl' step (acc,i) [1..quot ub ai]) (i+1)
       | otherwise = acc

uniqueSort :: Int -> Int -> UArray Int Int -> (Int, UArray Int Int)
uniqueSort ub n arr = runST $ do
  inArray <- newArray (0,ub) False :: ST s (STUArray s Int Bool)
  rep n $ \i -> do
    unsafeWrite inArray (unsafeAt arr i) True

  res <- newArray_ (0,n-1) :: ST s (STUArray s Int Int)

  let go !cnt !i
        | i <= ub = do
            flg <- unsafeRead inArray i
            if flg then unsafeWrite res cnt i >> go (cnt+1) (i+1)
            else go cnt (i+1)
        | otherwise = (,) cnt <$> unsafeFreeze res
  go 0 0


import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map
import qualified Data.Map as M
fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]
fast_read_Int64 = fmap (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) BS.getLine :: IO [Int64]

citesc_nr :: String -> Int64
citesc_nr s = read s
citesc_array :: [String] -> [Int64]
citesc_array = map read

--prefix sums
sumlist' xx = aux xx 0
    where aux [] a = []
          aux (x:xs) a = (a+x) : aux xs (a+x)

--pref m a = (a, if a `M.member` m then M.adjust succ a m else M.insert a 1 m)
f v x = Map.insertWith (+) x 1 v

solve :: Map.Map Int64 Int64 -> [(Int64,Int64)]
solve map_frec = M.toList map_frec

main = do
    x <- getLine
    let n = (citesc_nr x)
    vector <- fast_read_Int64
    let ps = sumlist' vector
    let dp = foldl f M.empty ps :: M.Map Int64 Int64
    print $ (n-) . foldl max 1 . map snd $ solve dp

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine, lookup)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.Map (elems, empty, lookup, insert, adjust)

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: Int -> [Int64] -> Int64
solve n xs = foldr go inf (zip [0..] . scanl1 (+) $ xs ++ xs) empty
    where
    inf = minimum . map snd . elems
    go (i, x) run w = case x `lookup` w of
        Nothing -> run $ insert x (i, 0) w
        Just (k, acc) -> case n < k + 1 of
            True  -> run w
            False -> run $ insert x (i, acc + inc) w
                where inc = fromIntegral $ i - k - 1

main = do
    [n] <- parse <$> getLine
    getLine >>= print . solve n . map fromIntegral . parse

import qualified Data.Map as M

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

solve :: [Integer] -> Integer
solve (n:xs) = (n-) . M.foldl max 1 . snd . foldl pref (0, M.empty) . take (fromIntegral n) $ xs

pref (cv, m) a = (nv, if nv `M.member` m then M.adjust succ nv m else M.insert nv 1 m)
  where nv = cv + a

import qualified Data.Map as Map

main :: IO()
main = do
    sn <- getLine
    sa <- getLine
    let n = read sn
    let a = map read $ words sa
    print $ solve n a Map.empty 0 n

removeMaybe :: Maybe Int -> Int
removeMaybe (Just a) = a
removeMaybe Nothing = 0

solve :: Int -> [Integer] -> Map.Map Integer Int -> Integer -> Int -> Int
solve _ [] _ _ ans = ans
solve n (a:ax) cnt sum ans = let next_sum = sum + a
                                 num = 1 + (removeMaybe $ Map.lookup next_sum cnt)
                                 deleted = Map.delete next_sum cnt
                                 next_cnt = Map.insert next_sum num deleted
                             in solve n ax next_cnt next_sum (min ans (n - num))

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine, lookup)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.Map (elems, empty, lookup, insert)

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: Int -> [Int] -> Int
solve n xs = foldr go (minimum . map snd . elems) ys empty
    where
    ys = zip [0..] . scanl1 (+) . map fromIntegral $ xs ++ xs :: [(Int, Int64)]
    go (i, x) run w = case x `lookup` w of
        Nothing -> run $ insert x (i, 0) w
        Just (k, acc) -> case n < k + 1 of
            True  -> run w
            False -> run $ insert x (i, acc + i - k - 1) w

main = do
    [n] <- parse <$> getLine
    getLine >>= print . solve n . parse

import qualified Data.Map as M

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

solve (n:xs) = ((n-1)-) . M.foldl max 0 . snd . foldl pref (0, M.empty) . take n $ xs

pref (cv, m) a = (nv, if nv `M.member` m then M.adjust succ nv m else M.insert nv 0 m)
  where nv = cv + a

import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map
import qualified Data.Map as M
fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

citesc_nr :: String -> Int
citesc_nr s = read s
citesc_array :: [String] -> [Int]
citesc_array = map read

--prefix sums
sumlist' xx = aux xx 0
    where aux [] a = []
          aux (x:xs) a = (a+x) : aux xs (a+x)

--pref m a = (a, if a `M.member` m then M.adjust succ a m else M.insert a 1 m)
f v x = Map.insertWith (+) x 1 v

solve :: Map.Map Int Int -> [(Int,Int)]
solve map_frec = M.toList map_frec

main = do
    x <- getLine
    let n = (citesc_nr x)
    vector <- fast_read_Int
    let ps = sumlist' vector
    let dp = foldl f M.empty ps :: M.Map Int Int
    print $ (n-) . maximum . map snd $ solve dp

import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map
import qualified Data.Map as M
fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

citesc_nr :: String -> Int
citesc_nr s = read s
citesc_array :: [String] -> [Int]
citesc_array = map read

--prefix sums
sumlist' xx = aux xx 0
    where aux [] a = []
          aux (x:xs) a = (a+x) : aux xs (a+x)

--pref m a = (a, if a `M.member` m then M.adjust succ a m else M.insert a 1 m)
f v x = Map.insertWith (+) x 1 v

solve :: Map.Map Int Int -> [(Int,Int)]
solve map_frec = M.toList map_frec

main = do
    x <- getLine
    let n = (citesc_nr x)
    vector <- fast_read_Int
    let ps = sumlist' vector
    let dp = foldl f M.empty ps :: M.Map Int Int
    print $ (n-) . foldl max 1 . map snd $ solve dp


-- ID  : 1569C (C. Jury Meeting)
-- URL : https://codeforces.com/contest/1569/problem/C
-- Failed to solve on my own and saw the editorial :/

import Control.Monad

-- bytestring for fast IO
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
getInt = parseInt `fmap` BS8.getLine :: IO Int64
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int64]
parseInt = fromIntegral . fst . fromJust . BS8.readInt

main = do
    t <- getInt
    replicateM_ (fromIntegral t) solve

magic = 998244353
mul2 x y = (x * y) `mod` magic

{- NOTE on Int64
 -
 - It's strange but when I use just Int type, codeforces and my desktop give different results for the input:
 - n = 74
 - as = 9 3 10 8 6 6 1 6 9 3 7 3 2 8 1 5 8 4 6 4 1 6 5 6 10 3 6 6 6 4 9 5 8 7 2 1 6 2 4 9 10 9 5 4 7 5 7 2 10 10 1 5 2 4 1 7 7 3 8 10 2 5 8 4 3 9 2 9 9 8 6 8 4 5
 - The answer is 420779088 and my desktop gives that number but codeforces gives 939628924.
 - Switching every Int to Int64 fixes the problem but I don't know why? Even the solution in the editorial uses int, not int64_t.
 -}
solve = do
    n <- getInt
    as <- getInts
    let maxima = maximum as
    let k = fromIntegral $ length $ filter (== (maxima - 1)) as
    let maxima_count = length $ filter (== maxima) as
    let x = foldl1 mul2 [1..n]
    let y = foldl1 mul2 [m | m <- [1..n], m /= (k + 1)]
    let answer = if maxima_count == 1 then (x - y + magic) `mod` magic else x
    print answer

-- ID  : 1569C (C. Jury Meeting)
-- URL : https://codeforces.com/contest/1569/problem/C

import Control.Monad

-- bytestring for fast IO
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
getInt = parseInt `fmap` BS8.getLine :: IO Int64
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int64]
parseInt = fromIntegral . fst . fromJust . BS8.readInt

main = do
    t <- getInt
    replicateM_ (fromIntegral t) (solve (t == 1000))

magic = 998244353
mul2 x y = (x * y) `mod` magic

solve dbg = do
    n <- getInt
    as <- getInts
    let maxima = maximum as
    let k = fromIntegral $ length $ filter (== (maxima - 1)) as
    let maxima_count = length $ filter (== maxima) as
    let x = foldl1 mul2 [1..n]
    let y = foldl1 mul2 [m | m <- [1..n], m /= (k + 1)]
    let answer = if maxima_count == 1 then (x - y + magic) `mod` magic else x
    print answer
    {-
    if dbg then do
        putStrLn "=== debug ==="
        putStrLn ("maxima: " ++ show maxima)
        putStrLn ("k: " ++ show k)
        putStrLn ("maxima_count: " ++ show maxima_count)
        putStrLn ("x: " ++ show x)
        putStrLn ("y: " ++ show y)
    else do
        return ()
        -}

{-# LANGUAGE LambdaCase #-}

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

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

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = numberOf int

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

-- solve :: Input -> Output
solve xs
  | f /= 1 = factorial ! n
  | otherwise = factorial ! n *% (fi g /% fi (f + g))
  where
    n = length xs
    m = maximum xs
    f = count m xs
    g = count (m - 1) xs

maxn :: (Integral a) => a
maxn = 2 * 10 ^ 5 + 5

factorial :: UArray Int Int64
factorial = listArray (0, maxn) $ scanl (*%) 1 [1 .. maxn]

modv :: Int64
modv = 998244353

(*%), (/%) :: Int64 -> Int64 -> Int64
u *% v = (u * v) `mod` modv
u /% v = u *% modInv v

modInv :: Int64 -> Int64
modInv a = modPow a (modv - 2)

modPow :: Int64 -> Int64 -> Int64
modPow a n
  | n == 0 = 1
  | odd n = a *% modPow a (n - 1)
  | otherwise = let a' = modPow a (n `div` 2) in a' *% a'

-------------------------- Template ------------------------------------------
fi = fromIntegral

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

import Control.Monad
import Data.Array
import Data.Int

m :: Int64
m = 998244353

newtype MInt = MInt {toInt64 :: Int64}

instance Num MInt where
    MInt a + MInt b = MInt $ if c >= m then c - m else c where c = a + b
    MInt a - MInt b = MInt $ if c < 0 then c + m else c where c = a - b
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum (MInt a) = MInt $ signum a
    fromInteger i   = MInt $ fromInteger i `mod` m

instance Enum MInt where
    toEnum = fromIntegral
    fromEnum = fromIntegral . toInt64

inv :: MInt -> MInt
inv a = a ^ (m - 2)

fac :: Array Int MInt
fac = listArray (0, 2 * 10^5) xs where xs = 1 : zipWith (*) [1..] xs

solve :: IO ()
solve = do
    n <- readLn
    as <- readMany
    let m = maximum as
        mc = length $ filter (==m) as
        bs = filter (/=m) as
        m' = maximum bs
        mc'= length $ filter (==m') bs
        res | mc > 1     = fac!n
            | m - m' > 1 = 0
            | otherwise  = fac!mc' * fromIntegral mc' * fac!n * inv (fac!(mc' + 1))
    print $ toInt64 res

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

main :: IO ()
main = readLn >>= flip replicateM_ solve

import Control.Monad
import Data.Array
import Data.Int

m :: Int64
m = 998244353

newtype MInt = MInt {toInt64 :: Int64} deriving Show

instance Num MInt where
    MInt a + MInt b = MInt $ if c >= m then c - m else c where c = a + b
    MInt a - MInt b = MInt $ if c < 0 then c + m else c where c = a - b
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum (MInt a) = MInt $ signum a
    fromInteger i   = MInt $ fromInteger i `mod` m

instance Enum MInt where
    toEnum = fromIntegral
    fromEnum = fromIntegral . toInt64

inv :: MInt -> MInt
inv a = a ^ (m - 2)

lim :: Int
lim = 5 * 10^5

fac :: Array Int MInt
fac = listArray (0, lim) xs where xs = 1 : zipWith (*) [1..] xs

binomMod :: Int -> Int -> MInt
binomMod = ch where
    ifac = listArray (0, lim) $ map inv $ elems fac
    ch a b | b < 0 || a < b = 0
    ch a b = fac!a * ifac!b * ifac!(a - b)

solve :: IO ()
solve = do
    n <- readLn
    as <- readMany
    let m = maximum as
        mc = length $ filter (==m) as
        bs = filter (/=m) as
        m' = maximum bs
        mc' = length $ filter (==m') bs
        res | mc > 1 = fac!n
            | m - m' > 1 = 0
            | otherwise = fac!mc' * fromIntegral mc' * fac!(n - mc' - 1) * binomMod n (mc' + 1)
    print $ toInt64 res

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

main :: IO ()
main = readLn >>= flip replicateM_ solve

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.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.Int
import Data.List
import Data.Semigroup

p :: Int64
p = 998244353

(*!) :: Int64 -> Int64 -> Int64
infixr 7 *!
x *! y = rem (x * y) p

newtype ModP = ModP { unModP :: Int64 }
instance  Semigroup ModP  where
  ModP x <> ModP y = ModP $ x *! y
inv :: Int64 -> Int64
inv = unModP . stimes (p - 2) . ModP

factorial :: Int64 -> Int64
factorial n = foldl' (*!) 1 [1 .. n]

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    let
      x : y : _ = reverse $ sort a
      opts = filter (>= y) a
      k = fromIntegral $ length opts
      n64 = fromIntegral n
      ans = case  x - y  of
        0 -> factorial n64
        1 -> factorial n64 *! (k - 1) *! inv k
        _ -> 0
    pure $ putInt64s [ans]

type SP = State [P.ByteString]
type SO = SP Builder

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

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> Builder
putInt64s vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.int64Dec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> int64Dec 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

-- ID  : 1569C (C. Jury Meeting)
-- URL : https://codeforces.com/contest/1569/problem/C

import Control.Monad

-- bytestring for fast IO
import Data.Maybe
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
getInt = parseInt `fmap` BS8.getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int]
parseInt = fromIntegral . fst . fromJust . BS8.readInt

main = do
    t <- getInt
    replicateM_ t (solve (t == 1000))

magic = 998244353
mul2 x y = (x * y) `mod` magic

solve dbg = do
    n <- getInt
    as <- getInts
    let maxima = maximum as
    let k = length $ filter (== (maxima - 1)) as
    let maxima_count = length $ filter (== maxima) as
    let x = foldl1 mul2 [1..n]
    let y = foldl1 mul2 [m | m <- [1..n], m /= (k + 1)]
    let answer = if maxima_count == 1 then (x - y + magic) `mod` magic else x
    print answer
    if dbg then do
        putStrLn "=== debug ==="
        putStrLn ("maxima: " ++ show maxima)
        putStrLn ("k: " ++ show k)
        putStrLn ("maxima_count: " ++ show maxima_count)
        putStrLn ("x: " ++ show x)
        putStrLn ("y: " ++ show y)
    else do
        return ()

-- ID  : 1569C (C. Jury Meeting)
-- URL : https://codeforces.com/contest/1569/problem/C

import Control.Monad

-- bytestring for fast IO
import Data.Maybe
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
getInt = parseInt `fmap` BS8.getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int]
parseInt = fromIntegral . fst . fromJust . BS8.readInt

main = do
    t <- getInt
    replicateM_ t solve

magic = 998244353
mul2 x y = (x * y) `mod` magic

solve = do
    n <- getInt
    as <- getInts
    let maxima = maximum as
    let k = length $ filter (== (maxima - 1)) as
    let maxima_count = length $ filter (== maxima) as
    let x = foldl1 mul2 [1..n]
    let y = foldl1 mul2 [m | m <- [1..n], m /= (k + 1)]
    let answer = if maxima_count == 1 then (x - y + magic) `mod` magic else x
    print answer

{-# LANGUAGE LambdaCase #-}

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

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

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = numberOf int

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

-- solve :: Input -> Output
solve xs
  | f == n = factorial ! n
  | g == 0 = 0
  | otherwise =
    let pick = fi g /% fi (f + g)
     in factorial ! n *% pick
  where
    n = length xs
    m = maximum xs
    f = count m xs
    g = count (m - 1) xs

factorial :: UArray Int Int64
factorial = listArray (0, 10 ^ 5) $ scanl (*%) 1 [1 .. 10 ^ 5]

modv :: Int64
modv = 998244353

(*%), (/%) :: Int64 -> Int64 -> Int64
u *% v = (u * v) `mod` modv
u /% v = u *% modInv v

modInv :: Int64 -> Int64
modInv a = modPow a (modv - 2)

modPow :: Int64 -> Int64 -> Int64
modPow a n
  | n == 0 = 1
  | odd n = a *% modPow a (n - 1)
  | otherwise = let a' = modPow a (n `div` 2) in a' *% a'

-------------------------- Template ------------------------------------------
fi = fromIntegral

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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


answer a b = (a+b)/(2*kb+2)
  where k = floor (((a/b)-1.0)/2.0)
        kb = (fromIntegral k)::Double

main = do
  w <- getLine
  let [a,b] = [read n::Double| n <- (words w)]
  if a < b
  then putStrLn "-1"
  else putStrLn $ show $ answer a b

import Data.Ratio ((%))
import Control.Applicative ((<$>))

solve :: Integer -> Integer -> Double
solve a b
    | x == -1   = fromRational y
    | y == -1   = fromRational x
    | otherwise = fromRational $ min x y
    where
    x = if k < 0 then -1 else if k == 0 then a % 1 else (a - b) % (2 * k)
        where k = floor $ (a - b) % (2 * b)

    y = if k < 1 then -1 else (a + b) % (2 * k)
        where k = floor $ (a + b) % (2 * b)

main = do
    a:b:_ <- map read . words <$> getLine
    print $ solve a b

-- Codeforces 578A

main :: IO ()
main = getLine >>= print . solve . map read . words where
    solve :: (RealFrac a) => [a] -> a
    solve [x, y]
        | x < y = -1
        | otherwise = (x+y)/2/(fromIntegral ((fromIntegral $ floor (x+y)) `div` (fromIntegral $ floor (2*y))))

import Data.Ratio ((%))
import Control.Applicative ((<$>))

solve :: Integer -> Integer -> Double
solve a b
    | a == b    = fromInteger a
    | k < 1 || x == 0 && y == 0 = -1
    | x == 0    = fromRational y
    | y == 0    = fromRational x
    | otherwise = fromRational $ min x y
    where
    k = floor $ (a - b) % (2 * b)
    x = (a - b) % (2 * k)
    y = (a + b) % (2 * k + 2)

main = do
    a:b:_ <- map read . words <$> getLine
    print $ solve a b

import Data.Ratio ((%))
import Control.Applicative ((<$>))

solve :: Integer -> Integer -> Double
solve a b
    | k < 1 || x == 0 && y == 0 = -1
    | x == 0    = fromRational y
    | y == 0    = fromRational x
    | otherwise = fromRational $ min x y
    where
    k = floor $ (a - b) % (2 * b)
    x = (a - b) % (2 * k)
    y = (a + b) % (2 * k + 2)

main = do
    a:b:_ <- map read . words <$> getLine
    print $ solve a b


import Control.Applicative
import Control.Monad

parse :: [String] -> [[Integer]]
parse = map (\l -> map read . words $ l)

solve :: [Integer] -> Integer
solve (a:b:n:[])
  | a>n || b>n = 0
  | a<=b = 1 +  solve [(a+b), b, n]
  | otherwise = 1 + solve [a, (a+b), n]

main :: IO ()
main = do
  n <- getLine
  content <- replicateM (read n :: Int) getLine
  putStrLn . unlines . map show . map solve . parse $ content

import Control.Monad

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

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

solve :: Int -> Int -> Int -> Int
solve a b n = f a' b' n
  where
    a' = min a b
    b' = max a b
    f x y m
      | y>m = 0
      | otherwise = 1 + f y (x+y) m

{-# LANGUAGE TypeApplications #-}

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

main = (>>=) (readLn @Int) $ flip replicateM_ $ do
  [a, b, n] <- map (read @Int) . words <$> getLine
  print $ solve a b n 0
 where
  solve a b n k | a > n || b > n = k
                | otherwise      = solve (max a b) (a + b) n (k + 1)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Tuple

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

(|>) = flip ($)

-- assuming x <= y
_solve !acc !x !y tgt
  | y > tgt = acc
  | otherwise = _solve (acc + 1) y (x+y) tgt
solve x y tgt = _solve 0 (min x y) (max x y) tgt

main = do
  input <- getContents
  let _:tokens = read <$> split input :: [Int]
      res = tokens |> unfoldr (\case
        []  -> Nothing
        a:b:n:rest  -> Just (solve a b n, rest)
        )
  sequence_ $ putStrLn <$> (show <$> res)

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

process s n m k | n>k || m>k = s
                | n<m = process (s+1) (n+m) m k
                | otherwise = process (s+1) n (m+n) k

onecase = do
		[n,m,k]<-map read <$> words <$> getLine ::IO [Int]
		print $ process 0 n m k

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

import Control.Monad

brute :: Int->Int->Int->Int->Int
brute a b n acc
  | a > n || b > n = acc
  | a > b = brute a (b + a) n (acc + 1)
  | otherwise = brute (a + b) b n (acc + 1)

solveTest = do
  [a, b, n] <- (map read) . words <$>getLine
  putStrLn . show $ brute a b n 0

main = do
  t <- read <$> getLine
  replicateM_ t solveTest


{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe, catMaybes)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, nub, intercalate, transpose)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.String (fromString)
import Data.Bits (shift)
import Data.Binary (encode, decode)

-- road map in reverse, and the number of cities, init pen state
type Domain = ([Int], Int)
type CoDomain = Int
type Solver  = Domain -> CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> fromString <$> getLine

printAns :: CoDomain -> IO ()
printAns xs = putStrLn $ show xs

parse :: IO Domain
parse = do
  [n, k] <- readChar8
  xs <- readChar8
  return (xs, k)

compute :: [Int] -> Int
compute ys = go 1 ys
  where
    go :: Int -> [Int] -> Int
    go _ [] = 0
    go n (x:xs)
     | n > 31 = 0
     | otherwise = x `div` 2 ^ n + go (n+1) xs

solve :: Solver
solve (xs, k) = ans
  where
        yss = zipWith (flip (-) . (k*)) [0..] $ scanl (+) 0 xs
        rss = compute <$> scanr (:) [] xs
        ans = maximum $ zipWith (+) rss yss

main :: IO ()
main = do
  [n] <- readChar8
  replicateM_ n $ printAns =<< solve <$> parse
  return ()

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

solve :: [Int] -> Int -> Int -> Int
solve arr n k =
    solve' arr n k 0 0 0

solve' [] n k i curSum acc =
    if acc > me then acc else me
    where me = curSum - n * k

solve' arr n k i curSum acc =
    solve' (tail arr) n k (i+1) (curSum + (head arr)) mx
    where
        elems = zip [1..] $ take 32 arr
        halve = \(i, v) -> v `div` (2 ^ i)
        me = curSum + (sum $ map halve elems) - k * i
        mx = if me > acc then me else acc

testcase 0 = return ()
testcase t = do
    (n:k:_) <- map (read :: String -> Int) <$> words <$> getLine
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show $ solve arr n k
    testcase (t - 1)

main :: IO ()
main = do
    t <- read <$> getLine
    testcase t

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

solve :: [Int] -> Int -> Int -> Int
solve arr n k =
    solve' arr n k 0 0

solve' [] n k i curSum = curSum - n * k
solve' arr n k i curSum =
    (if me - i * k > you
    then me - i * k
    else you)
    where
        elems = zip [1..] $ take 32 arr
        halve = \(i, v) -> v `div` (2 ^ i)
        me = curSum + (sum $ map halve elems)
        you = solve' (tail arr) n k (i+1) (curSum + (head arr))

testcase 0 = return ()
testcase t = do
    (n:k:_) <- map (read :: String -> Int) <$> words <$> getLine
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show $ solve arr n k
    testcase (t - 1)

main :: IO ()
main = do
    t <- read <$> getLine
    testcase t


import Control.Monad

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

printSolve = do
  n <- readLn :: IO Int
  a <- getLine
  b <- getLine
  putStrLn $ checkPossible ((tail . init) a) ((tail . init) b)

checkPossible [] [] = "YES"
checkPossible (x:xs) (y:ys)
  | x == '1' && y == '1' = "NO"
  | otherwise = checkPossible xs ys

import Data.Function (on)

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

solve input = let (t:tasks) = lines input
                  get_ans [] = []
                  get_ans (n:s1:s2:xs) = task_ans s1 s2 : get_ans xs where
                                         task_ans s1 s2 = (and $ zipWith ((||) `on` (=='0')) (init s1) (init s2)) && last s2 == '0'
              in unlines . map yesNo $ get_ans tasks

main = interact solve

import Control.Monad
import Data.List

calc :: [(Char,Char)] -> String
calc str =
  let ans = all (\(i,j) ->
         (i=='0') || (j=='0')
         ) str
  in
    if ans then "YES" else "NO"

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    unused <- getLine
    line1 <- getLine
    line2 <- getLine
    putStrLn $ calc $ zip line1 line2

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {m :: Int, row1 :: B8.ByteString, row2 :: B8.ByteString}
data Output = YES | NO deriving Show

solve :: Input -> Output
solve (Input _ xs ys) = maybe YES (const NO) $ L.find (==('1','1')) $ B8.zip xs ys

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[m] <- getIntegrals 1
  row1 <- state getNext
  row2 <- state getNext
  return $ Input m row1 row2

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go NO = str "NO" <> nl
  go (YES) = str "YES" <> nl --kkmconcat $ (<>nl) <$> [str "Yes", dec l, (mconcat $ fmap ((<> sp).dec) xs)]

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

----------------------------- library -------------------------------
modp :: Integral t=>t->t
modp = (`mod` (10^9+7))

fastPow :: Integral t=>(t->t)->t->t->t
fastPow modf base' p' = go base' p' where
  go base 0 = base
  go base p = go (base`times`base) (p`div`2)  `times`  base^(p`mod`2)
  times = (modf.).(*)

primeFac :: Integral t=> t -> [(t,Int)]
primeFac  = map (\xs-> (head xs,length xs)).L.group.tryDiv 2 where
  tryDiv d n
    | n `mod` d == 0 = d : tryDiv d (n `div` d)
    | n == 1 = []
    | d*d < n = tryDiv (d+1+d`mod`2) n
    | otherwise = tryDiv n n

umakeset xs = (M.fromList (zip xs xs), M.fromList (zip xs (repeat 0)))
ufind uf@(parents,ranks) x = if parents M.! x == x then x else ufind uf (parents M.! x)
uunion uf@(parents, ranks) x y = if fx==fy then (False,uf) else (True, (parents1, ranks1)) where
  (fx, fy) = (ufind uf x, ufind uf y)
  [(r0,f0), (r1,f1)] = L.sort [(ranks M.! fx, fx), (ranks M.! fy, fy)]
  parents1 = M.insert f0 f1 parents
  ranks1 = if r0 /= r1 then ranks else M.insert f1 (r1+1) ranks

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        ~[nTc] <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

import Control.Monad

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

solve = do
    n <- readLn :: IO Int
    s0 <- getLine
    s1 <- getLine
    let s = zip s0 s1
    let block = ('1', '1') `elem` s
    putStrLn $ if block
        then "NO"
        else "YES"


main :: IO ()
main = print . solve 0 0 . tail . map read . words =<< getContents

solve :: Int -> Int -> [Int] -> Int
solve sum single [_]      = sum + (single + 1) `div` 2
solve sum single (k:w:ws) = let pockets = (w + k - 1) `div` k
                            in solve (sum + pockets `div` 2) (single + pockets `mod` 2) (k:ws)

import Data.List( sort)
import Control.Applicative( (<$>))
import Control.Monad.State( evalState, get, modify)
main = do
    [_n_, k_] <- map read . words <$> getLine
    ws_ <- map read . words <$> getLine
    print $ slotTakingStep 2 k_ $ sort ws_

slotTakingStep numSlots slotSize list = (process list)
					    `evalState` (0,numSlots)
  where
    stepSize =  numSlots * slotSize

    process []	    = do
	    (value,idleSlots) <- get
	    return $ value + (if idleSlots==numSlots then 0 else 1)
    process (e:es) = do
	let
	    modifySlot f = modify (f <$>)
	    modifyValue f = modify $ \(value, idles) ->
					 (f value, idles)
	    getIdleSlots = snd <$> get

	idleSlots <- getIdleSlots
	if idleSlots==numSlots
	then case e `quotRem` stepSize of
		(0, stepRem)	    -> do
		    let
			(q,r) = stepRem `quotRem` slotSize
			slotsNeeded =	if r==0 then q else q+1
		    if numSlots==slotsNeeded
		    then do
			modifyValue (+1)
			process es
		    else do
			modifySlot (subtract slotsNeeded)
			process es

		(steps, 0)	-> do
				    modifyValue (+steps)
				    process es
		(steps,stepRem) -> do
				    modifyValue (+steps)
				    process (stepRem:es)
	else let
		(q,r) = e `quotRem` slotSize
		slotsNeeded =    if r==0 then q else q+1
		flushSlot = modifySlot (const numSlots)

	    in if idleSlots < slotsNeeded
	    then do
		flushSlot
		modifyValue (+1)
		process (e - idleSlots * slotSize   :es)
	    else if idleSlots==slotsNeeded
		then do
		    flushSlot
		    modifyValue (+1)
		    process es
		else do
		    modifySlot (subtract slotsNeeded)
		    process es

import Control.Applicative( (<$>))
main = do
    [_n_, k_] <- map read . words <$> getLine
    ws_ <- map read . words <$> getLine
    print $ slotTakingStep 2 k_ ws_

slotTakingStep numSlots szSlot list =
    let
	divBox i k = 1 + ((i-1)`div`k)
	boxes = sum $ (`divBox` szSlot) <$> list
    in
	boxes `divBox` numSlots

import Data.List( sort)
import Control.Applicative( (<$>))
import Control.Monad.Reader( runReader, ask, Reader)
main = do
    [_n_, k_] <- map read . words <$> getLine
    ws_ <- map read . words <$> getLine
    print $ slotTakingStep 2 k_ $ sort ws_

slotTakingStep	::Integral i
		=> Int -> i -> [i] -> i
slotTakingStep numSlots szSlot list = process 0 list
  where
    process step []  = step
    process step [n] =
	let
	    (q,r) = n `quotRem` (fromIntegral numSlots * szSlot)
	in
	    step + (if r==0 then q else q+1)

    process step list =
	let
	    (h:tl, remain) = splitAt numSlots list
	    (q,r) = h `quotRem` szSlot
	    q' =	if r==0 then q else q+1
	    processedSlot = (subtract $ q' * szSlot) <$> tl
	    positiveFiltered = dropWhile (<=0) processedSlot
	in
	    process (step+q') (positiveFiltered++remain)

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

import Control.Monad (forM_, forM)
import Data.List (sort)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

readint = fst. fromJust . C.readInt

ddiv k x | x `mod` k == 0 = x `div` k
         | otherwise      = x `div` k + 1

main = do
    (map readint . C.words -> [n, k]) <- B.getLine
    (map readint . C.words -> xs) <- B.getLine
    putStrLn $ show $ ddiv 2 (sum (map (ddiv k) xs))

import Control.Applicative

solve _ [] = 0
solve k (l:ls) = if l<=k then 1+solve k ls else ceiling (l/k)+solve k ls

main = do
   [n,k] <- map read.words <$> getLine
   suma <- map read.words <$> getLine
   putStrLn.show $ ceiling (fromInteger (solve k suma)/2)

import Data.List
import Data.Array
import Data.Ord
import Data.Char

rd x = read x::Integer
getNumbers=map rd.words
extract (x:y:_) = (k,num) where
	(_:k:_)=getNumbers x
	num=getNumbers y
divm x k=(\(a,b)->[a,b])$ quotRem x k
solve x k=(\(x,y)->x+sum(divm y 2)) $ foldr (\(a,b) (x,y)->(a+x,b+y)) (0,0) pairs
	where
		ones n
			|n==0 = 0
			|n>k = 2
			|otherwise = 1
		f n k=(a,ones b) where
			[a,b]=divm n (2*k)
		pairs = map (\n->f n k) x

res (k,x) = solve x k

main=interact$show.res.extract.lines

main = getContents >>= print . solve 0 . map read . words

solve rtn (n:k:ws)
  |null ws = (rtn + 1) `div` 2
  |otherwise = solve (rtn + ((head ws + k - 1)`div` k)) (n:k:(tail ws))

import Data.List
import Data.Array
import Data.Ord
import Data.Char

rd x = read x::Integer
getNumbers=map rd.words
extract (x:y:_) = (k,num) where
	(_:k:_)=getNumbers x
	num=getNumbers y

solve x k=(\(x,y)->x+(div y 2)+(mod y 2)) $ foldr (\(a,b) (x,y)->(a+x,b+y)) (0,0) pairs
	where
		ones n
			|n==0 = 0
			|n>k = 2
			|otherwise = 1
		pairs = map (\n->(div n (2*k),ones (mod n (2*k)))) x

res (k,x) = solve x k

main=interact$show.res.extract.lines

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

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

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

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

main = do
	[ n, k ] <- readInts
	as <- getList
	print $ ( `div` 2 ) $ succ $ sum $ map ( \m -> ( m + k - 1 ) `div` k ) as

import qualified Data.ByteString.Char8 as BS
import           Data.List             (unfoldr)

main = getInts >>= \[n, k] -> getInts >>= print . ql 2.  sum . fmap (ql k) where
  ql k x = quot (x + k - 1) k
  getInts = fmap (unfoldr readOne) BS.getLine where
    readOne s = do
      (x , s') <- BS.readInt s
      return (x, BS.drop 1 s')

import Data.List
import Data.Array
import Data.Ord

srt x=reverse $ sort x

takeMax n k
	|n>k = n-k
	|otherwise = 0

solve [] k day = day
solve [x] k day
	|mod x (2*k) ==0 = day + (div x (2*k))
	|otherwise = day + (div x (2*k) + 1)
solve (x:y:xs) k day
	|x==0 && y==0 = solve xs k day
	|x==0 = solve (y:xs) k day
	|y==0 = solve (x:xs) k day
	|x>=2*k = solve ((mod x (2*k)):y:xs) k (day+(div x (2*k)))
	|y>=2*k  = solve (x:(mod y (2*k)):xs) k (day+(div y (2*k)))
	|otherwise = solve ((takeMax x k):(takeMax y k):xs) k (day+1)

res (k,x) = solve (srt x) k 0

extract (x:y:_) = (k,num) where
	(_:k:_)=map (\n->read n::Integer) $ words x
	num=map (\n->read n::Integer) $ words y

main=interact$show.res.extract.lines

import Data.List
import Data.Array
import Data.Ord

srt x=reverse $ sort x

takeMax n k
	|n>k = n-k
	|otherwise = 0

solve [x] k day
	|mod x (2*k) ==0 = day + (div x (2*k))
	|otherwise = day + (div x (2*k) + 1)
solve (x:y:xs) k day
	|x==0 = solve (y:xs) k day
	|x>=2*k = solve ((mod x (2*k)):y:xs) k (day+(div x (2*k)))
	|y>=2*k && (mod y (2*k))/=0 = solve (x:(mod y (2*k)):xs) k (day+(div y (2*k)))
	|y>=2*k  = solve (x:xs) k (day+(div y (2*k)))
	|otherwise = solve ((takeMax x k):(takeMax y k):xs) k (day+1)

res (k,x) = solve (srt x) k 0

extract (x:y:_) = (k,num) where
	(_:k:_)=map (\n->read n::Integer) $ words x
	num=map (\n->read n::Integer) $ words y

main=interact$show.res.extract.lines

import Data.List
import Data.Array
import Data.Ord

srt x=reverse $ sort x

takeMax n k
	|n>k = n-k
	|otherwise = 0

solve [x] k day
	|mod x k ==0 = day + (div x k)
	|otherwise = day + (div x k + 1)
solve (x:y:xs) k day
	|x==0 = solve (y:xs) k day
	|x>=2*k = solve ((mod x k):y:xs) k (day+(div x (2*k)))
	|otherwise = solve ((takeMax x k):(takeMax y k):xs) k (day+1)

res (k,x) = solve (srt x) k 0

extract (x:y:_) = (k,num) where
	(_:k:_)=map (\n->read n::Integer) $ words x
	num=map (\n->read n::Integer) $ words y

main=interact$show.res.extract.lines

import Data.List
import Data.Array
import Data.Ord

srt x=reverse $ sort x

takeMax n k
	|n>k = n-k
	|otherwise = 0

solve [x] k day
	|mod x (2*k) ==0 = day + (div x (2*k))
	|otherwise = day + (div x (2*k) + 1)
solve (x:y:xs) k day
	|x==0 = solve (y:xs) k day
	|x>=2*k = solve ((mod x (2*k)):y:xs) k (day+(div x (2*k)))
	|y>=2*k = solve (x:(mod y (2*k)):xs) k (day+(div y (2*k)))
	|otherwise = solve ((takeMax x k):(takeMax y k):xs) k (day+1)

res (k,x) = solve (srt x) k 0

extract (x:y:_) = (k,num) where
	(_:k:_)=map (\n->read n::Integer) $ words x
	num=map (\n->read n::Integer) $ words y

main=interact$show.res.extract.lines

import Data.List
import Data.Array
import Data.Ord
import Data.Char

rd x = read x::Integer
getNumbers=map rd.words
extract (x:y:_) = (k,num) where
	(_:k:_)=getNumbers x
	num=getNumbers y

solve x k=foldr (\(_,b) n->n+b) 0 pairs
	where
		ones n
			|n==0 = 0
			|n>k = 2
			|otherwise = 1
		pairs = map (\n->(div n (2*k),ones (mod n (2*k)))) x

res (k,x) = solve x k

main=interact$show.res.extract.lines

import Data.List
import Data.Array
import Data.Ord

srt x=reverse $ sort x

takeMax n k
	|n>k = n-k
	|otherwise = 0

solve [x] k day
	|mod x k ==0 = day + (div x k)
	|otherwise = day + (div x k + 1)
solve (x:y:xs) k day
	|x==0 = solve (y:xs) k day
	|x>=2*k = solve ((mod x (2*k)):y:xs) k (day+(div x (2*k)))
	|otherwise = solve ((takeMax x k):(takeMax y k):xs) k (day+1)

res (k,x) = solve (srt x) k 0

extract (x:y:_) = (k,num) where
	(_:k:_)=map (\n->read n::Integer) $ words x
	num=map (\n->read n::Integer) $ words y

main=interact$show.res.extract.lines

import Data.List
import Data.Array
import Data.Ord

srt x=reverse $ sort x

takeMax n k
	|n>k = n-k
	|otherwise = 0

solve [x] k day
	|mod x (2*k) ==0 = day + (div x (2*k))
	|otherwise = day + (div x (2*k) + 1)
solve (x:y:xs) k day
	|x==0 = solve (y:xs) k day
	|x>=2*k = solve ((mod x (2*k)):y:xs) k (day+(div x (2*k)))
	|otherwise = solve ((takeMax x k):(takeMax y k):xs) k (day+1)

res (k,x) = solve (srt x) k 0

extract (x:y:_) = (k,num) where
	(_:k:_)=map (\n->read n::Integer) $ words x
	num=map (\n->read n::Integer) $ words y

main=interact$show.res.extract.lines

import Data.List( sortBy)
import Control.Applicative( (<$>))
import Data.Bool( bool)
main = do
    [n_, k_] <- map read . words <$> getLine
    ws <- map read . words <$> getLine
    let
	sortedWs = sortBy (flip compare) ws
	k2 = 2*k_
	collect day [] = day
	collect day [w] = let
				(qu,re) = w`quotRem`k2
				addition = bool 0 1 (re/=0)
			  in
			    day + qu + addition
	collect day (w1:w2:ws)= let
				(q,r) = w1`quotRem`k2
				nextW = w2-k_
	  in if k_<=r
	    then collect (day+q+1) (w2:ws)
	    else if 0 < nextW
		    then collect (day+q+1) (nextW:ws)
		    else collect (day+q+1) ws
    print $ collect 0 sortedWs

import Data.List( sortBy)
import Control.Applicative( (<$>))
import Data.Bool( bool)
main = do
    [n_, k_] <- map read . words <$> getLine
    ws <- map read . words <$> getLine
    let
	sortedWs = sortBy (flip compare) ws
	k2 = 2*k_
	collect day [] = day
	collect day [w] = let
			    (q,r) = w`quotRem`k2
			in
			    day + q + (if r/=0 then 1 else 0)

	collect day (w1:w2:ws) = let
				    w1' = max w1 w2
				    w2' = min w1 w2
				    (q,r) = w2'`quotRem`k_
				    head' = w1' - q * k_
		in case (q,r) of
		    (0,r)   -> if w1'==w2'
				then collect (day+1) ws
				else collect (day+1) ((w1'-k_):ws)
		    (q,0)   -> if w1'==w2'
				then collect (day+q) ws
				else collect (day+q) (head':ws)
		    (q,r)   -> collect (day+q) (head':r:ws)
    print $ collect 0 sortedWs


import System.IO

readType ("int":xs) acc = ("int":acc, xs)
readType ("pair":xs) acc = let (la, lc) = readType xs ("<":"pair":acc);
                               (ra, rc) = readType lc (",":la)
                           in (">":ra, rc)
readType _ _ = (["!"], [])

checkElem xs = if elem "!" xs then ["Error occurred"] else xs
checkLen (res, xs) = if xs /= [] then (["Error occurred"], []) else (res, xs)

solve text = concat $ reverse $ checkElem $ fst $ checkLen $ readType lexs []
             where lexs = words text

main = do
--    content <- readFile "input.txt"
--    ([intCount, ttypes]) <- return $ lines content
    ttypes <- getLine >> getLine
    putStrLn (solve ttypes)

import Control.Monad
import Data.List
data Type = IntT | PairT Type Type

printType :: Type -> IO ()
printType IntT = putStr "int"
printType (PairT t1 t2) = do
  putStr "pair<"
  printType t1
  putStr ","
  printType t2
  putStr ">"

data Parser a = Parser {run :: String -> (Maybe a, String)}
instance Monad Parser where
    return x = Parser $ \inp -> (Just x, inp)
    p >>= q = Parser $ \inp ->
              case run p inp of
                (Nothing, _) -> (Nothing, "")
                (Just x, rest) -> run (q x) rest

(<|>) :: Parser a -> Parser a -> Parser a
p <|> q = Parser $ \inp ->
          case run p inp of
            ok@(Just x, rest) -> ok
            (Nothing, _) -> run q inp

int :: Parser Type
int = Parser $ \inp -> if "int " `isPrefixOf` inp then (Just IntT, drop 4 inp) else (Nothing, "")

pairCons :: Parser ()
pairCons = Parser $ \inp -> if "pair " `isPrefixOf` inp then (Just (), drop 5 inp) else (Nothing, "")

typ :: Parser Type
typ = do
  int <|> do
        pairCons
        t1 <- typ
        t2 <- typ
        return $ PairT t1 t2

main = do
  n_ <- getLine
  let n = read n_
  inp_ <- getLine
  let inp = inp_ ++ " "
  if length (filter (=='t') inp) == n then
      case run typ inp of
        (Just typ, "") -> printType typ >> putStrLn ""
        _ -> putStrLn "Error occurred"
   else putStrLn "Error occurred"

loop :: [String] -> [String] -> [String] -> String

solve t = loop (words t) [] []

solve' t = loop t [] []

loop ["int"] [] [] = "int"
loop [] [] res = concat . reverse $ res
loop [] (">":stack) (",":res) =
    "Error occurred"

loop task (">":stack) res@(">":_) =
    loop task stack (">":res)
loop task (",":stack) res@(">":_) =
    loop task stack (",":res)

loop ("pair":task) stack res =
    loop task (",":">":stack) ("pair<":res)

loop ("int":task) (s:stack) res@(",":_) =
    loop task stack (s:"int":res)
loop ("int":task) (s:stack) res@("pair<":_) =
    loop task stack (s:"int":res)

loop task stack res =
    "Error occurred"
--   error $ show task ++ ";" ++ show stack++ ";"++show res

parse foo = case lines foo of
              [_, x] -> words x

main = (putStrLn . solve' . parse =<< getContents)

loop :: [String] -> [String] -> [String] -> String

solve t = loop (words t) [] []

solve' t = loop t [] []

loop ["int"] [] [] = "int"
loop [] [] res = concat . reverse $ res
loop [] (">":stack) (",":res) =
    "Error occurred"

loop task (">":stack) res@(">":_) =
    loop task stack (">":res)
loop task (",":stack) res@(">":_) =
    loop task stack (",":res)

loop ("pair":task) stack res =
    loop task (",":">":stack) ("pair<":res)

loop ("int":task) (s:stack) res@(",":_) =
    loop task stack (s:"int":res)
loop ("int":task) (s:stack) res@("pair<":_) =
    loop task stack (s:"int":res)

loop task stack res =
    "Error occurred"
--   error $ show task ++ ";" ++ show stack++ ";"++show res

parse foo = case lines foo of
              [_, x] -> words $! x

main = (putStrLn . solve' . parse =<< getContents)

import Monad (MonadPlus, liftM, mzero)
import Prelude hiding (print)

data Type  =  Int | Pair Type Type

nameInt   =  "int"
namePair  =  "pair"

mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a
mfilter pred ma  =  do
    a  <-  ma
    if pred a then return a else mzero

parse :: [String] -> Maybe Type
parse  =  liftM fst . mfilter (null . snd) . parse'
  where
    parse' (w:ws)
      | w == nameInt  =  return (Int, ws)
      | w == namePair  =  do
        (t1, ws')  <-  parse' ws
        (t2, ws'')  <-  parse' ws'
        return (Pair t1 t2, ws'')
    parse' _  =  fail ""

print :: Maybe Type -> IO ()
print res  =  maybe (putStr "Error occurred") print' res >> putStrLn ""
  where
    print' Int  =  putStr "int"
    print' (Pair t1 t2)  =  sequence_
        [putStr "pair<", print' t1, putStr ",", print' t2, putStr ">"]

main :: IO ()
main  =  getLine >> getLine >>= print . parse . words

{-# LANGUAGE OverloadedStrings #-}

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

main = B.getContents >>= print.solve.tail.B.words

solve :: [B.ByteString] -> Expr
solve bss = evalParser (expr <* end)  bss

type State = [Elem]
type Elem = B.ByteString

data Expr = I | P Expr Expr | Error

instance Show Expr where
  showsPrec _ I = showString "int"
  showsPrec _ (P x y) = showString "pair<"
                      . shows x
                      . showChar ','
                      . shows y
                      . showChar '>'
  showsPrec _ Error = showString "Error occurred"

evalParser :: Parser Expr -> State -> Expr
evalParser expr st = case runParser expr st of
                       Just (result,_) -> result
                       Nothing -> Error

getElem :: Parser Elem
getElem = Parser $ \st -> if null st
                              then Nothing
                              else Just (head st,st)
getState :: Parser State
getState = Parser $ \st -> Just (st,st)
putState :: State -> Parser ()
putState st = Parser $ const $ Just ((),st)
modifyState :: (State -> State) -> Parser ()
modifyState f = Parser $ \st -> Just ((),f st)

expr = int <|> pair

int = do
  bs <- getElem
  guard (bs=="int")
  modifyState tail
  return I

pair = do
  bs <- getElem
  guard (bs=="pair")
  modifyState tail
  x <- expr
  y <- expr
  return $ P x y

end = do
  rest <- getState
  guard (null rest)

data Parser t = Parser {runParser :: State -> Maybe (t, State)}

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

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

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

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

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

main = getLine >> getLine >>= putStrLn.solve [] [].words

solve [] [] ["int"] = "int"
solve ans [] [] = concat.reverse $ ans
solve ans s ("pair":ws) = solve ("pair<":ans) (",>"++s) ws
solve ans (',':s) ("int":ws) = solve ("int,":ans) s ws
solve ans ('>':s) ("int":ws) =
  case span ('>'==) s of
    (xs,',':ys) -> solve (",":xs:"int>":ans) ys ws
    (xs,[])     -> solve (xs:"int>":ans) [] ws
solve _ _ _  = "Error occurred"

import Monad (MonadPlus, liftM, mzero)
import Prelude hiding (print)

data Type  =  Int | Pair Type Type

nameInt   =  "int"
namePair  =  "pair"

mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a
mfilter pred ma  =  do
    a  <-  ma
    if pred a then return a else mzero

parse :: [String] -> Maybe Type
parse  =  liftM fst . mfilter (null . snd) . parse'
  where
    parse' (w:ws)
      | w == nameInt  =  return (Int, ws)
      | w == namePair  =  do
        (t1, ws')  <-  parse' ws
        (t2, ws'')  <-  parse' ws'
        return (Pair t1 t2, ws'')
    parse' _  =  fail ""

print :: Maybe Type -> IO ()
print res  =  maybe (putStr "Error occured") print' res >> putStrLn ""
  where
    print' Int  =  putStr "int"
    print' (Pair t1 t2)  =  sequence_
        [putStr "pair<", print' t1, putStr ",", print' t2, putStr ">"]

main :: IO ()
main  =  getLine >> getLine >>= print . parse . words

import Control.Monad
import Data.List
data Type = IntT | PairT Type Type
instance Show Type where
    show IntT = "Int"
    show (PairT t1 t2) = "pair<" ++ show t1 ++ "," ++ show t2 ++ ">"

data Parser a = Parser {run :: String -> (Maybe a, String)}
instance Monad Parser where
    return x = Parser $ \inp -> (Just x, inp)
    p >>= q = Parser $ \inp ->
              case run p inp of
                (Nothing, _) -> (Nothing, "")
                (Just x, rest) -> run (q x) rest

(<|>) :: Parser a -> Parser a -> Parser a
p <|> q = Parser $ \inp ->
          case run p inp of
            ok@(Just x, rest) -> ok
            (Nothing, _) -> run q inp

int :: Parser Type
int = Parser $ \inp -> if "int " `isPrefixOf` inp then (Just IntT, drop 4 inp) else (Nothing, "")

pairCons :: Parser ()
pairCons = Parser $ \inp -> if "pair " `isPrefixOf` inp then (Just (), drop 5 inp) else (Nothing, "")

typ :: Parser Type
typ = do
  int <|> do
        pairCons
        t1 <- typ
        t2 <- typ
        return $ PairT t1 t2

main = do
  n_ <- getLine
  let n = read n_
  inp_ <- getLine
  let inp = inp_ ++ " "
  if length (filter (=='t') inp) == n then
      case run typ inp of
        (Just typ, "") -> print typ
        _ -> putStrLn "Error occurred"
   else putStrLn "Error occurred"

loop :: [String] -> [String] -> [String] -> String

solve t = loop (words t) [] []

solve' t = loop t [] []

loop [] [] res = concat . reverse $ res
loop task (",":stack) res@(">":_) =
    loop task stack (",":res)
loop task@("pair":_) stack (">":res) =
    loop task (">":stack) res
loop task@("pair":_) stack ("int":res) =
    "Error occurred"
loop ("pair":task) stack res =
    loop task (",":">":stack) ("pair<":res)
loop ("int":task) (s:stack) res@(",":_) =
    loop task stack (s:"int":res)
loop ("int":task) (s:stack) res@("pair<":_) =
    loop task stack (s:"int":res)
loop task@("int":_) (">":stack) res =
    loop task stack (">":res)
loop ("int":task) [] [] =
    loop task [] ["int"]
-- loop task (s:stack) res@("<":_) =
--     loop task stack (s:res)
loop [] (">":stack) (",":res) =
    "Error occurred"
loop [] (">":stack) (res) =
    loop [] stack (">":res)
loop task stack res =
    "Error occurred"
--    error $ show task ++ ";" ++ show stack++ ";"++show res

parse foo = case lines foo of
              [_, x] -> words $! x

main = (putStrLn . solve' . parse =<< getContents)

loop :: [String] -> [String] -> [String] -> String

solve t = loop (words t) [] []

solve' t = loop t [] []

loop [] [] res = concat . reverse $ res
loop task (",":stack) res@(">":_) =
    loop task stack (",":res)
loop ("pair":task) stack res =
    loop task (",":">":stack) ("pair<":res)
loop ("int":task) (s:stack) res@(",":_) =
    loop task stack (s:"int":res)
loop ("int":task) (s:stack) res@("pair<":_) =
    loop task stack (s:"int":res)
loop task@("int":_) (">":stack) res =
    loop task stack (">":res)
loop ("int":task) [] [] =
    loop task [] ["int"]
-- loop task (s:stack) res@("<":_) =
--     loop task stack (s:res)
loop [] (">":stack) (",":res) =
    "Error occurred"
loop [] (">":stack) (res) =
    loop [] stack (">":res)
loop task stack res =
    "Error occurred"
    -- error $ show task ++ ";" ++ show stack++ ";"++show res

parse foo = case lines foo of
              [_, x] -> words $! x

main = (putStrLn . solve' . parse =<< getContents)

loop :: [String] -> [String] -> [String] -> String

solve t = loop (words t) [] []

solve' t = loop t [] []

loop [] [] res = concat . reverse $ res
loop task (",":stack) res@(">":_) =
    loop task stack (",":res)
loop ("pair":task) stack res =
    loop task (",":">":stack) ("pair<":res)
loop ("int":task) (s:stack) res@(",":_) =
    loop task stack (s:"int":res)
loop ("int":task) (s:stack) res@("pair<":_) =
    loop task stack (s:"int":res)
loop ("int":task) [] [] =
    loop task [] ["int"]
-- loop task (s:stack) res@("<":_) =
--     loop task stack (s:res)
loop [] (">":stack) (",":res) =
    "Error occurred"
loop [] (">":stack) (res) =
    loop [] stack (">":res)
loop task stack res = show task ++ ";" ++ show stack++ ";"++show res

parse foo = case lines foo of
              [_, x] -> words $! x

main = (putStrLn . solve' . parse =<< getContents)


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

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    dir <- replicateM n readString
    let ul = length $ filter (=="UL") dir
    let ur = length $ filter (=="UR") dir
    let dl = length $ filter (=="DL") dir
    let dr = length $ filter (=="DR") dir
    let all = (n - ul - ur - dl - dr)
    return (ul, ur, dl, dr, all)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve (ul, ur, dl, dr, all) = fromIntegral x * fromIntegral y :: Integer
  where
    x = 1 + ul + dr + all
    y = 1 + ur + dl + all

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

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

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

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

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

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

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

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

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

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

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

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

state = State
-- }}}

import Data.List

parse :: String -> [String]
parse = tail . lines

solve :: [String] -> Integer
solve = loop (1, 1)

loop (a, b) [] = a * b
loop (a, b) ("UL":rest) = loop (a + 1, b) rest
loop (a, b) ("DR":rest) = loop (a + 1, b) rest
loop (a, b) ("UR":rest) = loop (a, b + 1) rest
loop (a, b) ("DL":rest) = loop (a, b + 1) rest
loop (a, b) ("ULDR":rest) = loop (a + 1, b + 1) rest

main = interact (show . solve . parse)
  -- stuff <- getContents
  -- print . solve . parse $ stuff

import Control.Monad (liftM)

solve :: Int -> [String] -> Integer
solve n xs  =  solve' (0::Int) (0::Int) xs
  where
    solve' k l []  =  fromIntegral (n - k + 1) * fromIntegral (n - l + 1)
    solve' k l ("UL":xs)  =  solve' (k + 1) l xs
    solve' k l ("DR":xs)  =  solve' (k + 1) l xs
    solve' k l ("UR":xs)  =  solve' k (l + 1) xs
    solve' k l ("DL":xs)  =  solve' k (l + 1) xs
    solve' k l (_ : xs)  =  solve' k l xs

main :: IO ()
main  =  do
    lines'  <-  liftM lines getContents
    let n  =  (read . head) lines'
    let xs  =  (take n . tail) lines'
    print $ solve n xs

import CPUTime

solve :: [String] -> Integer
solve xs  =  solve' (1::Int) (1::Int) xs
  where
    solve' n m []  =  fromIntegral n * fromIntegral m
    solve' n m ("UL":xs)  =  solve' (succ n) m xs
    solve' n m ("UR":xs)  =  solve' n (succ m) xs
    solve' n m ("DR":xs)  =  solve' (succ n) m xs
    solve' n m ("DL":xs)  =  solve' n (succ m) xs
    solve' n m (_:xs)  =  solve' (succ n) (succ m) xs

main :: IO ()
main  =  do
    t0  <-  getCPUTime

    n  <-  readLn
    xs  <-  mapM (const getLine) [1..n]
    print $ solve xs

    t1 <- getCPUTime
    putStr "Time = "
    print (fromIntegral (t1 - t0) * 1e-12)


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

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

{-# options_ghc -O3                              #-}

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

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

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

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

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

solve (n,m) = sum $ [1..m] ++ [2*m,3*m..n*m]

readLines :: Int -> IO [String]
readLines 0 = do
  return []
readLines n = do
  line <- getLine

  lines <- readLines (n - 1)

  return (line:lines)

writeLines :: Show a => [a] -> IO ()
writeLines [] = return ()
writeLines (line:rest) = do
  putStrLn (show line)
  writeLines rest

deserializeTestCases :: [String] -> [(Int, Int)]
deserializeTestCases = map deserializeItem

calculateAllSolutions :: [String] -> [Int]
calculateAllSolutions = (map calculateSolution) . deserializeTestCases

deserializeItem :: String -> (Int, Int)
deserializeItem = deserializeInternal . words

calculateSolution :: (Int, Int) -> Int
calculateSolution (n, m) = m*(m + 1) `div` 2 + (if n > 1 then (m*(n - 1)*(n + 2) `div` 2) else 0)

deserializeInternal :: [String] -> (Int, Int)
deserializeInternal (first:second:rest) = if length rest > 0 then error "Expected two values." else (read first :: Int, read second :: Int)
deserializeInternal _ = error "Wrong number of values."

main = do
  testCasesNumStr <- getLine

  let testCasesNum = read testCasesNumStr :: Int

  testCasesStr <- readLines testCasesNum

  let solutions = calculateAllSolutions testCasesStr

  writeLines solutions


import Control.Monad

solve :: [Int] -> String
solve l = if b then "Yes" else "No"
  where
    b = maximum l<=(1+(sum l - maximum l))

routine :: IO ()
routine = do
  l <-(map read . words) <$> getLine
  putStrLn $ solve l

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

import Control.Monad
import Prelude

testCase = do
    line <- getLine
    putStrLn $ solution (map read (words line))

solution :: [Integer] -> String
solution [r, g, b] = result where
    mx = maximum [r, g, b]
    rest = r + g + b - mx
    result = case rest < (mx - 1) of
        True -> "No"
        False -> "Yes"

main = do
    testCases <- getLine
    strNums <- replicateM (read testCases) testCase
    return ()


{-# LANGUAGE TupleSections #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.IArray
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
import           Data.Int
import qualified Data.IntSet           as IntSet
import           Data.List             (sort, unfoldr)

aggregate::[Int]-> UArray Int Int64
aggregate nums = listArray (0, limit) $ go 0 0 sorted where
  sorted = sort nums
  limit = maximum nums
  go idx cnt (el:rest) | idx == el = go idx (cnt + 1) rest
                       | otherwise = cnt : go (idx + 1) cnt (el : rest)
  go _ cnt []                      = [cnt]

solution :: [Int] -> Int64
solution nums = result where
  result = maximum $ power <$> IntSet.toList (IntSet.fromList nums)
  limit = maximum nums
  sums   = aggregate nums
  rng i j = (sums ! (j - 1) ) - (sums ! (i - 1))
  rangePower x u = rng u (min (u + x) (limit + 1)) * fromIntegral u
  power x = sum $ fmap (rangePower x) [x, x + x..limit]

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

main::IO ()
main = do
  -- print $ solution [3,2,15,9]
  void BS.getLine
  xs <- getInts
  print $ solution xs

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int
import Data.List
readInt s = let Just (a,_) = BS.readInt s in fromIntegral a

main = BS.interact $ BS.pack . show . solve . map readInt . tail . BS.words

solve ns = maximum $ map res $ unique ns
  where pref = build ns :: UArray Int64 Int64
        (ml, mr) = bounds pref
        getsum l r
          | pl > ml = (pref ! pr) - (pref ! (pl - 1))
          | otherwise = pref ! pr
          where pl = max l ml
                pr = min r mr
        res base = sum [i * (getsum i $ i + base - 1) | i <- [base, 2 * base .. mr]]

build ns = runSTUArray $ do
  let l = minimum ns
      r = maximum ns
  a <- newArray (l, r) 0 :: ST s (STUArray s Int64 Int64)
  forM_ ns $ \n -> do
    v <- readArray a n
    writeArray a n $ v + 1
  forM_ [l + 1..r] $ \i -> do
    ni <- readArray a i
    np <- readArray a $ i - 1
    writeArray a i $ ni + np
  return a

unique ns = unique_ sorted
    where sorted = sort ns
          unique_ [] = []
          unique_ a@[_] = a
          unique_ (a:b:r)
            | a == b = unique_ (b:r)
            | otherwise = a : unique_ (b:r)

{-# LANGUAGE TupleSections #-}

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import qualified Data.IntMap           as IntMap
import           Data.List             (unfoldr)

solution :: [Int] -> Int
solution nums = result where
  result = maximum $ power <$> IntMap.keys sums
  limit = maximum nums
  counts = IntMap.fromListWith (+) $ fmap (, 1:: Int)  nums
  sums   = IntMap.fromAscList $ tail $ scanl collect (undefined,0)  $ IntMap.toAscList counts
  collect (_, acc) (i, x ) = (i, x + acc)
  upTo = maybe 0 snd . flip IntMap.lookupLE sums
  range i j = upTo (j - 1) - upTo (i - 1)
  rangePower x u = range u (u + x) *  u
  power x = sum $ fmap (rangePower x) [x, x + x..limit]

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

main::IO ()
main = do
  void BS.getLine
  xs <- getInts
  print $ solution xs

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
readInt s = let Just (a,_) = BS.readInt s in a

main = BS.interact $ BS.pack . show . solve . map readInt . tail . BS.words

solve ns = maximum $ map res ns
  where pref = prefs $ build ns :: Array Int Int
        (ml, mr) = bounds pref
        getsum l r
          | pl > ml = (pref ! pr) - (pref ! (pl - 1))
          | otherwise = pref ! pr
          where pl = max l ml
                pr = min r mr
        res base = sum [i * (getsum i $ i + base - 1) | i <- [base, 2 * base .. mr]]

build ns = runSTArray $ do
  a <- newArray (minimum ns, maximum ns) 0
  forM_ ns $ \n -> do
    v <- readArray a n
    writeArray a n $ v + 1
  return a

prefs a = let p = listArray (l, r) $ (a ! l) : [(p ! (i - 1)) + (a ! i) | i <- [l + 1..r]]
          in p
  where (l, r) = bounds a


solve :: String -> String
solve line = let
    len = length line
    countZero = length $ takeWhile (=='0') line
    countOnes = length $ takeWhile (=='1') $ reverse line
    begin = take countZero $ repeat '0'
    end = take countOnes $ repeat '1'
    middle = if len == (countOnes+countZero) then [] else ['0']
    in begin++middle++end

getInt::IO Integer
getInt=do
    line <- getLine
    let i = read line :: Integer
    return (i)

main :: IO ()
main = do
    t <- getInt
    for t where
        for 0 = return ()
        for t = do
            _ <- getInt
            line <- getLine
            putStrLn $ solve line
            for (t-1)

import Control.Monad

main = do
  t <- read <$> getLine
  replicateM t routine

routine = do
  _ <- getLine
  s <- getLine
  let l = takeWhile (== '0') s
  let r = takeWhile (== '1') $ reverse s
  let rest =
        if (length l + length r == length s)
          then ""
          else "0"
  putStrLn (l ++ rest ++ r)

skip :: [a] -> [a]
skip [] = []
skip (x : []) = [x]
skip (x1 : (x2 : xs)) = x1 : (skip xs)

pref :: Char -> String -> String
pref _ "" = ""
pref d (c : cs)
  | c == d = c : (pref d cs)
  | otherwise = ""

suff :: Char -> String -> String
suff c s = pref c $ reverse s

solve :: String -> String
solve s
  | length (pref '0' s ++ (suff '1' s)) == length s = s
  | otherwise = pref '0' s ++ "0" ++ (suff '1' s)

io :: String -> String
io s = unlines $ map solve $ skip $ drop 2 $ lines s

main :: IO ()
main = do
  interact io

import Control.Monad (replicateM_)
main = readLn >>= flip replicateM_ ioSolve

ioSolve :: IO ()
ioSolve = getLine >> getLine >>= putStrLn . solve

solve :: String -> String
solve s = a ++ x ++ b where
  (a,s') = span (=='0') s
  (b,s'') = span (=='1') $ reverse s'
  x = if null s'' then "" else "0"

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.List
import Data.Tuple

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

(|>) = flip ($)

readInt = read :: String -> Int

reduce [] = []
reduce [x] = [x]
reduce ('1':'0':'0':xs) = reduce ('1':'0':xs)
reduce ('1':'0':xs) = '0':xs
reduce ls = ls

solve [] = []
solve (x:xs) =
  let sub = solve xs
  in reduce $ x:sub

main = do
  input <- getContents
  let _:tokens = split input
      res = tokens |> unfoldr (\case
        []  -> Nothing
        _:str:rest  -> Just (solve str, rest)
        )
  sequence $ putStrLn <$> res

import Data.List
main = interact $ unlines . map (process . snd) . filter (odd . fst) . zip [0..] . tail . lines
process s = process' s x y
    where
        x = elemIndices '1' s
        y = elemIndices '0' s
process' s _ [] = s
process' s [] _ = s
process' s x y = process'' s (head x) (last y)
process'' s x y
    | x > y = s
    | otherwise = (take x s) ++ (drop y s)

skip :: [a] -> [a]
skip [] = []
skip (x : []) = [x]
skip (x1 : (x2 : xs)) = x1 : (skip xs)

pref :: Char -> String -> String
pref _ "" = ""
pref d (c : cs)
  | c == d = c : (pref d cs)
  | otherwise = ""

suff :: Char -> String -> String
suff c s = pref c $ reverse s

solve :: String -> String
solve s
  | length (pref '0' s ++ (suff '1' s)) == length s = s
  | otherwise = pref '0' s ++ "1" ++ (suff '1' s)

io :: String -> String
io s = unlines $ map solve $ skip $ drop 2 $ lines s

main :: IO ()
main = do
  interact io


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

main = do
  [n, k] <- fmap readInts B.getLine
  let (q, r) = n `quotRem` k
  print $ if k == 2 && r == 0 then 2 * (q - 1) + 1 else 2 * (q + fromEnum (r > 2)) + fromEnum (r == 2)
  sequence_ [putStrLn $ show i ++ " " ++ show (max 1 (i - k)) | i <- [2..n]]

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

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

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

main = do
  [n, k] <- fmap readInts B.getLine
  let (q, r) = n `quotRem` k
  print $ if k == 2 && r == 0 then 2 * (q - 1) + 1 else 2 * (q + fromEnum (r > 2)) + fromEnum (r == 2)
  sequence_ [B.putStrLn $ showB i `B.append` " " `B.append` showB (max 1 (i - k)) | i <- [2..n]]

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

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

main = do
  [n, k] <- fmap readInts B.getLine
  let (q, r) = n `quotRem` k
  print $ if r == 0 then 2 * (q - 1) + fromEnum (k == 2) else 2 * q + r - 1
  sequence_ [putStrLn $ show i ++ " " ++ show (max 1 (i - k)) | i <- [2..n]]

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

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

main = do
  [n, k] <- fmap readInts B.getLine
  let (q, r) = n `quotRem` k
  print $ if k == 2 && r == 0 then 2 * (q - 1) + 1 else 2 * q + max 0 (r - 1)
  sequence_ [putStrLn $ show i ++ " " ++ show (max 1 (i - k)) | i <- [2..n]]

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