import Control.Monad (forM_)
import Data.List
--import Debug.Trace (trace)

readInts = getLine >>= pure . map read . words

main = do
    [n'] <- readInts
    forM_ [1..n'] (\_ -> do
        [n] <- readInts
        s <- getLine
        putStrLn $ if n == 5 && "Timur" `elem` (permutations s) then "YES" else "NO"
        )

module Main
       ( main )
       where

import Control.Monad (replicateM)

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

timurSorted :: String
timurSorted = sort "Timur"

isTimurPermutation :: String -> Bool
isTimurPermutation s = (sort s) == timurSorted

main :: IO ()
main = do
  tests <- readLn
  replicateM  tests $ do
    -- ignore length of next line
    _ <- getLine
    s <- getLine
    case (isTimurPermutation s) of
      True  -> putStrLn "YES"
      False -> putStrLn "NO"
  return ()

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

import Data.Maybe
import Control.Monad

import Data.List (group, sort)

--solve :: Int -> C.ByteString -> String
solve n s
    | sort s == sort "Timur" = "YES"
    | otherwise = "NO"

read = do
    s1 <- getLine
    s2 <- getLine

    putStrLn $ solve (Prelude.read s1 :: Int) s2

main = do
    t <- getLine

    replicateM_ (Prelude.read t :: Int) Main.read

{-# LANGUAGE CPP, ScopedTypeVariables, TypeApplications #-}
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.ByteString.Char8 as SBS
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List
import Debug.Trace
import Data.Char

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

type SBS = State BS.ByteString
type S = StateT BS.ByteString

str = string7

dropSpace :: BS.ByteString -> BS.ByteString
dropSpace = BS.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m BS.ByteString
getNext = state $ BS.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . BS.readInt . dropSpace

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
#ifdef LOCAL
  handle <- openFile "input" ReadMode
  inp <- BS.hGetContents handle
#else
  inp <- BS.getContents
#endif
  let outp = evalState tloop inp
  BS.putStr $ toLazyByteString outp

tloop :: SBS Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SBS Builder
solve = do
  n <- getInt
  s <- getNext
  let
    base = SBS.sort . BS.toStrict $ s
    res = base == ((SBS.pack . sort) "Timur")
  pure . str $ if res then "YES\n" else "NO\n"

{-# LANGUAGE CPP, ScopedTypeVariables, TypeApplications #-}
import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as C
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List
import Debug.Trace
import Data.Char

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

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
#ifdef LOCAL
  handle <- openFile "input" ReadMode
  inp <- P.hGetContents handle
#else
  inp <- P.getContents
#endif
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SP Builder
solve = do
  n <- getInt
  s <- getNext
  let
    base = C.sort . P.toStrict $ s
    res = base == ((C.pack . sort) "Timur")
  pure . str $ if res then "YES\n" else "NO\n"

{-# LANGUAGE CPP, ScopedTypeVariables, TypeApplications #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List
import Debug.Trace
import Data.Char

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

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
#ifdef LOCAL
  handle <- openFile "input" ReadMode
  inp <- P.hGetContents handle
#else
  inp <- P.getContents
#endif
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SP Builder
solve = do
  n <- getInt
  s <- getNext
  let
    base = sort $ P.unpack s
    res = base == (sort "Timur")
  pure . str $ if res then "YES\n" else "NO\n"

{-# LANGUAGE LambdaCase #-}

import Data.List (sort)
import Data.IntMap (filterWithKey)

main :: IO ()
main = interact $ format . solve . parse

parse :: String -> [String]
parse input = case lines input of
    [] -> undefined
    (w:ws) -> oddPositions 0 $ take (2 * read w) ws

oddPositions :: Int -> [a] -> [a]
oddPositions _ [] = []
oddPositions n (x:xs)
    | odd n = x : oddPositions (n + 1) xs
    | otherwise = oddPositions (n + 1) xs

format :: [Bool] -> String
format = unlines . map (\case
        True -> "YES"
        False -> "NO"
    )

solve :: [String] -> [Bool]
solve = map ((== "Timru") . sort)

import Data.List (sort)
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >> getLine >>= putStrLn . (ite "Yes" "No") . isValid
ite x y b = if b then x else y
isValid s@(a1:a2:a3:a4:a5:[]) = sort s == "Timru"
isValid _ = False

{-#LANGUAGE ScopedTypeVariables#-}
import Data.Set (Set, fromList, size)

main = do
    input <- getContents
    let parsed = keepEverySecond (drop 1 (lines input)) []
    let results = reverse (mapTimur parsed [])
    mapM_ putStrLn results

keepEverySecond :: [a] -> [a] -> [a]
keepEverySecond [] res             = reverse res
keepEverySecond (fst:snd:rest) res = keepEverySecond rest ([snd] ++ res)

mapTimur :: [String] -> [String] -> [String]
mapTimur [] res     = res
mapTimur (x:xs) res = mapTimur xs ([(isTimur x (fromList "Timur"))] ++ res)

isTimur :: String -> Set Char -> String
isTimur maybeTimur definitelyTimur
    | (length maybeTimur) /= (size definitelyTimur) = "NO"
    | (fromList maybeTimur) == definitelyTimur      = "YES"
    | otherwise                                     = "NO"

import Debug.Trace

isCharOfName :: Char -> Bool
isCharOfName c = case c of
                     'T' -> True
                     'i' -> True
                     'm' -> True
                     'u' -> True
                     'r' -> True
                     _   -> False

allPass :: (Char -> Bool) -> Bool
allPass f = not (f 'T') && not (f 'i') && not (f 'm')
            && not (f 'u') && not (f 'r')

checkStr :: String -> (Char -> Bool) -> Bool
checkStr [] f = if allPass f
                then True
                else False
checkStr (x:xs) f = if f x
                    then checkStr xs (\c -> if c == x
                                     then False
                                     else f c)
                    else False

decide :: Int -> IO ()
decide 0 = return ()
decide n = do
    getLine
    s <- getLine
    if checkStr s isCharOfName
    then putStrLn "YES"
    else putStrLn "NO"
    decide (n - 1)

main :: IO ()
main = do
    t <- getLine >>= (return . (read :: String -> Int))
    decide t

module Main
       ( main )
       where

import Control.Monad (replicateM)

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

timurSorted :: String
timurSorted = sort "Timur"

isTimurPermutation :: String -> Bool
isTimurPermutation s = (sort s) == timurSorted

main :: IO ()
main = do
  tests <- readLn
  replicateM  tests $ do
    s <- getLine
    case (isTimurPermutation s) of
      True  -> putStrLn "YES"
      False -> putStrLn "NO"
  return ()

module Main
       ( main )
       where

import Control.Monad (replicateM)

timur :: String
timur = "Timur"

isTimurPermutation :: String -> Bool
isTimurPermutation s = lengthEqual && allElem
  where lengthEqual = length s == length timur
        allElem     = all (\x -> x `elem` timur) s

main :: IO ()
main = do
  tests <- readLn
  replicateM  tests $ do
    s <- getLine
    case (isTimurPermutation s) of
      True  -> putStrLn "YES"
      False -> putStrLn "NO"
  return ()

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

import Data.Maybe
import Control.Monad

import Data.List (group, sort)

--solve :: Int -> C.ByteString -> String
solve n s
    | C.sort s == C.sort (C.pack "Timur") = "YES"
    | otherwise = "NO"

read = do
    s1 <- C.getLine
    s2 <- C.getLine

    putStrLn $ solve (fst $ fromJust $ C.readInt s1) s2

main = do
    t <- C.getLine

    replicateM_ (fst $ fromJust $ C.readInt t) Main.read

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

import Data.Maybe
import Control.Monad

import Data.List (group, sort)

--solve :: Int -> C.ByteString -> String
solve n s
    | B.sort s == B.sort (C.pack "Timur") = "YES"
    | otherwise = "NO"

read = do
    s1 <- C.getLine
    s2 <- C.getLine

    putStrLn $ solve (fst $ fromJust $ C.readInt s1) s2

main = do
    t <- C.getLine

    replicateM_ (fst $ fromJust $ C.readInt t) Main.read

{-# LANGUAGE LambdaCase #-}

import Data.List (sort)

main :: IO ()
main = interact $ format . solve . parse

parse :: String -> [String]
parse input = case lines input of
    [] -> undefined
    (w:ws) -> take (read w) ws

format :: [Bool] -> String
format = unlines . map (\case
        True -> "YES"
        False -> "NO"
    )

solve :: [String] -> [Bool]
solve = map ((== "imrTu") . sort)


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

import qualified Data.Array as A

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

import Data.Bits(xor, (.&.), (.|.))

import Data.Array((!))
import Control.Monad(replicateM)
import Data.Maybe

type Set = S.Set Integer

isP :: String -> Bool
isP str = foldr (&&) True $ fmap (\i->strA ! i == strA ! (n-1-i)) [0..div n 2] where
	strA = A.listArray (0, n-1) str
	n = length str

solve :: String -> Maybe String
solve str
	| not $ isP $ str ++ "a" = Just $ str ++ "a"
	| not $ isP $ 'a':str = Just $ 'a':str
	| otherwise = Nothing

showR :: Maybe String -> IO ()
showR Nothing = putStrLn "NO"
showR (Just s) = do
	putStrLn $ "YES"
	putStrLn $ s

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

import Control.Arrow ((>>>))
import Data.List (find)
import Data.Maybe (fromMaybe)

main :: IO ()
main =
  interact $
  words >>> drop 1 >>> map (solve >>> maybe "NO" ("YES\n" ++)) >>> unlines

solve :: String -> Maybe String
solve s = find (not . isPalin) ['a' : s, s ++ "a"]

isPalin :: String -> Bool
isPalin s = s == reverse s


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

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

import Data.Int

type SIO = StateT P.ByteString IO

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    let
      valCtMap = [(head vs, length vs) | vs <- group $ sort a]
      totsBelow = scanl (\x (v, ct) -> x + v *! ct) 0 valCtMap
      cutoff = last
        $ [v | ((v, _ct), tot) <- zip valCtMap totsBelow, fromIntegral v > tot]
      ans = [i | (i, ai) <- zip [1..] a, ai >= cutoff]
    putInts [length ans]
    putInts ans

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

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

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

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

import Data.Map((!))

minus x = -x

result list' = aux list $ sumPartial list where
	list = L.sortOn (minus . snd) $ zip [0..] list'

	sumPartial :: [(Integer, Integer)] -> [Integer]
	sumPartial [] = [0]
	sumPartial (x:[]) = [0]
	sumPartial (x:y:xs) = (snd y) + head l : l where l = sumPartial (y:xs)

	aux [] [] = []
	aux (x:xs) (y:ys)
		| (snd x) > y = [fst x]
		| otherwise = fst x : aux xs ys

showR (x:xs) = show (x+1) ++ " " ++ showR xs
showR [] = []

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

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.List
import Data.Int

--getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

solve' :: Builder -> Int -> [Int] -> Builder
solve' buf 0 _ = buf
solve' buf nt (n:a) = solve' (buf <> f <> char7 '\n') (pred nt) c
  where
    (b, c) = splitAt n a
    d = sort $ zip b [1 ..]
    e :: [Int64]
    e = scanl1 (+) $ map (fromIntegral . fst) d
    f :: Builder
    l = succ $ length $ takeWhile (\((u, j), v) -> (fromIntegral u) <= v) $ zip (reverse d) (tail $ reverse e)
    g' = map snd $ take l $ reverse d
    --g' = map (snd.fst) $ takeWhile (\((u, j), v) -> (fromIntegral u) <= v) $ zip (reverse d) (tail $ reverse e)
    --u = snd $ last d
    g = map intDec $ sort g'
    --g = map intDec $ map (snd.fst) $ takeWhile (\((u, j), v) -> (fromIntegral u ) >= v) $ reverse $ zip d (e ++ [-1])
    f = intDec (length g) <> char7 '\n' <> (mconcat $ intersperse (char7 ' ') g)

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

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents

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

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

import Data.Int
import qualified Data.Map.Strict as M

type SIO = StateT P.ByteString IO

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    let
      --valCtMap = [(head vs, length vs) | vs <- group $ sort a]
      valCtMap = M.assocs $ M.fromListWith (+) $ zip a $ repeat 1
      totsBelow = scanl (\x (v, ct) -> x + v *! ct) 0 valCtMap
      cutoff = last
        $ [v | ((v, _ct), tot) <- zip valCtMap totsBelow, fromIntegral v > tot]
      ans = [i | (i, ai) <- zip [1..] a, ai >= cutoff]
    putInts [length ans]
    putInts ans

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

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

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

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

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

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

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

run1 = do
  n <- popInt
  as <- popIntegers
  let ans = solve n as
  return $ B.unlines [bshow (length ans), B.unwords $ map bshow ans]

solve :: Int -> [Integer] -> [Int]
solve n as = map fst $ filter ((>= thre) . snd) $ zip [1..] as
  where
    counts :: Array Int (Integer, Int)
    counts = let l = countList as in
               listArray (0, length l - 1) l

    ncounts = snd (bounds counts) + 1

    thre | ok 0 = fst $ counts ! 0
         | otherwise = go 0 (ncounts - 1)

    go i j | j - i == 1 = fst $ counts ! j
           | otherwise = let k = (i + j) `quot` 2 in
                           if ok k
                           then go i k
                           else go k j

    ok i = let s = sum $
                   map ((\(a, c) -> a * (fromIntegral c)) . (counts !)) $
                   [0 .. i] in
             okgo s $ map (counts !) [i + 1 .. ncounts - 1]

    okgo _ [] = True
    okgo s ((a, c) : as) | s >= a = okgo (s + a * (fromIntegral c)) as
                         | otherwise = False

countList :: (Ord a) => [a] -> [(a, Int)]
countList xs = Map.assocs $ foldl' addm Map.empty xs
  where
    addm m x | Map.member x m = Map.adjust (+ 1) x m
             | otherwise = Map.insert x 1 m

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

import Data.Map((!))

type PrioQueue = M.Map Integer [Integer]
insert :: Integer -> Integer -> PrioQueue -> PrioQueue
insert prio val queue = case M.lookup prio queue of
	Just l -> M.insert prio (val:l) queue
	Nothing -> M.insert prio [val] queue

delete :: Integer -> Integer -> PrioQueue -> PrioQueue
delete prio val queue = case M.lookup prio queue of
	Just (x:[]) -> M.delete prio queue
	Just l -> M.insert prio (L.delete val l) queue

findMax :: PrioQueue -> (Integer, Integer)
findMax queue = case M.findMax queue of
	(k, v:l) -> (k, v)

result arrayM
	| v > sumOther = [(k, v)]
	| otherwise = (k, v) : result arrayM'
	where
		(v, k) = findMax arrayM
		sumOther = M.foldrWithKey (\k l i ->i + k * toInteger (length l) ) 0 arrayM'
		arrayM' = delete v k arrayM

showR ((x, _):xs) = show (x+1) ++ " " ++ showR xs
showR [] = []

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		let val = result $ foldr (\(ai, i) m -> insert ai i m) M.empty $ zip a [0..]
		print $ length val
		putStrLn $ showR val
		loop $ t - 1
	loop t

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

import Data.Map((!))

result arrayM
	| null arrayM = []
	| v > sumOther = [(k, v)]
	| otherwise = (k, v) : result arrayM'
	where
		(k, v) = M.findMin arrayM
		sumOther = foldr (+) 0 arrayM'
		arrayM' = M.delete k arrayM

showR ((x, _):xs) = show (x+1) ++ " " ++ showR xs
showR [] = []

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


{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Data.List

main = do
  [n,k] <- map read.words <$> getLine
  xs <- map read.words <$> getLine
  print $ solve n k xs

solve :: Int -> Int -> [Int] -> Int
solve n k xs = maximum[calc (sort xs1) (sortBy(flip compare)$xs0++xs2)|i<-[0..n-1],j<-[i..n-1],let(xs0,xs')=splitAt i xs,let(xs1,xs2)=splitAt(j-i+1)xs']
 where
   calc :: [Int] ->[Int] -> Int
   calc xs ys = go k 0 xs ys
    where
      go 0 !acc xs ys = acc + sum xs
      go k acc (x:xs) (y:ys)
        | x < y = go (k-1) (acc+y) xs ys
        | otherwise = acc + sum (x:xs)
      go k acc xs _ = acc + sum xs

import Text.Printf
import Data.List as List

combinations list1 list2 = [(a, b) | a <- list1, b <- list2]

splitAt2 :: [Int] -> (Int, Int) -> ([Int], [Int], [Int])
splitAt2 list (s1, s2) =
    let
        (l1, l23) = splitAt s1 list
        (l2, l3) = splitAt (s2 - s1) l23
    in
        (l1, l2, l3)

solve :: Int -> Int -> [Int] -> Int
solve n k input =
    let
        subsegments = filter (\(l, r) -> l < r) $ combinations [0..n] [0..n]

        test (l1, l2, l3) =
            let
                taken = sort l2
                rest = reverse $ sort $ l1 ++ l3

                takenSum = sum taken

                substitutes = takeWhile (\(old, new) -> old < new) $ take k $ zip taken rest
            in
                takenSum + foldl (\acc (old, new) -> acc + new - old) 0 substitutes
    in
        maximum $ map test $ map (splitAt2 input) $ subsegments

main :: IO ()
main = do
  --n <- readLn :: IO Int
  content <- getContents
  let
    input = map (read::String->Int) $ words $ unwords $ lines content
    ans = solve (head input) (head $ tail input) (tail $ tail input)
  putStrLn $ show $ ans

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i
    where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = maximum $ [ sub l r | l <- [1..n], r <- [l..n] ]
    where
    sub l r = sum (zipWith max xs1 ys ++ xs2)
        where
        (a,as') = splitAt (l-1) as
        (b,c) = splitAt (r - l + 1) as'
        k' = minimum [k,(length b),(length $ a ++ c)]
        (xs1,xs2) = splitAt k' (sort $ b)
        ys = take k' $ reverse $ sort $ a ++ c


{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8       as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap                 as IM
import qualified Data.IntSet                 as IS
import           Data.List
import qualified Data.Map                    as M
import           Data.Ord
import qualified Data.Set                    as S
import           Data.STRef
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Data.Word
import           Debug.Trace

main :: IO ()
main = do
    n <- readLn :: IO Int
    xs <- U.unfoldrN n (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print $ solve $ U.map fromIntegral xs

solve :: U.Vector Int64 -> Int64
solve xs = len * m + U.maximum zs
  where
    len = fromIntegral $ U.length xs
    m = U.minimum xs
    ys = U.map (subtract m) xs
    zs = U.scanl (\acc x->if x==0 then 0 else acc+1) 0 $ ys U.++ ys

readInt :: String -> Int
readInt = read

f :: [Int] -> Integer
f a = l*m' + extra
    where
        l = toInteger $ length a
        m = minimum a
        m' = toInteger m
        b = map (\x->x-m) a
        c = scanl (\acc x -> if x == 0 then 0 else acc+1) 0 $ b ++ b
        extra = toInteger $ maximum c

main = do
    n <- readLn :: IO Int
    line <-  getLine
    let a = map readInt $ words line
    print (f a)

import Data.List
main = do
    n <- readLn :: IO Integer
    a <- fmap ((map read) . words) getLine :: IO[Integer]
    let mn = minimum a
        (_,ls) = unzip . filter (\(x,y) -> x==mn) . zip a $ [1..]
        zl = zipWith (\x y -> y-x-1) ls $ (tail ls)
        lmx = if zl==[] then 0 else maximum zl
        fst = head ls
        lst = last ls
        ans = max lmx (n-(lst-fst+1))
    print $ n*mn + ans

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

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

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

main = do
  n <- readLn
  as :: [Int64] <- map fromIntegral <$> getInts

  let
    m = minimum as
    bs = map (\x -> x-m) as

    p = min n $ maximum $ map genericLength $ splitOn [0] $ bs ++ bs

  print $ m*n + p

import Data.List
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let mn = minimum a
        (_,ls) = unzip . filter (\(x,y) -> x==mn) . zip a $ [1..]
        zl = zipWith (\x y -> y-x-1) ls $ (tail ls)
        lmx = if zl==[] then 0 else maximum zl
        fst = head ls
        lst = last ls
        ans = max lmx (n-(lst-fst+1))
    print $ n*mn + ans

import Data.List
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let mn = minimum a
        (_,ls) = unzip . filter (\(x,y) -> x==mn) . zip a $ [1..]
        ans = n*mn + (fn n (ls ++ [head ls]) 0)
    print ans

fn n (x:y:[]) mx = max mx (n + (y-x-1))
fn n (x:y:xs) mx =
    let seglen = (y-x-1)
    in fn n (y:xs) (max seglen mx)

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

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

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

main = do
  n <- readLn
  as <- getInts

  let
    m = minimum as
    bs = map (\x -> x-m) as

    p = min n $ maximum $ map length $ splitOn [0] $ bs ++ bs

  print $ m*n + p

readInt :: String -> Int
readInt = read

f :: [Int] -> Int
f a = l*m + extra
    where
        l = length a
        m = minimum a
        b = map (\x->x-m) a
        c = scanl (\acc x -> if x == 0 then 0 else acc+1) 0 $ b ++ b
        extra = maximum c

main = do
    n <- readLn :: IO Int
    line <-  getLine
    let a = map readInt $ words line
    print (f a)


import Data.Char as Char

g :: [Int] -> Int
g [] = 0
g [0] = 1
g [_] = 0
g (0:xs) = 1+(g xs)
g [_,0] = 1
g [x,y] = fromEnum $ (x+y)==3
g (_:0:lat) = 1 + (g lat)
g (x:y:z:lat)
 |(x+y)==3 = 1 + (g (z:lat))
 |otherwise = 1 + (g lat)

main :: IO ()
main = do
  line <- getLine
  let line' = map ((flip mod 3).(Char.digitToInt)) line
  print $ g line'

import Data.List

toint s = (read s) :: Integer

doit [] t = 0
doit (x:xs) t
    | mod x 3 == 0            = 1 + doit xs 0
    | t == 3                  = 1 + doit xs 0
    | mod x 3 == 1 && t == 0  = doit xs 1
    | mod x 3 == 1 && t == 1  = doit xs 3
    | mod x 3 == 1 && t == 2  = 1 + doit xs 0
    | mod x 3 == 2 && t == 0  = doit xs 2
    | mod x 3 == 2 && t == 1  = 1 + doit xs 0
    | mod x 3 == 2 && t == 2  = doit xs 3

solve::String -> String
solve ss =
    let d = map (\x -> toint [x]) (reverse (tail (reverse ss))) in
    let r = doit d 0 in
    (show r) ++ "\n"

main = do
  interact $ solve


{-# LANGUAGE FlexibleContexts, BangPatterns #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, liftM2, when, foldM, liftM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (accumArray, elems, (!), array, listArray, elems, bounds)
import Data.Array (Array)
import Data.Array.MArray.Safe (newArray, newArray_, readArray, writeArray, freeze, getBounds)
import Data.Array.ST.Safe (STUArray, runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftR, xor, bit, popCount)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64, Int8)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Tuple (swap)
import Data.List (unfoldr)
import Data.Char (isSpace)

data Op = UpdateOp !Int !Int8 | QueryOp !Int

op [1, v, c] = UpdateOp v (fromIntegral c)
op [2, v] = QueryOp v

type STree s = (STUArray s Int Int64, STUArray s Int Int8)

build :: UArray Int Int -> ST s (STree s)
build l = do
  let n = snd (bounds l)

  a <- newArray_ (1, 2*n-1)
  forM_ [n..2*n-1] $ \i -> writeArray a i (bit (l!(i-n+1)))

  forM_ [n-1,n-2..1] $ \i ->
    liftM2 (.|.) (readArray a $ 2*i) (readArray a $ 2*i+1) >>= writeArray a i

  b <- newArray (1, 2*n-1) 0

  return (a, b)

size :: (STree s) -> ST s Int
size t@(a, _) = do
  (_, l) <- getBounds a
  return $ l`div`2 + 1

pushDown :: (STree s) -> Int -> ST s ()
pushDown t@(a, b) i0 = push $ m-2
  where
    m = until (\s -> i0 `shiftR` s == 1) (+1) 0

    push (-2) = return ()
    push (-1) = return ()
    push s = do
      let i = i0 `shiftR` s
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then do
          let
            vv = bit $ fromIntegral v
            ii = i `xor` 1
          writeArray a i vv >> writeArray a ii vv
          writeArray b i v >> writeArray b ii v
          writeArray b j 0
      else return ()

      push $ s-1

update :: (STree s) -> Int -> Int -> Int8 -> ST s ()
update t@(a, b) l r v = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)

    pushDown t l' >> pushDown t r' >>
      loop l' r' >>
        popUp l' >> popUp r'
  where
    loop l r
      | l > r = return ()
      | odd l = write l v >> loop (l+1) r
      | even r = write r v >> loop l (r-1)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)
      where
        write i v = writeArray a i (bit $ fromIntegral v) >> writeArray b i (fromIntegral v)

    popUp 1 = return ()
    popUp i = do
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then writeArray a j (bit $ fromIntegral v)
        else liftM2 (.|.) (readArray a i) (readArray a (i `xor` 1)) >>= writeArray a j
      popUp $ i `shiftR` 1

query :: (STree s) -> Int -> Int -> ST s Int64
query t@(a, b) l r = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)
    pushDown t l' >> pushDown t r' >> loop l' r'
  where
    loop l r
      | l > r = return 0
      | odd l = liftM2 (.|.) (readArray a l) (loop (l+1) r)
      | even r = liftM2 (.|.) (loop l (r-1)) (readArray a r)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)

readInts = unfoldr (B.readInt . B.dropWhile isSpace)
getInts = readInts <$> B.getLine

main = do
  [n, m] <- getInts
  cs <- getInts
  es <- replicateM (n-1) $ ((\[a, b] -> (a, b)) <$> getInts)
  qs <- replicateM m $ (op <$> getInts)

  let
    rs = runST $ do
        t <- build cs' :: ST s ((STUArray s Int Int64), (STUArray s Int Int8))

        let
          handle [] = return []
          handle ((UpdateOp v c):ops) = do
              update t l r c
              handle ops
            where (l, r) = range v
          handle ((QueryOp v):ops) = do
              c <- query t l r
              let !r = fromIntegral $ popCount c
              (r:) <$> handle ops
            where (l, r) = range v

        handle qs
      where
        cs' = array (1, n) $ map swap $ zip cs (elems ins) :: UArray Int Int

        p :: (UArray Int Int, UArray Int Int)
        p@(ins, outs) = runST $ do
            ins <- newArray_ (1, n) :: ST s (STUArray s Int Int)
            outs <- newArray_ (1, n) :: ST s (STUArray s Int Int)
            cr <- newSTRef 0

            let
              dfs w u = do
                  modifySTRef cr (+1)
                  readSTRef cr >>= \c -> writeArray ins u c
                  mapM_ (dfs u) vs
                  readSTRef cr >>= \c -> writeArray outs u c
                where
                  vs = filter (/= w) $ g!u

            dfs 0 1

            liftM2 (,) (freeze ins) (freeze outs)
          where
            g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es :: Array Int [Int]

        range v = (ins!v, outs!v)

  putStrLn . unlines . map show $ filter (/= 0) rs

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, liftM2, when, foldM, liftM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (accumArray, elems, (!), array, listArray, elems, bounds)
import Data.Array (Array)
import Data.Array.MArray.Safe (newArray, newArray_, readArray, writeArray, freeze, getBounds)
import Data.Array.ST.Safe (STUArray, runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftR, xor, bit, popCount)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64, Int8)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Tuple (swap)
import Data.List (unfoldr)
import Data.Char (isSpace)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)

type STree s = (STUArray s Int Int64, STUArray s Int Int8)

forceM :: Monad m => m a -> m a
forceM m = do v <- m; return $! v

(<$!>) :: Monad m => (a -> b) -> m a -> m b
f <$!> m = liftM f (forceM m)

build :: UArray Int Int -> ST s (STree s)
build l = do
  let n = snd (bounds l)

  a <- newArray_ (1, 2*n-1)
  forM_ [n..2*n-1] $ \i -> writeArray a i (bit (l!(i-n+1)))

  forM_ [n-1,n-2..1] $ \i ->
    liftM2 (.|.) (readArray a $ 2*i) (readArray a $ 2*i+1) >>= writeArray a i

  b <- newArray (1, 2*n-1) 0

  return (a, b)

size :: (STree s) -> ST s Int
size t@(a, _) = do
  (_, l) <- getBounds a
  return $ l`div`2 + 1

pushDown :: (STree s) -> Int -> ST s ()
pushDown t@(a, b) i0 = push $ m-2
  where
    m = until (\s -> i0 `shiftR` s == 1) (+1) 0

    push (-2) = return ()
    push (-1) = return ()
    push s = do
      let i = i0 `shiftR` s
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then do
          let
            vv = bit $ fromIntegral v
            ii = i `xor` 1
          writeArray a i vv >> writeArray a ii vv
          writeArray b i v >> writeArray b ii v
          writeArray b j 0
      else return ()

      push $ s-1

update :: (STree s) -> Int -> Int -> Int -> ST s ()
update t@(a, b) l r v = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)

    pushDown t l' >> pushDown t r' >>
      loop l' r' >>
        popUp l' >> popUp r'
  where
    loop l r
      | l > r = return ()
      | odd l = write l v >> loop (l+1) r
      | even r = write r v >> loop l (r-1)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)
      where
        write i v = writeArray a i (bit $ fromIntegral v) >> writeArray b i (fromIntegral v)

    popUp 1 = return ()
    popUp i = do
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then writeArray a j (bit $ fromIntegral v)
        else liftM2 (.|.) (readArray a i) (readArray a (i `xor` 1)) >>= writeArray a j
      popUp $ i `shiftR` 1

query :: (STree s) -> Int -> Int -> ST s Int64
query t@(a, b) l r = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)
    pushDown t l' >> pushDown t r' >> loop l' r'
  where
    loop l r
      | l > r = return 0
      | odd l = liftM2 (.|.) (readArray a l) (loop (l+1) r)
      | even r = liftM2 (.|.) (loop l (r-1)) (readArray a r)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)

readInts = unfoldr (B.readInt . B.dropWhile isSpace)

takeTwo [] rs = rs
takeTwo (u:v:xs) rs = takeTwo xs ((u, v):rs)

main = do
  c <- readInts <$> B.getContents

  let
    (n:m:r1) = c
    (cs, r2) = splitAt n r1
    (p1, r3) = splitAt (2*n-2) r2
    es = takeTwo p1 []
    qs = r3

  let
    p :: (UArray Int Int, UArray Int Int)
    p@(ins, outs) = runST $ do
        ins <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        outs <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        cr <- newSTRef 0

        let
          dfs w u = do
              modifySTRef cr (+1)
              readSTRef cr >>= \c -> writeArray ins u c
              mapM_ (dfs u) vs
              readSTRef cr >>= \c -> writeArray outs u c
            where
              vs = filter (/= w) $ g!u

        dfs 0 1

        liftM2 (,) (freeze ins) (freeze outs)
      where
        g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es :: Array Int [Int]

    range v = (ins!v, outs!v)

    cs' = array (1, n) $ map swap $ zip cs (elems ins) :: UArray Int Int

    solve :: [Int8]
    solve = runST $ do
      t <- build cs' :: ST s ((STUArray s Int Int64), (STUArray s Int Int8))

      let
        f [] = return []

        f (1:v:c:qs) = update t l r c >> f qs where (l, r) = range v

        f (2:v:qs) = ((fromIntegral . popCount) <$!> query t l r) >>= \r -> (r:) <$> f qs where (l, r) = range v

      f qs

  putStrLn $ unlines $ map show $ filter (/= 0) solve
  -- let rs = filter (/= 0) solve

  -- let unwords_ = mconcat . map (<> charUtf8 '\n')
  -- hPutBuilder stdout $ unwords_ $ map intDec (rs

{-# LANGUAGE FlexibleContexts, BangPatterns #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, liftM2, when, foldM, liftM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (accumArray, elems, (!), array, listArray, elems, bounds)
import Data.Array (Array)
import Data.Array.MArray.Safe (newArray, newArray_, readArray, writeArray, freeze, getBounds)
import Data.Array.ST.Safe (STUArray, runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftR, xor, bit, popCount)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64, Int8)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Tuple (swap)
import Data.List (unfoldr)
import Data.Char (isSpace)

data Op = UpdateOp !Int !Int8 | QueryOp !Int

op [1, v, c] = UpdateOp v (fromIntegral c)
op [2, v] = QueryOp v

type STree s = (STUArray s Int Int64, STUArray s Int Int8)

forceM :: Monad m => m a -> m a
forceM m = do v <- m; return $! v

(<$!>) :: Monad m => (a -> b) -> m a -> m b
f <$!> m = liftM f (forceM m)

build :: UArray Int Int -> ST s (STree s)
build l = do
  let n = snd (bounds l)

  a <- newArray_ (1, 2*n-1)
  forM_ [n..2*n-1] $ \i -> writeArray a i (bit (l!(i-n+1)))

  forM_ [n-1,n-2..1] $ \i ->
    liftM2 (.|.) (readArray a $ 2*i) (readArray a $ 2*i+1) >>= writeArray a i

  b <- newArray (1, 2*n-1) 0

  return (a, b)

size :: (STree s) -> ST s Int
size t@(a, _) = do
  (_, l) <- getBounds a
  return $ l`div`2 + 1

pushDown :: (STree s) -> Int -> ST s ()
pushDown t@(a, b) i0 = push $ m-2
  where
    m = until (\s -> i0 `shiftR` s == 1) (+1) 0

    push (-2) = return ()
    push (-1) = return ()
    push s = do
      let i = i0 `shiftR` s
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then do
          let
            vv = bit $ fromIntegral v
            ii = i `xor` 1
          writeArray a i vv >> writeArray a ii vv
          writeArray b i v >> writeArray b ii v
          writeArray b j 0
      else return ()

      push $ s-1

update :: (STree s) -> Int -> Int -> Int8 -> ST s ()
update t@(a, b) l r v = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)

    pushDown t l' >> pushDown t r' >>
      loop l' r' >>
        popUp l' >> popUp r'
  where
    loop l r
      | l > r = return ()
      | odd l = write l v >> loop (l+1) r
      | even r = write r v >> loop l (r-1)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)
      where
        write i v = writeArray a i (bit $ fromIntegral v) >> writeArray b i (fromIntegral v)

    popUp 1 = return ()
    popUp i = do
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then writeArray a j (bit $ fromIntegral v)
        else liftM2 (.|.) (readArray a i) (readArray a (i `xor` 1)) >>= writeArray a j
      popUp $ i `shiftR` 1

query :: (STree s) -> Int -> Int -> ST s Int64
query t@(a, b) l r = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)
    pushDown t l' >> pushDown t r' >> loop l' r'
  where
    loop l r
      | l > r = return 0
      | odd l = liftM2 (.|.) (readArray a l) (loop (l+1) r)
      | even r = liftM2 (.|.) (loop l (r-1)) (readArray a r)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)

