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

--process::String->Int->Int->Bool
--process [] a b =   a*b==1
--process [_] a b =   a*b==1
--process (x1:x2:xs) a b | a*b==1 = True
--	               | a==0 && x1=='A' && x2=='B' = or [process xs 1 b,process (x2:xs) a b]
--                       | b==0 && x1=='B' && x2=='A' = or [process xs a 1,process (x2:xs) a b]
--		       | otherwise = process (x2:xs) a b

process x | (all C.null [x3,x4])  = False
	  | otherwise = True
	where x1 = snd $ C.breakSubstring (C.pack "AB") x
              x2 = snd $ C.breakSubstring (C.pack "BA") x
	      x3 = snd $ C.breakSubstring (C.pack "BA") $ C.drop 2 x1
	      x4 = snd $ C.breakSubstring (C.pack "AB") $ C.drop 2 x2

main= do
	x<- C.getLine
	putStrLn $ if process x   then "YES" else "NO"

import Control.Arrow ((&&&))
import Data.Functor ((<$>))
import Data.List (isPrefixOf)

main :: IO ()
main = putStrLn <$> yesno =<< solve <$> getLine

solve :: String -> Bool
solve = faraway 2 . (listIndices 0 "AB" &&& listIndices 0 "BA")

listIndices :: Eq a => Int -> [a] -> [a] -> [Int]
listIndices _ _ [] = []
listIndices n xs yss@(_:ys) | xs `isPrefixOf` yss = n : listIndices (n + 1) xs ys
                            | otherwise = listIndices (n + 1) xs ys

faraway :: Int -> ([Int], [Int]) -> Bool
faraway n (xs, ys) = not (null xs) && not (null ys) && (n <= abs (head xs - last ys) || n <= abs (last xs - head ys))

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

import Control.Applicative
main = interact $ merge Nothing Nothing Nothing Nothing . solve 0
solve i ('A':cs@('B':_)) = Left  i : solve (i+1) cs
solve i ('B':cs@('A':_)) = Right i : solve (i+1) cs
solve i (c:cs) = solve (i+1) cs
solve _ _ = []
merge fa la fb lb (Left  i:is) = merge (fa <|> Just i) (Just i) fb lb is
merge fa la fb lb (Right i:is) = merge fa la (fb <|> Just i) (Just i) is
merge fa la fb lb _ | liftA2 ((abs .) . (-)) fa lb > Just 1 = "YES"
                    | liftA2 ((abs .) . (-)) la fb > Just 1 = "YES"
                    | otherwise = "NO"

import Data.List (isPrefixOf)

check' :: String -> [String] -> Bool
check' _ [] = True
check' [] _ = False
check' s both@(p:ps)
  | p `isPrefixOf` s = check' (drop 2 s) ps
  | otherwise = check' (tail s) both

