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

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)

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

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


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


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


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

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


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

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

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)


import Data.List
main=interact$show.sum.map((`div`4).(^2).(+(-1)).length).group.sort.map head.tail.lines

import Data.List

main = getContents >>= print . solve . tail . words

solve = sum . map ((\n -> let x = n `div` 2 in c x 2 + c (n - x) 2) . length) . group . sort . map head
    where c n 2 = n * (n - 1) `div` 2

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

half :: Int -> [Int]
half n = [a, n - a] where a = div n 2

handshakes :: Int -> Int
handshakes n = div (n * (n - 1)) 2

solve :: [String] -> Int
solve = sum
      . map handshakes
      . concat
      . map half
      . map length
      . group
      . sort
      . map head

main :: IO ()
main = do
    n <- readInt
    names <- replicateM n getLine
    print $ solve names

import Data.List

main = interact $ show . sum . map (sum . map (\x -> x * (x - 1) `div` 2) . (\x -> [x `div` 2, (x + 1) `div` 2]) . length) . group . sort . map head . tail . lines

import Data.List
import Data.Function
main = interact $ show . solve . sort . tail . lines
solve = sum . map (f . length) . groupBy ((==) `on` head)
f n = ps h + ps h' where h = n `div` 2; h' = h + n `mod` 2
ps n = n * (n-1) `div` 2

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = do
	n <- readInt
	ls <- map length . group . sort . map head <$> replicateM n getLine
	print $ solve ls

solve [] = 0
solve (l:ls) = f l1 + f l2 + solve ls
	where
		l1 = l `div` 2
		l2 = l - l1
		f x = x * ( x - 1 ) `div` 2

import Data.List
import Data.Function
import Data.Bifunctor

fac n = snd $ until ((<2). fst) (\(x,y) -> (x-1,y*x)) (toInteger n,1 :: Integer)
comb2 n = if n < 2 then 0 else (fac n ) `div` (fac $ n-2) `div` 2
clip n = if n < 0 then 0 else n
solve =  uncurry (+) .
         foldr (\(a,b) (x,y) -> (a+x,b+y)) (0,0) .
         map ((\x -> let y = x`div`2 in bimap comb2 comb2 (y, clip $ x-y)) . length) .
         groupBy ((==) `on` (!!0)) .
         sort
main = print =<< solve . tail . lines <$> getContents

import Data.List
import Data.Function
import Data.Bifunctor

fac n = snd $ until ((<2). fst) (\(x,y) -> (x-1,y*x)) (n,1)
comb2 n = if n < 2 then 0 else (fac n ) `div` (fac $ n-2) `div` 2
solve = uncurry (+)
        . foldr (\(a,b) (x,y) -> (a+x,b+y)) (0,0)
        . map ((\x -> let y = x`div`2 in bimap comb2 comb2 (y,x-y)) . length)
        . groupBy ((==) `on` (!!0))
        . sort
main = print =<< solve . tail . lines <$> getContents


import Data.Functor
import Data.List

getInts :: IO [Int]
getInts = map read <$> words <$> getContents

main = getInts >>= putStrLn . (\b -> if b then "Yes" else "No") . solve

solve :: [Int] -> Bool
solve (n:m:as) = (==g) . length . nub $ map f xs ++ map f ys where
    xn:as2 = as
    yn:as3 = drop xn as2
    xs = take xn as2
    ys = take yn as3
    g = gcd n m
    f = (flip mod) g

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Char
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  [n, m] <- fmap (map read . words) getLine
  xs <- fmap (tail . map read . words) getLine
  ys <- fmap (tail . map read . words) getLine

  let
    check = runST $ do
      as <- newArray (0, n-1) False :: ST s (STUArray s Int Bool)
      mapM_ (\x -> writeArray as x True) xs

      bs <- newArray (0, m-1) False :: ST s (STUArray s Int Bool)
      mapM_ (\x -> writeArray bs x True) ys

      replicateM (n+m) $ do
        forM [0..n*m-1] $ \i -> do
          a <- readArray as (i `mod` n)
          b <- readArray bs (i `mod` m)

          when (not a && b) $ writeArray as (i `mod` n) True
          when (a && not b) $ writeArray bs (i `mod` m) True

      as' <- getElems as
      bs' <- getElems bs
      return $ and $ as' ++ bs'

  putStrLn $ if check then "Yes" else "No"

module Main where
import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8  as C
import Data.List
import Data.Maybe

getIntList :: IO [Int]
getIntList = map fst . mapMaybe C.readInt . C.words <$> C.getLine

main :: IO ()
main = do
  n:m:_ <- getIntList
  b:bs <- getIntList
  g:gs <- getIntList
  putStrLn $ if sol n m bs gs then "Yes" else "No"

sol :: Int -> Int -> [Int] -> [Int] -> Bool
sol a b bs gs = d>0 && (d==1 || d==h)
  where
  d = gcd a b
  h = length $ nub $ map (flip mod d) (bs ++ gs)

import Data.List
import qualified Data.Set as Set
import Control.Applicative
import System.IO
import Debug.Trace