readInts = unfoldr (B.readInt . B.dropWhile isSpace)
getInts = readInts <$> B.getLine

main = do
  [n, m] <- getInts
  cs <- getInts
  es <- replicateM (n-1) $ ((\[a, b] -> (a, b)) <$> getInts)
  qs <- replicateM m $ (op <$> getInts)

  let
    p :: (UArray Int Int, UArray Int Int)
    p@(ins, outs) = runST $ do
        ins <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        outs <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        cr <- newSTRef 0

        let
          dfs w u = do
              modifySTRef cr (+1)
              readSTRef cr >>= \c -> writeArray ins u c
              mapM_ (dfs u) vs
              readSTRef cr >>= \c -> writeArray outs u c
            where
              vs = filter (/= w) $ g!u

        dfs 0 1

        liftM2 (,) (freeze ins) (freeze outs)
      where
        g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es :: Array Int [Int]

    range v = (ins!v, outs!v)

    cs' = array (1, n) $ map swap $ zip cs (elems ins) :: UArray Int Int

    solve :: [Int8]
    solve = runST $ do
      t <- build cs' :: ST s ((STUArray s Int Int64), (STUArray s Int Int8))

      let
        handle [] = return []
        handle ((UpdateOp v c):ops) = do
            update t l r c
            handle ops
          where (l, r) = range v
        handle ((QueryOp v):ops) = do
            c <- query t l r
            let !r = fromIntegral $ popCount c
            (r:) <$> handle ops
          where (l, r) = range v

      handle qs

  putStrLn . unlines . map show $ filter (/= 0) solve

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, liftM2, when, foldM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (accumArray, elems, (!), array, listArray, elems, bounds)
import Data.Array (Array)
import Data.Array.MArray.Safe (newArray, newArray_, readArray, writeArray, freeze, getBounds)
import Data.Array.ST.Safe (STUArray, runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftR, xor, bit, popCount)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64, Int8)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Tuple (swap)
import Data.List (unfoldr)
import Data.Char (isSpace)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)

