You're a mikemon breeder currently in the middle of your journey to become a mikemon master. Your current obstacle is go through the infamous Biridian Forest.The forestThe Biridian Forest is a two-dimensional grid consisting of r rows and c columns. Each cell in Biridian Forest may contain a tree, or may be vacant. A vacant cell may be occupied by zero or more mikemon breeders (there may also be breeders other than you in the forest). Mikemon breeders (including you) cannot enter cells with trees. One of the cells is designated as the exit cell.The initial grid, including your initial position, the exit cell, and the initial positions of all other breeders, will be given to you. Here's an example of such grid (from the first example):  MovesBreeders (including you) may move in the forest. In a single move, breeders may perform one of the following actions:   Do nothing.  Move from the current cell to one of the four adjacent cells (two cells are adjacent if they share a side). Note that breeders cannot enter cells with trees.  If you are located on the exit cell, you may leave the forest. Only you can perform this move — all other mikemon breeders will never leave the forest by using this type of movement. After each time you make a single move, each of the other breeders simultaneously make a single move (the choice of which move to make may be different for each of the breeders).Mikemon battleIf you and t (t > 0) mikemon breeders are located on the same cell, exactly t mikemon battles will ensue that time (since you will be battling each of those t breeders once). After the battle, all of those t breeders will leave the forest to heal their respective mikemons.Note that the moment you leave the forest, no more mikemon battles can ensue, even if another mikemon breeder move to the exit cell immediately after that. Also note that a battle only happens between you and another breeders — there will be no battle between two other breeders (there may be multiple breeders coexisting in a single cell).Your goalYou would like to leave the forest. In order to do so, you have to make a sequence of moves, ending with a move of the final type. Before you make any move, however, you post this sequence on your personal virtual idol Blog. Then, you will follow this sequence of moves faithfully.Goal of other breedersBecause you post the sequence in your Blog, the other breeders will all know your exact sequence of moves even before you make your first move. All of them will move in such way that will guarantee a mikemon battle with you, if possible. The breeders that couldn't battle you will do nothing.Your taskPrint the minimum number of mikemon battles that you must participate in, assuming that you pick the sequence of moves that minimize this number. Note that you are not required to minimize the number of moves you make.

The first line consists of two integers: r and c (1 ≤ r, c ≤ 1000), denoting the number of rows and the number of columns in Biridian Forest. The next r rows will each depict a row of the map, where each character represents the content of a single cell:    'T': A cell occupied by a tree.  'S': An empty cell, and your starting position. There will be exactly one occurence of this in the map.  'E': An empty cell, and where the exit is located. There will be exactly one occurence of this in the map.  A digit (0-9): A cell represented by a digit X means that the cell is empty and is occupied by X breeders (in particular, if X is zero, it means that the cell is not occupied by any breeder).  It is guaranteed that it will be possible for you to go from your starting position to the exit cell through a sequence of moves.

A single line denoted the minimum possible number of mikemon battles that you have to participate in if you pick a strategy that minimize this number.

