import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  _ <- getLine
  as <- map (\c -> read [c]) <$> getLine
  print $ solve as

solve :: [Integer] -> Integer
solve as = sum as''
  where
    as' = map (\x -> x-1) as
    pref = scanl (+) 0 as'
    as'' =map ((\ l -> (l * (l - 1)) `div` 2) . fromIntegral . length) ((group.sort) pref)

import Data.List
import Data.Char
import Data.Int
getBlocks :: Eq a => [a] -> [Int64]
getBlocks [] = []
getBlocks [_] = [1]
getBlocks (x : y : t) = let ret = getBlocks (y : t) in
                        if x /= y
                        then (1 : ret)
                        else (head ret + 1 : tail ret)
solve :: [Int64] -> Int64
solve a = let prefixSum = scanl (+) 0 $ map pred a in
          let sortedPrefixSums = sort prefixSum in
          let blocks = getBlocks sortedPrefixSums in
          let countPairs x = (x * (x - 1)) `div` 2 in
          let pairsPerBlock = map countPairs blocks in
          sum pairsPerBlock
doCaseIO :: Int64 -> IO ()
doCaseIO 0 = return ()
doCaseIO t = do
             _ <- getLine -- ignore string length
             s <- getLine
             (putStrLn . show . solve . map (fromIntegral . digitToInt)) s
             doCaseIO (t - 1)
main :: IO ()
main = do
       t <- readLn :: IO Int64
       doCaseIO t