type STree s = (STUArray s Int Int64, STUArray s Int Int8)

build :: UArray Int Int -> ST s (STree s)
build l = do
  let n = snd (bounds l)

  a <- newArray_ (1, 2*n-1)
  forM_ [n..2*n-1] $ \i -> writeArray a i (bit (l!(i-n+1)))

  forM_ [n-1,n-2..1] $ \i ->
    liftM2 (.|.) (readArray a $ 2*i) (readArray a $ 2*i+1) >>= writeArray a i

  b <- newArray (1, 2*n-1) 0

  return (a, b)

size :: (STree s) -> ST s Int
size t@(a, _) = do
  (_, l) <- getBounds a
  return $ l`div`2 + 1

pushDown :: (STree s) -> Int -> ST s ()
pushDown t@(a, b) i0 = push $ m-2
  where
    m = until (\s -> i0 `shiftR` s == 1) (+1) 0

    push (-2) = return ()
    push (-1) = return ()
    push s = do
      let i = i0 `shiftR` s
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then do
          let
            vv = bit $ fromIntegral v
            ii = i `xor` 1
          writeArray a i vv >> writeArray a ii vv
          -- writeArray b i v >> writeArray b ii v
          writeArray b j 0
      else return ()

      push (s-1)

update :: (STree s) -> Int -> Int -> Int -> ST s ()
update t@(a, b) l r v = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)

    pushDown t l' >> pushDown t r' >>
      loop l' r' >>
        popUp l' >> popUp r'
  where
    loop l r
      | l > r = return ()
      | odd l = write l v >> loop (l+1) r
      | even r = write r v >> loop l (r-1)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)
      where
        write i v = writeArray a i (bit $ fromIntegral v) >> writeArray b i (fromIntegral v)

    popUp 1 = return ()
    popUp i = do
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then writeArray a j (bit $ fromIntegral v)
        else liftM2 (.|.) (readArray a i) (readArray a (i `xor` 1)) >>= writeArray a j
      popUp $ i `shiftR` 1

