You are given a string $$$a$$$, consisting of $$$n$$$ characters, $$$n$$$ is even. For each $$$i$$$ from $$$1$$$ to $$$n$$$ $$$a_i$$$ is one of 'A', 'B' or 'C'.A bracket sequence is a string containing only characters "(" and ")". A regular bracket sequence is a bracket sequence that can be transformed into a correct arithmetic expression by inserting characters "1" and "+" between the original characters of the sequence. For example, bracket sequences "()()" and "(())" are regular (the resulting expressions are: "(1)+(1)" and "((1+1)+1)"), and ")(", "(" and ")" are not.You want to find a string $$$b$$$ that consists of $$$n$$$ characters such that:   $$$b$$$ is a regular bracket sequence;  if for some $$$i$$$ and $$$j$$$ ($$$1 \le i, j \le n$$$) $$$a_i=a_j$$$, then $$$b_i=b_j$$$. In other words, you want to replace all occurrences of 'A' with the same type of bracket, then all occurrences of 'B' with the same type of bracket and all occurrences of 'C' with the same type of bracket.Your task is to determine if such a string $$$b$$$ exists.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of testcases. Then the descriptions of $$$t$$$ testcases follow. The only line of each testcase contains a string $$$a$$$. $$$a$$$ consists only of uppercase letters 'A', 'B' and 'C'. Let $$$n$$$ be the length of $$$a$$$. It is guaranteed that $$$n$$$ is even and $$$2 \le n \le 50$$$.

For each testcase print "YES" if there exists such a string $$$b$$$ that:    $$$b$$$ is a regular bracket sequence;  if for some $$$i$$$ and $$$j$$$ ($$$1 \le i, j \le n$$$) $$$a_i=a_j$$$, then $$$b_i=b_j$$$.  Otherwise, print "NO". You may print every letter in any case you want (so, for example, the strings yEs, yes, Yes and YES are all recognized as positive answer).

NoteIn the first testcase one of the possible strings $$$b$$$ is "(())()".In the second testcase one of the possible strings $$$b$$$ is "()()".

-- import Debug.Trace
import Data.List (permutations)

type InType  = String
type OutType = Bool

inpLines :: Int
inpLines = 1

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

perms :: [String]
perms = permutations "(()" ++ permutations "))("

checkPars :: String -> Bool
checkPars = go 0
    where go c [] = c == 0
          go c (x : xs) = c >= 0 && go (f x + c) xs
          f '(' = 1
          f ')' = -1

solve :: InType -> OutType
solve s = or [ go p | p <- perms ]
    where go [a, b, c] = checkPars $ map (make a b c) s
          make a b c 'A' = a
          make a b c 'B' = b
          make a b c 'C' = c

receive :: [String] -> InType
receive = head

main :: IO ()
main = interact (unlines . map (showb . solve . receive) . chunksOf inpLines . tail . lines)
    where showb True = "YES"
          showb False = "NO"

module Main where

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

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

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

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

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

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

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

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    s <- getLine
    putStrLn $ yesOrNo $ (head s /= last s) && f s

replace :: (Eq a) => a -> a -> [a] -> [a]
replace x y = map (\z -> if z == x then y else z)

f :: String -> Bool
f s = or [check 0 $ replace k '(' p, check 0 $ replace k ')' p]
    where p = replace (last s) ')' . replace (head s) '(' $ s
          k = last . ('-':) . filter (\c -> c /= '(' && c /= ')') $ p

check :: Int -> String -> Bool
check c [] = c == 0
check 0 (')':xs) = False
check c (')':xs) = check (c - 1) xs
check c ('(':xs) = check (c + 1) xs

isValid :: String -> Int -> Bool
isValid [] x = x == 0
isValid (s:ss) x | x < 0     = False
                 | s == '('  = isValid ss (x + 1)
                 | otherwise = isValid ss (x - 1)

replace :: String -> Char -> Char -> String
replace inp old new = map (\c -> if c == old then new else c) inp

loopHelper :: Int -> IO ()
loopHelper t | t == 0 = return ()
             | otherwise = do
                 inp <- getLine
                 let f = head inp
                     l = last inp
                     inp2 = replace (replace inp f '(') l ')'
                     r = head (filter (\c -> c /= f && c /= l) ['A', 'B', 'C'])

                 if (isValid (replace inp2 r '(') 0 || isValid (replace inp2 r ')') 0 ) then
                     putStrLn "YES"
                 else
                     putStrLn "NO"
                 loopHelper (t-1)
                 return ()

main :: IO ()
main = do
    t <- getLine
    loopHelper (read t :: Int)
    return ()

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