{-check' s subs-}
  {-| null subs = True-}
  {-| length s < 2 = False-}
  {-| (head subs) `isPrefixOf` s = check' (drop 2 s) (tail subs)-}
  {-| otherwise = check' (tail s) subs-}

check :: String -> String
check s
  | check' s ["AB", "BA"] || check' s ["BA", "AB"] = "YES"
  | otherwise = "NO"

main = do
  ans <- fmap check getLine
  putStrLn ans

import Data.List (isPrefixOf)

check' :: String -> [String] -> Bool
check' s subs
  | null subs = True
  | null s = False
  | (head subs) `isPrefixOf` s = check' (drop 2 s) (tail subs)
  | otherwise = check' (tail s) subs

{-check' _ [] = True-}
{-check' [] _ = False-}
{-check' s both@(p:ps)-}
  {-| p `isPrefixOf` s = check' (drop 2 s) ps-}
  {-| otherwise = check' (tail s) both-}

check :: String -> String
check s
  | check' s ["AB", "BA"] || check' s ["BA", "AB"] = "YES"
  | otherwise = "NO"

main = do
  ans <- fmap check getLine
  putStrLn ans

main = interact $ p . (\inp -> solve 'A' 'B' inp False || solve 'B' 'A' inp False)

p b = if b then "YES" else "NO"

solve :: Char -> Char -> [Char] -> Bool -> Bool
solve a b (x:y:xs) m
  | (m && x == b && y == a) = True
  | (not m && x == a && y == b) = solve a b xs (not m)
  | otherwise = solve a b (y : xs) m
solve _ _ _ _ = False

main = do
    inp <- getLine
    putStrLn $ ans inp

ans inp = if findFirst inp "AB" "BA" || findFirst inp "BA" "AB"
            then "YES"
            else "NO"

findFirst (x:y:xs) str1 str2 = if [x,y] == str1
                                    then findSecond xs str2
                                    else findFirst (y:xs) str1 str2
findFirst _ _ _ = False

findSecond (b:a:bs) str = if [b,a] == str
                            then True
                            else findSecond (a:bs) str
findSecond _ _ = False

import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.Text as T

ab= T.pack "AB"
ba= T.pack "BA"
nu= T.pack ""

check n | (snd $ T.breakOn ba $ T.drop 2$ snd $ T.breakOn ab n) /=nu = True
	| (snd $ T.breakOn ab $ T.drop 2$ snd $ T.breakOn ba n) /=nu = True
	| otherwise = False

main = do

	n<-   getLine
	putStrLn $ if check (T.pack n) then "YES" else "NO"

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

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

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

main = do
	s <- getLine
	putStrLn $ which "YES" "NO" $ solve s [ "AB", "BA" ] || solve s [ "BA", "AB" ]

solve _ [] = True
solve [] _ = False
solve [a] _ = False
solve s tt@(t:ts)
	| t `isPrefixOf` s = solve ( drop 2 s ) ts
	| otherwise = solve ( drop 1 s ) tt

f :: String -> Bool
f s =
  let chars = zip [0 ..] (zip s (tail s))
      l1   = [ i | (i, ('A', 'B')) <- chars ]
      l2   = [ i | (i, ('B', 'A')) <- chars ]
  in  (not . null) [ (i, j) | i <- l1, j <- l2, abs (i-j) > 1 ]

main = interact $ \x -> if f x then "YES" else "NO"

import Data.List (isPrefixOf)

check :: String -> Bool
check s = recur ["AB", "BA"] s || recur ["BA", "AB"] s
          where recur [] _  = True
                recur _  [] = False
                recur (p : ps) s
                    | p `isPrefixOf` s = recur      ps  (drop (length p) s)
                    | otherwise        = recur (p : ps) (tail s)

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

main :: IO ()
main = putStrLn . format . check =<< getLine

import Data.List (isInfixOf)

solve :: String -> Bool
solve ('A':'B':'A':cs) = isInfixOf "AB" cs || isInfixOf "BA" cs
solve ('B':'A':'B':cs) = isInfixOf "AB" cs || isInfixOf "BA" cs
solve ('A':'B':cs) = isInfixOf "BA" cs
solve ('B':'A':cs) = isInfixOf "AB" cs
solve (_:cs) = solve cs
solve [] = False

displ :: Bool -> String
displ True = "YES\n"
displ False = "NO\n"

main :: IO ()
main = interact (displ . solve)

main :: IO()
main = putStrLn . solve =<< getLine

solve :: String -> String
solve s | solve' s False False = "YES"
        | otherwise = "NO"
    where
        solve' :: String -> Bool -> Bool -> Bool
        solve' _ True True = True
        solve' "" a b = a && b
        solve' ('A':'B':'A':ss) a b = (solve' ('A':ss) True b) || (solve' ss a True)
        solve' ('B':'A':'B':ss) a b = (solve' ('B':ss) a True) || (solve' ss True b)
        solve' ('A':'B':ss) a b = solve' ss True b
        solve' ('B':'A':ss) a b = solve' ss a True
        solve' (s:ss) a b = solve' ss a b

main :: IO()
main = do
    a <- getLine
    let l1 = solveAB 1 a
        l2 = solveBA 1 a
        l3 = [ x-y | x<-l1 , y<-l2 , abs (x-y) >1]
    if l3 == []
        then putStrLn "NO"
        else putStrLn "YES"

solveAB _ (_:[]) = []
solveAB l (a:b:xs) = if and[a=='A',b=='B'] then l:solveAB (l+1) (b:xs) else solveAB (l+1) (b:xs)

solveBA _ (_:[]) = []
solveBA l (a:b:xs) = if and[a=='B',b=='A'] then l:solveBA (l+1) (b:xs) else solveBA (l+1) (b:xs)

{-# 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
  s <- B.getLine

  let
    b1 = "BA" `B.isInfixOf` s && ("AB" `B.isInfixOf` a || "AB" `B.isInfixOf` (B.drop 2 b))
      where
        (a, b) = B.breakSubstring "BA" s

    b2 = "AB" `B.isInfixOf` s && ("BA" `B.isInfixOf` a || "BA" `B.isInfixOf` (B.drop 2 b))
      where
        (a, b) = B.breakSubstring "AB" s

  putStrLn $ if b1 || b2 then "YES" else "NO"

answer s t 4 = True
answer [] t n =False
answer (s:ss) t 0 | s == (t !! 0) = answer ss t 1
                  | otherwise = answer ss t 0
answer (s:ss) t 1 | s == (t !! 1) = answer ss t 2
                  | s == (t !! 0) = answer ss t 1
                  | otherwise = answer ss t 0
answer (s:ss) t 2 | s == (t !! 2) = answer ss t 3
                  | otherwise = answer ss t 2
answer (s:ss) t 3 | s == (t !! 3) = answer ss t 4
                  | s == (t !! 2) = answer ss t 3
                  | otherwise = answer ss t 2
main = do
  s <- getLine
  putStrLn $ if (answer s "ABBA" 0) || (answer s "BAAB" 0) then "YES" else "NO"

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.head. lines
solve :: String->String
solve xs = if r1+r2>=2 && r1>0 && r2>0 then "YES" else "NO"
    where
    ([r1,r2],r3)=slv1 $ zip zp $ tail zp
    zp =zipWith (\a b->a:b:[]) ('Z':xs) $ tail ('Z':xs)
slv1 []=([0,0],1)
slv1 xss = foldr (f) ([0,0],1) xss where
  f (a1,a2) ([b1,b2],b0) | b0>0 && ((a1,a2) == ("AB","BA") || (a1,a2) == ("BA","AB")) = ([b1+0.5,b2+0.5],-1)
                         | b0>0 && a2 == "AB" = ([b1+1,b2],0)
                         | b0>0 && a2 == "BA" = ([b1,b2+1],0)
                         | otherwise = ([b1,b2],b0+1)

import Control.Arrow ((&&&))
import Data.Functor ((<$>))
import Data.List (isPrefixOf)

main :: IO ()
main = putStrLn <$> yesno =<< solve <$> getLine

solve :: String -> Bool
solve = not . nearBy 2 . (listIndices 0 "AB" &&& listIndices 0 "BA")

listIndices :: Eq a => Int -> [a] -> [a] -> [Int]
listIndices _ _ [] = []
listIndices n xs yss@(_:ys) | xs `isPrefixOf` yss = n : listIndices (n + 1) xs ys
                            | otherwise = listIndices (n + 1) xs ys

nearBy :: Int -> ([Int], [Int]) -> Bool
nearBy n (xs, ys) = null xs || null ys || n > abs (head xs - last ys) || n > abs (last xs - head ys)

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

import Data.List

check' :: String -> Int -> String -> Bool
check' s idx sub
  | idx + 1 >= length s = False
  | sub `isInfixOf` fst && (reverse sub) `isInfixOf` snd = True
  | otherwise = False
      where (fst, snd) = splitAt idx s

check :: String -> String
check s
  | check' s 2 "AB" || check' s 2 "BA" = "YES"
  | otherwise = "NO"

main = do
  ans <- fmap check getLine
  putStrLn ans

import Data.List (isPrefixOf)

check' :: String -> Int -> String -> Bool
check' s idx sub
  | idx + 1 >= length s = False
  | sub `isPrefixOf` fst && (reverse sub) `isPrefixOf` snd = True
  | otherwise = check' s (idx + 1) sub
      where (fst, snd) = splitAt idx s

check :: String -> String
check s
  | check' s 2 "AB" || check' s 2 "BA" = "YES"
  | otherwise = "NO"

main = do
  ans <- fmap check getLine
  putStrLn ans

import Control.Monad
import Data.List
xor :: Bool -> Bool -> Bool
xor a b = a /= b

t = (zip `ap` tail)
isSubStr = (`elem` [('A','B'), ('B','A')])
solve = check . t . map isSubStr . t

check l = not ((True, True) `elem` l) &&
               (False, True) `elem` l &&
               (True, False) `elem` l

p True = "YES"
p False = "NO"
main = interact $ p . solve

import Control.Monad
solve = foldr (&&) True . map (uncurry (&&)) . (zip `ap` tail) . map (`elem` [('A','B'), ('B','A')]) . (zip `ap` tail)

p True = "YES"
p False = "NO"
main = interact $ p . solve

import Control.Monad
import Data.List
import Data.Char
t = (zip `ap` tail)
isSubStr = (`elem` [('A','B'), ('B','A')])
solve = check . t . map isSubStr . t

check :: [(Bool, Bool)] -> Bool
check l = (case elemIndex (False, True) l of
             Just _ -> case elemIndex (True, False) l of
                         Just _ -> True
                         Nothing -> False
             Nothing -> False)
          || any (> 1) ((zipWith (\a b -> (abs (a - b))) `ap` tail)
             (elemIndices (True, True) l))

p True = "YES"
p False = "NO"
main = interact $ p . solve

import Control.Monad
solve = not . foldr (||) False . map (uncurry (&&)) . (zip `ap` tail) . map (`elem` [('A','B'), ('B','A')]) . (zip `ap` tail)

p True = "YES"
p False = "NO"
main = interact $ p . solve

import Control.Monad
solve = any (uncurry (&&)) . (zip `ap` tail) . map (`elem` [('A','B'), ('B','A')]) . (zip `ap` tail)

p True = "YES"
p False = "NO"
main = interact $ p . solve

import Control.Applicative
import Data.Char

process [] a b = if a*b==1 then "YES" else "NO"
process [_] a b = if a*b==1 then "YES" else "NO"
process (x1:x2:xs) a b | a*b==1 = "YES"
	               | x1=='A' && x2=='B' = process xs 1 b
                       | x1=='B' && x2=='A' = process xs a 1
		       | otherwise = process (x2:xs) a b

main= do
	x<-getLine
	putStrLn $ process x 0 0

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

newtype State = State Int
                deriving (Show, Eq)

step :: State -> Char -> State
step (State 0) 'A' = State 1
step (State 0)  _  = State 0
step (State 1) 'B' = State 2
step (State 1)  _  = State 0
step (State 2) 'B' = State 3
step (State 2)  _  = State 2
step (State 3) 'A' = State 4
step (State 3)  _  = State 2
step (State 4)  _  = State 4

step' :: State -> Char -> State
step' (State 0) 'B' = State 1
step' (State 0)  _  = State 0
step' (State 1) 'A' = State 2
step' (State 1)  _  = State 0
step' (State 2) 'A' = State 3
step' (State 2)  _  = State 2
step' (State 3) 'B' = State 4
step' (State 3)  _  = State 2
step' (State 4)  _  = State 4

run :: (State -> Char -> State) -> String -> State
run step = foldl step (State 0)

solve :: String -> Bool
solve s = (run step s) == (State 4) || (run step' s) == (State 4)

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

main = do
	a <- getLine
	if solve a == 2
		then putStrLn "YES"
		else putStrLn "NO"

solve "" = 0
solve ('A':'B':xs) = 1 + solve xs
solve ('B':'A':xs) = 1 + solve xs
solve (x:xs) = solve xs

{-# 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.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
  s <- getLine

  let
    f [] = []
    f ('A':'B':s) = s
    f (c:s) = c:(f s)

    g [] = []
    g ('B':'A':s) = s
    g (c:s) = c:(f s)

    b = "AB" `isInfixOf` s && "BA" `isInfixOf` (f s) || "BA" `isInfixOf` s && "AB" `isInfixOf` (g s)

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

{-# 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.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
  s <- getLine

  let
    f [] = []
    f ('A':'B':s) = s
    f (c:s) = c:(f s)

    b = "AB" `isInfixOf` s && "BA" `isInfixOf` (f s)

  putStrLn $ if b 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
  s <- B.getLine

  let
    b1 = "AB" `B.isInfixOf` a || "AB" `B.isInfixOf` (B.drop 2 b)
      where
        (a, b) = B.breakSubstring "BA" s

    b2 = "BA" `B.isInfixOf` a || "BA" `B.isInfixOf` (B.drop 2 b)
      where
        (a, b) = B.breakSubstring "AB" s

  putStrLn $ if b1 || b2 then "YES" else "NO"

{-# 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.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
  s <- getLine

  let
    f [] = []
    f ('A':'B':s) = s
    f (c:s) = c:(f s)

    g [] = []
    g ('B':'A':s) = s
    g (c:s) = c:(g s)

    b = "AB" `isInfixOf` s && "BA" `isInfixOf` (f s) || "BA" `isInfixOf` s && "AB" `isInfixOf` (g s)

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

answer::String -> String
answer a = btos ((smatch "BA" a)-(ematch "AB" a) >= 2  || (smatch "AB" a)-(ematch "BA" a) > 2)
smatch::String -> String -> Int
smatch a b= smatch0 a b 0
smatch0::String -> String -> Int -> Int
smatch0 a b index | lb < la = -1
                  | (take la b) == a = index
                  | otherwise = smatch0 a (tail b) (index + 1)
                  where la = length a
                        lb = length b
ematch::String -> String -> Int
ematch a b | lb < la = -1
           | (drop (lb-la) b) == a = (lb - la)
           | otherwise = ematch a (init b)
           where la = length a
                 lb = length b
btos::Bool -> String
btos True = "YES"
btos False = "NO"
main = do
  w <- getLine
  putStrLn $ answer w

answer s t 4 = True
answer [] t n =False
answer (s:ss) t 0 | s == (t !! 0) = answer ss t 1
                  | otherwise = answer ss t 0
answer (s:ss) t 1 | s == (t !! 1) = answer ss t 2
                  | otherwise = answer ss t 0
answer (s:ss) t 2 | s == (t !! 2) = answer ss t 3
                  | otherwise = answer ss t 2
answer (s:ss) t 3 | s == (t !! 3) = answer ss t 4
                  | otherwise = answer ss t 2
main = do
  s <- getLine
  putStrLn $ if (answer s "ABBA" 0) || (answer s "BAAB" 0) then "YES" else "NO"

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.head. lines
solve :: String->String
solve xs = if r1+r2>=2 && r1>0 && r3>0 then "YES" else "NO" where
    ([r1,r2],r3)=slv1 $ zip zp $ tail zp
    zp =zipWith (\a b->a:b:[]) xs $ tail xs
slv1 xss = foldr (f) ([0,0],1) xss where
  f (a1,a2) ([b1,b2],b0) | b0==1 && ((a1,a2) == ("AB","BA") || (a1,a2) == ("BA","AB")) = ([b1+0.5,b2+0.5],0)
                         | b0==1 && a1 == "AB" = ([b1+1,b2],1)
                         | b0==1 && a2 == "AB" = ([b1+1,b2],0)
                         | b0==1 && a1 == "BA" = ([b1,b2+1],1)
                         | b0==1 && a2 == "BA" = ([b1,b2+1],0)
                         | otherwise = ([b1,b2],1)

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.head. lines
solve :: String->String
solve xs = if r1+r2>=2 && r1>0 && r2>0 then "YES" else "NO"
    where
    ([r1,r2],r3)=slv1 $ zip zp $ tail zp
    zp =zipWith (\a b->a:b:[]) ('Z':xs) $ tail ('Z':xs)
slv1 []=([0,0],1)
slv1 xss = foldr (f) ([0,0],1) xss where
  f (a1,a2) ([b1,b2],b0) | b0==1 && ((a1,a2) == ("AB","BA") || (a1,a2) == ("BA","AB")) = ([b1+0.5,b2+0.5],0)
                         | b0==1 && a2 == "AB" = ([b1+1,b2],0)
                         | b0==1 && a2 == "BA" = ([b1,b2+1],0)
                         | otherwise = ([b1,b2],1)

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.head. lines
solve :: String->String
solve xs = if r1+r2>=2 && r1>0 && r2>0 then "YES" else "NO"
    where
    ([r1,r2],r3)=slv1 $ zip zp $ tail zp
    zp =zipWith (\a b->a:b:[]) xs $ tail xs
slv1 []=([0,0],1)
slv1 xss = foldr (f) ([0,0],1) xss where
  f (a1,a2) ([b1,b2],b0) | b0==1 && ((a1,a2) == ("AB","BA") || (a1,a2) == ("BA","AB")) = ([b1+0.5,b2+0.5],0)
                         | b0==1 && a1 == "AB" = ([b1+1,b2],0)
                         | b0==1 && a2 == "AB" = ([b1+1,b2],1)
                         | b0==1 && a1 == "BA" = ([b1,b2+1],0)
                         | b0==1 && a2 == "BA" = ([b1,b2+1],1)
                         | otherwise = ([b1,b2],1)


{-# 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

numLoop :: (Num a, Ord a, Monad m) => a -> a -> (a -> m ()) -> m ()
numLoop start end f = if start <= end then go start else return ()
  where
    go !x | x == end  = f x
          | otherwise = f x >> go (x+1)

{-# INLINE numLoop #-}

numLoopState :: (Num a, Eq a, Monad m) => a -> a -> b -> (b -> a -> m b) -> m b
numLoopState start end initState f = go start initState
  where
    go !x !state | x == end  = f state x
                 | otherwise = f state x >>= go (x+1)

{-# INLINE numLoopState #-}

main = do
  n <- readLn

  inp <- unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getContents
  let
    (a, vs) = splitAt (n*n) inp
    a' = listArray ((1, 1), (n, n)) a :: UArray (Int, Int) Int
    vs' = listArray (1, n) vs :: UArray Int Int

  b :: IOUArray (Int) Int <- newArray_ (0, n*n-1)

  numLoop 1 n $ \i -> numLoop 1 n $ \j ->
    writeArray b ((i-1)*n + j-1) $ a'!(vs'!(n-i+1), vs'!(n-j+1))

  rs <- numLoopState 0 (n-1) [] $ \rs w -> do
    numLoop 0 (n-1) $ \u -> do
      d1 <- readArray b (u*n + w)
      numLoop 0 (n-1) $ \v -> do
        d <- readArray b (u*n + v)
        d2 <- readArray b (w*n + v)
        let d' = d1+d2

        when (d' < d) $ writeArray b (u*n + v) d'

    r <- numLoopState 0 w 0 $ \s i -> do
      v <- numLoopState 0 w 0 $ \s j -> do
        v <- readArray b (i*n + j)
        return $ s + fromIntegral v
      return $ s + v

    return $ r:rs

  putStrLn $ unwords $ map show $ rs

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

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

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs
main = do
  n <- readLn

  inp <- unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getContents
  let
    (a, vs) = splitAt (n*n) inp
    a' = listArray ((1, 1), (n, n)) a :: UArray (Int, Int) Int
    vs' = listArray (1, n) vs :: UArray Int Int

  b :: IOUArray (Int, Int) Int <- newArray_ ((1, 1), (n, n))
  forM_ [1..n] $ \i -> forM_ [1..n] $ \j ->
    writeArray b (i, j) $ a'!(vs'!(n-i+1), vs'!(n-j+1))

  let
    {-# INLINE total #-}
    total k = f 1 0
      where
        f i !s
          | i > k = return s
          | otherwise = do
            let
              g j !s
                | j > k = return s
                | otherwise = readArray b (i, j) >>= \v -> g (j+1) (s + fromIntegral v)

            g 1 0 >>= \v -> f (i+1) (s+v)

    loop1 w rs
      | w > n = return rs
      | otherwise = do
        let
          loop2 u
            | u > n = return ()
            | otherwise = do
              d1 <- readArray b (u, w)
              let
                loop3 v
                  | v > n = return ()
                  | otherwise = do
                    d <- readArray b (u, v)

                    d2 <- readArray b (w, v)
                    let d' = d1+d2

                    when (d' < d) $ writeArray b (u, v) d'

                    loop3 (v+1)

              loop3 1
              loop2 (u+1)

        loop2 1
        r <- total w
        loop1 (w+1) (r:rs)

  rs <- loop1 1 []

  putStrLn $ unwords $ map show $ rs


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

import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid

------

mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst f (x, y) = (f x, y)

mapSnd :: (b -> c) -> (a, b) -> (a, c)
mapSnd f (x, y) = (x, f y)

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

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

popJust :: MonadState [r] m => m r
popJust = fromJust <$> pop

------

popInt :: MonadState [B.ByteString] m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

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

dropBackWhile :: (Char -> Bool) -> B.ByteString -> B.ByteString
dropBackWhile p = B.reverse . B.dropWhile p . B.reverse

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map (dropBackWhile isSpace) . B.lines

run :: Hopper B.ByteString B.ByteString
run = do
  n <- popInt
  B.unlines <$> replicateM n solve

solve :: Hopper B.ByteString B.ByteString
solve = B.pack . map f . zip (cycle [True, False]) . B.unpack <$> popJust
  where
    f (True, 'a') = 'b'
    f (True, _) = 'a'
    f (False, 'z') = 'y'
    f (False, _) = 'z'

process :: Bool -> String -> String
process _     []      = []
process True  (h : t) = (if h == 'a' then 'b' else 'a') : process False t
process False (h : t) = (if h == 'z' then 'y' else 'z') : process True t

main :: IO ()
main = interact (unlines . map (process True) . tail . lines)

module Main where

solve :: String -> String
solve = map f . zip [0..]
        where f (i,l) | even i = if l == 'a' then 'b' else 'a'
                      | odd  i = if l == 'z' then 'y' else 'z'

main = interact $ unlines . map solve . tail . lines

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

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

func :: Bool -> String -> String
func _ [] = []
func _ ['\r'] = []
func True ('a' : cs) = 'b' : func False cs
func True (c : cs) = 'a' : func False cs
func False ('z' : cs) = 'y' : func True cs
func False (c : cs) = 'z' : func True cs

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    s <- C.unpack <$> C.getLine
    C.putStrLn $ C.pack $ func True s

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

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

best :: P.ByteString
best = P.cycle $ P.pack "az"

step :: Char -> Char -> Char
step x y
  | x /= y  = x
  | x == 'a' = 'b'
  | otherwise = 'y'

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ readLine >>= (lift . putStrLn . P.zipWith step best)

type SIO = StateT P.ByteString IO

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

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

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

import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid

------

mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst f (x, y) = (f x, y)

mapSnd :: (b -> c) -> (a, b) -> (a, c)
mapSnd f (x, y) = (x, f y)

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

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

popJust :: MonadState [r] m => m r
popJust = fromJust <$> pop

------

popInt :: MonadState [B.ByteString] m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

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

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map (B.dropWhile isSpace) . B.lines

run :: Hopper B.ByteString B.ByteString
run = do
  n <- popInt
  B.unlines <$> replicateM n solve

solve :: Hopper B.ByteString B.ByteString
solve = B.pack . map f . zip (cycle [True, False]) . B.unpack <$> popJust
  where
    f (True, 'a') = 'b'
    f (True, _) = 'a'
    f (False, 'z') = 'y'
    f (False, _) = 'z'

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

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

------

mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst f (x, y) = (f x, y)

mapSnd :: (b -> c) -> (a, b) -> (a, c)
mapSnd f (x, y) = (x, f y)

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

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

popJust :: MonadState [r] m => m r
popJust = fromJust <$> pop

------

popInt :: MonadState [B.ByteString] m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

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

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

run :: Hopper B.ByteString B.ByteString
run = do
  n <- popInt
  B.unlines <$> replicateM n solve

solve :: Hopper B.ByteString B.ByteString
solve = B.pack . map f . zip (cycle [True, False]) . B.unpack <$> popJust
  where
    f (True, 'a') = 'b'
    f (True, _) = 'a'
    f (False, 'z') = 'y'
    f (False, _) = 'z'

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

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

func :: Bool -> String -> String
func _ [] = []
func True ('a' : cs) = 'b' : func False cs
func True (c : cs) = 'a' : func False cs
func False ('z' : cs) = 'y' : func True cs
func False (c : cs) = 'z' : func True cs

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    s <- C.unpack <$> C.getLine
    C.putStrLn $ C.pack $ func True s


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

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

solve as
  | any (== 0) as = (length $ filter (== 0) as) + (solve $ map (\x -> if x == 0 then 1 else x) as)
  | sum as == 0 = 1
  | otherwise = 0

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

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

type EIO a = ExceptT String IO a

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

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

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

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

f2 :: [Int] -> Int -> Int
f2 a n =    let asum = foldl (+) 0 a
            in
            let a0count = foldl (\s c -> if c == 0 then s + 1 else s) 0 a
            in
            let amcount = foldl (\s c -> if c == -1 then s + 1 else s) 0 a
            in
            if asum + a0count == 0 then
                if amcount == n then
                    a0count + 2
                else
                    a0count + 1
            else
                a0count

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

onecase= do
		getLine
		s<- map read <$> words <$> getLine ::IO [Int]
		let z = length $ filter (==0) s
		let su = sum s
		print $ if su +z ==0 then z+1 else z

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

--ghc 7.10

import Data.List(groupBy)

nonZero :: [Int] -> Int
nonZero a =
    if (n + sum a) == 0
        then n+1
        else n
    where n = length . filter (==0) $ a

process :: Int -> IO ()
process 0 = return ()
process t = do
    line1 <- getLine
    line2 <- getLine
    let a = map read . words $ line2
    print $ nonZero a
    process (t-1)

main = do
    tStr <- getLine
    let t = read tStr :: Int
    process t

import Data.List as L

solve :: [Int] -> Int
solve xs = stepsToRemoveZero + if sumAfterZeroRemoval == 0 then 1 else 0
  where stepsToRemoveZero = length $ filter (== 0) xs
        sumAfterZeroRemoval = (sum xs) + stepsToRemoveZero

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

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

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

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

solve :: [Int] -> Int
solve xs = if nsum ==0 then nuller +1 else nuller
  where
    nsum = summe + nuller
    (summe,nuller) = foldr bin acc xs
    bin x (sm,zs) = if x==0 then (sm,zs+1) else (sm+x,zs)
    acc = (0,0)


-- Codeforces 549A

import Data.List (sort)

main :: IO ()
main = do
    [n, m] <- fmap (map read . words) getLine
    getContents >>= print . solve [(i, j) | i <- [0..n-2], j <- [0..m-2]] . lines -- enumerate all positions.

solve :: [(Int, Int)] -> [String] -> Int
solve [] _ = 0
solve ((i,j):xs) mat = check + (solve xs mat) where check = if sort [mat!!i!!j, mat!!i!!(j+1), mat!!(i+1)!!j, mat!!(i+1)!!(j+1)] == "acef" then 1 else 0

import Data.List

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

solve :: [String] -> Int
solve (a:b:s) = (count (zips a b)) + (solve (b:s))
solve _       = 0

zips :: String -> String -> String
zips ""     ""     = ""
zips (a:as) (b:bs) = (a:b:(zips as bs))

count :: String -> Int
count (a:b:c:d:s) | sort [a,b,c,d] == sort "face" = 1 + (count (c:d:s))
                  | otherwise = count (c:d:s)
count _           = 0

{-# 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, m] <- map read . words <$> getLine
  a <- replicateM n getLine

  let check (a, b) (c, d) = sort [a, b, c, d] == "acef"

  print $ length $ filter id $ [check p q | [x, y] <- map (take 2) (init (init (tails a))), [p, q] <- map (take 2) (init (init (tails (zip x y))))]

import Data.List

detect i [] _ = i
detect i _ [] = i
detect i [_] _ = i
detect i _ [_] = i
detect i (a:b:as) (c:d:cs) = detect (i + if sort [a,b,c,d] == "acef" then 1 else 0) (b:as) (d:cs)

solve i [a] = i
solve i (a:b:as) = solve (i + detect 0 a b) (b:as)

main = interact $ show . solve 0 . tail . lines

import Data.List

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

solve :: [String] -> Int
solve lst =
  let n = length lst
      m = length $ head lst
      getSquare :: Int -> Int -> String
      getSquare i j =
        [(lst !! k) !! l | k <- [i, min (i+1) (n-1)], l <- [j, min (j+1) (m-1)]]
      isSquare :: String -> Bool
      isSquare str =
        sort str == "acef"
  in length $ filter isSquare $ [getSquare i j | i <- [0..n-1], j <- [0..m-1]]

import Control.Arrow ((&&&), (***))
import Data.Functor ((<$>))
import Data.List (sort)

main :: IO ()
main = print =<< solve <$> (tail <$> lines <$> getContents)

solve :: [String] -> Int
solve xs = length . filter (=="acef") . concatMap (map (sort . uncurry (++) . (unTuple *** unTuple))
        . uncurry zip . (uncurry zip . (id &&& tail) *** uncurry zip . (id &&& tail))) $ zip xs (tail xs)

unTuple :: (a, a) -> [a]
unTuple (a, b) = [a, b]

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

solve1 ((a,b) : (c,d) : _) = if sort [a,b,c,d] == sort "face" then 1 else 0
solve1 _ = 0

solver (x:y:_) = sum $ map solve1 (tails (zip x y))
solver _ = 0

solve :: [String] -> Integer
solve l = sum $ map solver (tails l)

main = interact $ unlines . return . show . solve . tail . lines

import Data.List (sort)

type Face = ((Char, Char), (Char, Char))

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

isFace :: Face -> Bool
isFace ((a, b), (c, d)) = (sort [a, b, c, d]) == "acef"

mkFaces :: [String] -> [Face]
mkFaces = concat . pairWith zip . map (pairWith (,))
          where pairWith f a = zipWith f a (tail a)

solve :: [String] -> Int
solve = length . filter isFace . mkFaces

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


import Control.Monad ( guard, replicateM_, forM_, when )
import Data.Bits ( Bits(xor) )
import Data.IORef ( newIORef, readIORef, writeIORef )
import Data.List ( unfoldr )
import Data.Maybe ( fromJust )
import System.IO ( hFlush, stdout )
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    [n, k] <- readInts
    done <- newIORef False
    forM_ [0..n - 1] $ \i -> do
        done' <- readIORef done
        if done' then return ()
        else do
            let j = if i == 0 then i else i `xor` (i - 1)
            print j
            hFlush stdout
            r <- readInt
            guard (r /= -1)
            when (r == 1) $ writeIORef done True
    readIORef done >>= guard

readInt :: IO Int
readInt = fst . fromJust . C.readInt <$> C.getLine

readInts :: IO [Int]
readInts = unfoldr (C.readInt . C.dropWhile (== ' ')) <$> C.getLine

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

import Control.Monad ( guard, replicateM_, forM_, when )
import Data.Bits ( Bits(xor) )
import Data.IORef ( newIORef, readIORef, writeIORef )
import Data.Maybe ( fromJust )
import System.IO ( hFlush, stdout )
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    [n, k] <- readInts
    done <- newIORef False
    forM_ [0..n - 1] $ \i -> do
        done' <- readIORef done
        if done' then return ()
        else do
            let j = if i == 0 then i else i `xor` (i - 1)
            C.putStrLn $ C.pack $ show j
            hFlush stdout
            r <- readInt
            guard (r /= -1)
            when (r == 1) $ writeIORef done True
    readIORef done >>= guard

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

readInt :: IO Int
readInt = parseInt <$> C.getLine

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

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

import Control.Monad ( replicateM_, guard, when )
import Data.Bits ( Bits(xor) )
import System.IO ( hFlush, stdout )

solve :: IO ()
solve = do
    [n, k] <- readMany :: IO [Int]
    let go :: Int -> IO ()
        go i = do
            let j = i `xor` (i - 1)
            print j
            hFlush stdout
            r <- readLn :: IO Int
            guard (r /= -1)
            when (r == 0) $ go (i + 1)
    go 1

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

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


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = readInt >>= flip replicateM solve >>= mapM_ print

solve = do
	n <- readInt
	ss <- replicateM n getLine
	let
		ls = map length ss
		zeros = length $ filter ( == '0' ) $ concat ss
		ones = sum ls - zeros
		pairs = ( zeros `div` 2 ) + ( ones `div` 2 )
	return $ length $ takeWhile ( <= pairs ) $ scanl1 (+) $ sort $ map ( `div` 2 ) ls

import           Data.List
import           Numeric

(|>) = flip (.)

int :: String -> Int
int x = fst $ readDec x !! 0

ints :: String -> [Int]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> map show
  |> unlines

solverLoop :: [String] -> [Int]
solverLoop (ts:xs) = go t xs
    where
      t = int ts
      go 0 _ = []
      go t (nStr:xs) =
          solve (take n xs) : go (t - 1) (drop n xs)
          where
            n = int nStr

solve :: [String] -> Int
solve xs = go lengths counts1 counts0
  where
    counts1 = sum $ map (count '1') xs
    counts0 = sum $ map (count '0') xs
    lengths = sort $ map length xs
    go [] _ _ = 0
    go (x:xs) c1 c0
      | x `mod` 2 == 0
        && ec1 + ec0 >= x
        = 1 + go xs
          (c1 - (min ec1 x))
          (c0 - (min ec0 (x - (min ec1 x))))
      | x `mod` 2 == 1
        && c1 + c0 >= x
        = 1 + if c1 `mod` 2 == 1
            then go xs (c1 - (min c1 x)) (c0 - (x - (min c1 x)))
            else go xs (c1 - (min c1 (x-1))) (c0 - (x - (min c1 (x-1))))
      | otherwise = 0
      where
        ec1 = (c1 - c1 `mod` 2)
        ec0 = (c0 - c0 `mod` 2)

count x = length . filter (== x)

import           Data.List
import           Numeric

(|>) = flip (.)

int :: String -> Int
int x = fst $ readDec x !! 0

ints :: String -> [Int]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> map show
  |> unlines

solverLoop :: [String] -> [Int]
solverLoop (ts:xs) = go t xs
    where
      t = int ts
      go 0 _ = []
      go t (nStr:xs) =
          solve (take n xs) : go (t - 1) (drop n xs)
          where
            n = int nStr

solve :: [String] -> Int
solve xs = length
  $ takeWhile (<= (counts1 `div` 2 + counts0 `div` 2))
  $ scanl1 (+)
  $ sort $ map ((`div` 2) . length) xs
  where
    counts1 = sum $ map (count '1') xs
    counts0 = sum $ map (count '0') xs

count x = length . filter (== x)


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

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

type DpState = (Maybe Int, Maybe Int, Maybe Int, Maybe Int)

maybeMaximum :: [Maybe Int] -> Maybe Int
maybeMaximum = foldr max Nothing

dpStateStep :: DpState -> Char -> DpState
dpStateStep (a0, a1, a2, a3) '[' = (maybeMaximum [a0, Just 1], a1, a2, a3)
dpStateStep (a0, a1, a2, a3) ':' = (a0, maybeMaximum [(+1) <$> a0, a1], maybeMaximum [(+1) <$> a1, a2], a3)
dpStateStep (a0, a1, a2, a3) '|' = (a0, (+1) <$> a1, a2, a3)
dpStateStep (a0, a1, a2, a3) ']' = (a0, a1, a2, maybeMaximum [(+1) <$> a2, a3])
dpStateStep dpState _ = dpState

solve :: B8.ByteString -> Int
solve str = fromMaybe (-1) answer
    where
        (_, _, _, answer) = B8.foldl' dpStateStep (Nothing, Nothing, Nothing, Nothing) str

main :: IO ()
main = do
    str <- B8.getLine
    printf "%d" $ solve str

main = interact f

f s = (case f0 s of
    Just i -> show (i + 4)
    Nothing -> "-1") ++ "\n"

f0 ('[':s) = f1 s
f0 (_:s) = f0 s
f0 [] = Nothing

f1 (':':s) = f2 s
f1 (_:s) = f1 s
f1 [] = Nothing

f2 s = f3 Nothing 0 s

f3 prev score ('|':s) = f3 prev (score + 1) s
f3 prev score (':':s) = case f4 score s of
    Just (i, j, s) -> f3 (Just i) j s
    Nothing -> prev
f3 prev score (_:s) = f3 prev score s
f3 prev _ [] = prev

f4 score s = f5 score score s

f5 i j ('|':s) = f5 i (j + 1) s
f5 i j (']':s) = Just (i, j, s)
f5 i j (':':s) = f5 j j s
f5 i j (_:s) = f5 i j s
f5 _ _ [] = Nothing

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve [] = -1
solve ('[':s) = solve2 $ s
solve (x:s) = solve s

solve2 [] = -1
solve2 (':':s) = solve3 $ reverse s
solve2 (x:s) = solve2 s

solve3 [] = -1
solve3 (']':s) = solve4 s
solve3 (x:s) = solve3 s

solve4 [] = -1
solve4 (':':s) = solve5 s
solve4 (x:s) = solve4 s

solve5 [] = 4
solve5 ('|':s) = 1 + solve5 s
solve5 (x:s) = solve5 s

main = do
    s <- getLine
    print $ solve s

-- Educational Codeforces Round #58 (B), Contest 1101, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

main :: IO ()
main = do
  s <- BS.getLine
  print $ fromMaybe (-1) $ query s

query :: BS.ByteString -> Maybe Int
query xs0 = do
  let xs1 = BS.dropWhile (/='[') xs0
      xs2 = BS.dropWhile (/=':') xs1
  guard $ not $ BS.null xs2
  let (xs3,_) = BS.spanEnd (/= ']') $ BS.tail xs2
      (xs4,_) = BS.spanEnd (/=':') $ xs3
  guard $ not $ BS.null xs4
  let xs5 = BS.init xs4
  return $ (4+) $ length $ BS.elemIndices '|' xs5

-- Educational Codeforces Round #58 (B), Contest 1101, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

main :: IO ()
main = do
  s <- BS.getLine
  print $ fromMaybe (-1) $ query s

query :: BS.ByteString -> Maybe Int
query xs0 = do
  let xs1 = BS.dropWhile (/='[') xs0
      xs2 = BS.dropWhile (/=':') xs1
  guard $ not $ BS.null xs2
  let (xs3,_) = BS.spanEnd (/= ']') $ BS.tail xs2
      (xs4,_) = BS.spanEnd (/=':') $ xs3
  guard $ not $ BS.null xs4
  let xs5 = BS.tail xs4
  return $ (4+) $ length $ BS.elemIndices '|' xs5

main = interact f

f s = (case f0 s of
    Just i -> show (i + 4)
    Nothing -> "-1") ++ "\n"

f0 ('[':s) = f1 s
f0 (_:s) = f0 s
f0 [] = Nothing

f1 (':':s) = f2 s
f1 (_:s) = f1 s
f1 [] = Nothing

f2 s = f3 Nothing 0 s

f3 prev score ('|':s) = f3 prev (score + 1) s
f3 prev score (':':s) = case f4 s of
    Just (i, s) -> f3 (Just score) (score + i) s
    Nothing -> prev
f3 prev score (_:s) = f3 prev score s
f3 prev _ [] = prev

f4 s = f5 0 s

f5 i ('|':s) = f5 (i + 1) s
f5 i (']':s) = Just (i, s)
f5 i (_:s) = f5 i s
f5 _ [] = Nothing


import qualified Data.Array as A
import qualified Data.List as L
import Data.Ix
import Control.Monad

main :: IO ()
main = do [na,ma] <- (getLine >>= return . map read . words)
          la      <- foldM (\e x -> nextChar >>= (\c -> return ((x,c):e))) [] [(x,y) | x <- [1..na],y <- [1..ma]]
          getLine
          [nb,mb] <- (getLine >>= return . map read . words)
          lb      <- foldM (\e x -> nextChar >>= (\c -> return ((x,c):e))) [] [(x,y) | x <- [1..nb],y <- [1..mb]]
          putStrLn . unwords . map show $ solve (na,ma) la (nb,mb) lb
    where
          nextChar = do c <- getChar
                        case c of
                            '\n' -> nextChar
                            '0'  -> return 0
                            '1'  -> return 1

solve :: (Int,Int) -> [((Int,Int),Int)] -> (Int,Int) -> [((Int,Int),Int)] -> [Int]
solve (na,ma) la (nb,mb) lb = snd $ maximum [ (overlap x y,[x,y]) | x <- [-50..50], y <- [-50..50]]
    where mat_a = A.array ((1,1),(na,ma)) la
          mat_b = A.array ((1,1),(nb,mb)) lb
          overlap :: Int -> Int -> Int
          overlap x y = L.foldl' (+) 0 [(mat_a A.! (i,j)) * (mat_b A.! (i+x,j+y)) | i <- [max 1 (1-x)..min na (nb-x)],j <- [max 1 (1-y)..min ma (mb-y)]]

import Array
import Data.List (foldl')
import Monad (liftM)

solve :: Array (Int, Int) Int -> Array (Int, Int) Int -> (Int, Int)
solve a b  =  (m, n)
  where
    (m, n, fa)  =  foldl' getMax (undefined, undefined, -1)
                    [(x, y) | x <- [1 - na .. nb - 1], y <- [1 - ma .. mb - 1]]
    (na, ma)  =  snd $ bounds a
    (nb, mb)  =  snd $ bounds b
    getMax a@(_, _, fa) b@(b1, b2)
      | fa > fb    =   a
      | otherwise  =  (b1, b2, fb)
      where
        fb  =  f b
    f (x, y)  =  foldl' (+) 0 [a ! (i,j) * b ! (i+x, j+y)
                  | i <- [max 1 (1 - x) .. min na (nb - x)],
                    j <- [max 1 (1 - y) .. min ma (mb - y)]]

main :: IO ()
main  =  do
    ls  <-  liftM lines getContents
    let [na, ma]  =  map read . words . head $ ls
    let a  =  listArray ((1,1), (na, ma)) . map read . concatMap (map (\c -> [c])) . take na . tail $ ls
    let [nb, mb]  =  map read . words . head . drop na . drop 1 $ ls
    let b  =  listArray ((1,1), (nb, mb)) . map read . concatMap (map (\c -> [c])) . take nb . drop 1 . drop na . drop 1 $ ls
    let (x,y)  = solve a b
    putStrLn $ concat [show x, " ", show y]


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

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

type EIO a = ExceptT String IO a

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

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

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

f1 :: EIO ()
f1 = do
    get :: EIO Int
    s <- gets
    case f2 s of
        Nothing -> putsln("-1")
        Just (i, j) -> putsln(i : j : [])

f2 :: String -> Maybe (Char, Char)
f2 s =  let aux (c : rest) (x, y) = if (mod ((ord c) - (ord '0')) 2) == 1 then aux rest (y, c) else aux rest (x, y)
            aux [] (x, y) = (x, y)
        in
        let (x, y) = aux s ('x', 'x') in
            if x == 'x' || y == 'x' then
                Nothing
            else Just (x, y)

import Data.Maybe (fromMaybe)

main = readLn >>= go where
    go 0 = return ()
    go n = getLine >> readLn >>= print . fromMaybe (-1) . solve >> go (n-1)

solve :: Integer -> Maybe Int
solve n = let
    a = map read (map (:[]) $ show n) :: [Int]
    odds = filter odd a
    in if length odds < 2 then Nothing else Just $ 10 * (odds !! 0) + odds !! 1

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number = take 2 $ filter odd number

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString [_] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

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

main = getLine >>= test.read
test 0 = return ()
test a = getLine >> getLine >>= putStrLn.solve.take 2.filter (\d -> odd $ read [d]) >> test (a - 1)

solve a | length a == 2 = a | otherwise = "-1"

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number = take 2 $ filter odd number

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo [_, _] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number = take 2 $ filter odd number

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number
  | null oddVersion = []
  | even currSum = oddVersion
  | otherwise    = (takeWhile even oddVersion) ++ (tail (dropWhile even oddVersion))
  where oddVersion = reverse $ dropWhile even $ reverse number
        currSum = sum oddVersion

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number = take 2 $ filter odd number

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo [_] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

import Data.Char

toEbne :: [Int] -> [Int]
toEbne number
  | null oddVersion = []
  | even currSum = oddVersion
  | otherwise    = (takeWhile even oddVersion) ++ (tail (dropWhile even oddVersion))
  where oddVersion = reverse $ dropWhile even $ reverse number
        currSum = sum oddVersion

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Int] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> n - (ord '0')) $ map ord xs

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


import Control.Monad (liftM, forM_)
import Data.Char (ord)
import Data.List (intercalate)

solve :: [Int] -> [Int]
solve [n, k]
  | n == k  =  [-1]
  | n == k + 1  =  [1..n]
  | otherwise  =  n : [2 .. k+1] ++ 1 : [k+2 .. n-1]

main :: IO ()
main  =  reads >>= prints . solve

  where

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

module Main where
import Control.Applicative
main :: IO ()
main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  let ans = [n] ++ [2..k+1] ++ [1] ++ [k+2..n-1]
  case undefined of
    _ | n == k -> print $ -1
    _ | n == k+1 -> putStrLn $ unwords $ map show [1..n]
    _ | otherwise -> putStrLn $ unwords $ map show ans

import Control.Monad (liftM, forM_)
import Data.Char (ord)
import Data.List (intercalate)

solve :: [Int] -> [Int]
solve [n, k]
  | n == k  =  [-1]
  | otherwise  =  take n ([1..k+1] ++ repeat 1)

main :: IO ()
main  =  reads >>= prints . solve

  where

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

module Main where
import Control.Applicative
main :: IO ()
main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  let ans = [n] ++ [2..k+1] ++ [1] ++ [k+2..n-1]
  if n == k
    then print $ -1
    else putStrLn $ unwords $ map show ans


main :: IO ()
main = do
       raw <- getContents
       let rows = map (map (read :: [Char] -> Integer) . words) $ tail $ lines raw
       putStr $ unlines $ map (show . process) rows

process :: [Integer] -> Integer
process [str, int, exp_] = max 0 (if exp_ < str - int then exp_ + 1 else (str - int + exp_ + 1) `div` 2)
process _ = error "Malformed line"

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 asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | otherwise = max 0 (exp - adds + 1)
  -- | str >= int = min (div (base' + exp + 1) 2) exp
  -- | otherwise = div' left 2
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'
      adds = max 0 (div (exp + int - str + 2) 2)

div' it n2 = (div it n2) + (mod it n2)

main = mapM (print . solve) . parse . map read . tail . words =<< getContents
parse (a:b:c:xs) = (a,b,c) : parse xs
parse [] = []
solve (str,int,exp) | tip < 0 = 0
                    | tip > exp = exp + 1
                    | otherwise = tip + 1
  where tip = (str-int+exp-1) `div` 2

main = do
       s <- getContents
       let xss = tail $ lines s
       let rows = map (map (read :: [Char] -> Integer) . words) xss
       putStr $ unlines $ map (show . process) rows

process [str, int, exp] = max 0 (str + exp - (str + int + exp) `div` 2)

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 asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | str >= int = min (quot (base' + exp) 2) exp
  | otherwise = (div left 2) + (mod left 2)
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'

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 asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | str >= int = min (div (base' + exp) 2) exp
  | otherwise = div' left 2
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'

div' it n2 = (div it n2) + (mod it n2)

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 asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | str >= int = min (div' (base' + exp) 2) exp
  | otherwise = div' left 2
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'

div' it n2 = (div it n2) + (mod it n2)

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 asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | str >= int = min (div (base' + exp + 1) 2) exp
  | otherwise = div' left 2
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'

div' it n2 = (div it n2) + (mod it n2)

main = mapM (print . solve) . parse . map read . tail . words =<< getContents
parse (a:b:c:xs) = (a,b,c) : parse xs
parse [] = []
solve (str,int,exp) | tip < 0 = 0
                    | otherwise = tip + 1
  where tip = (str-int+exp-1) `div` 2

main = interact $ unlines . map (show . solve) . parse . map read . tail . words
parse (a:b:c:xs) = (a,b,c) : parse xs
parse [] = []
solve (str,int,exp) | tip < 0 = 0
                    | otherwise = tip + 1
  where tip = (str-int+exp-1) `div` 2


import Control.Monad (liftM, replicateM, mapM_)
import Data.Char (ord)
import Data.List (intercalate, sort, (\\))

solve :: [[Int]] -> [Bool]
solve carts  =  map maybeWin carts
  where
    maybeWin cart  =  all (not . elem' cart) (carts \\ [cart])
    elem' a b  =  elem'' (sort a) (sort b)
    elem'' _ []  =  True
    elem'' [] _  =  False
    elem'' (a:as) (b:bs)
      | a < b  =  elem'' as (b:bs)
      | a > b  =  False
      | otherwise  =  elem'' as bs

main :: IO ()
main  =  do
    n  <-  readLn
    as  <-  replicateM n $ liftM tail reads
    mapM_ (putStrLn . ("YES" <?> "NO")) $ solve as

  where
    (<?>) a b p  =  if p then a else b

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

import Data.List

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

solve :: [[Int]] -> [String]
solve cards = go [] cards
   where
     go xs (y:ys)
       | all (not . null . (\\y)) xs && all (not . null . (\\y)) ys = "YES" : go (y:xs) ys
       | otherwise = "NO" : go (y:xs) ys
     go _ _ = []


import List
import Control.Monad
import Control.Applicative
solve x0 (a,b) | mx > mn = "-1"
               | mx <= x0 && x0 <= mn = "0"
               | True = show $ min (abs(x0-mx)) (abs(x0-mn))
      where mx = maximum a
            mn = minimum b

pair = map read . words <$> getLine

main = do
    [n, x0] <- pair
    (replicateM n pair) >>= (putStrLn . solve x0 . unzip. map ((\[a,b]->(a,b)).sort))

import List

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

main = do
    s <- getLine
    let n:x0:_ = un s
    l <- getLines n
    let xys_ = map un l
        xys = map (\(a:b:_) -> (min a b, max a b)) xys_
        x1 = maximum $ map fst xys
        x2 = minimum $ map snd xys
    if x1 > x2 then
            putStrLn "-1"
        else if x1 <= x0 && x0 <= x2 then
            putStrLn "0"
        else let m = min (abs (x1 - x0)) (abs (x2 - x0))
            in putStrLn $ show m

module Main where

-- import Test.Tasty
-- import Test.Tasty.HUnit
-- import Debug.Trace
import Data.List
import Control.Monad

run start positions =
    let enumerate begin end [a,b] = if a<b then [max begin a..min end b] else [max begin b.. min end a]
        [begin, end] = head positions
        fst3 = (\(x,_,_) -> x)
        commonPositions =
            fst3 $
            foldr (\x (acc,a,b) -> let e = enumerate a b x in (acc `intersect` e, head e, last e))
                  ([min begin end .. max begin end], min begin end, max begin end)
                  (tail positions)
    in if null commonPositions then -1 else minimum $ map (abs . ((-) start)) commonPositions

main = do
   let processLine = map (\x -> read x::Int) . words
   [len, start] <- (getLine >>= return . processLine)
   positions <- (replicateM len getLine >>= return . (map processLine))
   print $ run start positions

{-
main = defaultMain $
   testCase "Tests" $ do
    run 3 [[0,7],[14,2],[4,6]] @?= 1

-}

solve _ _ [] = True
solve d add ((a, b) : xs)
 | (d + add) >= min a b && (d + add) <= max a b = solve d add xs
 | otherwise = False

main = do
	line <- getLine
	arr' <- getContents
	let
		[n, x] = map (\x -> read x :: Integer ). words $ line
		arr = map (\x -> let [a, b] = map (\y -> read y :: Integer ). words $ x in (a, b)  ). lines $ arr'
		ans 1001 = -1
		ans d
		 | solve x d arr = d
		 | solve x (-d) arr = d
		 | otherwise = ans (d+1)
--	print x
--	print arr
	print $ ans 0

import List

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

main = do
    s <- getLine
    let n:x0:_ = un s
    l <- getLines n
    let xys_ = map un l
        xys = map (\(a:b:_) -> (min a b, max a b)) xys_
        x1 = maximum $ map fst xys
        x2 = minimum $ map snd xys
    if x1 > x2 then
        putStrLn "-1"
        else let m = min (abs (x1 - x0)) (abs (x2 - x0))
            in putStrLn $ show m


import Data.List (group, sort, sortBy)
import Data.Ord (comparing)
solve :: [String] -> String
solve [xs,k']
    | length xs <= k = "0\n"
    | otherwise = (show (length ps - maxl)) ++ "\n" ++ filter (`notElem` rmv) xs
    where sch = sort $ map (\x -> (length x, head x)) ps
          ps = group (sort xs)
          k = read k'
          maxl = length $ takeWhile (<=k) $ scanl1 (+) $ map fst sch
          rmv = map snd (take maxl sch)
main = putStrLn.solve.lines =<< getContents

module Main where

import Data.List
import Data.Ord
import qualified Data.Map as Map

main = do
    string <- getLine
    inputK <- getLine
    let k = read inputK :: Int
        letterCount = foldl' (\count letter -> Map.insertWith' (+) letter 1 count) Map.empty string
        orderLetter = sortBy ( comparing ( letterCount Map.! ) ) $ Map.keys letterCount
        eat :: Int -> [Char] -> [Char]
        eat _ [] = []
        eat k (letter:letters) =
            let head_count = letterCount Map.! letter in
            if k >= head_count
                then eat ( k - head_count ) letters
                else letter:letters
        remainLetter = eat k orderLetter

    putStrLn $ show ( length remainLetter )
    putStrLn $ filter ( `elem` remainLetter ) string

import List
import Data.Function
l=length
s[w,k]=[show$l$group$sort r,r]where r=map fst$sortBy(compare`on`snd)(drop(read k)$concat$sortBy(compare`on`l)$groupBy((==)`on`fst)$sort$zip w[0..])
main=interact$unlines.s.words

import Data.Array.ST
import Control.Monad.ST
import Control.Monad (foldM)
import Data.Array.Unboxed
import Data.List (sortBy)
import Data.Function (on)
main = do

    строка <- getLine
    k <- read `fmap` getLine
    let границы = ('a','z')
        символы = sortBy (compare `on` snd) $ filter ((>0).snd) $ assocs $ runSTUArray ((newArray границы 0 :: ST s (STUArray s Char Int)) >>=
            \a -> foldM (\a c -> readArray a c >>= \n -> writeArray a c (n+1) >> return a) a строка)

        (_, вычёркиваем) = foldl (\(k, l) (c, n) -> if k >= n then (k-n, c:l) else (k, l)) (k, []) символы
        фильтр = array границы $ map (\c -> (c, c `notElem` вычёркиваем)) $ range границы :: UArray Char Bool
    print (length символы - length вычёркиваем)
    putStrLn $ filter (фильтр !) строка

import List
f#p=(\x->f(p x).p)
l=length
z x=[show$l$group$sort x,x]
b x=sortBy$compare#x
s[w,k]=drop(read k)$id=<<(b l$groupBy((==)#fst)$sort$zip w[0..])
main=interact$unlines.z.map fst.b snd.s.words

import List
f#p=(.p).f.p
l=length
z x=[show$l$group$sort x,x]
b x=sortBy$compare#x
s[w,k]=drop(read k)$id=<<(b l$groupBy((==)#fst)$sort$zip w[0..])
main=interact$unlines.z.map fst.b snd.s.words

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

solve :: String -> Int -> (String, Int)
solve chars k =
    (solution, S.size $ S.fromList solution)
    where solution = filter (\x -> not $ S.member x dropped) chars
          chars2 :: [(Int, Char)]
          chars2 = L.sort [(length x, head x) | x <- L.group . L.sort $ chars]
          chars3 :: [(Int, Char)]
          chars3 = snd $ L.mapAccumL (\k (cnt, chr) -> (k - cnt, (k - cnt, chr))) k chars2
          dropped = S.fromList [chr | (cnt, chr) <- chars3, cnt >= 0]

main = do
  chars <- getLine
  k <- (getLine >>= return . (read::String->Int))
  let (solution, m) = solve chars k
  putStrLn $ show m
  putStrLn $ solution

import List
l=length
s[w,k]=[show$l$nub r,w\\r]where r=take(read k)$snd=<<(sort$map(\x->(l x,x))$group$sort w)
main=interact$show.unlines.s.words

import List
l=length
s[w,k]=[show$l$nub r,w\\r]where r=take(read k)$snd=<<(sort$map(\x->(l x,x))$group$sort w)
main=interact$unlines.s.words

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

solve :: String -> Int -> (String, Int)
solve chars k =
    (solution, S.size $ S.fromList solution)
    where solution = filter (\x -> not $ S.member x dropped) chars
          chars2 :: [(Int, Char)]
          chars2 = L.sort [(length x, head x) | x <- L.group . L.sort $ chars]
          chars3 :: [(Int, Char)]
          chars3 = snd $ L.mapAccumL (\k (cnt, chr) -> (k - cnt, (k - cnt, chr))) k chars2
          dropped = S.fromList [chr | (cnt, chr) <- chars3, cnt > 0]

main = do
  chars <- getLine
  k <- (getLine >>= return . (read::String->Int))
  let (solution, m) = solve chars k
  putStrLn $ solution
  putStrLn $ show m

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

solve :: String -> Int -> (String, Int)
solve chars k =
    (solution, S.size $ S.fromList solution)
    where solution = filter (\x -> not $ S.member x dropped) chars
          chars2 :: [(Int, Char)]
          chars2 = L.sort [(length x, head x) | x <- L.group . L.sort $ chars]
          chars3 :: [(Int, Char)]
          chars3 = snd $ L.mapAccumL (\k (cnt, chr) -> (k - cnt, (k - cnt, chr))) k chars2
          dropped = S.fromList [chr | (cnt, chr) <- chars3, cnt > 0]

main = do
  chars <- getLine
  k <- (getLine >>= return . (read::String->Int))
  let (solution, m) = solve chars k
  putStrLn $ show m
  putStrLn $ solution


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

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

main :: IO ()
main = readLn >>= putStr.unlines.map (map$bool '*' '+').solve

solve :: Int -> [[Bool]]
solve 0 = [[True]]
solve k = zipWith (++) block0 block2 ++ zipWith (++) block0 block1
  where
    block0 = solve (k-1)
    block1 = map reverse block0
    block2 = map (map not) block1

import Data.List

readint :: String -> Int
readint = read

flipv :: Char -> Char
flipv '*' = '+'
flipv '+' = '*'

solve :: Int -> [String]
solve 0 = [['+']]
solve k = concat $ map (\s -> [s++s, s++(map flipv s)]) $ solve (k-1)

main = interact $ intercalate "\n" . solve . readint

import Data.List
expand s = [s++s, s++(map (*(-1)) s)]

hadamard 0 = [[1]]
hadamard k = concat $ map expand $ hadamard (k-1)

hf::Int -> Char
hf ( 1) = '+'
hf (-1) = '*'

toSymbols s = map hf s

hadamard' k = map toSymbols (hadamard k)

main = do
    k <- readLn :: IO Int
    putStr $ unlines (hadamard' k)

import Data.List
expand s = [s++s, s++(map (*(-1)) s)]

hadamard 0 = [[1]]
hadamard k = concat $ map expand $ hadamard (k-1)

hf::Int -> Char
hf ( 1) = '+'
hf (-1) = '-'

toSymbols s = map hf s

hadamard' k = map toSymbols (hadamard k)

main = do
    k <- readLn :: IO Int
    putStr $ unlines (hadamard' k)


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

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

main = do
  r1 <- fromIntegral.maximum.tail.map readInt.B.words <$> B.getLine
  p1 <- fromIntegral.maximum.tail.map readInt.B.words <$> B.getLine
  p2 <- fromIntegral.minimum.tail.map readInt.B.words <$> B.getLine
  [a,b] <- map read.words <$> getLine
  print $ sqrt $ (b*p1*r1*r1)/(a*p2+b*p1)

import Prelude hiding (reads)

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

solve :: (Double, Double) -> [Double] -> [Double] -> [Double] -> Double
solve (a, b) r1s p1s p2s  =  r1 * sqrt (p1 * b / (p2 * a + p1 * b))
  where
    r1  =  maximum r1s
    p1  =  maximum p1s
    p2  =  minimum p2s

main :: IO ()
main  =  do
    as  <-  reads
    bs  <-  reads
    cs  <-  reads
    [a, b]  <-  reads
    print $ solve (a,b) (tail as) (tail bs) (tail cs)

import Data.List
main = do
    [x, y, z] <- mapM (\_ -> (map read . tail . words) `fmap` getLine) [1..3] :: IO [[Double]]
    [a, b] <- (map read . words) `fmap` getLine
    let p1 = maximum y
    let p2 = minimum z
    let r1 = maximum x
    print $ sqrt $ r1 * r1 * p1/(a/b + p1/p2)/p2

solve :: ([Double], [Double], [Double], Double, Double) -> Double
solve (xs, ys, zs, a, b) = sqrt $ r1^2 * p1 * b / (p1 * b + p2 * a)
    where r1 = maximum xs
          p1 = maximum ys
          p2 = minimum zs

readInput :: IO ([Double], [Double], [Double], Double, Double)
readInput = do
    contents <- getContents
    let ns:ms:ks:ab:_ = lines contents
        xs = map read $ tail $ words ns
        ys = map read $ tail $ words ms
        zs = map read $ tail $ words ks
        a = read $ words ab !! 0
        b = read $ words ab !! 1
    return (xs, ys, zs, a, b)

showOutput :: Double -> IO ()
showOutput r = do
    print r

main :: IO ()
main = do
    input <- readInput
    showOutput $ solve input

solve :: ([Double], [Double], [Double], Double, Double) -> Double
solve (xs, ys, zs, a, b) = maximum [r2 | r1 <- xs, let p1 = maximum ys, let p2 = minimum zs, let r2 = sqrt $ r1^2 * p1 * b / (p1 * b + p2 * a)]

readInput :: IO ([Double], [Double], [Double], Double, Double)
readInput = do
    contents <- getContents
    let ns:ms:ks:ab:_ = lines contents
        xs = map read $ tail $ words ns
        ys = map read $ tail $ words ms
        zs = map read $ tail $ words ks
        a = read $ words ab !! 0
        b = read $ words ab !! 1
    return (xs, ys, zs, a, b)

showOutput :: Double -> IO ()
showOutput r = do
    print r

main :: IO ()
main = do
    input <- readInput
    showOutput $ solve input

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

parse = map (map read) . map words . lines

-- xs~r1, ys~p1, zs~p2
solve [_:xs, _:ys, _:zs, [a, b]] =
  let
    r1 = maximum xs
    p1 = maximum ys
    p2 = minimum zs
  in
    sqrt ((b * p1 * r1 * r1)/(p2 * a + p1 * b))

present = show

main = interact $ present . solve . parse

main = do
  r1 <- fmap (maximum . tail) getArray
  p1 <- fmap (maximum . tail) getArray
  p2 <- fmap (minimum . tail) getArray
  [a, b] <- getArray
  print $ gao r1 p1 p2 a b
  where
    getArray = fmap (map read . words) getLine
    gao r1 p1 p2 a b = r1 / sqrt ((a * p2) / (b * p1) + 1)

calc::Double->Double->Double->Double->[Double]->Double
calc _ _ _ _ [] = 0
calc r1 p2 a b (y:ys) = max (sqrt ((r1 * r1 * y * b) / (p2 * a + y * b))) (calc r1 p2 a b ys)

main = do
     xs <- getLine
     let r1 = foldl max 0 (tail (map (read::String->Double) (words xs)))
     ys <- getLine
     let p1 = tail.map (read::String->Double) $ words ys
     zs <- getLine
     let p2 = foldl min 65535 (tail (map (read::String->Double) (words zs)))
     ab' <- getLine
     let ab = map (read::String->Double) $ words ab'
     putStrLn(show $ calc r1 p2 (ab !! 0) (ab !! 1) p1)

import qualified Data.ByteString.Char8 as BS
import Control.Applicative

ring a b = (circle a) - (circle b)
circle a = a * a

-- (r1 * r1 * pi - r2 * r2 * pi) * p1 * b == r2 * r2 * pi * p2 * a
solve x y z a b = let r1 = foldr max 0.0 x
                      p2 = foldr min 10000.0 z
                      cand = [ r1 * (sqrt ((p1 * b) / (p2 * a + p1 * b))) | p1 <- y ]
                  in  foldr max 0.0 cand

main = do
  x <- map fromIntegral <$> (tail <$> readInts)
  y <- map fromIntegral <$> (tail <$> readInts)
  z <- map fromIntegral <$> (tail <$> readInts)
  [a, b] <- map fromIntegral <$> readInts
  print $ solve x y z a b

toNumber (Just (x, _)) = x
toNumber Nothing       = 0
readInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))


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

main=do
 [n,m,x]<-map read.words<$>getLine
 keys<-replicateM n getLine
 let goodKeys = map head.group.sort $ do
       (i, row) <- zip [0..n-1] keys
       (j, 'S') <- zip [0..m-1] row
       (i', row') <- zip [0..n-1] keys
       (j', l) <- zip [0..m-1] row'
       let sq x = x*x
       guard (sq(i-i')+sq(j-j') <= sq x)
       return l
 getLine
 text<-getLine
 let badKeys = map toUpper$filter(`notElem` goodKeys)['a'..'z']
     veryBadLc = filter(\c -> all (c `notElem`) keys)['a'..'z']
     any2D p = any (any p)
     veryBadKeys | any2D (=='S') keys = veryBadLc ++ map toUpper veryBadLc
      | otherwise = veryBadLc ++ ['A'..'Z']
     cnt p = length.filter p

 putStrLn$show$case cnt (`elem` veryBadKeys) text of
    0 -> cnt(`elem` badKeys) text
    _ -> -1

import Data.Char (toLower, isUpper)
import qualified Data.Map as M
import Control.Monad (foldM, guard)
import Data.List (foldl')
main = do
    [n, m, x] <- (map read . words) `fmap` getLine
    cm <- foldM (\cm' i -> do
        l <- getLine
        return $ foldl (\cm (c, j) -> M.insertWith (++) c [(i, j)] cm) cm' $
                zip l [0..]) M.empty [0..n-1]
    let cm' = M.fromList $ (if M.notMember 'S' cm then map (\x -> (x, Nothing))
            else let xs = cm M.! 'S' in map (\c -> (c, Just $ (do
            (ix, jx) <- xs
            (i, j) <- cm M.! c
            let l = (i-ix)^2 + (j-jx)^2
            guard (l <= x^2)
            return l) /= []))) $ filter (/='S') $ M.keys cm
    _ <- getLine
    k <- (foldl' (\r c -> do
        r' <- r
        b <- M.lookup (toLower c) cm'
        r'' <- if isUpper c then do
            b' <- b
            return $ if b' then 0 else 1 else Just 0
        return (r' + r'')) (Just 0)) `fmap` getLine
    print $ case k of {Nothing -> (-1); Just x -> x}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Data.Char
import Data.Array

look :: (Eq e, Ix i) => Array i e -> e -> [i]
look ar el =  filter (\i ->(ar ! i) == el)  (indices ar)

main :: IO ()
main = do
   [n,m,x] <- map (fst.fromJust.BS.readInt) . BS.words <$> BS.getLine
   board <- listArray ((1,1), (n,m)) . BS.unpack .BS.filter isAlpha . BS.concat <$> replicateM n BS.getLine
   let epS c = c `elem` (elems board)
       wU c = if epS (toLower c) && ('S' `elem` (elems board))
              then if isPoss then 0 else 1
              else (-1)
          where sl = look board 'S'
                cl = look board (toLower c)
                isPoss = or [ ((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)) <= x*x  | (x1, y1) <- sl, (x2, y2) <- cl]
   q <- fst . fromJust . BS.readInt <$> BS.getLine
   let f (-1) _ = (-1)
       f n c | isLower c && epS c = n
             | isLower c = (-1)
             | temp == (-1) = (-1)
             | otherwise = n + temp
         where temp = wU' !  c
       wU' = listArray ('A','Z') [wU c | c <- ['A'..'Z']]
   ans <- BS.foldl' f 0 . BS.filter isAlpha <$> BS.getLine
   --print $ look board 'S'
   --print $ look board 'c'
   --print wU'
   print ans


import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ solve
solve = read <$> getLine >>= \x -> print $
    if x == 1 then 2 else
        let (a, r) = x `divMod` 3 in
            (if r == 0 then id else (1+)) a

module Main where
import Control.Monad
import Data.List
y::Bool->Bool->Int
y True True=2
y False False=0
y True False=1
y False True=1
solve::Int->Int
solve x= d+(y ((x`rem`3)/=0) (x==1))
    where d=x`div`3

main = do
  line<-getLine
  let nTerm=read line::Int
  replicateM_ nTerm$do
    line<-getLine
    let n=read line::Int
    print$solve n

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ solve
solve = read <$> getLine >>= \x -> print $
    if x == 1 then 2 else
        let (a, r) = x `divMod` 3 in
            if r == 0 then a else 1+a

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ solve
solve = read <$> getLine >>= \x -> print $
    if x == 1 then 2
    else x `div` 3 + case x `mod` 3 of
        0 -> 0
        1 -> 1
        2 -> 1

{-
 Whatever you do, work heartily, as for the Lord and not for men,
 knowing that from the Lord you will receive the inheritance as your reward.
 You are serving the Lord Christ.
   - Colossians 3:23-24
-}

module Main
       ( main )
       where

import Control.Monad

minutesTo :: Int -> Int
minutesTo x
   | x == 1    = 2
   | rem == 0  = quot
   | otherwise = quot + 1
   where (quot, rem) = x `quotRem` 3

main :: IO ()
main = do
  line <- getLine
  let testCases = read line

  replicateM_ testCases $ do
    line <- getLine
    let n = read line
    print $ minutesTo n

{-
 Whatever you do, work heartily, as for the Lord and not for men,
 knowing that from the Lord you will receive the inheritance as your reward.
 You are serving the Lord Christ.
   - Colossians 3:23-24
-}

module Main
       ( main )
       where

import Control.Monad

minutesTo :: Int -> Int
minutesTo x
   | x == 1         = 2
   | x `mod` 3 == 0 = x `div` 3
   | otherwise      = x `div` 2

main :: IO ()
main = do
  line <- getLine
  let testCases = read line

  replicateM_ testCases $ do
    line <- getLine
    let n = read line
    print $ minutesTo n