query :: (STree s) -> Int -> Int -> ST s Int64
query t@(a, b) l r = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)
    pushDown t l' >> pushDown t r' >> loop l' r'
  where
    loop l r
      | l > r = return 0
      | odd l = liftM2 (.|.) (readArray a l) (loop (l+1) r)
      | even r = liftM2 (.|.) (loop l (r-1)) (readArray a r)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)

readInts = unfoldr (B.readInt . B.dropWhile isSpace)

takeTwo [] rs = rs
takeTwo (u:v:xs) rs = takeTwo xs ((u, v):rs)

main = do
  c <- readInts <$> B.getContents

  let
    (n:m:r1) = c
    (cs, r2) = splitAt n r1
    (p1, r3) = splitAt (2*n-2) r2
    es = takeTwo p1 []
    qs = r3

  let
    p :: (UArray Int Int, UArray Int Int)
    p@(ins, outs) = runST $ do
        ins <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        outs <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        cr <- newSTRef 0

        let
          dfs w u = do
              modifySTRef cr (+1)
              readSTRef cr >>= \c -> writeArray ins u c
              mapM_ (dfs u) vs
              readSTRef cr >>= \c -> writeArray outs u c
            where
              vs = filter (/= w) $ g!u

        dfs 0 1

        liftM2 (,) (freeze ins) (freeze outs)
      where
        g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es :: Array Int [Int]

    range v = (ins!v, outs!v)

    cs' = array (1, n) $ map swap $ zip cs (elems ins) :: UArray Int Int

    solve = runST $ do
      t <- build cs' :: ST s ((STUArray s Int Int64), (STUArray s Int Int8))

      let
        f [] = return []

        f (1:v:c:qs) = update t l r c >> f qs where (l, r) = range v

        f (2:v:qs) = (popCount <$> query t l r) >>= \r -> (r:) <$> f qs where (l, r) = range v

      f qs

  -- putStrLn $ unlines $ map show $ filter (/= 0) solve
  let rs = filter (/= 0) solve

  let unwords_ = mconcat . map (<> charUtf8 '\n')
  hPutBuilder stdout $ unwords_ $ map intDec rs


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

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: (Int, Int) -> (Int, Int) -> Ordering
solve (x1, p1) (x2, p2) | p1 /= 0 && p2 /= 0 = let p = min p1 p2 in solve (x1, p1 - p) (x2, p2 - p)
solve (x1, p1) (x2, p2) | p2 > 8 = LT
solve (x1, p1) (x2, p2) | p1 > 8 = GT
solve (x1, p1) (x2, p2) = solve' xx1 xx2
    where
        xx1 = show x1 ++ replicate p1 '0'
        xx2 = show x2 ++ replicate p2 '0'

        solve' :: String -> String -> Ordering
        solve' s1 s2 | L.length s1 < L.length s2 = solve' ("0" ++ s1) s2
        solve' s1 s2 | L.length s1 > L.length s2 = solve' s1 ("0" ++ s2)
        solve' s1 s2 = compare s1 s2

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    replicateM_ n $ do
        [x1, p1] <- B8.getLine <&> readIntB8s
        [x2, p2] <- B8.getLine <&> readIntB8s

        let answer = solve (x1, p1) (x2, p2)
        case answer of
            LT -> putStrLn "<"
            GT -> putStrLn ">"
            EQ -> putStrLn "="

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

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

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[x1, p1] <- getInts 2
    ~[x2, p2] <- getInts 2
    let
      scale = min p1 p2
      s1 = min 7 $ p1 - scale
      s2 = min 7 $ p2 - scale
      y1 = x1 `quot` 10 ^ s2
      y2 = x2 `quot` 10 ^ s1
      z1 = toInteger x1 * 10 ^ s1
      z2 = toInteger x2 * 10 ^ s2
      ans = compare y1 y2 <> compare z1 z2
    pure $ string7 $ case ans of
      LT -> "<\n"
      EQ -> "=\n"
      GT -> ">\n"