import Control.Applicative
import Control.Exception (assert)
import Control.Monad hiding (mapM, mapM_, forM, forM_)
import Control.Monad.State hiding (mapM, mapM_, forM, forM_)
import Data.Array.IArray
import Data.Array.ST
import Data.Array.Unboxed (UArray)
import Data.Bits
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Foldable
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.Ix
import Data.List hiding (and, or, any, all, foldr, foldl')
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.STRef
import Data.Traversable
import Prelude hiding (and, or, any, all, mapM, mapM_)
import System.IO

------

data P a b = P !a !b
  deriving (Show, Eq, Ord)

data T a b c = T !a !b !c
  deriving (Show, Eq, Ord)

data Q a b c d = Q !a !b !c !d
  deriving (Show, Eq, Ord)

class HasFirst a t | t -> a where
  first :: t -> a

instance HasFirst a (P a b) where
  first (P x _) = x

instance HasFirst a (T a b c) where
  first (T x _ _) = x

instance HasFirst a (Q a b c d) where
  first (Q x _ _ _) = x

instance HasFirst a (a, b) where
  first (x, _) = x

instance HasFirst a (a, b, c) where
  first (x, _, _) = x

instance HasFirst a (a, b, c, d) where
  first (x, _, _, _) = x

class HasSecond b t | t -> b where
  second :: t -> b

instance HasSecond b (P a b) where
  second (P _ x) = x

instance HasSecond b (T a b c) where
  second (T _ x _) = x

instance HasSecond b (Q a b c d) where
  second (Q _ x _ _) = x

instance HasSecond b (a, b) where
  second (_, x) = x

instance HasSecond b (a, b, c) where
  second (_, x, _) = x

instance HasSecond b (a, b, c, d) where
  second (_, x, _, _) = x

class HasThird c t | t -> c where
  third :: t -> c

instance HasThird c (T a b c) where
  third (T _ _ x) = x

instance HasThird c (Q a b c d) where
  third (Q _ _ x _) = x

instance HasThird c (a, b, c) where
  third (_, _, x) = x

instance HasThird c (a, b, c, d) where
  third (_, _, x, _) = x

class HasFourth d t | t -> d where
  fourth :: t -> d

instance HasFourth d (Q a b c d) where
  fourth (Q _ _ _ x) = x

instance HasFourth d (a, b, c, d) where
  fourth (_, _, _, x) = x

------

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 :: (Functor m, MonadHopper r m) => m r
popJust = fromJust <$> pop

------

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

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

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

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

------

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

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

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

------

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

run1 = bool "NO" "YES" . solve . B.unpack <$> popJust

solve s = or $ map test [T a b c | a <- [1, -1], b <- [1, -1], c <- [1, -1]]
  where
    test repl = (\l -> all (>= 0) l && last l == 0) $
                second $
                mapAccumL (\x y -> (x + y, x + y)) 0 $ map (replace repl) s

    replace (T a b c) ch = case ch of
      'A' -> a
      'B' -> b
      'C' -> c

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

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

check :: String -> Maybe Int
check [] = Just 0
check ('\r' : _) = Just 0
check (c : cs) = do
  rest <- check cs
  guard $ c == ')' || rest > 0
  return $ if c == ')' then rest + 1 else rest - 1

replace :: String -> (Char, Char, Char) -> String
replace [] _ = []
replace (c : cs) t@(x1, x2, x3)
  | c == 'A' = x1 : replace cs t
  | c == 'B' = x2 : replace cs t
  | c == 'C' = x3 : replace cs t
  | otherwise = ""

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    s <- C.unpack <$> C.getLine
    let bs = "()"
        results = filter (==0) . map fromJust . filter isJust . map (check . replace s) $ [(x1, x2, x3) | x1 <- bs, x2 <- bs, x3 <- bs]
    C.putStrLn $ C.pack $ if null results then "NO" else "YES"

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

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

import Data.Bits

count :: Char -> P.ByteString -> Int
count c = P.foldl' (\x y -> x + if  y == c  then  1  else  0) 0

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    s <- readLine
    let
      n = fromIntegral $ P.length s
      letters = "ABC"
      cts = map (`count` s) letters
      half = filter (\x -> 2 * fst x == n) $ zip cts letters
    lift $ P.putStrLn $ P.pack $ case  half  of
      [] -> "NO"
      (_, tarc) : _ -> let
        startWithTar = P.head s == tarc
        fun c = if  xor startWithTar (c == tarc)
          then  ')'
          else  '('
        newS = map fun $ P.unpack s
        prefTots :: [Int]
        prefTots = scanl (\x y -> x + if  y == '('  then  1  else  -1) 0 newS
        in  if  all (>= 0) prefTots && last prefTots == 0
        then  "YES"
        else  "NO"

type SIO = StateT P.ByteString IO

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

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

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

module Main where

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

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

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

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

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

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

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

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    s <- getLine
    putStrLn $ yesOrNo $ and [f s, head s /= last s]

f :: String -> Bool
f = check . sort . map length . group . sort

check :: [Int] -> Bool
check [a] = False
check [a, b] = a == b
check [a, b, c] = a + b == c


Vasya has been playing Plane of Tanks with his friends the whole year. Now it is time to divide the participants into several categories depending on their results. A player is given a non-negative integer number of points in each round of the Plane of Tanks. Vasya wrote results for each round of the last year. He has n records in total.In order to determine a player's category consider the best result obtained by the player and the best results of other players. The player belongs to category:   "noob" — if more than 50% of players have better results;  "random" — if his result is not worse than the result that 50% of players have, but more than 20% of players have better results;  "average" — if his result is not worse than the result that 80% of players have, but more than 10% of players have better results;  "hardcore" — if his result is not worse than the result that 90% of players have, but more than 1% of players have better results;  "pro" — if his result is not worse than the result that 99% of players have.  When the percentage is calculated the player himself is taken into account. That means that if two players played the game and the first one gained 100 points and the second one 1000 points, then the first player's result is not worse than the result that 50% of players have, and the second one is not worse than the result that 100% of players have.Vasya gave you the last year Plane of Tanks results. Help Vasya determine each player's category.

The first line contains the only integer number n (1 ≤ n ≤ 1000) — a number of records with the players' results. Each of the next n lines contains a player's name and the amount of points, obtained by the player for the round, separated with a space. The name contains not less than 1 and no more than 10 characters. The name consists of lowercase Latin letters only. It is guaranteed that any two different players have different names. The amount of points, obtained by the player for the round, is a non-negative integer number and does not exceed 1000.

Print on the first line the number m — the number of players, who participated in one round at least. Each one of the next m lines should contain a player name and a category he belongs to, separated with space. Category can be one of the following: "noob", "random", "average", "hardcore" or "pro" (without quotes). The name of each player should be printed only once. Player names with respective categories can be printed in an arbitrary order.

5
vasya 100
vasya 200
artem 100
kolya 200
igor 250

4
artem noob
igor pro
kolya random
vasya random

NoteIn the first example the best result, obtained by artem is not worse than the result that 25% of players have (his own result), so he belongs to category "noob". vasya and kolya have best results not worse than the results that 75% players have (both of them and artem), so they belong to category "random". igor has best result not worse than the result that 100% of players have (all other players and himself), so he belongs to category "pro".In the second example both players have the same amount of points, so they have results not worse than 100% players have, so they belong to category "pro".

import Data.List (nub)

main = do
    n <- fmap read getLine
    a <- fmap (map (\[name, score] -> (name, read score :: Double)) . map words . take n . lines) getContents
    let gamers = nub $ map (\(name, _) -> (name, maximum $ map snd $ filter ((== name) . fst) a)) a
    print $ length gamers
    mapM_ (\(name, rank) -> putStrLn $ name ++ " " ++ rank) $ map (\(name, score) -> (name, calcRank (fromIntegral $ length gamers) $ fromIntegral $ length $ filter ((<= score) . snd) gamers)) gamers
    where
        calcRank :: Double -> Double -> String
        calcRank n k | k >= 0.99 * n = "pro"
                     | k >= 0.9 * n  = "hardcore"
                     | k >= 0.8 * n  = "average"
                     | k >= 0.5 * n  = "random"
                     | otherwise     = "noob"

import Control.Monad (replicateM)
import Data.Map (Map, assocs, filter, fromListWith, map, size)
import Prelude hiding (filter, map)

readResult :: IO (String, Int)
readResult  =  do
    [s1, s2]  <-  getLine >>= return . words
    return (s1, read s2)

getNoob :: Map String Int -> Int -> String
getNoob results source
  | k < 50  =  "noob"
  | k < 80  =  "random"
  | k < 90  =  "average"
  | k < 99  =  "hardcore"
  | otherwise  =  "pro"
  where
    n  =  size results
    m  =  size $ filter (<= source) results
    k  =  div (100 * m) n

printAns :: Map String String -> IO ()
printAns results  =  print (size results) >> mapM_ printAns' (assocs results)
  where
    printAns' (name, result)  =  putStrLn $ concat [name, " ", result]

main :: IO ()
main  =  do
    n  <-  readLn
    allResults  <-  replicateM n readResult
    let results   =  fromListWith max allResults
    printAns $ map (getNoob results) results

import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map

-- Pure Code

solve :: Int -> [(String, Int)] -> [(String, String)]
solve n records = map (categorize n records) records

getCategory :: Int -> String
getCategory p
  | p < 50    = "noob"
  | p < 80    = "random"
  | p < 90    = "average"
  | p < 99    = "hardcore"
  | otherwise = "pro"

categorize :: Int -> [(String, Int)] -> (String, Int) -> (String, String)
categorize n records (name, score) =
  let m = length $ filter (\(_, score1) -> score1 <= score) records
      p = 100 * m `div` n
  in (name, getCategory p)

-- Dirty Code

main = do n <- fmap read getLine
          records <- fmap (Map.toList . Map.fromListWith max) $ replicateM n getRecord
          let m = length records
          putStrLn $ show m
          sequence_ $ map printCategory $ solve m records

getRecord :: IO (String, Int)
getRecord = do [name, score] <- fmap words getLine
               return (name, read score)

printCategory (name, category) =
  putStrLn (name ++ " " ++ category)

{-# 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
    replicateM n $ do
        name <- readString
        score <- readInt
        return (name, score)
  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 = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

solve records = BS.unlines $
    (BS.pack $ show n) : map (\(name, s) ->
        name `BS.append` " " `BS.append` solvePlayer s) highScores
  where
    highScores = Map.toList $ Map.fromListWith max records
    n = length highScores

    solvePlayer score
        | r < 50 % 100 = "noob"
        | r < 80 % 100 = "random"
        | r < 90 % 100 = "average"
        | r < 99 % 100 = "hardcore"
        | otherwise    = "pro"
      where
        r = cnt % n
        cnt = length [ undefined
                     | (_, score') <- highScores
                     , score' <= score
                     ]

-- {{{ 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 (nub)

main = do
    n <- fmap read getLine
    a <- fmap (map (\[name, score] -> (name, read score :: Double)) . map words . take n . lines) getContents
    let gamers = nub $ map (\(name, _) -> (name, maximum $ map snd $ filter ((== name) . fst) a)) a
    mapM_ (\(name, rank) -> putStrLn $ name ++ " " ++ rank) $ map (\(name, score) -> (name, calcRank (fromIntegral $ length gamers) $ fromIntegral $ length $ filter ((<= score) . snd) gamers)) gamers
    where
        calcRank :: Double -> Double -> String
        calcRank n k | k >= 0.99 * n = "pro"
                     | k >= 0.9 * n  = "hardcore"
                     | k >= 0.8 * n  = "average"
                     | k >= 0.5 * n  = "random"
                     | otherwise     = "noob"

import Control.Monad (replicateM)
import Data.Map (Map, assocs, filter, fromListWith, map, size)
import Prelude hiding (filter, map)

readResult :: IO (String, Int)
readResult  =  do
    [s1, s2]  <-  getLine >>= return . words
    return (s1, read s2)

getCool :: Map String Int -> Int -> Double
getCool results source  =  fromIntegral m / fromIntegral n
  where
    n  =  size results
    m  =  size $ filter (<= source) results

getNoob :: Double -> String
getNoob a
  | a < 0.50  =  "noob"
  | a < 0.80  =  "random"
  | a < 0.90  =  "average"
  | a < 0.99  =  "hardcore"
  | otherwise  =  "pro"

printAns :: Map String String -> IO ()
printAns results  =  print (size results) >> mapM_ printAns' (assocs results)
  where
    printAns' (name, result)  =  putStrLn $ concat [name, " ", result]

main :: IO ()
main  =  do
    n  <-  readLn
    allResults  <-  replicateM n readResult
    let results   =  fromListWith max allResults
    printAns $ map (getNoob . getCool results) results

import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map

-- Pure Code

solve :: Int -> [(String, Int)] -> [(String, String)]
solve n records = map (categorize n records) records

getCategory :: Double -> String
getCategory p
  | p < 50.0  = "noob"
  | p < 80.0  = "random"
  | p < 90.0  = "average"
  | p < 99.0  = "hardcore"
  | otherwise = "pro"

categorize :: Int -> [(String, Int)] -> (String, Int) -> (String, String)
categorize n records (name, score) =
  let m = length $ filter (\(_, score1) -> score1 <= score) records
      p = 100.0 / fromIntegral n * fromIntegral m
  in (name, getCategory p)

-- Dirty Code

main = do n <- fmap read getLine
          records <- fmap (Map.toList . Map.fromListWith max) $ replicateM n getRecord
          let m = length records
          putStrLn $ show m
          sequence_ $ map printCategory $ solve m records

getRecord :: IO (String, Int)
getRecord = do [name, score] <- fmap words getLine
               return (name, read score)

printCategory (name, category) =
  putStrLn (name ++ " " ++ category)

import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map

-- Pure Code

solve :: Int -> [(String, Int)] -> [(String, String)]
solve n records = map (categorize n records) records

getCategory :: Double -> String
getCategory p
  | 100.0 - p > 50.0              = "noob"
  | 50.0 <= p && 100.0 - p > 20.0 = "random"
  | 80.0 <= p && 100.0 - p > 10.0 = "average"
  | 90.0 <= p && 100.0 - p > 1.0  = "hardcore"
  | 99.0 <= p                     = "pro"
  | otherwise = undefined

categorize :: Int -> [(String, Int)] -> (String, Int) -> (String, String)
categorize n records (name, score) =
  let m = length $ filter (\(_, score1) -> score1 <= score) records
      p = 100.0 / fromIntegral n * fromIntegral m
  in (name, getCategory p)

-- Dirty Code

main = do n <- fmap read getLine
          records <- fmap (Map.toList . Map.fromListWith max) $ replicateM n getRecord
          let m = length records
          putStrLn $ show m
          sequence_ $ map printCategory $ solve m records

getRecord :: IO (String, Int)
getRecord = do [name, score] <- fmap words getLine
               return (name, read score)

printCategory (name, category) =
  putStrLn (name ++ " " ++ category)

import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map

-- Pure Code

solve :: Int -> [(String, Int)] -> [(String, String)]
solve n records = map (categorize n records) records

getCategory :: Double -> String
getCategory p
  | 100.0 - p > 50.0              = "noob"
  | 50.0 <= p && 100.0 - p > 20.0 = "random"
  | 80.0 <= p && 100.0 - p > 10.0 = "average"
  | 90.0 <= p && 100.0 - p > 1.0  = "hardcore"
  | 99.0 <= p                     = "pro"
  | otherwise = undefined

categorize :: Int -> [(String, Int)] -> (String, Int) -> (String, String)
categorize n records (name, score) =
  let m = length $ filter (\(_, score1) -> score1 <= score) records
      p = 100.0 / fromIntegral n * fromIntegral m
  in (name, getCategory p)

-- Dirty Code

main = do n <- fmap read getLine
          records <- fmap (Map.toList . Map.fromListWith max) $ replicateM n getRecord
          sequence_ $ map printCategory $ solve (length records) records

getRecord :: IO (String, Int)
getRecord = do [name, score] <- fmap words getLine
               return (name, read score)

printCategory (name, category) =
  putStrLn (name ++ " " ++ category)


Some natural number was written on the board. Its sum of digits was not less than k. But you were distracted a bit, and someone changed this number to n, replacing some digits with others. It's known that the length of the number didn't change.You have to find the minimum number of digits in which these two numbers can differ.

The first line contains integer k (1 ≤ k ≤ 109). The second line contains integer n (1 ≤ n < 10100000). There are no leading zeros in n. It's guaranteed that this situation is possible.

Print the minimum number of digits in which the initial number and n can differ.

NoteIn the first example, the initial number could be 12.In the second example the sum of the digits of n is not less than k. The initial number could be equal to n.

import Data.List
import Data.Char
main =
  do
    sk <- getLine
    let k = read sk :: Int
    sn <- getLine
    let sv = (map digitToInt $ sort sn) :: [Int]
        allsum = sum sv

    if k <= allsum
       then print 0
       else
         print.snd $ foldl (\(acc, acci) x -> if acc > 0
                                     then (acc - 9 + x, acci + 1)
                                     else (acc, acci)) (k - allsum, 0) sv

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

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
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.Strict    as IM
import qualified Data.IntSet           as IS
import           Data.List
import qualified Data.Map.Strict       as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set              as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
    k <- readLn
    ns <- map digitToInt.B.unpack.B.filter(\c->'0'<=c&&c<='9') <$> B.getLine
    print $ solve k ns

solve :: Int -> [Int] -> Int
solve k ns = go 0 (k - s) $ sort ns
  where
    !s = sum ns
    go !res !rest (x:xs)
      | rest <= 0 = res
      | otherwise = go (res + 1) (rest - (9 - x)) xs
    go res _ _ = res

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

run ::  Int32 -> [Int] -> Int
run _ [] = 0
run sum (c:cs) | sum <= 0   = 0
               | otherwise  = 1 + (run (sum-m) cs)
               where m = 9 - (fromIntegral c)

solve :: Int32 -> [Int] -> Int
solve k s = run (k - (fromIntegral $ sum s)) s

main = do
  k <- read <$> getLine
  s <- sort . (map digitToInt) <$> getLine
  print $ solve k s

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

main = do
  k <- fmap readInt B.getLine
  n <- getLine
  print $ solve k n

solve k n
  | s >= k = 0
  | otherwise = (1+) $ length $ takeWhile (< k) $ tail $ scanl (\s d -> s - d + 9) s xs
  where
    xs = sort $ map digitToInt n
    s = sum xs

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

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

import qualified Data.Map as M
import Data.Char

main = print . solve . words =<< getContents

solve [ks, ns] = ans where
    k = read ks :: Int
    (cn, mp) = foldl f (0, M.empty) $ map digitToInt ns
    f (c, m) d = (c + d, M.insertWith (+) d 1 m)
    ans = if cn >= k then 0
          else snd $ foldl g (cn, 0) [0..8]
    g t@(c, x) i | c >= k    = t
                 | otherwise =
                    case M.lookup i mp of
                    Nothing -> t
                    Just p  ->
                        let j = 9 - i
                            w = k - c
                            e = max 1 $ div (w + j - 1) j
                            v = min e p
                        in (c + v * j, x + v)

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

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
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.Strict    as IM
import qualified Data.IntSet           as IS
import           Data.List
import qualified Data.Map.Strict       as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set              as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
    k <- readLn
    ns <- map digitToInt.B.unpack.B.filter(\c->'0'<=c&&c<='9') <$> B.getLine
    putStrLn . concatMap show $ solve k ns

solve :: Int -> [Int] -> [Int]
solve k ns = go [] (k - s) $ reverse ns ++ repeat 0
  where
    !s = sum ns
    go !res !rest (x:xs)
      | rest <= 0 = [0]
      | 9 - x >= rest = rest:res
      | otherwise = go ((9-x):res) (rest-(9-x)) xs

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

main = do
  k <- fmap readInt B.getLine
  n <- getLine
  print $ solve k n

solve k n
  | need <= 0 = 0
  | otherwise = ceiling $ (fromIntegral need + 1) / 9
  where
    xs = map digitToInt n
    need = k - sum xs

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

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

import qualified Data.Map as M
import Data.Char

main = print . solve . words =<< getContents

solve [ks, ns] = ans where
    k = read ks :: Int
    (cn, mp) = foldl f (0, M.empty) $ map digitToInt ns
    f (c, m) d = (c + d, M.insertWith (+) d 1 m)
    ans = if cn >= k then 0
          else snd $ foldl g (cn, 0) [0..8]
    g t@(c, x) i | c >= k    = t
                 | otherwise =
                    case M.lookup i mp of
                    Nothing -> t
                    Just p  ->
                        let j = 9 - i
                            w = k - c
                            e = max 1 $ div w j
                            v = min e p
                        in (c + v * j, x + v)

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

import qualified Data.Map as M
import Data.Char

main = print . solve . words =<< getContents

solve [ks, ns] = ans where
    k = read ks :: Int
    (cn, mp) = foldl f (0, M.empty) $ map digitToInt ns
    f (c, m) d = (c + d, M.insertWith (+) d 1 m)
    ans = if cn >= k then 0
          else snd $ foldl g (cn, 0) [0..8]
    g t@(c, x) i | c >= k    = t
                 | otherwise =
                    case M.lookup i mp of
                    Nothing -> t
                    Just p  ->
                        let j = 9 - i
                            w = k - c
                            e = max 1 $ quot w j
                            v = min e p
                        in (c + v * j, x + v)


Vasya decided to write an anonymous letter cutting the letters out of a newspaper heading. He knows heading s1 and text s2 that he wants to send. Vasya can use every single heading letter no more than once. Vasya doesn't have to cut the spaces out of the heading — he just leaves some blank space to mark them. Help him; find out if he will manage to compose the needed text.

The first line contains a newspaper heading s1. The second line contains the letter text s2. s1 и s2 are non-empty lines consisting of spaces, uppercase and lowercase Latin letters, whose lengths do not exceed 200 symbols. The uppercase and lowercase letters should be differentiated. Vasya does not cut spaces out of the heading.

If Vasya can write the given anonymous letter, print YES, otherwise print NO

Instead of dogging Your footsteps it disappears but you dont notice anything
where is your dog

Instead of dogging Your footsteps it disappears but you dont notice anything
Your dog is upstears

Instead of dogging your footsteps it disappears but you dont notice anything
Your dog is upstears

import Data.List ((\\))

main = do
	a <- getLine
	b <- getLine
	putStrLn $ if filter (/= ' ') b \\ a == [] then "YES" else "NO"

{-# LANGUAGE ScopedTypeVariables,TupleSections #-}
import Control.Monad
data State s a = State {runState :: s->(a,s)}
instance Monad (State s) where
	return = State . (,)
	(State f1) >>= f2 = State $ uncurry (runState . f2) . f1
	(State f1) >> (State f2) = State $ f2 .snd . f1

readall = State (,"")

runRead x s = fst $ runState x s

main = reader >>= writer . solver
reader = getContents
writer = putStr
solver = runRead $ do
	(s1:s2:_)<-liftM lines readall
	let count c s = length . filter (==c) $ s
	let chars = ['a'..'z'] ++ ['A'..'Z']
	return (if and [count c s1 >= count c s2 | c<-chars] then "YES" else "NO")

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

count s = \x -> (C.length . C.filter ((==) x)) s

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let [s1,s2] = take 2 $ input
	let ans = length $ filter (==False) $ [ count s1 c >= count s2 c | c <- ['a'..'z'] ++ ['A'..'Z'] ]
	putStrLn (if ans == 0 then "YES" else "NO")

import Data.List
f xs = [x | x <- xs, x/=' ']
solve s s2 | null s2 = "YES"| null s = "NO" | head s2 `elem` s  = solve x z | otherwise = "NO"
    where
        x = delete y s
        y = head s2
        z = tail s2
main = do
    s <- fmap f getLine
    s2 <- fmap f getLine
    putStrLn $ solve s s2

main = do l1 <- getLine
          l2 <- getLine
          if solve l1 l2 then putStrLn "YES" else putStrLn "NO"

solve :: String -> String -> Bool
solve _ [] = True
solve [] _ = False
solve cs1 (c2:cs2) = if c2 == ' '
                     then solve cs1 cs2
                     else case (find "" cs1 c2) of
                            Just cs -> solve cs cs2
                            Nothing -> False
    where
      nl = length cs1
      find :: String -> String -> Char -> Maybe String
      find _ [] c = Nothing
      find cs (c':cs') c = if c == c'
                           then Just (cs ++ cs')
                           else find (c':cs) cs' c

import Data.List

main = do
  t <- getLine
  h <- getLine

  putStrLn $ m (f t) (f h)

m _ [] = "YES"
m [] _ = "NO"
m (a:as) (b:bs)
 | a == b = m as bs
 | otherwise = m as (b:bs)

f = sort . filter (/=' ')

import List
main=interact(s.lines)
s [p,f] = if null(c f\\c p)then"YES"else"NO"where c=filter(>' ')

import Data.List ((\\))

main = do
        xs <- getLine
        ys <- getLine
        putStrLn $ if null $ filter (/= ' ') ys \\ xs then "YES" else "NO"

import List
import Char

solve :: String -> String -> String
solve _ [] = "YES"
solve [] _ = "NO"
solve (x:xs) (y:ys)
  | x == y  =  solve xs ys
  | x <  y  =  solve xs (y:ys)
  | x >  y  =  "NO"

main = do
  s1 <- getLine
  s2 <- getLine
  putStrLn $ solve (sort $ filter isAlpha s1) (sort $ filter isAlpha s2)

import List
main = interact solve
solve input = output where
  [s1,s2] = lines input
  output = answer s1 s2
answer _ [] = "YES"
answer xs (y:ys)
  | elem y xs = answer (delete y xs) ys
  | y == ' '  = answer xs ys
  | otherwise = "NO"

import Data.List

main = do
  text <- getLine
  heading <- getLine

  let fh = f heading
  let tmp = f text `intersect` fh
  print $ if sort tmp == sort fh
    then "YES"
    else "NO"

f = filter (/=' ')

import Data.List

main = do
  text <- getLine
  heading <- getLine

  let fh = f heading
  let tmp = f text `intersect` fh
--  print $ sort fh
--  print $ sort tmp
  print $ m (sort tmp) (sort fh)

m _ [] = "YES"
m [] _ = "NO"
m (a:as) (b:bs)
 | a == b = m as bs
 | otherwise = m as (b:bs)

f = filter (/=' ')

import Data.List

main = do
  text <- getLine
  heading <- getLine

  let fh = f heading
  let tmp = f text `intersect` fh
  print $ m (sort tmp) (sort fh)

m [] _ = "NO"
m _ [] = "YES"
m (a:as) (b:bs)
 | a == b = m as bs
 | otherwise = m as (b:bs)

f = filter (/=' ')

import Data.List

main = do
  text <- getLine
  heading <- getLine

  let fh = f heading
  print $ sort fh
  print $ sort text
  print $ m (sort $ f text) (sort fh)

m _ [] = "YES"
m [] _ = "NO"
m (a:as) (b:bs)
 | a == b = m as bs
 | otherwise = m as (b:bs)

f = filter (/=' ')

import Data.List

main = do
  text <- getLine
  heading <- getLine

  let fh = f heading
  print $ m (sort $ f text) (sort fh)

m _ [] = "YES"
m [] _ = "NO"
m (a:as) (b:bs)
 | a == b = m as bs
 | otherwise = m as (b:bs)

f = filter (/=' ')


Petya organized a strange birthday party. He invited $$$n$$$ friends and assigned an integer $$$k_i$$$ to the $$$i$$$-th of them. Now Petya would like to give a present to each of them. In the nearby shop there are $$$m$$$ unique presents available, the $$$j$$$-th present costs $$$c_j$$$ dollars ($$$1 \le c_1 \le c_2 \le \ldots \le c_m$$$). It's not allowed to buy a single present more than once.For the $$$i$$$-th friend Petya can either buy them a present $$$j \le k_i$$$, which costs $$$c_j$$$ dollars, or just give them $$$c_{k_i}$$$ dollars directly.Help Petya determine the minimum total cost of hosting his party.

The first input line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^3$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \leq n, m \leq 3 \cdot 10^5$$$) — the number of friends, and the number of unique presents available. The following line contains $$$n$$$ integers $$$k_1, k_2, \ldots, k_n$$$ ($$$1 \leq k_i \leq m$$$), assigned by Petya to his friends.  The next line contains $$$m$$$ integers $$$c_1, c_2, \ldots, c_m$$$ ($$$1 \le c_1 \le c_2 \le \ldots \le c_m \le 10^9$$$) — the prices of the presents. It is guaranteed that sum of values $$$n$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$, and the sum of values $$$m$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$.

For each test case output a single integer — the minimum cost of the party.

NoteIn the first example, there are two test cases. In the first one, Petya has $$$5$$$ friends and $$$4$$$ available presents. Petya can spend only $$$30$$$ dollars if he gives  $$$5$$$ dollars to the first friend.  A present that costs $$$12$$$ dollars to the second friend.  A present that costs $$$5$$$ dollars to the third friend.  A present that costs $$$3$$$ dollars to the fourth friend.  $$$5$$$ dollars to the fifth friend. In the second one, Petya has $$$5$$$ and $$$5$$$ available presents. Petya can spend only $$$190$$$ dollars if he gives  A present that costs $$$10$$$ dollars to the first friend.  A present that costs $$$40$$$ dollars to the second friend.  $$$90$$$ dollars to the third friend.  $$$40$$$ dollars to the fourth friend.  $$$10$$$ dollars to the fifth friend.

{-# LANGUAGE BangPatterns #-}

import Control.Arrow
import Control.Monad
import Data.Char
import Data.List (sort)
import Data.Map.Strict (fromList, (!))
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace
import System.IO
import Text.Read
import Data.Maybe (fromJust)

getNums :: IO [Int]
getNums = do
  line <- B.getLine
  return $ map ((fst . fromJust) . B.readInt) . B.split ' ' $ line

main :: IO ()
main = do
  t <- readLn :: IO Integer
  forM_ [1 .. t] handleCase

handleCase :: Integer -> IO ()
handleCase c = do
  [n, m] <- fmap (map read . words) getLine :: IO [Int]
  k <- getNums :: IO [Int]
  c <- getNums :: IO [Int]
  print $ solve n m k c
  return ()

type State = (Int, Int)

inf = 10^9 + 30 :: Int

solve :: Int -> Int -> [Int] -> [Int] -> Integer
solve !n !m !k !c =
  let !sortedK = sort k
      !mapC = fromList $ zip [1 ..] c

      countExcess :: State -> Int -> State
      countExcess (idx, mx) i = (idx + 1, max mx (idx - i))

      (_, !mx) = foldl countExcess (1, 0) sortedK

      !costs = map (mapC !) sortedK
      !paddedC = if n <= m then take n c else  c ++ replicate (n - m) inf

      !startCost = sum $ map toInteger $ take n paddedC :: Integer
      !tradeOffs = zip costs (reverse paddedC)

      !a = takeWhile (uncurry (<)) tradeOffs
      !a' = if length a < mx then take mx tradeOffs else a

      !result = startCost + sum (map (\(a, b) -> toInteger a - toInteger b) a')

   in result

{-# LANGUAGE DeriveFunctor       #-} -- hasker's code
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

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

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

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

solve :: Int -> [Int] -> Int -> [Int64] -> Int64
solve n ks m cs = solve' 1 ksSorted
    where
        ksSorted = reverse $ sort ks
        csArray = A.listArray (1, m) cs
        solve' _ [] = 0
        solve' currK ks@(k : restKs)
            | currK <= k = csArray A.! currK + solve' (currK + 1) restKs
            | otherwise  = csArray A.! k + solve' currK restKs

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m] <- B8.getLine <&> map readIntB8 . B8.words
        ks <- B8.getLine <&> map readIntB8 . B8.words
        cs <- B8.getLine <&> map (\word -> (fromInteger $ readIntegerB8 word) :: Int64) . B8.words
        let answer = solve n ks m cs
        printf "%lld\n" answer

{-# LANGUAGE DeriveFunctor       #-} -- Hasker's code
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

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

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

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

solve :: Int -> [Int] -> Int -> [Int64] -> Int64
solve n ks m cs = sum $ map fromIntegral $ zipWith min sks (cs ++ (repeat (10^9+1))) where
  sks = map (vcs A.!) $ sortOn negate ks
  vcs = A.listArray (1,m) cs
{-
solve :: Int -> [Int] -> Int -> [Int64] -> Int64
solve n ks m cs = solve' 1 ksSorted
    where
        ksSorted = reverse $ sort ks
        csArray = A.listArray (1, m) cs
        solve' _ [] = 0
        solve' currK ks@(k : restKs)
            | currK <= k = csArray A.! currK + solve' (currK + 1) restKs
            | otherwise  = csArray A.! k + solve' currK restKs
-}

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m] <- B8.getLine <&> map readIntB8 . B8.words
        ks <- B8.getLine <&> map readIntB8 . B8.words
        cs <- B8.getLine <&> map (\word -> (fromInteger $ readIntegerB8 word) :: Int64) . B8.words
        let answer = solve n ks m cs
        printf "%lld\n" answer

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

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

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

solve :: [[Int]] -> Integer
solve [[n,m],ks,cs] = sum $ map toInteger $ zipWith min sks (cs ++ (repeat (10^9+1))) where
  sks = map (vcs A.!) $ sortOn negate ks
  vcs = A.listArray (1,m) cs

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

import {-safe-} Control.Arrow ((>>>))
import qualified Data.Text as T
import qualified Data.Text.IO as TI
import Data.List
import Data.Function
import Data.Maybe
import qualified Data.Array as A

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

solve :: [[Int]] -> Integer
solve [ks,cs] = sum $ map toInteger $ zipWith min sks (cs ++ (repeat (10^9+1))) where
  sks = map (vcs A.!) $ sortOn negate ks
  vcs = A.listArray (1,length cs) (cs)

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

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

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

solve :: [[Integer]] -> Integer
solve [ks,cs] = sum $ zipWith min sks (cs ++ (repeat (10^9+1))) where
  sks = reverse $ map (mic M.!) $ sort ks
  mic = M.fromList (zip [1..] cs)

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

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

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

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

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

solve :: Int -> [Int] -> Int -> [Int64] -> Int64
solve n ks m cs = solve' 1 ksSorted
    where
        ksSorted = reverse $ sort ks
        csArray = A.listArray (1, m) cs
        solve' _ [] = 0
        solve' currK ks@(k : restKs)
            | currK <= k = csArray A.! currK + solve' (currK + 1) restKs
            | otherwise  = csArray A.! k + solve' currK restKs

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m] <- B8.getLine <&> map readIntB8 . B8.words
        ks <- B8.getLine <&> map readIntB8 . B8.words
        cs <- B8.getLine <&> map (\word -> (fromInteger $ readIntegerB8 word) :: Int64) . B8.words
        let answer = solve n ks m cs
        printf "%lld\n" answer

import Control.Arrow
import Control.Monad
import Data.Char
import Data.List (sort)
import Data.Map (fromList, (!))
-- import Debug.Trace
import System.IO
import Text.Read

main :: IO ()
main = do
  t <- readLn :: IO Integer
  forM_ [1 .. t] handleCase

handleCase :: Integer -> IO ()
handleCase c = do
  [n, m] <- fmap (map read . words) getLine :: IO [Int]
  k <- fmap (map read . words) getLine :: IO [Int]
  c <- fmap (map read . words) getLine :: IO [Int]
  print $ solve n m k c
  return ()

type State = (Int, Int)

inf = 10^9 + 30 :: Int

solve :: Int -> Int -> [Int] -> [Int] -> Integer
solve n m k c =
  let sortedK = sort k
      mapC = fromList $ zip [1 ..] c

      countExcess :: State -> Int -> State
      countExcess (idx, mx) i = (idx + 1, max mx (i - idx))

      (_, mx) = foldl countExcess (1, 0) sortedK

      costs = map (mapC !) sortedK
      paddedC = if n <= m then c else  c ++ replicate (n - m) inf

      startCost = sum $ map toInteger $ take n paddedC
      tradeOffs = zip costs (reverse paddedC)

      a = takeWhile (uncurry (<)) $ tradeOffs
      a' = if length a < mx then take mx tradeOffs else a

      result = startCost + sum (map (\(a, b) -> toInteger a - toInteger b) a')

   in result


This is a simplified version of the problem B2. Perhaps you should read the problem B2 before you start solving B1.Paul and Mary have a favorite string $$$s$$$ which consists of lowercase letters of the Latin alphabet. They want to paint it using pieces of chalk of two colors: red and green. Let's call a coloring of a string wonderful if the following conditions are met:  each letter of the string is either painted in exactly one color (red or green) or isn't painted;  each two letters which are painted in the same color are different;  the number of letters painted in red is equal to the number of letters painted in green;  the number of painted letters of this coloring is maximum among all colorings of the string which meet the first three conditions. E. g. consider a string $$$s$$$ equal to "kzaaa". One of the wonderful colorings of the string is shown in the figure.    The example of a wonderful coloring of the string "kzaaa". Paul and Mary want to learn by themselves how to find a wonderful coloring of the string. But they are very young, so they need a hint. Help them find $$$k$$$ — the number of red (or green, these numbers are equal) letters in a wonderful coloring.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of one non-empty string $$$s$$$ which consists of lowercase letters of the Latin alphabet. The number of characters in the string doesn't exceed $$$50$$$.

For each test case, output a separate line containing one non-negative integer $$$k$$$ — the number of letters which will be painted in red in a wonderful coloring.

NoteThe first test case contains the string from the statement. One of the wonderful colorings is shown in the figure. There's no wonderful coloring containing $$$3$$$ or more red letters because the total number of painted symbols will exceed the string's length.The string from the second test case can be painted as follows. Let's paint the first occurrence of each of the letters "c", "o", "e" in red and the second ones in green. Let's paint the letters "d", "f" in red and "r", "s" in green. So every letter will be painted in red or green, hence the answer better than $$$5$$$ doesn't exist.The third test case contains the string of distinct letters, so you can paint any set of characters in red, as long as the size of this set doesn't exceed half of the size of the string and is the maximum possible.The fourth test case contains a single letter which cannot be painted in red because there will be no letter able to be painted in green.The fifth test case contains a string of identical letters, so there's no way to paint more than one letter in red.

module Main where
import Data.List (group, sort)
main = interact solve

solve :: String -> String
solve inp =
    let
        t = read . head . lines $ inp :: Int
        arr = take t . tail . lines $ inp
        more x = (length . filter (\y -> length y >= 2) . group . sort $ x) * 2
        one x = (length . filter (\y -> length y == 1) . group . sort $ x)
        logic x = if one x < more x then one x * 2 else more x * 2
    in
        unlines . map (show . (\x -> (one x + more x) `div` 2)) $ arr

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

-- (ghc -Werror -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > tmp.txt  &&  diff -sdu -- output.txt tmp.txt  &&  cat -- tmp.txt)

import Prelude
import Control.Monad
import Data.List

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

    (putStr . unlines . map (show . solve)) tcs

solve s = cntOnes `div` 2 + (length s' - cntOnes)
  where
    s' = reverse . sort . map length . group . sort $ s
    cntOnes = length . filter (==1) $ s'

import Data.List (intersperse, intercalate, sort, group)

parseOut :: [Int] -> String
parseOut = intercalate "\n" . map show

parseIn :: String -> [String]
parseIn = tail . words

solve :: String -> Int
solve str = gtOne + div one 2 where
    frequencies = map length $ group $ sort str
    gtOne = length $ filter (>1) frequencies
    one = length $ filter (==1) frequencies

main :: IO ()
main = interact $ parseOut . map solve . parseIn

import Control.Arrow ((>>>))
import Data.Set (fromList, toList)

unique :: Ord a => [a] -> [a]
unique = toList . fromList

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

solve :: String -> Int
solve s = (map ((`count` s) >>> min 2) >>> sum >>> (`div` 2)) $ unique s

main :: IO ()
main = interact $ lines >>> tail >>> map (solve >>> show) >>> unlines

import Control.Arrow ((>>>))
import Data.Bifunctor (bimap)
import Data.List (group, groupBy, sort, sortBy)
import Data.Ord (comparing)

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> map (solve >>> count 1 >>> show)
      >>> unlines

type Col = (Int, Maybe Int)

solve :: [Char] -> [Int]
solve as =
  let k = 2
   in map (maybe 0 ((1 +) . (`mod` k)) . snd)
        . sortOn fst
        . uncurry (++)
        . bimap (`zip` (Just <$> [1 ..])) (`zip` repeat Nothing)
        . (\(cs, ws) -> let (ws', cs') = splitAt (length cs `mod` k) cs in (cs', ws' ++ ws))
        . bimap' concat
        . unzip
        . map (splitAt k . map snd)
        . groupOn fst
        . sortOn fst
        $ as `zip` [0 ..]

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

groupOn :: (Eq b) => (a -> b) -> [a] -> [[a]]
groupOn p = groupBy (\x y -> p x == p y)

sortOn :: (Ord b) => (a -> b) -> [a] -> [a]
sortOn = sortBy . comparing

bimap' f = bimap f f

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

import Control.Monad (replicateM_)
import qualified Data.Map as M

counts :: Ord k => [k] -> M.Map k Int
counts = foldr insrt M.empty where
  insrt k mp = M.insertWith (+) k 1 mp

numRed :: String -> Int
numRed s = evenCnt + oddCnt + oneCnt `div` 2
  where
    cnt = counts s
    evenCnt = M.size $ M.filter even cnt
    oddCnt = M.size $ M.filter (\x -> odd x && x > 1) cnt
    oneCnt = M.size $ M.filter (==1) cnt

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    s <- getLine
    print $ numRed s

import qualified Data.Map as M
import Data.Map (Map)
import Control.Monad
import Data.Functor ((<&>))
import Data.STRef
import Control.Monad.ST

-- | Take a sequence of elements and convert into frequency mapping
collect :: Ord a => [a] -> Map a Int
collect = foldl ins_ M.empty
  where
    ins_ m n = M.alter (Just . maybe 1 (+1)) n m

-- | calculate coloring
coloring :: Ord a => [a] -> Int
coloring xs = gt2 + lt2 `div` 2
  where
    m = collect xs
    gt2 = length $ filter (>= 2) $ M.elems m
    lt2 = length m - gt2

main :: IO ()
main = do
  testCases <- read <$> getLine
  forM_ [1..testCases] $ \_ -> do
    test <- getLine
    print $ coloring test

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

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

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  a <- getLine
  let k = 2
      b = group $ sort a
      total = foldl (\acc xs -> acc + min (length xs) k) 0 b
    in print $ div total 2

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

----------------------------------------------------------------------------------------
readrows :: (Integral a, Integral b) => b -> IO [[a]]
readrows 0 = return []
readrows n = do
  row <- readInts
  l <- readrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs

import Control.Monad
import Data.List

printResult = do
    s <- getLine
    let a = concatMap (take 2)  (group $ sort s)
    print $ div (length a) 2

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

module Main where
import Data.List (group)
main = interact solve

solve :: String -> String
solve inp =
    let
        t = read . head . lines $ inp :: Int
        arr = take t . tail . lines $ inp
        logic x = ((length . filter(\y -> length y == 1) . group $ x) `div` 2) + (length . filter (\y -> length y == 2) . group $ x)  + (length . filter(\y -> length y > 2) . group $ x)
    in
        unlines . map (show . logic) $ arr

module Main where
import Data.List (group)
main = interact solve

solve :: String -> String
solve inp =
    let
        t = read . head . lines $ inp :: Int
        arr = take t . tail . lines $ inp
        logic x = (length . filter(\y -> length y == 1) . group $ x) `div` 2 + (length . filter (\y -> length y > 1) . group $ x) `div` 2  + (length . filter(\y -> length y > 2) . group $ x)
    in
        unlines . map (show . logic) $ arr


Eugene likes working with arrays. And today he needs your help in solving one challenging task.An array $$$c$$$ is a subarray of an array $$$b$$$ if $$$c$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) elements from the beginning and several (possibly, zero or all) elements from the end.Let's call a nonempty array good if for every nonempty subarray of this array, sum of the elements of this subarray is nonzero. For example, array $$$[-1, 2, -3]$$$ is good, as all arrays $$$[-1]$$$, $$$[-1, 2]$$$, $$$[-1, 2, -3]$$$, $$$[2]$$$, $$$[2, -3]$$$, $$$[-3]$$$ have nonzero sums of elements. However, array $$$[-1, 2, -1, -3]$$$ isn't good, as his subarray $$$[-1, 2, -1]$$$ has sum of elements equal to $$$0$$$.Help Eugene to calculate the number of nonempty good subarrays of a given array $$$a$$$.

The first line of the input contains a single integer $$$n$$$ ($$$1 \le n \le 2 \times 10^5$$$)  — the length of array $$$a$$$. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$)  — the elements of $$$a$$$.

Output a single integer  — the number of good subarrays of $$$a$$$.

NoteIn the first sample, the following subarrays are good: $$$[1]$$$, $$$[1, 2]$$$, $$$[2]$$$, $$$[2, -3]$$$, $$$[-3]$$$. However, the subarray $$$[1, 2, -3]$$$ isn't good, as its subarray $$$[1, 2, -3]$$$ has sum of elements equal to $$$0$$$.In the second sample, three subarrays of size 1 are the only good subarrays. At the same time, the subarray $$$[41, -41, 41]$$$ isn't good, as its subarray $$$[41, -41]$$$ has sum of elements equal to $$$0$$$.

module Main where

import Control.Monad
import Data.List
import qualified Data.Map as M
import Data.Maybe

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

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

main :: IO ()
main = do
    getLine
    a <- getIntList
    let pre = scanl1 max $ f (M.fromList [(0, 0)]) 0 (zip a [1..])
    print . sum $ zipWith (-) [0..] pre

f :: M.Map Integer Integer -> Integer -> [(Integer, Integer)] -> [Integer]
f _ _ [] = []
f mp psum ((x,id):xs) = case M.member (psum + x) mp of
    True -> fromJust (M.lookup (psum + x) mp)
            : f (M.insert (psum + x) id mp) (psum + x) xs
    False -> -1
             : f (M.insert (psum + x) id mp) (psum + x) xs

module Main where

import Control.Monad
import Data.List
import qualified Data.Map as M
import Data.Maybe

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

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

main :: IO ()
main = do
    getLine
    a <- getIntList
    let pre = scanl1 max $ f (M.fromList [(0, 0)]) 0 (zip a [1..])
    print . sum $ zipWith (-) [0..] pre

f :: M.Map Integer Int -> Integer -> [(Integer, Int)] -> [Int]
f _ _ [] = []
f mp psum ((x,id):xs) = case M.member (psum + x) mp of
    True -> fromJust (M.lookup (psum + x) mp)
            : f (M.insert (psum + x) id mp) (psum + x) xs
    False -> -1
             : f (M.insert (psum + x) id mp) (psum + x) xs


A student of z-school found a kind of sorting called z-sort. The array a with n elements are z-sorted if two conditions hold:  ai ≥ ai - 1 for all even i,  ai ≤ ai - 1 for all odd i > 1. For example the arrays [1,2,1,2] and [1,1,1,1] are z-sorted while the array [1,2,3,4] isn’t z-sorted.Can you make the array z-sorted?

The first line contains a single integer n (1 ≤ n ≤ 1000) — the number of elements in the array a. The second line contains n integers ai (1 ≤ ai ≤ 109) — the elements of the array a.

If it's possible to make the array a z-sorted print n space separated integers ai — the elements after z-sort. Otherwise print the only word "Impossible".

import Data.List

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

solve :: [Int] -> [Int]
solve (n:a) = let b = sort a
                  h = div (n + 1) 2
                  (l, r) = splitAt h b
              in solve' l r
              where solve' :: [Int] -> [Int] -> [Int]
                    solve' [] [] = []
                    solve' l [] = l
                    solve' (l:ls) (r:rs) = l : r : solve' ls rs

import Data.List
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    mapM_ putStr (map (\x -> (show x ++ " ")) (solve n (sort a)))

solve :: Int -> [Int] -> [Int]
solve n l =
    let (x,y) = splitAt (n `div` 2) l
    in merge x (reverse y)
     where merge [] b = b
           merge a [] = a
           merge (a:as) (b:bs) = a:b:merge as bs

import Data.List (sort)

main = do
  getLine
  as <- fmap (map read . words) getLine :: IO [Int]

  let
    rev (a:b:xs) = (b:a:rev xs)
    rev [a] = [a]
    rev [] = []

  putStrLn $ unwords $ map show $ rev $ reverse $ sort as

import Data.List
main=interact$unwords.map show.f1.sort.map (read::String->Int).tail.words
f1 []=[]
f1 (a:b)=a:f2 b
f2 []=[]
f2 a=last a:f1 (init a)

import Data.List

main = interact $ unwords . map show . sol . map read . tail . words

sol :: [Int] -> [Int]
sol xs
    | odd $ length xs = weave (tail sxs) ++ [head sxs]
    | otherwise = weave sxs
    where
    sxs = sort xs
    weave xs = concat $ zipWith (\a b -> [a, b]) l r
        where
        (l, r) = splitAt (length sxs `div` 2) $ sort xs


You are given an array $$$a$$$ of length $$$n$$$ consisting of integers. You can apply the following operation, consisting of several steps, on the array $$$a$$$ zero or more times:   you select two different numbers in the array $$$a_i$$$ and $$$a_j$$$;  you remove $$$i$$$-th and $$$j$$$-th elements from the array. For example, if $$$n=6$$$ and $$$a=[1, 6, 1, 1, 4, 4]$$$, then you can perform the following sequence of operations:   select $$$i=1, j=5$$$. The array $$$a$$$ becomes equal to $$$[6, 1, 1, 4]$$$;  select $$$i=1, j=2$$$. The array $$$a$$$ becomes equal to $$$[1, 4]$$$. What can be the minimum size of the array after applying some sequence of operations to it?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) is length of the array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output the minimum possible size of the array after applying some sequence of operations to it.

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust, fromMaybe)
import Data.List (group, sort)

main :: IO ()
main = C.interact $ runScanner (numberOf (C.pack <$> testCase)) >>> C.unlines

testCase :: Scanner String
testCase = show . compute <$> numberOf int

compute :: [Int] -> Int
compute xs
  | lg >= n - lg = 2 * lg - n
  | otherwise = n `mod` 2
  where
    n = length xs
    lg = maximum . map length . group . sort $ xs

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

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

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> str

double :: Scanner Double
double = read . C.unpack <$> str

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 (,)


Reforms continue entering Berland. For example, during yesterday sitting the Berland Parliament approved as much as n laws (each law has been assigned a unique number from 1 to n). Today all these laws were put on the table of the President of Berland, G.W. Boosch, to be signed.This time mr. Boosch plans to sign 2k laws. He decided to choose exactly two non-intersecting segments of integers from 1 to n of length k and sign all laws, whose numbers fall into these segments. More formally, mr. Boosch is going to choose two integers a, b (1 ≤ a ≤ b ≤ n - k + 1, b - a ≥ k) and sign all laws with numbers lying in the segments [a; a + k - 1] and [b; b + k - 1] (borders are included).As mr. Boosch chooses the laws to sign, he of course considers the public opinion. Allberland Public Opinion Study Centre (APOSC) conducted opinion polls among the citizens, processed the results into a report and gave it to the president. The report contains the absurdity value for each law, in the public opinion. As mr. Boosch is a real patriot, he is keen on signing the laws with the maximum total absurdity. Help him.

The first line contains two integers n and k (2 ≤ n ≤ 2·105, 0 < 2k ≤ n) — the number of laws accepted by the parliament and the length of one segment in the law list, correspondingly. The next line contains n integers x1, x2, ..., xn — the absurdity of each law (1 ≤ xi ≤ 109).

Print two integers a, b — the beginning of segments that mr. Boosch should choose. That means that the president signs laws with numbers from segments [a; a + k - 1] and [b; b + k - 1]. If there are multiple solutions, print the one with the minimum number a. If there still are multiple solutions, print the one with the minimum b.

NoteIn the first sample mr. Boosch signs laws with numbers from segments [1;2] and [4;5]. The total absurdity of the signed laws equals 3 + 6 + 1 + 6 = 16.In the second sample mr. Boosch signs laws with numbers from segments [1;2] and [3;4]. The total absurdity of the signed laws equals 1 + 1 + 1 + 1 = 4.

{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,TypeSynonymInstances #-}

import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = 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)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = maximizeBy cmpFst
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]
maximizeBy c f l = snd $ maximumBy c [(f x,x)| x<- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,k] <- map readInt. B.words <$> B.getLine
    l     <- map readInt . B.words <$> B.getLine
    let (a,b) = solve n k l
    putStrLn $ show a ++" "++show b

solve n k l = snd $ foldl1 g (reverse cs)
    where
    l'  = map toInteger l
    costs = totalAbsurdity k l'
    as  = zip costs [1..]
    bs  = drop k $ scanr1 g as
    cs  = zipWith (\(a,ai) (b,bi) -> (a+b,(ai,bi))) as bs
    f (a,b) (c,d) = case compare a c of
        EQ -> compare d b
        a  -> a
    g a b = case f a b of
        LT -> b
        GT -> a
        EQ -> a

totalAbsurdity k l = go (sum $ take k l) l (drop k l)
    where go a h []          = [a]
          go a (h:hs) (t:ts) =
            let a'   = a-h+t in
                a' `seq` a:go a' hs ts

{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,TypeSynonymInstances #-}

import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

scanl' f q ls = q : case ls of
    [] -> []
    x:xs -> let q' = f q x in scanl' f q' xs
scanl1' f (x:xs) = scanl f x xs
scanl1' _ [] = []

scanr' _ q [] = [q]
scanr' f q (x:xs) =
    let qs@(q':_) = scanr f q xs in q' `seq` (f x q:qs)

scanr1' _ [] = []
scanr1' _ [x] = [x]
scanr1' f (x:xs) = q `seq` (f x q : qs)
    where qs@(q:_) = scanr1 f xs

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)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = maximizeBy cmpFst
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]
maximizeBy c f l = snd $ maximumBy c [(f x,x)| x<- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,k] <- map readInt. B.words <$> B.getLine
    l     <- map readInt . B.words <$> B.getLine
    let (a,b) = solve n k l
    putStrLn $ show a ++" "++show b

solve n k l = snd $ foldl1' g (reverse cs)
    where
    l'  = map toInteger l
    costs = totalAbsurdity k l'
    as  = zip costs [1..]
    bs  = drop k $ scanr1 g as
    cs  = zipWith (\(a,ai) (b,bi) -> (a+b,(ai,bi))) as bs
    f (a,b) (c,d) = case compare a c of
        EQ -> compare d b
        a  -> a
    g a b = case f a b of
        LT -> b
        GT -> a
        EQ -> a

totalAbsurdity k l = go (sum $ take k l) l (drop k l)
    where go a h []          = [a]
          go a (h:hs) (t:ts) =
            let a'   = a-h+t in
                a' `seq` a:go a' hs ts

{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,TypeSynonymInstances #-}

import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.Int
import Data.List
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = 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)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = maximizeBy cmpFst
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]
maximizeBy c f l = snd $ maximumBy c [(f x,x)| x<- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,k] <- map readInt. B.words <$> B.getLine
    l     <- map (fromIntegral.readInt) . B.words <$> B.getLine
    let (a,b) = solve n k l
    putStrLn $ show a ++" "++show b

solve n k l = snd $ foldl1 g cs
    where
    costs = totalAbsurdity k l
    as  = zip costs [1..]
    bs  = scanl1 g (reverse $ drop k as)
    cs  = zipWith (\(a,ai) (b,bi) -> (a+b,(ai,bi))) (drop k (reverse as)) bs
    f (a,b) (c,d) = case compare a c of
        EQ -> compare d b
        a  -> a
    g a b = case f a b of
        LT -> b
        GT -> a
        EQ -> a

totalAbsurdity :: Int -> [Int64] -> [Int64]
totalAbsurdity k l = go (sum $ take k l) l (drop k l)
    where go a h []          = [a]
          go a (h:hs) (t:ts) =
            let a'   = a-h+t in
                a' `seq` a:go a' hs ts

{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,TypeSynonymInstances #-}

import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = 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)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = maximizeBy cmpFst
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]
maximizeBy c f l = snd $ maximumBy c [(f x,x)| x<- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,k] <- map readInt. B.words <$> B.getLine
    l     <- map readInt . B.words <$> B.getLine
    let (a,b) = solve n k l
    putStrLn $ show a ++" "++show b

solve n k l = snd $ foldl1' g cs
    where
    l' = map toInteger l
    costs = totalAbsurdity k l'
    as = zip costs [1..]
    bs = drop k $ reverse $ scanl1 g $ reverse as
    cs  = zipWith (\(a,ai) (b,bi) -> (a+b,(ai,bi))) as bs
    f (a,b) (c,d) = case compare a c of
        EQ -> compare d b
        a  -> a
    g a b = case f a b of
        LT -> b
        GT -> a
        EQ -> a

totalAbsurdity k l = go (sum (take k l)) l (drop k l) []
    where go a h [] acc = reverse (a:acc)
          go a (h:hs) (t:ts) acc =
            let acc' = a:acc
                a'   = a-h+t
            in
                acc' `seq` a' `seq` go a' hs ts acc'

{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,TypeSynonymInstances #-}

import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.Int
import Data.List
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = 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)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = maximizeBy cmpFst
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]
maximizeBy c f l = snd $ maximumBy c [(f x,x)| x<- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,k] <- map readInt. B.words <$> B.getLine
    l     <- map readInt . B.words <$> B.getLine
    let (a,b) = solve n k l
    putStrLn $ show a ++" "++show b

solve n k l = snd $ foldl1 g (reverse cs)
    where
    l'  = map fromIntegral l
    costs = totalAbsurdity k l'
    as  = zip costs [1..]
    bs  = drop k $ scanr1 g as
    cs  = zipWith (\(a,ai) (b,bi) -> (a+b,(ai,bi))) as bs
    f (a,b) (c,d) = case compare a c of
        EQ -> compare d b
        a  -> a
    g a b = case f a b of
        LT -> b
        GT -> a
        EQ -> a

totalAbsurdity :: Int -> [Int64] -> [Int64]
totalAbsurdity k l = go (sum $ take k l) l (drop k l)
    where go a h []          = [a]
          go a (h:hs) (t:ts) =
            let a'   = a-h+t in
                a' `seq` a:go a' hs ts

{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main :: IO ()
main = do
  [n,k] <- map read.words <$> getLine
  xs <- map (fromIntegral.readInt).B.words <$> B.getLine
  putStr.unwords.map show $ solve n k xs

solve :: Int -> Int -> [Int64] -> [Int]
solve n k xs = snd.foldl1' max' $ zipWith (&) ls rs
   where
     xis = zip (sumK k xs) [1..]
     ls = take (n-2*k+1) xis
     rs = scanr1 max' $ drop k xis
     (x,i) & (y,j) = (x+y,[i,j])

max' :: (Ord a, Ord b) => (a,b) -> (a,b) -> (a,b)
max' xy@(x,_) zw@(z,_)
  | x == z = min xy zw
  | otherwise = max xy zw

sumK :: Int -> [Int64] -> [Int64]
sumK k xs = go (sum ys) ys [] zs
   where
     (ys,zs) = splitAt k xs
     go !acc _ _ [] = [acc]
     go !acc (f:fs) rs (x:xs) = acc : go (acc-f+x) fs (x:rs) xs
     go !acc [] rs xs = go acc (reverse rs) [] xs

import Control.Applicative
import Control.Arrow
import Data.Int
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as BS

readInt64 :: BS.ByteString -> Int64
readInt64 = fromIntegral . readInt

readInt :: BS.ByteString -> Int
readInt bs = case BS.readInt bs of Just (x, _) -> x

maxElem :: [Int64] -> Int
maxElem arr = fromMaybe (-1) $ elemIndex (foldl1 max arr) arr

solve :: [Int64] -> Int -> (Int, Int)
solve arr k =
	let pSum = scanl (+) 0 arr
	    pSeg = zipWith (-) (drop k pSum) pSum
	    afst = maxElem $ zipWith (+) pSeg (drop k $ scanr1 max pSeg)
	    asnd = maxElem $ drop (afst + k) pSeg
	in (1 + afst, 1 + asnd + afst + k)

main =
	do [n, k] <- map readInt . BS.words <$> BS.getLine
	   arr <- map readInt64 . BS.words <$> BS.getLine
	   putStrLn $ show' (solve arr k)
	     where show' (a, b) = show a ++ " " ++ show b


You are given a table consisting of n rows and m columns. Each cell of the table contains a number, 0 or 1. In one move we can choose some row of the table and cyclically shift its values either one cell to the left, or one cell to the right.To cyclically shift a table row one cell to the right means to move the value of each cell, except for the last one, to the right neighboring cell, and to move the value of the last cell to the first cell. A cyclical shift of a row to the left is performed similarly, but in the other direction. For example, if we cyclically shift a row "00110" one cell to the right, we get a row "00011", but if we shift a row "00110" one cell to the left, we get a row "01100".Determine the minimum number of moves needed to make some table column consist only of numbers 1.

The first line contains two space-separated integers: n (1 ≤ n ≤ 100) — the number of rows in the table and m (1 ≤ m ≤ 104) — the number of columns in the table. Then n lines follow, each of them contains m characters "0" or "1": the j-th character of the i-th line describes the contents of the cell in the i-th row and in the j-th column of the table. It is guaranteed that the description of the table contains no other characters besides "0" and "1".

Print a single number: the minimum number of moves needed to get only numbers 1 in some column of the table. If this is impossible, print -1.

NoteIn the first sample one way to achieve the goal with the least number of moves is as follows: cyclically shift the second row to the right once, then shift the third row to the left twice. Then the table column before the last one will contain only 1s.In the second sample one can't shift the rows to get a column containing only 1s.

import Control.Monad
import Data.Array.IO
import Data.Array.Unboxed
import qualified Data.Array.MArray as M
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char

shifts :: ByteString -> IO (Maybe (UArray Int Int))
shifts bs = do
  let n = BS.length bs
  s <- newArray (0,n-1) n :: IO (IOUArray Int Int)
  let i0 = BS.elemIndex '1' bs
      loop k [] = return ()
      loop k (i:rest) = do
        let k' = if BS.index bs i == '1' then 0 else k
        do v <- readArray s i
           if k' < v then writeArray s i k' else return ()
           loop (k'+1) rest
  case BS.elemIndex '1' bs of
    Nothing -> return Nothing
    Just i0 -> do writeArray s i0 0
                  loop 0 $ [i0..n-1] ++ [0..i0-1]
                  loop 0 $ [i0,i0-1..0] ++ [n-1,n-2..i0+1]
                  s' <- M.freeze s :: IO (UArray Int Int)
                  return $ Just s'

trimRight :: ByteString -> ByteString
trimRight bs = BS.take n bs
  where n = find (BS.length bs-1)
        find k | k < 0 = k+1
               | isSpace (BS.index bs k) = find (k-1)
               | otherwise = (k+1)

main = do
  (n:m:_) <- fmap (map read . words) getLine
  rows <- replicateM n (fmap trimRight BS.getLine)
  let loop [] as = return $ Just as
      loop (r:rs) as = do ma <- shifts r
                          case ma of
                             Nothing -> return Nothing
                             Just a -> loop rs (a:as)
  marrays <- loop rows []
  case marrays of
    Nothing   -> putStrLn "-1"
    Just arrs -> let best = minimum [ sum [ a!i | a <- arrs ] | i <- [0..m-1] ]
                 in print best


Two players play a game.Initially there are $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ written on the board. Each turn a player selects one number and erases it from the board. This continues until there is only one number left on the board, i. e. $$$n - 1$$$ turns are made. The first player makes the first move, then players alternate turns.The first player wants to minimize the last number that would be left on the board, while the second player wants to maximize it.You want to know what number will be left on the board after $$$n - 1$$$ turns if both players make optimal moves.

The first line contains one integer $$$n$$$ ($$$1 \le n \le 1000$$$) — the number of numbers on the board. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^6$$$).

Print one number that will be left on the board.

NoteIn the first sample, the first player erases $$$3$$$ and the second erases $$$1$$$. $$$2$$$ is left on the board.In the second sample, $$$2$$$ is left on the board regardless of the actions of the players.

{-# Language BangPatterns, ViewPatterns #-}
import Control.DeepSeq
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Set as Set

main = do
    n <- fmap readInt $ getLine
    ps <- fmap parseInput $ getLine
    putStrLn $ show $ (sort ps) !! ((n-1)`div`2)

parseInput = map readInt . words
readInt x = (read x) :: Int

import Data.List
import Data.List.Split

main = do
    nstr <- getLine
    let n = read nstr :: Int
    line <- getLine
    let ints = map (read::String->Int) $ splitOn " " line
    let sints = sort ints
    putStrLn.show $ sints !! ((n - 1) `div` 2)

import Data.List
import qualified Data.Map as Map

main=do
     a<-getLine
     b<-getLine
     let xs=map read (words b)::[Int]
         ys=sort xs
         l=(length ys)-1
     print $  ys!!(l `div` 2)

import Data.List
main = interact $ show . solve . map read . words
solve (n:as) = sort as !! ((n - 1) `div` 2)

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

main = do
		t<- read <$> getLine ::IO Int
		a<- sort <$> map read <$> words <$> getLine::IO [Int]
		print $ if odd t then a!!(div t 2) else a!!((div t 2)-1)

import Data.List

main :: IO ()
main = do
  n <- getLine
  a <- getLine
  print $ w $ sort $ map read $ words a
  where
    w :: [Int] -> Int
    w a = a !! ((length a - 1) `quot` 2)

--ghc 7.10

import Data.List(sort)

midNumber :: (Ord a) => [a] -> a
midNumber xs = (!! ((length xs - 1) `div` 2)) . sort $ xs

main = do
    nStr <- getLine
    aStrs <- getLine
    let a = map read . words $ aStrs :: [Int]
    print $ midNumber a

import Data.List
import Data.List.Split

main = do
    nstr <- getLine
    let n = read nstr :: Int
    line <- getLine
    let ints = map (read::String->Int) $ splitOn " " line
    --print ints
    putStrLn.show $ (ints!!(div n 2))

import Data.List
import Data.List.Split

main = do
    nstr <- getLine
    let n = read nstr :: Int
    line <- getLine
    let ints = map (read::String->Int) $ splitOn " " line
    --print ints
    putStrLn.show $ ((sort ints)!!(div n 2))

import Data.List
import Data.List.Split

main = do
    nstr <- getLine
    let n = read nstr :: Int
    line <- getLine
    let ints = map (read::String->Int) $ splitOn " " line
    --print ints
    putStrLn.show $ (sort ints)!! (n - 1) `div` 2

--ghc 7.10

import Data.List(sort)

midNumber :: (Ord a) => [a] -> a
midNumber xs = (!! ((length xs) `div` 2)) . sort $ xs

main = do
    nStr <- getLine
    aStrs <- getLine
    let a = map read . words $ aStrs :: [Int]
    print $ midNumber a