New Year is coming in Tree World! In this world, as the name implies, there are n cities connected by n - 1 roads, and for any two distinct cities there always exists a path between them. The cities are numbered by integers from 1 to n, and the roads are numbered by integers from 1 to n - 1. Let's define d(u, v) as total length of roads on the path between city u and city v.As an annual event, people in Tree World repairs exactly one road per year. As a result, the length of one road decreases. It is already known that in the i-th year, the length of the ri-th road is going to become wi, which is shorter than its length before. Assume that the current year is year 1.Three Santas are planning to give presents annually to all the children in Tree World. In order to do that, they need some preparation, so they are going to choose three distinct cities c1, c2, c3 and make exactly one warehouse in each city. The k-th (1 ≤ k ≤ 3) Santa will take charge of the warehouse in city ck.It is really boring for the three Santas to keep a warehouse alone. So, they decided to build an only-for-Santa network! The cost needed to build this network equals to d(c1, c2) + d(c2, c3) + d(c3, c1) dollars. Santas are too busy to find the best place, so they decided to choose c1, c2, c3 randomly uniformly over all triples of distinct numbers from 1 to n. Santas would like to know the expected value of the cost needed to build the network.However, as mentioned, each year, the length of exactly one road decreases. So, the Santas want to calculate the expected after each length change. Help them to calculate the value.

The first line contains an integer n (3 ≤ n ≤ 105) — the number of cities in Tree World. Next n - 1 lines describe the roads. The i-th line of them (1 ≤ i ≤ n - 1) contains three space-separated integers ai, bi, li (1 ≤ ai, bi ≤ n, ai ≠ bi, 1 ≤ li ≤ 103), denoting that the i-th road connects cities ai and bi, and the length of i-th road is li. The next line contains an integer q (1 ≤ q ≤ 105) — the number of road length changes. Next q lines describe the length changes. The j-th line of them (1 ≤ j ≤ q) contains two space-separated integers rj, wj (1 ≤ rj ≤ n - 1, 1 ≤ wj ≤ 103). It means that in the j-th repair, the length of the rj-th road becomes wj. It is guaranteed that wj is smaller than the current length of the rj-th road. The same road can be repaired several times.

Output q numbers. For each given change, print a line containing the expected cost needed to build the network in Tree World. The answer will be considered correct if its absolute and relative error doesn't exceed 10 - 6.

NoteConsider the first sample. There are 6 triples: (1, 2, 3), (1, 3, 2), (2, 1, 3), (2, 3, 1), (3, 1, 2), (3, 2, 1). Because n = 3, the cost needed to build the network is always d(1, 2) + d(2, 3) + d(3, 1) for all the triples. So, the expected cost equals to d(1, 2) + d(2, 3) + d(3, 1).

import qualified Data.ByteString.Char8 as B
import Data.IntMap hiding (map, foldl)
import qualified Data.IntMap as M
fuck = maybe 0 fst . B.readInt
main = B.interact $ B.unlines . map (B.pack . show) . f . map fuck . B.words
f (n:x) = map (6/z/(z-1)*) $ g s m r where
  z = fromIntegral n
  (p, (q:r)) = splitAt (3*n-3) x
  m = M.map (\(k,l) -> (k*(z-k),l)) $ h p
  s = M.foldl (\a (k,l) -> a+k*fromIntegral l) 0 m
g _ _ [] = []
g s m (r:w:q) = t:g t u q where
  (k,l) = m!r
  t = s-k*fromIntegral(l-w)
  u = adjust (\(k,l) -> (k,w)) r m
h x = fromList . snd $ i [] 0 1 where
  m = j 1 x
  i s u v = foldl f (1,s) $ m!v where
    f x (b,_,_) | b == u = x
    f (x,y) (b,k,l) = let (p,q) = i y v b in (x+p,(k,(fromIntegral p,l)):q)
j _ [] = empty
j k (a:b:l:s) = unionWith (++) (fromList [(a,[(b,k,l)]),(b,[(a,k,l)])]) $ j (k+1) s

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

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

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

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

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

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

get :: State s s
get = State $ id &&& id
put :: s -> State s ()
put = State . const . ((),)
modify :: (s -> s) -> State s ()
modify = State . (.) ((,) ())
evalState :: State s a -> s -> a
evalState = (.) fst . runState
execState :: State s a -> s -> s
execState = (.) snd . runState

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