type SP = State [P.ByteString]

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

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

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

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

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

getInput :: IO (C.ByteString, Int)
getInput = do
  [x, p] <- fmap C.words C.getLine
  return $ (C.reverse $ C.dropWhile (=='0') $ C.reverse x, C.length x + parseInt p)

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    (s1, n1) <- getInput
    (s2, n2) <- getInput
    let result = case compare n1 n2 of
          EQ -> compare s1 s2
          other -> other
        toChar LT = '<'
        toChar GT = '>'
        toChar _ = '='
    return $ charUtf8 (toChar result) <> charUtf8 '\n'
  hPutBuilder stdout output


import Data.Char
import System.IO

split :: String -> Char -> [String]
split [] _ = []
split (x:xs) c| x==c = split xs c
              | otherwise = first (x:xs) c: split (rest (x:xs) c) c where
                    first [] c = []
                    first (x:xs) c| x==c = []
                                  | otherwise = x : first xs c
                    rest [] c = []
                    rest (x:xs) c | x==c = xs
                                  | otherwise = rest xs c

strToIntList :: String -> [Integer]
strToIntList xs = map toInt (split xs ' ')

toInt :: String -> Integer
toInt [] = 0
toInt (x:xs) = toInteger (digitToInt x) * 10^(length xs) + toInt xs

solve :: [Integer] -> Integer
solve xs = div (sum xs) 2

solveN :: Integer -> Handle -> IO ()
solveN 0 h = return ()
solveN n h = do
                abc <- hGetLine h
                (putStrLn . show . solve . strToIntList) abc
                solveN (n-1) h

main :: IO ()
main = do
            -- h <- openFile "A.in" ReadMode
            n <- hGetLine stdin
            solveN (toInt n) stdin
            -- hClose h
            return()

--ghc 7.10

distribute :: (Integral a) => a -> [a] -> a
distribute n xs = (sum xs) `div` n

main = do
    qStr <- getLine
    contents <- getContents
    let xss = map (map read . words) . lines $ contents :: [[Integer]]
    let ds = map (distribute 2) xss
    sequence (map print ds)

import Control.Monad
import Data.List

bestSplit :: [Integer] -> Integer
bestSplit xs =
    let sorted = sort xs
        startA = sorted !! 0
        startB = sorted !! 1
        commonPile = sorted !! 2
        takeA = min commonPile (startB - startA)
        toSplit = commonPile - takeA
        finalA = startA + takeA + (toSplit `div` 2)
        finalB = startB + (commonPile - takeA) + (toSplit `div` 2)
    in min finalA finalB

readNums :: (Num a, Read a) => IO [a]
readNums = map read . words <$> getLine

solve :: IO Integer
solve = do
    piles <- readNums :: IO [Integer]
    return (bestSplit piles)

main = do
    [tests] <- readNums :: IO [Int]
    results <- replicateM tests $ solve
    putStrLn . unlines . map show $ results

import Control.Monad

solve_case a b c = (a + b + c) `div` 2

solve [] = []
solve ([a, b, c]:xs) = (solve_case a b c : solve xs)