NoteThe following picture illustrates the first example. The blue line denotes a possible sequence of moves that you should post in your blog:  The three breeders on the left side of the map will be able to battle you — the lone breeder can simply stay in his place until you come while the other two breeders can move to where the lone breeder is and stay there until you come. The three breeders on the right does not have a way to battle you, so they will stay in their place.For the second example, you should post this sequence in your Blog:  Here's what happens. First, you move one cell to the right.  Then, the two breeders directly to the right of the exit will simultaneously move to the left. The other three breeder cannot battle you so they will do nothing.  You end up in the same cell with 2 breeders, so 2 mikemon battles are conducted. After those battles, all of your opponents leave the forest.  Finally, you make another move by leaving the forest.

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

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
  [r, c] <- map read . words <$> getLine
  a <- replicateM r getLine

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

    end = head [(x, y) | x <- [1..r], y <- [1..c], a'!(x, y) == 'E']

  let
    ds = runSTUArray $ do
      ds :: STUArray s (Int, Int) Int <- newArray ((1, 1), (r, c)) (-1)
      writeArray ds end 0

      let
        loop q =
          case Seq.viewl q of
            Seq.EmptyL -> return ()
            (p Seq.:< q') -> do
              d <- readArray ds p
              let ps = filter (\(x, y) -> 1 <= x && x <= r && 1 <= y && y <= c && a'!(x, y) /= 'T') [(x+1, y), (x-1, y), (x, y+1), (x, y-1)] where (x, y) = p

              ps' <- filterM (\p -> (== (-1)) <$> readArray ds p) ps
              forM_ ps' $ \p -> writeArray ds p (d+1)

              loop $ foldl (Seq.|>) q' ps'

      loop $ Seq.singleton end
      return ds

  let
    start = head [(x, y) | x <- [1..r], y <- [1..c], a'!(x, y) == 'S']
    d0 = ds!start
    mikes = [p | x <- [1..r], y <- [1..c], let p = (x, y), '1' <= (a'!p), (a'!p) <= '9']

  print $ sum $ map (\p -> fromEnum (a'!p) - fromEnum '0') $ filter (\p -> ds!p /= -1 && ds!p <= d0) mikes

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

import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import Data.Array.ST(runSTArray)
import Data.Array.MArray
import Debug.Trace

type Map2D a = A.Array (Int,Int) a

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
near (x,y) = [(x+1,y),(x,y+1),(x-1,y),(x,y-1)]

main = do
    [r,c] <- map readInt . B.words <$> B.getLine
    l <- B.lines <$> B.getContents
    let bb = ((0,0),(r-1,c-1))
    let mymap = A.listArray bb $ [ B.index s i | s <- l , i <- [0..c-1]]
    print $ solve r c mymap

solve r c mymap = foldl' (+) 0 $ do
    (p,c) <- breeders
    guard $ isJust (cost A.! p) && fromJust (cost A.! p) <= mycost
    return (digitToInt c)
    where
    start = head $ findPos (=='S') mymap
    exit  = head $ findPos (=='E') mymap
    mycost = fromJust (cost A.! fst start)
    breeders = findPos (\c -> '0' < c && c <= '9') mymap
    cost  = calcDistance (fst exit) mymap

findPos :: (a -> Bool) -> Map2D a -> [((Int,Int),a)]
findPos prop l = [ (p,c) | (p,c) <- A.assocs l, prop c ]

calcDistance :: (Int,Int) -> Map2D Char -> Map2D (Maybe Int)
calcDistance st mymap = runSTArray $ do
    cost <- newArray bb Nothing
    go cost
    return cost
    where
    bb  = A.bounds mymap
    canEnter p = inRange bb p && mymap A.! p /= 'T'
    go cost = loop [(st,0)] []
        where
        loop [] [] = return ()
        loop [] l  = loop l []
        loop ((p,c):ps) l | not (canEnter p) = loop ps l
                          | otherwise = do
            v <- readArray cost p
            case v of
                Nothing -> do
                    writeArray cost p (Just c)
                    loop ps (map (\p -> (p,c+1)) (near p)++l)
                Just _ -> loop ps l

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

import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import Data.Array.ST(runSTArray)
import Data.Array.MArray

type Map2D a = A.Array (Int,Int) a

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
near (x,y) = [(x+1,y),(x,y+1),(x-1,y),(x,y-1)]

main = do
    [r,c] <- map readInt . B.words <$> B.getLine
    l <- B.lines <$> B.getContents
    let bb = ((0,0),(r-1,c-1))
    let mymap = A.listArray bb $ [ B.index s i | s <- l , i <- [0..c-1]]
    print $ solve r c mymap

solve r c mymap = foldl' (+) 0 $ do
    (p,c) <- breeders
    guard $ isJust (cost A.! p) && fromJust (cost A.! p) <= mycost
    return (digitToInt c)
    where
    start = head $ findPos (=='S') mymap
    exit  = head $ findPos (=='E') mymap
    mycost = fromJust (cost A.! fst start)
    breeders = findPos (\c -> '0' < c && c <= '9') mymap
    cost  = calcDistance (fst exit) mymap

findPos :: (a -> Bool) -> Map2D a -> [((Int,Int),a)]
findPos prop l = [ (p,c) | (p,c) <- A.assocs l, prop c ]

calcDistance :: (Int,Int) -> Map2D Char -> Map2D (Maybe Int)
calcDistance st mymap = runSTArray $ newArray bb Nothing >>= go
    where
    bb  = A.bounds mymap
    canEnter p = inRange bb p && mymap A.! p /= 'T'
    go cost = loop [st] [] 0
        where
        loop [] [] c = return cost
        loop [] l  c = loop l [] (c+1)
        loop (p:ps) l c = do
            b <- isJust <$> readArray cost p
            when (not b) $ writeArray cost p (Just c)
            let l' = if b then l else (filter canEnter $ near p)++l
            loop ps l' c

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

import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import qualified Data.Array.Unboxed as A
import Data.Array.ST(runSTUArray)
import Data.Array.MArray

type Map2D a = A.UArray (Int,Int) a

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
near (x,y) = [(x+1,y),(x,y+1),(x-1,y),(x,y-1)]

main = do
    [r,c] <- map readInt . B.words <$> B.getLine
    l <- B.lines <$> B.getContents
    let bb = ((0,0),(r-1,c-1))
    let mymap = A.listArray bb $ [ B.index s i | s <- l , i <- [0..c-1]]
    print $ solve r c mymap

solve :: Int -> Int -> Map2D Char -> Int
solve r c mymap = foldl' (+) 0 $ do
    (p,c) <- breeders
    guard $ (>=0) (cost A.! p) && (cost A.! p) <= mycost
    return (digitToInt c)
    where
    start = head $ findPos (=='S') mymap
    exit  = head $ findPos (=='E') mymap
    mycost = cost A.! fst start
    breeders = findPos (\c -> '0' < c && c <= '9') mymap
    cost  = calcDistance (fst exit) mymap

findPos :: (Char -> Bool) -> Map2D Char -> [((Int,Int),Char)]
findPos prop l = [ (p,c) | (p,c) <- A.assocs l, prop c ]

calcDistance :: (Int,Int) -> Map2D Char -> Map2D Int
calcDistance st mymap = runSTUArray $ newArray bb (-1) >>= go
    where
    bb  = A.bounds mymap
    canEnter p = inRange bb p && mymap A.! p /= 'T'
    go cost = loop [st] [] 0
        where
        loop [] [] c = return cost
        loop [] l  c = loop l [] (c+1)
        loop (p:ps) l c = do
            b <- (>=0) <$> readArray cost p
            when (not b) $ writeArray cost p (c)
            let l' = if b then l else (filter canEnter $ near p)++l
            loop ps l' c

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

import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import Data.Array.ST(runSTArray)
import Data.Array.MArray
import Debug.Trace

type Map2D a = A.Array (Int,Int) a

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
near (x,y) = [(x+1,y),(x,y+1),(x-1,y),(x,y-1)]

main = do
    [r,c] <- map readInt . B.words <$> B.getLine
    l <- B.lines <$> B.getContents
    let bb = ((0,0),(r-1,c-1))
    let mymap = A.listArray bb $ [ B.index s i | s <- l , i <- [0..c-1]]
    print $ solve r c mymap

solve r c mymap = foldl' (+) 0 $ do
    (p,c) <- breeders
    guard $ isJust (cost A.! p) && fromJust (cost A.! p) <= mycost
    return (digitToInt c)
    where
    start = head $ findPos (=='S') mymap
    exit  = head $ findPos (=='E') mymap
    mycost = fromJust (cost A.! fst start)
    breeders = findPos (\c -> '0' < c && c <= '9') mymap
    cost  = calcDistance (fst exit) mymap

findPos :: (a -> Bool) -> Map2D a -> [((Int,Int),a)]
findPos prop l = [ (p,c) | (p,c) <- A.assocs l, prop c ]

calcDistance :: (Int,Int) -> Map2D Char -> Map2D (Maybe Int)
calcDistance st mymap = runSTArray $ do
    cost <- newArray bb Nothing
    go cost
    return cost
    where
    bb  = A.bounds mymap
    canEnter p = inRange bb p && mymap A.! p /= 'T'
    go cost = loop [st] [] 0
        where
        loop [] [] c = return ()
        loop [] l  c = loop l [] (c+1)
        loop (p:ps) l c | not (canEnter p) = loop ps l c
                        | otherwise = do
            v <- readArray cost p
            case v of
                Nothing -> do
                    writeArray cost p (Just c)
                    loop ps ((filter canEnter $ near p)++l) c
                Just _ -> loop ps l c

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

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
  [r, c] <- map read . words <$> getLine
  a <- replicateM r getLine

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

    end = head [(x, y) | x <- [1..r], y <- [1..c], a'!(x, y) == 'E']

  let
    ds = runSTUArray $ do
      ds :: STUArray s (Int, Int) Int <- newArray ((1, 1), (r, c)) (-1)
      writeArray ds end 0

      let
        loop q =
          case Seq.viewl q of
            Seq.EmptyL -> return ()
            (p Seq.:< q') -> do
              d <- readArray ds p
              let ps = filter (\(x, y) -> 1 <= x && x <= r && 1 <= y && y <= c && a'!(x, y) /= 'T') [(x+1, y), (x-1, y), (x, y+1), (x, y-1)] where (x, y) = p

              ps' <- filterM (\p -> (== (-1)) <$> readArray ds p) ps
              forM_ ps' $ \p -> writeArray ds p (d+1)

              loop $ foldl (Seq.|>) q' ps'

      loop $ Seq.singleton end
      return ds

  let
    start = head [(x, y) | x <- [1..r], y <- [1..c], a'!(x, y) == 'S']
    d0 = ds!start
    mikes = [p | x <- [1..r], y <- [1..c], let p = (x, y), '1' <= (a'!p), (a'!p) <= '9']

  print $ sum $ map (\p -> fromEnum (a'!p) - fromEnum '0') $ filter (\p -> ds!p <= d0) mikes

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

import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import Data.Array.ST(runSTArray)
import Data.Array.MArray

readInt = B.readInt >>> fmap fst >>> fromMaybe 0

main = do
    [r,c] <- map readInt . B.words <$> B.getLine
    l <- B.lines <$> B.getContents
    print $ solve r c l

solve r c l = foldl' (+) 0 $ do
    (p,c) <- breeders
    guard $ isJust (cost A.! p) && fromJust (cost A.! p) <= mycost
    return (digitToInt c)
    where
    start = head $ findPos (=='S') l
    exit  = head $ findPos (=='E') l
    mycost = fromJust (cost A.! fst start)
    breeders = findPos (\c -> '0' < c && c <= '9') l
    cost  = calcDistance (fst exit) l

calcDistance :: (Int,Int) -> [B.ByteString] -> A.Array (Int,Int) (Maybe Int)
calcDistance st l = runSTArray $ do
    cost <- newArray bb Nothing
    go cost
    return cost
    where
    r   = length l
    c   = B.length (head l)
    bb  = ((0,0),(r-1,c-1))
    mymap = A.listArray bb $ [ B.index s i | s <- l , i <- [0..c-1]]
    canEnter p = inRange bb p && mymap A.! p /= 'T'
    go cost = loop [(st,0)] []
        where
        loop [] [] = return ()
        loop [] l  = loop l []
        loop ((p,c):ps) l | not (canEnter p) = loop ps l
                          | otherwise = do
            v <- readArray cost p
            case v of
                Nothing -> do
                    writeArray cost p (Just c)
                    loop ps (map (\p -> (p,c+1)) (near p)++l)
                Just _ -> loop ps l

near (x,y) = [(x+1,y),(x,y+1),(x-1,y),(x,y-1)]

findPos :: (Char -> Bool) -> [B.ByteString] -> [((Int,Int),Char)]
findPos p l = do
    (s,i) <- zip l [0..]
    j     <- [0..B.length s-1]
    let c = B.index s j
    guard (p c)
    return ((i,j),c)


Every December, VK traditionally holds an event for its employees named "Secret Santa". Here's how it happens.$$$n$$$ employees numbered from $$$1$$$ to $$$n$$$ take part in the event. Each employee $$$i$$$ is assigned a different employee $$$b_i$$$, to which employee $$$i$$$ has to make a new year gift. Each employee is assigned to exactly one other employee, and nobody is assigned to themselves (but two employees may be assigned to each other). Formally, all $$$b_i$$$ must be distinct integers between $$$1$$$ and $$$n$$$, and for any $$$i$$$, $$$b_i \ne i$$$ must hold.The assignment is usually generated randomly. This year, as an experiment, all event participants have been asked who they wish to make a gift to. Each employee $$$i$$$ has said that they wish to make a gift to employee $$$a_i$$$.Find a valid assignment $$$b$$$ that maximizes the number of fulfilled wishes of the employees.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^5$$$). Description of the test cases follows. Each test case consists of two lines. The first line contains a single integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the number of participants of the event. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$; $$$a_i \ne i$$$) — wishes of the employees in order from $$$1$$$ to $$$n$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print two lines. In the first line, print a single integer $$$k$$$ ($$$0 \le k \le n$$$) — the number of fulfilled wishes in your assignment. In the second line, print $$$n$$$ distinct integers $$$b_1, b_2, \ldots, b_n$$$ ($$$1 \le b_i \le n$$$; $$$b_i \ne i$$$) — the numbers of employees assigned to employees $$$1, 2, \ldots, n$$$. $$$k$$$ must be equal to the number of values of $$$i$$$ such that $$$a_i = b_i$$$, and must be as large as possible. If there are multiple answers, print any.

NoteIn the first test case, two valid assignments exist: $$$[3, 1, 2]$$$ and $$$[2, 3, 1]$$$. The former assignment fulfills two wishes, while the latter assignment fulfills only one. Therefore, $$$k = 2$$$, and the only correct answer is $$$[3, 1, 2]$$$.

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

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

import Data.Array.Unboxed

type UA = UArray Int Int

soln :: [Int] -> [Int] -> [(Int, Int)]
soln [] [] = []
soln [x1, x2] [y1, y2] = if  x1 == y1 || x2 == y2
  then  [(x1, y2), (x2, y1)]
  else  [(x1, y1), (x2, y2)]
soln (x : xs) (y1 : y2 : ys) = if  x == y1
  then  (x, y2) : soln xs (y1 : ys)
  else  (x, y1) : soln xs (y2 : ys)
soln _ _ = error "yikes"

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    aLi <- readInts
    let
      a :: UA
      a = listArray (1, n) aLi
      ins :: UA
      ins = accumArray (+) 0 (1, n) $ zip (elems a) (repeat 1)

      rev :: UA
      rev = accumArray (\_ v -> v) 0 (1, n) $ zip (elems a) [1..]

      loners = [i | (i, 0) <- assocs ins]
      score = n - length loners
      free = [i | (i, ai) <- assocs a, rev ! ai /= i]

      ans :: UA
      ans = a // if  score == n - 1
        then  let
          from = [i | (i, ai) <- assocs a, ins ! ai /= 1]
          to   = [i | (i, ii) <- assocs ins, ii /= 1]
          in  soln from to
        else  soln free loners
    putInts [score]

    putInts $ elems ans

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


You are given two integers $$$b$$$ and $$$w$$$. You have a chessboard of size $$$10^9 \times 10^9$$$ with the top left cell at $$$(1; 1)$$$, the cell $$$(1; 1)$$$ is painted white.Your task is to find a connected component on this chessboard that contains exactly $$$b$$$ black cells and exactly $$$w$$$ white cells. Two cells are called connected if they share a side (i.e. for the cell $$$(x, y)$$$ there are at most four connected cells: $$$(x - 1, y), (x + 1, y), (x, y - 1), (x, y + 1)$$$). A set of cells is called a connected component if for every pair of cells $$$C_1$$$ and $$$C_2$$$ from this set, there exists a sequence of cells $$$c_1$$$, $$$c_2$$$, ..., $$$c_k$$$ such that $$$c_1 = C_1$$$, $$$c_k = C_2$$$, all $$$c_i$$$ from $$$1$$$ to $$$k$$$ are belong to this set of cells and for every $$$i \in [1, k - 1]$$$, cells $$$c_i$$$ and $$$c_{i + 1}$$$ are connected.Obviously, it can be impossible to find such component. In this case print "NO". Otherwise, print "YES" and any suitable connected component.You have to answer $$$q$$$ independent queries.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 10^5$$$) — the number of queries. Then $$$q$$$ queries follow. The only line of the query contains two integers $$$b$$$ and $$$w$$$ ($$$1 \le b, w \le 10^5$$$) — the number of black cells required and the number of white cells required. It is guaranteed that the sum of numbers of cells does not exceed $$$2 \cdot 10^5$$$ ($$$\sum w + \sum b \le 2 \cdot 10^5$$$).

For each query, print the answer to it. If it is impossible to find the required component, print "NO" on the first line. Otherwise, print "YES" on the first line. In the next $$$b + w$$$ lines print coordinates of cells of your component in any order. There should be exactly $$$b$$$ black cells and $$$w$$$ white cells in your answer. The printed component should be connected. If there are several answers, you can print any. All coordinates in the answer should be in the range $$$[1; 10^9]$$$.

import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    [b,w] <- map read . words <$> getLine
    if b > w then solve b w 0 else solve w b 1
solve b w o | b > 3*w+1 = putStrLn "NO"
            | otherwise = do
  putStrLn "YES"
  mapM_ pick $ take (w+b) $
    [ (2+o,2+2*j) | j <- [0..w-1] ] ++
    [ (2+o,1+2*j) | j <- [1..w-1] ] ++
    [ (1+o,2+2*j) | j <- [0..w-1] ] ++
    [ (3+o,2+2*j) | j <- [0..w-1] ] ++
    [ (2+o,1), (2+o,2*w+1) ]
pick (i,j) = putStrLn $ show i ++ " " ++ show j

import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    [b,w] <- map read . words <$> getLine
    if b > w then solve b w 1 else solve w b 0
solve b w o | b > 3*w+1 = putStrLn "NO"
            | otherwise = do
  putStrLn "YES"
  mapM_ pick $ take (b+w) $
    [ (2+o,1+j) | j <- [1..2*w+1] ] ++
    [ (1+o,2+2*j) | j <- [0..w-1] ] ++
    [ (3+o,2+2*j) | j <- [0..w-1] ] ++
    [ (2+o,1), (2+o,2*w+3) ]
pick (i,j) = putStrLn $ show i ++ " " ++ show j

import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    [b,w] <- map read . words <$> getLine
    if b > w then solve b w 0 else solve w b 1
solve b w o | b > 3*w+1 = putStrLn "NO"
            | otherwise = do
  putStrLn "YES"
  mapM_ pick $ take (b+w) $
    [ (2+o,1+j) | j <- [1..2*w+1] ] ++
    [ (1+o,2+2*j) | j <- [0..w-1] ] ++
    [ (3+o,2+2*j) | j <- [0..w-1] ] ++
    [ (2+o,1), (2+o,2*w+3) ]
pick (i,j) = putStrLn $ show i ++ " " ++ show j


You are given a square matrix consisting of n rows and n columns. We assume that the rows are numbered from 1 to n from top to bottom and the columns are numbered from 1 to n from left to right. Some cells (n - 1 cells in total) of the the matrix are filled with ones, the remaining cells are filled with zeros. We can apply the following operations to the matrix:  Swap i-th and j-th rows of the matrix;  Swap i-th and j-th columns of the matrix. You are asked to transform the matrix into a special form using these operations. In that special form all the ones must be in the cells that lie below the main diagonal. Cell of the matrix, which is located on the intersection of the i-th row and of the j-th column, lies below the main diagonal if i > j.

The first line contains an integer n (2 ≤ n ≤ 1000) — the number of rows and columns. Then follow n - 1 lines that contain one's positions, one per line. Each position is described by two integers xk, yk (1 ≤ xk, yk ≤ n), separated by a space. A pair (xk, yk) means that the cell, which is located on the intersection of the xk-th row and of the yk-th column, contains one. It is guaranteed that all positions are distinct.

Print the description of your actions. These actions should transform the matrix to the described special form. In the first line you should print a non-negative integer m (m ≤ 105) — the number of actions. In each of the next m lines print three space-separated integers t, i, j (1 ≤ t ≤ 2, 1 ≤ i, j ≤ n, i ≠ j), where t = 1 if you want to swap rows, t = 2 if you want to swap columns, and i and j denote the numbers of rows or columns respectively. Please note, that you do not need to minimize the number of operations, but their number should not exceed 105. If there are several solutions, you may print any of them.

import Control.Monad
import Control.Applicative
import Data.Function
import Data.List
import Data.Ord
import qualified Data.IntMap as M

groupBy' :: ((Int, Int) -> Int) -> [(Int, Int)] -> [[(Int, Int)]]
groupBy' f = groupBy ((==) `on` f) . sortBy (comparing f)

gao :: Int -> [(Int, Int)] -> [[Int]]
gao n p = go p m m
  where
    m = M.fromList [(i, i) | i <- [1 .. n]]
    go [] _ _ = []
    go ((a,b):c) pos idx
      | a' == b   = go c pos idx
      | otherwise = [a', b]: go c pos' idx'
      where
        a' = pos M.! a
        b' = idx M.! b
        pos' = M.insert a b $ M.insert b' a' $ pos
        idx' = M.insert b a $ M.insert a' b' $ idx

main :: IO ()
main = do
  n <- fmap read getLine
  p <- replicateM (n - 1) $ do
    [x, y] <- fmap (map read . words) getLine
    return (x, y)
  let zip' a b = (flip zip) (reverse a) (reverse b)
      groupr = map (liftA2 (,) (fst . head) length) $ groupBy' fst p
      mapr   = zip' [2 .. n] $ map fst $ sortBy (comparing snd) groupr
      swapr  = gao n mapr

      mapr'  = M.fromList mapr
      top    = minimum . map ((mapr' M.!) . fst)
      groupc = map (liftA2 (,) (snd . head) top) $ groupBy' snd p
      mapc   = (flip zip) [1 .. n - 1] $ map fst $ sortBy (comparing snd) groupc
      swapc  = gao n mapc

      ans    = map (1:) swapr ++ map (2:) swapc
  print $ length ans
  putStr $ unlines $ map (unwords . map show) ans

import Control.Monad
import Control.Applicative
import Data.List
import Data.Ord
import qualified Data.IntMap as M

gao :: [Int] -> [Int] -> [[Int]]
gao p x = go (zip q p) (M.fromList $ zip p p) (M.fromList $ zip p p)
  where
    g = map (liftA2 (,) head length) $ group $ sort $ p ++ x
    q = map fst $ sortBy (comparing snd) g
    go [] _ _ = []
    go ((a,b):c) pos idx
      | a' == b   = go c pos idx
      | otherwise = [a', b]: go c pos' idx'
      where
        a' = pos M.! a
        b' = idx M.! b
        pos' = M.insert a b $ M.insert b' a' $ pos
        idx' = M.insert b a $ M.insert a' b' $ idx

main :: IO ()
main = do
  n <- fmap read getLine
  (x, y) <- fmap unzip $ replicateM (n - 1) $ do
    [x, y] <- fmap (map read . words) getLine
    return (x, y)
  let ans = map (1:) (gao [1 .. n] x) ++ map (2:) (gao [n, n - 1 .. 1] y)
  print $ length ans
  putStr $ unlines $ map (unwords . map show) ans

import Control.Monad
import Control.Applicative
import Data.Function
import Data.List
import Data.Ord
import qualified Data.IntMap as M

gao :: Int -> [(Int, Int)] -> [[Int]]
gao n p = go p m m
  where
    m = M.fromList [(i, i) | i <- [1 .. n]]
    go [] _ _ = []
    go ((a,b):c) pos idx
      | a' == b   = go c pos idx
      | otherwise = [a', b]: go c pos' idx'
      where
        a' = pos M.! a
        b' = idx M.! b
        pos' = M.insert a b $ M.insert b' a' $ pos
        idx' = M.insert b a $ M.insert a' b' $ idx

main :: IO ()
main = do
  n <- fmap read getLine
  p <- replicateM (n - 1) $ do
    [x, y] <- fmap (map read . words) getLine
    return (x, y)
  let groupr = map (liftA2 (,) (fst . head) length) $ groupBy ((==) `on` fst) p
      mapr   = (flip zip) [2 .. n] $ map fst $ sortBy (comparing snd) groupr
      swapr  = gao n mapr

      mapr'  = M.fromList mapr
      top    = minimum . map ((mapr' M.!) . fst)

      groupc = map (liftA2 (,) (snd . head) top) $ groupBy ((==) `on` snd) p
      mapc   = (flip zip) [1 .. n - 1] $ map fst $ sortBy (comparing snd) groupc
      swapc  = gao n mapc

      ans    = map (1:) swapr ++ map (2:) swapc
  print $ length ans
  putStr $ unlines $ map (unwords . map show) ans

import Control.Monad
import Control.Applicative
import Data.Function
import Data.List
import Data.Ord
import qualified Data.IntMap as M

groupBy' :: ((Int, Int) -> Int) -> [(Int, Int)] -> [[(Int, Int)]]
groupBy' f = groupBy ((==) `on` f) . sortBy (comparing f)

gao :: Int -> [(Int, Int)] -> [[Int]]
gao n p = go p m m
  where
    m = M.fromList [(i, i) | i <- [1 .. n]]
    go [] _ _ = []
    go ((a,b):c) pos idx
      | a' == b   = go c pos idx
      | otherwise = [a', b]: go c pos' idx'
      where
        a' = pos M.! a
        b' = idx M.! b
        pos' = M.insert a b $ M.insert b' a' $ pos
        idx' = M.insert b a $ M.insert a' b' $ idx

main :: IO ()
main = do
  n <- fmap read getLine
  p <- replicateM (n - 1) $ do
    [x, y] <- fmap (map read . words) getLine
    return (x, y)
  let groupr = map (liftA2 (,) (fst . head) length) $ groupBy' fst p
      mapr   = (flip zip) [2 .. n] $ map fst $ sortBy (comparing snd) groupr
      swapr  = gao n mapr

      mapr'  = M.fromList mapr
      top    = minimum . map ((mapr' M.!) . fst)

      groupc = map (liftA2 (,) (snd . head) top) $ groupBy' snd p
      mapc   = (flip zip) [1 .. n - 1] $ map fst $ sortBy (comparing snd) groupc
      swapc  = gao n mapc

      ans    = map (1:) swapr ++ map (2:) swapc
  print $ length ans
  putStr $ unlines $ map (unwords . map show) ans

import Control.Monad
import Control.Applicative
import Data.Function
import Data.List
import Data.Ord
import qualified Data.IntMap as M

groupBy' :: ((Int, Int) -> Int) -> [(Int, Int)] -> [[(Int, Int)]]
groupBy' f = groupBy ((==) `on` f) . sortBy (comparing f)

gao :: Int -> [(Int, Int)] -> [[Int]]
gao n p = go p m m
  where
    m = M.fromList [(i, i) | i <- [1 .. n]]
    go [] _ _ = []
    go ((a,b):c) pos idx
      | a' == b   = go c pos idx
      | otherwise = [a', b]: go c pos' idx'
      where
        a' = pos M.! a
        b' = idx M.! b
        pos' = M.insert a b $ M.insert b' a' $ pos
        idx' = M.insert b a $ M.insert a' b' $ idx

main :: IO ()
main = do
  n <- fmap read getLine
  p <- replicateM (n - 1) $ do
    [x, y] <- fmap (map read . words) getLine
    return (x, y)
  let zip' a b = (flip zip) (reverse a) (reverse b)

      groupr = map (liftA2 (,) (fst . head) length) $ groupBy' fst p
      mapr   = zip' [2 .. n] $ map fst $ sortBy (comparing snd) groupr
      swapr  = gao n mapr

      mapr'  = M.fromList mapr
      top    = minimum . map ((mapr' M.!) . fst)

      groupc = map (liftA2 (,) (snd . head) top) $ groupBy' snd p
      mapc   = zip' [1 .. n - 1] $ map fst $ sortBy (comparing snd) groupc
      swapc  = gao n mapc

      ans    = map (1:) swapr ++ map (2:) swapc
  print $ length ans
  putStr $ unlines $ map (unwords . map show) ans


A new e-mail service "Berlandesk" is going to be opened in Berland in the near future. The site administration wants to launch their project as soon as possible, that's why they ask you to help. You're suggested to implement the prototype of site registration system. The system should work on the following principle. Each time a new user wants to register, he sends to the system a request with his name. If such a name does not exist in the system database, it is inserted into the database, and the user gets the response OK, confirming the successful registration. If the name already exists in the system database, the system makes up a new user name, sends it to the user as a prompt and also inserts the prompt into the database. The new name is formed by the following rule. Numbers, starting with 1, are appended one after another to name (name1, name2, ...), among these numbers the least i is found so that namei does not yet exist in the database.

The first line contains number n (1 ≤ n ≤ 105). The following n lines contain the requests to the system. Each request is a non-empty line, and consists of not more than 32 characters, which are all lowercase Latin letters.

Print n lines, which are system responses to the requests: OK in case of successful registration, or a prompt with a new name, if the requested name is already taken.

import Data.List
import Data.Map (Map)
import qualified Data.Map as Map

handle :: Map String Int -> String -> (Map String Int, String)
handle ac ar = (Map.insertWith (+) ar 1 ac, maybe "OK" (\x -> ar ++ (show x)) $ Map.lookup ar ac)

run :: String -> String
run xs = unlines $ snd $ mapAccumL (handle) Map.empty (tail $ lines xs)

main = interact run

import Data.List
import qualified Data.Map as M

solve acc x = (M.insertWith (+) x 1 acc, oStr)
  where oStr = if x `M.member` acc then x ++ show (acc M.! x) else "OK"

main = interact $ unlines . snd . mapAccumL solve M.empty . tail . words

import Data.List
import qualified Data.Map as M

solve acc x = (M.insertWith (+) x 1 acc, maybe "OK" ((x ++) . show) $ M.lookup x acc)

main = interact $ unlines . snd . mapAccumL solve M.empty . tail . words

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

repeatM a = mapM (const a) (repeat 1)
repeatMn a n = mapM (const a) [1..n]
readm::(Read a) => State String a
readm = State (head . reads)
readchar = State (\s->(head s,tail s))
readall = State (,"")

runRead x s = fst $ runState x s

solve::Map String Int -> [String] -> [String]
solve _ [] = []
solve m (s:ss) = s1 : solve m1 ss where
	(s1,m1) = case (Data.Map.lookup s m) of
		Nothing -> ("OK",insert s 1 m)
		Just x -> (s++show x,insert s (x+1) m)
main = reader >>= writer . solver
reader = getContents
writer = putStr
solver = runRead $ do
	n <- readm
	l <- liftM lines readall
	return (unlines . solve empty . take n  . tail $ l)

module Main where

import Control.Monad
import Data.Char
import qualified Data.HashTable as Hash

main = do
    idHash <- Hash.new (==) Hash.hashString :: IO (Hash.HashTable [Char] Int)

    n <- read `liftM` getLine
    replicateM_ n $ do
        id <- getLine
        maybeCount <- Hash.lookup idHash id
        case maybeCount of
            Just n -> do
                Hash.update idHash id (n+1)
                putStrLn $ id ++ show n
            _ -> do
                Hash.insert idHash id 1
                putStrLn "OK"

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

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

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

main = do
  n <- readLn
  ss <- replicateM n (B.init <$> B.getLine)

  let
    rs = process HashMap.empty ss
      where
        process _ [] = []
        process m (s:ss) =
          case s `HashMap.lookup` m of
            Nothing -> (B.pack "OK"):(process (HashMap.insert s 1 m) ss)
            Just k -> (B.append s (B.pack $ show k)):(process (HashMap.adjust (+1) s m) ss)

  B.putStr $ B.unlines rs

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

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

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

main = do
  n <- readLn
  ss <- replicateM n (B.init <$> B.getLine)

  let
    rs = snd $ mapAccumL f HashMap.empty ss
      where
        f m s =
          case s `HashMap.lookup` m of
            Nothing -> (HashMap.insert s 1 m, B.pack "OK")
            Just k -> (HashMap.adjust (+1) s m, B.append s (B.pack $ show k))

  B.putStr $ B.unlines rs

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

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

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

main = do
  n <- readLn
  ss <- replicateM n getLine

  let
    rs = process HashMap.empty ss
      where
        process _ [] = []
        process !m (s:ss) =
          case s `HashMap.lookup` m of
            Nothing -> "OK":(process (HashMap.insert s 1 m) ss)
            Just k -> (s ++ show k):(process (HashMap.adjust (+1) s m) ss)

  putStr $ unlines rs

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

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

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

main = do
  n <- readLn
  ss <- replicateM n (B.init <$> B.getLine)

  let
    rs = process Map.empty ss
      where
        process _ [] = []
        process m (s:ss) =
          case s `Map.lookup` m of
            Nothing -> (B.pack "OK"):(process (Map.insert s 1 m) ss)
            Just k -> (B.append s (B.pack $ show k)):(process (Map.adjust (+1) s m) ss)

  B.putStr $ B.unlines rs

import qualified Data.Map.Strict as M
import Control.Monad (replicateM,foldM_)

(-->) = flip fmap

main = do
  n <- getLine --> read :: IO Int
  let doit m _ = do name <- getLine
                    case M.lookup name m of
                     Nothing -> do putStrLn "OK"
                                   return $ M.insert name 1 m
                     Just n  -> do putStrLn $ name ++ show n
                                   return $ M.insert name (n+1) m
  foldM_ doit (M.empty :: M.Map String Int) [1..n]

import qualified Data.Map.Strict as M
import Control.Monad (replicateM,foldM_)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char

(-->) = flip fmap

main = do
  n <- getLine --> read :: IO Int
  let doit m _ = do name' <- BS.getLine
                    let name = BS.takeWhile (not . isSpace) name'
                    case M.lookup name m of
                     Nothing -> do putStrLn "OK"
                                   return $ M.insert name 1 m
                     Just n  -> do BS.putStrLn $ name `BS.append` (BS.pack $ show n)
                                   return $ M.insert name (n+1) m
  foldM_ doit (M.empty :: M.Map ByteString Int) [1..n]

module Main (main) where

import qualified Data.HashTable as H

main = do
	map <- H.new (==) H.hashString
	instr <- getLine
	let n = read instr :: Int
	inloop n map

inloop 0 _ = do return ()
inloop n map = do
	key <- getLine
	v <- H.lookup map key
	let x = maybe 0 id v
	if x == 0 then do putStrLn "OK" else do putStrLn (key ++ show x)
	H.insert map key (x + 1)
	inloop (n - 1) map

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as M
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  readLn >>= \n ->  (mapM_ putStrLn).solve =<< (forM [1..n] $ \i ->  getLine>>= \j -> return (j))
--solve :: [String]-> [String]
solve (x:xs) = slv1 (x:xs) M.empty
slv1 [] ys =[]
slv1 (x:xs) ms =  let (z1, z2) = M.insertLookupWithKey (\ k n o -> 1+o) x 0 ms in if z1==Nothing then "OK":slv1 xs z2 else (x++show (z2 M.! x)):slv1 xs z2

import Data.Map (Map, empty, insert, findWithDefault)

solve :: [String] -> [String]
solve  =  tail . map fst . scanl f ("", empty)
  where
    f :: (String, Map String Int) -> String -> (String, Map String Int)
    f (_, map) name  =  (name', map')
      where
        n  =  findWithDefault 0 name map
        name'  =  if n == 0 then "OK" else name ++ (show n)
        map'  =  insert name (n+1) map

main :: IO ()
main  =  do
    n  <-  readLn
    names  <-  mapM (const getLine) [1..n]
    mapM_ putStrLn $ solve names

-- Codeforces 4C

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

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    solve Map.empty n

-- Note:
--  1. don't store the result, input a line, then compute, then print result.
--  2. use Map.insertWith to combine the old value and new value.

solve :: Map.Map String Int -> Int -> IO ()
solve _ 0 = return ()
solve db n = do
    req <- getLine
    putStrLn $ case Map.lookup req db of
        Just c -> req ++ show c
        Nothing -> "OK"
    solve (Map.insertWith (+) req 1 db) (n-1)

import qualified Data.Map as M
import Data.Map (Map)
import Data.Maybe

updateMap :: Map String Int -> String -> Map String Int
updateMap dataset str  = M.insertWith (+) str 1 dataset

loop :: Int -> Map String Int -> IO (Map String Int)
loop 0 dataset = return dataset
loop n dataset = do
    str <- getLine
    let a = M.lookup str dataset
    if isNothing a then
            putStrLn "OK"
        else
            putStrLn (str ++ show (fromJust a))
    let newSet = updateMap dataset str
    loop (n - 1) newSet

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    dataset <- loop n M.empty
    return ()

import qualified Data.Map as M
import Data.Map (Map)
import Data.Maybe

updateMap :: Map String Int -> String -> Map String Int
updateMap dataset str = M.insertWith (+) str 1 dataset
    where
        updater 0 _ = 1
        updater value _ = value + 1

loop :: Int -> Map String Int -> IO (Map String Int)
loop 0 dataset = return dataset
loop n dataset = do
    str <- getLine
    let a = M.lookup str dataset
    if isNothing a then
            putStrLn "OK"
        else

            putStrLn (str ++ show (fromJust a))
    let newSet = updateMap dataset str
    --print $ output
    loop (n - 1) newSet

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    dataset <- loop n M.empty
    return ()

import qualified Data.Map as M
import Data.Map (Map)
import Data.Maybe

updateMap :: Map String Int -> String -> Map String Int
updateMap dataset str = M.insertWith updater str 1 dataset
    where
        updater _ 0 = 1
        updater _ value = value + 1

loop :: Int -> Map String Int -> IO (Map String Int)
loop 0 dataset = return dataset
loop n dataset = do
    str <- getLine
    let a = M.lookup str dataset
    if isNothing a then
            putStrLn "OK"
        else
            putStrLn (str ++ show (fromJust a))
    let newSet = updateMap dataset str
    loop (n - 1) newSet

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    dataset <- loop n M.empty
    return ()

import Control.Applicative
import qualified Data.Map as M
import Data.Maybe

process::[String]->M.Map String Int->IO ()
process [] _ = putStrLn ""
process (q:qs) d | M.lookup q d== Nothing = do
                                                  putStrLn "OK"
                                                  process qs (M.insert q 1 d)
                     | otherwise = do
                                      let x = fromJust $ M.lookup q d
                                      putStrLn $ q++ (show x)
                                      process qs (M.insert q (x+1) d)

main=do
      getLine
      q<- lines<$>  getContents
      process  q  M.empty

import qualified Data.Map as M
import Data.List
main=getContents>>=mapM_ putStrLn.snd.mapAccumL(\m x->(M.insertWith(+)x(1::Integer)m,maybe"OK"((x++).show)(M.lookup x m)))M.empty.tail.lines

import qualified Data.Map as M
import Data.List
main=interact$unlines.snd.mapAccumL(\m x->(M.insertWith(+)x(1::Integer)m,maybe"OK"((x++).show)(M.lookup x m)))M.empty.tail.lines

import qualified Data.Map as M
import Data.List (mapAccumL)

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

solve :: [String] -> [String]
solve = snd . mapAccumL f M.empty
  where f m x = (M.insertWith (+) x (1 :: Integer) m, maybe "OK" ((x++) . show) (M.lookup x m))

import qualified Data.Map as M
import Control.Monad
main = do
  n <- readLn
  loop n M.empty
loop 0 _ = return ()
loop n m = do
  name <- getLine
  putStrLn $ case M.lookup name m of
               Just c -> name ++ show c
               Nothing -> "OK"
  loop (n-1) (M.insertWith (+) name 1 m)

import qualified Data.Map as M
import Control.Monad

type Names = M.Map String Int

solve :: Names -> a -> IO Names
solve m _ = do
    name <- getLine
    case lookup' name m of
        0 -> do
            putStrLn "OK"
            return $ M.insert name 1 m
        n -> do
            putStrLn $ name ++ show n
            return $ M.insert name (n + 1) m

lookup' :: String -> Names -> Int
lookup' k m = case M.lookup k m of
    Just v -> v
    Nothing -> 0

main :: IO ()
main = do
    n <- fmap read getLine
    foldM_ solve M.empty [1..n]

-- Vicfred
-- https://codeforces.com/problemset/problem/4/C

import Data.List
import qualified Data.Map as M

solve :: (Num a, Show a) => M.Map [Char] a -> [Char] -> (M.Map [Char] a, [Char])
solve acc x = (M.insertWith (+) x 1 acc, maybe "OK" ((x ++) . show) $ M.lookup x acc)

main :: IO ()
main = interact $ unlines . snd . mapAccumL solve M.empty . tail . words

import Data.List
import qualified Data.ByteString.Char8 as B
import Data.Map.Strict as M
import Control.Monad

f m s = case s `M.lookup` m of
          Just a -> (M.adjust (+1) s m, B.append s (B.pack $ show a))
          Nothing -> (M.insert s 1 m, B.pack "OK")
main = do
  n <- readLn
  rest <- replicateM n (B.init <$> B.getLine)
  let rs = snd $ mapAccumL f M.empty rest
  B.putStr $ B.unlines rs

import Data.List
import qualified Data.ByteString.Char8 as B
import Data.Map.Strict as M
import Control.Monad

f m s = case s `M.lookup` m of
          Just a -> (M.adjust (+1) s m, B.append s (B.pack $ show a))
          Nothing -> (M.insert s 1 m, B.pack "OK")
main = do
  n <- readLn
  rest <- replicateM n (head <$> B.words <$> B.getLine)
  let rs = snd $ mapAccumL f M.empty rest
  B.putStr $ B.unlines rs

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

main = readLn >>= foldM_ output Map.empty . enumFromTo 1
 where
  output mp _ = do
    s <- getLine
    putStrLn $ maybe "OK" ((s ++) . show) $ Map.lookup s mp
    return $ Map.insertWith' (fmap (+ 1) . const id) s 1 mp

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

data TrieLike a = Empty | Node {count :: Maybe Int, branches :: [(a, TrieLike a)]} deriving Show

modify' :: Ord a => a -> (TrieLike a -> TrieLike a) -> [(a, TrieLike a)] -> [(a, TrieLike a)]
modify' k f nodes = parse nodes
 where
  parse [] = [(k, f Empty)]
  parse xs@(x'@(k', t') : xs') =
    case compare k k' of
      LT -> (k , f Empty) : xs
      EQ -> (k', f t')    : xs'
      GT -> x'            : parse xs'

inc' :: TrieLike a -> TrieLike a
inc' Empty = Empty
inc' node  = node {count = Just . maybe 1 succ $ count node}

insert' :: Ord a => [a] -> TrieLike a -> TrieLike a
insert' xs       Empty = insert' xs $ Node Nothing []
insert' []       node  = inc' node
insert' (x : xs) node  = node {branches = modify' x (insert' xs) $ branches node}

lookup' :: Ord a => [a] -> TrieLike a -> Maybe (TrieLike a)
lookup' _  Empty       = Nothing
lookup' [] node        = Just node
lookup' (x : xs) node  = lookup x (branches node) >>= lookup' xs

next' :: Ord a => [a] -> TrieLike a -> Maybe Int
next' = fmap (join . fmap count) . lookup'

main = readLn >>= foldM_ output Empty . enumFromTo 1
 where
  output t _ = do
    s <- getLine
    putStrLn $ maybe "OK" ((s ++) . show) $ next' s t
    return $ insert' s t

import Data.HashTable as H
main = do
    hTable <- new (==) hashString
    n <- read `fmap` getLine
    mapM_ (\_ ->  do
        name <- getLine
        val <- H.lookup hTable name
        case val of
            Just count -> do
                putStr (name ++ show count ++ "\n")
                update hTable name (count + 1)
                return ()
            Nothing -> do
                putStr "OK\n"
                insert hTable name 1
        ) [1..n]
-- vim: set et sts=4:

import Control.Monad
import qualified Data.Map as M

main = do
     getLine
     foldM_ (\mapping name -> do
            let res = M.lookup name mapping
            if res == Nothing
               then putStrLn "OK" >> return (M.insert name 0 mapping)
               else let Just res' = res
                    in putStrLn (name++show (res'+1)) >> return (M.insert name (res'+1) mapping)
            ) M.empty =<< return . lines =<< getContents

module Main where

import Data.List (mapAccumL)
import qualified Data.Map.Strict as M

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

solve :: [String] -> [String]
solve names = snd $ mapAccumL processName M.empty names

processName :: M.Map String Int -> String -> (M.Map String Int, String)
processName occ name = (M.insertWith (+) name 1 occ, maybe "OK" ((name ++) . show) (M.lookup name occ))

module Main where

import Data.List (mapAccumL)
import qualified Data.Map.Strict as M

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

solve :: [String] -> [String]
solve names = snd $ mapAccumL processName M.empty names

processName :: M.Map String Int -> String -> (M.Map String Int, String)
processName occ name = case M.lookup name occ of
  Nothing     -> (M.insert name 1 occ, "OK")
  Just count  -> (M.insert name (count + 1) occ, name ++ show count)

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Map
import Data.HashTable
import Debug.Trace
import Data.List
import Data.Array
import Data.Char
import Data.Int
class Scan a where scan' :: String -> a
instance Scan Int where scan' = read
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' = read
instance Scan Double where scan' = read
instance Scan Integer where scan' = read
instance Scan String where scan' x = x
scan :: (Scan a) => IO a
scan = getLine>>=(return.scan')
scans :: (Scan a) => Int -> IO [a]
scans n = if n==0 then return [] else scan>>=(\x->scans (n-1)>>=return.(x:))

solve [] _ l = reverse l
solve (x:xs) mp l = let mp' = insertWith (+) x 1 mp in
                    case Data.Map.lookup x mp of
                      Nothing -> (solve$!) xs mp' ("OK":l)
                      Just n -> (solve$!) xs mp' ((x++(show n)):l)

main = do n <- scan :: IO Int
          l <- scans n :: IO [String]
          hash <- new (==) hashString
          sequence_ [do val <- Data.HashTable.lookup hash x;case val of {Nothing -> Data.HashTable.insert hash x 1>>putStrLn "OK";Just n -> Data.HashTable.update hash x (n+1)>>putStrLn (x++(show n))}|x<-l]

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Data.HashTable
class Scan a where scan' :: String -> a
instance Scan Int where scan' = read
instance Scan String where scan' x = x
scan :: (Scan a) => IO a
scan = getLine>>=(return.scan')
scans :: (Scan a) => Int -> IO [a]
scans n = if n==0 then return [] else scan>>=(\x->scans (n-1)>>=return.(x:))

main = do n <- scan :: IO Int
          l <- scans n :: IO [String]
          hash <- new (==) hashString
          sequence_ [do val <- Data.HashTable.lookup hash x;case val of {Nothing -> Data.HashTable.insert hash x 1>>putStrLn "OK";Just n -> Data.HashTable.update hash x (n+1)>>putStrLn (x++(show n))}|x<-l]

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

process [] _   = return ()
process (a:as) m   | M.findWithDefault (-10) a m ==(-10) = do
								putStrLn "OK"
								process as (M.insert a 0 m )
		   | otherwise = do
					let m1 = (M.insertWith (+) a 1 m)
					putStrLn (a++show (M.findWithDefault (-10) a m1 ))
					process as  m1

main=do
	getLine
	a<-lines <$> getContents ::IO [String]
        process a M.empty

import qualified Data.Map as Map
import Control.Monad

insertFun::a->b->Int->Int
insertFun _ _ old_value = old_value + 1

forDisplay::String->Maybe Int->String
forDisplay request res = case res of
			      Just n -> request ++ show n
			      Nothing -> "OK"

work database request = do
  let tmp = fst res
  putStrLn (forDisplay request tmp)
  return (snd res)
  where res = Map.insertLookupWithKey insertFun request 1 database

process database _ = do
  request <- getLine
  ret <- work database request
  return ret

main = do
  n <- getLine
  foldM_ process Map.empty [1..read n::Int]

import Data.List (mapAccumL)
import Data.Maybe
import qualified Data.Map.Lazy as M

data Trie a = Trie { value :: Int
                   , getTrie :: M.Map a (Trie a)
                   } deriving (Eq)

empty :: Trie a
empty = Trie (-1) M.empty

insert :: Ord a => [a] -> Trie a -> Trie a
insert [] (Trie e m)     = Trie (e+1) m
insert (x:xs) (Trie e m) = Trie e (M.alter (Just . insert xs . fromMaybe empty) x m)

find :: Ord a => [a] -> Trie a -> Int
find [] (Trie e _)     = e
find (x:xs) (Trie _ m) = fromMaybe (-1) (find xs <$> M.lookup x m)

--process :: [String] -> [String]
process xs = zipWith g xs $ snd $ mapAccumL f empty xs
    where
        f s l = (s', i)
            where
                s' = insert l s
                i = find l s'
        g x i = if i == 0
                    then "OK"
                    else x ++ show i

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    xs <- fmap lines getContents
    putStrLn.unlines $ process xs

import Data.List
import qualified Data.Map as M

parse = tail . lines
present = unlines
solve = snd . mapAccumL insertName M.empty

insertName :: (M.Map String Int) -> String -> (M.Map String Int, String)
insertName olds new =
  let
    name = case M.findWithDefault 0 new olds of
      0 -> "OK"
      x -> new ++ (show x)
  in
  (M.insertWith (+) new 1 olds, name)

main = interact $ present . solve . parse

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.List
import qualified Data.Map as M

parse = tail . lines
present = unlines
solve !l = snd $ mapAccumL insertName M.empty l

insertName :: (M.Map String Int) -> String -> (M.Map String Int, String)
insertName olds new =
  let
    name = case M.findWithDefault 0 new olds of
      0 -> "OK"
      x -> new ++ (show x)
  in
  (M.insertWith (+) new 1 olds, name)

main = interact $ present . solve . parse

{-# OPTIONS_GHC -rtsopts -O2 #-}
import Data.List
import qualified Data.Map as M

parse = tail . lines
present = unlines
solve l = snd $ mapAccumL insertName M.empty l

insertName :: (M.Map String Int) -> String -> (M.Map String Int, String)
insertName olds new =
  let
    name = case M.findWithDefault 0 new olds of
      0 -> "OK"
      x -> new ++ (show x)
  in
  (M.insertWith (+) new 1 olds, name)

main = interact $ present . solve . parse

import qualified Data.Map as M
main = interact $ unlines.f.tail.words

f x = g (M.empty) x

g :: (M.Map String Int) -> [String] -> [String]
g a [] = []
g a b =
    let key = M.findWithDefault 0 (head b) a in
    if key == 0
    then "OK": g (M.insert (head b) 1 a) (tail b)
    else ((head b) ++ show key) : g (M.insert (head b) (key + 1) a) (tail b)

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

repeatM a = mapM (const a) (repeat 1)
repeatMn a n = mapM (const a) [1..n]
readm::(Read a) => State String a
readm = State (head . reads)
readchar = State (\s->(head s,tail s))
readall = State (,"")

runRead x s = fst $ runState x s

solve::Map String Int -> [String] -> [String]
solve _ [] = []
solve m (s:ss) = s1 : solve m1 ss where
	(s1,m1) = case (Data.Map.lookup s m) of
		Nothing -> ("OK",insert s 1 m)
		Just x -> (s++show (x+1),insert s (x+1) m)
main = reader >>= writer . solver
reader = getContents
writer = putStr
solver = runRead $ do
	n <- readm
	l <- liftM lines readall
	return (unlines . solve empty . take n  . tail $ l)

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

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

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

main = do
  n <- readLn
  ss <- replicateM n B.getLine

  let
    rs = process HashMap.empty ss
      where
        process _ [] = []
        process !m (s:ss) =
          case s `HashMap.lookup` m of
            Nothing -> (B.pack "OK"):(process (HashMap.insert s 1 m) ss)
            Just k -> (B.append s (B.pack $ show k)):(process (HashMap.adjust (+1) s m) ss)

  B.putStr $ B.unlines rs

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

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

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

main = do
  n <- readLn
  ss <- replicateM n B.getLine

  let
    rs = process HashMap.empty ss
      where
        process _ [] = []
        process m (s:ss) =
          case s `HashMap.lookup` m of
            Nothing -> (B.pack "OK"):(process (HashMap.insert s 1 m) ss)
            Just k -> (B.append s (B.pack $ show k)):(process (HashMap.adjust (+1) s m) ss)

  putStr $ unlines $ map B.unpack rs

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

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

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

main = do
  n <- readLn
  ss <- replicateM n B.getLine

  let
    rs = process Map.empty ss
      where
        process _ [] = []
        process !m (s:ss) =
          case s `Map.lookup` m of
            Nothing -> (B.pack "OK"):(process (Map.insert s 1 m) ss)
            Just k -> (B.append s (B.pack $ show k)):(process (Map.adjust (+1) s m) ss)

  B.putStr $ B.unlines rs

import Data.List
import Data.Tree
import Data.Int
import Data.Word
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  getLine>>= \i -> C.interact $ C.unlines.solve. take (read i).C.lines
solve :: [C.ByteString]-> [C.ByteString]
solve xs =  map (\(a1,a2)->a1) $ sortBy (\ (a1,a2) (b1,b2) -> a2 `compare` b2) $ concat $ map slv2 $ slv1 xs
slv1::[C.ByteString]->[[(C.ByteString,Int)]]
slv1 xs= groupBy (\(a1,a2) (b1,b2)->a1==b1 ) $sortBy (\ (a1,a2) (b1,b2) -> a1 `compare` b1) $ zip xs [1..]
slv2 :: [(C.ByteString,Int)]->[(C.ByteString,Int)]
slv2 xs=zipWith (\ (a1,a2) b->if b==0 then (C.pack "OK",a2) else (C.append a1 (C.pack $ show b) ,a2) ) xs [0..]

import qualified Data.Map as M
import Data.Map (Map)

updateMap :: Map String Int -> String -> Map String Int
updateMap dataset str = M.insertWith (+) str 1 dataset
    where
        updater 0 _ = 1
        updater value _ = value + 1

loop :: Int -> Map String Int -> IO (Map String Int)
loop 0 dataset = return dataset
loop n dataset = do
    str <- getLine
    let newSet = updateMap dataset str
    loop (n - 1) newSet

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    dataset <- loop n M.empty
    print dataset

import Control.Applicative
import qualified Data.Map as M
import Data.Maybe

process::[String]->M.Map String Int->IO ()
process [] _ = putStrLn ""
process (q:qs) d | M.lookup q d== Nothing = do
                                                  putStrLn "Ok"
                                                  process qs (M.insert q 1 d)
                     | otherwise = do
                                      let x = fromJust $ M.lookup q d
                                      putStrLn $ q++ (show x)
                                      process qs (M.insert q (x+1) d)

main=do
      getLine
      q<- lines<$>  getContents
      process  q  M.empty

import Data.List
c1 = 27 ** 32
main = do
    n <- read `fmap` getLine
    l <- mapM (\i ->  (\s -> (s, i)) `fmap` getLine) [1..n]
    let l1 = concat $ map addNumb $ groupBy (\(a, _) (b, _) -> a == b) $ sort l where
            addNumb [(s, i)] = [("OK", i)]
            addNumb ((s, i):ss) = let
                a = foldl' (\(ss', n') (st, nline) ->
                    ((st++show n', nline):ss', n+1)) ([("OK", i)], 1) ss in fst a
    mapM_ (\s -> putStr (fst s ++ "\n")) $ sortBy (\(_, a) (_, b) -> a `compare` b) l1

import Control.Applicative
import Control.Monad
import qualified Data.Map.Strict as M
import qualified Data.ByteString.Char8 as C

process::[C.ByteString]->M.Map C.ByteString Int->IO ()
process [] _   = return ()
process (a:as) m   | M.findWithDefault (-10) a m ==(-10) = do
								putStrLn "OK"
								process as (M.insert a 0 m )
		   | otherwise = do
					let m1 = (M.insertWith (+) a 1 m)
					putStrLn $ (show a) ++ (show (M.findWithDefault (-10) a m1 ))
					process as  m1

main=do
	getLine
	a<-C.lines <$> C.getContents
        process a M.empty

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

process [] _ s = mapM_ putStrLn $ reverse s
process (a:as) m s | M.findWithDefault (-10) a m ==(-10) = process as (M.insert a 0 m )  ("Ok" : s)
		   | otherwise = process as  m1 ((a++show (M.findWithDefault (-10) a m1 )):s)
		where m1 = (M.insertWith (+) a 1 m)

main=do
	getLine
	a<-lines <$> getContents ::IO [String]
        process a M.empty []


Sereja and his friends went to a picnic. The guys had n soda bottles just for it. Sereja forgot the bottle opener as usual, so the guys had to come up with another way to open bottles.Sereja knows that the i-th bottle is from brand ai, besides, you can use it to open other bottles of brand bi. You can use one bottle to open multiple other bottles. Sereja can open bottle with opened bottle or closed bottle.Knowing this, Sereja wants to find out the number of bottles they've got that they won't be able to open in any way. Help him and find this number.

The first line contains integer n (1 ≤ n ≤ 100) — the number of bottles. The next n lines contain the bottles' description. The i-th line contains two integers ai, bi (1 ≤ ai, bi ≤ 1000) — the description of the i-th bottle.

In a single line print a single integer — the answer to the problem.

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (liftM, replicateM)
import Data.List (delete)

type Bottle = (Int, Int)

readInt :: String -> Int
readInt = read

cantBeOpened :: Bottle -> [Bottle] -> Bool
cantBeOpened b bs = null [x | x <- bs, snd x == t]
  where t = fst b

main = do
  numBottles <- liftM readInt getLine
  bottles <- replicateM numBottles $ do
    [a, b] <- liftM (map readInt . words) getLine
    return (a, b)
  let result = zipWith cantBeOpened bottles $ map (`delete` bottles) bottles
  print . length $ filter id result

main = do
    getLine
    interact $ show.length.solve.(map (map read)).(map words).lines

solve con = filter (\[x,y]->x/=0) (res con [])
res [] acc = acc
res ([x,y]:xs) acc = res (sch (x,y) xs) ([x,y]:(sch (x,y) acc))
sch _ [] = []
sch (a,b) ([x,y]:xs)
    |b==x           = [0,y]:sch (a,b) xs
    |otherwise      = [x,y]:sch (a,b) xs

import Control.Monad (liftM)
import Data.List (delete)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

readPair :: Read a => IO (a, a)
readPair  =  do
    [x, y]  <-  reads
    return (x, y)

solve :: [(Int, Int)] -> Int
solve xs  =  length $ filter notOpen xs
  where
    notOpen x  =  notElem (fst x) $ map snd $ delete x xs

main :: IO ()
main  =  do
    n  <-  readLn
    xs  <-  sequence $ replicate n readPair
    print $ solve xs

import Control.Applicative
import Data.Array

main = do
    n <- read <$> getLine :: IO Int
    aa <- sequence $ take n $ repeat $ do
        s <- words <$> getLine
        return (read (s!!0), read (s!!1)) :: IO (Int, Int)
    let a = listArray (1, n) aa
    let goodL = filter (\i -> any (\j -> i /= j && fst (a!i) == snd (a!j)) [1..n]) [1..n]
    print $ n - length goodL

main = do
    getLine
    interact $ show.length.solve.(map (map read)).(map words).lines

solve con = filter (\[x,y]->x/=0) (res con con)
res [] con = con
res ([x,y]:xs) con = res xs (sch (x,y) con)
sch _ [] = []
sch (a,b) ([x,y]:xs)
    |b==x&&a/=x     = [0,y]:sch (a,b) xs
    |otherwise      = [x,y]:sch (a,b) xs


You are given an integer m as a product of integers a1, a2, ... an . Your task is to find the number of distinct decompositions of number m into the product of n ordered positive integers.Decomposition into n products, given in the input, must also be considered in the answer. As the answer can be very large, print it modulo 1000000007 (109 + 7).

The first line contains positive integer n (1 ≤ n ≤ 500). The second line contains space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109).

In a single line print a single number k — the number of distinct decompositions of number m into n ordered multipliers modulo 1000000007 (109 + 7).

NoteIn the second sample, the get a decomposition of number 2, you need any one number out of three to equal 2, and the rest to equal 1.In the third sample, the possible ways of decomposing into ordered multipliers are [7,5], [5,7], [1,35], [35,1].A decomposition of positive integer m into n ordered multipliers is a cortege of positive integers b = {b1, b2, ... bn} such that . Two decompositions b and c are considered different, if there exists index i such that bi ≠ ci.

{-# LANGUAGE BangPatterns #-}

import Data.List (foldl',sort,groupBy)
import Data.Int
import Data.Array.IO
import qualified Data.Array.MArray as M
import qualified Data.Array.IArray as I
import Data.Array.Unboxed
import Control.Monad

isqrt :: Integral a => a -> Int
isqrt n = floor $ sqrt ((fromIntegral n) :: Double)

sieve arr = do
  (_,hi) <- getBounds arr
  let maxi = isqrt hi
  forM_ [2..maxi] $ \i -> do
    v <- readArray arr i
    if v == 0
      then let v = i*i in forM_ [v,v+i..hi] $ \j -> writeArray arr j (fromIntegral i)
      else return ()

genPrimes :: Integral a => Int -> IO [a]
genPrimes n = do
  parr' <- newArray (2,n) 0 :: IO (IOUArray Int Int)
  sieve parr'
  parr <- M.freeze parr' :: IO (UArray Int Int)
  let primes = map (fromIntegral.fst) $ filter (\(i,v) -> v == 0) $ I.assocs parr
  return primes

ind :: Integral a => a -> a -> (Int,a)
ind p n = go 0 n
  where go !k m = case m `divMod` p of
                    (q,0)     -> go (k+1) q
                    otherwise -> (k,m)

factor :: Integral a => [a] -> a -> [(a,Int)]
factor [] n
  | n == 1 = []
  | otherwise = [(n,1)]  -- assume n is prime
factor (p:ps) n = case ind p n of
                    (0,_) -> factor ps n
                    (k,m) -> (p,k) : factor ps m

prod :: Integral a => [(a,Int)] -> a
prod = product . map (\(p,k) -> p^k)

minvs :: Integral a => a -> [a]
minvs m = map (minv m) [1..m-1]

minv :: Integral a => a -> a -> a
minv m a = y `mod` m
  where (x,y) = crt m a

-- crt a b = (x,y) s.t. a*x + b*y = gcd(a,b)
crt :: Integral a => a -> a -> (a,a)
crt 0 a = (0,1)
crt a 0 = (1,0)
crt a b =
  let (q,r) = a `divMod` b
      (y,x) = crt b r
  in (x, y-q*x)

prop_crt :: Int -> Int -> Bool
prop_crt a b =
  let (x,y) = crt a b
      g     = gcd a b
  in abs (a*x + b*y) == g

data Mod a = M { modulus :: a, inverses :: [a] }

mkMod :: Integral a => a -> Mod a
mkMod m = M m (minvs m)

-- compute starsbars(a,n) modulo a
-- invs is [1,1/2,1/3,...] mod m
starsbars :: (Show a , Integral a) => Mod a -> a -> a -> a
starsbars m n a =
  let m' = modulus m
      -- mmult x (p,q) | trace msg False = undefined
      --  where msg = "x: " ++ show x ++ " p: " ++ show p ++ " q: " ++ show q
      mmult x (p,q) = (((x*p) `mod` m') * q) `mod` m'
  in foldl' mmult 1 $ zip [a+n-1,a+n-2..a+1] (inverses m)

equalFst a b = (fst a) == (fst b)

testInverses :: Int -> Int -> Bool
testInverses m r =
  let mmod = mkMod m
      m' = fromIntegral m :: Int64
      check (x,y) = mod (x'*y') m' == 1
        where x' = fromIntegral x :: Int64
              y' = fromIntegral y :: Int64
  in all check (zip [1..r] (inverses mmod))

bigPrime = 10^(9::Int)+7
mBigPrime = mkMod bigPrime
mmult a b = mod (a*b) bigPrime

mergeFactors :: [(Int,Int)] -> [Int]
mergeFactors fs = map (\g -> sum (map snd g)) $ groupBy equalFst $ sort fs

main = do
  n <- fmap read getLine :: IO Int
  xs <- fmap (map read . words) getLine
  primes <- genPrimes 32000
  let pcounts = map fromIntegral $ mergeFactors $ concatMap (factor primes) xs
      _ = pcounts :: [Int64]
      n' = fromIntegral n
      answer = foldl' mmult 1 $ map (starsbars mBigPrime n') pcounts
  print answer
  return ()


Alice and Bob are playing a game with strings. There will be $$$t$$$ rounds in the game. In each round, there will be a string $$$s$$$ consisting of lowercase English letters. Alice moves first and both the players take alternate turns. Alice is allowed to remove any substring of even length (possibly empty) and Bob is allowed to remove any substring of odd length from $$$s$$$.More formally, if there was a string $$$s = s_1s_2 \ldots s_k$$$ the player can choose a substring $$$s_ls_{l+1} \ldots s_{r-1}s_r$$$ with length of corresponding parity and remove it. After that the string will become $$$s = s_1 \ldots s_{l-1}s_{r+1} \ldots s_k$$$.After the string becomes empty, the round ends and each player calculates his/her score for this round. The score of a player is the sum of values of all characters removed by him/her. The value of $$$\texttt{a}$$$ is $$$1$$$, the value of $$$\texttt{b}$$$ is $$$2$$$, the value of $$$\texttt{c}$$$ is $$$3$$$, $$$\ldots$$$, and the value of $$$\texttt{z}$$$ is $$$26$$$. The player with higher score wins the round. For each round, determine the winner and the difference between winner's and loser's scores. Assume that both players play optimally to maximize their score. It can be proved that a draw is impossible.

The first line of input contains a single integer $$$t$$$ ($$$1\leq t\leq 5\cdot 10^4$$$) denoting the number of rounds. Each of the next $$$t$$$ lines contain a single string $$$s$$$ ($$$1\leq |s|\leq 2\cdot 10^5$$$) consisting of lowercase English letters, denoting the string used for the round. Here $$$|s|$$$ denotes the length of the string $$$s$$$. It is guaranteed that the sum of $$$|s|$$$ over all rounds does not exceed $$$2\cdot 10^5$$$.

For each round, print a single line containing a string and an integer. If Alice wins the round, the string must be "Alice". If Bob wins the round, the string must be "Bob". The integer must be the difference between their scores assuming both players play optimally.

NoteFor the first round, $$$\texttt{"aba"}\xrightarrow{\texttt{Alice}}\texttt{"}{\color{red}{\texttt{ab}}}\texttt{a"}\xrightarrow{} \texttt{"a"}\xrightarrow{\texttt{Bob}}\texttt{"}{\color{red}{\texttt{a}}}\texttt{"}\xrightarrow{}\texttt{""}$$$. Alice's total score is $$$1+2=3$$$. Bob's total score is $$$1$$$.For the second round, $$$\texttt{"abc"}\xrightarrow{\texttt{Alice}}\texttt{"a}{\color{red}{\texttt{bc}}}\texttt{"}\xrightarrow{} \texttt{"a"}\xrightarrow{\texttt{Bob}}\texttt{"}{\color{red}{\texttt{a}}}\texttt{"}\xrightarrow{}\texttt{""}$$$. Alice's total score is $$$2+3=5$$$. Bob's total score is $$$1$$$.For the third round, $$$\texttt{"cba"}\xrightarrow{\texttt{Alice}}\texttt{"}{\color{red}{\texttt{cb}}}\texttt{a"}\xrightarrow{} \texttt{"a"}\xrightarrow{\texttt{Bob}}\texttt{"}{\color{red}{\texttt{a}}}\texttt{"}\xrightarrow{}\texttt{""}$$$. Alice's total score is $$$3+2=5$$$. Bob's total score is $$$1$$$.For the fourth round, $$$\texttt{"n"}\xrightarrow{\texttt{Alice}}\texttt{"n"}\xrightarrow{} \texttt{"n"}\xrightarrow{\texttt{Bob}}\texttt{"}{\color{red}{\texttt{n}}}\texttt{"}\xrightarrow{}\texttt{""}$$$. Alice's total score is $$$0$$$. Bob's total score is $$$14$$$.For the fifth round, $$$\texttt{"codeforces"}\xrightarrow{\texttt{Alice}}\texttt{"}{\color{red}{\texttt{codeforces}}}\texttt{"}\xrightarrow{} \texttt{""}$$$. Alice's total score is $$$3+15+4+5+6+15+18+3+5+19=93$$$. Bob's total score is $$$0$$$.

-- https://codeforces.com/contest/1679/problem/D
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NumericUnderscores #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

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

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "Yes"
                else "No"
    printf "%s\n" result

{- END OF GENERAL -}

stringValue :: B8.ByteString -> Int
stringValue str = sum . map (\c -> ord c - ord 'a' + 1) $ B8.unpack str

solve :: B8.ByteString -> (String, Int)
solve str
    | even $ B8.length str = valueToAnswer strValue
    | otherwise = valueToAnswer $ max (tailStrValue - headStrValue) (tailEndStrValue - headEndStrValue)
    where
        strValue = stringValue str

        tailStrValue = stringValue $ B8.drop 1 str
        headStrValue = stringValue $ B8.take 1 str

        tailEndStrValue = stringValue $ B8.take (B8.length str - 1) str
        headEndStrValue = stringValue $ B8.drop (B8.length str - 1) str

        valueToAnswer value
            | value > 0 = ("Alice", value)
            | value < 0 = ("Bob", - value)
            | otherwise = ("WTF", - value)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        str <- B8.getLine <&> head . B8.words
        let (player, score) = solve str
        printf "%s %d\n" player score

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

solve :: IO ()
solve = do
    xs <- map ((+(-96)) . ord) . takeWhile (not . isSpace) . C.unpack <$> C.getLine
    let [sm, hx, lx] = ($xs) <$> [sum, head, last]
        diff
            | even (length xs) = sm
            | otherwise        = sm - 2 * min hx lx
    putStrLn $ (if diff > 0 then "Alice" else "Bob") ++ " " ++ show (abs diff)

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts


Developers often face with regular expression patterns. A pattern is usually defined as a string consisting of characters and metacharacters that sets the rules for your search. These patterns are most often used to check whether a particular string meets the certain rules.In this task, a pattern will be a string consisting of small English letters and question marks ('?'). The question mark in the pattern is a metacharacter that denotes an arbitrary small letter of the English alphabet. We will assume that a string matches the pattern if we can transform the string into the pattern by replacing the question marks by the appropriate characters. For example, string aba matches patterns: ???, ??a, a?a, aba.Programmers that work for the R1 company love puzzling each other (and themselves) with riddles. One of them is as follows: you are given n patterns of the same length, you need to find a pattern that contains as few question marks as possible, and intersects with each of the given patterns. Two patterns intersect if there is a string that matches both the first and the second pattern. Can you solve this riddle?

The first line contains a single integer n (1 ≤ n ≤ 105) — the number of patterns. Next n lines contain the patterns. It is guaranteed that the patterns can only consist of small English letters and symbols '?'. All patterns are non-empty and have the same length. The total length of all the patterns does not exceed 105 characters.

In a single line print the answer to the problem — the pattern with the minimal number of signs '?', which intersects with each of the given ones. If there are several answers, print any of them.

NoteConsider the first example. Pattern xab intersects with each of the given patterns. Pattern ??? also intersects with each of the given patterns, but it contains more question signs, hence it is not an optimal answer. Clearly, xab is the optimal answer, because it doesn't contain any question sign. There are a lot of other optimal answers, for example: aab, bab, cab, dab and so on.

import Data.List
strToList = (map (read :: String -> Int)).words

f [] = ""
f (x:xs)  | length s > 1 = '?' : f xs
          | length s == 1 = s !! 0 : f xs
          | otherwise = 'a' : f xs
            where s = filter (/='?') (nub x)

main = do
    n <- readLn :: IO Int
    s <- getContents
    putStrLn $ f $ transpose $ lines s

import Data.List
import Control.Applicative

main = do
	n <- read <$> getLine :: IO Int
	a <- take n <$> lines <$> getContents
	putStrLn $ mergeMatrix $ transpose a

mergeMatrix :: [[Char]] -> [Char]
mergeMatrix a
    | null a        = ""
    | otherwise     = (mergeString (head a)) : (mergeMatrix (tail a))

mergeString :: [Char] -> Char
mergeString s = finalize $ foldl mergeChar '.' s

mergeChar :: Char -> Char -> Char
mergeChar '.' '?' = '.'
mergeChar '.'   c = c
mergeChar '?'   c = '?'
mergeChar   c '?' = c
mergeChar   a   b = if a == b then a else '?'

finalize :: Char -> Char
finalize c
    | c == '.'      = 'x'
    | otherwise     = c


In Python, code blocks don't have explicit begin/end or curly braces to mark beginning and end of the block. Instead, code blocks are defined by indentation.We will consider an extremely simplified subset of Python with only two types of statements.Simple statements are written in a single line, one per line. An example of a simple statement is assignment.For statements are compound statements: they contain one or several other statements. For statement consists of a header written in a separate line which starts with "for" prefix, and loop body. Loop body is a block of statements indented one level further than the header of the loop. Loop body can contain both types of statements. Loop body can't be empty.You are given a sequence of statements without indentation. Find the number of ways in which the statements can be indented to form a valid Python program.

The first line contains a single integer N (1 ≤ N ≤ 5000) — the number of commands in the program. N lines of the program follow, each line describing a single command. Each command is either "f" (denoting "for statement") or "s" ("simple statement"). It is guaranteed that the last line is a simple statement.

Output one line containing an integer - the number of ways the given sequence of statements can be indented modulo 109 + 7.

NoteIn the first test case, there is only one way to indent the program: the second for statement must be part of the body of the first one.simple statementfor statement    for statement        simple statementIn the second test case, there are two ways to indent the program: the second for statement can either be part of the first one's body or a separate statement following the first one.for statement    simple statement    for statement        simple statementorfor statement    simple statementfor statement    simple statement

{-# LANGUAGE BangPatterns, ViewPatterns #-}
import Data.Int
import Data.List
import Control.DeepSeq
main = interact exec
exec = (\(n0:ss0) -> let n = read n0 :: Int; (s:ss) = map head ss0 in show $ f s (1:replicate (n - 1) 0) ss) . words

f 's' (force -> !ms) (s:ss) = f s (scanr1 (+%) ms) ss
f 'f' (force -> !ms) (s:ss) = f s (zipWith const (0:ms) ms) ss
f _   (force -> !ms) [] = foldl' (+%) 0 ms

mbase = 10^9 + 7 :: Int64
a +% b = (a + b) `rem` mbase

import Data.Int
import Data.List
import Control.DeepSeq
import qualified Data.ByteString.Char8 as B
main = B.interact exec
exec = (\(n0:ss0) -> let n = maybe undefined fst $ B.readInt n0; (s:ss) = map B.head ss0 in B.pack $ show $ f s (1:replicate (n - 1) 0) ss) . B.words

f 's' ms (s:ss) = f s (ms `deepseq` scanr1 (+%) ms) ss
f 'f' ms (s:ss) = f s (ms `deepseq` zipWith const (0:ms) ms) ss
f _   ms [] = foldl' (+%) 0 ms

mbase = 10^9 + 7 :: Int64
a +% b = (a + b) `rem` mbase

{-# LANGUAGE BangPatterns, ViewPatterns #-}
import Data.List
import Data.Int
import Control.DeepSeq

main = do
    temp <- getLine
    let n = read temp :: Int
    input <- getContents
    putStrLn $ solve $ init $ take n $ lines input

mod_constant = 1000000007 :: Int64
a `modplus` b = (a + b) `rem` mod_constant

suffixSum = scanr1 modplus

dpStep (force -> !p) "s" = suffixSum p
dpStep (force -> !p) "f" = 0:p

solve :: [String] -> String
solve x = show $ foldl modplus 0 $ foldl dpStep [1] x

import Data.Foldable
import Data.Semigroup

main = interact $ show . solve . args . words
  where args :: [String] -> [Int]
        args (w:ws) = go (read w) 0 ws
          where go :: Int -> Int -> [String] -> [Int]
                go _ _ [] = []
                go n k (w:ws)
                  | n == 1    = []
                  | w == "f"  = go (n - 1) (k + 1) ws
                  | otherwise = (k + 1) : go (n - 1) 0 ws

solve :: [Int] -> Int
solve as = solve' as [1] 1
  where solve' :: [Int] -> [Int] -> Int -> Int
        solve' []     xs s = s
        solve' (a:as) xs s = solve' as xs' (foldl' modAdd 0 xs')
          where xs' = zipWith modSub (s : xs') (stimes a [0] ++ xs)

modConst :: Int
modConst = 1000000007

modSub :: Int -> Int -> Int
modSub a b = (a - b) `mod` modConst

modAdd :: Int -> Int -> Int
modAdd a b = (a + b) `mod` modConst

import Data.List

main = do
    temp <- getLine
    let n = read temp :: Int
    input <- getContents
    putStrLn $ solve $ init $ take n $ lines input

suffixSum p = map sum $ (init . tails) p

dpStep p "s" = map (\x -> x `mod` 1000000007) $ suffixSum p
dpStep p "f" = 0:p

solve :: [String] -> String
solve x = show $ sum $ foldl dpStep [1] x

import Data.List

main = do
    temp <- getLine
    let n = read temp :: Int
    input <- getContents
    putStrLn $ solve $ init $ take n $ lines input

addStep p "s" = reverse $ map sum $ (init . tails) p
addStep p "f" = 0:p

solve :: [String] -> String
solve x = show $ sum $ foldl addStep [1] x

import Data.List

main = do
    temp <- getLine
    let n = read temp :: Int
    input <- getContents
    putStrLn $ solve $ init $ take n $ lines input

suffixSum p = map sum $ (init . tails) p

addStep p "s" = suffixSum p
addStep p "f" = 0:p

solve :: [String] -> String
solve x = show $ sum $ foldl addStep [1] x

import Data.Semigroup

main = interact $ show . solve . args . words
  where args :: [String] -> [Int]
        args (w:ws) = go (read w) 0 ws
          where go :: Int -> Int -> [String] -> [Int]
                go _ _ [] = []
                go n k (w:ws)
                  | n == 1    = []
                  | w == "f"  = go (n - 1) (k + 1) ws
                  | otherwise = (k + 1) : go (n - 1) 0 ws

solve :: [Int] -> Int
solve as = solve' as [1] 1
  where solve' :: [Int] -> [Int] -> Int -> Int
        solve' []     xs s = s
        solve' (a:as) xs s = solve' as xs' (sum xs')
          where xs' = zipWith (-) (s : xs') (stimes a [0] ++ xs)