main = do
    sn:l <- B.lines <$> B.getContents
    let n = readInt sn
    let (_es,sq:l') = splitAt (n-1) l
    let es = map (map readInt . B.words) _es
    let q = readInt sq
    let qs = map (map readInt . B.words) l'
    putStr $ unlines $ map (printf "%.6f") $ solve n es q qs

solve :: Int -> [[Int]] -> Int -> [[Int]] -> [Double]
solve n es q qs = runST doit where
    n' :: Integer
    n' = fromIntegral n
    doit = do
        edges <- buildTree n es
        cost0 <- do
            es <- getElems edges
            return $ sum $ [ fromIntegral w * l * (n'-l) | (w,l) <- es ]
        go cost0 edges qs
    go _ _ [] = return []
    go !cost edges ([ri,wi]:qs) = do
        (wi',l) <- readArray edges ri
        let e = 3 * fromIntegral cost' / fromIntegral (n' * (n'-1) `div` 2)
            cost' = cost + fromIntegral (wi - wi') * l * (n'-l)
        writeArray edges ri (wi,l)
        (e:) <$> go cost' edges qs

buildTree :: Int -> [[Int]] -> ST s (STArray s Int (Int,Integer))
buildTree n es = doit where
    g :: Array Int [(Int,Int,Int)]
    g = accumArray (flip (:)) [] (1,n) $ do
        (i,[a,b,w]) <- zip [1..] es
        [(a,(b,w,i)),(b,(a,w,i))]
    doit = do
        a <- newArray_ (1,n-1)
        let dfs pv v = do
            let us = [ (u,w,i) | (u,w,i) <- g ! v, u /= pv]
            fmap ((+1).sum) $ forM us $ \(u,w,i) -> do
                ci <- dfs v u
                writeArray a i (w,ci)
                return ci
        dfs (-1) 1
        return a

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

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

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

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

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

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

get :: State s s
get = State $ id &&& id
put :: s -> State s ()
put = State . const . ((),)
modify :: (s -> s) -> State s ()
modify = State . (.) ((,) ())
evalState :: State s a -> s -> a
evalState = (.) fst . runState
execState :: State s a -> s -> s
execState = (.) snd . runState

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

main = do
    sn:l <- B.lines <$> B.getContents
    let n = readInt sn
    let (_es,sq:l') = splitAt (n-1) l
    let es = map (map readInt . B.words) _es
    let q = readInt sq
    let qs = map (map readInt . B.words) l'
    putStr $ unlines $ map (printf "%.6f") $ solve n es q qs

solve :: Int -> [[Int]] -> Int -> [[Int]] -> [Double]
solve n es q qs = go cost0 edges0 qs where
    n' :: Integer
    n' = fromIntegral n
    go _ _ [] = []
    go !cost !edges ([ri,wi]:qs) = e : go cost' edges' qs where
        (wi',l) = edges IM.! ri
        e = 3 * fromIntegral cost' / fromIntegral (n' * (n'-1) `div` 2)
        cost' = cost + fromIntegral (wi - wi') * l * (n'-l)
        edges' = IM.insert ri (wi,l) edges
    cost0 = sum $ [ fromIntegral w * l * (n'-l) | (w,l) <- IM.elems edges0 ]
    edges0 = buildTree n es

buildTree :: Int -> [[Int]] -> IM.IntMap (Int,Integer)
buildTree n es = execState doit IM.empty where
    g :: Array Int [(Int,Int,Int)]
    g = accumArray (flip (:)) [] (1,n) $ do
        (i,[a,b,w]) <- zip [1..] es
        [(a,(b,w,i)),(b,(a,w,i))]
    doit = void $ dfs (-1) 1
    dfs pv v = do
        let us = [ (u,w,i) | (u,w,i) <- g ! v, u /= pv]
        fmap ((+1).sum) $ forM us $ \(u,w,i) -> do
            ci <- dfs v u
            modify (IM.insert i (w,ci))
            return ci

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

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import Data.Array.Base
import qualified Data.ByteString.Char8 as B

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

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

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

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

get :: State s s
get = State $ id &&& id
put :: s -> State s ()
put = State . const . ((),)
modify :: (s -> s) -> State s ()
modify = State . (.) ((,) ())
evalState :: State s a -> s -> a
evalState = (.) fst . runState
execState :: State s a -> s -> s
execState = (.) snd . runState

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

main = do
    sn:l <- B.lines <$> B.getContents
    let n = readInt sn
    let (_es,sq:l') = splitAt (n-1) l
    let es = map (map readInt . B.words) _es
    let q = readInt sq
    let qs = map (map readInt . B.words) l'
    putStr $ unlines $ map (printf "%.6f") $ solve n es q qs

solve :: Int -> [[Int]] -> Int -> [[Int]] -> [Double]
solve n es q qs = runST doit where
    n' :: Integer
    n' = fromIntegral n
    edges = buildTree n es
    ws = [ fromIntegral w | [_,_,w] <- es ]
    doit :: ST s [Double]
    doit = do
        edgeLength <- newListArray (0,n-2) ws :: ST s (STUArray s Int Int64)
        let cost0 = sum $ zipWith (*) ws (elems edges)
        go cost0 edgeLength qs
    go :: Int64 -> (STUArray s Int Int64) -> [[Int]] -> ST s [Double]
    go _ _ [] = return []
    go !cost edgeLength ([ri,wi]:qs) = do
        wi' <- unsafeRead edgeLength (ri-1)
        let e = 3 * fromIntegral cost' / fromIntegral (n' * (n'-1) `div` 2)
            r = unsafeAt edges (ri-1)
            cost' = cost + fromIntegral (fromIntegral wi - wi') * r
        unsafeWrite edgeLength (ri-1) (fromIntegral wi)
        (e:) <$> go cost' edgeLength qs

buildTree :: Int -> [[Int]] -> UArray Int Int64
buildTree n es = doit where
    g :: Array Int [(Int,Int)]
    g = accumArray (flip (:)) [] (1,n) $ do
        (i,[a,b,w]) <- zip [1..] es
        [(a,(b,i)),(b,(a,i))]
    n' = fromIntegral n
    doit = runSTUArray $ do
        a <- newArray_ (0,n-2)
        let dfs pv v = do
            let us = [ (u,i-1) | (u,i) <- g ! v, u /= pv ]
            fmap ((+1).sum) $ forM us $ \(u,i) -> do
                ci <- dfs v u
                unsafeWrite a i (ci * (n'- ci))
                return ci
        dfs (-1) 1
        return a

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

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

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

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

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

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

get :: State s s
get = State $ id &&& id
put :: s -> State s ()
put = State . const . ((),)
modify :: (s -> s) -> State s ()
modify = State . (.) ((,) ())
evalState :: State s a -> s -> a
evalState = (.) fst . runState
execState :: State s a -> s -> s
execState = (.) snd . runState

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

main = do
    sn:l <- B.lines <$> B.getContents
    let n = readInt sn
    let (_es,sq:l') = splitAt (n-1) l
    let es = map (map readInt . B.words) _es
    let q = readInt sq
    let qs = map (map readInt . B.words) l'
    putStr $ unlines $ map (printf "%.6f") $ solve n es q qs

solve :: Int -> [[Int]] -> Int -> [[Int]] -> [Double]
solve n es q qs = runST doit where
    n' :: Integer
    n' = fromIntegral n
    edges = buildTree n es
    ws = [ fromIntegral w | [_,_,w] <- es ]
    doit :: ST s [Double]
    doit = do
        edgeLength <- newListArray (1,n-1) ws :: ST s (STUArray s Int Int64)
        let cost0 = sum $ zipWith (*) ws (elems edges)
        go cost0 edgeLength qs
    go :: Int64 -> (STUArray s Int Int64) -> [[Int]] -> ST s [Double]
    go _ _ [] = return []
    go !cost edgeLength ([ri,wi]:qs) = do
        wi' <- readArray edgeLength ri
        let e = 3 * fromIntegral cost' / fromIntegral (n' * (n'-1) `div` 2)
            r = edges ! ri
            cost' = cost + fromIntegral (fromIntegral wi - wi') * r
        writeArray edgeLength ri (fromIntegral wi)
        (e:) <$> go cost' edgeLength qs

buildTree :: Int -> [[Int]] -> UArray Int Int64
buildTree n es = doit where
    g :: Array Int [(Int,Int)]
    g = accumArray (flip (:)) [] (1,n) $ do
        (i,[a,b,w]) <- zip [1..] es
        [(a,(b,i)),(b,(a,i))]
    n' = fromIntegral n
    doit = runSTUArray $ do
        a <- newArray_ (1,n-1)
        let dfs pv v = do
            let us = [ (u,i) | (u,i) <- g ! v, u /= pv]
            fmap ((+1).sum) $ forM us $ \(u,i) -> do
                ci <- dfs v u
                writeArray a i (ci * (n'- ci))
                return ci
        dfs (-1) 1
        return a

import Data.IntMap hiding (foldl)
import qualified Data.IntMap as M
main = interact $ unlines . fmap show . f . fmap read . words
f (n:x) = fmap ((* t) . fromIntegral) $ g s m r where
  (p, (q:r)) = splitAt (3*n-3) x
  m = M.map (\(k,l) -> (k*(toInteger n-k),l)) $ h p
  s = M.foldl (\a (k,l) -> a+k*toInteger l) 0 m
  t = 6.0 / (fromIntegral $ n*(n-1))
g _ _ [] = []
g s m (r:w:q) = t:g t u q where
  (k,l) = m!r
  t = s-k*toInteger(l-w)
  u = adjust (\(k,l) -> (k,w)) r m
h x = fromList . snd $ i 0 1 where
  m = j 1 x
  i u v = foldl f (1,[]) $ m!v where
    f x (b,_,_) | b == u = x
    f (x,y) (b,k,l) = let (p,q) = i v b in (x+p,(k,(p,l)):y++q)
j _ [] = empty
j k (a:b:l:s) = unionWith (++) (fromList [(a,[(b,k,l)]),(b,[(a,k,l)])]) $ j (k+1) s


Your classmate, whom you do not like because he is boring, but whom you respect for his intellect, has two strings: $$$s$$$ of length $$$n$$$ and $$$t$$$ of length $$$m$$$.A sequence $$$p_1, p_2, \ldots, p_m$$$, where $$$1 \leq p_1 < p_2 < \ldots < p_m \leq n$$$, is called beautiful, if $$$s_{p_i} = t_i$$$ for all $$$i$$$ from $$$1$$$ to $$$m$$$. The width of a sequence is defined as $$$\max\limits_{1 \le i < m} \left(p_{i + 1} - p_i\right)$$$.Please help your classmate to identify the beautiful sequence with the maximum width. Your classmate promised you that for the given strings $$$s$$$ and $$$t$$$ there is at least one beautiful sequence.

The first input line contains two integers $$$n$$$ and $$$m$$$ ($$$2 \leq m \leq n \leq 2 \cdot 10^5$$$) — the lengths of the strings $$$s$$$ and $$$t$$$. The following line contains a single string $$$s$$$ of length $$$n$$$, consisting of lowercase letters of the Latin alphabet. The last line contains a single string $$$t$$$ of length $$$m$$$, consisting of lowercase letters of the Latin alphabet. It is guaranteed that there is at least one beautiful sequence for the given strings.

Output one integer — the maximum width of a beautiful sequence.

NoteIn the first example there are two beautiful sequences of width $$$3$$$: they are $$$\{1, 2, 5\}$$$ and $$$\{1, 4, 5\}$$$.In the second example the beautiful sequence with the maximum width is $$$\{1, 5\}$$$.In the third example there is exactly one beautiful sequence — it is $$$\{1, 2, 3, 4, 5\}$$$.In the fourth example there is exactly one beautiful sequence — it is $$$\{1, 2\}$$$.

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as S
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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m] <- readInts
  s <- P.toStrict <$> readLine
  t <- P.unpack <$> readLine
  let
    sfwd c i = if  S.index s i == c  then  i  else  sfwd c (i+1)
    srev c i = if  S.index s i == c  then  i  else  srev c (i-1)
    istart = sfwd (head t) 0
    is = scanl (\i c -> sfwd c (i+1)) istart (tail t)
    trev = reverse t
    jstart = srev (head trev) (n-1)
    js = reverse $ scanl (\j c -> srev c (j-1)) jstart (tail trev)
  putInts [maximum $ zipWith (-) (tail js) is]

type SIO = StateT P.ByteString IO

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

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

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

import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as P
import Data.List
import Data.Semigroup
import System.IO

-- Throws exception if not found
findNext :: S.ByteString -> Char -> Int -> Int
findNext s c i = if S.index s i == c then i else findNext s c (i + 1)

firstBeautifulSequence :: S.ByteString -> String -> [Int]
firstBeautifulSequence s t = tail $ scanl (\i c -> findNext s c (i + 1)) (-1) t

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m] <- readInts
  s <- P.toStrict <$> readLine
  t <- P.unpack <$> readLine
  let dpFwd = firstBeautifulSequence s t
      dpRev = reverse (map ((S.length s - 1) -) $ firstBeautifulSequence (S.reverse s) (reverse t))
      answer = maximum $ zipWith (-) (tail dpRev) dpFwd
  putInts [answer]

type SIO = StateT P.ByteString IO

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

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

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

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

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

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

run :: Hopper B.ByteString B.ByteString
run = do
  ~[n, m] <- popInts
  s <- B.unpack <$> popJust
  t <- B.unpack <$> popJust
  return $ bshow (solve n m s t) <> "\n"

solve n m s t = maximum $ map (\((a, _), (_, b)) -> b - a) $ adjlist $ zip fi bi
  where
    makeIndex s t = makeIndex' 0 s t

    makeIndex' _ _ [] = []
    makeIndex' i (s : ss) ts@(t : ts')
      | s == t = i : makeIndex' (i + 1) ss ts'
      | otherwise = makeIndex' (i + 1) ss ts

    fi = makeIndex s t

    bi = map ((n - 1 -)) $ reverse $ makeIndex (reverse s) (reverse t)

adjlist as@(_ : as') = zip as as'
adjlist _ = []


A flower shop has got n bouquets, and the i-th bouquet consists of ai flowers. Vasya, the manager of the shop, decided to make large bouquets from these bouquets. Vasya thinks that a bouquet is large if it is made of two or more initial bouquets, and there is a constraint: the total number of flowers in a large bouquet should be odd. Each of the initial bouquets can be a part of at most one large bouquet. If an initial bouquet becomes a part of a large bouquet, all its flowers are included in the large bouquet.Determine the maximum possible number of large bouquets Vasya can make.

The first line contains a single positive integer n (1 ≤ n ≤ 105) — the number of initial bouquets. The second line contains a sequence of integers a1, a2, ..., an (1 ≤ ai ≤ 106) — the number of flowers in each of the initial bouquets.

Print the maximum number of large bouquets Vasya can make.

NoteIn the first example Vasya can make 2 large bouquets. For example, the first bouquet can contain the first and the fifth initial bouquets (the total number of flowers is then equal to 9), and the second bouquet can consist of the second and the third initial bouquets (the total number of flowers is then equal to 7). The fourth initial bouquet is unused in this scheme. In the second example it is not possible to form a single bouquet with odd number of flowers.In the third example Vasya can make one large bouquet. For example, he can make it using all three initial bouquets. The size of the large bouquet is then equal to 11 + 4 + 10 = 25.

main = do
    (n : as) <- fmap (map read . words) getContents
    let even = length . filter (\x -> x `mod` 2 == 0) $ as
    let odd = length . filter (\x -> x `mod` 2 == 1) $ as
    if even >= odd
    then print $ odd
    else print $ even + ((odd - even) `quot` 3)

main = do
  (n:as) <- fmap (map read . words) getContents
  let e = length $ filter even as
  let o = n - e
  print $ if o < e then o else (e + (o-e) `div` 3)

--ghc 7.10

evenCount :: [Integer] -> Integer
evenCount [] = 0
evenCount (x:xs)
    | x `mod` 2 == 0 = 1 + evenCount xs
    | otherwise = evenCount xs

oddCount :: [Integer] -> Integer
oddCount [] = 0
oddCount (x:xs)
    | x `mod` 2 == 1 = 1 + oddCount xs
    | otherwise = oddCount xs

main :: IO()
main = do
    str <- getLine
    let n = read str :: Integer
    str <- getLine
    let a = fmap (\as -> read as :: Integer) (words str)
    let ecnt = evenCount a
    let ocnt = oddCount a
    let ans = min ecnt ocnt
    let e1 = ecnt - ans
    let o1 = ocnt - ans
    let a1 = ans + (o1 `div` 3)
    print(a1)

main = do
    (n:as) <- fmap (map read . words) getContents
    print $ (let cnt1 = toInteger $ length $ filter odd as
             in if cnt1 <= (quot n 2) then cnt1
                                       else ((n - cnt1) + (quot (cnt1 - (n - cnt1))) 3))

import System.IO -- импорт  модуля IO
import Data.List
f :: [[Char]] -> Int
f [] = 0
f (x:xs) = if (mod (read x :: Int) 2 == 1) then (1 + (f xs))
    else (f xs)
split :: Char -> String -> [[Char]]
split _ [] = []
split d l = uncurry (:) . fmap (split d . drop 1) . break (==d) $ l
del :: Int -> Int -> Int
del n m = div n m
main :: IO ()
main = do
	n <- getLine
	m <- getLine
	let nech = length [x | (x,y)<- zip (split ' ' m) [1..],(mod (read x :: Int) 2) == 1];ch = length [x | (x,y)<- zip (split ' ' m) [1..], (mod (read x :: Int) 2) == 0];ans = min ch nech + w;w = h (nech - ch)
	print (ans)
    where
        h n = if n < 1 then 0
            else del n 3
	--putStrLn $ show $ (read sx1 :: Int) + (read sx2 :: Int) -- печатаем сумму (преобразовав строки в Int)
	--putStrLn $ show $ n

import Data.List (sort)
main = do
  (n:as) <- fmap (map read . words) getContents
  let oddcnt = length (filter (odd) as)
  print (if oddcnt <= (n - oddcnt) then (oddcnt) else (n - oddcnt + (div (oddcnt - n + oddcnt) 3)))

main = do
  (n:as) <- fmap (map read . words) getContents
  let e = length $ filter even as
  let o = n - e
  print $ if o < e then o else (e + (o-e) `div` 2)

--ghc 7.10

evenCount :: [Integer] -> Integer
evenCount [] = 0
evenCount (x:xs)
    | x `mod` 2 == 0 = 1 + evenCount xs
    | otherwise = evenCount xs

oddCount :: [Integer] -> Integer
oddCount [] = 0
oddCount (x:xs)
    | x `mod` 2 == 1 = 1 + oddCount xs
    | otherwise = oddCount xs

main :: IO()
main = do
    str <- getLine
    let n = read str :: Integer
    str <- getLine
    let a = fmap (\as -> read as :: Integer) (words str)
    let ecnt = evenCount a
    let ocnt = oddCount a
    let ans = ecnt + ((ocnt - ecnt) `div` 3)
    print(ans)

--ghc 7.10

evenCount :: [Integer] -> Integer
evenCount [] = 0
evenCount (x:xs)
    | x `mod` 2 == 0 = 1 + evenCount xs
    | otherwise = evenCount xs

oddCount :: [Integer] -> Integer
oddCount [] = 0
oddCount (x:xs)
    | x `mod` 2 == 1 = 1 + oddCount xs
    | otherwise = oddCount xs

main :: IO()
main = do
    str <- getLine
    let n = read str :: Integer
    str <- getLine
    let a = fmap (\as -> read as :: Integer) (words str)
    let ecnt = evenCount a
    let ocnt = oddCount a
    print(min ecnt ocnt)


This is the easy version of the problem. The difference between versions is the constraints on $$$n$$$ and $$$a_i$$$. You can make hacks only if all versions of the problem are solved.First, Aoi came up with the following idea for the competitive programming problem:Yuzu is a girl who collecting candies. Originally, she has $$$x$$$ candies. There are also $$$n$$$ enemies numbered with integers from $$$1$$$ to $$$n$$$. Enemy $$$i$$$ has $$$a_i$$$ candies.Yuzu is going to determine a permutation $$$P$$$. A permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$\{2,3,1,5,4\}$$$ is a permutation, but $$$\{1,2,2\}$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$\{1,3,4\}$$$ is also not a permutation (because $$$n=3$$$ but there is the number $$$4$$$ in the array).After that, she will do $$$n$$$ duels with the enemies with the following rules:  If Yuzu has equal or more number of candies than enemy $$$P_i$$$, she wins the duel and gets $$$1$$$ candy. Otherwise, she loses the duel and gets nothing.  The candy which Yuzu gets will be used in the next duels. Yuzu wants to win all duels. How many valid permutations $$$P$$$ exist?This problem was easy and wasn't interesting for Akari, who is a friend of Aoi. And Akari made the following problem from the above idea:Let's define $$$f(x)$$$ as the number of valid permutations for the integer $$$x$$$.You are given $$$n$$$, $$$a$$$ and a prime number $$$p \le n$$$. Let's call a positive integer $$$x$$$ good, if the value $$$f(x)$$$ is not divisible by $$$p$$$. Find all good integers $$$x$$$.Your task is to solve this problem made by Akari.

The first line contains two integers $$$n$$$, $$$p$$$ $$$(2 \le p \le n \le 2000)$$$. It is guaranteed, that the number $$$p$$$ is prime (it has exactly two divisors $$$1$$$ and $$$p$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ $$$(1 \le a_i \le 2000)$$$.

In the first line, print the number of good integers $$$x$$$. In the second line, output all good integers $$$x$$$ in the ascending order. It is guaranteed that the number of good integers $$$x$$$ does not exceed $$$10^5$$$.

NoteIn the first test, $$$p=2$$$.  If $$$x \le 2$$$, there are no valid permutations for Yuzu. So $$$f(x)=0$$$ for all $$$x \le 2$$$. The number $$$0$$$ is divisible by $$$2$$$, so all integers $$$x \leq 2$$$ are not good.  If $$$x = 3$$$, $$$\{1,2,3\}$$$ is the only valid permutation for Yuzu. So $$$f(3)=1$$$, so the number $$$3$$$ is good.  If $$$x = 4$$$, $$$\{1,2,3\} , \{1,3,2\} , \{2,1,3\} , \{2,3,1\}$$$ are all valid permutations for Yuzu. So $$$f(4)=4$$$, so the number $$$4$$$ is not good.  If $$$x \ge 5$$$, all $$$6$$$ permutations are valid for Yuzu. So $$$f(x)=6$$$ for all $$$x \ge 5$$$, so all integers $$$x \ge 5$$$ are not good. So, the only good number is $$$3$$$.In the third test, for all positive integers $$$x$$$ the value $$$f(x)$$$ is divisible by $$$p = 3$$$.

import qualified Data.IntMap as IntMap
import           Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

main :: IO()
main =
  do
    [n, p] <- map read . words <$> getLine :: IO [Int]
    a <- map read . words <$> getLine :: IO [Int]
    let k = maximum a
    let empty = IntMap.fromList $ zip [0 .. n - 1] $ repeat 0
    let cntMap = foldr (IntMap.alter ((1+) <$>) . (\x -> if x > k - n then x - k + n - 1 else 0)) empty a
    let s = foldr (wtf p) IntSet.empty $ scanl1 (\(_, ci) (j, cj) -> (j, ci + cj)) $ IntMap.toList cntMap
    let ans = [x + k - n + 1 | x <- [0..n-1], x < p, IntSet.notMember (x `mod` p) s]
    print $ length ans
    putStrLn $ unwords $ map show ans
  where
    wtf :: Int -> (Int, Int) -> IntSet -> IntSet
    wtf p = (\(i, m) -> if (-m) `mod` p <= i then IntSet.insert $ (-m) `mod` p else id).(\(i, c) -> (i, c - i))


In one school with Vasya there is a student Kostya. Kostya does not like physics, he likes different online games. Every day, having come home, Kostya throws his bag in the farthest corner and sits down at his beloved computer. Kostya even eats glued to the game. A few days ago Kostya bought a new RPG game "HaresButtle", which differs from all other games in this genre. It has a huge number of artifacts. As we know, artifacts are divided into basic and composite ones. Only the basic artifacts are available on sale. More powerful composite artifacts are collected from some number of basic artifacts.After the composing composite artifact, all the components disappear.Kostya is the head of the alliance, so he has to remember, what artifacts has not only himself, but also his allies. You must identify by sequence of artifacts purchased by Kostya and his allies, how many and which artifacts has been collected by each of them. It is believed that initially no one has any artifacts.

The first line has 4 natural numbers: k (1 ≤ k ≤ 100) — the number of Kostya's allies, n (1 ≤ n ≤ 50) — the number of basic artifacts, m (0 ≤ m ≤ 50) — the number of composite artifacts, q (1 ≤ q ≤ 500) — the number of his friends' purchases. The following n lines contain the names of basic artifacts. After them m lines contain the descriptions of composite artifacts in the following format: <Art. Name>: <Art. №1> <Art. №1 Number>, <Art. №2> <Art. №2 Number>, ... <Art. №X> <Art. №Х Number> All the numbers are natural numbers not exceeding 100 (1 ≤ X ≤ n). The names of all artifacts are different, they are composed of lowercase Latin letters, and the length of each name is from 1 to 100 characters inclusive. All the words in the format of the description of a composite artifact are separated by exactly one space. It is guaranteed that all components of the new artifact are different and have already been met in the input data as the names of basic artifacts.  Next, each of the following q lines is characterized by the number ai, the number of a friend who has bought the artifact (1 ≤ ai ≤ k), and the name of the purchased basic artifact. Let's assume that the backpacks of the heroes are infinitely large and any artifact bought later can fit in there. It is guaranteed that after the i-th purchase no more than one opportunity to collect the composite artifact appears. If such an opportunity arose, the hero must take advantage of it.

The output file should consist of k blocks. The first line should contain number bi — the number of different artifacts the i-th ally has. Then the block should contain bi lines with the names of these artifacts and the number of these artifacts. At that the lines should be printed in accordance with the lexicographical order of the names of the artifacts. In each block all the artifacts must be different, and all the numbers except the bi should be positive.

2 3 2 5
desolator
refresher
perseverance
vanguard: desolator 1, refresher 1
maelstorm: perseverance 2
1 desolator
2 perseverance
1 refresher
2 desolator
2 perseverance

import qualified Data.Map as M
import qualified Data.IntMap as IM
import Control.Monad
import Data.List
default (Int)

inA a b = let c = M.intersectionWith (-) a b in
    if M.size c == M.size b && M.fold ((&&).(>=0)) True c then
            Just (c `M.union` M.difference a b) else Nothing

f a ((bn,bm):bs) = case a `inA` bm of
        Nothing -> f a bs
        Just c -> M.insertWith' (+) bn 1 c
f a [] = a

main = do
    [k, n, m, q] <- (map read .words) `fmap` getLine
    mapM_ (\_ -> getLine) [1..n]
    let вводСоставных (имя:состав) = let
            пары (с1:с2:ост) = (с1, read с2):пары ост
            пары [] = [] in (имя, M.fromList (пары состав))
    составные <- mapM (\_ -> (вводСоставных . words . filter (not.flip elem ",:"))
            `fmap` getLine) [1..m]
    let другПокупка рюкзаки [друг, покупка] = let
            друг' = read друг
            новое = (M.singleton покупка 1)
            рюкзак' = f (case IM.lookup друг' рюкзаки of
                Nothing -> новое
                Just старое -> M.unionWith (+) старое новое) составные in
                    IM.insert друг' рюкзак' рюкзаки
    рюкзаки <- foldM (\рюкзаки _ -> (другПокупка рюкзаки . words) `fmap` getLine) IM.empty
                [1..q]
    mapM (\i -> do
        let блок = IM.lookup i рюкзаки
        case блок of
            Nothing -> putStrLn "0"
            Just рюкзак -> do
                let r = filter ((>0).snd) $ M.toList рюкзак
                putStrLn $ show (length r)
                mapM_ (\(артефакт, количество) -> putStr артефакт >> putChar ' '
                    >> (putStrLn (show количество))) r) [1..k]

import qualified Data.Map as M
import qualified Data.IntMap as IM
import Control.Monad
import Data.List
default (Int)

inA a b = let c = M.intersectionWith (-) a b in
    if M.size c == M.size b && M.fold ((&&).(>=0)) True c then
            Just (c `M.union` M.difference a b) else Nothing

f a ((bn,bm):bs) = case a `inA` bm of
        Nothing -> f a bs
        Just c -> M.insertWith' (+) bn 1 c
f a [] = a

main = do
    [k, n, m, q] <- (map read .words) `fmap` getLine
    mapM_ (\_ -> getLine) [1..n]
    let вводСоставных (имя:состав) = let
            пары (с1:с2:ост) = (с1, read с2):пары ост
            пары [] = [] in (имя, M.fromList (пары состав))
    составные <- mapM (\_ -> (вводСоставных . words . filter (not.flip elem ",:"))
            `fmap` getLine) [1..m]
    let положитьВРюкзак новое старое  = let
            новое' = M.unionWith (+) новое старое in f новое' составные
        другПокупка рюкзаки [друг, покупка] = let друг' = read друг in
           IM.insertWith положитьВРюкзак друг' (M.singleton покупка 1) рюкзаки
    рюкзаки <- foldM (\рюкзаки _ -> (другПокупка рюкзаки . words) `fmap` getLine) IM.empty
                [1..q]
    mapM (\i -> do
        let блок = IM.lookup i рюкзаки
        case блок of
            Nothing -> putStrLn "0"
            Just рюкзак -> do
                let r = filter ((>0).snd) $ M.toList рюкзак
                putStrLn $ show (length r)
                mapM_ (\(артефакт, количество) -> putStr артефакт >> putChar ' '
                    >> (putStrLn (show количество))) r) [1..k]


Все готовятся к VK Fest 2021! Для того, чтобы зрителям была лучше видна главная сцена, планируется построить амфитеатр. В этой задаче мы будем рассматривать его сбоку — схематично он будет иметь форму лестницы из $$$n$$$ одинаковых квадратов. Лестница — это одна или более башен квадратов, выстроенных в ряд, где высоты башен невозрастают слева направо.На следующем рисунке можно видеть три разные фигуры из $$$12$$$ квадратов. Первые две фигуры — лестницы, а третья — нет.  Из эстетических соображений было решено, что амфитеатр должен быть симметричным. Формально, амфитеатр называется симметричным, если при отражении его схемы относительно прямой $$$x = y$$$ получается тот же самый рисунок (где ось $$$x$$$ направлена слева направо, а ось $$$y$$$ — снизу вверх). Например, первая лестница на рисунке выше — симметричная, а вторая — нет.  Кроме того, амфитеатр должен быть максимально компактным — а именно, сторона минимального квадрата, внутрь которого можно его поместить, должна быть как можно меньше.По заданному числу $$$n$$$ нарисуйте схему амфитеатра из ровно $$$n$$$ квадратов, удовлетворяющую всем условиям.

В единственной строке задано одно целое число $$$n$$$ ($$$1 \le n \le 100$$$) — число квадратов, из которых нужно составить схему амфитеатра.

Если не существует схемы амфитеатра из $$$n$$$ квадратов, выведите единственное число $$$-1$$$. Иначе в первой строке выведите целое число $$$m$$$ — минимальное возможное число строк и столбцов в схеме амфитеатра. Далее выведите $$$m$$$ строк, описывающих схему. Каждая строка должна содержать ровно $$$m$$$ символов 'o' (строчная латинская буква) или '.', где 'o' описывает построенный квадрат, а '.' — пустое место. Схема амфитеатра должна состоять ровно из $$$n$$$ символов 'o'. Ячейка в левом нижнем углу должна содержать квадрат. Если возможных ответов с минимальным $$$m$$$ несколько, выведите любой из них.

solution1 x = replicate x $ replicate x 'o'
solution2 x = (replicate (x - 1) 'o' ++ ".") : (replicate (x - 1) $ replicate x 'o')
solution3 x = ('o' : replicate x '.') :
              (replicate (x - 2) 'o' ++ "...") :
              (replicate (x - 2) 'o' ++ "...") :
              (replicate (x - 3) $ replicate x 'o' ++ ".") ++
              [replicate (x + 1) 'o']
solution4 p x = (replicate p 'o' ++ replicate (x - p) '.') :
                (replicate (x - p - 1) $ replicate (x - 1) 'o' ++ ".") ++
                (replicate p $ replicate x 'o')
solution5 p x = (replicate p 'o' ++ replicate (x - p) '.') :
                (replicate (x - 2) 'o' ++ "..") :
                (replicate (x - p - 2) $ replicate (x - 1) 'o' ++ ".") ++
                (replicate p $ replicate x 'o')

solution :: Int -> [String]
solution n
    | n         == 2 = ["-1"]
    | x * x     == n = show x : solution1 x
    | x * x - 1 == n = show x : solution2 x
    | x * x - 2 == n = show (x + 1) : solution3 x
    | mod p 2   == 0 = show x : solution4 (div p 2) x
    | otherwise      = show x : solution5 (div (p + 1) 2) x
    where p = n - (x - 1) * (x - 1)
          x = ceiling $ sqrt $ fromIntegral n

main = do
    n <- fmap read getLine
    putStr $ unlines $ solution n

solution1 x = replicate x $ replicate x 'o'
solution2 x = (replicate (x - 1) 'o' ++ ".") : (replicate (x - 1) $ replicate x 'o')
solution3 x = ('o' : replicate x '.') :
              (replicate (x - 2) 'o' ++ "...") :
              (replicate (x - 2) 'o' ++ "...") :
              (replicate (x - 4) $ replicate x 'o' ++ ".") ++
              [replicate (x + 1) 'o']
solution4 p x = (replicate p 'o' ++ replicate (x - p) '.') :
                (replicate (x - p - 1) $ replicate (x - 1) 'o' ++ ".") ++
                (replicate p $ replicate x 'o')
solution5 p x = (replicate p 'o' ++ replicate (x - p) '.') :
                (replicate (x - 2) 'o' ++ "..") :
                (replicate (x - p - 2) $ replicate (x - 1) 'o' ++ ".") ++
                (replicate p $ replicate x 'o')

solution :: Int -> [String]
solution n
    | n == 2         = ["-1"]
    | x * x     == n = show x : solution1 x
    | x * x - 1 == n = show x : solution2 x
    | x * x - 2 == n = show (x + 1) : solution3 x
    | mod p 2 == 0   = show x : solution4 (div p 2) x
    | otherwise      = show x : solution5 (div (p + 1) 2) x
    where p = n - (x - 1) * (x - 1)
          x = ceiling $ sqrt $ fromIntegral n

main = do
    n <- fmap read getLine
    putStr $ unlines $ solution n

solution1 x = replicate x $ replicate x 'o'
solution2 x = (replicate (x - 1) 'o' ++ ".") : (replicate (x - 1) $ replicate x 'o')
solution3 x = ('o' : replicate x '.') :
              (replicate (x - 2) 'o' ++ "...") :
              (replicate (x - 2) 'o' ++ "...") :
              (replicate (x - 4) $ replicate x 'o' ++ ".") ++
              [replicate (x + 1) 'o']
solution4 p x = (replicate p 'o' ++ replicate (x - p) '.') :
                (replicate (x - p - 1) $ replicate (x - 1) 'o' ++ ".") ++
                (replicate p $ replicate x 'o')
solution5 p x = (replicate p 'o' ++ replicate (x - p) '.') :
                (replicate (x - 2) 'o' ++ "..") :
                (replicate (x - p - 2) $ replicate (x - 1) 'o' ++ ".") ++
                (replicate p $ replicate x 'o')

solution :: Int -> Int -> [String]
solution x n
    | x * x     == n = solution1 x
    | x * x - 1 == n = solution2 x
    | x * x - 2 == n = solution3 x
    | mod p 2 == 0   = solution4 (div p 2) x
    | otherwise      = solution5 (div (p + 1) 2) x
    where p = n - (x - 1) * (x - 1)

main = do
    n <- fmap read getLine
    let x = ceiling $ sqrt $ fromIntegral n
    if n == 2
        then putStrLn "-1"
        else putStr $ show x ++ "\n" ++ (unlines $ solution x n)

main = do
    n <- fmap read getLine
    let x = ceiling $ sqrt $ fromIntegral n
    putStrLn $ show $ x
    let p = div (x * x - n) 2
    putStrLn $ replicate p '.' ++ replicate (x - p - 1) 'o' ++ if mod (x * x - n) 2 == 0 then "o" else "."
    mapM putStrLn $ zipWith (\i s -> if i < (x - p) then s ++ "o" else s ++ ".") [1..(x - 1)] $ replicate (x - 1) $ replicate (x - 1) 'o'


You are given string s. Your task is to determine if the given string s contains two non-overlapping substrings "AB" and "BA" (the substrings can go in any order).

The only line of input contains a string s of length between 1 and 105 consisting of uppercase Latin letters.

Print "YES" (without the quotes), if string s contains two non-overlapping substrings "AB" and "BA", and "NO" otherwise.

NoteIn the first sample test, despite the fact that there are substrings "AB" and "BA", their occurrences overlap, so the answer is "NO".In the second sample test there are the following occurrences of the substrings: BACFAB.In the third sample test there is no substring "AB" nor substring "BA".

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"

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

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

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)


Greg has a weighed directed graph, consisting of n vertices. In this graph any pair of distinct vertices has an edge between them in both directions. Greg loves playing with the graph and now he has invented a new game:  The game consists of n steps.  On the i-th step Greg removes vertex number xi from the graph. As Greg removes a vertex, he also removes all the edges that go in and out of this vertex.  Before executing each step, Greg wants to know the sum of lengths of the shortest paths between all pairs of the remaining vertices. The shortest path can go through any remaining vertex. In other words, if we assume that d(i, v, u) is the shortest path between vertices v and u in the graph that formed before deleting vertex xi, then Greg wants to know the value of the following sum: . Help Greg, print the value of the required sum before each step.

The first line contains integer n (1 ≤ n ≤ 500) — the number of vertices in the graph. Next n lines contain n integers each — the graph adjacency matrix: the j-th number in the i-th line aij (1 ≤ aij ≤ 105, aii = 0) represents the weight of the edge that goes from vertex i to vertex j. The next line contains n distinct integers: x1, x2, ..., xn (1 ≤ xi ≤ n) — the vertices that Greg deletes.

Print n integers — the i-th number equals the required sum before the i-th step. Please, do not use the %lld specifier to read or write 64-bit integers in C++. It is preferred to use the cin, cout streams of the %I64d specifier.

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


Homer has two friends Alice and Bob. Both of them are string fans. One day, Alice and Bob decide to play a game on a string $$$s = s_1 s_2 \dots s_n$$$ of length $$$n$$$ consisting of lowercase English letters. They move in turns alternatively and Alice makes the first move.In a move, a player must choose an index $$$i$$$ ($$$1 \leq i \leq n$$$) that has not been chosen before, and change $$$s_i$$$ to any other lowercase English letter $$$c$$$ that $$$c \neq s_i$$$.When all indices have been chosen, the game ends. The goal of Alice is to make the final string lexicographically as small as possible, while the goal of Bob is to make the final string lexicographically as large as possible. Both of them are game experts, so they always play games optimally. Homer is not a game expert, so he wonders what the final string will be.A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ if and only if one of the following holds:   $$$a$$$ is a prefix of $$$b$$$, but $$$a \ne b$$$;  in the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$b$$$.

Each test contains multiple test cases. The first line contains $$$t$$$ ($$$1 \le t \le 1000$$$)  — the number of test cases. Description of the test cases follows. The only line of each test case contains a single string $$$s$$$ ($$$1 \leq |s| \leq 50$$$) consisting of lowercase English letters.

For each test case, print the final string in a single line.

NoteIn the first test case: Alice makes the first move and must change the only letter to a different one, so she changes it to 'b'.In the second test case: Alice changes the first letter to 'a', then Bob changes the second letter to 'z', Alice changes the third letter to 'a' and then Bob changes the fourth letter to 'z'.In the third test case: Alice changes the first letter to 'b', and then Bob changes the second letter to 'y'.

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

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]

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

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


Guy-Manuel and Thomas have an array $$$a$$$ of $$$n$$$ integers [$$$a_1, a_2, \dots, a_n$$$]. In one step they can add $$$1$$$ to any element of the array. Formally, in one step they can choose any integer index $$$i$$$ ($$$1 \le i \le n$$$) and do $$$a_i := a_i + 1$$$.If either the sum or the product of all elements in the array is equal to zero, Guy-Manuel and Thomas do not mind to do this operation one more time.What is the minimum number of steps they need to do to make both the sum and the product of all elements in the array different from zero? Formally, find the minimum number of steps to make $$$a_1 + a_2 +$$$ $$$\dots$$$ $$$+ a_n \ne 0$$$ and $$$a_1 \cdot a_2 \cdot$$$ $$$\dots$$$ $$$\cdot a_n \ne 0$$$.

Each test contains multiple test cases.  The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^3$$$). The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \le n \le 100$$$) — the size of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$-100 \le a_i \le 100$$$) — elements of the array .

For each test case, output the minimum number of steps required to make both sum and product of all elements in the array different from zero.

NoteIn the first test case, the sum is $$$0$$$. If we add $$$1$$$ to the first element, the array will be $$$[3,-1,-1]$$$, the sum will be equal to $$$1$$$ and the product will be equal to $$$3$$$.In the second test case, both product and sum are $$$0$$$. If we add $$$1$$$ to the second and the third element, the array will be $$$[-1,1,1,1]$$$, the sum will be equal to $$$2$$$ and the product will be equal to $$$-1$$$. It can be shown that fewer steps can't be enough.In the third test case, both sum and product are non-zero, we don't need to do anything.In the fourth test case, after adding $$$1$$$ twice to the first element the array will be $$$[2,-2,1]$$$, the sum will be $$$1$$$ and the product will be $$$-4$$$.

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

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)