main = do
    [n, m] <- map read <$> words <$> getLine
    (_:boys)  <- map read <$> words <$> getLine
    (_:girls) <- map read <$> words <$> getLine

    let loop i boys girls
          | Set.size boys == n
            && Set.size girls == m  = Right ()
          | i > n * m = Left (boys, girls)
          | otherwise = do
            let ib = i `mod` n
                ig = i `mod` m
                hb = Set.member ib boys
                hg = Set.member ig girls

            let (boys', girls')
                  | hb  &&  hg       = (boys, girls)
                  | not hb && not hg = (boys, girls)
                  | hb  && not hg = (boys, Set.insert ig girls)
                  | not hb &&  hg = (Set.insert ib boys, girls)

            loop (i+1) boys' girls'

    let checkpoint boys girls =
          case loop 0 boys girls of
            Right _ -> True
            Left (boys', girls') -> do
              if boys == boys' && girls == girls'
                then False
                else checkpoint boys' girls'

    putStrLn $
      if checkpoint (Set.fromList boys) (Set.fromList girls)
        then "Yes"
        else "No"

import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ B.unpack line

makeStep :: Set.Set (Int, Int) -> ([Bool], [Bool]) -> ([Bool], [Bool])
makeStep goodPairs (boys, girls) =
    (boys', girls')
    where
        n = length boys
        m = length girls
        happyPairs = [(bi, gi) | (b, bi) <- zip boys [0..],
                                 (g, gi) <- zip girls [0..],
                                 (b || g) && (bi, gi) `Set.member` goodPairs]
        happyBoys = Set.fromList $ map fst happyPairs
        happyGirls = Set.fromList $ map snd happyPairs
        boys' = map (`Set.member` happyBoys) [0..n - 1]
        girls' = map (`Set.member` happyGirls) [0..m - 1]

main = do
    [n, m] <- readIntList
    happyBoys <- tail `liftM` readIntList
    happyGirls <- tail `liftM` readIntList
    let boys = map (`elem` happyBoys) [0..n - 1]
    let girls = map (`elem` happyGirls) [0..m - 1]
    let goodPairs = Set.fromList $ map (\d -> (d `mod` n, d `mod` m)) [0..n * m - 1]
    let (boys', girls') = foldr (.) id (replicate (n + m) (makeStep goodPairs))
            $ (boys, girls)
    let allHappy = not (False `elem` (boys' ++ girls'))
    let ans = if allHappy then "Yes" else "No"
    putStrLn $ ans

import Data.List
import qualified Data.Set as Set
import Control.Applicative
import System.IO

main = do
    [n, m] <- map read <$> words <$> getLine
    (_:boys)  <- map read <$> words <$> getLine
    (_:girls) <- map read <$> words <$> getLine

    let loop i boys girls
          | Set.size boys == n
            && Set.size girls == m  = True
          | i > n * m = False
          | otherwise = do
            let ib = i `mod` n
                ig = i `mod` m
                hb = Set.member ib boys
                hg = Set.member ig girls

            let (boys', girls')
                  | hb  &&  hg       = (boys, girls)
                  | not hb && not hg = (boys, girls)
                  | hb  && not hg = (boys, Set.insert ig girls)
                  | not hb &&  hg = (Set.insert ib boys, girls)

            loop (i+1) boys' girls'

    putStrLn $
      if loop 0 (Set.fromList boys) (Set.fromList girls)
        then "Yes"
        else "No"


import Control.Applicative ((<$>))
import Data.Int (Int64)
import Control.Monad (forM_)
import Data.List (intercalate)

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int]
  a <- map read . words <$> getLine :: IO [Int64]
  b <- map read . words <$> getLine :: IO [Int64]
  forM_ (solve a b 1 0) $ \(x, y) -> do
    putStrLn $ intercalate " " $ map show [x, y]

solve :: [Int64] -> [Int64] -> Int64 -> Int64 -> [(Int64, Int64)]
solve _ [] _ _ = []
solve (a:as) (b:bs) n s
  | b <= s + a = (n, b - s) : solve (a:as) bs n s
  | otherwise  = solve as (b:bs) (n + 1) (s + a)

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Map as M
import Data.List

main = do
  inp <- fmap B.lines B.getContents
  let as = map readI $ B.words $ inp!!1
  let bs = map readI $ B.words $ inp!!2
  putStrLn $ unlines $ map (\(i,j)->show i++" "++show j) $ solve as bs

readI :: B.ByteString -> Integer
readI s = case B.readInteger s of Just (n,_) -> n

solve :: [Integer] -> [Integer] -> [(Integer,Integer)]
solve as bs =
  map f bs
  where
    m = M.fromList $ zip (scanl (+) 0 as) [0..]

    f x = case M.lookupLT x m of
            Nothing -> error "error"
            Just (k,v)  -> (v+1,x-k)


module Main where
import Data.List as L
import Data.ByteString.Lazy as B
import Data.ByteString.Lazy.Char8 as C
main :: IO ()
main = do
    _ <- readLn :: IO Integer
    cs <- B.getContents
    let ls = C.lines cs
        lineToTup l =
            let ws = C.words l
                readDatInt = (\ (Just (i,_)) -> i) . C.readInt
                [a,b] = Prelude.map readDatInt ws
            in (a,b)
        events = Prelude.map lineToTup ls
        eventsbystart = L.sortBy (\(a,_) (b,_) -> compare a b) $ events
        (_,ans) = Prelude.foldl (\ (m,c) (_,b) -> (max m b, c + if b < m then 1 else 0)) (snd $ Prelude.head eventsbystart,0::Integer) (Prelude.tail eventsbystart)
        -- eventsbystartl = F.toList eventsbystart
    print ans