{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import Data.Int
import Data.Char
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

solve :: String -> Int64
solve digitsString = pairsCount
    where
        pairsCount = sum $ map (\cnt -> (cnt * (cnt - 1)) `div` (2 :: Int64)) countGroups
        countGroups = map (\group -> (fromIntegral $ length group) :: Int64) . group $ sort digitSums
        digitSums = scanl' (+) 0 digits
        digits = map (\c -> (fromIntegral ((ord c) - (ord '0') - 1)) :: Int64) digitsString

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        n <- readIntB8 <$> B8.getLine
        digits <- (head . B8.words) <$> B8.getLine
        let answer = solve $ B8.unpack digits
        printf "%s\n" $ show answer

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

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

main = interact solve

type Input = [Int64]
type Output = Int64

solve :: String -> String
solve input = intercalate "\n" formattedOutputs
    where
        _:xs = words input
        inputs = inputParser xs
        outputs = map solver inputs
        formattedOutputs = map outputFormatter outputs

inputParser :: [String] -> [Input]
inputParser [] = []
inputParser (_:x:xs) = (readStr x):(inputParser xs)

readStr :: [Char] -> [Int64]
readStr = map (fromIntegral . Data.Char.digitToInt)

outputFormatter :: Output -> String
outputFormatter x = show x

type FoldState = (M.Map Int64 Int64, Int64)

solver :: Input -> Output
solver x =
    let
        sutr = map (\x -> x - 1) x
        sutr :: [Int64]
        cumul = scanl (+) 0 sutr
        cumul :: [Int64]
        (_, answer) = foldl' folder (M.empty, 0) cumul
    in answer

folder :: FoldState -> Int64 -> FoldState
folder (mm, cur) x
    | M.null mm = (M.insert x 1 mm, cur)
    | otherwise = (M.insertWith (+) x 1 mm, cur + (M.findWithDefault 0 x mm) )

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  _ <- getLine
  as <- map (\c -> read [c]) <$> getLine
  print $ solve as

solve :: [Int] -> Int
solve as = sum as''
  where
    as' = map (\x -> x-1) as
    pref = scanl (+) 0 as'
    as'' =map ((\ l -> (l * (l - 1)) `div` 2) . length) ((group.sort) pref)

import Data.List
import Data.Char
getBlocks :: Eq a => [a] -> [Int]
getBlocks [] = []
getBlocks [_] = [1]
getBlocks (x : y : t) = let ret = getBlocks (y : t) in
                        if x /= y
                        then (1 : ret)
                        else (head ret + 1 : tail ret)
solve :: [Int] -> Int
solve a = let prefixSum = scanl (+) 0 $ map pred a in
          let sortedPrefixSums = sort prefixSum in
          let blocks = getBlocks sortedPrefixSums in
          let countPairs x = (x * (x - 1)) `div` 2 in
          let pairsPerBlock = map countPairs blocks in
          sum pairsPerBlock
doCaseIO :: Int -> IO ()
doCaseIO 0 = return ()
doCaseIO t = do
             _ <- getLine -- ignore string length
             s <- getLine
             (putStrLn . show . solve . map digitToInt) s
             doCaseIO (t - 1)
main :: IO ()
main = do
       t <- readLn :: IO Int
       doCaseIO t

{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import Data.Int
import Data.Char
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

solve :: String -> Int64
solve digitsString = pairsCount
    where
        pairsCount = sum $ map (\cnt -> (cnt * (cnt - 1)) `div` 2) countGroups
        countGroups = map (\group -> (fromIntegral $ length group) :: Int64) . group $ sort digitSums
        digitSums = (scanl' (\x y -> x + y - 1) 0 digits)
        digits = map (\c -> (ord c) - (ord '0')) digitsString

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        n <- readIntB8 <$> B8.getLine
        digits <- B8.getLine
        let answer = solve $ B8.unpack digits
        printf "%lld\n" answer

{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import Data.Int
import Data.Char
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

solve :: String -> Int64
solve digitsString = pairsCount
    where
        pairsCount = sum $ map (\cnt -> (cnt * (cnt - 1)) `div` (2 :: Int64)) countGroups
        countGroups = map (\group -> (fromIntegral $ length group) :: Int64) . group $ sort digitSums
        digitSums = scanl' (+) 0 digits
        digits = map (\c -> (ord c) - (ord '0') - 1) digitsString

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        n <- readIntB8 <$> B8.getLine
        digits <- B8.getLine
        let answer = solve $ B8.unpack digits
        printf "%s\n" $ show answer

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

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

main = interact solve

type Input = [Int]
type Output = Int

solve :: String -> String
solve input = intercalate "\n" formattedOutputs
    where
        _:xs = words input
        inputs = inputParser xs
        outputs = map solver inputs
        formattedOutputs = map outputFormatter outputs

inputParser :: [String] -> [Input]
inputParser [] = []
inputParser (_:x:xs) = (readStr x):(inputParser xs)

readStr :: [Char] -> [Int]
readStr = map (Data.Char.digitToInt)

outputFormatter :: Output -> String
outputFormatter x = show x

type FoldState = (M.Map Int Int, Int)

solver :: Input -> Output
solver x =
    let
        sutr = map (\x -> x - 1) x
        sutr :: [Int]
        cumul = scanl (+) 0 sutr
        cumul :: [Int]
        (_, answer) = foldl' folder (M.empty, 0) cumul
    in answer

folder :: FoldState -> Int -> FoldState
folder (mm, cur) x
    | M.null mm = (M.insert x 1 mm, cur)
    | otherwise = (M.insertWith (+) x 1 mm, cur + (M.findWithDefault 0 x mm) )


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

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

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

main = do
    (n,m) <- readIntPair
    if n > m + 1 || m > 2*(n+1) then
        print $ -1
    else if n == m + 1 then
        putStrLn $ take (n+m) $ cycle "01"
    else if m > 2 * n then
        putStrLn $ take (n+m) $ cycle "110"
    else do
        let k = m - n
        putStrLn $ take (3*k) (cycle "110") ++ take (m+n - 3*k) (cycle "10")

main = interact $ g.map read .words.head.lines

g (x:y:[])
  | a == "-1" && b == "-1" = a
  | a == "-1" = b
  | otherwise = a
  where a = f x y [] 0
        b = f x y [] 1
f 0 0 ans st = ans
f x y ans st
  | x < 0 || y < 0 = "-1"
  | x - y  >= -1 && st == 1 = f x (y-1) ('1':ans) 0
  | st == 1 = f x (y-2) ('1':'1':ans) 0
  | otherwise = f (x - 1) y ('0':ans) 1

import qualified Data.ByteString.Char8 as B
main = B.putStrLn . B.concat . solve . map read . words =<< getLine
solve [n,m] | n > m+1 || m > 2*n+2 = [B.pack "-1"]
            | m == 2*n+2 = B.pack "11" : go n (m-2)
            | m == 2*n+1 = B.pack "1" : go n (m-1)
            | n == m+1 = go (n-1) m ++ [B.pack "0"]
            | otherwise = go n m
go n m = replicate (m-n) (B.pack "011") ++ replicate (2*n-m) (B.pack "01")

import Data.List

main=interact$f.map read.words
f[m,n]
  | n < m-1 || 2*(m+1) < n = "-1"
  | n+1 == m = take (n+m) $ '0':cycle"10"
  | n == m = take (n+m) $ cycle "10"
  | 2*(m+1) == n = take (n+m) $ cycle "110"
  | r <- n `mod`(m+1) = intercalate "0" $ replicate r "11" ++ replicate (m+1-r) "1"

main = interact $ g.map read .words.head.lines

g (x:y:[])
  | x >= y = f x y [] 0
  | otherwise = f x y [] 1

f 0 0 ans st = ans
f x y ans st
  | x < 0 || y < 0 = "-1"
  | x >= y && st == 1 = f x (y-1) ('1':ans) 0
  | st == 1 = f x (y-2) ('1':'1':ans) 0
  | otherwise = f (x - 1) y ('0':ans) 1

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

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

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

main = do
    (n,m) <- readIntPair
    if n > m + 1 || m > 2*(n+1) then
        print $ -1
    else if n == m + 1 then
        putStrLn $ take (n+m) $ cycle "01"
    else if m == 2 * (n+1) then
        putStrLn $ take (n+m) $ cycle "110"
    else do
        let k = m - n
        putStrLn $ take (3*k) (cycle "110") ++ take (m+n - 3*k) (cycle "10")

import qualified Data.ByteString.Char8 as B
main = B.putStrLn . B.concat . solve . map read . words =<< getLine
solve [n,m] | n > m+1 || m > 2*n+2 = [B.pack "-1"]
            | m == 2*n+2 = B.pack "11" : go n (m-2)
            | n == m+1 = go (n-1) m ++ [B.pack "0"]
            | otherwise = go n m
go n m = replicate (m-n) (B.pack "011") ++ replicate (2*n-m) (B.pack "01")


calc :: [String] -> ([String], Bool)
calc []                       = ([], False)
calc (['O','O','|',c,d]:rest) = (("++|" ++ [c , d]):rest, True)
calc ([a,b,'|','O','O']:rest) = (([a, b] ++ "|++"):rest, True)
calc (row:rest)               = (row:next, b)
  where
    (next, b) = calc rest

process :: String -> String
process str =
  let (header : body) = lines str
      n               = read header
      bus             = take n body
      (newBus, can)   = calc bus
  in
    if can then "YES\n" ++ unlines newBus else "NO"

main :: IO ()
main = interact process

import Control.Monad

-- plain string for output
newtype PlainString = PlainString String
instance Show PlainString where
  show (PlainString s) = s

main :: IO()
main = do
	input <- getLine
	let rows = read input :: Int
	bus <- replicateM (rows) getLine
	let found = findPlace bus 0

	if found >= 0
		then do
			printPlain "YES"
			printPlace bus 0 found
		else printPlain "NO"

printPlain :: [Char] -> IO()
printPlain str = print (PlainString str)

printSit :: [Char] -> IO()
printSit curRow
	| curRow !! 0 == 'O' && curRow !! 1 == 'O' = printPlain ("++" ++ (drop 2 curRow))
	| curRow !! 3 == 'O' && curRow !! 4 == 'O' = printPlain ((take 3 curRow) ++ "++")

printPlace :: [[Char]] -> Int -> Int -> IO()
printPlace [] _ _ = return ()
printPlace (curRow:rest) curRowNum sitNum
	| curRowNum == sitNum = do
				printSit curRow
				printPlace rest (curRowNum + 1) sitNum
	| otherwise = do 	printPlain curRow
				printPlace rest (curRowNum + 1) sitNum

findPlace :: [[Char]] -> Int -> Int
findPlace [] _ = -1
findPlace (curRow:rest) curRowNum
	| curRow !! 0 == 'O' && curRow !! 1 == 'O' = curRowNum
	| curRow !! 3 == 'O' && curRow !! 4 == 'O' = curRowNum
	| otherwise = findPlace rest (curRowNum + 1)

import Control.Monad
import Data.List (isInfixOf)

rep_f :: [Char] -> [Char]
rep_f ('O':'O':x) = ['+', '+']++x
rep_f (c:x) = c:rep_f x
rep_f [] = []

print_f :: [[Char]] -> [Bool] -> Bool -> IO ()
print_f (h:t) (True:t2) True = do
  putStrLn (rep_f h)
  print_f t t2 False
print_f (h:t) (_:t2) is_f = do
  putStrLn h
  print_f t t2 is_f
print_f _ _ _ = return ()

main :: IO ()
main = do
  n_s <- getLine
  seats <- replicateM (read n_s) getLine
  let free = (map (\x -> isInfixOf "OO" x) seats)
  if foldr (||) False free
    then do
      putStrLn "YES"
      print_f seats free True
    else putStrLn "NO"

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

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

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

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

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

main = do
	getLine
	seats <- getContents
	let
		res = solve seats
		ok = isJust res
	putStrLn $ which "YES" "NO" ok
	when ok $ do
		putStrLn $ fromJust res

solve [c] = Nothing
solve ( c1 : c2 : s )
	| c1 == 'O' && c2 == 'O' = Just $ "++" ++ s
	| otherwise = ( c1 : ) <$> solve ( c2 : s )

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# 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.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 (Map)
import qualified Data.Map as Map
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

replace a b t = f t []
  where
    f t r =
      case stripPrefix a t of
        Nothing -> f (tail t) $ (head t):r
        Just t' -> (reverse r) ++ b ++ t'

main = do
  getLine
  s <- getContents

  if "OO" `isInfixOf` s
    then do
      putStrLn "YES"
      putStr $ replace "OO" "++" s
    else
      putStrLn "NO"

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 >>= \n -> solve =<< (forM [1..read n] $ \i-> C.splitWith (=='|') <$> C.getLine)
solve xs = mapM_  (\as->C.putStrLn $ C.intercalate (C.singleton '|') as) $ filter (/=[]) $ slv1 $ break (\a-> a==C.pack "OO" || a==C.pack "OO\r") $ concat xs
slv1 (xs,[]) =[[C.pack "NO"]]
slv1 (xs,ys)= let zs = xs++[C.pack "++"]++tail ys in [[C.pack "YES"]]++zipWith (\a b -> if a `mod` 2 /=0 then b else [] ) [1..] (zipWith (\a b -> a:b:[]) zs (tail zs))

import Control.Monad

main = getLine >>= getLines . read >>= putStrLn . decide . parse

getLines :: Int -> IO [String]
getLines n = mapM (\_ -> getLine) [1..n]

parse :: [String] -> ([String], Bool)
parse rows = foldr parse' ([], False) rows
  where parse' row (rows, True) = (row:rows, True)
        parse' ('O':'O':xs) (rows, _) = (('+':'+':xs):rows, True)
        parse' (a:b:_:"OO") (rows, _) = ((a:b:"|++"):rows, True)
        parse' row (rows, _) = (row:rows, False)

decide :: ([String], Bool) -> String
decide (_, False) = "NO"
decide (rows, _) = unlines $ "YES":rows

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

readB8Int :: B8.ByteString -> Int
readB8Int = fst . fromJust . B8.readInt

solve :: [String] -> Maybe [String]
solve [] = Nothing
solve bus @ (f : other)
    | "OO" `isSuffixOf` f = Just ((take 3 f ++ "++") : other)
    | "OO" `isInfixOf` f = Just (("++" ++ drop 2 f) : other)
    | otherwise = (f :) <$> solve other

main :: IO ()
main = do
    n <- readInt <$> getLine
    bus <- replicateM n getLine
    let answer = unlines . ("YES" :) <$> solve bus
    printf "%s" $ fromMaybe "NO" answer

import Control.Monad(replicateM)
import Data.Functor ((<$>))

solve :: [String] -> Maybe [String]
solve [] = Nothing
solve (s:t)
    | take 2 s == "OO" = Just (("++" ++ drop 2 s) : t)
    | drop 3 s == "OO" = Just ((take 3 s ++ "++") : t)
    | otherwise = (s :) <$> solve t

main :: IO()
main = do
    n <- readLn :: IO Int
    s <- replicateM n getLine
    case solve s of
        Just s' -> do
            putStrLn "YES"
            putStr (unlines s')
        Nothing ->
            putStrLn "NO"

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

process2::String->(String,Int)
process2 s | take 2 s =="OO" = ("++" ++ drop 2 s,1)
           | drop 3 s =="OO" = (take 3 s ++ "++" ,1)
           | otherwise = (s,0)

process1::[String]->[String]
process1 s = s3
  where s1 =  map process2 s
        s2 = length $ takeWhile (\z-> snd z <1) s1
        s3 = (take (s2+1)  (map fst s1)) ++ (drop (s2+1) s)

process::[String]->[String]
process s | x==[] && y==[] = ["NO"]
          | otherwise = ["YES"] ++ ( process1 s)
  where x = take 1 $ filter (\z-> take 2 z =="OO" ) s
        y = take 1 $ filter (\z-> drop 3 z =="OO" ) s

main = do
  getLine
  s<- lines <$> getContents
  mapM_ putStrLn $  process s

module Main where

checkRow :: (Bool, [String]) -> String -> (Bool, [String])
checkRow (False, ys) ('O':'O':'|':a:b:"") = (True, ys ++ ['+':'+':'|':a:b:""])
checkRow (False, ys) (a:b:'|':'O':'O':"") = (True, ys ++ [a:b:'|':'+':'+':""])
checkRow (b, ys) s                        = (b, ys ++ [s])

render :: (Bool, [String]) -> String
render (True, ys) = "YES\n" ++ unlines ys
render (False, _) = "NO"

solve :: String -> String
solve input = let
    (header:body) = lines input
    n = read header
    ys = take n body
    in render $ foldl checkRow (False, []) ys

main :: IO ()
main = interact solve

{-# LANGUAGE FlexibleInstances #-}

module Main where

import           Control.Monad
import           Data.List     (intercalate)

checkRow :: (Bool, [String]) -> String -> (Bool, [String])
checkRow (False, ys) ('O':'O':'|':a:b:"") = (True, ys ++ ['+':'+':'|':a:b:""])
checkRow (False, ys) (a:b:'|':'O':'O':"") = (True, ys ++ [a:b:'|':'+':'+':""])
checkRow (b, ys) s                        = (b, ys ++ [s])

render :: (Bool, [String]) -> String
render (False, _) = "NO"
render (True, ys) = "YES\n" ++ intercalate "\n" ys

solve :: [String] -> String
solve ys = render $ foldl checkRow (False, []) ys

main :: IO ()
main = do
    n <- readLn
    xs <- replicateM n getLine
    putStrLn $ solve xs

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 -> Int
  readInt s = read s :: Int

  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

  considerSeats :: String -> (Bool, Bool)
  considerSeats ('O':'O':_) = (True, False)
  considerSeats (_:_:'|':'O':'O':_) = (False, True)
  considerSeats _ = (False, False)

  transform :: (Bool, Bool) -> String -> String
  transform (True, False) (a:b:s) = '+':'+':s
  transform (False, True) (a:b:s) =  a:b:"|++"

  reshow :: Bool -> [((Bool, Bool), String)] -> [String] -> [String]
  reshow _ [] accumulator = accumulator
  reshow True ((_, s):xs) accumulator                   = reshow True xs (s:accumulator)
  reshow False ((pred@(True, False), s):xs) accumulator = reshow True xs ((transform pred s):accumulator)
  reshow False ((pred@(False, True), s):xs) accumulator = reshow True xs ((transform pred s):accumulator)
  reshow False ((pred@(False, False), s):xs) accumulator  = reshow False xs (s:accumulator)

  hasTrue :: (Bool, Bool) -> Bool
  hasTrue (False, False) = False
  hasTrue _ = True

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    seats <- readMultilineInput n return
    let consideredSeats = considerSeats `map` seats
        hasAns = any hasTrue consideredSeats
        ans = consideredSeats `zip` seats
        action = case hasAns of
          False -> putStrLn "NO"
          True -> do
            putStrLn "YES"
            mapM_ putStrLn $ reverse $ reshow False ans []
    -- putStrLn $ show ans
    action

import Control.Monad( replicateM)
import Data.List( intercalate, elemIndex)
import Data.Maybe( fromJust)
main = do
    nmRows <- readLn
    let rowseat = getLine >>= return . (read::String->Rowseat)
	rowseat::IO Rowseat
    rowseatS <- replicateM nmRows rowseat
    let tryshit::Pairseat->Pairseat
	tryshit ps = case ps of
		    Empty   -> OK
		    ps	    -> ps
	tryrow (Rowseat (lp,rp)) = Rowseat (tryshit lp, tryshit rp)
	result = map tryrow rowseatS
	resultBusStr = intercalate "\n" $ map show result
	cleanse str =
	  let
	    point = fromJust $ elemIndex '+' str
	    (selectedPart, normalPart) = splitAt (point+2) str
	    cleansed = map (\c->if c=='+' then 'O' else c) normalPart
	  in
	    selectedPart++cleansed
    if elem '+' resultBusStr
	then putStrLn "YES" >> putStr (cleanse resultBusStr)
	else putStr "NO"

data Pairseat = Empty | Full | LEmpty | REmpty | OK
instance Read Pairseat where
    readsPrec _ str =
	tryParse [("OO",Empty), ("OX",LEmpty),
		    ("XO",REmpty), ("XX",Full)]
      where
	tryParse [] = []
	tryParse ((attempt, result):xs) =
	    if str == attempt
		then [(result, [])]
		else tryParse xs

instance Show Pairseat where
    show Empty = "OO"
    show LEmpty = "OX"
    show REmpty = "XO"
    show Full = "XX"
    show OK = "++"

data Rowseat = Rowseat (Pairseat,Pairseat)
instance Read Rowseat where
    readsPrec _ str =
	[(Rowseat (read [str!!0,str!!1], read [str!!3,str!!4]), [])]
instance Show Rowseat where
    show (Rowseat (lp,rp)) = show lp ++ "|" ++ show rp

import System.IO (interact)
import Data.List (find, isInfixOf)
import Control.Applicative ((<$>), (<*>))

g :: [String] -> Maybe [String]
g [] = Nothing
g (x:xs) = case x of
                'O':'O':ys -> Just $ ("++" ++ ys):xs
                a:b:c:"OO" -> Just $ (a:b:c:"++"):xs
                _ -> (:) <$> Just x <*> g xs

f :: [String] -> [String]
f x = case y of
        Nothing -> "NO":[]
        Just xs -> "YES":xs
  where y = g x

main = do
  _ <- getLine
  interact (unlines . f . lines)

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

process [] _ = putStrLn "NO"

process (s:ss) y | q1 || q2 = do
				putStrLn "YES"
				mapM_ putStrLn $ reverse y
				putStrLn $ if q1 then  ("++"++ (drop 2 s)) else ((take 3 s)++"++")

				mapM_ putStrLn $ ss

		 | otherwise = process ss (s:y)
	 where 	q1=isPrefixOf "OO" s
	 	q2=isSuffixOf "OO" s

main= do
		n<- read <$> getLine ::IO Int
		s<- replicateM n getLine
		process s []

import Control.Applicative
import Control.Monad

fixLine [] = Nothing
fixLine (l:ls) = case l of
  ['O','O', _ , _ , _ ] -> Just $ ("++"++ drop 2 l) : ls
  [ _ , _ , _ ,'O','O'] -> Just $ (take 3 l ++"++") : ls
  _ -> (l:) <$> (fixLine ls)

main = do
    n <- read <$> getLine
    lines <- replicateM n getLine
    case fixLine lines of
      Just x -> do putStrLn "YES"
                   mapM_ putStrLn x
      Nothing -> putStrLn "NO"

--ghc 7.10

import Data.List

findSeat :: [String] -> (Bool, [String])
findSeat [] = (False, [])
findSeat (row:rows)
    | lPair == "OO" = (True, ("++|" ++ rPair) : rows)
    | rPair == "OO" = (True, (lPair ++ "|++") : rows)
    | otherwise = (tr, row:rows')
    where
        (tr,rows') = findSeat rows
        [lPair,c:rPair] = groupBy (\a b -> b /= '|') row

main = do
    nStr <- getLine
    contents <- getContents
    let rows = lines contents
    let (tr,rows') = findSeat rows
    if tr
        then do
            putStrLn "YES"
            putStrLn . unlines $ rows'
        else putStrLn "NO"

main :: IO ()
main = do
        _:rows <- getLoS
        putStr $ unlines . printBus . busTransform $ rows

rowTransform :: String -> (Bool, String)
rowTransform ['O','O',a,b,c] = (True, ['+','+',a,b,c])
rowTransform [a,b,c, 'O','O'] = (True, [a,b,c, '+', '+'])
rowTransform row = (False, row)

busTransform :: [String] -> (Bool, [String])
busTransform [] = (False, [])
busTransform (x:xs)
    | success = (True, xTransformed : xs)
    | otherwise = (success', x : xs')
                        where
                            (success, xTransformed) = rowTransform x
                            (success', xs') = busTransform xs

printBus :: (Bool, [String])->[String]
printBus (True, xs) = "YES" : xs
printBus (False, xs) = ["NO"]

-- Boilerplate
getLoS :: IO [String]
getLoS = fmap lines getContents

getMoS :: IO [[String]]
getMoS = fmap (fmap words) getLoS

tokenizeLtM :: [String] -> [[String]]
tokenizeLtM = fmap words

main :: IO ()
main = do
        _ <- getLine
        interact $ unlines . render . busT . lines

busT :: [String] -> Maybe [String]
busT [] = Nothing
busT (x:xs) = case x of
                ['O','O',a,b,c] -> Just $ ['+','+',a,b,c]:xs
                [a,b,c, 'O','O'] -> Just $ [a,b,c, '+', '+']:xs
                _ -> fmap (x:) (busT  xs)

render :: Maybe [String] -> [String]
render (Just xs) = "YES" : xs
render _ = ["NO"]

import Control.Monad
import Data.List (isInfixOf)

rep_f :: [Char] -> [Char]
rep_f ('O':'O':x) = ['+', '+']++x
rep_f (_:x) = rep_f x
rep_f [] = []

print_f :: [[Char]] -> [Bool] -> Bool -> IO ()
print_f (h:t) (True:t2) True = do
  putStrLn (rep_f h)
  print_f t t2 False
print_f (h:t) (_:t2) is_f = do
  putStrLn h
  print_f t t2 is_f
print_f _ _ _ = return ()

main :: IO ()
main = do
  n_s <- getLine
  seats <- replicateM (read n_s) getLine
  let free = (map (\x -> isInfixOf "OO" x) seats)
  if foldr (||) False free
    then do
      putStrLn "YES"
      print_f seats free True
    else putStrLn "NO"

import Control.Monad
import Data.List (isInfixOf)

rep_f :: [Char] -> [Char]
rep_f ('O':'O':x) = ['+', '+']++x
rep_f (_:x) = rep_f x
rep_f [] = []

print_f :: [[Char]] -> [Bool] -> Bool -> IO ()
print_f (h:t) (True:t2) True = do
  putStrLn (rep_f h)
  print_f t t2 False
print_f (h:t) (_:t2) is_f = do
  putStrLn h
  print_f t t2 is_f
print_f _ _ _ = return ()

main :: IO ()
main = do
  n_s <- getLine
  seats <- replicateM (read n_s) getLine
  let free = (map (\x -> isInfixOf "OO" x) seats)
  if foldr (||) False free
    then print_f seats free True
    else putStrLn "NO"

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 >>= \n -> solve =<< (forM [1..read n] $ \i-> C.splitWith (=='|') <$> C.getLine)
solve xs = mapM_  (\as->C.putStrLn $ C.intercalate (C.singleton '|') as) $ filter (/=[]) $ slv1 $ break (==C.pack "OO") $ concat xs
slv1 (xs,[]) =[[C.pack "NO"]]
slv1 (xs,ys)= let zs = xs++[C.pack "++"]++tail ys in [[C.pack "YES"]]++zipWith (\a b -> if a `mod` 2 /=0 then b else [] ) [1..] (zipWith (\a b -> a:b:[]) zs (tail zs))

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

process2::String->(String,Int)
process2 s | take 2 s =="XX" = ("++" ++ drop 2 s,1)
           | drop 3 s =="XX" = (take 3 s ++ "++" ,1)
           | otherwise = (s,0)

process1::[String]->[String]
process1 s = s3
  where s1 =  map process2 s
        s2 = length $ takeWhile (\z-> snd z <1) s1
        s3 = (take (s2+1)  (map fst s1)) ++ (drop (s2+1) s)

process::[String]->[String]
process s | x==[] && y==[] = ["NO"]
          | otherwise = ["YES"] ++ ( process1 s)
  where x = take 1 $ filter (\z-> take 2 z =="XX" ) s
        y = take 1 $ filter (\z-> drop 3 z =="XX" ) s

main = do
  getLine
  s<- lines <$> getContents
  mapM_ putStrLn $  process s

module Main where

checkRow :: (Bool, [String]) -> String -> (Bool, [String])
checkRow (False, ys) ('O':'O':'|':a:b:"") = (True, ys ++ ['+':'+':'|':a:b:""])
checkRow (False, ys) (a:b:'|':'O':'O':"") = (True, ys ++ [a:b:'|':'+':'+':""])
checkRow (b, ys) s                        = (b, ys ++ [s])

render :: (Bool, [String]) -> String
render (True, ys) = "YES\n" ++ unlines ys
render (False, _) = "NO"

solve :: String -> String
solve input = let
    (header:body) = lines input
    n = read header
    ys = take n body
    in render (False, ys)

main :: IO ()
main = interact solve

import Control.Monad( replicateM)
import Data.List( intercalate)
main = do
    nmRows <- readLn
    let rowseat = getLine >>= return . (read::String->Rowseat)
	rowseat::IO Rowseat
    rowseatS <- replicateM nmRows rowseat
    let tryshit::Pairseat->Pairseat
	tryshit ps = case ps of
		    Empty   -> Selected
		    ps	    -> ps
	tryrow (Rowseat (lp,rp)) = Rowseat (tryshit lp, tryshit rp)
	result = map tryrow rowseatS
	resultBusStr = intercalate "\n" $ map show result
    if elem '+' resultBusStr
	then putStrLn "YES" >> putStr resultBusStr
	else putStr "NO"

data Pairseat = Empty | Full | LEmpty | REmpty | Selected
instance Read Pairseat where
    readsPrec _ str =
	tryParse [("OO",Empty), ("OX",LEmpty),
		    ("XO",REmpty), ("XX",Full)]
      where
	tryParse [] = []
	tryParse ((attempt, result):xs) =
	    if str == attempt
		then [(result, [])]
		else tryParse xs

instance Show Pairseat where
    show Empty = "OO"
    show LEmpty = "OX"
    show REmpty = "XO"
    show Full = "XX"
    show Selected = "++"

data Rowseat = Rowseat (Pairseat,Pairseat)
instance Read Rowseat where
    readsPrec _ str =
	[(Rowseat (read [str!!0,str!!1], read [str!!3,str!!4]), [])]
instance Show Rowseat where
    show (Rowseat (lp,rp)) = show lp ++ "|" ++ show rp

main :: IO ()
main = do
        _ <- getLine
        interact $ unlines . render . busT . lines

busT :: [String] -> Maybe [String]
busT [] = Nothing
busT (x:xs) = case x of
                ['O','O',a,b,c] -> Just $ ['O','O',a,b,c]:xs
                [a,b,c, 'O','O'] -> Just $ [a,b,c, '+', '+']:xs
                _ -> fmap (x:) (busT  xs)

render :: Maybe [String] -> [String]
render (Just xs) = "YES" : xs
render _ = ["NO"]


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

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [Int]
 where fn x = let Just (y,_) = B.readInt x in y

main = do
    n <- readLn :: IO Int
    a <- fmap sort readIntList
    print $ if even n then a!!((n `div` 2)-1) else a!!(n `div` 2)

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

f :: [String] -> [Int]
f = map read

main = do
	getLine
	t <- B.getLine
	let l = map (fst . M.fromJust . B.readInt) $ B.words $ t
	let q = sort $ l
	let q2 = if odd (length q)
				then q !! (length q `div` 2)
				else q !! (length q `div` 2 - 1)
	print q2

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

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [Int]
 where fn x = let Just (y,_) = B.readInt x in y

main = do
    [n] <- readIntList
    a <- readIntList
    print $ if even n then a!!((n `div` 2)-1) else a!!(n `div` 2)

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

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [Int]
 where fn x = let Just (y,_) = B.readInt x in y

main = do
    n <- readLn :: IO Int
    a <- readIntList
    print $ if even n then a!!((n `div` 2)-1) else a!!(n `div` 2)

import Data.List

main = do
    n <- readLn :: IO Int
    a <- fmap (sort . (map read) . words) getLine :: IO [Int]
    print $ a!!((n `div` 2)-1)

import Data.List

f :: [String] -> [Int]
f = map read
g :: (Num a) => [a] -> a
g q = sum $ take 2 $ (drop (length q `div` 2 - 1) q)

main = do
	getLine
	t <- getLine
	let q = map fromIntegral $ sort $ f $ words t :: [Double]
	let q2 = if odd (length q)
				then q !! (length q `div` 2)
				else
					g q/2
	print $ round (subtract 0.00000000001 q2)

calc x = round $ sum x / (fromIntegral . length $ x)
toNums = map read . words

main = do
	getLine
	t <- getLine
	print $ calc $ toNums t


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

import qualified Data.Array as A

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

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

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

intNat :: Natural -> Int
intNat = fromInteger . toInteger

solve :: Natural -> Natural -> Maybe [Natural]
solve n k
	| n <= 2*k = Nothing
	| otherwise = Just $ fmap (+1) $ fmap aux [0..(n-1)]
	where
		aux i
			| i == 0 = 0
			| i > 2*k = i
			| mod i 2 == 0 = i - 1
			| mod i 2 == 1 = i + 1

showR :: Maybe [Natural] -> String
showR (Just list) = foldr (\i s -> show i ++ " " ++ s) [] list
showR Nothing = "-1"

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

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

readInts = fmap (map read.words) getLine :: IO [Int]
printArray [] = ""
printArray (x:xs) = show(x) ++" " ++ printArray xs

combine [] b = b
combine a [] = a
combine (x:a) (y:b) = [x,y] ++ combine a b

printS = do
    [n,k]<-readInts
    if k + 1 > div (n+1) 2 then putStrLn"-1"
    else do
        let a = take (n - k) [1..n]
            b = reverse $ drop (n-k) [1..n]
        putStrLn $ printArray $ combine a b

main = do
    t<-readLn
    replicateM_ t printS

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

import qualified Data.Array as A

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

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

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

intNat :: Natural -> Int
intNat = fromInteger . toInteger

solve :: Natural -> Natural -> Maybe [Natural]
solve n k
	| n < 2*k = Nothing
	| otherwise = Just $ fmap (+1) $ fmap aux [0..(n-1)]
	where
		aux i
			| i == 0 = 0
			| i > 2*k = i
			| mod i 2 == 0 = i - 1
			| mod i 2 == 1 = i + 1

showR :: Maybe [Natural] -> String
showR (Just list) = foldr (\i s -> show i ++ " " ++ s) [] list
showR Nothing = "-1"

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

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

import qualified Data.Array as A

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

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

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

intNat :: Natural -> Int
intNat = fromInteger . toInteger

solve :: Natural -> Natural -> Maybe [Natural]
solve n k
	| 2*k >= n = Nothing
	| otherwise = Just $ fmap (+1) $ fmap aux [0..(n-1)]
	where
		aux i
			| i == 0 = 0
			| 2*k >= i = i
			| i == (n-1) = n-1
			| mod i 2 == 0 = i - 1
			| mod i 2 == 1 = i + 1

showR :: Maybe [Natural] -> String
showR (Just list) = foldr (\i s -> show i ++ " " ++ s) [] list
showR Nothing = "-1"

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


main = getLine >> fmap (map read . words) getLine >>= print . solve
solve :: [Int] -> Int
solve xs = length $ filter isSurprise lists
    where lists = map (\n -> take n xs) [2..length xs]
isSurprise :: [Int] -> Bool
isSurprise xs = all (>current) previous || all (<current) previous
    where current = last xs
          previous = init xs

module Main (main)
    where

import Data.List (group)

main :: IO ()
main = print . solve . map read . words =<< (getLine >> getLine)
    where solve :: [Int] -> Int
          solve xs = length (mins xs) + length (maxes xs) - 2
          mins  = scanWith min
          maxes = scanWith max
          scanWith f = map head . group . scanl1 f

main = do
    getLine
    x <- getLine
    putStr (solve (map read (words x)))

solve:: [Integer] -> String
solve (x:xs) = show (result 0 x x xs)
result r min max x
    |x==[]                  = r
    |head x>max             = result (r+1) min (head x) (tail x)
    |head x<min             = result (r+1) (head x) max (tail x)
    |otherwise              = result r min max (tail x)

module Main where

import Control.Monad
import Data.List

considerContest (acc, minScore, maxScore) thisScore =
  let
    minScore' = min minScore thisScore
    maxScore' = max maxScore thisScore
    acc' = acc + if thisScore < minScore || thisScore > maxScore
      then 1
      else 0
  in (acc', minScore', maxScore')

main = do
  n <- liftM read getLine :: IO Int
  ss <- liftM ( map read . words ) getLine :: IO [Int]

  let
    (res, _, _) = foldl considerContest (-1, maxBound, minBound) ss

  putStrLn $ show res

main = do
	n<-getLine
	rest<-getLine
	let dat=words rest
	putStrLn $ show $ solve (tail (map read dat)) (read(head dat)) (read(head dat)) 0

solve::[Int]->Int->Int->Int->Int
solve [] _ _ count = count
solve (v:vs) mini maxi count | v > maxi = solve vs mini v (count+1)
                           | v < mini = solve vs v maxi (count+1)
                           | otherwise = solve vs mini maxi count

solve [x] = 0
solve (x:xs) = (solve xs) + c where c = if (all (>x) xs || all (<x) xs) then 1 else 0
main= getLine>>do
        xs <- getLine>>=return . map (read :: String -> Int) . words
        print $ solve $ reverse xs

module Main(main) where
import System.IO
import Data.List

main = interact real_main
real_main inp =
	let (n:nmbs) = map (read::String->Int) . words $ inp
	    (cnt, _, _) = foldl' (\(n, mx, mn) x -> if x > mx then (n + 1, x, mn) else if x < mn then (n + 1, mx, x) else (n, mx, mn)) (0, head nmbs, head nmbs) nmbs
	in show cnt ++ "\n"

fu xs max min ans | null xs = ans | head xs > max = fu ys y min ans+1 | head xs < min = fu ys max y ans+1 | otherwise = fu ys max min ans
    where
          ys = tail xs
          y = head xs
solve :: (Integral a) => [a] -> a
solve xs = fu (tail xs) (xs !! 1) (xs !! 1) 0
main =  interact $ show . solve . map read . words

import Data.List

findAmazing :: [Int] -> Int
findAmazing [_] = 0
findAmazing xs
    | all (< (last xs)) (init xs) = 1 + findAmazing (init xs)
    | all (> (last xs)) (init xs) = 1 + findAmazing (init xs)
    | otherwise = findAmazing (init xs)

main = do
  n <- getLine
  inStr <- getLine
  let points = map (\x -> read x :: Int) . words $ inStr
  print $ findAmazing points

main = do
  getLine
  xs <- fmap (map read . words) getLine :: IO [Int]
  let
    m1 = scanl1 max xs
    m2 = scanl1 min xs

    c1 = length $ filter (\(a, b) -> a > b) $ zip (tail xs) m1
    c2 = length $ filter (\(a, b) -> a < b) $ zip (tail xs) m2

  print $ c1 + c2

import Data.List

boolToInt :: Bool -> Int
boolToInt num | num == True = 1
              | num == False = 0

readNumbers str = map readInt $ words str
    where readInt = read :: String -> Int

run numbers = sum [boolToInt (num < minim || num > maxim) |
                   [num, minim, maxim] <- tail $ transpose [numbers, min_list, max_list]]
-- $ zip min_list max_list]
    where
        lim = 10000
        min_list = scanl min lim numbers
        max_list = scanl max (-lim) numbers

main = do
    getLine
    numbers_str <- getLine
    putStrLn $ show $ run $ readNumbers numbers_str

{-# LANGUAGE BangPatterns #-}

(-->) = flip fmap

solve :: [Int] -> Int
solve [] = 0
solve [a] = 0
solve (a:as) = go a a as 0
  where
    go min max [] !c = c
    go min max (a:as) c
      | a < min = go a max as (c+1)
      | a > max = go min a as (c+1)
      | otherwise = go min max as c

main = do
  n <- getLine --> read :: IO Int
  nums <- getLine --> words --> map read
  print $ solve nums

import Data.List
import qualified Data.Map as M
(|>) x f = f x

main = interact process

process contents = let
  ls = contents |> lines |> map words |> map (map read) :: [[Int]]
  in solve (ls !! 1) |> show

solve nums = solve' (head nums) (head nums) (tail nums)

solve' _ _ [] = 0
solve' minSoFar maxSoFar (x:xs)
  | x < minSoFar = 1 + solve' x maxSoFar xs
  | x > maxSoFar = 1 + solve' minSoFar x xs
  | otherwise = solve' minSoFar maxSoFar xs

main =
  do
    n <- readLn :: IO Int
    s <- getLine
    let list = map read (words s) :: [Int]
    print (f (tail list) (head list) (head list) 0)

f [] a b count = count
f (x:xs) a b count =
  let f1 = max x a
      f2 = min x b
      count1 = if f1 == a then 0 else 1
      count2 = if f2 == b then 0 else 1
  in f xs f1 f2 (count+count1+count2)

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

solve (n:xss) = solve' (-1) (-1) xs 0 where
    xs = take n xss
    solve' (-1) (-1) (x:xs) 0 = solve' x x xs 0
    solve' _    _    []     k = k
    solve' mn   mx   (x:xs) k
        | x < mn    = solve' x  mx xs (k + 1)
        | x > mx    = solve' mn x  xs (k + 1)
        | otherwise = solve' mn mx xs k

main = do
    str <- getLine
    let n = read str
    aux <- getLine
    let xs = map read $ words aux :: [Int]

    let solve = _solve 0 0 where
        _solve i ans
            | i == n = ans
            | i == 0 = _solve (i + 1) ans
            | otherwise = if (xs !! i > maximum (take i xs) || xs !! i < minimum (take i xs)) then _solve (i + 1) (ans + 1) else _solve (i + 1) ans

    print solve

import Control.Applicative

solve :: [Int] -> Int
solve (x:xs) = solve' xs x x
    where solve' []     mn mx = 0
          solve' (x:xs) mn mx = let a = if mn > x then 1 else 0
                                    b = if mx < x then 1 else 0
                                in  a + b + solve' xs (min mn x) (max mx x)

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

main = getLine >> getLine >>= putStrLn . show . thrd . amazing . map read . words

amazing :: [Int] -> (Int,Int,Int)
amazing (x:xs) = foldl ( svfn ) (x,x,0) xs

thrd (a,b,c) = c;

svfn (mx,mn,n) y =  if y < mn
						then (mx,y,n+1)
						else if y > mx
								then (y,mn,n+1)
								else (mx,mn,n)

import Data.List
import Data.Maybe
import Data.Char
import Data.Function
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve. tail.concat.map (map read.words). take 2. lines
solve :: [Integer]->String
solve (x:xs) = show $ last $ foldl (\[bma,bmi,bre] a->if a>bma then [a,bmi,bre+1]
 else if a<bmi then [bma,a,bre+1] else [bma,bmi,bre]) [x,x,0] (x:xs)

module Main where

main = do
    _ <- getLine
    s <- getLine
    let bs = reverse (map read (words s)) :: [Int]
    print(solve bs)

solve (b:[]) = 0
solve (b:bs)
    | (b > maximum bs) = solve bs + 1
    | (b < minimum bs) = solve bs + 1
    | otherwise = solve bs

main = let solve (x:xs) = (let (_,_,z) = foldl (\(a, b, c) y -> (max a y, min b y, c + (if (y > a) || (y < b) then 1 else 0)) ) (x,x,0) xs in z) in getLine >>= const (fmap (map read . words) getLine :: IO [Int]) >>= (putStrLn . show . solve)

import List

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

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

solve :: [Int] -> Int
solve (x:xs)  =  solve' (x, x) 0 xs
  where
    solve' _ n []  =  n
    solve' (a, b) n (x:xs)
      | x < a      =  solve' (x, b) (n+1) xs
      | b < x      =  solve' (a, x) (n+1) xs
      | otherwise  =  solve' (a, b) n xs

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

import Control.Applicative

main = do
  _ <- getLine
  (x:xs) <- map read . words <$> getLine :: IO [Int]
  print $ cnt 0 x x xs

cnt a _ _ []     = a
cnt a m n (x:xs) =
  let nc = a + fromEnum (x > m) + fromEnum (x < n)
      nm = max m x
      nn = min n x
  in cnt nc nm nn xs

solve :: [Int] -> Int
solve (x:xs) = let (_, _, ans) = foldl playContest (x, x, 0) xs
               in ans
  where playContest (mn, mx, ans) x
          | mn > x = (x, mx, ans + 1)
          | mx < x = (mn, x, ans + 1)
          | True   = (mn, mx, ans)

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

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

toD :: Int -> Double
toD = fromIntegral

solve1 :: (Int -> Int -> Bool) -> [Int] -> Int
solve1 _ [] = 0
solve1 f (h:t)  = 1 + solve1 f (dropWhile (f h) t)

solve :: [Int] -> Int
solve = subtract 2 . liftM2 (+) (solve1 (<=)) (solve1 (>=))

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

module Main where

readi :: String -> Int
readi = read

parseSolve x = initSolve $ map readi $ words x

solve :: Int -> Int -> [Int] -> Int
solve _ _ [] = 0
solve xmin xmax (h:t)
    | h < xmin = 1 + (solve h xmax t)
    | h > xmax = 1 + (solve xmin h t)
    | otherwise = (solve xmin xmax t)

initSolve :: [Int] -> Int
initSolve (h:t) = solve h h t

main = do
    _ <- getLine
    line <- getLine
    print $ parseSolve line

import Control.Applicative

process [] _ _ a = a
process (a:as) mi ma co | a<mi = process as a ma (co+1)
                        | a>ma = process as mi a (co+1)
                        | otherwise = process as mi ma co

main=do
     getLine
     q<-  map read <$> words <$> getLine::IO [Int]
     print $ process q (head q) (head q) 0

import Data.List
import Data.Char
import qualified Data.Set as Set
import Control.Monad
import Control.Applicative
main = do
  n <- getLine
  xs <- map read . words <$> getLine
  print (solve xs)

solve (x:xs) = f xs t t 0
  where
    t = fromIntegral x
    f [] _ _ acc = acc
    f (x:xs) min max acc
      | x < min = f xs x max (acc+1)
      | x > max = f xs min x (acc+1)
      | otherwise = f xs min max acc

import Data.List (inits)

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

solve :: [Int] -> Int
solve xs = length $ filter id $ zipWith f (tail xs) (tail $ inits xs)
  where f y ys = y < minimum ys || maximum ys < y

main = print . fst . foldl contest (-1,(minBound,maxBound :: Int)) .
       map read . tail . words =<< getContents
contest (a,(u,l)) s | s > u || s < l = (a+1,(max u s,min l s))
                    | otherwise      = (a,(u,l))

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

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

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

amazing :: (Int -> Int -> Bool) -> [Int] -> Int
amazing _ [] = 0
amazing f (h:t) = 1 + amazing f (dropWhile (f h) t)

solve :: [Int] -> Int
solve = subtract 2 . liftM2 (+) (amazing (<=)) (amazing (>=))

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

import Data.List
import Control.Applicative

main = do _ <- getLine
          xs <- map read . words <$> getLine
          print $ solve xs

solve :: [Int] -> Int
solve xxs@(x:xs) = fst $ foldl' f (0,(x,x)) xs

f :: (Int,(Int,Int)) -> Int -> (Int,(Int,Int))
f (i,(x,y)) z
  | z < x = (i+1,(z,y))
  | y < z = (i+1,(x,z))
  | otherwise = (i,(x,y))

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

func :: [Int] -> Int
func (x:xs) = ct (x,x) xs

ct (a,b) (x:xs) = (if x < a || x > b then 1 else 0) + ct (minimum [a,x], maximum [b,x]) xs
ct _ _ = 0

import Control.Applicative

solve :: [Int] -> Int -> Int -> Int
solve [] _ _ = 0
solve (a:as) mn mx
  | mn > a = 1 + solve as a mx
  | mx < a = 1 + solve as mn a
  | otherwise = solve as mn mx

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

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

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

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

Vasya adores sport programming. He can't write programs but he loves to watch the contests' progress. Vasya even has a favorite coder and Vasya pays special attention to him.

One day Vasya decided to collect the results of all contests where his favorite coder participated and track the progress of his coolness. For each contest where this coder participated, he wrote out a single non-negative number — the number of points his favorite coder earned in the contest. Vasya wrote out the points for the contest in the order, in which the contests run (naturally, no two contests ran simultaneously).

Vasya considers a coder's performance in a contest amazing in two situations: he can break either his best or his worst performance record. First, it is amazing if during the contest the coder earns strictly more points that he earned on each past contest. Second, it is amazing if during the contest the coder earns strictly less points that he earned on each past contest. A coder's first contest isn't considered amazing. Now he wants to count the number of amazing performances the coder had throughout his whole history of participating in contests. But the list of earned points turned out long and Vasya can't code... That's why he asks you to help him.

Input
------
The first line contains the single integer n (1 ≤ n ≤ 1000) — the number of contests where the coder participated.

The next line contains n space-separated non-negative integer numbers — they are the points which the coder has earned. The points are given in the chronological order. All points do not exceed 10000.

Output
------
Print the single number — the number of amazing performances the coder has had during his whole history of participating in the contests.

Sample test(s)
---------------
input
5
100 50 200 150 200
output
2

input
10
4664 6496 5814 7010 5762 5736 6944 4850 3698 7242
output
4

Note
------
In the first sample the performances number 2 and 3 are amazing.

In the second sample the performances number 2, 4, 9 and 10 are amazing.

-}

import Data.List (tails)

countAmazing :: [Int] -> Int
countAmazing xs = length $ filter (\(y:ys) -> y > maximum ys || y < minimum ys) yys
  where yys = (takeWhile ((> 1) . length) . tails . reverse) xs

main = do
  input <- getContents
  let points = (map read . words . last . lines) input
  print $ countAmazing points

main::IO ()
main = do cs <- getContents
          (putStr . show . solve . parse) cs

parse::String->[Int]
parse s = map (\x -> read x::Int) (words k)
            where
              [_,k] = lines s

solve_step::(Int,Int,Int)->Int->(Int,Int,Int)
solve_step (min,max,cnt) i
    | i < min = (i,max,cnt+1)
    | i > max = (min,i,cnt+1)
    | otherwise = (min,max,cnt)

solve :: [Int] -> Int
solve [] = 0;
solve (k:ks) = ret
                 where
                   (_,_,ret) = foldl solve_step (k,k,0) ks

import Data.List
main = getLine >> getLine >>= putStrLn.show.solve.map read.words

solve :: [Int] -> Int
solve [one] = 0
solve many  = sum $ map (flip calc many) [min, max]

calc f = pred.length.nub.scanl1 f

process :: [Int] -> Int
process xs = best + wrst
    where
        best = snd $ foldl (\a@(ax,an) x -> if x > ax then (x,an+1) else a) (minBound,(-1)) xs
        wrst = snd $ foldl (\a@(ax,an) x -> if x < ax then (x,an+1) else a) (maxBound,(-1)) xs

readInt :: String -> Int
readInt = read

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

main = do
	_ <- getLine
	b_s <- getLine
	let (b:bs) = (map read (words b_s)) :: [Int]
	putStrLn.show $ solve bs [b] [b]

solve [] (h:hs) (l:ls) = length (h:hs) + length (l:ls) - 2
solve (b:bs) (h:hs) (l:ls)
	| (b > h) = solve bs (b:h:hs) (l:ls)
	| (b < l) = solve bs (h:hs) (b:l:ls)
	| otherwise = solve bs (h:hs) (l:ls)

countAmazing :: [Int] -> Int
countAmazing xs = count
    where (_, _, count) =  foldl accumulator (maxBound :: Int, minBound :: Int, 0) xs

accumulator :: (Int, Int, Int) -> Int -> (Int, Int, Int)
accumulator (mi, ma, count) current = (mi', ma', count')
    where mi' = min mi current
          ma' = max ma current
          count' = count + fromEnum ((mi' < mi) /= (ma' > ma))

solve :: String -> String
solve = show . countAmazing . fmap read . tail . words

main :: IO ()
main = interact solve

import Data.List

countAmazing :: [Int] -> Int
countAmazing xs = sum $ fmap (countMutations xs) [min, max]

countMutations :: [Int] -> (Int -> Int -> Int) -> Int
countMutations xs = pred . length . group . (`scanl1` xs)

solve :: String -> String
solve = show . countAmazing . fmap read . tail . words

main :: IO ()
main = interact solve

solve :: [Integer] -> Integer
solve (lh:lt) =
    third . subsolve $ lt
        where third (_, _, x) = x
              funk old@(mx, mn, ac) hd
                   | hd > mx = (hd, mn, ac + 1)
                   | hd < mn = (mx, hd, ac + 1)
                   | otherwise = old
              subsolve = foldl funk (lh, lh, 0)

main = do
  _ <- getLine
  numbers <- getLine
  print $ solve (map read (words numbers))

import Control.Applicative

main = do
  n <- getLine
  xs <- map read . words <$> getLine
  print $ cnt 0 (-1) xs

cnt a _ []     = a
cnt a m (x:xs)
  | x > m     = cnt (a+1) x xs
  | otherwise = cnt a m xs

import Control.Applicative

process [] _ _ a = a
process (a:as) mi ma co | a<mi = process as a ma (co+1)
                        | a>ma = process as mi a (co+1)
                        | otherwise = process as mi ma co

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

main = print . fst . foldl contest (0,(minBound,maxBound :: Int)) .
       map read . tail . words =<< getContents
contest (a,(u,l)) s | s > u || s < l = (a+1,(max u s,min u l))
                    | otherwise      = (a,(u,l))

main = interact $ show . func . tail . words

func (x:xs) = ct (x,x) xs

ct (a,b) (x:xs) = (if x < a || x > b then 1 else 0) + ct (minimum [a,x], maximum [b,x]) xs
ct _ _ = 0


import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  n <- read <$> getLine
  board <- replicateM n $ getLine
  putStrLn $ solve board

solve :: [[Char]] -> String
solve b = if length invalidList >= 1 then "NO" else "YES"
  where
    checkList   = map (filter $ within n) [[(x-1,y),(x+1,y),(x,y-1),(x,y+1)] | x <- [0..n-1], y <- [0..n-1]]
    countList   = map (cnt b) checkList
    invalidList = filter (\x -> (x `mod` 2) == 1) countList
    n           = length b

cnt :: [[Char]] -> [(Int,Int)] -> Int
cnt b [] = 0
cnt b ((x,y):lx) = c + (cnt b lx)
  where c = if ((b !! x) !! y) == 'o' then 1 else 0

within :: Int -> (Int, Int) -> Bool
within n (x, y) = (x >= 0) && (y >= 0) && (x <= n-1) && (y <= n-1)

-- from submiession by qqz003 http://codeforces.com/contest/462/submission/7685448

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (mapMaybe)
import qualified Data.List as L
import qualified Data.ByteString.Lazy.Char8 as LC

main :: IO ()
main = LC.interact $ LC.pack . solve . map (map (\x -> if x=='o' then 1 else 0)) . tail . map LC.unpack . LC.words

solve :: [[Int]] -> String
solve a = if (all even transform) then "YES" else "NO"
          where
              transform = zipWith (+) (concat . map add $ a) (concat . L.transpose . map add $ L.transpose a)

add a = zipWith (+) (tail a ++ [0]) (0 : init a)

-- from submiession by qqz003 http://codeforces.com/contest/462/submission/7685448

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (mapMaybe)
import qualified Data.List as L
import qualified Data.ByteString.Lazy.Char8 as LC

main :: IO ()
main = LC.interact $ LC.pack . solve . map (map (\x -> if x=='o' then 1 else 0)) . tail . map LC.unpack . LC.words

solve :: [[Int]] -> String
solve a = if (all even f3) then "YES" else "NO"
          where
              f1 = map add a
              f2 = map add $ L.transpose a
              f3 = zipWith (+) (concat f1) (concat $ L.transpose f2)

add a = zipWith (+) (tail a ++ [0]) (0 : init a)

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

main = interact $ getAns . map (map (\x -> if x == 'o' then 1 else 0)) . tail . lines

shiftL x = tail x ++ [0]

shiftR x = 0 : init x

crossAdd x = zipWith (+) (shiftL x) (shiftR x)

getAns :: [[Int]] -> String
getAns x = let na = map crossAdd x;
			   nb = map crossAdd $ transpose x;
			   nc = zipWith (+) (concat na) $ (concat $ transpose nb);
		   in if (all even nc) then "YES" else "NO"

{-# 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
  n <- readLn
  a <- replicateM n getLine

  let
    a' = listArray ((1, 1), (n, n)) $ concat a :: UArray (Int, Int) Char

    b = and [f i j | i <- [1..n], j <- [1..n]]
      where
        f i j = even $ length [(ii, jj) | (ii, jj) <- [(i+1,j), (i-1,j), (i,j-1), (i,j+1)], 1 <= ii && ii <= n && 1 <= jj && jj <= n, a'!(ii, jj) == 'o']

  putStrLn $ if b then "YES" else "NO"

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedStrings    #-}

module Main where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Trans.State
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.List
import           Data.Maybe

type BString = B.ByteString

type Result = BString

type Matrix = [String]

solve :: Matrix -> Result
solve matrix
    | not $ symmetrical matrix = "NO"
    | not $ symmetrical $ reverse matrix = "NO"
    | otherwise = "YES"
    where symmetrical m = m == transpose m

process :: State Reader Result
process = do
    n <- parse
    matrix <- replicateM n parse
    return $ solve matrix
--    return (matrix, transpose matrix)

main :: IO ()
main = do
    input <- B.lines <$> B.getContents
    say $ evalState process input

say :: Display a => a -> IO ()
say = putStrLn . display

type Reader = [BString]

class Display a =>
      EIO a where
    parse :: State Reader a
    parse = state $ \(line:rest) -> (scan line, rest)

instance EIO Int
instance EIO [Int]
instance EIO String
instance EIO BString

class (Read a, Show a) =>
      Display a where
    display :: a -> String
    scan :: BString -> a
    display = show
    scan = read . B.unpack

instance Display String where
    display = id
    scan = takeWhile (/='\r') . B.unpack

instance Display BString where
    display = B.unpack
    scan = id

instance Display Int where
    scan = fst . fromJust . B.readInt

instance Display [Int] where
    display = unwords . map display
    scan = unfoldr (B.readInt . B.dropWhile (== ' '))

instance Display [[Int]] where
    display = unlines . map display

main :: IO ()
main = getContents >>= putStrLn . yesno . solve . lines

solve :: [String] -> Bool
solve (ns:cs) = all even [ length [ () | (di, dj) <- [(-1, 0), (1, 0), (0, -1), (0, 1)]
                                       , 0 <= i + di, i + di < n
                                       , 0 <= j + dj, j + dj < n
                                       , cs !! (i + di) !! (j + dj) == 'o' ]
                                       | i <- [0..n-1], j <- [0..n-1] ]
  where n = read ns

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

import Data.Array
main = do
  n <- readLn
  g <- listArray ((1,1),(n,n)) . concat . lines <$> getContents
  let neighbors (i,j) = filter (inRange (bounds g)) [(i-1,j),(i+1,j),(i,j-1),(i,j+1)]
  putStrLn $ if all (even . length . filter ((== 'o') . (g!)) . neighbors)  (indices g) then "YES" else "NO"

import Control.Applicative
import Data.Array

main=do
	n<- read <$> getLine:: IO Int
	s<-    concat . lines<$>getContents
	let x = listArray ((1,1),(n,n)) s
	let y = array((1,1),(n,n)) [((i,j),m)| i<-[1..n],j<-[1..n],let m =length $ filter (=='o') $ map (x!)$filter (\z-> fst z >0 && fst z<=n && snd z >0 && snd z<=n) [(i-1,j),(i+1,j),(i,j-1),(i,j+1)]]
	let z= length $ take 1 $ filter (odd) $ elems y
	putStrLn $ if z==1 then "NO" else "YES"

-- from submiession by qqz003 http://codeforces.com/contest/462/submission/7685448

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (mapMaybe)
import qualified Data.List as L
import qualified Data.ByteString.Lazy.Char8 as LC

main :: IO ()
main = LC.interact $ LC.pack . show . solve . map (map (\x -> if x=='o' then 1 else 0)) . tail . map LC.unpack . LC.words

solve :: [[Int]] -> String
solve a = if (all even f3) then "YES" else "NO"
          where
              f1 = map add a
              f2 = map add $ L.transpose a
              f3 = zipWith (+) (concat f1) (concat $ L.transpose f2)

add a = zipWith (+) (tail a ++ [0]) (0 : init a)

{-# 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
  n <- readLn
  a <- replicateM n getLine

  let
    a' = listArray ((1, 1), (n, n)) $ concat a :: UArray (Int, Int) Char

    b = and [f i j | i <- [1..n], j <- [1..n]]
      where
        f i j = if a'!(i, j) == 'o' then True else even $ length [(ii, jj) | (ii, jj) <- [(i+1,j), (i-1,j), (i,j-1), (i,j+1)], 1 <= ii && ii <= n && 1 <= jj && jj <= n, a'!(ii, jj) == 'o']

  putStrLn $ if b then "YES" else "NO"

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedStrings    #-}

module Main where

import           Control.Applicative
import           Control.Category           ((>>>))
import           Control.Monad
import           Control.Monad.Trans.State
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.HashMap.Lazy          as HM
import           Data.List
import           Data.Maybe

type BString = B.ByteString

type Result = BString

type Matrix = [String]

solve :: Matrix -> Result
solve matrix
    | symmetrical matrix = "YES"
    | otherwise = "NO"
    where symmetrical m = m == transpose m

--process :: State Reader Result
process = do
    n <- parse
    matrix <- replicateM n parse
    return $ solve matrix
--    return (matrix, transpose matrix)

main :: IO ()
main = do
    input <- B.lines <$> B.getContents
    say $ evalState process input

say :: Display a => a -> IO ()
say = putStrLn . display

type Reader = [BString]

class Display a =>
      EIO a where
    parse :: State Reader a
    parse = state $ \(line:rest) -> (scan line, rest)

instance EIO Int
instance EIO [Int]
instance EIO [Char]
instance EIO BString

class (Read a, Show a) =>
      Display a where
    display :: a -> String
    scan :: BString -> a
    display = show
    scan = read . B.unpack

instance Display String where
    display = id
    scan = B.unpack

instance Display BString where
    display = B.unpack
    scan = id

instance Display Int where
    scan = fst . fromJust . B.readInt

instance Display [Int] where
    display = unwords . map display
    scan = unfoldr (B.readInt . B.dropWhile (== ' '))

instance Display [[Int]] where
    display = unlines . map display

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedStrings    #-}

module Main where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Trans.State
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.List
import           Data.Maybe

type BString = B.ByteString

type Result = BString

type Matrix = [String]

solve :: Matrix -> Result
solve matrix
    | symmetrical matrix = "YES"
    | otherwise = "NO"
    where symmetrical m = m == transpose m

process :: State Reader Result
process = do
    n <- parse
    matrix <- replicateM n parse
    return $ solve matrix
--    return (matrix, transpose matrix)

main :: IO ()
main = do
    input <- B.lines <$> B.getContents
    say $ evalState process input

say :: Display a => a -> IO ()
say = putStrLn . display

type Reader = [BString]

class Display a =>
      EIO a where
    parse :: State Reader a
    parse = state $ \(line:rest) -> (scan line, rest)

instance EIO Int
instance EIO [Int]
instance EIO String
instance EIO BString

class (Read a, Show a) =>
      Display a where
    display :: a -> String
    scan :: BString -> a
    display = show
    scan = read . B.unpack

instance Display String where
    display = id
    scan = takeWhile (/='\r') . B.unpack

instance Display BString where
    display = B.unpack
    scan = id

instance Display Int where
    scan = fst . fromJust . B.readInt

instance Display [Int] where
    display = unwords . map display
    scan = unfoldr (B.readInt . B.dropWhile (== ' '))

instance Display [[Int]] where
    display = unlines . map display

main :: IO ()
main = getContents >>= putStrLn . yesno . solve . lines

solve :: [String] -> Bool
solve (ns:cs) = all even [ length [ () | (di, dj) <- [(-1, 0), (1, 0), (0, -1), (0, 1)]
                                       , 0 <= i + di, i + di < n
                                       , 0 <= j + dj, j + dj < n
                                       , cs !! i !! j == 'o' ]
                                       | i <- [0..n-1], j <- [0..n-1] ]
  where n = read ns

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"


{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
-- {-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

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

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

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

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

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

{- solution -}

solve :: Int -> [Int] -> Maybe Int
solve n as = if finalCnt2 >= n
        then Just steps
        else Nothing
    where
        powers2 = L.iterate (*2) 2
        cntPowers2 x = L.length $ L.takeWhile (\md -> x `mod` md == 0) powers2

        cnt2 :: Int
        cnt2 = L.sum . L.map cntPowers2 $ as

        cnts2 :: [(Int, Int)]
        cnts2 = L.sortOn ((* (-1)) . snd) $ L.map (\i -> (i, cntPowers2 i)) [1..n]

        solve' :: ((), (Int, Int))
        solve' = flip MS.execStateT (0 :: Int, cnt2) $ do
            M.forM_ cnts2 $ \(i, iCnt2) ->
                M.runMaybeT $ do
                    (steps, cnt2) <- MS.get
                    M.guard $ cnt2 < n
                    M.guard $ iCnt2 > 0
                    MS.modify (\(steps, cnt2) -> (steps + 1, cnt2 + iCnt2))

        (_, (steps, finalCnt2)) = solve'

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = fromMaybe (-1) $ solve n as
        printf "%d\n" answer

module Main where

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

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

twoFactors :: Int -> Int
twoFactors v
  | even v    = 1 + twoFactors (v `div` 2)
  | otherwise = 0

solve :: [Int] -> Int
solve vs = case dropWhile (\(_, v) -> v < requiredTwoFactors) gainableTwoFactors of
              x:_ -> fst x
              _   -> -1
  where availableTwoFactors = sum $ map twoFactors vs
        requiredTwoFactors = max 0 $ length vs - availableTwoFactors
        gainableTwoFactors = [0..] `zip` scanl (+) 0 (reverse . sort . filter (/= 0) $ map twoFactors [1..length vs])
                              -- Pair of (i, v): with i steps a gain of v two factors is possible.

handleTestCase :: IO ()
handleTestCase = do
  B.getLine
  vs <- map readInt . B.words <$> B.getLine
  print $ solve vs

readInt :: B.ByteString -> Int
readInt = maybe 0 fst . B.readInt

main :: IO ()
main = do
  numberTestCases <- read <$> getLine
  replicateM_ numberTestCases handleTestCase

module Main where

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

twoFactors :: Int -> Int
twoFactors v
  | even v    = 1 + twoFactors (v `div` 2)
  | otherwise = 0

solve :: [Int] -> Int
solve vs = case dropWhile (\(_, v) -> v < requiredTwoFactors) gainableTwoFactors of
              x:_ -> fst x
              _   -> -1
  where availableTwoFactors = sum $ map twoFactors vs
        requiredTwoFactors = max 0 $ length vs - availableTwoFactors
        gainableTwoFactors = [0..] `zip` scanl (+) 0 (reverse . sort . filter (/= 0) $ map twoFactors [1..length vs])
                              -- Pair of (i, v): with i steps a gain of v two factors is possible.

handleTestCase :: IO ()
handleTestCase = do
  getLine
  vs <- map read . words <$> getLine
  print $ solve vs

main :: IO ()
main = do
  numberTestCases <- read <$> getLine
  replicateM_ numberTestCases handleTestCase

module Main where

import Control.Monad (replicateM_)

intLogBase :: Int -> Int -> Int
intLogBase b v
  | v >= b    = 1 + intLogBase (2 * b) v
  | otherwise = 0

twoFactors :: Int -> Int
twoFactors v
  | even v    = 1 + twoFactors (v `div` 2)
  | otherwise = 0

solve :: [Int] -> Int
solve vs = case dropWhile (\(_, v) -> v < requiredTwoFactors) gainableTwoFactors of
              x:_ -> fst x
              _   -> -1
  where availableTwoFactors = sum $ map twoFactors vs
        requiredTwoFactors = max 0 $ length vs - availableTwoFactors
        gainableTwoFactors = [0..] `zip` scanl (+) 0 (reverse [1..intLogBase 2 (length vs)])
                              -- Pair of (i, v): with i steps a gain of v two factors is possible.

handleTestCase :: IO ()
handleTestCase = do
  getLine
  vs <- map read . words <$> getLine
  print $ solve vs

main :: IO ()
main = do
  numberTestCases <- read <$> getLine
  replicateM_ numberTestCases handleTestCase


import Data.List

answer :: Int -> [Int] -> Int
answer k xs = answer' k (reverse $ sort xs) where
  answer' k xs
    | (k >= l) = m
    | otherwise = m + answer' k (drop k xs) where
      l = length xs
      m = 2 * (head xs - 1)

main = do
    s <- getLine
    let (n:k:xs) = map read (words s)
    t <- getLine
    let ys = map read (words t)
    putStrLn (show (answer k ys))

import Data.List

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

solve :: [Int] -> Int
solve (n:k:f) =
    let sf = (sortBy (flip compare) f)
    in (solve' sf k) * 2
    where
        solve' :: [Int] -> Int -> Int
        solve' []     _ = 0
        solve' (f:fs) i | i == k    = f - 1 + (solve' fs 1)
                        | otherwise = solve' fs (i + 1)

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

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

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

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

solve :: Int -> Int -> [Int] -> Int
solve n k fs' = go fs where
    fs = reverse $ sort $ map pred fs'
    go [] = 0
    go l = 2 * head l + go l' where
        l' = drop k l

import System.IO
import Data.List

main :: IO ()
main = do
	line1 <- getLine
	let k = head . tail . map read . words $ line1
	line2 <- getLine
	let nums = map read . words $ line2
	print . minTime k $ sortBy (flip compare) nums

minTime :: Integer -> [Integer] -> Integer
minTime _ [] = 0
minTime k xs = 2 * (maxFloor - 1) + minTime k rest
	where
		(batch, rest) = splitAt (fromIntegral k) xs
		maxFloor = head batch

-- Codeforces 472B

import Data.List

main :: IO ()
main = do
    [n, k] <- fmap (map read . words) getLine :: IO [Int]
    people <- fmap (reverse . sort . map read . words) getLine :: IO [Int]
    print $ solve k people where
        solve k people
            | length people == 0 = 0
            | length people <= k = 2 * (maximum people - 1)
            | otherwise = 2 * (head people - 1) + solve k (drop k people)

import Data.List (sortBy)

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

solve :: [[Int]] -> Int
solve [[_, k], fs] = (2*) $ sum [ f | (i, f) <- zip [0..] $ map (subtract 1) $ sortBy (flip compare) fs, i `mod` k == 0 ]
solve _ = undefined

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

slices :: Int -> [a] -> [[a]]
slices n xs = map(take n).takeWhile(not.null) $ iterate(drop n)xs
{-# INLINE slices #-}

main :: IO ()
main = do
  [n,k] <- map read.words <$> getLine
  fs <- map readInt.B.words <$> B.getContents
  print $ solve k fs

solve :: Int -> [Int] -> Int
solve k fs = foldl' (\acc xs->2 * (maximum xs - 1) + acc) 0.slices k $ sortBy (flip compare) fs

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

solve k [] = 0
solve k (h : hs) = h * 2 + solve k (drop (k-1) hs)

main = do
  [n,k] <- getInts
  fs <- reverse . sort . map (subtract 1) <$> getInts
  let solution = [solve k fs]
  putStrLn $ unwords $ map show solution

-- helper functions --

readInt = fst . fromJust . B.readInt
getInts = map readInt . B.words <$> B.getLine

memoArr :: Ix i => (i, i) -> (i -> r) -> (i -> r)
memoArr range f = f' where
  f' i
    | Arr.inRange range i = arr ! i
    | otherwise = f i
  arr = Arr.listArray range (map f (Arr.range range))

dpArr :: Ix i => (i, i) -> ((i -> r) -> (i -> r)) -> (i -> r)
dpArr ixs f = fix (memoArr ixs . f)

import Data.List

main = interact $ show . sum.sl . map read . words
sl (n:k:f) = map ((!!) $ reverse.sort $ map (\x -> x*2-2) f) [0, k..n-1]

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

chunkmax _ [] = []
chunkmax n s = head s: ( chunkmax n (drop n s))

main= do
	[n,m] <-map read. words <$> getLine   ::IO [Int]
	s<-reverse.sort.map read. words <$> getLine   ::IO [Int]
	let s1 = chunkmax m s
	print $ 2*((sum s1) - (length s1))

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

solve k [] = 0
solve k (h : hs) = h * 2 + solve k (drop (k-1) hs)

main = do
  [n,k] <- getInts
  fs <- reverse . sort <$> getInts
  let solution = [solve k fs]
  putStrLn $ unwords $ map show solution

-- helper functions --

readInt = fst . fromJust . B.readInt
getInts = map readInt . B.words <$> B.getLine

memoArr :: Ix i => (i, i) -> (i -> r) -> (i -> r)
memoArr range f = f' where
  f' i
    | Arr.inRange range i = arr ! i
    | otherwise = f i
  arr = Arr.listArray range (map f (Arr.range range))

dpArr :: Ix i => (i, i) -> ((i -> r) -> (i -> r)) -> (i -> r)
dpArr ixs f = fix (memoArr ixs . f)

import Data.List

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

sol (_:k:f) =  (*2) . sum . ct . sort $ f
    where ct [] = []
          ct x = head x - 1 : (ct $ drop k x)


import Control.Monad

type Test = (Integer, Integer, Integer)

getLines :: Int -> IO [Test]
getLines n = replicateM n getTest

getTest :: IO Test
getTest = do
    test <- getLine
    let [n, m, k] = map read (words test)
    return (n, m, k)

getAnswer :: [Test] -> [Integer]
getAnswer [] = []
getAnswer (first:rest) = solve first : getAnswer rest

solve :: Test -> Integer
solve (n, m, k) = maxJokers - nextMaxJokers
    where maxJokers = min (n `div` k) m
          a = fromIntegral (m - maxJokers)
          b = fromIntegral (k - 1)
          nextMaxJokers = ceiling (a/b)

main :: IO ()
main = do
    count <- getLine
    tests <- getLines $ read count
    mapM_ print (getAnswer tests)

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

main = getLine >>= flip replicateM_ test . read

test = do
    (n:m:k:_) <- map read . words <$> getLine
    let d = n `div` k
    print $ bool (d - (m - d - 1) `div` (k - 1) - 1) m (m <= d)

module Main where

solve :: Int -> Int -> Int -> Int
solve cards jokers players =
  let hand     = cards `div` players
      -- Split the remaining jokers among the other players
      maxrival = q + min 1 r
          where (q, r) = (jokers - hand) `quotRem` (players - 1)
  in  if jokers <= hand then jokers else hand - maxrival

readCase :: Int -> IO ()
readCase 0       = return ()
readCase casenum = do
  l <- getLine
  let [n, m, k] = (map read . words) l :: [Int]
  print $ solve n m k
  readCase (casenum - 1)

main = getLine >>= (readCase . (read :: String -> Int))

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

parse :: String -> (Int, Int, Int)
parse s = (n, m, k)
  where
    [n, m, k] = map read . words $ s

solve :: (Int, Int, Int) -> Int
solve (n, m, k) = x - y
  where
    x = min (div n k) m
    y = div (m - x + k - 2) (k - 1)

module Main where
    solve :: IO ()
    solve = do
        s <- getLine
        let [n, m, k] = map (\x -> read x :: Integer) $ words s
            x = min m (n `div` k)
        putStrLn $ show $ x - (m - x + k - 2) `div` (k - 1)

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter (n - 1)

    main :: IO ()
    main = do
        s <- getLine
        let q = read s :: Integer
        iter q

solve :: [[Int]] -> [Int]
solve [] = []
solve ([n,m,k]:xs) = (count n m k ) : (solve xs)

count :: Int -> Int -> Int -> Int
count n m k = winnerJ - secondJ
	where
		card = n `div` k
		winnerJ = min m card
		secondJ = (m - winnerJ + k - 2) `div` (k-1)

main = do
	t' <- getLine
	let t = read t' :: Int
	input' <- getContents
	let input = map (map read) (take t (map words (lines input'))) :: [[Int]]
	let result = solve input
	mapM print result

import Data.List

-- import Debug.Trace

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

split = _split [] ""

main = do
  input <- getContents
  let (_:vals) = read <$> split input :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []          -> Nothing
          n:m:k:rest  ->
            let handSize = n `div` k
                winner = min handSize m
                bestLoser = (m - winner + k - 2) `div` (k - 1)
                subres = winner - bestLoser
            in Just (subres, rest)
        ) vals
  sequence_ (putStrLn . show <$> res)

solve :: (Int, Int, Int) -> Int
solve (n, m, k) = let  sz = div n k  in  case  ()  of
  () | sz >= m   -> m  -- all jokers in one hand
     | otherwise -> case  divMod (m - sz) (k-1)  of
       (excess, 0) -> sz - excess  -- distribute evenly
       (excess, _) -> sz - excess - 1

parse :: String -> [(Int, Int, Int)]
parse inp = [(n, m, k) | [n, m, k] <- map (map read . words) (tail $ lines inp)]

main :: IO ()
main = interact (unlines . map (show . solve) . parse)


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

sumEvens [] = 0
sumEvens [x] = x
sumEvens (x:y:xs) = (+x) $ sumEvens xs

testCandyEven [] _ _ _ _ = 0
testCandyEven (x:xs) esf osf eall oall = (+rez) $ testCandyOdd xs (esf + x) osf erest oall
  where erest = eall - x
        rez = if (erest + osf) == (oall + esf) then 1 else 0

testCandyOdd [] _ _ _ _ = 0
testCandyOdd (x:xs) esf osf eall oall = (+rez) $ testCandyEven xs esf (osf + x) eall orest
  where orest = oall - x
        rez = if (eall + osf) == (orest + esf) then 1 else 0

main=do
 n <- readLn::IO Int
 v <- map (fst . fromJust . B.readInt).B.words <$> B.getLine
 let se = sumEvens v
 let sodd = (sum v) - se
 print $ testCandyEven v 0 0 se sodd

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 n:xs = map fastRead . words $ input
        numbers = xs
        numbersA :: A.Array Int64 Int64
        numbersA = A.listArray (0, n-1) numbers
        reversed = reverse numbers

        dp :: A.Array (Int, Int64, Int64) Int64
        dp = A.array ((-1, 0, -1), (1, 1, n)) [((dir, pol, i), calcSum dir pol i) | dir <- [-1, 1], pol <- [0, 1], i <- [-1..n]]
        calcSum :: Int -> Int64 -> Int64 -> Int64
        calcSum 1 polarity i
            | i >= n = 0
            | i `mod` 2 == polarity = numbersA!i + dp!(1, polarity, i + 1)
            | otherwise = dp!(1, polarity, i + 1)
        calcSum (-1) polarity i
            | i < 0 = 0
            | i `mod` 2 == polarity = numbersA!i + dp!(-1, polarity, i - 1)
            | otherwise = dp!(-1, polarity, i - 1)

        isOkAt i =
            let totalP1 = toLeft + toRight2
                totalP2 = toLeft2 + toRight
                toRight = calcSum 1 polarity i+1
                toRight2 = calcSum 1 ipolarity i+1
                toLeft = calcSum (-1) polarity i-1
                toLeft2 = calcSum (-1) ipolarity i-1
                polarity = i `mod` 2
                ipolarity = 1 - polarity
            in totalP1 == totalP2
    in show . length $ filter isOkAt [0..(n-1)]
    -- in show $ calcSum 1 1 0

import Data.List(scanl')

proc :: [Int] -> Int -> [Int]
proc [a] x = []
proc (a:b:c) x = (a+b-x):(proc (b:c) x)

ft' :: Int -> [a] -> (Int -> Bool) -> a -> [a]
ft' _ [] _ _ = []
ft' i (a:b) f x = (if (f i) then a else x) : (ft' (succ i) b f x)

ft = ft' 0

getsame :: [Int] -> [Int] -> Int
getsame [] _ = 0
getsame _ [] = 0
getsame (a:b) (c:d) = (if a == c then 1 else 0)+getsame b d
main = do
    nstr <- getLine
    let n = (read::String->Int) nstr
    str <- getLine
    let a = map (read::String->Int) $ words str
    let to = length a - 1
    let odds  = scanl' (+) 0 $ ft a odd 0
    let evens = scanl' (+) 0 $ ft a even 0
    print $ getsame (proc odds $ last odds) (proc evens $ last evens)

import Data.List
import Control.Monad

sumEvens [] = 0
sumEvens [x] = x
sumEvens (x:y:xs) = (+x) $ sumEvens xs

testCandyEven [] _ _ _ _ = 0
testCandyEven (x:xs) esf osf eall oall = (+rez) $ testCandyOdd xs (esf + x) osf erest oall
  where erest = eall - x
        rez = if (erest + osf) == (oall + esf) then 1 else 0

testCandyOdd [] _ _ _ _ = 0
testCandyOdd (x:xs) esf osf eall oall = (+rez) $ testCandyEven xs esf (osf + x) eall orest
  where orest = oall - x
        rez = if (eall + osf) == (orest + esf) then 1 else 0

main=do
 n <- readLn::IO Int
 v <- map (read::String->Int).words <$> getLine
 let se = sumEvens v
 let sodd = (sum v) - se
 print $ testCandyEven v 0 0 se sodd

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 n:xs = map fastRead . words $ input
        numbers = xs
        numbersA :: A.Array Int64 Int64
        numbersA = A.listArray (0, n-1) numbers
        reversed = reverse numbers

        dp :: A.Array (Int, Int64, Int64) Int64
        dp = A.array ((-1, 0, -1), (1, 1, n)) (do {
            dir <- [-1, 1];
            pol <- [0, 1];
            i <- [-1..n];
            return ((dir, pol, i), calcSum dir pol i);
        })

        calcSum :: Int -> Int64 -> Int64 -> Int64
        calcSum 1 polarity i
            | i >= n = 0
            | i `mod` 2 == polarity = numbersA!i + dp!(1, polarity, i + 1)
            | otherwise = dp!(1, polarity, i + 1)
        calcSum (-1) polarity i
            | i < 0 = 0
            | i `mod` 2 == polarity = numbersA!i + dp!(-1, polarity, i - 1)
            | otherwise = dp!(-1, polarity, i - 1)

        isOkAt i =
            let totalP1 = toLeft + toRight2
                totalP2 = toLeft2 + toRight
                toRight = calcSum 1 polarity i+1
                toRight2 = calcSum 1 ipolarity i+1
                toLeft = calcSum (-1) polarity i-1
                toLeft2 = calcSum (-1) ipolarity i-1
                polarity = i `mod` 2
                ipolarity = 1 - polarity
            in totalP1 == totalP2
    in show . length $ filter isOkAt [0..(n-1)]
    -- in show $ calcSum 1 1 0


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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    k <- getInt
    let
      nc2 = n * (n - 1) `div` 2
      tarXorTotal = nc2 - 2 * k

      numPairs = n `div` 2
      canSolve = inRange (numPairs, numPairs * (n - 1)) tarXorTotal

      tryWith baselineXor = let
        lastPairsXor = (tarXorTotal - baselineXor * (numPairs - 2)) `div` 2

        basicArr = array (0, n-1) [(i, i `xor` baselineXor) | i <- [0 .. n-1]]
        toLi :: UArray Int Int -> [[Int]]
        toLi arr = [[i, j] | (i, j) <- assocs arr, i < j]
        in  if  inRange (1, n - 1) lastPairsXor
        then  Just $ if  baselineXor == lastPairsXor
          then  toLi basicArr
          else  toLi $ basicArr //
            [ (0, lastPairsXor)
            , (lastPairsXor, 0)
            , (baselineXor, baselineXor `xor` lastPairsXor)
            , (baselineXor `xor` lastPairsXor, baselineXor)
            ]
        else  Nothing

      ans = if  canSolve
        then  head $ mapMaybe tryWith [1 .. n - 1]
        else  [[-1]]
    pure $ foldMap putInts ans

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

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

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

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

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

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

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    k <- getInt
    let
      basicArr = listArray (0, n-1) [n-1, n-2 .. 0]
      directArr x = basicArr // [(x, n-1), (n-1, x), (0, n-1-x), (n-1-x, 0)]
      s = div n 2
      maxArr = directArr (k-1) // [(s+1, s-1), (s-1, s+1), (s-2, s), (s, s-2)]
      toLi :: UArray Int Int -> [[Int]]
      toLi arr = [[i, j] | (i, j) <- assocs arr, i < j]
      ans = if  n == 4 && k == 3
        then  [[-1]]
        else  if  k < n - 1
        then  toLi $ directArr k
        else  toLi maxArr
    pure $ foldMap putInts ans

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

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

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

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

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

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