read_input = do
  q <- getLine
  strings <- replicateM (read q) getLine
  return $ map get_ints $ map words $ strings
  where get_ints = map read

main = do
  q <- read_input
  mapM print (solve q)

cal :: Int -> IO ()
cal 0 = return ()
cal n = do
  line <- getLine
  let (a:b:c:[]) = map (read :: String -> Integer) $ words line
  putStrLn $ show $ (a + b + c) `div` 2
  cal (n - 1)

main :: IO ()
main = do
  n <- getLine
  cal $ read n

main = interact $ unlines
        . map ( show
               . (`div` 2)
               . sum
               .  map (read :: String -> Integer)
               .  words )
        . tail
        . lines

import Control.Monad (replicateM_)

findAliceCandies :: [Integer] -> Integer
findAliceCandies xs = sum xs `div` 2

readCandies :: IO [Integer]
readCandies = (map read) . words <$> getLine

main =
    read <$> getLine >>= \q ->
    replicateM_ q (readCandies >>= print . findAliceCandies)

import Data.Int
main = interact $ unlines . map (show . solve) . triplets . map read . tail . words
triplets (a:b:c:xs) = (a,b,c) : triplets xs
triplets [] = []
solve (a,b,c) = (a+b+c) `div` 2 :: Int64

import Control.Monad
import Data.Typeable
import Data.Int
import Data.List

solve [a,b,c] = minimum [a+c, b+c, (a+b+c) `quot` 2]

main = do
    n <- fmap read getLine :: IO Int
    inputs <- replicateM n getLine :: IO [String]
    let int_inputs = map (solve . sort . map read . words) inputs :: [Int64]

    mapM print int_inputs
    --print $ int_inputs

main = interact $ unlines . map show . map ((`div` 2) . sum . map read . words) . tail . lines

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

onecase=do
		c<-sum <$> map read <$> words <$>getLine ::IO Integer
		print $ div c 2

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

import Control.Monad
import Data.Typeable

solve [a,b,c] = minimum [a+c, b+c, (a+b+c) `quot` 2]

main = do
    n <- fmap read getLine :: IO Int
    inputs <- replicateM n getLine :: IO [String]
    let int_inputs = map (solve . map read . words) inputs :: [Int]

    mapM print int_inputs
    --print $ int_inputs

import Control.Monad
import Data.Typeable
import Data.Int

solve [a,b,c] = minimum [a+c, b+c, (a+b+c) `quot` 2]

main = do
    n <- fmap read getLine :: IO Int
    inputs <- replicateM n getLine :: IO [String]
    let int_inputs = map (solve . map read . words) inputs :: [Int64]

    mapM print int_inputs
    --print $ int_inputs

import Data.Char
import System.IO

split :: String -> Char -> [String]
split [] _ = []
split (x:xs) c| x==c = split xs c
              | otherwise = first (x:xs) c: split (rest (x:xs) c) c where
                    first [] c = []
                    first (x:xs) c| x==c = []
                                  | otherwise = x : first xs c
                    rest [] c = []
                    rest (x:xs) c | x==c = xs
                                  | otherwise = rest xs c

strToIntList :: String -> [Int]
strToIntList xs = map toInt (split xs ' ')

toInt :: String -> Int
toInt [] = 0
toInt (x:xs) = (digitToInt x) * 10^(length xs) + toInt xs

solve :: [Int] -> Int
solve xs = div (sum xs) 2

solveN :: Int -> Handle -> IO ()
solveN 0 h = return ()
solveN n h = do
                abc <- hGetLine h
                (putStrLn . show . solve . strToIntList) abc
                solveN (n-1) h

main :: IO ()
main = do
            -- h <- openFile "A.in" ReadMode
            n <- hGetLine stdin
            solveN (toInt n) stdin
            -- hClose h
            return()

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

onecase=do
		c<-sum <$> map read <$> words <$>getLine ::IO Int
		print $ div c 2

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