{-# OPTIONS_GHC -O2 #-}

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

import Control.Monad
import Control.Applicative

solve :: [(Int, Int)] -> Int
solve events = snd $ foldl' f (0, 0) es
  where es = map snd $ sort events
        f (right, ans) y | y < right = (right, ans + 1)
                         | otherwise = (y, ans)

toPair [x, y] = (x, y)

main = do _:xs <- map (toPair . map (fst .fromJust . BS.readInt) . BS.words) . BS.lines <$> BS.getContents
          print $ solve xs

import Data.List(sort,foldl')
import Control.Applicative
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do n <- read <$> getLine
          xs <- map ((\ [x,y] -> (x,y)).map read'.B.words) <$> B.lines <$> B.getContents
          print $ solve n xs

read' s = let Just (n,s') = B.readInt s
          in n

solve :: Int -> [(Int,Int)] -> Int
solve _ xs = snd $ foldl' f (y,0) ys
   where (y:ys) = map snd $ sort xs

f :: (Int,Int) -> Int -> (Int,Int)
f (m,i) n
  | m > n     = (m,succ i)
  | otherwise = (n,i)

{-# OPTIONS_GHC -O2 #-}

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

import Control.Monad
import Control.Applicative

solve :: [(Int, Int)] -> Int
solve events = snd $ foldl' f (0, 0) es
  where es = map snd $ sort events
        f (right, ans) y | y < right = (right, ans + 1)
                         | otherwise = (y, ans)

main = BS.interact $ BS.pack . show . solve . map parseEvent . tail .  BS.lines
  where parseEvent line = let [x, y] = map BS.readInt $ BS.words line
                          in (fst $ fromJust x, fst $ fromJust y)

import Control.Applicative
import Data.List (foldl', sort)
import qualified Data.ByteString.Char8 as S

main :: IO ()
main = do
  _:xs <- map (\x -> let [a, b] = S.words x in (S.readInt a, S.readInt b)) . S.lines <$> S.getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Foreign
import Foreign.C

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_i  :: CString -> Ptr CInt -> IO CInt

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_ii :: CString -> Ptr CInt -> Ptr CInt -> IO CInt

main :: IO ()
main = do
  alloca              $ \(a   :: Ptr CInt) -> do
  alloca              $ \(b   :: Ptr CInt) -> do
  withCString "%d"    $ \(i   :: CString)  -> do
  withCString "%d%d"  $ \(ii  :: CString)  -> do
    c_scanf_i i a
    n   <- peek a
    xs  <- replicateM (fromIntegral n) $ do
      c_scanf_ii ii a b
      (,) <$> peek a <*> peek b
    let y : ys = map snd $ sort xs
    print $ solve 0 y ys
 where
  solve !acc _   []        = acc
  solve !acc x'  (x : xs)
    | x < x'          = solve (1 + acc) x' xs
    | otherwise       = solve acc       x  xs

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Foreign
import Foreign.C

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_i  :: CString -> Ptr CInt -> IO CInt

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_ii :: CString -> Ptr CInt -> Ptr CInt -> IO CInt

main :: IO ()
main = do
  alloca              $ \(a   :: Ptr CInt) -> do
  alloca              $ \(b   :: Ptr CInt) -> do
  withCString "%d"    $ \(i   :: CString)  -> do
  withCString "%d%d"  $ \(ii  :: CString)  -> do
    c_scanf_i i a
    n   <- peek a
    xs  <- replicateM (fromIntegral n) $ do
      c_scanf_ii ii a b
      (,) <$> peek a <*> peek b
    let y : ys = map snd $ sort xs
    print $ snd $ foldl f (y, 0) ys
 where
  f (!y, !acc) x
    | x < y          = (y, 1 + acc)
    | otherwise      = (x, acc)

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  _:xs <- map parse . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)
    parse x = let [a, b] = words x
                  !c = read a :: Int
                  !d = read b :: Int
              in (c, d)

import Data.List
import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

readInt = fst . fromJust . C.readInt
readIntList = map readInt . C.words

listToTuple [a, b] = (a, b)

f (m, r) (_, b)
   | m > b     = (m, r+1)
   | otherwise = (b, r)

main = do
   input <- fmap (map (C.takeWhile (/='\r')) . C.lines) $ C.hGetContents stdin
   let n  = readInt $ head input
       ab = map (listToTuple . readIntList) (take n $ tail input)
   print . snd $ foldl' f (0, 0) (sort ab)

-- vim: set expandtab:

{-# LANGUAGE BangPatterns #-}

import Control.Monad (replicateM)
import Data.List (sort,foldl')
import Data.Ord (comparing)

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

main = do
  n <- fmap read getLine
  pairs <- replicateM n $ do
             (a:b:_) <- fmap (parseInts 2) BS.getLine
             return (a,b)
  let _ = pairs :: [(Int,Int)]
  let sorted = sort pairs

  let go :: (Int,Int) -> (Int,Int) -> (Int,Int)
      go (!c,m) (a,b) = case compare m b of
                              GT -> (c+1,m)
                              EQ -> (c,m)
                              LT -> (c,b)
  let (answer,_) = foldl' go (0,0) sorted
  print answer

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    replicateM n ((,) <$> readInt <*> readInt)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve xs = length [undefined | (a, b) <- zip rights maxr, a < b]
  where
    rights = map snd (sort xs)
    maxr = scanl max 0 rights

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

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

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

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

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

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  n <- getLine
  xs <- (map parse) . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

parse :: String -> (Int, Int)
parse x = let [a, b] = words x
              !c = read a :: Int
              !d = read b :: Int
              in (c, d)

import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  _:xs <- map parse . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

parse :: String -> (Int, Int)
parse x = let [a, b] = words x
              !c = read a :: Int
              !d = read b :: Int
              in (c, d)

import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  n <- getLine
  xs <- map parse . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

parse :: String -> (Int, Int)
parse x = let [a, b] = words x
              !c = read a :: Int
              !d = read b :: Int
              in (c, d)

import Control.Monad (replicateM)
import Data.List (sortBy)
import Data.Ord (comparing)
import Data.Array

contains :: (Int,Int) -> (Int,Int) -> Bool
contains (a,b) (c,d) = a < b && c < d

(-->) = flip fmap

main = do
  n <- getLine --> read
  pairs <- replicateM n $ do
             (a:b:_) <- getLine --> words --> map read
             return (a,b)
  let _ = pairs :: [(Int,Int)]
  let sorted = sortBy (comparing fst) pairs
  let arr = listArray (1,n) sorted
  -- count the number of pairs which are contained in some other (earlier) pair
  let isContained :: Int -> Bool
      isContained j =
        let cd = arr ! j in any (\i -> contains (arr ! i) cd) [1..j-1]
  let count = length $ filter isContained [2..n]
  print count

import Control.Applicative
import Data.List

main :: IO ()
main = do
  _:(_,b):xs <- map (\x -> let [a, b] = words x in (read a :: Int, read b :: Int)) . lines <$> getContents
  print $ fst $ foldl' f (0,b) $ map snd $ sort xs
  where
    f (acc,prev) b
      | prev > b = (acc+1, prev)
      | otherwise = (acc, b)

import Control.Applicative
import Data.List

main :: IO ()
main = do
  _:(_,b):xs <- map (\x -> let [a, b] = words x in (read a :: Int, read b :: Int)) . lines <$> getContents
  print $ fst $ foldl' f (0,b) $ map snd xs
  where
    f (acc,prev) b
      | prev > b = (acc+1, prev)
      | otherwise = (acc, b)

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

main :: IO ()
main = do n <- read <$> getLine
          xs <- forM [1..n] (\_ -> (\ [x,y] -> (x, negate y)) <$> map read <$> words <$> getLine)
          print $ solve n xs

solve :: Int -> [(Int,Int)] -> Int
solve _ xs = length $ filter (<y) ys
   where (y:ys) = map (negate.snd.head) $ groupBy (\ (i,_) (j,_) -> i == j) $ sort xs


{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

solve :: IO ()
solve = do
  ~[x,y] <- readv
  if odd (x+y) then putStrLn ("-1 -1") else printv [x`div`2, (y+1)`div`2]

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x <> DBB.char8 ' ' | x <- xs] <> DBB.char8 '\n'

readv :: IO [Int]
readv = map (maybe 0 fst . DBC.readInt) <$> (DBC.words <$> DBC.getLine)

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ nTc solve

import Control.Monad (replicateM)

main = do
  x <- getLine
  let nLines :: Int
      nLines = read x
  lines <- replicateM nLines getLine
  let res = map solve lines
  putStr $ unlines res

solve line = do
  let arr = [read x :: Int | x <- words line]
  let (x : y : _) = arr
  if (x + y) `mod` 2 == 1
    then "-1 -1"
    else unwords $ map show [floor $ fromIntegral x / 2, floor $ fromIntegral (y + 1) / 2]

f[x,y] =
 case (mod x 2, mod y 2) of
  (0, 0) -> [div x 2, div y 2]
  (0, 1) -> [-1, -1]
  (1, 0) -> [-1, -1]
  (1, 1) -> [div x 2, 1 + (div y 2)]

main=interact$unlines.map(unwords.map show.f.map read.words).tail.lines

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [x, y] = map read $ words input
        output = case findPointC (x, y) of
            Just (cx, cy) -> unwords $ map show [cx, cy]
            Nothing -> "-1 -1"

findPointC :: (Integer, Integer) -> Maybe (Integer, Integer)
findPointC (x, y)
    | odd (abs(x) + abs(y)) = Nothing
    | otherwise = Just (x `div` 2, (y + 1) `div` 2)

import Control.Monad (replicateM)

main = do
  x <- getLine
  let nLines :: Int
      nLines = read x
  lines <- replicateM nLines getLine
  let res = map solve lines
  putStr $ unlines res

solve line = do
  let arr = [read x :: Int | x <- words line]
  let (x : y : _) = arr
  unwords $ map show [floor $ fromIntegral x / 2, floor $ fromIntegral (y + 1) / 2]

import Control.Monad (replicateM)

main = do
  x <- getLine
  let nLines :: Int
      nLines = read x
  lines <- replicateM nLines getLine
  let res = map solve lines
  putStr $ unlines res

solve line = do
  let arr = [read x :: Int | x <- words line]
  let (x : y : _) = arr
  unwords $ map show [fromIntegral x / 2, fromIntegral y / 2]


import Data.List
import GHC.Exts

main = interact solve

solve str =
    let wd = lines str
        crosswords = sort [makeCrossword p | p <- permutations wd, good p]
    in if null crosswords
       then "Impossible\n"
       else unlines (head  crosswords) ++ "\n"

good p = head (p!!0) == head (p!!1) &&
         last (p!!0) == head (p!!2) &&
         last (p!!1) == head (p!!3) &&
         last (p!!3) == head (p!!4) &&
         last (p!!2) == head (p!!5) &&
         last (p!!5) == last (p!!4) &&
         l!!1 > 2 && l!!0 > 2 && l!!4 > 2 && l!!5 > 2 &&
         l!!3 == l!!0 + l!!5 - 1 &&
         l!!2 == l!!1 + l!!4 - 1 &&
         p!!3!!(l!!0 - 1) == p!!2!!(l!!1 - 1)
      where
         l = map length p

makeCrossword p = (p!!0 ++ right):
        map first (zip (init . tail $ p!!1) (init . tail $ p!!2)) ++
        [p!!3] ++
        map second (zip (init . drop (length (p!!1)) $ p!!2) (init . tail $ p!!4)) ++
        [left ++ p!!5]
    where first (a, b) = a:tail left ++ b:right
          second (a, b) = left ++ a:tail right ++ [b]
          right = replicate ( length (p!!5) - 1 ) '.'
          left = replicate ( length (p!!0) - 1 ) '.'

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

main :: IO ()
main = do
    xs <- replicateM 6 getLine
    --mapM_ print . filter valid . perms $ xs
    let sols = sortOn snd . filter (valid . fst) . map (id &&& crossword) . perms $ xs
    putStrLn $ if null sols then "Impossible" else snd . head $ sols

perms :: Eq a => [a] -> [[a]]
perms [] = [[]]
perms xs = [x:y | x <- xs, y<- perms (delete x xs)]

crossword :: [String] -> String
crossword [a,b,c,d,e,f] =
    unlines [[as!(i, j)|i<-[1..length e]]| j<-[1..length b]]
    where
        as :: Array (Int, Int) Char -- (x, y)
        as = accumArray (const id) '.' ((1,1), (length e, length b))
            $  zip [(i,1)|i<-[1..]] a
            ++ zip [(length a, i)|i<-[1..]] b
            ++ zip [(i,length b)|i<-[length a..]] c
            ++ zip [(length e,i)|i<-[length f..]] d
            ++ zip [(i,length f)|i<-[1..]] e
            ++ zip [(1,i)|i<-[1..]] f
crossword _ = ""

valid :: [String] -> Bool
valid [a, b, c, d, e, f] =
    last a == head b
    && last b == head c
    && last c == last d
    && last e == head d
    && last f == head e
    && head a == head f
    && length e == length a + length c - 1
    && length b == length d + length f - 1
    && b !! (length f - 1) == e !! (length a - 1)
valid _ = False

import Data.List

main = interact (unlines.s.take 6.lines)
s ls = if null cr then ["Impossible"] else minimum cr where
    cr = filter (/=[]) $ map cross $ permutations (zip ls (map length ls))

cross hls =
    if (l!!0+l!!2-1)==(l!!1) && (l!!3+l!!5-1)==(l!!4) &&
       head (h!!0)==head (h!!3) && last (h!!0)==head (h!!4) &&
       head (h!!1)==last (h!!3) && ((h!!1)!!(l!!0-1))==((h!!4)!!(l!!3-1)) && last (h!!1)==head (h!!5) &&
       head (h!!2)==last (h!!4) && last (h!!2)==last (h!!5)
    then make (h, l)
    else []
    where
        h = map fst hls
        l = map snd hls

make (h, l) = (map (++rm) ((h!!0):v1)) ++ [h!!1] ++ (map (lm++) (v2++[h!!2]))
    where
        v1 = zipWith (\a b -> (a:ls)++[b]) ((init.tail)(h!!3)) ((take (l!!3-2).tail)(h!!4))
        v2 = zipWith (\a b -> (a:rs)++[b]) ((init.drop (l!!3))(h!!4)) ((init.tail)(h!!5))
        rm = replicate ((l!!2)-1) '.'
        rs = tail rm
        lm = replicate ((l!!0)-1) '.'
        ls = tail lm

import Data.List
import GHC.Exts

main = interact solve

solve str =
    let wd = lines str
        crosswords = sort [makeCrossword p | p <- permutations wd, good p]
    in if null crosswords
       then "Impossible\n"
       else unlines (head  crosswords) ++ "\n"

good p = head (p!!0) == head (p!!1) &&
         last (p!!0) == head (p!!2) &&
         last (p!!1) == head (p!!3) &&
         last (p!!3) == head (p!!4) &&
         last (p!!2) == head (p!!5) &&
         last (p!!5) == last (p!!4) &&
         l!!1 > 2 && l!!0 > 2 && l!!4 > 2 && l!!5 > 2 &&
         l!!3 == l!!0 + l!!5 - 1 &&
         l!!2 == l!!1 + l!!4 - 1 &&
         p!!3!!(l!!0 - 1) == p!!2!!(l!!1 - 1)
      where
         l = map length p

makeCrossword p = (p!!0 ++ right):
        map first (zip (init . tail $ p!!1) (init . tail $ p!!2)) ++
        [p!!3] ++
        map second (zip (tail . drop (length (p!!1)) $ p!!2) (init . tail $ p!!4)) ++
        [left ++ p!!5]
    where first (a, b) = a:tail left ++ b:right
          second (a, b) = left ++ a:tail right ++ [b]
          right = replicate ( length (p!!5) - 1 ) '.'
          left = replicate ( length (p!!0) - 1 ) '.'

import Data.List
import GHC.Exts

main = interact solve

solve str =
    let wd = lines str
        crosswords = sort [makeCrossword p | p <- permutations wd, good p]
    in if null crosswords
       then "Impossible"
       else unlines . head $ crosswords

good p = head (p!!0) == head (p!!1) &&
         last (p!!0) == head (p!!2) &&
         last (p!!1) == head (p!!3) &&
         last (p!!3) == head (p!!4) &&
         last (p!!2) == head (p!!5) &&
         last (p!!5) == last (p!!4) &&
         l!!1 > 2 && l!!0 > 2 && l!!4 > 2 && l!!5 > 2 &&
         l!!3 == l!!0 + l!!5 - 1 &&
         l!!2 == l!!1 + l!!4 - 1 &&
         p!!3!!(l!!0 - 1) == p!!2!!(l!!1 - 1)
      where
         l = map length p

makeCrossword p = (p!!0 ++ right):
        map first (zip (init . tail $ p!!1) (init . tail $ p!!2)) ++
        [p!!3] ++
        map second (zip (tail . drop (length (p!!1)) $ p!!2) (init . tail $ p!!4)) ++
        [left ++ p!!5]
    where first (a, b) = a:tail left ++ b:right
          second (a, b) = left ++ a:tail right ++ [b]
          right = replicate ( length (p!!5) - 1 ) '.'
          left = replicate ( length (p!!0) - 1 ) '.'


import Data.Array.IArray
import Text.Printf

intersect :: (Integer, Integer) -> (Integer, Integer) -> Integer
intersect (a, b) (c, d) = max 0 ans
	where ans = min b d - max a c

ones :: [(Integer, Integer)]
ones = [(10^x, 2*10^x) | x <- [0..19]]

prob1 :: (Integer, Integer) -> Double
prob1 (a,b) = count1 / total
    where count1 = fromIntegral $ sum $ map (intersect (a, b+1)) ones
          total  = fromIntegral (b - a + 1)

dp :: Array Int Double -> Int -> Double
dp probs k = f' n k
    where
        n = length $ indices probs

        arr :: Array (Int,Int) Double
        arr = listArray ((0, 0), (n, k)) $
               [f n' k' | n' <- [0..n], k' <- [0..k]]
        f' = curry (arr !)

        f :: Int -> Int -> Double
        f n' k'
         | n' == 0 && k' == 0   = 1
         | n' == 0              = 0
         | otherwise =
               p1     * f' (n'-1) (max (k'-1) 0) +
               (1-p1) * f' (n'-1) k'

               where p1 = probs ! n'

readInterval :: Int -> IO [(Integer, Integer)]
readInterval 0 = return $ []
readInterval l = do
    [a, b] <- (map read . words) `fmap` getLine
    ret <- readInterval (l-1)
    return $ (a,b) : ret

main = do
    n <- read `fmap` getLine
    intervals <- readInterval n
    k <- read `fmap` getLine
    let k' = ceiling $ fromIntegral n * k / 100

    let probs = listArray (1,n) [prob1 x | x <- intervals]

    let ans = dp probs k'

    printf "%.12f\n" ans

import Control.Monad

getA = fmap (map read . words) getLine

cnt n = let (m:t) = reverse $ takeWhile (<=n) $ iterate (*10) 1 in sum t + min m (n - m)

gao [] = [1.0]
gao ([l,r]:t) = zipWith (\i j -> p * i + (1 - p) * j) (0:a) (a++[0]) where
	u = r + 1
	p = fromInteger (cnt u - cnt l) / fromInteger (u - l)
	a = gao t

main = do
	[n] <- getA
	a <- replicateM (fromInteger n) getA
	[k] <- getA
	putStrLn $ show $ sum $ drop (fromInteger $ div (n * k + 99) 100) $ gao a

import Data.Array
import Control.Applicative
import Control.Monad

-- import Control.DeepSeq

-- import Test.QuickCheck

-- import Debug.Trace

-- debug = flip trace

-- testnBWO :: Gen Bool
-- testnBWO = do
--   l <- choose (1, 10^18)
--   u <- choose (l, 10^18)
--   let nBWO' = length . filter beginWithOne
--   return $ nBWO l u == fi (nBWO' [l..u])

-- testnBWO2 :: Gen Prop
-- testnBWO2 = do
--   l <- choose (1, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print l) $ nBWO l l == fi (nBWO' [l])

-- testnBWO3 :: Gen Prop
-- testnBWO3 = do
--   l <- choose (1, 10)
--   u <- choose (l, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print (l, u)) $ nBWO l u == fi (nBWO' [l..u])

-- testLeast :: Gen Bool
-- testLeast = do
--   n <- choose (1, 100) :: Gen Int
--   p <- choose (1, 100) :: Gen Int
--   return $ ceiling (fi n * fi p / 100.0) == ceiling (fi n * fi p / 100.0 - eps)

-- test1 :: Gen Bool
-- test1 = do
--   n <- choose (1, 1000)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [1,1]
--   return $ prob n input p == 1

-- test0 :: Gen Bool
-- test0 = do
--   n <- choose (1, 1000)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [2,2]
--   return $ prob n input p == 0

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO 1 u
  | u < 10 = 1
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 10 ^ li
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li..ui - 1])
  in  middl `seq` tailP - headM + middl
      -- `debug` (show l ++ " " ++ show u ++ " " ++ show headM ++ " " ++ show middl ++ " " ++ show tailP)

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  arrOld `seq`
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ ind `seq` prob `seq` (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

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

getInts :: IO [Integer]
getInts = map read . words <$> getLine

prob n lines p =
  let least = ceiling (fi n * fi p / 100.0 - eps)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
  in prob

main = do
  -- verboseCheck test1
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  print (prob n lines p)

import Data.Array
import Control.Applicative
import Control.Monad

-- import Test.QuickCheck

-- import Debug.Trace

-- debug = flip trace

-- testnBWO :: Gen Bool
-- testnBWO = do
--   l <- choose (1, 1^18)
--   u <- choose (l, 1^18)
--   let nBWO' = length . filter beginWithOne
--   return $ nBWO l u == fi (nBWO' [l..u])

-- testnBWO2 :: Gen Prop
-- testnBWO2 = do
--   l <- choose (1, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print l) $ nBWO l l == fi (nBWO' [l])

-- testnBWO3 :: Gen Prop
-- testnBWO3 = do
--   l <- choose (1, 10)
--   u <- choose (l, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print (l, u)) $ nBWO l u == fi (nBWO' [l..u])

-- testLeast :: Gen Bool
-- testLeast = do
--   n <- choose (1, 100) :: Gen Int
--   p <- choose (1, 100) :: Gen Int
--   return $ ceiling (fi n * fi p / 100.0) == ceiling (fi n * fi p / 100.0 - eps)

-- test1 :: Gen Bool
-- test1 = do
--   n <- choose (1, 100)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [1,1]
--   return $ prob n input p == 1

-- test0 :: Gen Bool
-- test0 = do
--   n <- choose (1, 100)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [2,2]
--   return $ prob n input p == 0

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO 1 u
  | u < 10 = 1
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 10 ^ li
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li..ui - 1])
  in  middl `seq` tailP - headM + middl
      -- `debug` (show l ++ " " ++ show u ++ " " ++ show headM ++ " " ++ show middl ++ " " ++ show tailP)

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

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

getInts :: IO [Integer]
getInts = map read . words <$> getLine

prob n lines p =
  let least = ceiling (fi n * fi p / 100.0 - eps)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
  in prob

main = do
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  print (prob n lines p)

import Data.Array
import Control.Applicative
import Control.Monad

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 0
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li + 1..ui - 1])
  in  middl `seq` tailP - headM + middl

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

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

getInts :: IO [Integer]
getInts = map read . words <$> getLine

main = do
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  let least = ceiling (fi n * fi p / 100.0)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
      difference [n, m] = abs (n - m)
      full  = sum $ map difference lines
  print prob

import Data.Array
import Control.Applicative
import Control.Monad

-- import Test.QuickCheck

-- testnBWO :: Gen Bool
-- testnBWO = do
--   l <- choose (1, 1^18)
--   u <- choose (l, 1^18)
--   let nBWO' = length . filter beginWithOne
--   return $ nBWO l u == fi (nBWO' [l..u])

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 0
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li + 1..ui - 1])
  in  middl `seq` tailP - headM + middl

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

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

getInts :: IO [Integer]
getInts = map read . words <$> getLine

main = do
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  let least = ceiling (fi n * fi p / 100.0 - eps)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
      difference [n, m] = abs (n - m)
      full  = sum $ map difference lines
  print prob


{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust, fromMaybe, isJust)

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

type Input = [Int]
type Output = Int

input :: Scanner Input
input = numberOf int

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

solve :: Input -> Output
solve xs
  | isJust a && isJust b = min (fromJust a) (fromJust b)
  | isJust a = fromJust a
  | otherwise = fromMaybe (-1) b
  where
    n = length xs
    ixs = [i | (v, i) <- zip xs [0..n], odd v]
    a = compute ixs [0, 2 .. n - 1]
    b = compute ixs [1, 3 .. n - 1]

compute ixs ts
  | length ixs /= length ts = Nothing
  | otherwise = Just . sum . map abs $ zipWith (-) ixs ts

count :: Eq a => a -> [a] -> Int
count v = length . filter (== v)

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

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

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

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

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

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

(><) = times

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

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

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

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List
import Data.Int

interleave :: [t] -> [t] -> [t]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  replicateM_ t $ do
    [n] <- getInts 1
    a <- getInts n
    let
      eIxs = [i | (i, ai) <- zip [1..] a, even ai]
      oIxs = [i | (i, ai) <- zip [1..] a, odd ai]
      efst = interleave eIxs oIxs
      ofst = interleave oIxs eIxs
      opts = case  length eIxs - length oIxs  of
        -1 -> [ofst]
        0 -> [efst, ofst]
        1 -> [efst]
        _ -> []
      cost = foldl' (\x (i, tar) -> x + abs (i - tar)) 0
      ans = if  null opts
        then  0-1
        else  minimum [cost $ zip opt [1..] | opt <- opts] `div` 2
    putInt64s [ans]

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> SIO ()
putInt64s vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< int64Dec
  in  lift $ B.hPutBuilder stdout $ case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.int64Dec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List

interleave :: [t] -> [t] -> [t]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  replicateM_ t $ do
    [n] <- getInts 1
    a <- getInts n
    let
      eIxs = [i | (i, ai) <- zip [1..] a, even ai]
      oIxs = [i | (i, ai) <- zip [1..] a, odd ai]
      efst = interleave eIxs oIxs
      ofst = interleave oIxs eIxs
      opts = case  length eIxs - length oIxs  of
        -1 -> [ofst]
        0 -> [efst, ofst]
        1 -> [efst]
        _ -> []
      cost = foldl' (\x (i, tar) -> x + abs (i - tar)) 0
      ans = if  null opts
        then  0-1
        else  minimum [cost $ zip opt [1..] | opt <- opts] `div` 2
    putInts [ans]

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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


{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Array.Unboxed
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve n m ps (l, r, x) = (x - l) == (length $ filter (< (ps!x)) [ps!i | i <- [l..r]])

main = do
  n:m:_ <- readInts <$> B.getLine
  ps :: UArray Int Int <- listArray (1, n) . readInts <$> B.getLine
  lrxs <- map (\(l:r:x:_) -> (l, r, x)) <$> replicateM m (readInts <$> B.getLine)
  putStrLn $ unlines . map (\lrx -> if solve n m ps lrx then "Yes" else "No") $ lrxs

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

readInt :: B.ByteString -> Int
readInt = fst . fromJust . B.readInt

main :: IO ()
main = do
  [n, m] <- liftM (map readInt . B.words) B.getLine
  p      <- liftM (map readInt . take n . B.words) B.getLine :: IO [Int]
  let process :: Int -> IO ()
      process 0 = return ()
      process m = do
        [l, r, x] <- liftM (map readInt . B.words) B.getLine
        let slice = filter (< p !! (x - 1)) $ (take (r - l + 1) . drop (l - 1)) p
        putStrLn $ if length slice == (x - l) then "Yes" else "No"
        process (m - 1)
  process m

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

readInt :: B.ByteString -> Int
readInt = fst . fromJust . B.readInt

solve :: Int -> Int -> [Int] -> IO ()
solve 0 _ _ = return ()
solve m n a = do
    [l, r, x] <- liftM (map readInt . B.words) B.getLine
    let sp = filter (< (a !! (x - 1))) (take (r - l + 1) $ drop (l - 1) a)
    putStrLn $ if length sp /= x - l then "No" else "Yes"
    solve (m - 1) n a

main :: IO ()
main = do
    [n, m] <- liftM (map readInt . B.words) B.getLine
    a <- liftM (map readInt . take n . B.words) B.getLine
    -- return ()
--     s <- B.getLine
--     p <- B.getLine
--     let [n, m] = map read (words s) :: [Int]
--     let a = map read (words p) :: [Int]
    solve m n a

{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Array.Unboxed
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve n m ps (l, r, x)
  | odd (r - l + 1) = (==) <$> fst <*> snd $ foldl' (\(s, b) a -> case compare (ps!x) a of
      LT -> (s + 1, b)
      GT -> (s, b + 1)
      otherwise -> (s, b)) (0, 0) [ps!i | i <- [l..r]]
  | otherwise = False

main = do
  n:m:_ <- readInts <$> B.getLine
  ps :: UArray Int Int <- listArray (1, n) . readInts <$> B.getLine
  lrxs <- map (\(l:r:x:_) -> (l, r, x)) <$> replicateM m (readInts <$> B.getLine)
  putStrLn $ unlines . map (\lrx -> if solve n m ps lrx then "Yes" else "No") $ lrxs


module Main where

import Control.Monad (replicateM_, replicateM)
import Data.Maybe (maybe, catMaybes)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B

solve :: [(Int, Int)] -> Int
solve rs = 2 * (maximum (map (snd . rotate) rs) +
                sum (map (fst . rotate) rs))
  where rotate (x, y)
          | x <= y    = (x, y)
          | otherwise = (y, x)

readSlice :: IO (Maybe (Int, Int))
readSlice = do
  vs <- map readInt . B.words <$> B.getLine
  case vs of [x, y] -> pure (Just (x, y))
             _      -> pure Nothing

handleProblem :: IO ()
handleProblem = do
  numberSlices <- readInt <$> B.getLine
  slices <- catMaybes <$> replicateM numberSlices readSlice
  print $ solve slices

main :: IO ()
main = do
  numberProblems <- readInt <$> B.getLine
  replicateM_ numberProblems handleProblem

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

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

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

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

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

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

solve xs = 2 * (maxv + mins)
  where maxv = maximum $ map (\(a, b) -> max a b) xs
        mins = sum $ map (\(a, b) -> min a b) xs

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n] <- getInts
    xs <- forM [1..n] $ \_ -> do
      [a, b] <- getInts
      return (a, b)
    print $ solve xs