Andrewid the Android is a galaxy-famous detective. In his free time he likes to think about strings containing zeros and ones.Once he thought about a string of length n consisting of zeroes and ones. Consider the following operation: we choose any two adjacent positions in the string, and if one them contains 0, and the other contains 1, then we are allowed to remove these two digits from the string, obtaining a string of length n - 2 as a result.Now Andreid thinks about what is the minimum length of the string that can remain after applying the described operation several times (possibly, zero)? Help him to calculate this number.

First line of the input contains a single integer n (1 ≤ n ≤ 2·105), the length of the string that Andreid has. The second line contains the string of length n consisting only from zeros and ones.

Output the minimum length of the string that may remain after applying the described operations several times.

NoteIn the first sample test it is possible to change the string like the following: .In the second sample test it is possible to change the string like the following: .In the third sample test it is possible to change the string like the following: .

main :: IO()
main = print . solve . head . tail . words =<< getContents

solve :: String -> Int
solve s = solve' s [] 0

solve' :: String -> [Char] -> Int -> Int
solve' []     _      num = num
solve' (c:cs) []     0   = solve' cs [c] 1
solve' (c:cs) (s:ss) num | c == s    = solve' cs (c:s:ss) (num+1)
                         | otherwise = solve' cs ss (num-1)

module Main where

toInt :: String -> Int
toInt s = read s :: Int

toIntList :: String -> [Int]
toIntList s = map toInt $ words s

readInt :: IO Int
readInt = fmap toInt getLine

readIntPair :: IO (Int, Int)
readIntPair = do
  (x:y:[]) <- fmap (map toInt . words) getLine
  return (x, y)

readIntList :: IO [Int]
readIntList = fmap (map toInt . words) getLine

readNStrings :: Int -> IO [String]
readNStrings n = sequence $ replicate n getLine

readNIntLists :: Int -> IO [[Int]]
readNIntLists n = fmap (map (\s -> toIntList s)) (readNStrings n)

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

process :: Char -> [Char] -> [Char]
process '0' ('1':xs) = xs
process '1' ('0':xs) = xs
process x xs = x:xs

main = do
  n <- getLine
  s <- getLine
  let r = foldr process [] s
  print $ length r

-- http://codeforces.com/problemset/problem/556A.hs

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

reduceString :: String -> String
reduceString str = reduceString' [] str
	where
		reduceString' acum [] = reverse acum
		reduceString' acum (x:[]) = reverse $ (x:acum)
		reduceString' [] (x:xs)
			| x /= head xs = reduceString' [] (tail xs)
			| otherwise = reduceString' [x] xs
		reduceString' acum (x:xs)
			| x /= head xs = reduceString' (tail acum) (head acum : tail xs)
			| otherwise = reduceString' (x:acum) xs

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

main = do

	_ <- getLine
	str <- getLine

	let
		reduced = reduceString str

	putStrLn $ show $ length reduced

main = do
  getLine
  s <- getLine
  let
    c1 = length $ filter (== '1') s
    c2 = length $ filter (== '0') s

  print $ abs $ c1-c2

main = getContents >>= putStrLn . show . solve . last . words

solve :: String -> Int
solve cs = n - 2 * min p q
    where n = length cs
          p = length $ filter (== '0') cs
          q = length $ filter (== '1') cs

module Main where

import Control.Applicative
import Control.Monad
import Data.Char           (toLower)
import Data.List           (intersperse)
import System.IO

solve :: String -> String
solve str = show $ abs $ count '0' str - count '1' str
    where count ch = length . filter (==ch)

main :: IO ()
main = do
    hSetBuffering stdin $ BlockBuffering Nothing
    hSetBuffering stdout $ BlockBuffering Nothing
    getLine
    str <- getLine
    putStrLn $ solve str

answer::[Char] -> Int
answer a = abs ((length (filter (=='0') a)) - (length (filter (=='1') a)))
main = do
  w0 <- getLine
  w1 <- getLine
  print $ answer w1

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine >>= \a->solve =<< (map (fst.fromJust.C.readInt).C.words.C.intersperse ' '<$>C.getLine)
solve xs = print $ abs $ foldr (\a b-> if a>0 then 1+b else b-1) 0 xs

remove01 [] bs = length bs
remove01 ('1':'0':as) []  = remove01 as []
remove01 ('1':'0':as) (b:bs)  = remove01 (b:as) bs
remove01 ('0':'1':as) []  = remove01 as []
remove01 ('0':'1':as) (b:bs)  = remove01 (b:as) bs
remove01 (a:as) bs  = remove01 as (a:bs)

main = getLine >> getLine >>= print . (\x -> remove01 x [] )

-- Codeforces 556A