import Data.List (scanl')
import Control.Monad

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

solve :: IO()
solve = do
  s <- getLine
  -- Cumulative count of 0s and 1s
  -- Example: scanl' (count '0') 0 "00110101"
  --          => [0,1,2,2,2,3,3,4,4]
  --                0 0 1 1 0 1 0 1
  --          scanl' (count '1') 0 "00110101"
  --          => [0,0,0,1,2,2,3,3,4]
  --                0 0 1 1 0 1 0 1
  let zeros = scanl' (count '0') 0 s
  let ones = scanl' (count '1') 0 s

  print (minOps zeros ones)

-- Cumulative counter
count :: Char -> Int -> Char -> Int
count c x y = if y == c then x else x+1

-- Solve problem with cumulative counters
-- Get the minimum number of operations needed
--
-- Covers all four possibilities:
--  1) All 0s (00..00) (Typically given as such)
--  2) All 1s (11..11) (Typically given as such)
--  3) 0s followed by 1s (00..01..11)
--  4) 1s followed by 0s (11..10..00)
--
--  Example: using "00110101"
--           numSwitch [0,1,2,2,2,3,3,4,4] [0,0,0,1,2,2,3,3,4]
--                        zeros               ones
--
--           Covering cases 2 and 3:
--           (Cost of switching all zeros to ones -
--            best cost reduction when keeping zeros up to a point)
--           (last zeros - maximum (zipWith (-) zeros ones))
--           ((   4    ) - maximum (  [0,1,2,1,0,1,0,1,0]  )
--           (                  4 - 2 = 2                  )
--
--           Covering cases 1 and 4:
--           (Cost of switching all ones to zeros -
--            best cost reduction when keeping ones up to a point)
--           (last ones - maximum (zipWith (-) ones zeros) )
--           ((   4   ) - maximum ([0,-1,-2,-1,0,-1,0,-1,0])
--           (                  4 - 0 = 4                  )
--
--           solve zeros ones = min 2 4 = 2
--           solution (2) => "00110101" -> "00111111"
--                                ^ ^
minOps :: [Int] -> [Int] -> Int
minOps zeros ones = do
  min (last zeros - maximum (zipWith (-) zeros ones)) $
      (last ones - maximum (zipWith (-) ones zeros))

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

routine :: IO ()
routine = do
  s <- getLine
  print $ solve s

solve :: String -> Int
solve s = min (minimum $ zipWith (+) (tl zeroprefix) (tl onesuffix)) (minimum $ zipWith (+) (tl oneprefix) (tl zerosuffix))
  where
    tl = toList
    arr = listArray (1,length s) s
    zeroprefix = array (0,length s) ((0,0):[ (i,(if arr!i == '0' then (+1) else id) $ zeroprefix!(i-1)) |  i <- [1..(length s)]])
    oneprefix =  array (0,length s) ((0,0):[ (i,(if arr!i == '1' then (+1) else id) $ oneprefix!(i-1)) |  i <- [1..(length s)]])
    zerosuffix = array (0,length s) ((length s, 0):[ (i,(if arr!(i+1) == '0' then (+1) else id) $ zerosuffix!(i+1)) |  i <- [0..(length s - 1)]])
    onesuffix =  array (0,length s) ((length s, 0):[ (i,(if arr!(i+1) == '1' then (+1) else id) $ onesuffix!(i+1)) |  i <- [0..(length s - 1)]])

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

routine :: Int -> IO()
routine t
  | t > 1 = do
      solve
      routine (t-1)
  | t == 1 = solve

solve :: IO()
solve = do
  s <- getLine
  let zeros = countZeros s
  let ones = countOnes s
  print (min (min (oneZero s 0 ones) (zeroOne s 0 zeros)) (min ones zeros))

oneZero :: [Char] -> Int -> Int -> Int
oneZero s toOne toZero
  | (length s) > 1 = do
    min (toOne + toZero) (oneZero (drop 1 s) (toOne+(if (s !! 0 == '0') then 1 else 0)) (toZero-(if (s !! 0 == '1') then 1 else 0)))
  | (length s) == 1 = toOne + toZero

zeroOne :: [Char] -> Int -> Int -> Int
zeroOne s toZero toOne
  | (length s) > 1 = do
    min (toZero + toOne) (zeroOne (drop 1 s) (toZero+(if (s !! 0 == '1') then 1 else 0)) (toOne-(if (s !! 0 == '0') then 1 else 0)))
  | (length s) == 1 = toZero + toOne

countOnes :: [Char] -> Int
countOnes s = do
  length (filter (=='1') s)

countZeros :: [Char] -> Int
countZeros s = do
  length (filter (=='0') s)

{-# LANGUAGE BangPatterns #-}

import Data.List

_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 [] ""

_prefsums acc [] = reverse acc
_prefsums acc@(curr:_) (x:xs) =
  let !x' = x + curr
  in _prefsums (x':acc) xs
prefsums = _prefsums [0]

main = do
  input <- getContents
  let _:tokens = split input
      res = solve <$> tokens
        where solve = (\str ->
                let ones = read <$> (:[]) <$> str :: [Int]
                    onesR = reverse ones
                    zeros = (1 -) <$> ones
                    zerosR = reverse zeros
                    prefs1 : prefs1R : prefs0 : prefs0R : _ = prefsums <$> [ones, onesR, zeros, zerosR]
                    sufs1 : sufs0 : _ = reverse <$> [prefs1R, prefs0R]
                    cost10 = uncurry (+) <$> zip prefs0 sufs1
                    cost01 = uncurry (+) <$> zip prefs1 sufs0
                in foldl1 min (cost10 ++ cost01)
                )
  sequence_ (putStrLn . show <$> res)

{-# LANGUAGE BangPatterns #-}

import Data.List (scanl')
import Data.Foldable (for_)

costs :: Char -> String -> [Int]
costs c = scanl' (\x y -> if  y == c  then  x  else  x+1) 0

solve :: String -> Int
solve str = min (last c0 - maximum (zipWith (-) c0 c1)) $
                (last c1 - maximum (zipWith (-) c1 c0))  where
  c0 = costs '0' str
  c1 = costs '1' str

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  for_ [1..t] $ \_ -> getLine >>= (print . solve)

{-# LANGUAGE BangPatterns #-}

import Data.Foldable (for_)

solve :: String -> Int
solve [] = 0
solve (c:cs) = go 0 c cs  where
  go !n !c1 [] = n
  go !n !c1 [c2] = n
  go !n !c1 (c2:c3:cs)
    | c1 == c2 || c2 == c3  = go n c2 (c3:cs)
    | otherwise = go (n+1) c3 cs

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  for_ [1..t] $ \_ -> getLine >>= (print . solve)


import Data.List
import Control.Monad
combinations k ns = filter ((k==).length) (subsequences ns)
solution::[String]->[(String,String)]->Int->[String]
solution ns cs 1 = [ns !! 0]
solution ns cs n | or $ map isClique combs = (filter isClique combs) !! 0
                 | otherwise = solution ns cs (n-1)
                      where combs = combinations n ns
                            isClique q = all (flip notElem cs) [(a,b) | a<- q, b <-q]
printsol xs = (putStrLn $ show.length $ xs) >> (forM_ xs (\x -> putStrLn x))
main = do
       [n,m] <- getLine >>= return.(map read).words
       team <- forM [1..n]  (\_ -> getLine)
       collisions <-fmap concat $ forM [1..m] (\_ -> do
                                          [n1,n2] <- getLine >>= return . words
                                          return [(n1,n2), (n2,n1)])
       printsol $ sort $ solution team collisions n

module Main where

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

bitCount 0 = 0
bitCount n = ( n .&. 1 ) + bitCount ( n `shiftR` 1 )

chooseToNames 0 _ = []
chooseToNames n (name:names) =
    let others = chooseToNames (n `shiftR` 1) names in
    if n .&. 1 == 0
        then others
        else name : others

main = do
    [n, m] <- ( map read . words ) `liftM` getLine
    volunteers <- replicateM n getLine

    let volunteerIndexMap = Map.fromList (zip volunteers [0..])

    constraints <- replicateM m $ do
        [a, b] <- ( map ( bit . ( volunteerIndexMap Map.! ) ) . words ) `liftM` getLine
        return ( a .|. b )

    let candidates :: [Int]
        candidates = filter (\t ->
                all (\c -> t .&. c /= c) constraints
            ) [1..( 1 `shift` n )]
        (choose, chooseLen) = foldl' (\(best, bestLen) c ->
                let currLen = bitCount c in
                if currLen > bestLen
                    then (c, currLen)
                    else (best, bestLen)
            ) (0,0) candidates
        chooseName = sort $ chooseToNames choose volunteers

    --putStrLn $ show constraints
    --putStrLn $ show candidates
    --putStrLn $ show choose
    putStrLn $ show chooseLen
    putStr $ unlines chooseName

import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Array
import Data.Maybe
import IO
import Debug.Trace

mytrace x = traceShow x x

powSet :: [a] -> [[a]]
powSet [] = [[]]
powSet (x:xs) = concat [[x:y, y] | y <- powSet xs]

ok :: [(Int, Int)] -> Int -> Int -> Bool
ok x y z = d!(y,z)
	where
		ok' (i,j) = (elemIndex (i,j) x == Nothing) && (elemIndex (j,i) x == Nothing)
		d = array ((1,1),(16,16)) [((i,j), ok' (i,j)) | i <- [1..16], j <- [1..16]]

-- nameToId :: [C.ByteString] -> C.ByteString -> Int
nameToId a s = (fromJust . elemIndex s) a + 1

-- idToName :: [C.ByteString] -> Int -> C.ByteString
idToName a i = a !! (i - 1)

ord :: [a] -> [a] -> Ordering
ord x y
	| length x < length y = LT
	| length x > length y = GT
	| otherwise = EQ

getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getLines2 0 = return []
getLines2 n = do
	x <- getLine >>= return . words
	xs <- getLines2 (n-1)
	return (x:xs)

main = do
	-- stream <- fmap C.lines $ C.hGetContents stdin
	-- let [n, m] = mytrace $ (map (fst . fromJust . C.readInt) . C.words . head) stream
	-- let names = mytrace $ (take n . tail) stream
	-- let bad_pairs = mytrace $ (map ((\x -> (head x, last x)) . map (nameToId names) . C.words) . take m . drop (n+1)) stream
	[n, m] <- getLine >>= return . map read . words :: IO [Int]
	names <- getLines n
	bad_pairs <- getLines2 m >>= return . map ((\x -> (head x, last x)) . map (nameToId names))
	let ans = (last . sortBy ord) [ c | c <- powSet [1..n], all (\(a, b) -> ok bad_pairs a b) [(a, b) | a <- c, b <- c]]
	putStr $ (show . length) ans ++ "\n" ++ (unlines . sort . map (idToName names)) ans

import Data.List
import Data.Array
import Data.Maybe

powSet :: [a] -> [[a]]
powSet [] = [[]]
powSet (x:xs) = concat [[x:y, y] | y <- powSet xs]

ok :: [(Int, Int)] -> Int -> Int -> Bool
ok x y z = d!(y,z)
	where
		ok' (i,j) = (elemIndex (i,j) x == Nothing) && (elemIndex (j,i) x == Nothing)
		d = array ((1,1),(16,16)) [((i,j), ok' (i,j)) | i <- [1..16], j <- [1..16]]

nameToId :: [String] -> String -> Int
nameToId a s = (fromJust . elemIndex s) a + 1

idToName :: [String] -> Int -> String
idToName a i = a !! (i - 1)

ord :: [a] -> [a] -> Ordering
ord x y
	| length x < length y = LT
	| length x > length y = GT
	| otherwise = EQ

getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getLines2 0 = return []
getLines2 n = do
	x <- getLine >>= return . words
	xs <- getLines2 (n-1)
	return (x:xs)

main = do
	[n, m] <- getLine >>= return . map read . words :: IO [Int]
	names <- getLines n
	bad_pairs <- getLines2 m >>= return . map ((\x -> (head x, last x)) . map (nameToId names))
	let ans = (last . sortBy ord) [ c | c <- powSet [1..n], all (\(a, b) -> ok bad_pairs a b) [(a, b) | a <- c, b <- c]]
	putStr $ (show . length) ans ++ "\n" ++ (unlines . sort . map (idToName names)) ans

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Data.Array
import Data.Char
import Data.Map

class Scan a where scan' :: String -> a
instance Scan Int where scan' = read
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' = read
instance Scan Double where scan' = read
instance Scan Integer where scan' = read
instance Scan String where scan' x = x
instance (Scan a,Scan b) => Scan (a,b) where scan' x = (\(x:y:_) -> (scan' x,scan' y)) (words x)
instance (Scan a,Scan b,Scan c) => Scan (a,b,c) where scan' x = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)) (words x)
instance (Scan a,Scan b,Scan c,Scan d) => Scan (a,b,c,d) where scan' x = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)) (words x)
instance (Scan a,Scan b,Scan c,Scan d,Scan e) => Scan (a,b,c,d,e) where scan' x = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)) (words x)
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance Ans String where showans x = x
instance (Ans a, Ans b) => Ans (a,b) where showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z
scan :: (Scan a) => IO a
scan = getLine>>=(return.scan')
scans :: (Scan a) => Int -> IO [a]
scans n = if n==0 then return [] else scan>>=(\x->scans (n-1)>>=return.(x:))
scanlist :: (Scan a) => IO [a]
scanlist = getLine>>=return.(Data.List.map scan').words
scanlists :: (Scan a) => Int -> IO [[a]]
scanlists n = if n==0 then return [] else scanlist>>=(\x->scanlists (n-1)>>=return.(x:))
putAnsLn :: (Ans a) => a -> IO ()
putAnsLn = putStrLn.showans
putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns = mapM_ putAnsLn

rec _ [] l = (length l,l)
rec antis (x:xs) l = let (a1,team1) = rec antis xs l in
                     let diff' = (Data.Map.lookup x antis) in
                     let diff = case diff' of
                                  Nothing -> []
                                  Just l -> l
                     in
                       let (a2,team2) = rec antis (xs Data.List.\\ diff) (x:l) in
                       if a1>a2 then
                           (a1,team1)
                       else
                           (a2,team2)

solve members n anti = let antis = foldl (\mp -> \(na,an) -> insertWith (++) an [na] (insertWith (++) na [an] mp)) empty anti in
                       let (ans,team) = rec antis members [] in
                       if ans==0 then
                           ["0"]
                       else
                           (show ans):(sort team)

main = do (n,m) <- scan :: IO (Int,Int)
          members <- scans n :: IO [String]
          anti <- scans m :: IO [(String,String)]
          putAnsLns (solve members n anti)

import Data.List
import Debug.Trace (trace)
import GHC.Exts(sortWith)

main3 = print $ getResult [1,2,3] [(1,2)]
mains = print $ getResult [1,2,3] []
main =
	do
		[n,m] <- getNums
		l <- getLines n
		lines <- getLines m
		let n = lines |> map (\x ->
			let [a,b] = (splitBy x)
			in (a,b))
		let r = getResult (l) n |> sort
		putStrLn $ (show (length r)) ++ "\n" ++ (intercalate "\n" r)

getResult l n = result
	where
		result = subsequences l |> sortWith (\x -> length x) |> reverse |>
			filter (\x -> n |> all (\(y,z) -> (notElem y x) || (notElem z x))) |> head
------------------usefule-----------------------
tr x y = trace ((show x) ++ (show y)) y
tr1 x y = trace ((show x)) y
tr2 y = trace ((show y)) y

(|>) x f = f x

parseInt x = (read x) :: Int

getLines n = repeat getLine |> take n |> sequence

getNums =
	do
		line <- getLine
		return $ getNumbers line

getNumbers line =
	case index of
		Nothing -> [parseInt line]
		Just i ->
			let (l,r) = splitAt (i + 1) line in
				(parseInt l) : (getNumbers r)
	where
		index = elemIndex ' ' line

splitBy k =
	case index of
		Nothing -> [k]
		Just i ->
			let (l,r) = splitAt (i) k in
				l : splitBy (drop 1 r)
	where
		index = elemIndex ' ' k


import Data.Either

main=readFile"input.txt">>=writeFile"output.txt".parseOutput.solve.map f.zip[1..].(!!1).lines
f(i,'L')=Left i
f(i,'R')=Right i

parseOutput (l:r:lrs) = shows l" "++shows r"\n"++parseOutput lrs
parseOutput _ = []

solve lrs = merge (lefts lrs) (rights lrs)

merge [l] [r1,r2,r3]
  | l < r1 = [l,r2,r1,r3]
  | l < r2 = [l,r3,r1,r2]
  | l < r3 = [l,r1,r2,r3]
  | otherwise = [l,r2,r1,r3]

merge [l1,l2,l3] [r]
  | r < l1 = [l2,r,l1,l3]
  | r < l2 = [l3,r,l1,l2]
  | r < l3 = [l1,r,l2,l3]
  | otherwise = [l2,r,l1,l3]

merge [l1,l2] [r1,r2]
  | l2 < r1  || r2 < l1 = [l1,r1,l2,r2]
  | r2-r1==1 || l2-l1==1 = [l1,r2,l2,r1]
  | otherwise = [l1,l2,r1,r2]

merge [l1,l2,l3,l4] [] = [l1,l3,l2,l4]

merge [] [r1,r2,r3,r4] = [r1,r3,r2,r4]

merge (l1:l2:ls) (r1:r2:rs)
  | l2 < r1  || r2 < l1  = l1:r1: merge (l2:ls) (r2:rs)
  | r2-r1==1 || l2-l1==1 = l1:r2: merge (l2:ls) (r1:rs)
  | otherwise            = r1:r2: merge (l1:l2:ls) rs

merge [l] (r1:r2:r3:rs) = r1:r3:merge [l] (r2:rs)
merge (l1:l2:l3:ls) [r] = l1:l3:merge (l2:ls) [r]
merge [] (r1:r2:r3:r4:rs) = r1:r3:merge [] (r2:r4:rs)
merge (l1:l2:l3:l4:ls) [] = l1:l3:merge (l2:l4:ls) []

solve n orient = map swapInter $ zip left right
  where left = [1 .. halfN]
        right = [halfN + 1 .. n]
        halfN = n `div` 2
        swapInter (x, y)
          | l == 'R' && r == 'L' = (y, x)
          | otherwise = (x, y)
          where l = orient !! (x - 1)
                r = orient !! (y - 1)

showPair (x, y) = show x ++ " " ++ show y

main = do [n, orient] <- fmap words $ readFile "input.txt"
          writeFile "output.txt" $ unlines $ map showPair $ solve (read n) orient

import Array
import Monad
import IO

solve :: Int -> Array Int Char -> [(Int, Int)]
solve n xs  =  [f i | i <- [1..div n 2]]
  where
    f i
      | xs ! i == 'R' && xs ! (i + div n 2) == 'L'  =  (i + div n 2, i)
      | otherwise  =  (i, i + div n 2)

prints :: Show a => Handle -> (a, a) -> IO ()
prints hOutput (a, b)  =  hPutStrLn hOutput (show a ++ " " ++ show b)

main :: IO ()
main  =  do
    hInput  <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode
    n   <-  liftM read (hGetLine hInput)
    xs  <-  liftM (listArray (1,n)) (hGetLine hInput)
    mapM_ (prints hOutput) $ solve n xs
    hClose hInput
    hClose hOutput


module Main where

import Control.Monad
import Data.Foldable

processCase _ = do
  getLine
  s <- getLine
  let r = foldl' (\r -> (r +) . (\b -> if b then 1 else -fromEnum (r /= 0)) . (== 'Q')) 0 s :: Int
  putStrLn $ if r > 0 then "No" else "Yes"

main :: IO ()
main = do
  n <- readLn :: IO Int
  forM_ [1..n] processCase

module Main where

import Control.Monad
import Data.Foldable

processCase _ = do
  getLine
  s <- getLine
  let r = foldl' (\r -> (r +) . (\b -> if b then 1 else if r /= 0 then -1 else 0) . (== 'Q')) 0 s :: Int
  putStrLn $ if r > 0 then "No" else "Yes"

main :: IO ()
main = do
  n <- readLn :: IO Int
  forM_ [1..n] processCase

module Main where

import Control.Monad

processCase _ = do
  getLine
  s <- getLine
  let r = foldl (\r -> (r +) . (\b -> if b then 1 else if r /= 0 then -1 else 0) . (== 'Q')) 0 s :: Int
  putStrLn $ if r > 0 then "No" else "Yes"

main :: IO ()
main = do
  n <- readLn :: IO Int
  forM_ [1..n] processCase

module Main where

import Control.Monad

processCase _ = do
  getLine
  s <- getLine
  let r = foldl (\r -> (r +) . (\b -> if b then 1 else -fromEnum (r /= 0)) . (== 'Q')) 0 s
  putStrLn $ if r > 0 then "No" else "Yes"

main :: IO ()
main = do
  n <- readLn :: IO Int
  forM_ [1..n] processCase

module Main where

import Control.Monad

processCase _ = do
  getLine
  s <- getLine
  let r = foldl (\r -> (r +) . (\b -> if b then 1 else -1) . (== 'Q')) 0 s
  putStrLn $ if r > 0 then "No" else "Yes"

main :: IO ()
main = do
  n <- readLn :: IO Int
  forM_ [1..n] processCase

module Main where

import Control.Monad

processCase _ = do
  l <- readLn :: IO Int
  s <- getLine
  let r = foldl (\r -> (r +) . (\b -> if b then 1 else -1) . (== 'Q')) 0 s
  putStrLn $ if r > 0 then "No" else "Yes"

main :: IO ()
main = do
  n <- readLn :: IO Int
  forM_ [1..n] processCase

module Main where

import Control.Monad

processCase _ = do
  l <- readLn :: IO Int
  s <- getLine
  let r = foldl (\r -> fromEnum . (== 'Q')) 0 s
  putStrLn $ if r > 0 then "No" else "Yes"

main :: IO ()
main = do
  n <- readLn :: IO Int
  forM_ [1..n] processCase


f _ [] = 0
f c (x:xs) = g c xs + (if c == x then 1 else 0)

g _ [] = 0
g c (x:xs) = f c xs

h0 c s = (f c s) * (g c s)
h1 c s = (f c s * (f c s + 1) + g c s * (g c s + 1)) `div` 2

main = do
  s <- getLine
  putStrLn $ show (h0 'a' s + h0 'b' s) ++ " " ++ show (h1 'a' s + h1 'b' s)

{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.Int
import Data.Bits
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

pairsum (a,b) (c,d) = (a+c, b+d)

solve :: String -> Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> (Int64, Int64)
solve [] _ _ _ _ _ = (0, 0)
solve (s:str) aEven aOdd bEven bOdd cpos
  | s == 'a' = pairsum resA (solve str aEven1 aOdd1 bEven1 bOdd1 (1 - cpos))
  | s == 'b' = pairsum resB (solve str aEven1 aOdd1 bEven1 bOdd1 (1 - cpos))
  where resA
          | cpos == 0 = (aOdd1, aEven1)
          | cpos == 1 = (aEven1, aOdd1)
        resB
          | cpos == 0 = (bOdd1, bEven1)
          | cpos == 1 = (bEven1, bOdd1)
        aEven1 = if s == 'a' && cpos == 0 then aEven + 1 else aEven
        aOdd1  = if s == 'a' && cpos == 1 then aOdd  + 1 else aOdd
        bEven1 = if s == 'b' && cpos == 0 then bEven + 1 else bEven
        bOdd1  = if s == 'b' && cpos == 1 then bOdd  + 1 else bOdd

main = do
  str <- getLine
  let res = solve str 0 0 0 0 0
  putStr (show (fst res))
  putStrLn $ " " ++ (show (snd res))