-- Hint: If there still exist at least one 0 and at least one 1 in the string
-- then there obviously exists either substring 01 or substring 10 (or both)
-- and we can remove it.
-- The order in which we remove substrings is unimportant: in any case we will
-- make min(#zeros, #ones) such operations.
-- Thus the answer is #ones + #zeros - 2min(#ones, #zeros) = |#ones - #zeros|.

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    getLine >>= print . abs . solve where
        solve xs = (length $ filter (== '1') xs) - (length $ filter (== '0') xs)

apply_operation :: [Char] -> [Char]
apply_operation [] = []
apply_operation (x:xs)
    | null rest = [x]
    | x == (head rest) = (x:rest)
    | otherwise = tail rest
    where rest = apply_operation xs

main :: IO()
main = do _ <- getLine
          bitstring <- getLine
          print (length $ apply_operation bitstring)

apply_operation :: [Char] -> [Char]
apply_operation bitstring = foldr loop "" bitstring
    where loop y "" = [y]
          loop y (x:xs)
              | x == y = y:(x:xs)
              | otherwise = xs

main :: IO()
main = do _ <- getLine
          bitstring <- getLine
          print (length $ apply_operation bitstring)

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

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

main = interact solve
solve input =
  let aswords = words input
      n:p:_ = aswords
  in show . solve' $ p

solve' :: String -> Int
solve' = length . reducedStr
  where
    reducedStr :: String -> String
    reducedStr "" = ""
    reducedStr "1" = "1"
    reducedStr "0" = "0"
    reducedStr str
      | reduced == "" = f:[]
      | f == f' = f:reduced
      | otherwise = rest'
      where (f:rest) = str
            reduced = reducedStr rest
            (f':rest') = reduced

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

--process::C.ByteString->C.ByteString

--process q       | C.null q = C.empty
--                | C.length q ==1 = q
--                | C.take 2 q==(C.pack "10") = process (C.drop 2 q)
--                | C.take 2 q ==(C.pack "01") = process (C.drop 2 q)
--                | otherwise = C.cons (C.head q ) ( process (C.tail q))

--myfix::(C.ByteString->C.ByteString)->C.ByteString->C.ByteString
--myfix f q | q==qq = q
--          | otherwise = myfix f (f q)
--  where qq = f q
process::Int->String->String->Int
process n st re | re==[] = n
                | st ==[] = process n [(head re)] (tail re)
                | head st /= head re = process (n-2) (tail st) (tail re)
                | otherwise = process n ((head re):st) (tail re)
main=do
    n<-read <$> getLine ::IO Int
    q<-  C.unpack <$> C.take n <$> C.getLine
    print $   process n []   q

import Control.Applicative ((*>), (<$>))
import Control.Arrow ((&&&))
import Data.Function (on)

main :: IO ()
main = print =<< solve <$> (getLine *> getLine)

solve :: String -> Int
solve = abs . uncurry ((-) `on` length) . (filter (=='1') &&& filter (=='0'))

import Data.List (partition)
main = getLine >> getLine >>= print . solve
solve s = abs (length a - length b) where (a,b) = partition (== '1') s

f :: String -> Int
f s = abs $ ones - zeros
    where ones = length $ filter (=='1') s
          zeros = length s - ones

main = getLine >> getLine >>= print . f

xsolve ""  = ""
xsolve [a] = [a]
xsolve (a:rest) =
    if null rest' then [a]
    else if a /= head rest' then tail rest'
    else a:rest'
    where rest' = xsolve rest

main = do
    _ <- getLine
    line <- getLine
    (print . length . xsolve) line

probA line = foldr loop "" line
    where
        loop a "" = [a]
        loop a (b:rest)
            | a /= b = rest
            | otherwise = a:(b:rest)

main = do
    _ <- getLine
    line <- getLine
    (print . length . probA) line

solve :: String -> Int
solve ns = abs ((length $ filter (=='0') ns) - (length $ filter (=='1') ns))

main :: IO ()
main = do
  getLine
  getLine >>= print . solve

solve :: String -> Int
solve = solveHelper [] where
    solveHelper [] [] = 0
    solveHelper [] (y:ys) = solveHelper [y] ys
    solveHelper xs [] = length xs
    solveHelper (x:xs) (y:ys)
        | x == y = solveHelper (y:(x:xs)) ys
        | otherwise = solveHelper xs ys

main = do
    n <- getLine
    s <- getLine
    putStrLn $ show $ solve s

import Control.Applicative

count' _ [] = 0
count' n (x:xs)
    | n == x = 1 + count' n xs
    | otherwise = count' n xs

main = do
    n <- read <$> getLine
    n1 <- count' '1' <$> getLine
    let n0 = n - n1
    print $ n - 2 * (n0 `min` n1)

module Main where

count _ [] = 0
count c (a:as) =
    (if a == c then 1 else 0) + count c as

main = do
    _ <- getLine
    s <- getLine
    print $ abs (count '0' s - count '1' s)

import Control.Applicative
import Data.List

main=do
	n<- read <$> getLine ::IO Int
	a<-   getLine
	let b1= length $ filter (=='1') a
	print $ abs ((n-b1)-b1)

ans [] = 0
ans (x:xs) = if x == '0' then ans xs + 1
                     else ans xs - 1

main = do
    numInputs <- getLine
    digs <- getLine
    print(abs(ans digs))

{-# LANGUAGE BangPatterns #-}

import Data.List (foldl')

parse :: String -> String
parse contents = s where [_, s] = lines contents

solve :: String -> Int
solve = length . foldl' step []
        where step []       !a = [a]
              step (s : ss) !a
                | s /= a    = ss
                | otherwise = a : s : ss

main :: IO ()
main = print . solve . parse =<< getContents

import Data.List (partition)

process :: [Char] -> Int
process s = abs ((length s1)-(length s0))
    where
        (s0,s1) = partition (=='0') s

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    s <- getLine
    print $ process s

main :: IO ()
main = interact $ show . solve . head .tail.lines

solve :: String -> Int
solve xs = abs $ (-) (length . filter (=='1') $ xs) (length . filter (=='0') $ xs)

module Main where

import Data.Char

--foo :: String -> Int
finds n m = length $ filter (== m) n

main = do
  n <- getLine
  s <- getLine
  let p = (finds s '1')
  let q = (finds s '0')
  print (if p >= q then p-q else q-p)

main = getContents >>= putStrLn . show . solve . last . words

solve :: String -> Int
solve cs = n - min p q
    where n = length cs
          p = length $ filter (== '0') cs
          q = length $ filter (== '1') cs

minRemain :: [Char] -> Int
minRemain [] = 0
minRemain (x:[]) = 0
minRemain (x:xs)
    | x == snd = 2 + (minRemain $ tail xs)
    | otherwise = minRemain $ tail xs
    where snd = head xs

main :: IO()
main = do len <- getLine
          str <- getLine
          print $ minRemain str

import Control.Applicative
import Data.List

process [] = []
process [x] = [x]
process (a:b:cs)| a=='0' && b=='1' = process cs
                | a=='1' && b=='0' = process cs
                | otherwise = a: ( process (b:cs) )

main=do
    n<-getLine
    q<-   getLine
    print $ length $ process q

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

process::C.ByteString->C.ByteString

process q       | C.null q = C.empty
                | C.length q ==1 = q
                | C.take 2 q==(C.pack "10") = process (C.drop 2 q)
                | C.take 2 q ==(C.pack "01") = process (C.drop 2 q)
                | otherwise = C.cons (C.head q ) ( process (C.tail q))

myfix::(C.ByteString->C.ByteString)->C.ByteString->C.ByteString
myfix f q | q==qq = q
          | otherwise = myfix f (f q)
  where qq = f q

main=do
    n<-getLine
    q<-  C.getLine
    print $ C.length $ myfix process q

import Control.Applicative
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as C
process q | qql>1 = process (concat qq)
          | qqql>1 = process ( concat qqq)
          | otherwise = q

  where qq = splitOn "01" q
        qql = length qq
        qqq = splitOn "10" q
        qqql = length qqq

main=do
    n<-getLine
    q<- C.getLine
    print $ length $ process (C.unpack q)

import Control.Applicative
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as C
process q | qql>1 = process (concat qq)
          | qqql>1 = process ( concat qqq)
          | otherwise = q

  where qq = splitOn "01" q
        qql = length qq
        qqq = splitOn "10" q
        qqql = length qqq

myfix f q | q==qq = q
          | otherwise = myfix f (f q)
  where qq = f q

main=do
    n<-getLine
    q<- C.getLine
    print $ length $ process (C.unpack q)

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

process::C.ByteString->C.ByteString

process q       | C.null q = C.empty
                | C.length q ==1 = q
                | C.take 2 q==(C.pack "10") = process (C.drop 2 q)
                | C.take 2 q ==(C.pack "01") = process (C.drop 2 q)
                | otherwise = C.cons (C.head q ) ( process (C.tail q))

myfix::(C.ByteString->C.ByteString)->C.ByteString->C.ByteString
myfix f q | q==qq = q
          | otherwise = myfix f (f q)
  where qq = f q

main=do
    n<-getLine
    q<-  C.getContents
    print $ C.length $ myfix process q

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

process [] =[]
process [q] = [q]
process (a:b:c) | a=='1' && b=='0' = process c
                | a=='0' && b=='1' = process c
                | otherwise = a:(process (b:c))

myfix f q | q==qq = q
          | otherwise = myfix f (f q)
  where qq = f q

main=do
    n<-getLine
    q<-  C.getLine
    let q1 = C.unpack q
    print $ length $ myfix process  q1

import Data.List (group)
main = getLine >> getLine >>= print . solve . map length . group
solve [] = 0
solve [x] = x
solve s = solve $ reduce $ step s
step (a:b:c) = a-m : b-m : step c where m = min a b
step c = c
reduce (0:a) = reduce a
reduce (a:0:b:c) = a+b : reduce c
reduce (a:b) = a : reduce b
reduce [] = []

main :: IO ()
main = interact $ show . solve

solve :: String -> Int
solve (_:xs) = abs $ (-) (length . filter (=='1') $ xs) (length . filter (=='0') $ xs)

main :: IO ()
main = interact $ show . solve

solve :: String -> Int
solve xs = abs $ (-) (length . filter (=='1') $ xs) (length . filter (=='0') $ xs)


Caisa solved the problem with the sugar and now he is on the way back to home. Caisa is playing a mobile game during his path. There are (n + 1) pylons numbered from 0 to n in this game. The pylon with number 0 has zero height, the pylon with number i (i > 0) has height hi. The goal of the game is to reach n-th pylon, and the only move the player can do is to jump from the current pylon (let's denote its number as k) to the next one (its number will be k + 1). When the player have made such a move, its energy increases by hk - hk + 1 (if this value is negative the player loses energy). The player must have non-negative amount of energy at any moment of the time. Initially Caisa stand at 0 pylon and has 0 energy. The game provides a special opportunity: one can pay a single dollar and increase the height of anyone pylon by one. Caisa may use that opportunity several times, but he doesn't want to spend too much money. What is the minimal amount of money he must paid to reach the goal of the game?

The first line contains integer n (1 ≤ n ≤ 105). The next line contains n integers h1, h2, ..., hn (1  ≤  hi  ≤  105) representing the heights of the pylons.

Print a single number representing the minimum number of dollars paid by Caisa.

NoteIn the first sample he can pay 4 dollars and increase the height of pylon with number 0 by 4 units. Then he can safely pass to the last pylon.

main :: IO ()
main = getContents >>= print . maximum . map (read :: String -> Integer) . tail . words

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

solve :: [Integer] -> Integer
solve (_:hs) = maximum hs
solve _ = undefined

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

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

solve :: [Int] -> Int
solve (_:hs) = maximum hs
solve _ = undefined

{-# LANGUAGE TypeApplications #-}
main = interact $ show @Int . maximum . map read . tail . words

main = do
  getLine
  getLine >>= print. maximum. map (fromIntegral.read) . words

main = interact $ show . maximum . map (read::String -> Int) . drop 1 . words

solve :: [Integer] -> Integer -> Integer
solve [x] power = 0
solve (x:y:xs) power = if delta > power then ((delta - power) + solve (y:xs) 0) else solve (y:xs) (power - delta)
	where delta = y - x

main = do
	getLine
	input <- getLine
	putStr $ show $ max 0 (solve (0:(map read $ words input :: [Integer])) 0)

main=interact$show.f.g.(0:).map read.tail.words
g (x:y:[]) = [x-y]
g (x:y:xs) = x-y:g(y:xs)

f (x:[])
  | x < 0 = negate x
  | otherwise = 0
f (x:xs)
  | x < 0 = negate x + f xs
  | otherwise = f (((head xs)+x):(tail xs))

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

solve :: [Integer] -> Integer
solve h = solve' h 0 0
    where
        solve' :: [Integer] -> Integer -> Integer -> Integer
        solve' []     _     _      = 0
        solve' (h:hs) lastH energy | energy + lastH - h < 0 = h - energy - lastH + (solve' hs h 0)
                                   | otherwise              = solve' hs h (energy + lastH - h)

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . getAns . getIntArray

getAns :: [Int] -> Int
getAns (n:xs) = negate $ calMax xs 0 0

calMax :: [Int] -> Int -> Int -> Int
calMax [] _ _ = 0
calMax (x:xs) e p = let ne = e + p - x;
					  in min ne $ calMax xs ne x

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . getAns . getIntArray

getAns :: [Int] -> Int
getAns (n:xs) = maximum xs

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . maximum . tail . getIntArray

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

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

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

main = do
  getLine
  xs <- getInts

  let
    (_, s) = foldl (\(c, s) x -> let c' = c+x in if c' >= 0 then (c', s) else (0, s-c')) (0, 0) $ zipWith (-) (0:xs) $ xs

  print s

main = interact $ (show :: Int -> [Char]) . maximum . map read . tail . words

import Control.Applicative
main = do
		n <- getLine
		p <- (map read . words <$> getLine) :: IO [Int]
		print $ maximum p

-- Codeforces 463B

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

solve :: [Int] -> Int
solve = fst . foldl (
    \(m, (e, h)) b -> if (e < b-h)
        then (m+(b-h-e), (0, b))
        else (m, (e-(b-h), b)))
    (0, (0, 0))

import Control.Applicative
import Data.List

main::IO ()
main=do
    n<- read <$> getLine::IO Int
    a1<- maximum <$>  map read <$>   words   <$> getLine:: IO Int
    print a1

main=interact$show.f.(0:).map read.tail.words
f (x:y:[]) = y-x
f (x:y:xs)
  | x - y < 0 = y-x + f (y:xs)
  | otherwise = f(x:xs)

main=interact$show.negate.minimum.g.(0:).map read.tail.words
g (x:y:[]) = [x-y]
g (x:y:xs) = x-y:g(y:xs)


We guessed some integer number $$$x$$$. You are given a list of almost all its divisors. Almost all means that there are all divisors except $$$1$$$ and $$$x$$$ in the list.Your task is to find the minimum possible integer $$$x$$$ that can be the guessed number, or say that the input data is contradictory and it is impossible to find such number.You have to answer $$$t$$$ independent queries.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 25$$$) — the number of queries. Then $$$t$$$ queries follow. The first line of the query contains one integer $$$n$$$ ($$$1 \le n \le 300$$$) — the number of divisors in the list. The second line of the query contains $$$n$$$ integers $$$d_1, d_2, \dots, d_n$$$ ($$$2 \le d_i \le 10^6$$$), where $$$d_i$$$ is the $$$i$$$-th divisor of the guessed number. It is guaranteed that all values $$$d_i$$$ are distinct.

For each query print the answer to it. If the input data in the query is contradictory and it is impossible to find such number $$$x$$$ that the given list of divisors is the list of almost all its divisors, print -1. Otherwise print the minimum possible $$$x$$$.

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

type SieveArray = UA.UArray Int Int
sieveArray :: Int -> SieveArray

sa, pf :: SieveArray

sa = sieveArray 1000005
pf = primeFactorizationArray sa

sieveArray n = runSTUArray $ do
  a <- newListArray (0, n) [if odd x then x else 2 | x <- [0 .. n]]
  forM_ (takeWhile (\p -> p * p <= n) [3, 5 ..]) $ \p -> do
    l <- readArray a p
    when (l == p) $
      forM_ (takeWhile ( <= n) [p * p, (p + 2) * p ..]) $ \ !o -> do
        k <- readArray a o
        when (k == o) $ writeArray a o p
  return a

primeFactorizationArray :: SieveArray -> SieveArray
primeFactorizationArray p = runSTUArray $ do
  let (_, !n) = UA.bounds p
  c <- newArray_ (0, 2 * n + 1)
  forM_ [2 .. n] $ \i -> do
    let !k = p UA.! i
        !j = i `div` k
        !i2 = 2 * i
    if (p UA.! j) == k then do
      let !j2 = 2 * j
      cj <- readArray c j2
      writeArray c i2 $! succ cj
      nj <- readArray c $! succ j2
      writeArray c (succ i2) nj
    else do
      writeArray c i2 1
      writeArray c (succ i2) j
  return c

factors :: SieveArray -> SieveArray -> Int -> [(Int, Int)]
factors _ _ 1 = []
factors sa pfa !n = (sa UA.! n, pfa UA.! i2) : (factors sa pfa $ pfa UA.! (succ i2))
  where
    !i2 = 2 * n

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

ru, ri :: C.ByteString -> Int

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

sNo = intDec (-1)

test :: Int -> [Int] -> Builder
test !n b
  | t /= toInteger (n + 2) || x == (toInteger $! maximum b) = sNo
  | True = integerDec x
  where
    m = IM.fromListWith max $ concatMap (factors sa pf) b
    m' = IM.toList m
    t0 = product $ map (toInteger . succ . snd) m'
    x0 = product $ map (\ (i, j) -> (toInteger i) ^ j) m'
    (t, x) = if length m == 1 then (succ t0, x0 * (toInteger $ fst $ head m')) else (t0, x0)

solve :: Builder -> Int -> [Int] -> Builder
solve buf 0 _ = buf
solve buf !nt (n:a) = solve (buf <> test n b <> char7 '\n') (pred nt) t
  where
    (b, t) = splitAt n a

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

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

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

type SieveArray = UA.UArray Int Int
sieveArray :: Int -> SieveArray

sa, pf :: SieveArray

sa = sieveArray 1000005
pf = primeFactorizationArray sa

sieveArray n = runSTUArray $ do
  a <- newListArray (0, n) [if odd x then x else 2 | x <- [0 .. n]]
  forM_ (takeWhile (\p -> p * p <= n) [3, 5 ..]) $ \p -> do
    l <- readArray a p
    when (l == p) $
      forM_ (takeWhile ( <= n) [p * p, (p + 2) * p ..]) $ \ !o -> do
        k <- readArray a o
        when (k == o) $ writeArray a o p
  return a

primeFactorizationArray :: SieveArray -> SieveArray
primeFactorizationArray p = runSTUArray $ do
  let (_, !n) = UA.bounds p
  c <- newArray_ (0, 2 * n + 1)
  forM_ [2 .. n] $ \i -> do
    let !k = p UA.! i
        !j = i `div` k
        !i2 = 2 * i
    if (p UA.! j) == k then do
      let !j2 = 2 * j
      cj <- readArray c j2
      writeArray c i2 $! succ cj
      nj <- readArray c $! succ j2
      writeArray c (succ i2) nj
    else do
      writeArray c i2 1
      writeArray c (succ i2) j
  return c

factors :: SieveArray -> SieveArray -> Int -> [(Int, Int)]
factors _ _ 1 = []
factors sa pfa !n = (sa UA.! n, pfa UA.! i2) : (factors sa pfa $ pfa UA.! (succ i2))
  where
    !i2 = 2 * n

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

ru, ri :: C.ByteString -> Int

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

sNo = intDec (-1)

test :: Int -> [Int] -> Builder
test !n b
  | t /= toInteger (n + 2) = sNo
  | True = integerDec x
  where
    m = IM.fromListWith max $ concatMap (factors sa pf) b
    m' = IM.toList m
    t0 = product $ map (toInteger . succ . snd) m'
    x0 = product $ map (\ (i, j) -> (toInteger i) ^ j) m'
    (t, x) = if length m == 1 then (succ t0, x0 * (toInteger $ fst $ head m')) else (t0, x0)

solve :: Builder -> Int -> [Int] -> Builder
solve buf 0 _ = buf
solve buf !nt (n:a) = solve (buf <> test n b <> char7 '\n') (pred nt) t
  where
    (b, t) = splitAt n a

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

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


The store sells $$$n$$$ items, the price of the $$$i$$$-th item is $$$p_i$$$. The store's management is going to hold a promotion: if a customer purchases at least $$$x$$$ items, $$$y$$$ cheapest of them are free.The management has not yet decided on the exact values of $$$x$$$ and $$$y$$$. Therefore, they ask you to process $$$q$$$ queries: for the given values of $$$x$$$ and $$$y$$$, determine the maximum total value of items received for free, if a customer makes one purchase.Note that all queries are independent; they don't affect the store's stock.

The first line contains two integers $$$n$$$ and $$$q$$$ ($$$1 \le n, q \le 2 \cdot 10^5$$$) — the number of items in the store and the number of queries, respectively. The second line contains $$$n$$$ integers $$$p_1, p_2, \dots, p_n$$$ ($$$1 \le p_i \le 10^6$$$), where $$$p_i$$$ — the price of the $$$i$$$-th item. The following $$$q$$$ lines contain two integers $$$x_i$$$ and $$$y_i$$$ each ($$$1 \le y_i \le x_i \le n$$$) — the values of the parameters $$$x$$$ and $$$y$$$ in the $$$i$$$-th query.

For each query, print a single integer — the maximum total value of items received for free for one purchase.

NoteIn the first query, a customer can buy three items worth $$$5, 3, 5$$$, the two cheapest of them are $$$3 + 5 = 8$$$.In the second query, a customer can buy two items worth $$$5$$$ and $$$5$$$, the cheapest of them is $$$5$$$.In the third query, a customer has to buy all the items to receive the three cheapest of them for free; their total price is $$$1 + 2 + 3 = 6$$$.

-- ID : 1697B (Promo)
-- URL: https://codeforces.com/problemset/problem/1697/B

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

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

main = do
    [n,q] <- getIntsSlow
    ps0 <- getInt64s
    let ps = sortBy (\a b -> compare b a) ps0
    let subsumTable = listArray (0,n) (scanl (+) 0 ps) :: Array Int Int64
    --print subsumTable
    replicateM_ q $ do
        [x,y] <- getInt64s
        let answer = (subsumTable ! (fromIntegral x)) - (subsumTable ! (fromIntegral (x-y)))
        print answer

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

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

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

data TC = TC { n :: Int, q :: Int, ps :: [Int], qs :: [(Int, Int)]}
type Output = [Int]

input :: Scanner TC
input = do
  n <- int
  q <- int
  ps <- n >< int
  qs <- q >< pair int int
  return TC {..}

solve :: TC -> Output
solve TC {..} = map calc qs
  where
    pre = listArray (0, n) . scanl (+) 0 . reverse . sort $ ps
    calc (x, y) = pre ! x - pre ! (x - y)

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

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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


Gardener Alex loves to grow trees. We remind that tree is a connected acyclic graph on $$$n$$$ vertices. Today he decided to grow a rooted binary tree. A binary tree is a tree where any vertex has no more than two sons. Luckily, Alex has a permutation of numbers from $$$1$$$ to $$$n$$$ which he was presented at his last birthday, so he decided to grow a tree according to this permutation. To do so he does the following process: he finds a minimum element and makes it a root of the tree. After that permutation is divided into two parts: everything that is to the left of the minimum element, and everything that is to the right. The minimum element on the left part becomes the left son of the root, and the minimum element on the right part becomes the right son of the root. After that, this process is repeated recursively on both parts.Now Alex wants to grow a forest of trees: one tree for each cyclic shift of the permutation. He is interested in what cyclic shift gives the tree of minimum depth. Unfortunately, growing a forest is a hard and long process, but Alex wants the answer right now. Will you help him?We remind that cyclic shift of permutation $$$a_1, a_2, \ldots, a_k, \ldots, a_n$$$ for $$$k$$$ elements to the left is the permutation $$$a_{k + 1}, a_{k + 2}, \ldots, a_n, a_1, a_2, \ldots, a_k$$$.

First line contains an integer number $$$n ~ (1 \leqslant n \leqslant 200\,000)$$$ — length of the permutation. Second line contains $$$n$$$ integer numbers $$$a_1, a_2, \ldots, a_n ~ (1 \leqslant a_i \leqslant n)$$$, and it is guaranteed that all numbers occur exactly one time.

Print two numbers separated with space: minimum possible depth of a tree and how many elements we need to shift left to achieve this depth. The number of elements should be a number from $$$0$$$ to $$$n - 1$$$. If there are several possible answers, print any of them.

NoteThe following picture depicts all possible trees for sample test and cyclic shifts on which they are achieved.

import Data.List

one (a, b) c = (m+1, (c, 1+(foldl max 0 $m:map snd p)):q) where (p, q) = break ((c,0)>) b; m = a-(length p)

gls = scanl (\a (_,(x:s))->max a $snd x) 0 . tail . scanl one (0,[])

slv x =(m+1,o) where Just o = elemIndex m l; l = zipWith max (gls x) $reverse $ gls $ reverse x; m = foldl1 min l;

ot x n = [a,(1+o+b)`mod`n] where (a,b)=(slv . take (n - 1) . tail. snd . break (1==) $x++x); Just o = elemIndex 1 x

main=do
 st1<-getLine
 st2<-getLine
 let n = (read st1)::Int
 let arr = map read $ words st2 :: [Int]
 putStrLn $intercalate " " $ map show (ot arr n)

import Data.List

one :: (Int, [(Int, Int)])->Int->(Int, [(Int, Int)])
one (a, b) c = (m+1, (c, 1+(foldl max 0 $m:map snd p)):q) where (p, q) = break ((c,0)>) b; m = a-(length p)

gls :: [Int]->[Int]
gls = scanl (\a (_,(x:s))->max a $snd x) 0 . tail . scanl one (0,[])

slv :: [Int]->(Int, Int)
slv x =(m+1,o) where Just o = elemIndex m l; l = zipWith max (gls x) $reverse $ gls $ reverse x; m = foldl1 min l;

ot :: [Int]->Int->[Int]
ot x n = [a,(1+o+b)`mod`n] where (a,b)=(slv . take (n - 1) . tail. snd . break (1==) $x++x); Just o = elemIndex 1 x

main=do
 st1<-getLine
 st2<-getLine
 let n = (read st1)::Int
 let arr = map read $ words st2 :: [Int]
 putStrLn $intercalate " " $ map show (ot arr n)


Innokentiy likes tea very much and today he wants to drink exactly n cups of tea. He would be happy to drink more but he had exactly n tea bags, a of them are green and b are black.Innokentiy doesn't like to drink the same tea (green or black) more than k times in a row. Your task is to determine the order of brewing tea bags so that Innokentiy will be able to drink n cups of tea, without drinking the same tea more than k times in a row, or to inform that it is impossible. Each tea bag has to be used exactly once.

The first line contains four integers n, k, a and b (1 ≤ k ≤ n ≤ 105, 0 ≤ a, b ≤ n) — the number of cups of tea Innokentiy wants to drink, the maximum number of cups of same tea he can drink in a row, the number of tea bags of green and black tea. It is guaranteed that a + b = n.

If it is impossible to drink n cups of tea, print "NO" (without quotes). Otherwise, print the string of the length n, which consists of characters 'G' and 'B'. If some character equals 'G', then the corresponding cup of tea should be green. If some character equals 'B', then the corresponding cup of tea should be black. If there are multiple answers, print any of them.

main=getLine>>=putStrLn.f.map read.words
f[_,k,a,b]
  | a <= b, div (b + a) (a + 1) > k = "NO"
  | a <= b, (q, r) <- divMod b (a + 1) = merge (g 'B' q r a b) (h 'G' a)
  | b <= a, div (a + b) (b + 1) > k = "NO"
  | b <= a, (q, r) <- divMod a (b + 1) = merge (g 'G' q r b a) (h 'B' b)
g c q 0 low high = replicate (low + 1) (replicate q c)
g c q r low high = replicate r (replicate (q + 1) c) ++ replicate (low + 1 - r) (replicate q c)
h c low = replicate low [c]

merge (xs:xss) (ys:yss) = xs ++ ys ++ merge xss yss
merge [xs] _ = xs
merge _ _ = ""

main=getLine>>=putStrLn.f.map read.words
f[_,k,a,b]
  | a <= b, div b (a + 1) > k = "NO"
  | a <= b, (q, r) <- divMod b (a + 1) = merge (g 'B' q r a b) (h 'G' a)
  | b <= a, div a (b + 1) > k = "NO"
  | b <= a, (q, r) <- divMod a (b + 1) = merge (g 'G' q r b a) (h 'B' b)
g c q 0 low high = replicate (low + 1) (replicate q c)
g c q r low high = replicate r (replicate (q + 1) c) ++ replicate (low + 1 - r) (replicate q c)
h c low = replicate low [c]

merge (xs:xss) (ys:yss) = xs ++ ys ++ merge xss yss
merge [xs] _ = xs
merge _ _ = ""


You are given two polynomials:  P(x) = a0·xn + a1·xn - 1 + ... + an - 1·x + an and  Q(x) = b0·xm + b1·xm - 1 + ... + bm - 1·x + bm.  Calculate limit .

The first line contains two space-separated integers n and m (0 ≤ n, m ≤ 100) — degrees of polynomials P(x) and Q(x) correspondingly. The second line contains n + 1 space-separated integers — the factors of polynomial P(x): a0, a1, ..., an - 1, an ( - 100 ≤ ai ≤ 100, a0 ≠ 0). The third line contains m + 1 space-separated integers — the factors of polynomial Q(x): b0, b1, ..., bm - 1, bm ( - 100 ≤ bi ≤ 100, b0 ≠ 0).

If the limit equals  + ∞, print "Infinity" (without quotes). If the limit equals  - ∞, print "-Infinity" (without the quotes). If the value of the limit equals zero, print "0/1" (without the quotes). Otherwise, print an irreducible fraction — the value of limit , in the format "p/q" (without the quotes), where p is the — numerator, q (q > 0) is the denominator of the fraction.

NoteLet's consider all samples:           You can learn more about the definition and properties of limits if you follow the link: http://en.wikipedia.org/wiki/Limit_of_a_function

import Data.List

getNumerator :: Int -> Int -> Int
getNumerator a b
	| b > 0 = div a (gcd a b)
	| otherwise =  div (0 - a) (gcd a b)

getDenominator :: Int -> Int -> Int
getDenominator a b
	| b > 0 = div b (gcd a b)
	| otherwise = div (0 - b) (gcd a b)

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	str3 <- getLine
	let num = words str1
	let a0  = read ((words str2) !! 0)
	let b0  = read ((words str3) !! 0)
	let n = read (num !! 0)
	let m = read (num !! 1)
	if ((m - n) > 0)
		then putStrLn "0/1"
		else if (n > m)
			then if (a0 * b0 > 0)
				then putStrLn "Infinity"
				else putStrLn "-Infinity"
			else putStrLn (show (getNumerator a0 b0) ++ "/" ++ show (getDenominator a0 b0))

-- -*- compile-command: "ghc --make -O limit.hs" -*-

import System.IO
import Data.List
import Data.Char
import qualified Data.ByteString.Lazy as B

limit :: Int -> Int -> Int -> Int -> String
limit n m a b
  | m > n = "0/1"
  | n > m && a*b > 0 = "Infinity"
  | n > m = "-Infinity"
   | otherwise = (show $ c `div` ggt) ++ "/" ++ (show $ d `div` ggt)
       where ggt = gcd a b
             (c,d) = if a*b > 0
                     then (abs a, abs b)
                     else (negate $ abs a, abs b)

readInts :: String -> [Int]
readInts = (map read) . words

main = do
     n:m:[] <- readInts `fmap` getLine
     a0:_ <- readInts `fmap` getLine
     b0:_ <- readInts `fmap` getLine
     --print a0
     --print b0
     putStrLn $ limit n m a0 b0

solve :: Int -> Int -> Int -> Int -> String
solve n m a b
  | n < m  =  "0/1"
  | a * b < 0  =  '-' : solve n m a' b'
  | n > m  =  "Infinity"
  | otherwise  =  concat [show $ div a' gcdAB, "/", show $ div b' gcdAB]
  where
    a'  =  abs a
    b'  =  abs b
    gcdAB  =  gcd a' b'

reads :: Read a => IO [a]
reads  =  getLine >>= return . map read . words

main :: IO ()
main  =  do
    [n, m]  <-  Main.reads
    as  <-  Main.reads
    bs  <-  Main.reads
    putStrLn $ solve n m (head as) (head bs)

import Control.Applicative

main = do
  [n,m] <- map read.words <$> getLine
  (a:_) <- map read.words <$> getLine
  (b:_) <- map read.words <$> getLine
  putStrLn $ solve n m a b

solve :: Int -> Int -> Int -> Int ->String
solve n m a b
  | n>m = s ++ "Infinity"
  | n<m = "0/1"
  | otherwise = s ++ show x ++ "/" ++ show y
   where
     s = if a*b<0 then "-" else ""
     x = abs $ div a g
     y = abs $ div b g
     g = gcd a b

import Data.Ratio

solve [ [n, m], p:_, q:_ ]	| n < m			= "0/1"
				| n > m && p * q > 0	= "Infinity"
				| n > m && p * q < 0	= "-Infinity"
				| n == m		= show (numerator $ p % q) ++ "/" ++ show (denominator $ p % q)

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

import Data.Ratio

showR r = show (numerator r) ++ "/" ++ show (denominator r)

solve [ [n, m], p:_, q:_ ]	| n < m			= "0/1"
				| n > m && p * q > 0	= "Infinity"
				| n > m && p * q < 0	= "-Infinity"
				| n == m		= showR (p % q)

main = interact $ solve . map (map read . words) . take 3 . lines

import Data.Ratio

solve [ [n, m], p:_, q:_ ]	| n < m			= "0/1"
				| n > m 		= (if p * q < 0 then "-" else "") ++ "Infinity"
				| n == m		= show (numerator $ p % q) ++ "/" ++ show (denominator $ p % q)

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

import Data.Ratio

main =
	do	grades <- getLine
		coeficientsP <- getLine
		coeficientsQ <- getLine
		putStrLn (result grades coeficientsP coeficientsQ)

result::String -> String -> String -> String

result grades coefsP coefsQ =
	if gradeP > gradeQ
	then infinity coefP coefQ
	else if gradeQ > gradeP
	then "0/1"
	else limit coefP coefQ
		where	[gradeP, gradeQ]	= map toInt (words grades)
			coefP			= toInt (head (words coefsP))
			coefQ			= toInt (head (words coefsQ))

infinity coefA coefB =
	(if coefA*coefB > 0
	then ""
	else "-")++"Infinity"

limit::Int -> Int -> String
limit p q =
	(show (numerator lim))
	++ "/" ++
	(show (denominator lim))
		where lim = p % q

toInt::String -> Int
toInt s = read s :: Int

import Data.List

getNumerator :: Int -> Int -> Int
getNumerator a b
	| b > 0 = div a (gcd a b)
	| otherwise =  div (0 - a) (gcd a b)

getDenominator :: Int -> Int -> Int
getDenominator a b
	| b > 0 = div b (gcd a b)
	| otherwise = div (0 - b) (gcd a b)

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	str3 <- getLine
	let num = words str1
	let a0  = read ((words str2) !! 0)
	let b0  = read ((words str3) !! 0)
	let n = num !! 0
	let m = num !! 1
	if (m > n)
		then putStrLn "0/1"
		else if (n > m)
			then if (a0 * b0 > 0)
				then putStrLn "Infinity"
				else putStrLn "-Infinity"
			else putStrLn (show (getNumerator a0 b0) ++ "/" ++ show (getDenominator a0 b0))

-- -*- compile-command: "ghc --make -O limit.hs" -*-

import System.IO
import Data.List
import Data.Char
import qualified Data.ByteString.Lazy as B

limit :: Int -> Int -> Int -> Int -> String
limit n m a b
  | m > n = "0/1"
  | n > m && a*b > 0 = "Infinty"
  | n > m = "-Infinty"
   | otherwise = (show $ c `div` ggt) ++ "/" ++ (show $ d `div` ggt)
       where ggt = gcd a b
             (c,d) = if a*b > 0
                     then (abs a, abs b)
                     else (negate $ abs a, abs b)

readInts :: String -> [Int]
readInts = (map read) . words

main = do
     n:m:[] <- readInts `fmap` getLine
     a0:_ <- readInts `fmap` getLine
     b0:_ <- readInts `fmap` getLine
     --print a0
     --print b0
     putStrLn $ limit n m a0 b0

import Data.Ratio

showR r = show (numerator r) ++ "/" ++ show (denominator r)

solve [ [n, m], p:_, q:_ ]	| n < m			= "0/1"
				| n > m && p > 0	= "Infinity"
				| n > m && p < 0	= "-Infinity"
				| n == m		= showR (p % q)

main = interact $ solve . map (map read . words) . take 3 . lines

import Data.Ratio

main =
	do	grades <- getLine
		coeficientsP <- getLine
		coeficientsQ <- getLine
		putStrLn (result grades coeficientsP coeficientsQ)

result::String -> String -> String -> String

result grades coefsP coefsQ =
	if gradeP > gradeQ
	then infinity coefP
	else if gradeQ > gradeP
	then "0/1"
	else limit coefP coefQ
		where	[gradeP, gradeQ]	= map toInt (words grades)
			coefP			= toInt (head (words coefsP))
			coefQ			= toInt (head (words coefsQ))

infinity coef =
	(if coef > 0
	then ""
	else "-")++"Infinity"

limit::Int -> Int -> String
limit p q =
	(show (numerator lim))
	++ "/" ++
	(show (denominator lim))
		where lim = p % q

toInt::String -> Int
toInt s = read s :: Int


You are given a prime number $$$p$$$, $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$, and an integer $$$k$$$. Find the number of pairs of indexes $$$(i, j)$$$ ($$$1 \le i < j \le n$$$) for which $$$(a_i + a_j)(a_i^2 + a_j^2) \equiv k \bmod p$$$.

The first line contains integers $$$n, p, k$$$ ($$$2 \le n \le 3 \cdot 10^5$$$, $$$2 \le p \le 10^9$$$, $$$0 \le k \le p-1$$$). $$$p$$$ is guaranteed to be prime. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le p-1$$$). It is guaranteed that all elements are different.

Output a single integer — answer to the problem.

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

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

output :: Show a => [a] -> IO ()
output = putStrLn <$> unwords <$> map show

main = do
  [n,p,k] <- input
  a <- input
  print
    $ sum
    $ map (\xs -> let n = length xs in n*(n-1)`div`2)
    $ group
    $ sort [(x^4-k*x) `mod` p | x <- a]

import Control.Monad
import qualified Data.Map.Strict as M

--
-- UTILITIES
--
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)

getInt :: IO Int
getInt = read <$> getLine

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

getInteger :: IO Integer
getInteger = read <$> getLine

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

--
-- MAIN
--

main :: IO ()
main = do
  [n, p, k] <- getIntegers
  nums <- getIntegers
  let modnums = (\a -> (a ^ 4 - k * a) `mod` p) <$> nums
      modmap  = foldl (\m k -> if k `M.member` m then M.adjust succ k m else M.insert k 1 m) M.empty modnums
      modlist = (\(_, v) -> (v * v - v) `div` 2) <$> M.toList modmap
  print $ sum modlist


Let us call a point of the plane admissible if its coordinates are positive integers less than or equal to $$$200$$$.There is an invisible rectangle such that:   its vertices are all admissible;  its sides are parallel to the coordinate axes;  its area is strictly positive.  Your task is to guess the perimeter of this rectangle.In order to guess it, you may ask at most $$$4$$$ queries. In each query, you choose a nonempty subset of the admissible points and you are told how many of the chosen points are inside or on the boundary of the invisible rectangle.

NoteThe following is an example of interaction for the first sample intended to show the format of the queries. $$$$$$ \begin{array}{l|l|l} \text{Query (contestant program)} & \text{Answer (interactor)} & \text{Explanation} \\ \hline \mathtt{?\ 4} & & \text{We choose the $4$ vertices of} \\ \mathtt{13\ 5\ 13\ 80\ 123\ 5\ 123\ 80} & \mathtt{4} &\text{the hidden rectangle.}\\ \hline \mathtt{?\ 5} & & \text{We choose $4$ points just outside the hidden}\\ \mathtt{100\ 4\ 100\ 81\ 12\ 40\ 124\ 40\ 50\ 50} & \mathtt{1}& \text{rectangle and also the point $(50,50)$.}\\ \hline \mathtt{?\ 2} & & \text{We choose the points $(1, 1)$} \\ \mathtt{200\ 200\ 1\ 1} & \mathtt{0} & \text{and $(200,200)$.}\\ \hline \mathtt{!\ 370} & & \text{This is the correct perimeter.} \end{array} $$$$$$For the second sample, a possible interaction is the following. $$$$$$ \begin{array}{l|l|l} \text{Query (contestant program)} & \text{Answer (interactor)} & \text{Explanation} \\ \hline \mathtt{?\ 4} & & \text{We choose the points $(3, 2)$, $(4, 1)$,} \\ \mathtt{3\ 2\ 4\ 1\ 5\ 2\ 4\ 3} & 2 & \text{$(5, 2)$ and $(4, 3)$.} \\ \hline \mathtt{?\ 7} & & \text{We choose the points $(1, 4)$, $(2, 4)$,} \\ \mathtt{1\ 4\ 2\ 4\ 1\ 5\ 2\ 5\ 5\ 5\ 5\ 6\ 6\ 5} & 1 & \text{$(1, 5)$, $(2, 5)$, $(5, 5)$, $(5, 6)$ and $(6, 5)$.} \\ \hline \mathtt{!\ 8} & & \text{This is the correct perimeter.} \end{array} $$$$$$ The situation is shown in the following picture:  The green points are the ones belonging to the first query, while the orange points are the ones belonging to the second query. One can see that there are exactly two rectangles consistent with the interactor's answers:   the rectangle of vertices $$$(2, 2)$$$ and $$$(4, 4)$$$, shown in red;  the rectangle of vertices $$$(4, 2)$$$ and $$$(5, 5)$$$, shown in blue.  Since both of these rectangles have perimeter $$$8$$$, this is the final answer.

import Control.Monad
import System.IO

solve :: IO ()
solve = do
    ab <- qry 0
    a <- bs 1 8 ab
    let b = ab `div` a
    putStrLn $ "! " ++ show (2 * (a + b - 2))
  where
    qry k = do
        let k' = 2^k
            ps = concat [[x, y] | x <- [k',2*k'..200], y <- [1..200]]
        putStrLn $ "? " ++ show (length ps `div` 2)
        putStrLn $ unwords $ show <$> ps
        hFlush stdout
        readLn
    bs l h c'
        | l >= h    = return c'
        | otherwise = do
            c <- qry m
            if c == 0
                then bs l m c'
                else bs (m + 1) h c
        where m = (l + h) `div` 2

main :: IO ()
main = solve

import Control.Monad
import System.IO

solve :: IO ()
solve = do
    ab <- qry 0
    a <- bs 1 8 ab
    let b = ab `div` a
    putStrLn $ "! " ++ show (2 * (a + b - 2))
  where
    qry k = do
        let k' = 2^k
            ps = concat [[x, y] | x <- [k',2*k'..200], y <- [1..200]]
        putStrLn $ "? " ++ show (length ps `div` 2)
        putStrLn $ unwords $ show <$> ps
        hFlush stdout
        readLn
    bs l h m'
        | l >= h    = return m'
        | otherwise = do
            c <- qry m
            if c == 0
                then bs l m m'
                else bs (m + 1) h m
        where m = (l + h) `div` 2

main :: IO ()
main = solve


There are n parliamentarians in Berland. They are numbered with integers from 1 to n. It happened that all parliamentarians with odd indices are Democrats and all parliamentarians with even indices are Republicans.New parliament assembly hall is a rectangle consisting of a × b chairs — a rows of b chairs each. Two chairs are considered neighbouring if they share as side. For example, chair number 5 in row number 2 is neighbouring to chairs number 4 and 6 in this row and chairs with number 5 in rows 1 and 3. Thus, chairs have four neighbours in general, except for the chairs on the border of the hallWe know that if two parliamentarians from one political party (that is two Democrats or two Republicans) seat nearby they spent all time discussing internal party issues.Write the program that given the number of parliamentarians and the sizes of the hall determine if there is a way to find a seat for any parliamentarian, such that no two members of the same party share neighbouring seats.

The first line of the input contains three integers n, a and b (1 ≤ n ≤ 10 000, 1 ≤ a, b ≤ 100) — the number of parliamentarians, the number of rows in the assembly hall and the number of seats in each row, respectively.

If there is no way to assigns seats to parliamentarians in a proper way print -1. Otherwise print the solution in a lines, each containing b integers. The j-th integer of the i-th line should be equal to the index of parliamentarian occupying this seat, or 0 if this seat should remain empty. If there are multiple possible solution, you may print any of them.

NoteIn the first sample there are many other possible solutions. For example, 3 20 1and 2 13 0The following assignment 3 21 0is incorrect, because parliamentarians 1 and 3 are both from Democrats party but will occupy neighbouring seats.

main :: IO ()
main = do
  (n:a:b:_) <- fmap (map read . words) getLine
  if n > a * b
  then print (-1)
  else flip mapM_ [0 .. a-1] $ \i -> do
    let r = (if even b && odd i then reverse else id)
          [if j < n then j + 1 else 0 | j <- take b [i * b ..]]
    putStrLn $ unwords $ map show r

import Data.List (splitAt)
main = do
    [n,a,b] <- fmap ((map read) . words) getLine :: IO[Int]
    if n>a*b
        then print (-1)
        else mapM_ printLs $ solve n a b

printLs :: [Int] -> IO()
printLs xs = mapM_ (\x -> putStr (show x ++ " ")) xs >> putStrLn ""

solve :: Int -> Int ->Int ->[[Int]]
solve n a b =
    let l = [1..n] ++ (repeat 0)
    in go l a b 0

go :: [Int] -> Int -> Int -> Int ->[[Int]]
go l a b c
 |c==a = []
 |otherwise =
    let (x,y) = splitAt b l
    in if even c then x:go y a b (c+1) else (reverse x):go y a b (c+1)

import Data.List

rowToString [] = ""
rowToString (x : xs) = (show x) ++ " " ++ (rowToString xs)
tableToString [] = ""
tableToString (r : rs) = (rowToString r) ++ ("\n") ++( tableToString rs)

up b = div (b + 1) 2
down b = div b 2
build a n m b | a == 0 = []
              | otherwise = ((map (max 0) . concat . transpose $ ([take (up b) [n, n - 2..], take (down b) [m, m - 2..]])): build (a - 1) (m - 2 * down(b)) (n - 2 * up(b)) b)
main = do
    [n, a, b] <- fmap (map  read . words) getLine
    putStr .tableToString $ if (n > a * b) then [[(-1)]] else (build a n (n - 1) b)

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

splitBy::Int->[a]->[[a]]
splitBy _ [] = []
splitBy n xs = let (pref, rest) = splitAt n xs in pref: splitBy n rest

solution::Int->Int->Int->[[Int]]
solution n a b
  | n > a * b = [[-1]]
  | otherwise = let
    nums    = splitBy b $ take (a*b)  $ [1..n] ++ repeat 0
    rev _ []          = []
    rev False (x: xs) = x: rev True xs
    rev True (x:xs)   = reverse x : rev False xs
    in case mod b 2 of
      1 -> nums
      _ -> rev False nums

main :: IO ()
main = do
  [n,a,b] <- map read . words <$> getLine
  forM_ (solution n a b) $ putStrLn . intercalate " ". map show

main = interact $ unlines . map (unwords . map show) . go . map read . words . filter ('\n'/=)
go [n,a,b] | n>a*b = [[-1]]
           | True = (map (\(i,k) -> dr i [k-b+1..k]) . take ndb $ zip [1..] [b,b+b..]) ++ map zs [ndb+1..a]
           where dr i | b`mod`2==0 && i`mod`2==0 = reverse
                      | True = id
                 zs i = dr i $ l ++ take (b-length l) [0,0..]
                      where l = [b*(i-1)+1..n]
                 ndb = n`div`b

main = do
  (n:a:b:_) <- fmap (map read . words) getLine
  if n > a * b
  then print (-1)
  else flip mapM_ [0 .. a-1] $ \i -> do
    let r = (if odd b && odd i then reverse else id)
          [if j < n then j + 1 else 0 | j <- take b [i * b ..]]
    putStrLn $ unwords $ map show r


Reminder: the median of the array $$$[a_1, a_2, \dots, a_{2k+1}]$$$ of odd number of elements is defined as follows: let $$$[b_1, b_2, \dots, b_{2k+1}]$$$ be the elements of the array in the sorted order. Then median of this array is equal to $$$b_{k+1}$$$.There are $$$2n$$$ students, the $$$i$$$-th student has skill level $$$a_i$$$. It's not guaranteed that all skill levels are distinct.Let's define skill level of a class as the median of skill levels of students of the class.As a principal of the school, you would like to assign each student to one of the $$$2$$$ classes such that each class has odd number of students (not divisible by $$$2$$$). The number of students in the classes may be equal or different, by your choice. Every student has to be assigned to exactly one class. Among such partitions, you want to choose one in which the absolute difference between skill levels of the classes is minimized.What is the minimum possible absolute difference you can achieve?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of students halved. The second line of each test case contains $$$2n$$$ integers $$$a_1, a_2, \dots, a_{2 n}$$$ ($$$1 \le a_i \le 10^9$$$) — skill levels of students. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, output a single integer, the minimum possible absolute difference between skill levels of two classes of odd sizes.

NoteIn the first test, there is only one way to partition students — one in each class. The absolute difference of the skill levels will be $$$|1 - 1| = 0$$$.In the second test, one of the possible partitions is to make the first class of students with skill levels $$$[6, 4, 2]$$$, so that the skill level of the first class will be $$$4$$$, and second with $$$[5, 1, 3]$$$, so that the skill level of the second class will be $$$3$$$. Absolute difference will be $$$|4 - 3| = 1$$$.Note that you can't assign like $$$[2, 3]$$$, $$$[6, 5, 4, 1]$$$ or $$$[]$$$, $$$[6, 5, 4, 1, 2, 3]$$$ because classes have even number of students.$$$[2]$$$, $$$[1, 3, 4]$$$ is also not possible because students with skills $$$5$$$ and $$$6$$$ aren't assigned to a class.In the third test you can assign the students in the following way: $$$[3, 4, 13, 13, 20], [2, 5, 8, 16, 17]$$$ or $$$[3, 8, 17], [2, 4, 5, 13, 13, 16, 20]$$$. Both divisions give minimal possible absolute difference.

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Data.List

main = getLine >>= test.read
test 0 = return ()
test n = getLine >> getLine >>= print.solve.sort.map read.words >> test (n - 1)

solve as = abs $ as !! i - as !! pred i where
  i = div (length as) 2

import Data.List
import Control.Monad
main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine
routine :: IO ()
routine = do
  n <- readLn
  as <- (map read. words) <$> getLine
  print $ solve n as

solve :: Int -> [Int] -> Int
solve n as = (as'!!n)-(as'!!(n-1))
  where
    as' = sort as

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>), take)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
gets :: EIO String
gets = ExceptT $ liftM Right getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    n <- get
    a <- replicateM (2 * n) get
    putln $ f2 a n

f2 :: [Int64] -> Int -> Int64
f2 l n =    let sl = sort l
            in
            ((sl !! (n)) - (sl !! (n - 1)))

import Control.Monad
import Data.List

solve :: (Int, [Int]) -> Int
solve (n,xs) = abs $ (xs !! q) - (xs !! r)
  where
    q = 2 * n `div` 2
    r = q - 1

main = do
  t <- readLn :: IO Int
  xss <- replicateM t $ do
    n <- readLn :: IO Int
    xs <- sort . map read . words <$> getLine :: IO [Int]
    return (n, xs)
  mapM_ (print . solve) xss

import Data.List as L

solve :: [Integer] -> Integer
solve as = (head secondHalf) - (last firstHalf)
  where ordered = L.sort as
        mid = div (length as) 2
        firstHalf = take mid ordered
        secondHalf = drop mid ordered

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:as:other) = [(n, as)] ++ groupByTwo other

parse :: (String, String) -> String
parse (_, as) = show $ solve as'
  where as' = map (\x -> read x :: Integer) $ words as

main :: IO ()
main = interact (unlines . map parse . groupByTwo . tail . lines)

import Control.Monad
import Data.List

solve :: (Int, [Int]) -> Int
solve (n,xs) = abs $ ma - mb
  where
    ma = (reverse as) !! (n `div` 2)
    mb = (reverse bs) !! (n `div` 2)
    (as,bs) = foldl' step ([],[]) $ zip [1..2*n] xs
    step (as,bs) (i,e)
      | odd i = (e:as,bs)
      | otherwise = (as,e:bs)

main = do
  t <- readLn :: IO Int
  xss <- replicateM t $ do
    n <- readLn :: IO Int
    xs <- sort . map read . words <$> getLine :: IO [Int]
    return (n,xs)
  mapM_ (print . solve) xss

import Control.Monad
import Data.List

solve :: (Int, [Int]) -> Int
solve (n,xs) = abs $ ma - mb
  where
    ma = (sort as) !! (n `div` 2)
    mb = (sort bs) !! (n `div` 2)
    (as,bs) = collect xs ([],[])
    collect xs (as,bs)
      | null xs = (as,bs)
      | otherwise = collect xs' ((h:as), (l:bs))
      where
        h = head xs
        l = last xs
        xs' = reverse $ init $ tail xs

main = do
  t <- readLn :: IO Int
  xss <- replicateM t $ do
    n <- readLn :: IO Int
    xs <- sort . map read . words <$> getLine :: IO [Int]
    return (n,xs)
  mapM_ (print . solve) xss

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

solve :: (Int, [Int]) -> Int
solve (n,xs) = abs $ (xs !! q) - (xs !! r)
  where
    q = 2 * n `div` 2
    r = q - 1

main = do
  t <- readLn :: IO Int
  xss <- replicateM t $ do
    n <- readLn :: IO Int
    xs <- sort . map (fst . fromJust . B.readInt) . B.words <$> B.getLine :: IO [Int]
    return (n, xs)
  mapM_ (print . solve) xss


Bees Alice and Alesya gave beekeeper Polina famous card game "Set" as a Christmas present. The deck consists of cards that vary in four features across three options for each kind of feature: number of shapes, shape, shading, and color. In this game, some combinations of three cards are said to make up a set. For every feature — color, number, shape, and shading — the three cards must display that feature as either all the same, or pairwise different. The picture below shows how sets look.Polina came up with a new game called "Hyperset". In her game, there are $$$n$$$ cards with $$$k$$$ features, each feature has three possible values: "S", "E", or "T". The original "Set" game can be viewed as "Hyperset" with $$$k = 4$$$.Similarly to the original game, three cards form a set, if all features are the same for all cards or are pairwise different. The goal of the game is to compute the number of ways to choose three cards that form a set.Unfortunately, winter holidays have come to an end, and it's time for Polina to go to school. Help Polina find the number of sets among the cards lying on the table.

The first line of each test contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 1500$$$, $$$1 \le k \le 30$$$) — number of cards and number of features. Each of the following $$$n$$$ lines contains a card description: a string consisting of $$$k$$$ letters "S", "E", "T". The $$$i$$$-th character of this string decribes the $$$i$$$-th feature of that card. All cards are distinct.

Output a single integer — the number of ways to choose three cards that form a set.

NoteIn the third example test, these two triples of cards are sets:  "SETT", "TEST", "EEET"  "TEST", "ESTE", "STES"

import Data.Map.Strict (fromAscList, findWithDefault, keys)
import Data.List

main = do
	getLine
	strings <- group . sort . words <$> getContents
	let counts = fromAscList [(head ss, length ss) | ss <- strings]
	    elems = keys counts
	print $ sum [findWithDefault 0 (set a b) counts |
		i <- [0..length elems - 1],
		let (a:bs) = drop i elems,
		b <- bs] `div` 3

set [] _ = []
set (a:as) (b:bs)
	| a == b = a : set as bs
	| otherwise = (head $ "SET" \\ [a, b]) : set as bs

import Data.List
import qualified Data.Maybe as M
import qualified Data.Set as S

candidate :: String -> String -> String

candidate [] [] = []
candidate (x:xs) (y:ys) = cur:candidate xs ys
    where
        cur = if (x == y) then x else (head $ "SET" \\ [x, y])

getAllMatches cards = [(a, b, c) |
    (a:bs) <- tails cards,
    b <- bs,
    let c = candidate a b,
    c < a,
    S.member c cards']
    where cards' = S.fromAscList cards

solve :: [String] -> Int
solve cards =
    length . getAllMatches . sort $ cards

main = do
    _ <- getLine
    strings <- words <$> getContents
    print $ solve strings

import Data.Set as S
import Data.List as L

missing :: Char -> Char -> Char
missing 'S' 'E' = 'T'
missing 'E' 'S' = 'T'
missing 'E' 'T' = 'S'
missing 'T' 'E' = 'S'
missing 'S' 'T' = 'E'
missing 'T' 'S' = 'E'

desiredCard :: String -> String -> String
desiredCard "" "" = ""
desiredCard (a:as) (b:bs)
  | a == b = [a] ++ next
  | otherwise = [missing a b] ++ next
  where next = desiredCard as bs

possibilitiesCount :: [String] -> Int
possibilitiesCount strings = length
                             $ L.filter (\[a, b] -> S.member (desiredCard a b) allStrings)
                             [[a, b] | a <- strings, b <- strings, a /= b && a < b]
  where allStrings = S.fromList strings

solve :: String -> String
solve input = show $ (div (possibilitiesCount lines') 3)
  where lines' = tail $ lines input

main :: IO ()
main = do
  contents <- getContents
  putStrLn (solve contents)


ZS the Coder and Chris the Baboon arrived at the entrance of Udayland. There is a n × n magic grid on the entrance which is filled with integers. Chris noticed that exactly one of the cells in the grid is empty, and to enter Udayland, they need to fill a positive integer into the empty cell.Chris tried filling in random numbers but it didn't work. ZS the Coder realizes that they need to fill in a positive integer such that the numbers in the grid form a magic square. This means that he has to fill in a positive integer so that the sum of the numbers in each row of the grid (), each column of the grid (), and the two long diagonals of the grid (the main diagonal —  and the secondary diagonal — ) are equal. Chris doesn't know what number to fill in. Can you help Chris find the correct positive integer to fill in or determine that it is impossible?

The first line of the input contains a single integer n (1 ≤ n ≤ 500) — the number of rows and columns of the magic grid. n lines follow, each of them contains n integers. The j-th number in the i-th of them denotes ai, j (1 ≤ ai, j ≤ 109 or ai, j = 0), the number in the i-th row and j-th column of the magic grid. If the corresponding cell is empty, ai, j will be equal to 0. Otherwise, ai, j is positive. It is guaranteed that there is exactly one pair of integers i, j (1 ≤ i, j ≤ n) such that ai, j = 0.

Output a single integer, the positive integer x (1 ≤ x ≤ 1018) that should be filled in the empty cell so that the whole grid becomes a magic square. If such positive integer x does not exist, output  - 1 instead. If there are multiple solutions, you may print any of them.

NoteIn the first sample case, we can fill in 9 into the empty cell to make the resulting grid a magic square. Indeed, The sum of numbers in each row is:4 + 9 + 2 = 3 + 5 + 7 = 8 + 1 + 6 = 15.The sum of numbers in each column is:4 + 3 + 8 = 9 + 5 + 1 = 2 + 7 + 6 = 15.The sum of numbers in the two diagonals is:4 + 5 + 6 = 2 + 5 + 8 = 15.In the third sample case, it is impossible to fill a number in the empty square such that the resulting grid is a magic square.

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Integer
  readInt s = read s :: Integer

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  getTotalOnNonZero :: (Bool, [Integer]) -> Integer
  getTotalOnNonZero (True, _) = -1
  getTotalOnNonZero (False, xs) = sum xs

  hasZero :: [Integer] -> Bool
  hasZero = any (==0)

  main :: IO()
  main = do
    n <- getLine >>= return . (read :: String -> Int)
    matrix <- readMultilineInput n (return . (map readInt) . words)
    let matrixT = transpose matrix
        zeroX = 0 -- TODO
        zeroY = 0 -- TODO
        lm = length matrix
        zerosH = map hasZero matrix
        zerosV = map hasZero matrixT
        ids = [0..(length matrix - 1)]
        diags = (\index -> matrix !! index !! index) `map` ids
        diagsI = (\index -> matrix !! index !! (lm - index - 1)) `map` ids
        sdiags = sum diags
        sdiagsI = sum diagsI
        hm = zerosH `zip` matrix
        vm = zerosV `zip` matrixT
        hmm = snd . head $ filter fst hm :: [Integer]
        vmm = snd . head $ filter fst vm :: [Integer]
        horizontals = map getTotalOnNonZero hm
        verticals = map getTotalOnNonZero vm
        targetScore = head $ filter (>=0) horizontals
        allTargets = filter (>0) $ horizontals ++ verticals
        possible = all (==targetScore) allTargets
        shmm = sum hmm
        svmm = sum vmm
        d1diff = targetScore - sdiags
        d2diff = targetScore - sdiagsI
        hdiff = targetScore - shmm
        vdiff = targetScore - svmm
        action = case ans < 1 of
                   True -> print (-1)
                   False -> print ans
        ans = case n of
          1 ->  9 -- doesnt matter
          _ -> case possible && (hdiff == vdiff) of
                 False ->  (-1)
                 True -> case any (==0) diags of
                           True -> case any (==0) diagsI of
                                     True -> case d1diff == d2diff && hdiff == d1diff of
                                               False ->  (-2)
                                               True ->  d1diff
                                     False -> case d1diff == hdiff && sdiagsI == targetScore of
                                                False ->  (-3)
                                                True ->  d1diff
                           False -> case any (==0) diagsI of
                                      True -> case hdiff == d2diff && sdiags == targetScore of
                                                False ->  (-4)
                                                True ->  hdiff
                                      False -> case sdiagsI == sdiags && sdiags == targetScore of
                                                 False ->  (-5)
                                                 True ->  hdiff

    action

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

btoi :: (Integral a) => B.ByteString -> a
btoi = fromIntegral . fst . fromJust . B.readInt

replace :: Integer -> [[Integer]] -> [[Integer]]
replace _ []         = []
replace b (row:rest) = (replace' row):replace b rest
  where
    replace' :: [Integer] -> [Integer]
    replace' []   = []
    replace' (x:xs)
      | 0 == x    = b:xs
      | otherwise = x:replace' xs

getDiag :: [[Integer]] -> [Integer]
getDiag [] = []
getDiag ((r:row):rest) = r : getDiag (map tail rest)

allEq :: [Integer] -> Bool
allEq []     = True
allEq (x:xs) = all (== x) xs

checkMagic :: [[Integer]] -> Bool
checkMagic mat =
  let rows  = map sum mat
      cols  = map sum $ transpose mat
      diag1 = sum $ getDiag mat
      diag2 = sum . getDiag $ reverse mat
  in allEq $ rows ++ cols ++ [diag1, diag2]

getRow :: ([Integer] -> Bool) -> [[Integer]] -> [Integer]
getRow p (row:rest)
  | p row     = row
  | otherwise = getRow p rest

process_case :: Int -> [[Integer]] -> Integer
process_case 1 _              = 1
process_case _ mat =
  let row  = getRow (elem 0) mat
      row' = getRow (not . (elem 0)) mat
      t    = sum row' - sum row
      mat' = replace t mat
  in if checkMagic mat' && t > 0 && t <= 10^18 then t else -1

process :: B.ByteString -> B.ByteString
process str =
  let (header:body) = B.lines str
      n             = btoi header
      mat           = map (map btoi . take n . B.words) $ take n body
  in B.pack . show $ process_case n mat

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

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Integer
  readInt s = read s :: Integer

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  getTotalOnNonZero :: (Bool, [Integer]) -> Integer
  getTotalOnNonZero (True, _) = -1
  getTotalOnNonZero (False, xs) = sum xs

  hasZero :: [Integer] -> Bool
  hasZero = any (==0)

  calculate2 :: [[Integer]] -> Int
  calculate2 _ = -1 -- TODO

  main :: IO()
  main = do
    n <- getLine >>= return . (read :: String -> Int)
    matrix <- readMultilineInput n (return . (map readInt) . words)
    let matrixT = transpose matrix
        zeroX = 0 -- TODO
        zeroY = 0 -- TODO
        lm = length matrix
        zerosH = map hasZero matrix
        zerosV = map hasZero matrixT
        ids = [0..(length matrix - 1)]
        diags = (\index -> matrix !! index !! index) `map` ids
        diagsI = (\index -> matrix !! index !! (lm - index - 1)) `map` ids
        sdiags = sum diags
        sdiagsI = sum diagsI
        hm = zerosH `zip` matrix
        vm = zerosV `zip` matrixT
        hmm = snd . head $ filter fst hm :: [Integer]
        vmm = snd . head $ filter fst vm :: [Integer]
        horizontals = map getTotalOnNonZero hm
        verticals = map getTotalOnNonZero vm
        targetScore = head $ filter (>=0) horizontals
        allTargets = filter (>0) $ horizontals ++ verticals
        possible = all (==targetScore) allTargets
        shmm = sum hmm
        svmm = sum vmm
        d1diff = targetScore - sdiags
        d2diff = targetScore - sdiagsI
        hdiff = targetScore - shmm
        vdiff = targetScore - svmm
        action = case n of
          1 -> print 9 -- doesnt matter
          2 -> print $ calculate2 matrix
          _ -> case possible && (hdiff == vdiff) of
                 False -> print (-1)
                 True -> case any (==0) diags of
                           True -> case any (==0) diagsI of
                                     True -> case d1diff == d2diff && hdiff == d1diff of
                                               False -> print (-1)
                                               True -> print d1diff
                                     False -> case d1diff == hdiff && sdiagsI == targetScore of
                                                False -> print (-1)
                                                True -> print d1diff
                           False -> case any (==0) diagsI of
                                      True -> case hdiff == d2diff && sdiags == targetScore of
                                                False -> print (-1)
                                                True -> print hdiff
                                      False -> case sdiagsI == sdiags && sdiags == targetScore of
                                                 False -> print (-1)
                                                 True -> print hdiff

    action

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Integer
  readInt s = read s :: Integer

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  getTotalOnNonZero :: (Bool, [Integer]) -> Integer
  getTotalOnNonZero (True, _) = -1
  getTotalOnNonZero (False, xs) = sum xs

  hasZero :: [Integer] -> Bool
  hasZero = any (==0)

  main :: IO()
  main = do
    n <- getLine >>= return . (read :: String -> Int)
    matrix <- readMultilineInput n (return . (map readInt) . words)
    let matrixT = transpose matrix
        zeroX = 0 -- TODO
        zeroY = 0 -- TODO
        lm = length matrix
        zerosH = map hasZero matrix
        zerosV = map hasZero matrixT
        ids = [0..(length matrix - 1)]
        diags = (\index -> matrix !! index !! index) `map` ids
        diagsI = (\index -> matrix !! index !! (lm - index - 1)) `map` ids
        sdiags = sum diags
        sdiagsI = sum diagsI
        hm = zerosH `zip` matrix
        vm = zerosV `zip` matrixT
        hmm = snd . head $ filter fst hm :: [Integer]
        vmm = snd . head $ filter fst vm :: [Integer]
        horizontals = map getTotalOnNonZero hm
        verticals = map getTotalOnNonZero vm
        targetScore = head $ filter (>=0) horizontals
        allTargets = filter (>0) $ horizontals ++ verticals
        possible = all (==targetScore) allTargets
        shmm = sum hmm
        svmm = sum vmm
        d1diff = targetScore - sdiags
        d2diff = targetScore - sdiagsI
        hdiff = targetScore - shmm
        vdiff = targetScore - svmm
        action = case n of
          1 -> print 9 -- doesnt matter
          _ -> case possible && (hdiff == vdiff) of
                 False -> print (-1)
                 True -> case any (==0) diags of
                           True -> case any (==0) diagsI of
                                     True -> case d1diff == d2diff && hdiff == d1diff of
                                               False -> print (-1)
                                               True -> print d1diff
                                     False -> case d1diff == hdiff && sdiagsI == targetScore of
                                                False -> print (-1)
                                                True -> print d1diff
                           False -> case any (==0) diagsI of
                                      True -> case hdiff == d2diff && sdiags == targetScore of
                                                False -> print (-1)
                                                True -> print hdiff
                                      False -> case sdiagsI == sdiags && sdiags == targetScore of
                                                 False -> print (-1)
                                                 True -> print hdiff

    action

import Data.List

replace :: Integer -> Integer -> [[Integer]] -> [[Integer]]
replace _ _ []         = []
replace a b (row:rest) = (replace' row):replace a b rest
  where
    replace' :: [Integer] -> [Integer]
    replace' []   = []
    replace' (x:xs)
      | a == x    = b:xs
      | otherwise = x:replace' xs

getDiag :: [[Integer]] -> [Integer]
getDiag [] = []
getDiag ((r:row):rest) = r : getDiag (map tail rest)

checkMagic :: [[Integer]] -> Bool
checkMagic mat =
  let rows  = map sum mat
      cols  = map sum $ transpose mat
      diag1 = sum $ getDiag mat
      diag2 = sum . getDiag $ transpose mat
  in length (nub (rows ++ cols ++ [diag1, diag2])) == 1

process_case :: Int -> [[Integer]] -> Integer
process_case 1 _              = 1
process_case _ mat@(row:row':_) =
  let s = if elem 0 row then sum row' else sum row
      t = if elem 0 row then sum row' - sum row else sum row - sum row'
      mat' = replace 0 t mat
  in if checkMagic mat' && t <= 10^18 then t else -1

process :: String -> String
process str =
  let (header:body) = lines str
      n             = read header
      mat           = map (map read . take n . words) $ take n body
  in show $ process_case n mat

main :: IO ()
main = interact process

import Data.List

replace :: Integer -> [[Integer]] -> [[Integer]]
replace _ []         = []
replace b (row:rest) = (replace' row):replace b rest
  where
    replace' :: [Integer] -> [Integer]
    replace' []   = []
    replace' (x:xs)
      | 0 == x    = b:xs
      | otherwise = x:replace' xs

getDiag :: [[Integer]] -> [Integer]
getDiag [] = []
getDiag ((r:row):rest) = r : getDiag (map tail rest)

allEq :: [Integer] -> Bool
allEq []     = True
allEq (x:xs) = all (== x) xs

checkMagic :: [[Integer]] -> Bool
checkMagic mat =
  let rows  = map sum mat
      cols  = map sum $ transpose mat
      diag1 = sum $ getDiag mat
      diag2 = sum . getDiag $ transpose mat
  in allEq $ rows ++ cols ++ [diag1, diag2]

getRow :: ([Integer] -> Bool) -> [[Integer]] -> [Integer]
getRow p (row:rest)
  | p row     = row
  | otherwise = getRow p rest

process_case :: Int -> [[Integer]] -> Integer
process_case 1 _              = 1
process_case _ mat =
  let row  = getRow (elem 0) mat
      row' = getRow (not . (elem 0)) mat
      t    = sum row' - sum row
      mat' = replace t mat
  in if checkMagic mat' && t > 0 && t <= 10^18 then t else -1

process :: String -> String
process str =
  let (header:body) = lines str
      n             = read header
      mat           = map (map read . take n . words) $ take n body
  in show $ process_case n mat

main :: IO ()
main = interact process

import Data.List

replace :: Integer -> [[Integer]] -> [[Integer]]
replace _ []         = []
replace b (row:rest) = (replace' row):replace b rest
  where
    replace' :: [Integer] -> [Integer]
    replace' []   = []
    replace' (x:xs)
      | 0 == x    = b:xs
      | otherwise = x:replace' xs

getDiag :: [[Integer]] -> [Integer]
getDiag [] = []
getDiag ((r:row):rest) = r : getDiag (map tail rest)

allEq :: [Integer] -> Bool
allEq []     = True
allEq (x:xs) = all (== x) xs

checkMagic :: [[Integer]] -> Bool
checkMagic mat =
  let rows  = map sum mat
      cols  = map sum $ transpose mat
      diag1 = sum $ getDiag mat
      diag2 = sum . getDiag $ transpose mat
  in allEq $ rows ++ cols ++ [diag1, diag2]

process_case :: Int -> [[Integer]] -> Integer
process_case 1 _              = 1
process_case _ mat@(row:row':_) =
  let s = if elem 0 row then sum row' else sum row
      t = if elem 0 row then sum row' - sum row else sum row - sum row'
      mat' = replace t mat
  in if checkMagic mat' && t > 0 && t <= 10^18 then t else -1

process :: String -> String
process str =
  let (header:body) = lines str
      n             = read header
      mat           = map (map read . take n . words) $ take n body
  in show $ process_case n mat

main :: IO ()
main = interact process


Another Codeforces Round has just finished! It has gathered $$$n$$$ participants, and according to the results, the expected rating change of participant $$$i$$$ is $$$a_i$$$. These rating changes are perfectly balanced — their sum is equal to $$$0$$$.Unfortunately, due to minor technical glitches, the round is declared semi-rated. It means that all rating changes must be divided by two.There are two conditions though:   For each participant $$$i$$$, their modified rating change $$$b_i$$$ must be integer, and as close to $$$\frac{a_i}{2}$$$ as possible. It means that either $$$b_i = \lfloor \frac{a_i}{2} \rfloor$$$ or $$$b_i = \lceil \frac{a_i}{2} \rceil$$$. In particular, if $$$a_i$$$ is even, $$$b_i = \frac{a_i}{2}$$$. Here $$$\lfloor x \rfloor$$$ denotes rounding down to the largest integer not greater than $$$x$$$, and $$$\lceil x \rceil$$$ denotes rounding up to the smallest integer not smaller than $$$x$$$.  The modified rating changes must be perfectly balanced — their sum must be equal to $$$0$$$. Can you help with that?

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 13\,845$$$), denoting the number of participants. Each of the next $$$n$$$ lines contains a single integer $$$a_i$$$ ($$$-336 \le a_i \le 1164$$$), denoting the rating change of the $$$i$$$-th participant. The sum of all $$$a_i$$$ is equal to $$$0$$$.

Output $$$n$$$ integers $$$b_i$$$, each denoting the modified rating change of the $$$i$$$-th participant in order of input. For any $$$i$$$, it must be true that either $$$b_i = \lfloor \frac{a_i}{2} \rfloor$$$ or $$$b_i = \lceil \frac{a_i}{2} \rceil$$$. The sum of all $$$b_i$$$ must be equal to $$$0$$$. If there are multiple solutions, print any. We can show that a solution exists for any valid input.

NoteIn the first example, $$$b_1 = 5$$$, $$$b_2 = -3$$$ and $$$b_3 = -2$$$ is another correct solution.In the second example there are $$$6$$$ possible solutions, one of them is shown in the example output.

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

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.State.Strict
import qualified Data.Array                 as A
import qualified Data.Array.ST.Safe         as MA
import qualified Data.Array.Unboxed         as UA
import           Data.Bool
import qualified Data.ByteString.Builder    as B
import qualified Data.ByteString.Char8      as C
import           Data.Char
import           Data.Function
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import qualified Data.List                  as L
import qualified Data.List.NonEmpty         as NL
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup
import qualified Data.Set                   as S
import           Data.Tuple
import           Foreign
import qualified System.IO                  as IO
#ifdef DEBUG
import           Debug.Trace
#endif

main :: IO ()
main = do
    n <- readLn
    xs <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getContents
    putStr.unlines.map show $ solve n xs

solve :: Int -> [Int] -> [Int]
solve n xs = go (sum $ map (`quot` 2) xs) xs
  where
    go 0 xs = map (`quot` 2) xs
    go acc (x:xs)
        | even x = quot x 2 : go acc xs
        | acc > 0, x < 0 = div x 2 : go (acc - 1) xs
        | acc < 0, x > 0 = quot (x + 1) 2 : go (acc + 1) xs
        | otherwise = quot x 2 : go acc xs


You and your $$$n - 1$$$ friends have found an array of integers $$$a_1, a_2, \dots, a_n$$$. You have decided to share it in the following way: All $$$n$$$ of you stand in a line in a particular order. Each minute, the person at the front of the line chooses either the first or the last element of the array, removes it, and keeps it for himself. He then gets out of line, and the next person in line continues the process.You are standing in the $$$m$$$-th position in the line. Before the process starts, you may choose up to $$$k$$$ different people in the line, and persuade them to always take either the first or the last element in the array on their turn (for each person his own choice, not necessarily equal for all people), no matter what the elements themselves are. Once the process starts, you cannot persuade any more people, and you cannot change the choices for the people you already persuaded.Suppose that you're doing your choices optimally. What is the greatest integer $$$x$$$ such that, no matter what are the choices of the friends you didn't choose to control, the element you will take from the array will be greater than or equal to $$$x$$$?Please note that the friends you don't control may do their choice arbitrarily, and they will not necessarily take the biggest element available.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$)  — the number of test cases. The description of the test cases follows. The first line of each test case contains three space-separated integers $$$n$$$, $$$m$$$ and $$$k$$$ ($$$1 \le m \le n \le 3500$$$, $$$0 \le k \le n - 1$$$)  — the number of elements in the array, your position in line and the number of people whose choices you can fix. The second line of each test case contains $$$n$$$ positive integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$)  — elements of the array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$3500$$$.

For each test case, print the largest integer $$$x$$$ such that you can guarantee to obtain at least $$$x$$$.

NoteIn the first test case, an optimal strategy is to force the first person to take the last element and the second person to take the first element.  the first person will take the last element ($$$5$$$) because he or she was forced by you to take the last element. After this turn the remaining array will be $$$[2, 9, 2, 3, 8]$$$;  the second person will take the first element ($$$2$$$) because he or she was forced by you to take the first element. After this turn the remaining array will be $$$[9, 2, 3, 8]$$$;  if the third person will choose to take the first element ($$$9$$$), at your turn the remaining array will be $$$[2, 3, 8]$$$ and you will take $$$8$$$ (the last element);  if the third person will choose to take the last element ($$$8$$$), at your turn the remaining array will be $$$[9, 2, 3]$$$ and you will take $$$9$$$ (the first element). Thus, this strategy guarantees to end up with at least $$$8$$$. We can prove that there is no strategy that guarantees to end up with at least $$$9$$$. Hence, the answer is $$$8$$$.In the second test case, an optimal strategy is to force the first person to take the first element. Then, in the worst case, both the second and the third person will take the first element: you will end up with $$$4$$$.

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
gets :: EIO String
gets = ExceptT $ liftM Right getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get :: EIO Int
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (n, m, k) <- liftM3 (,,) get get get :: EIO (Int, Int, Int)
    as <- replicateM n get :: EIO [Int64]
    putln $ f2 as n m k

f2 :: [Int64] -> Int -> Int -> Int -> Int64
f2 as n m k =   let arr = runSTUArray $ do
                    a <- newArray (0, n - 1) 0 :: ST s (STUArray s Int Int64)
                    foldlM (\i c -> do
                        writeArray a i c
                        return $ i + 1) 0 as
                    return a
                in
                foldl (\ans i -> max ans $ f3 arr i m n $ min k (m - 1)) (-1) [0..min k (m - 1)]

f3 :: (UArray Int Int64) -> Int -> Int -> Int -> Int -> Int64
f3 arr i m n k = foldl (\ans j -> min ans $ max (arr ! (i + j)) (arr ! (n - (m - i - j)))) 100000000000 [0..m-k-1]

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
gets :: EIO String
gets = ExceptT $ liftM Right getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get :: EIO Int
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (n, m, k) <- liftM3 (,,) get get get :: EIO (Int, Int, Int)
    as <- replicateM n get :: EIO [Int64]
    putln $ f2 as n m k

f2 :: [Int64] -> Int -> Int -> Int -> Int64
f2 as n m k =   let arr = runSTUArray $ do
                    a <- newArray (0, n - 1) 0 :: ST s (STUArray s Int Int64)
                    foldlM (\i c -> do
                        writeArray a i c
                        return $ i + 1) 0 as
                    return a
                in
                foldl (\ans i -> max ans $ f3 arr i m n $ min k (m - 1)) (-1) [0..min k (m - 1)]

f3 :: (UArray Int Int64) -> Int -> Int -> Int -> Int -> Int64
f3 arr i m n k = foldl (\ans j -> min ans $ max (arr ! (i + j)) (arr ! (n - (m - i - j)))) 10000000 [0..m-k-1]