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

main = do
	n <- readLn
	ss <- replicateM n getLine
	print $ solve " " ss

--solve :: String -> [String] -> Int
solve prev [] = 0
solve prev (s:ss) = solve s ss + if prev == s then 0 else 1

module Main
    where

import System.IO

--2215

main = do
    first <- getLine
    groups <- solve "" 0 $ read first
    print groups
    where
        solve last c 0 = do
            return c
        solve last c n = do
            magnet <- getLine
            solve magnet (if magnet == last then c else c + 1) (n - 1)

import Control.Monad

sol :: [String] -> String -> Int
sol [] _ = 0
sol mags last_s = if (head mags) == last_s
  then (sol (tail mags) last_s)
  else 1 + (sol (tail mags) (head mags))

main :: IO ()
main = do
  n_s <- getLine
  let n = read n_s :: Int
  inputs <- replicateM n getLine :: IO [[Char]]
  print(1 + (sol inputs (head inputs)))

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

main = do
	n <- readLn
	res <- length . group <$> replicateM n getLine
	print res

import Control.Monad
import Control.Applicative

groups [x] = 0
groups (x:y:xs) = (if x == y then 1 else 0) + groups (y:xs)

genAns [] = 0
genAns xs = 1 + (groups xs)

main = do
  n <- readLn :: IO Int
  gs <- concat <$> replicateM n getLine
  print $ genAns gs

import Data.List (group)

numGroups :: Eq a => [a] -> Int
numGroups = length . group

main :: IO ()
main = do
  n <- getLine
  magnets <- sequence $ replicate (read n) getLine
  print $ numGroups magnets

module Main (main)
    where

import Data.List (foldl')
import Control.Monad (replicateM)

addMag :: [[String]] -> String -> [[String]]
addMag [] y = [[y]]
addMag xt@(x:xs) y
    | head x == y = (y:x):xs
    | otherwise   = [y]:xt

main :: IO ()
main = print . length . foldl' addMag [] =<< flip replicateM getLine =<< readLn

solve [] = 0
solve (m1:[]) = 0
solve (m1:m) | m1==head m = 1+ solve m
             | otherwise = solve m

main = do
	n<-getLine
	d<-getContents
	let b=concat $ lines d
	putStrLn $ show $ (solve b + 1)

import Control.Applicative
main :: IO ()
main = do
    n <- read <$> getLine
    solve n 0 >>= print

solve :: Int -> Int -> IO Int
solve 0 _        = return 0
solve n previous = do
    current <- read <$> getLine
    if current == previous
        then
            solve (n-1) previous
        else
            solve (n-1) current >>= return . (+1)

import Data.List (group)
main = getLine >> getContents >>= return . length . group . words >>= print

import Data.List
main = getContents >>= print . length . group . tail . lines

import Control.Monad

-- Snippet: partitionWith
partitionWith1 eq (a1 : an)
    | not (null an) && eq a1 (head an) = (a1 : r, aLeft)
    | otherwise = ([a1], an)
    where (r, aLeft) = partitionWith1 eq an

partitionWith eq a
    | null a = []
    | otherwise = r : partitionWith eq aLeft
    where (r, aLeft) = partitionWith1 eq a

main = do
    n <- readLn
    a <- replicateM n getLine
    putStrLn $ show $ length $ partitionWith (==) a

readData :: Int -> IO [Int]
readData 0 = return []
readData n = do
        x <- readLn :: IO Int
        xs <- readData (n-1)
        return (x:xs)

countIsles n (x1:[]) = n
countIsles n (x1:x2:xs)
        | x1==x2 = countIsles n (x2:xs)
        | otherwise = countIsles (n+1) (x2:xs)

main = do
        n <- readLn :: IO Int
        mags <- readData n
        print $ countIsles 1 mags

main = do
  getLine
  ls <- fmap lines getContents
  let c = length $ filter (== True) $ zipWith (\a b -> last a == head b) ls (tail ls)
  print $ c + 1

solve :: [Int] -> Int
solve [] = 0
solve (a:x) = 1 + (solve $ (dropWhile (a==)) x)
main = interact $ show . solve . map read . tail . lines

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  getLine >>= \x -> interact $ solve.take (read x) . lines
solve :: [String]->String
solve xss = show $ fst $ foldr solv1 (0,"") xss
  where solv1 a (b1,b2) = if a /= b2 then (1+b1, a) else (b1,b2)

import Data.List (group)

main :: IO ()
main  =  getContents >>= print . length . group . tail . words

module Main where
import Control.Monad
main :: IO ()
main = do
    input <- getLine
    inputs <- replicateM (read input) getLine
    let second_chars = map tail inputs
        magnets = map read second_chars
        (ans,_) = foldl (\(acc,curr) new -> (if curr == new then acc else acc+1, new)) (0,2) magnets
    print ans

import Control.Applicative
import Data.List (group)
import qualified Data.ByteString.Lazy.Char8 as C

main = do
  n <- getLine
  xs <- C.lines <$> C.getContents
  print . length . group $ xs

import Control.Applicative
import Control.Monad
import Data.List (group)

main = do
  n <- read <$> getLine
  xs <- replicateM n getLine
  print . length . group $ xs

import Control.Monad

main = getLine >>= getMags . read >>= putStrLn . show . count

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

count :: [String] -> Int
count (x:xs) = snd ans
  where ans = foldl (\(lst, res) curr -> if lst == curr
                                         then (curr, res)
                                         else (curr, res + 1)) (x, 1) xs

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function

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

main :: IO ()
main = do
    n <- readInt <$> getLine
    magnets <- replicateM n getLine
    printf "%d" . length . group $ magnets

import Prelude
import Data.String
import Text.Printf
import Control.Monad

readNums:: Int -> [Int] -> IO [Int]
readNums 0 numbers = return numbers
readNums n numbers = do
                        c <- getChar
                        if (c /= ' ')
                            then
                                readNums (n - 1) ((read [c] :: Int):numbers)
                            else
                                readNums n numbers

solver:: Int -> Int -> Int -> IO Int
solver 0 count _ = return count
solver n count lastFlag = do
                            str <- getLine
                            let newFlag = if (str == "01")
                                            then 1
                                            else 2
                            if (lastFlag == newFlag)
                                then solver (n - 1) count newFlag
                                else solver (n - 1) (count + 1) newFlag
main = do
        str <- getLine
        let n = read str :: Int
        str <- getLine
        let initFlag = if (str == "01")
                        then 1
                        else 2
        numbers <- solver (n - 1) 1 initFlag
        print numbers
        return ()

import Control.Monad
import Data.List

countIslands :: [Int] -> Int
countIslands [] = 0
countIslands (x:xs) = 1 + (countIslands $ dropWhile (== x) xs)

main = do
    n <- read `fmap` getLine
    a <- replicateM n getLine
    print $ countIslands $ map read a

import Control.Monad
import Data.List

countIslands :: [String] -> Integer
countIslands [] = 0
countIslands (x:xs) = 1 + (countIslands $ dropWhile (== x) xs)

main = do
    n <- read `fmap` getLine
    a <- replicateM n getLine
    print $ countIslands a

import Control.Monad
import Data.List

countIslands :: [Integer] -> Integer
countIslands [] = 0
countIslands (x:xs) = 1 + (countIslands $ dropWhile (== x) xs)

main = do
    n <- read `fmap` getLine
    a <- replicateM n getLine
    print $ countIslands $ map read a

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

solve :: Eq a => [a] -> Int
solve = length . group

main :: IO ()
main = do
        _ <- B.getLine
        a <- fmap B.lines B.getContents
        print $ solve a

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

solve :: Eq a => [a] -> Int
solve = length . group

main :: IO ()
main = do
        n <- fmap read getLine
        a <- replicateM n B.getLine
        print $ solve a

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

solve :: Eq a => [a] -> Int
solve = length . group

main :: IO ()
main = do
        _ <- getLine
        a <- fmap lines getContents
        print $ solve a

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

solve :: Eq a => [a] -> Int
solve = length . group

main :: IO ()
main = do
        n <- fmap read getLine
        a <- replicateM n getLine
        print $ solve a

-- Michael V. Antosha  <Michael.Antosha@gmail.com>
-- 2016
-- http://mivael.in.ua

data MagnetType = Type01 | Type10

main = do
  interact $ show . s . words
    where
      s (numStr:restStr) = solve (read numStr) restStr

mtype "10" = Type10
mtype "01" = Type01

solve :: Integer -> [String] -> Integer
solve n (magnet:rest) = solve' (n-1) 1 (mtype magnet) rest
solve _ _ = error "Bad input."

solve' 0 sum _ [] = sum
solve' n sum lastType (magnet:rest) = recur
  where
    recur = solve' (n-1) (sum + s) thisType rest
    thisType = mtype magnet
    s = cntNewGroup lastType thisType
    cntNewGroup Type01 Type01 = 0
    cntNewGroup Type10 Type10 = 0
    cntNewGroup _      _      = 1
solve' _ _ _ _ = error "Unexpected."

-- Michael V. Antosha  <Michael.Antosha@gmail.com>
-- 2016
-- http://mivael.in.ua

data MagnetType = Type01 | Type10

main = do
  interact $ show . s . words
    where
      s (numStr:restStr) = solve (read numStr) restStr

mtype "10" = Type10
mtype "01" = Type01

solve :: Int -> [String] -> Int
solve n (magnet:rest) = solve' (n-1) 1 (mtype magnet) rest
solve _ _ = error "Bad input."

solve' 0 sum _ [] = sum
solve' n sum lastType (magnet:rest) = recur
  where
    recur = solve' (n-1) (sum + s) thisType rest
    thisType = mtype magnet
    s = cntNewGroup lastType thisType
    cntNewGroup Type01 Type01 = 0
    cntNewGroup Type10 Type10 = 0
    cntNewGroup _      _      = 1
solve' _ _ _ _ = error "Unexpected."

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

main=do
    getLine
    show <$> length <$> group <$> lines <$> getContents   >>=putStrLn

import Data.List (group)

main :: IO ()
main = getContents >>= print . length . group . tail . lines

-- import Debug.Trace
-- import System.IO.Unsafe
-- import Text.Printf
import System.IO
import Control.Monad
import Data.List

glwr = fmap (map read . words) getLine

main = do
  hSetBuffering stdout NoBuffering
  solve

solve :: IO ()
solve = do
  n:_ <- glwr
  magnets <- forM [1..n] $ const getLine
  print $ magnet n magnets

magnet :: Int -> [String] -> Int
magnet n = fst . foldr ko (1, '2')

ko :: String -> (Int, Char) -> (Int, Char)
ko (m:ms) (acc, prev)
  | last ms == prev = (acc+1, m)
  | 0 < 1 = (acc, m)

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

import Data.List

main :: IO ()
main = getContents >>= print . length . group . tail . lines

import Data.List
solve :: [Int] -> Int
solve = length . group
main = interact $ show . solve . map read . tail . words

import Data.List
main = interact $ show . length . group . tail . words

import Data.List
main = interact $ show . length . group . tail . lines

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List
import Data.Ord

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

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getContents
  print . length $ group xs

loop 0 c p = putStrLn $ show c

loop n c p = do
    q <- getLine
    loop (n-1) (if p == q then c else c+1) q

main = do
    n <- getLine
    loop (read n :: Int) 0 ""

main = interact $ show.calc.tail.lines

calc (x:y:xs) = ( calc $ y:xs ) + ( if x == y then 0 else 1 )
calc _ = 1

solve :: [String] -> String -> Int -> Int
solve [] _ grp = grp
solve (x : xs) prev grp | x == prev = solve xs x grp
                        | otherwise = solve xs x grp + 1

prepare :: [String] -> Int
prepare lst = solve lst (head lst) 1

main :: IO ()
main = interact $ show . prepare . tail . words

magnetGroups ts = 1 + (length $ filter (uncurry (/=)) $ zip ts (tail ts))
readNLines (ln:ls) = take (read ln) ls
main = interact $ (++ "\n") . show . magnetGroups . readNLines . lines

module Main where

import Control.Applicative

main = do
    n <- read <$> getLine
    l1 <- read <$> getLine
    res <- solve (n-1) l1 1
    print res

solve :: Int -> Int -> Int -> IO Int
solve 0 _ m = return m
solve n c m = do
    li <- read <$> getLine
    if li == c
    then solve (n-1) c m
    else solve (n-1) li (m+1)

import Control.Applicative
import Data.List
import Data.Maybe

main= do
	getLine
	x<-   words <$> getContents
	print $ length $ group x

import           Control.Monad
import           Data.List

unfolder :: [String] -> Maybe (Bool, [String])
unfolder (a:b:as) = Just (a == b, b:as)
unfolder _ = Nothing

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    print =<< (1+) . sum . map (fromEnum . not) . unfoldr unfolder <$> replicateM n getLine

import Data.List
import Control.Monad
main = getLine >>= flip replicateM getLine.read >>= putStrLn.show.length.group

--ghc 7.10

import Data.List

countMagnets :: (Eq a) => [a] -> Int
countMagnets = length . group

main = do
    nStr <- getLine
    aStr <- getContents
    let a = map read . words $ aStr :: [Int]
    print $ countMagnets a

import Data.List

main = do
    m<-getLine
    n<-getContents
    print.length.group $ lines n

import Control.Monad

process :: [String] -> Int
process source = snd (foldr (\z (x, y) -> (z, if x == z then y else y+1) ) (" ", 0) source)

main :: IO()
main = do
    count <- readLn
    inputs <- replicateM count getLine
    putStrLn (show $ process inputs)

import Data.List
addIfRepell l r
	| (snd l) !! 1 == (snd r) !! 0 = ( (+1) $ fst l, snd r)
	| otherwise = (fst l, snd r)
cal ls =
	let mags = map (\m -> (1,m)) $ tail ls
	in fst $ foldl1 addIfRepell mags

main = interact (show . cal . lines)

data Magnet = Magnet Char Char deriving (Show)

readmagnet :: String -> Magnet
readmagnet (x:y:_) = Magnet x y

ans :: [Magnet] -> Int -> Int
ans f@(x : y : _) z = if ((check x y) == True) then (ans (tail f) (z + 1)) else (ans (tail f) z)
	where
	check :: Magnet -> Magnet -> Bool
	check (Magnet x1 y1) (Magnet x2 y2) = if (y1 == x2) then True else False
ans _ z = z

main = do
	n <- getLine
	magnets <- getContents
	putStr $ show $ (ans (map readmagnet (lines magnets) :: [Magnet]) 1)

import Control.Monad

sol :: [String] -> String -> Int
sol [] _ = 0
sol mags last_s = if (head mags) == last_s
  then 1 + (sol (tail mags) last_s)
  else (sol (tail mags) (head mags))

main :: IO ()
main = do
  n_s <- getLine
  let n = read n_s :: Int
  inputs <- replicateM n getLine :: IO [[Char]]
  print(sol (tail inputs) (head inputs))

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

main = do
	n <- readLn
	ss <- group . sort <$> replicateM n getLine
	let
		n1 = length $ ss !! 0
		n2 = length $ ss !! 1
	print $ 2 * min n1 n2 + if n1 == n2 then 0 else 1

import Control.Applicative
main :: IO ()
main = do
    n <- read <$> getLine
    solve n 0 >>= print

solve :: Int -> Int -> IO Int
solve 0 _        = return 0
solve n previous = do
    current <- read <$> getLine
    if current == previous
        then
            solve (n-1) previous
        else
            solve (n-1) previous >>= return . (+1)

main = interact $ show.calc.lines

calc (x:y:xs) = ( calc $ y:xs ) + ( if x == y then 0 else 1 )
calc _ = 1

import           Control.Monad
import           Data.List

unfolder :: [String] -> Maybe (Bool, [String])
unfolder (a:b:as) = Just (a == b, b:as)
unfolder _ = Nothing

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    print =<< maximum . (1:) . map((1+) . length) . filter or . group . unfoldr unfolder <$> replicateM n getLine

import Data.List

main = do
    m<-getLine
    n<-getLine
    print.length.group $ lines n

data Magnet = Magnet Char Char deriving (Show)

readmagnet :: String -> Magnet
readmagnet (x:y:_) = Magnet x y

ans :: [Magnet] -> Int -> Int
ans f@(x : y : _) z = if ((check x y) == True) then (ans (tail f) (z + 1)) else (ans (tail f) z)
	where
	check :: Magnet -> Magnet -> Bool
	check (Magnet x1 y1) (Magnet x2 y2) = if (y1 == x2) then False else True
ans _ z = z

main = do
	n <- getLine
	magnets <- getContents
	putStr $ show $ (ans (map readmagnet (lines magnets) :: [Magnet]) 1)


import Array

m = 10

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

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

getArray :: [Int] -> Array Int Integer
getArray xs = accumArray (+) 0 (-m, m) [(x, 1) | x <- xs]

solve :: [Int] -> Integer
solve xs = notZeroPairs + zeroPairs
  where
    array = getArray xs
    notZeroPairs = sum (map (\i -> (array ! i) * (array ! (-i))) [1..m])
    zeroPairs = div (n * (n - 1)) 2
    n = array ! 0

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

main :: IO()
main = do
	getLine
	stringNumbers <- getLine
	let numbers = map read $ words stringNumbers :: [Integer]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs :: Integer
		zeroPairs = fib $ integerLength (filter (== 0) numbers) - 1 where
			fib :: Integer -> Integer
			fib (-1) = 0
			fib n = n + (fib $ n - 1)
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs :: [Integer] -> Integer
		countPairs [] = 0
		countPairs list = integerLength positive * integerLength negative + countPairs others where
			positive = [x | x <- list, x == head list]
			negative = [x | x <- list, x == -head list]
			others   = [x | x <- list, x /= head list, x /= -head list]
	putStrLn $ show n

integerLength :: [Integer] -> Integer
integerLength [] = 0
integerLength (x:xs) = 1 + integerLength xs

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Debug.Trace
import Data.List
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.Unboxed as UB
import Data.Array.ST
import Data.Array
import Data.Char
class IOtyp a where scan' :: String -> a; show' :: a -> String
instance IOtyp Int where scan' = read; show' = show
instance IOtyp Char where scan' (x:_) = x;show' = (:[])
instance IOtyp Float where scan' = read;show' = show
instance IOtyp Double where scan' = read;show' = show
instance IOtyp Integer where scan' = read;show' = show
instance IOtyp String where scan' = id;show' = id
instance (IOtyp a,IOtyp b) => IOtyp (a,b) where scan' = (\(x:y:_) -> (scan' x,scan' y)).words;show' (x,y) = show' x++' ':show' y
instance (IOtyp a,IOtyp b,IOtyp c) => IOtyp (a,b,c) where scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;show' (x,y,z) = show' x++' ':show' y++' ':show' z
foreign import ccall "stdio.h puts" c_puts :: CString -> IO ()
scan :: (IOtyp a) => IO a; scan = getLine>>=return.scan'
scans :: (IOtyp a) => Int -> IO [a]; scans = (flip replicateM) scan
scanlist :: (IOtyp a) => IO [a]; scanlist = getLine>>=return.map scan'.words
scanlists :: (IOtyp a) => Int -> IO [[a]]; scanlists = (flip replicateM) scanlist
puts :: (IOtyp a) => a -> IO (); puts ans = do {str<-newCString $ show' ans;c_puts str;free str}

count c = foldl (\n -> \x -> if x==c then n+1 else n) 0

solve :: [Int] -> Integer
solve l = let ary = array (-10,10) [(i,count i l)|i<-[-10..10]]
              zero = fromIntegral ((ary!0)*((ary!0)-1) `div` 2)
              other = fromIntegral (foldl (\n -> \m -> (ary!m)*(ary!(-m))+n) 0 [1..10])
          in
           zero + other

main = do n <- scan :: IO Int
          l <- scanlist :: IO [Int]
          puts.show $ solve l

import Data.List
import Debug.Trace

main = getContents >>= doit . lines where
     doit [] = putStrLn ""
     doit (n:lis:xs) = do
          print . solve $ words lis
          doit xs

     solve lis = solve' (0 :: Integer)  lis' where
           lis' = group . sort $ map (read :: String -> Integer) lis

length' = toInteger . length

solve' :: (Ord a, Num a) => Integer -> [[a]] -> Integer
solve' n [] = n
solve' n (x:[]) = if (head x) == 0 then n + (length' x) * ((length' x) - 1) `div` (2 :: Integer) else n
solve' n (x1:x2:xs)
             | d > 0 =  solve' n $ x2:xs
             | d < 0 =  solve' n $ init $ x1:x2:xs
             | otherwise = solve' (n + (length' x1) * (length' . last $ x2:xs)) (init $ x2:xs) where
               d = diff (x1:x2:xs)

diff [] = 0
diff xs =  (abs . head . head $ xs) - (abs . last . last $ xs)

main = do
    getLine
    ts <- fmap (map read . words) getLine
    let zs = count 0 ts
    print $ zs * (zs - 1) `div` 2 + (sum $ map (\x -> (count x ts) * (count (-x) ts)) [1..10])
    where
        count x xs = foldl (\acc y -> if x == y then acc + 1 else acc) 0 xs

import Data.ByteString.Char8 as BS (readInt, getLine, split)
import Data.Maybe (fromJust)

main = do
    BS.getLine
    ts <- fmap (map (fst . fromJust . BS.readInt) . BS.split ' ') BS.getLine
    let zs = count 0 ts
    print $ zs * (zs - 1) `div` 2 + (sum $ map (\x -> (count x ts) * (count (-x) ts)) [1..10])
    where
        count x xs = foldl (\acc y -> if x == y then acc + 1 else acc) 0 xs

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

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

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

main = do
  getLine
  xs <- getInts

  let
    cs = accumArray (+) 0 (-10, 10) $ zip xs $ repeat 1 :: UArray Int Int64

  print $ sum [cs!i * cs!(-i) | i <- [1..10]] + cs!0 * (cs!0 - 1) `div` 2

count :: (Eq a, Num b) => a -> [a] -> b
count item lst = count' lst item 0
    where count'     []    _ ret = ret
          count' (x:xs) item ret
            | x == item = count' xs item (ret + 1)
            | otherwise = count' xs item ret

solve :: [Int] -> Integer
solve lst = let zero = count 0 lst                             :: Integer
                pcnt = map (flip count lst) [1..10]            :: [Integer]
                ncnt = map (flip count lst) [(-1),(-2)..(-10)] :: [Integer]
            in (zero * (zero - 1)) `div` 2 +
               (sum $ (map (\(x, y) -> x * y) $ zip pcnt ncnt))

main :: IO ()
main = do nn <- getLine
          tt <- getLine
          let
            n = read nn :: Int
            t = map read $ words tt :: [Int]
          print $ solve t

import qualified Data.ByteString.Char8 as BS

count :: (Eq a, Num b) => a -> [a] -> b
count item = fromIntegral . length . filter (== item)

solve :: [Int] -> Integer
solve lst = let zero = count 0 lst                             :: Integer
                pcnt = map (flip count lst) [1..10]            :: [Integer]
                ncnt = map (flip count lst) [(-1),(-2)..(-10)] :: [Integer]
            in (zero * (zero - 1)) `div` 2 +
               (sum $ (map (\(x, y) -> x * y) $ zip pcnt ncnt))

main :: IO ()
main = do nn <- BS.getLine
          tt <- BS.getLine
          let
            n = toNumber $ BS.readInt nn
            t = map (toNumber . BS.readInt) (BS.words tt)
          print $ solve t

toNumber :: Num a => Maybe (a, BS.ByteString) -> a
toNumber (Just (x, _)) = x
toNumber Nothing       = 0

count :: (Eq a, Num b) => a -> [a] -> b
count item = fromIntegral . length . filter (== item)

solve :: [Int] -> Integer
solve lst = let zero = count 0 lst                             :: Integer
                pcnt = map (flip count lst) [1..10]            :: [Integer]
                ncnt = map (flip count lst) [(-1),(-2)..(-10)] :: [Integer]
            in (zero * (zero - 1)) `div` 2 +
               (sum $ (map (\(x, y) -> x * y) $ zip pcnt ncnt))

main :: IO ()
main = do nn <- getLine
          tt <- getLine
          let
            n = read nn :: Int
            t = map read $ words tt :: [Int]
          print $ solve t

import Data.List

main = interact $ show . (count (repeat 0) 0). map (10+) . map read . words . head . tail . lines
	where
		count list n [] = n
		count list n (x:xs) = count (plusIndex list x) (if (list !! (inverse x) == 0) then n else (n+(list !! (inverse x)))) xs
		inverse n = 20 - n
		plusIndex (x:xs) 0 = x+1: xs
		plusIndex (x:xs) n = x: plusIndex xs (n-1)

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

main = BS.interact $ BS.pack . show . sumMatches . count
		. map readInt' . BS.words . head . tail . BS.lines
	where
		count ns = accumArray (+) 0 (-10,10) [(n,1)| n<-ns]
		sumMatches arr = sum [arr ! x * arr ! (-x)| x<-[1..10]] + (arr ! 0) * (arr ! 0 - 1) `div` 2
		readInt' bs = fst $ fromJust $ BS.readInt bs

import Array

main = interact $ show . sumMatches . count . map read . words . head . tail . lines
	where
		count ns = accumArray (+) 0 (-10,10) [(n,1)| n<-ns]
		sumMatches arr = sum [arr ! x * arr ! (-x)| x<-[1..10]] + (arr ! 0) * (arr ! 0 - 1) `div` 2

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

main = do
  n <- readLn :: IO Int
  a <- getList
  let zeroList = count 0 a
      otherList = sum $ map (\x -> (count x a) * (count (-x) a)) [1..10]
  print $ zeroList * (zeroList - 1) `div` 2 + otherList
  where
    count element xs = foldl' (\x e -> if e == element then x+1 else x) 0 xs
    getList = fmap (map read . words) getLine :: IO [Int]

import Data.List
import Data.Int
main = print . solve . map read . tail . words =<< getContents
solve ts = nzs * (nzs-1) `div` 2 + sum (merge (group ps) (group ns))
    where (ps',ns') = partition (>= 0) ts
          (zs,ps) = break (> 0) (sort ps')
          ns = sort (map negate ns')
          nzs = genericLength zs :: Int64
merge (x:xs) (y:ys) | head x < head y = merge xs (y:ys)
                    | head x > head y = merge (x:xs) ys
                    | otherwise     = (genericLength x * genericLength y) :
                                      merge xs ys
merge _ _ = []

import Data.List

main = getContents >>= doit . lines where
     doit [] = putStrLn ""
     doit (n:lis:xs) = do
          print . solve $ words lis
          doit xs

     solve lis = solve' 0 lis' where
           lis' = group . sort $ map (read :: String -> Int) lis

solve' n [] = n
solve' n (x:[]) = if (head x) == 0 then n + (length x) * ((length x) - 1) `div` 2 else n
solve' n (x1:x2:xs)
             | d > 0 = solve' n $ x2:xs
             | d < 0 = solve' n $ init x1:x2:xs
             | otherwise = solve' (n + (length x1) * (length . last $ x2:xs)) (init $ x2:xs) where
               d = diff xs

diff [] = 0
diff xs = (abs . head . head $ xs) - (abs . last . last $ xs)

import Data.List

main = getContents >>= doit . lines where
     doit [] = putStrLn ""
     doit (n:lis:xs) = do
          print . solve $ words lis
          doit xs

     solve lis = solve' 0 lis' where
           lis' = group . sort $ map (read :: String -> Int) lis
           solve' n [] = n
           solve' n (x:[]) = if (head x) == 0 then n + (length x) * ((length x) - 1) `div` 2 else n
           solve' n (x1:x2:xs)
             | d > 0 = solve' n $ x2:xs
             | d < 0 = solve' n $ init x1:x2:xs
             | otherwise = solve' (n + (length x1) * (length . last $ xs)) (tail $ x2:xs) where
               d = diff xs

diff xs = (abs . head . head $ xs) - (abs . last . last $ xs)

import Data.List
import Debug.Trace

main = getContents >>= doit . lines where
     doit [] = putStrLn ""
     doit (n:lis:xs) = do
          print . solve $ words lis
          doit xs

     solve lis = solve' 0 lis' where
           lis' = group . sort $ map (read :: String -> Int) lis

solve' n [] = n
solve' n (x:[]) = if (head x) == 0 then n + (length x) * ((length x) - 1) `div` 2 else n
solve' n (x1:x2:xs)
             | d > 0 =  solve' n $ x2:xs
             | d < 0 =  solve' n $ init $ x1:x2:xs
             | otherwise = solve' (n + (length x1) * (length . last $ x2:xs)) (init $ x2:xs) where
               d = diff (x1:x2:xs)

diff [] = 0
diff xs =  (abs . head . head $ xs) - (abs . last . last $ xs)

main = do
    getLine
    ts <- fmap (map read . words) getLine
    let zs = count 0 ts
    print $ zs * (zs - 1) `div` 2 + (sum $ map (\x -> (count x ts) * (count (-x) ts)) [1..10])
    where
        count x = length . filter (==x) --foldl (\acc y -> if x == y then acc + 1 else acc) 0 xs

import Array

m = 10

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

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

getArray :: [Int] -> Array Int Integer
getArray xs = accumArray (+) 0 (-m, m) [(x, 1) | x <- xs]

solve :: [Int] -> Integer
solve xs = notZeroPairs + zeroPairs
  where
    array = getArray xs
    notZeroPairs = sum (map (\i -> (array ! i) * (array ! (-i))) [1..m])
    zeroPairs = div (n * (n - 1)) 2
    n = array ! 0

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

import Data.List
main = print . solve . map read . tail . words =<< getContents
solve ts = nzs * (nzs-1) `div` 2 + sum (merge (group ps) (group ns))
    where (ps',ns') = partition (>= 0) ts
          (zs,ps) = break (> 0) (sort ps')
          ns = sort (map negate ns')
          nzs = length zs
merge (x:xs) (y:ys) | head x < head y = merge xs (y:ys)
                    | head x > head y = merge (x:xs) ys
                    | otherwise     = (length x * length y) : merge xs ys
merge _ _ = []

main :: IO()
main = do
	stringNumbers <- getLine
	let numbers = map read $ words stringNumbers :: [Integer]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs :: Integer
		zeroPairs = fib $ integerLength (filter (== 0) numbers) - 1 where
			fib :: Integer -> Integer
			fib (-1) = 0
			fib n = n + (fib $ n - 1)
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs :: [Integer] -> Integer
		countPairs [] = 0
		countPairs list = integerLength positive * integerLength negative + countPairs others where
			positive = [x | x <- list, x == head list]
			negative = [x | x <- list, x == -head list]
			others   = [x | x <- list, x /= head list, x /= -head list]
	putStrLn $ show n

integerLength :: [Integer] -> Integer
integerLength [] = 0
integerLength (x:xs) = 1 + integerLength xs

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + (fib $ n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = countPairs numbers where
		countPairs [] = 0
		countPairs nums = length positive * length negative + fib (length zeroes - 1) + countPairs restNums where
			positive = [x | x <- nums, x /= 0, x == head nums]
			negative = [x | x <- nums, x /= 0, negate x == head nums]
			zeroes   = filter (== 0) nums
			restNums = [x | x <- nums, x /= 0, x /= head nums, x /= -head nums]
	putStrLn $ show n

import Data.List

fib :: Integer -> Integer
fib (-1) = 0
fib 0 = 0
fib n = n + fib (n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Integer]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs :: Integer
		zeroPairs = fib $ toInteger $ length (filter (== 0) numbers) - 1
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs :: [Integer] -> Integer
		countPairs [] = 0
		countPairs list@(h:_) = toInteger (length positive * length negative) + countPairs others where
			positive = filter (==  h) list
			negative = filter (== -h) list
			others   = [x | x <- list, x /= h, x /= -h]
	putStrLn $ show n

main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = makePairs numbers where
		makePairs [_] = 0
		makePairs (man:others) = (+) (foldl (\x -> if man == negate x then (+1) else (+0)) 0 others)
									 (makePairs others)
	putStrLn $ show n

import Data.List

fib 0 = 0
fib n = n + (fib $ n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = countPairs numbers where
		countPairs [] = 0
		countPairs nums = length positive * length negative + fib (length zeroes - 1) + countPairs restNums where
			positive = [x | x <- nums, x /= 0, x == head nums]
			negative = [x | x <- nums, x /= 0, negate x == head nums]
			zeroes   = filter (== 0) nums
			restNums = [x | x <- nums, x /= head nums, x /= -head nums]
	putStrLn $ show n

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + fib (n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs = fib $ length (filter (== 0) numbers) - 1
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs [] = 0
		countPairs list@(h:_) = length positive * length negative + countPairs others where
			positive = filter (==  h) list
			negative = filter (== -h) list
			others   = [x | x <- list, x /= h, x /= -h]
	putStrLn $ show n

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + (fib $ n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = countPairs numbers where
		countPairs [] = 0
		countPairs nums = length positive * length negative + fib (length zeroes - 1) + countPairs restNums where
			positive = [x | x <- nums, x /= 0, x == head nums]
			negative = [x | x <- nums, x /= 0, negate x == head nums]
			zeroes   = filter (== 0) nums
			restNums = [x | x <- nums, x /= head nums, x /= -head nums]
	putStrLn $ show n

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + fib (n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = countPairs numbers where
		countPairs [] = 0
		countPairs nums = length positive * length negative + fib (length zeroes - 1) + countPairs restNums where
			positive = [x | x <- nums, x /= 0, x == head nums]
			negative = [x | x <- nums, x /= 0, negate x == head nums]
			zeroes   = filter (== 0) nums
			restNums = [x | x <- nums, x /= 0, x /= head nums, x /= -head nums]
	putStrLn $ show n

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + fib (n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Integer]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs = fib $ length (filter (== 0) numbers) - 1
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs [] = 0
		countPairs list@(h:_) = length positive * length negative + countPairs others where
			positive = filter (==  h) list
			negative = filter (== -h) list
			others   = [x | x <- list, x /= h, x /= -h]
	putStrLn $ show n


{-# LANGUAGE Strict #-}
import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> map (words >>> map read)
      >>> chunksOf 2
      >>> map (solve >>> show)
      >>> unlines

solve :: [[Int]] -> Int
solve [_, as] = rec 0 (reverse as)
  where
    v = last as
    rec _ [] = 0
    rec c (x : xs)
      | x == v = rec (c + 1) xs
      | otherwise = 1 + rec (2 * c) (drop (c - 1) xs)

-- helpers
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

import Control.Monad

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

solve :: IO ()
solve = do n <- readLn
           line <- getLine
           let a = reverse $ map read $ words line
           print $ operate (tail a) (n - 1) 1 (head a)

operate :: [Int] -> Int -> Int -> Int -> Int
operate a n l v | n <= 0    = 0
                | x == v    = operate xs (n - 1) (l + 1) v
                | otherwise = 1 + operate (drop l a) (n - l) (l * 2) v
                where x:xs = a

module Main where

(|>) = flip ($)

chunksOf :: Int -> [a] -> [[a]]
chunksOf n [] = []
chunksOf n xs = take n xs : chunksOf n (drop n xs)

parse :: [String] -> [Int]
parse = map read . words . last

solve' :: [Int] -> Int -> Int -> Int -> Int
solve' [] n el ans = ans
solve' (x:xs) n el ans =
    if x == el
       then solve' (xs) (n+1) el ans
       else solve' (drop n (x:xs)) (2*n) el (ans+1)

solve :: [Int] -> Int
solve a =
    let el = last a in
    let a' = reverse a in
    solve' a' 0 el 0

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

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> map (words >>> map read)
      >>> chunksOf 2
      >>> map (solve >>> show)
      >>> unlines

solve :: [[Int]] -> Int
solve [_, as] = rec 0 (reverse as)
  where
    v = last as
    rec _ [] = 0
    rec c (x:xs)
      | x == v = rec (c + 1) xs
      | otherwise = 1 + rec (2 * c) (drop c xs)

-- helpers
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts


import Control.Monad
main = do
    [x,y] <- liftM (map read . words) getLine :: IO [Integer]
    putStrLn $ show $ (fromIntegral x) * ((1.000000011)^^(y))

main = do
    s <- getLine
    let [n, m] = map read $ words s
    print $ solve n m

solve :: Integer -> Integer -> Double
solve n m = (1.000000011 ^^ m) * (fromIntegral n)

module Main where

main :: IO ()
main =
  do
    a <- getLine
    let b = read $ words a !! 0 :: Double
        e = read $ words a !! 1 :: Int in
          putStrLn $ show $ b * 1.000000011 ^ e

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

import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    a <-(\(x:y:ys) -> (x,y)) . map (fst.fromJust.C.readInt) . C.words<$> C.getLine
    print $ ((1.000000011) ^^ (snd a)) * ((fromIntegral.fst) a)

main = fmap (map read. words ) getLine >>= \[n,t] -> print $ n * 1.000000011 ** t

module Main where

readInts :: IO [Int]
readInts = fmap (map read.words) getLine

main::IO()
main = do
       line <- readInts
       let a = line !! 0
       let b = line !! 1
       let result  = fromIntegral(a)*(1.000000011)^b
       print result

import Numeric

explg :: (Fractional a) => a -> Int -> a
explg _ 0 = 1
explg x 1 = x
explg x n
	| even n = explg (x * x) (div n 2)
 	| otherwise = x * explg (x * x) (div n 2)

readInts :: IO [Int]
readInts = fmap (map read . words) getLine

growth ::Double
growth = 1.000000011

main :: IO ()
main = do
	ints <- readInts
 	let init' = ints !! 0;
	  	time' = ints !! 1
	putStr . show $ fromIntegral init' * (explg growth time')

import Control.Applicative

main= do
	[a,b]<-map read. words <$>getLine::IO [Double]
	putStrLn $ show $ a*(1.000000011**b)

import Control.Monad (liftM)

main :: IO ()
main = do
    [n, t] <- (map read . words) `liftM` getContents :: IO [Double]
    print $ n * (1.000000011 ** t)

main :: IO ()
main = do
  [n_str, t_str] <- fmap words getLine
  let n = read n_str :: Int
  let t = read t_str :: Int
  let ans = (fromIntegral n) * ((1+1.1e-8) ^ t)
  print ans


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

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

solve :: [String] -> String
solve = dropWhile (== ' ') . solve'
 where
  solve' []                          = ""
  solve' (s : ss)
    | s `elem` [".", ",", "!", "?"] = s        ++ solve' ss
    | otherwise                     = " " ++ s ++ solve' ss

main :: IO ()
main = getLine >>= putStrLn . solve . split
 where
  split = filter (not . null) . split' []
   where
    split' ys []        = reverse ys : []
    split' ys (x : xs)
      | x == ' '        = reverse ys : split' [] xs
      | x `elem` ".,!?" = reverse ys : [x] : split' [] xs
      | otherwise       = split' (x : ys) xs

s=' '
f x a@(h:t)|x==s&&h<'A'=a|x>s&&x<'A'&&h>s=x:s:a|1>0=x:a
main=interact$foldr f"\n"

module Main where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import System.IO
import System.IO.Error

hReadMany :: (Char -> Bool) -> Handle -> IO String
hReadMany p h = do b <- (p <$> hLookAhead h) `catch` const (return False)
                   if b
                     then (:) <$> hGetChar h <*> hReadMany p h
                     else return ""

hSkipSpaces  = hReadMany isSpace
hReadNumeric = hReadMany (\c -> isDigit c || c `elem` ['.', '-', '+'])

readNum :: (Num a, Read a) => IO a
readNum = do hSkipSpaces stdin
             read <$> hReadNumeric stdin

readTerm :: IO String
readTerm = do hSkipSpaces stdin
              hReadMany (not . isSpace) stdin

isPunct '.' = True
isPunct ',' = True
isPunct '!' = True
isPunct '?' = True
isPunct _   = False

separate :: String -> [String]
separate "" = []
separate (c:cs) | isPunct c = [c] : separate cs
                | isLower c = let (tok, rest) = readOut (c:cs)
                              in tok : separate rest
                | isSpace c = separate cs
    where
      readOut (c:cs) | isLower c = let (tok, rest) = readOut cs
                                   in (c:tok, rest)
                     | otherwise = ("", c:cs)
      readOut "" = ("", "")

combine :: [String] -> String
combine (str:strings) = str ++ combine' strings
    where
      combine' [] = ""
      combine' (s:ss) | isPunct $ head s = s ++ combine' ss
                      | otherwise = " " ++ s ++ combine' ss

main = do line <- getLine
          putStrLn $ combine $ separate line

import Data.Char
import Data.List

isPunct x = x `elem` ".,!?"

solve :: String -> String
solve [] = []
solve (x:xs) | isSpace x = space xs
             | isPunct x = x : punc xs
             | otherwise = x : solve xs

-- seen a space
space [] = []
space (x:xs) | isSpace x = space xs
             | isPunct x = x : punc xs
             | otherwise = ' ' : x : solve xs

-- seen a punctuation mark
punc [] = ' ' : []
punc (x:xs) | isSpace x = punc xs
            | isPunct x = x : punc xs -- not possible
            | otherwise = ' ' : x : solve xs

main = do
  solve `fmap` getLine >>= putStrLn

dtw :: String -> String -> [String]
dtw [] akk = (reverse akk):[]
dtw (x:xs) akk | (x == ' ') = mk akk ++ dtw xs []
               | (x `elem` ",.!?") = mk akk ++ [[x]] ++ dtw xs []
               | otherwise = dtw xs (x:akk)
	where mk [] = []
	      mk a = [reverse a]

write [] = []
write (x:xs) | (x == []) = " " ++ write xs
             | ((head x) `elem` ",.!?") = "◁" ++ x ++ " " ++ write xs
             | otherwise = x ++ " " ++ write xs

cut :: String -> (Bool,String) -- Костыль 1
cut [] = (False,[])
cut (x:xs) | (x == '◁') = (True,(snd next))
           | (fst next) = (False,(snd next))
           | otherwise = (False,(x:(snd next)))
    where next = cut xs

dspase [] = [] -- Костыль 2
dspase a = reverse $ tail $ reverse $ a

main = do
			s <- getLine
			putStrLn $ dspase $ snd $ cut $ write $ dtw s []

znak = ",.!?"

solve :: String -> String
solve s = reverse (solve_ "" s)
  where
    solve_ :: String -> String -> String
    solve_ acc "" = acc
    solve_ acc (c:s)
      | c `elem` (znak ++ " ")   =  solveSpaces c acc s
      | otherwise                =  solve_ (c:acc) s

    solveSpaces :: Char -> String -> String -> String
    solveSpaces ' ' acc ""       =  acc
    solveSpaces  z  acc ""       =  z:acc
    solveSpaces  z  acc (' ':s)  =  solveSpaces z acc s
    solveSpaces ' ' acc (c:s)
      | c `elem` znak  =  solveSpaces c acc s
      | otherwise      =  solve_ (' ':acc) (c:s)
    solveSpaces  z acc (c:s)
      | c `elem` znak  =  error "SolveSpaces: '!!' or ',,' etc"
      | otherwise      =  solve_ (' ':z:acc) (c:s)

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

import Data.Char
import Data.List

stick [] = []
stick (x:[a]:rest) | not $ isLetter a = (x ++ [a]):stick rest
                   | otherwise = x:stick ([a]:rest)
stick (x:rest) = x:stick rest

main = interact $ unwords . stick . (concatMap $ groupBy (\x y -> isLetter x == isLetter y)) . words

import Data.List

puncs = ".,!?"

solve :: String -> String
solve s = reverse $ f "" $ unwords $ words s
    where f s "" = s
          f s (c:c':cs) | c == ' ' && c' `elem` puncs = f s (c':cs)
                        | c' `elem` puncs = f (c:s) (c':cs)
          f s (c':c:cs) | c == ' ' && c' `elem` puncs = f (c:c':s) cs
                        | c' `elem` puncs = f (c:' ':c':s) cs
          f s (c:cs) = f (c:s) cs

main = do
    getLine >>= putStrLn . solve

main = do cs <- getLine
          putStrLn $ solve cs

solve :: String -> String
solve [] = []
solve (c:cs)
  | c == ' '  = if null cs' then  []
               else if isPunc $ head cs' then solve cs'
               else  c : solve cs'
  | isPunc c  = c : ' ' : solve cs'
  | otherwise = c : solve cs
   where cs' = dropWhile (' '==) cs

isPunc :: Char -> Bool
isPunc = flip elem ".,!?"

dtw :: String -> String -> [String]
dtw [] akk = akk:[]
dtw (x:xs) akk | (x == ' ') = mk akk ++ dtw xs []
               | (x `elem` ",.!?") = mk akk ++ [[x]] ++ dtw xs []
               | otherwise = dtw xs (x:akk)
	where mk [] = []
	      mk a = [reverse a]

write [] = []
write (x:xs) | (x == []) = " " ++ write xs
             | ((head x) `elem` ",.!?") = "\b" ++ x ++ " " ++ write xs
             | otherwise = x ++ " " ++ write xs

main = do
			s <- getLine
			putStrLn $ write $ dtw s []

dtw :: String -> String -> [String]
dtw [] akk = (reverse akk):[]
dtw (x:xs) akk | (x == ' ') = mk akk ++ dtw xs []
               | (x `elem` ",.!?") = mk akk ++ [[x]] ++ dtw xs []
               | otherwise = dtw xs (x:akk)
	where mk [] = []
	      mk a = [reverse a]

write [] = []
write (x:xs) | (x == []) = " " ++ write xs
             | ((head x) `elem` ",.!?") = "◁" ++ x ++ " " ++ write xs
             | otherwise = x ++ " " ++ write xs

cut :: String -> (Bool,String)
cut [] = (False,[])
cut (x:xs) | (x == '◁') = (True,(snd next))
           | (fst next) = (False,(snd next))
           | otherwise = (False,(x:(snd next)))
    where next = cut xs

main = do
			s <- getLine
			putStrLn $ snd $ cut $ write $ dtw s []

chakk [] = []
chakk (' ':xs) = chakk xs
chakk (x:xs) = x:(chakk xs)

parse :: String -> String -> [String]
parse [] akk = [reverse akk]
parse (' ':xs) akk = [reverse $ chakk akk] ++ parse xs []
parse (x:xs) akk = if (x `elem` ",.?!") then [reverse $ chakk akk] ++ [[x]] ++ parse xs []
                                        else parse xs (x:akk)

make [] = []
make (x:xs) | (x == []) = make xs
            | ((head x) `elem` ",.?!") = x ++ make xs
            | otherwise = (' ':x) ++ make xs

cut [] = []
cut (_:xs) = xs

main = do
         l <- getLine
         print $ cut $ make $ parse l []

-- Resubmit #1
import Data.Char
import Data.List

solve [] = []
solve (s:[x]:rest) | not $ isLetter x = s:[x]:" ":solve rest
                       | otherwise        = s:" ":[x]:" ":solve rest
solve (x:[]) = [x]
solve (x:xs) = x:" ":solve xs

main = interact $ concat . solve . (concatMap $ groupBy (\x y -> isLetter x == isLetter y)) . words

import Data.Char
import Data.List

stick [] = []
stick (x:[a]:rest) | not $ isLetter a = (x ++ [a]):stick rest
                   | otherwise = x:[a]:stick rest
stick (x:rest) = x:stick rest

main = interact $ unwords . stick . (concatMap $ groupBy (\x y -> isLetter x == isLetter y)) . words

import Data.List

solve :: String -> String
solve s = reverse $ f "" $ unwords $ words s
    where f s "" = s
          f s (c:',':cs) | c == ' ' = f s (',':cs)
                         | otherwise = f (c:s) (',':cs)
          f s (',':c:cs) | c == ' ' = f (c:',':s) cs
                         | otherwise = f (c:' ':',':s) cs
          f s (c:cs) = f (c:s) cs

main = do
    getLine >>= putStrLn . solve

import Data.List

puncs = ".,!?"

solve :: String -> String
solve s = reverse $ f "" $ unwords $ words s
    where f s "" = s
          f s (c:c':cs) | c == ' ' && c' `elem` puncs = f s (c':cs)
                        | c' `elem` puncs = f (c:s) (',':cs)
          f s (c':c:cs) | c == ' ' && c' `elem` puncs = f (c:c':s) cs
                        | c' `elem` puncs = f (c:' ':c':s) cs
          f s (c:cs) = f (c:s) cs

main = do
    getLine >>= putStrLn . solve

main = do cs <- getLine
          putStrLn $ solve cs

solve :: String -> String
solve [] = []
solve (c:cs)
  | c == ' ' = if null cs' then  []
               else if (head cs') == ',' then solve cs'
               else  c : solve cs'
  | c == ',' = c : ' ' : solve cs'
  | otherwise = c : solve cs
   where cs' = dropWhile (' '==) cs


sol :: [Int] -> Int
sol [0, 0] = 0
sol [h, m] = 24 * 60 - h * 60 - m

main = interact (unlines . map show . map (sol . map read) . map words .  tail . lines)

-- https://codeforces.com/problemset/problem/1283/A

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Char(digitToInt)

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

getInts :: Int -> IO [Int]
getInts n = fmap read <$> getLines n

getInt :: IO Int
getInt = fmap read getLine

readLine :: Read a => IO [a]
readLine = fmap (fmap read . words) getLine

solve :: [Int] -> String
solve [h, m] = show $ (23 - h) * 60 + (60 - m)

workProblem :: IO ()
workProblem = do
                n <- getInt
                input <- replicateM n (readLine :: IO [Int])
                () <- mapM_ putStrLn $ map solve input
                return ()

main :: IO ()
main = workProblem

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

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

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [h, m] <- getIntList
        print $ (23 - h) * 60 + (60 - m)

import Control.Monad

import Data.Char
import Data.List

solve :: (Int, Int) -> Int
solve (h, m) = (24 - h) * 60 - m

main :: IO ()
main = do
    input <- getContents
    putStrLn $ unlines . map (show . solve) $ zip (a input) (b input)
    where a            = map snd .filter (odd . fst) . zip [1..] . map (read :: String -> Int) . tail . words
          b            = map snd . filter (even .fst) . zip [1..] . map (read :: String -> Int) . tail . words

main = do
  firstLine <- getLine
  let n = (read::String->Int) firstLine
  mainLoop n

mainLoop :: Int -> IO ()
mainLoop n = do
  if n == 0
    then return ()
  else do
    line <- getLine
    let minutes = (show . minutesToChristmas . getTime) line
    putStrLn minutes
    mainLoop (n - 1)

getTime :: String -> (Int, Int)
getTime = (\[a,b] -> (a, b)) . map read . take 2 . words

minutesToChristmas :: (Int, Int) -> Int
minutesToChristmas (hours, minutes) = ((23 - hours) * 60) + 60 - minutes

import Control.Monad

solve :: [Int] -> Int
solve (h:m:_) = 60 * 24 - 60 * h - m

main :: IO ()
main = ids >>= mapM_ (fn >=> print)
  where ids   = enumFromTo 1 . read <$> getLine
        fn tc = solve . map read . words <$> getLine

import Control.Monad

solve :: Int -> Int -> Int
solve h m = 60*24-60*h-m

routine :: IO ()
routine = do
    [h,m] <- (map read.words) <$> getLine
    print $ solve h m

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

main = interact $ unlines . map ((show . ((24*60) - ) . sum . zipWith (*) [60, 1]) . map (read :: String -> Int) . words )  . tail . lines

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

process (x:y:[]) = (24-x)*60-y

main::IO ()
main=do
  t<- read <$> getLine ::IO Int
  a<-  map( map read) <$> map words <$> replicateM t getLine::IO [[Int]]
  mapM_ print $ map process a

import Control.Applicative
import Control.Monad

solve h m = 24 * 60 - h * 60 - m

readInt :: String -> Integer
readInt = read

main = do
    n <- read <$> getLine
    replicateM_ n $ do
        [h, m] <- map readInt . words <$> getLine
        print $ solve h m

process :: (Int,Int) -> Int
process (h,m) = (24-h) * 60 - m

readInt :: String -> Int
readInt = read

readPair :: String -> (Int,Int)
readPair str = (a,b)
    where [a,b] = map read (words str)

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

main :: IO ()

main = interact solve

solve :: String -> String
solve = buildup . map solver . breakdown
solver (x:y:[]) = 60 * (23 - x) + (60 - y)

breakdown :: String -> [[Int]]
breakdown = map (map readInt . words) . tail . lines

buildup :: [Int] -> String
buildup = unlines . map show

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

main = do
    line <- getLine
    putStrLn line


{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array (accumArray, assocs, elems, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray, STArray, runSTArray)
import Data.ByteString.Char8 (readInt, words, lines, getContents, getLine)
import Data.List (elemIndex)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
  [n, m, _] <- map readInt' . words <$> getLine
  es <- map ((\[u, v] -> (u, v + n)) . map readInt' . words) . lines <$> getContents

  let
    vs = runSTArray $ do
      let k = max n m
      vs <- newArray ((1, 1), (n+m, k)) 0 :: ST s (STArray s (Int, Int) Int)

      let
        look u = look' 1
          where
            look' i = do
              v <- readArray vs (u, i)
              if v == 0
                 then return i
                 else look' (i + 1)

      forM_ es $ \(u, v) -> do
        c <- look u
        d <- look v
        let s = c + d

        writeArray vs (u, c) v

        let
          set u v c = do
            w <- readArray vs (v, c)
            if w /= 0
              then do
                writeArray vs (v, c) u
                writeArray vs (w, c) 0
                let c' = s - c
                writeArray vs (v, c') w
                set v w c'
              else
                return (u, v, c)

        (u, v, c) <- set u v c
        writeArray vs (v, c) u

      return vs

    cs = accumArray (flip const) 0 ((0, 0), (n+m, n+m)) . map (\((v, c), u) -> ((v, u), c)) $ assocs vs

  if length es == 0
    then print 0
    else do
      let r = map (cs !) es
      print . maximum $ r
      putStr . unwords . map show $ r

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array (accumArray, assocs, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.List (elemIndex)
import Data.Maybe (fromJust)

main = do
  [n, m, _] <- map read . words <$> getLine
  es <- map ((\[u, v] -> (u, v + n)) . map read . words) . lines <$> getContents

  let
    vs = runSTArray $ do
      let k = max n m
      vs <- newArray ((1, 1), (n+m, k)) 0 :: ST s (STArray s (Int, Int) Int)

      forM_ es $ \(u, v) -> do
        let f u = (+1) . fromJust . elemIndex 0 <$> mapM (\i -> readArray vs (u, i)) [1..k]
        c <- f u
        d <- f v
        let s = c + d

        writeArray vs (u, c) v

        let
          set u v c = do
            w <- readArray vs (v, c)
            if w /= 0
              then do
                writeArray vs (v, c) u
                writeArray vs (w, c) 0
                let c' = s - c
                writeArray vs (v, c') w
                set v w c'
              else
                return (u, v, c)

        (v, u, c) <- set u v c
        writeArray vs (u, c) v

      return vs

    cs = accumArray (flip const) 0 ((0, 0), (n+m, n+m)) . map (\((v, c), u) -> ((v, u), c)) $ assocs vs

  putStr . unwords . map show $ map (cs !) es


{-# 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
    k <- readInt
    poems <- replicateM n (replicateM 4 readString)
    return (n, k, poems)
  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

isVowel a = a `elem` "aeiou"

checkRhyme :: Int -> ByteString -> ByteString -> Bool
checkRhyme k a b
    | length indexA < k = False
    | length indexB < k = False
    | otherwise         = suffixA == suffixB
  where
    indexA = reverse $ BS.findIndices isVowel a
    indexB = reverse $ BS.findIndices isVowel b

    suffixA = BS.drop (indexA !! (k - 1)) a
    suffixB = BS.drop (indexB !! (k - 1)) b

data Outcome = AABB
             | ABAB
             | ABBA
             | AAAA
             | NoneAbove
  deriving Eq

mergeOutcome NoneAbove _ = NoneAbove
mergeOutcome _ NoneAbove = NoneAbove
mergeOutcome AAAA x = x
mergeOutcome x AAAA = x
mergeOutcome a b | a == b    = a
                 | otherwise = NoneAbove

instance Show Outcome where
    show AABB = "aabb"
    show ABAB = "abab"
    show ABBA = "abba"
    show AAAA = "aaaa"
    show NoneAbove = "NO"

checkQuatrain k [a, b, c, d] | check a b && check a c && check a d = AAAA
                             | check a b && check c d              = AABB
                             | check a c && check b d              = ABAB
                             | check a d && check b c              = ABBA
                             | otherwise                           = NoneAbove
  where
    check = checkRhyme k

solve (n, k, poems) = foldl mergeOutcome AAAA (map (checkQuatrain k) poems)

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

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 Data.List

isVowel 'a' = True
isVowel 'i' = True
isVowel 'u' = True
isVowel 'e' = True
isVowel 'o' = True
isVowel   _ = False

chop 0      _ = Just ""
chop _     [] = Nothing
chop k (x:xs)
   | isVowel x = fmap (x:) $ chop (k-1) xs
   | otherwise = fmap (x:) $ chop k xs

aaaa [] = Just True
aaaa ((Just a) : (Just b) : (Just c): (Just d) : es)
   | a == b && b == c && c == d = aaaa es
aaaa _ = Nothing

aabb [] = Just True
aabb ((Just a) : (Just b) : (Just c): (Just d) : es)
   | a == b && c == d = aabb es
aabb _ = Nothing

abab [] = Just True
abab ((Just a) : (Just b) : (Just c): (Just d) : es)
   | a == c && b == d = abab es
abab _ = Nothing

abba [] = Just True
abba ((Just a) : (Just b) : (Just c): (Just d) : es)
   | a == d && b == c = abba es
abba _ = Nothing

solve x
   | aaaa x == Just True = "aaaa"
   | aabb x == Just True = "aabb"
   | abab x == Just True = "abab"
   | abba x == Just True = "abba"
   | otherwise = "NO"

main = do
   [n, k] <- fmap (map read . words) getLine
   p <- mapM (fmap (chop k . reverse)) $ take (n*4) (repeat getLine)
   putStrLn $ solve p

-- vim: set expandtab:

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

data Suffix = Suffix String
            | Invalid
            deriving Show

instance Eq Suffix where
    (Suffix a) == (Suffix b) = a == b
    _ == _ = False

type Quatrain = (Suffix, Suffix, Suffix, Suffix)

isAABB (a,b,c,d) = a == b && c == d
isABAB (a,b,c,d) = a == c && b == d
isABBA (a,b,c,d) = a == d && b == c

solve :: [Quatrain] -> String
solve list =
    let fs = [isAABB, isABAB, isABBA]
        ans  = map (flip all list) fs
        ans' = map snd $ filter fst $ zip ans ["aabb", "abab", "abba"]
    in case length ans' of
        0 -> "NO"
        1 -> head ans'
        _ -> "aaaa"

isVowel = isJust . flip elemIndex "aeiou"

suffix :: Int -> String -> Suffix
suffix k str =
    let xs   = findIndices isVowel str
        x    = drop (length xs - k) xs
    in if k > length xs
         then Invalid
         else Suffix $ drop (head x) str

main = do
    [n, k] <- (map read . words) `fmap` getLine
    list <- replicateM n $ do
        list <- replicateM 4 $ do
            [str] <- words `fmap` getLine
            return str
        let [a,b,c,d] = map (suffix k) list
        return (a,b,c,d)

    let ans = solve list
    putStrLn ans

-- lyrics
rifm = ["aabb", "abab", "abba", "aaaa"]

glasn a = (a=='a'||a=='e'||a=='i'||a=='o'||a=='u')--a=='y'

gnums [] s (a,_) = (a, read $ reverse s :: Int)
gnums (' ':xs) s _ = gnums xs [] (read $ reverse s :: Int,1)
gnums (x:xs) s a = gnums xs (x:s) a

getLyr 0 a _ = return a
getLyr i a n = do
				x <- getLine
				getLyr (i-1) ((gsfx n (reverse x) []):a) n

gsfx _ [] _ = "-"
gsfx 1 (x:xs) a = if (glasn x) then (x:a) else gsfx 1 xs (x:a)
gsfx n (x:xs) a = if (glasn x) then gsfx (n-1) xs (x:a) else gsfx n xs (x:a)

-- find type for one lir
find :: [String] -> String -> String -> String -> String
find [] _ _ akk = reverse akk
find (x:xs) a b akk | (x == "-") = "NO"
                    | (a == []) = find xs x b ('a':akk)
                    | ((x /= a) && (b == [])) = find xs a x ('b':akk)
                    | (x == a) = find xs a b ('a':akk)
                    | (x == b) = find xs a b ('b':akk)
                    | otherwise = "NO"

solve :: Int -> [String] -> [String] -> String -> String
solve 4 list lakk takk | (((takk == [])||(takk == "aaaa"))&&(foldr (||) False (map (newT==) rifm)))= solve 0 list [] newT
                       | ((takk == newT)||(newT == "aaaa")) = solve 0 list [] takk
                       | otherwise = "NO"
      where newT = (find lakk [] [] [])
solve _ [] _ t = t
solve n (x:xs) lakk t = solve (n+1) xs (x:lakk) t

main = do
			snums <- getLine
			let n = gnums snums [] (0,0) in
				do
					lyrics <- getLyr ((fst n)*4) [] (snd n)
					putStrLn $ solve 0 lyrics [] []

{-# LANGUAGE OverloadedStrings #-}

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

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'

data RhymeScheme = None | Any | Aabb | Abba | Abab
  deriving (Eq,Show)

scheme [s1,s2,s3,s4]
  | s1 == s2 && s1 == s3 && s1 == s4 = Any
  | s1 == s2 && s3 == s4 = Aabb
  | s1 == s3 && s2 == s4 = Abab
  | s1 == s4 && s2 == s3 = Abba
  | otherwise = None

combine :: RhymeScheme -> RhymeScheme -> RhymeScheme
combine None _ = None
combine _ None = None
combine Any r  = r
combine r   Any = r
combine r   s  = if r == s then r else None

commonScheme as = go Any as
  where go r [] = r
        go r (a:as) = case combine r a of
                        None -> None
                        s    -> go s as

trimRight :: ByteString -> ByteString
trimRight bs = BS.take n bs
  where n = find (BS.length bs-1)
        find k | k < 0 = k+1
               | isSpace (BS.index bs k) = find (k-1)
               | otherwise = (k+1)

chunksOf :: Int -> [a] -> [[a]]
chunksOf n as =
  case splitAt n as of
    (bs,[]) -> [bs]
    (bs,cs) -> bs : chunksOf n cs

isVowel 'a' = True
isVowel 'e' = True
isVowel 'i' = True
isVowel 'o' = True
isVowel 'u' = True
isVowel _ = False

suffix :: Int -> ByteString -> Maybe ByteString
suffix k bs = go k (BS.length bs)
  where go 0 i = Just $ BS.drop i bs
        go _ 0 = Nothing
        go k i = if isVowel (BS.index bs (i-1))
                   then go (k-1) (i-1)
                   else go k (i-1)

solve k lines =
  if all isJust suffixes
    then commonScheme schemes
    else None
  where
    suffixes = map (suffix k) lines
    quatrains = chunksOf 4 (map fromJust suffixes)
    schemes = map scheme quatrains

main = do
  (n:k:_) <- map read <$> words <$> getLine
  lines <- replicateM (4*n) $ BS.pack <$> getLine
  let answer =
        case solve k lines of
          None -> "NO"
          Any  -> "aaaa"
          Aabb -> "aabb"
          Abba -> "abba"
          Abab -> "abab"
  putStrLn answer

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

import Control.Monad

vowel x = x `elem` "aeiou"

combineTypes (a1, b1, c1) (a2, b2, c2) =
  (a1 && a2,
   b1 && b2,
   c1 && c2)

getType k [a, b, c, d] =
  (rhymes k a b && rhymes k c d,
   rhymes k a c && rhymes k b d,
   rhymes k a d && rhymes k b c)

rhymes k a b = let (suffixA, countA) = getSuffix a
                   (suffixB, countB) = getSuffix b
               in suffixA == suffixB && countA >= k && countB >= k
  where getSuffix x = BS.foldr collectSuffix (BS.empty, 0) x
        collectSuffix x (suffix, count) | count >= k = (suffix, count)
                                        | vowel x    = (BS.cons x suffix,
                                                        count + 1)
                                        | otherwise  = (BS.cons x suffix, count)

solve :: Int -> [[BS.ByteString]] -> String
solve k quantrains =
  case generalType of
    (True,  False, False) -> "aabb"
    (False, True,  False) -> "abab"
    (False, False, True)  -> "abba"
    (True,  True,  True)  -> "aaaa"
    _                     -> "NO"
  where generalType = foldl' combineTypes (True, True, True) types
        types = map (getType k) quantrains

main = do [n, k] <- fmap (map readInt . BS.words) BS.getLine
          quantrains <- replicateM n $ replicateM 4 BS.getLine
          putStrLn $ solve k quantrains

readInt line = fst $ fromJust $ BS.readInt line

import Control.Applicative

main = do [n,k] <- map read <$> words <$> getLine
          ss <- mapM (\i -> getLine) [1..(4*n)]
          putStrLn $ solve k n ss

solve :: Int -> Int -> [String] -> String
solve k _ ss = if any ((<k).length.filter isVowel) ss
                  then "NO"
                  else solve' $ map rhyme $ toQuat $ map (take' k.reverse) ss

solve' :: [String] -> String
solve' ss
  | null ss' = "aaaa"
  | all ((head ss') ==) (tail ss') = head ss'
  | otherwise = "NO"
   where ss' = filter (not.("aaaa"==)) ss

rhyme :: [String] -> String
rhyme (a:b:c:d:_)
  | (a==b)&&(b==c)&&(c==d) = "aaaa"
  | (a==b)&&(c==d) = "aabb"
  | (a==c)&&(b==d) = "abab"
  | (a==d)&&(b==c) = "abba"
  | otherwise = "NO"

toQuat :: [String] -> [[String]]
toQuat [] = []
toQuat (a:b:c:d:xs) = [a,b,c,d]: toQuat xs

isVowel :: Char -> Bool
isVowel c = elem c "aeiou"

take' :: Int -> String -> String
take' 0 _ = []
take' k cs = xs ++ [y] ++ (take' (k-1) ys)
   where (xs,(y:ys)) = break isVowel cs

module Main where

import Data.Array
import Data.List
import Data.Char

import Data.Time.Calendar

main = interact (solve . lines)

solve :: [String] -> String
solve lines = result where
    result = case rhyme of
        Nothing -> "NO"
        Just s  -> s
    rhyme = foldl1 (buildType) types
    types = map getType poem
    poem = quads $ tail endings
    endings = map (ending k) lines
    k = (read $ last $ words $ head lines) :: Int

buildType t (Just "aaaa")  = t
buildType (Just "aaaa") t  = t
buildType t1 t2
    | t1 == t2      = t1
    | otherwise     = Nothing

getType :: [Maybe String] -> Maybe String
getType quad@[a, b, c, d]
    | any (== Nothing) quad  = Nothing
    | all (== a) quad        = Just "aaaa"
    | a == b && c == d       = Just "aabb"
    | a == c && b == d       = Just "abab"
    | a == d && b == c       = Just "abba"
    | otherwise              = Nothing

quads :: [a] -> [[a]]
quads [] = []
quads (a : b : c : d : poem) = [a, b, c, d] : quads poem

ending :: Int -> String -> Maybe String
ending k = ending' [] k . reverse

ending' :: String -> Int -> String -> Maybe String
ending' result 0 _   = Just result
ending' result k []  = Nothing
ending' result k (c : str)
    | c `elem` "aeiou"  = ending' (c : result) (k - 1) str
    | otherwise         = ending' (c : result) k str

isVowel 'a' = True
isVowel 'i' = True
isVowel 'u' = True
isVowel 'e' = True
isVowel 'o' = True
isVowel   _ = False

chop k x
   | k > length x = ""
   | otherwise    = drop (length x - k) x

aaaa [] = True
aaaa (a:b:c:d:es)
   | a == b && b == c && c == d = aaaa es
   | otherwise = False

aabb [] = True
aabb (a:b:c:d:es)
   | a == b && c == d = aabb es
   | otherwise = False

abab [] = True
abab (a:b:c:d:es)
   | a == c && b == d = abab es
   | otherwise = False

abba [] = True
abba (a:b:c:d:es)
   | a == d && b == c = abba es
   | otherwise = False

solve x
   | aaaa x = "aaaa"
   | aabb x = "aabb"
   | abab x = "abab"
   | abba x = "abba"
   | otherwise = "NO"

main = do
   [n, k] <- fmap (map read . words) getLine
   p <- mapM (fmap (chop k . filter isVowel)) $ take (n*4) (repeat getLine)
   putStrLn $ solve p

-- vim: set expandtab:

isVowel 'a' = True
isVowel 'i' = True
isVowel 'u' = True
isVowel 'e' = True
isVowel 'o' = True
isVowel   _ = False

chop k x
   | k > length x = ""
   | otherwise    = drop (length x - k) x

aaaa [] = True
aaaa (a:b:c:d:es)
   | a == "" || b == "" || c == "" || d == "" = False
   | a == b && b == c && c == d = aaaa es
   | otherwise = False

aabb [] = True
aabb (a:b:c:d:es)
   | a == "" || b == "" || c == "" || d == "" = False
   | a == b && c == d = aabb es
   | otherwise = False

abab [] = True
abab (a:b:c:d:es)
   | a == "" || b == "" || c == "" || d == "" = False
   | a == c && b == d = abab es
   | otherwise = False

abba [] = True
abba (a:b:c:d:es)
   | a == "" || b == "" || c == "" || d == "" = False
   | a == d && b == c = abba es
   | otherwise = False

solve x
   | aaaa x = "aaaa"
   | aabb x = "aabb"
   | abab x = "abab"
   | abba x = "abba"
   | otherwise = "NO"

main = do
   [n, k] <- fmap (map read . words) getLine
   p <- mapM (fmap (chop k . filter isVowel)) $ take (n*4) (repeat getLine)
   putStrLn $ solve p

-- vim: set expandtab:

-- lyrics
rifm = ["aabb", "abab", "abba", "aaaa"]

glasn a = (a=='a'||a=='e'||a=='i'||a=='o'||a=='u')--a=='y'

gnums [] s (a,_) = (a, read $ reverse s :: Int)
gnums (' ':xs) s _ = gnums xs [] (read $ reverse s :: Int,1)
gnums (x:xs) s a = gnums xs (x:s) a

getLyr 0 a _ = return a
getLyr i a n = do
				x <- getLine
				getLyr (i-1) ((gsfx n (reverse x) []):a) n

gsfx _ [] _ = "-"
gsfx 1 (x:xs) a = if (glasn x) then (x:a) else gsfx 1 xs (x:a)
gsfx n (x:xs) a = if (glasn x) then gsfx (n-1) xs (x:a) else gsfx n xs (x:a)

-- find type for one lir
find :: [String] -> String -> String -> String -> String
find [] _ _ akk = reverse akk
find (x:xs) a b akk | (x == "-") = "NO"
                    | (a == []) = find xs x b ('a':akk)
                    | ((x /= a) && (b == [])) = find xs a x ('b':akk)
                    | (x == a) = find xs a b ('a':akk)
                    | (x == b) = find xs a b ('b':akk)
                    | otherwise = []

solve :: Int -> [String] -> [String] -> String -> String
solve 4 list lakk takk | (((takk == [])||(takk == "aaaa"))&&(foldr (||) False (map (newT==) rifm)))= solve 0 list [] newT
                       | ((takk == newT)||(newT == "aaaa")) = solve 0 list [] takk
                       | otherwise = "NO"
      where newT = (find lakk [] [] [])
solve _ [] _ t = t
solve n (x:xs) lakk t = solve (n+1) xs (x:lakk) t

main = do
			snums <- getLine
			let n = gnums snums [] (0,0) in
				do
					lyrics <- getLyr ((fst n)*4) [] (snd n)
					putStrLn $ solve 0 lyrics [] []

-- lyrics
rifm = ["aabb", "abab", "abba", "aaaa"]

glasn a = (a=='a'||a=='e'||a=='i'||a=='o'||a=='u')--a=='y'

gnums [] s (a,_) = (a, read $ reverse s :: Int)
gnums (' ':xs) s _ = gnums xs [] (read $ reverse s :: Int,1)
gnums (x:xs) s a = gnums xs (x:s) a

getLyr 0 a _ = return a
getLyr i a n = do
				x <- getLine
				getLyr (i-1) ((gsfx n (reverse x) []):a) n

gsfx _ [] a = a
gsfx 1 (x:xs) a = if (glasn x) then (x:a) else gsfx 1 xs (x:a)
gsfx n (x:xs) a = if (glasn x) then gsfx (n-1) xs (x:a) else gsfx n xs (x:a)

-- find type for one lir
find :: [String] -> String -> String -> String -> String
find [] _ _ akk = reverse akk
find (x:xs) a b akk | (a == []) = find xs x b ('a':akk)
                    | ((x /= a) && (b == [])) = find xs a x ('b':akk)
                    | (x == a) = find xs a b ('a':akk)
                    | (x == b) = find xs a b ('b':akk)
                    | otherwise = []

solve :: Int -> [String] -> [String] -> String -> String
solve 4 list lakk takk | (((takk == [])||(takk == "aaaa"))&&(foldr (||) False (map (newT==) rifm)))= solve 0 list [] newT
                       | ((takk == newT)||(newT == "aaaa")) = solve 0 list [] takk
                       | otherwise = "NO"
      where newT = (find lakk [] [] [])
solve _ [] _ t = t
solve n (x:xs) lakk t = solve (n+1) xs (x:lakk) t

main = do
			snums <- getLine
			let n = gnums snums [] (0,0) in
				do
					lyrics <- getLyr ((fst n)*4) [] (snd n)
					putStrLn $ solve 0 lyrics [] []

{-# LANGUAGE OverloadedStrings #-}

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

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'

data RhymeScheme = None | Any | Aabb | Abba | Abab
  deriving (Eq,Show)

scheme [s1,s2,s3,s4]
  | s1 == s2 && s1 == s3 && s1 == s4 = Any
  | s1 == s2 && s3 == s4 = Aabb
  | s1 == s3 && s2 == s4 = Abab
  | s1 == s4 && s2 == s3 = Abba
  | otherwise = None

combine :: RhymeScheme -> RhymeScheme -> RhymeScheme
combine None _ = None
combine Any r  = r
combine r   s  = if r == s then r else None

commonScheme as = go Any as
  where go r [] = r
        go r (a:as) = case combine r a of
                        None -> None
                        s    -> go s as

trimRight :: ByteString -> ByteString
trimRight bs = BS.take n bs
  where n = find (BS.length bs-1)
        find k | k < 0 = k+1
               | isSpace (BS.index bs k) = find (k-1)
               | otherwise = (k+1)

chunksOf :: Int -> [a] -> [[a]]
chunksOf n as =
  case splitAt n as of
    (bs,[]) -> [bs]
    (bs,cs) -> bs : chunksOf n cs

isVowel 'a' = True
isVowel 'e' = True
isVowel 'i' = True
isVowel 'o' = True
isVowel 'u' = True
isVowel _ = False

suffix :: Int -> ByteString -> Maybe ByteString
suffix k bs = go k (BS.length bs)
  where go 0 i = Just $ BS.drop i bs
        go _ 0 = Nothing
        go k i = if isVowel (BS.index bs (i-1))
                   then go (k-1) (i-1)
                   else go k (i-1)

solve k lines =
  if all isJust suffixes
    then commonScheme schemes
    else None
  where
    suffixes = map (suffix k) lines
    quatrains = chunksOf 4 (map fromJust suffixes)
    schemes = map scheme quatrains

main = do
  (n:k:_) <- map read <$> words <$> getLine
  lines <- replicateM (4*n) $ trimRight <$> BS.getLine
  let answer =
        case solve k lines of
          None -> "NO"
          Any  -> "aaaa"
          Aabb -> "aabb"
          Abba -> "abba"
          Abab -> "abab"
  putStrLn answer

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

import Control.Monad

vowel x = x `elem` "aeiou"

combineTypes (a1, b1, c1) (a2, b2, c2) =
  (a1 && a2,
   b1 && b2,
   c1 && c2)

getType k [a, b, c, d] =
  (rhymes k a b && rhymes k c d,
   rhymes k a c && rhymes k b d,
   rhymes k a d && rhymes k b c)

rhymes k a b = (getSuffix a) == (getSuffix b)
  where getSuffix x = fst $ BS.foldr collectSuffix (BS.empty, 0) x
        collectSuffix x (suffix, count) | count >= k = (suffix, count)
                                        | vowel x    = (BS.cons x suffix,
                                                        count + 1)
                                        | otherwise  = (BS.cons x suffix, count)

solve :: Int -> [[BS.ByteString]] -> String
solve k quantrains =
  case generalType of
    (True,  False, False) -> "aabb"
    (False, True,  False) -> "abab"
    (False, False, True)  -> "abba"
    (True,  True,  True)  -> "aaaa"
    _                     -> "NO"
  where generalType = foldl' combineTypes (True, True, True) types
        types = map (getType k) quantrains

main = do [n, k] <- fmap (map readInt . BS.words) BS.getLine
          quantrains <- replicateM n $ replicateM 4 BS.getLine
          putStrLn $ solve k quantrains

readInt line = fst $ fromJust $ BS.readInt line


{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Control.Applicative
import Control.Monad
import Data.Function (on)
import Data.List (sortBy)
import Data.Maybe
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C

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

gao :: S.Set (Int, Int) -> [((Int, Int), Int)] -> [((Int, Int), Int)]
gao _ [] = []
gao r (((c, p), i): cps) =
  case S.lookupGE (c, 0) r of
    Just k@(_, j) -> ((i, j), p): gao (S.delete k r) cps
    Nothing -> gao r cps

main :: IO ()
main = do
  n <- getInt
  cp <- replicateM n $ do
    (c:p:_) <- getInts
    return (c, p)
  _ <- getInt
  r <- S.fromList . flip zip [0..] <$> getInts
  let ans = gao r $ reverse $ sortBy (compare `on` snd . fst) $ zip cp [0 ..]
  putStrLn $ unwords $ map show [length ans, sum $ map snd ans]
  putStr $ unlines $ flip map ans $ \((i, j), _) ->
    show (i + 1) ++ " " ++ show (j + 1)
  where
  getInt = readInt <$> C.getLine
  getInts = map readInt . C.words <$> C.getLine

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

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

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

main = do
  n <- readLn
  (qs, is) :: ([[Int]], [Int]) <- unzip . sort . (\l -> zip l [1..]) <$> replicateM n getInts

  k <- readLn
  (rs, js) :: ([Int], [Int]) <- unzip . sort . (\l -> zip l [1..]) <$> getInts

  cs :: IOUArray (Int, Int) Int <- newArray ((0, 0), (n, k)) 0
  ps :: IOUArray (Int, Int) Bool <- newArray ((0, 0), (n, k)) False

  forM_ (zip [1..n] qs) $ \(i, [c, p]) ->
    forM_ (zip [1..k] rs) $ \(j, r) -> do
      ci <- readArray cs (i-1, j)
      cj <- readArray cs (i, j-1)
      cij <- (p +) <$> readArray cs (i-1, j-1)

      if c <= r && cij >= ci && cij >= cj
        then do
          writeArray cs (i, j) cij
          writeArray ps (i, j) True
        else do
          writeArray cs (i, j) $ max ci cj
          writeArray ps (i, j) False

  cs' :: UArray (Int, Int) Int <- freeze cs
  ps' :: UArray (Int, Int) Bool <- freeze ps

  let
    is' :: UArray Int Int = listArray (1, n) is
    js' :: UArray Int Int = listArray (1, k) js

    restore 0 _ = []
    restore _ 0 = []

    restore i j
      | p = (is'!i, js'!j):(restore (i-1) (j-1))
      | cs'!(i-1, j) == c = restore (i-1) j
      | otherwise = restore i (j-1)
      where
        c = cs'!(i, j)
        p = ps'!(i, j)

  let
    ijs = restore n k
    c = cs'!(n, k)

  putStrLn $ show (length ijs) ++ " " ++ show c
  putStrLn $ unlines $ map (\(i, j) -> show i ++ " " ++ show j) ijs

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

main :: IO ()
main = do
  n <- readLn
  rs <- fmap S.fromList . forM [1..n] $ \i -> do
    [c, p] <- map readInt.B.words <$> B.getLine
    return (p, c, i)
  _m <- getLine
  ts <- S.fromList.(`zip`[1..]).map readInt.B.words <$> B.getLine
  let (m,res,rts) = solve rs ts
  putStrLn $ shows m " " ++ show res
  putStr.unlines.map (unwords.map show) $ rts

solve :: S.Set (Int,Int,Int) -> S.Set (Int,Int) -> (Int,Int,[[Int]])
solve rs ts = go 0 0 [] rs ts
   where

     go !accept !money res !rs !ts
       | S.null rs = (accept,money,sort res)
       | ((p,c,i),rs') <-  S.deleteFindMax rs =
            case S.lookupGE (c,0) ts of
              Just (t,j) -> go (accept+1)
                               (money+p)
                               ([i,j]:res)
                               rs'
                               (S.delete (t,j) ts)
              Nothing -> go accept money res rs' ts

--{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Control.Applicative
import Control.Monad
import Data.Maybe
import Data.Function (on)
import Data.List (sortBy)
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

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

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

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

gao :: S.Set(Int, Int) -> [((Int, Int), Int)] -> [((Int, Int), Int)]
gao _ [] = []
gao set (((c, p), i) : xs) =
  case S.lookupGE (c, 0) set of
    Just k@(_, j) -> ((i, j), p) : gao (S.delete k set) xs
    Nothing -> gao set xs

main :: IO ()
main = do
  n <- getInt
  arr <- replicateM n $ do
    [c, p] <- getInts
    return (c, p)
  m <- getInt
  set <- S.fromList . flip zip [0..] <$> getInts
  let ans = gao set $ reverse . sortBy (compare `on` snd . fst) $ zip arr [0..]
  putStrLn $ unwords $ map show [length ans, sum $ map snd ans]
  putStr $ unlines . flip map ans $ \((i, j), _) -> show (i + 1) ++ " " ++ show (j + 1)


{-# LANGUAGE OverloadedStrings, BangPatterns #-}

import Data.Array
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as L

main :: IO ()
main = do
	(l:ls) <- L.lines `fmap` L.getContents
	let n = fst . fromJust . L.readInt $ l
	let strings = listArray (1, 2 * n) . concatMap L.words . init $ ls
	let nums = map (fst . fromJust . L.readInt) . L.words . last $ ls
	printResult . isLexographic strings $ nums

isLexographic :: Array Int L.ByteString -> [Int] -> Bool
isLexographic strings (ix:ixs) = foldl' process start ixs /= ""
	where
		ixMap x = let (!f, !s) = (strings ! (2 * x - 1), strings ! (2 * x)) in if f <= s then (f, s) else (s, f)
		start = fst . ixMap $ ix
		process !acc !x
			| acc == "" = ""
			| otherwise = if acc <= f
							then f
							else if acc <= s
								then s
								else ""
			where !(f, s) = ixMap x
isLexographic _ _ = True

printResult :: Bool -> IO ()
printResult b = putStrLn (if b then "YES" else "NO")

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (readLn >>= (`replicateM` B.getLine)) <*> (map (fst . fromJust . B.readInt) . B.words <$> B.getLine) >>= putStrLn . yesno

solve :: [B.ByteString] -> [Int] -> Bool
solve names hs = hs `isContainedIn` map snd (sort $ concat [ zip (B.words name) (repeat i) | (i, name) <- zip [1..] names ])

isContainedIn :: Eq a => [a] -> [a] -> Bool
isContainedIn xxs@(x:xs) (y:ys) | x == y = isContainedIn xs ys
                                | otherwise = isContainedIn xxs ys
isContainedIn [] _ = True
isContainedIn _ _ = False

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

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (readLn >>= (`replicateM` B.getLine)) <*> (map read . words <$> getLine) >>= putStrLn . yesno

solve :: [B.ByteString] -> [Int] -> Bool
solve names hs = hs `isContainedIn` map snd (sort $ concat [ zip (B.words name) (repeat i) | (i, name) <- zip [1..] names ])

isContainedIn :: Eq a => [a] -> [a] -> Bool
isContainedIn xxs@(x:xs) (y:ys) | x == y = isContainedIn xs ys
                                | otherwise = isContainedIn xxs ys
isContainedIn [] _ = True
isContainedIn _ _ = False

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

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

main :: IO ()
main = do
  n <- readLn
  (names, permStrs) <- splitAt (2*n).B.words <$> B.getContents
  putStrLn.bool"YES""NO"$ solve (perse n names) $ map (subtract 1.readInt) permStrs

perse :: Int -> [B.ByteString] -> (Array Int B.ByteString, Array Int B.ByteString)
perse n bss = runST $ do
  fname <- newArray_ (0,n-1)  :: ST s (STArray s Int B.ByteString)
  sname <- newArray_ (0,n-1)  :: ST s (STArray s Int B.ByteString)
  let go !i (fn:sn:rest) = do
        unsafeWrite fname i $! fn
        unsafeWrite sname i $! sn
        go (i+1) rest
      go _ _ = (,)  <$> unsafeFreeze fname <*> unsafeFreeze sname
  go 0 bss

solve :: (Array Int B.ByteString, Array Int B.ByteString) -> [Int] -> Bool
solve (fname,sname) (p0:perm) = go (min (unsafeAt fname p0) (unsafeAt sname p0)) perm
   where
     go !cur (p:rest) = case [name | name<-[unsafeAt fname p, unsafeAt sname p],cur < name] of
                          [] -> False
                          names -> go (minimum names) rest
     go _ _ = True

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

main = do
  [n] <- getInts
  names <- Arr.listArray (0, n-1) <$> replicateM n (B.words <$> B.getLine)
  perm <- getInts
  let permed = map (\i -> names ! (i - 1)) perm
  let
    solution = go (B.pack "") permed where
      go prev [] = "YES"
      go prev (l : ls) = case sort (filter (>prev) l) of
        (h : _) -> go h ls
        [] -> "NO"
  putStrLn $ solution

-- helper functions --

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

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

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

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

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

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

main = do
    n <- readLn
    ss <- replicateM n $ l2p . sort . B.words <$> B.getLine
    ps <- readInts
    let a = listArray (1,n) ss :: Array Int (B.ByteString,B.ByteString)
        go [] s = True
        go ((s1,s2):ss) s | s < s1 = go ss s1
                          | s < s2 = go ss s2
                          | otherwise = False where
    putStrLn $ if (go (map (a !) ps) (B.pack "")) then "YES" else "NO"

{-# LANGUAGE OverloadedStrings, BangPatterns #-}

import Data.Array
import Data.Maybe
import Data.List
import qualified Data.ByteString.Lazy.Char8 as L

main :: IO ()
main = do
	(l:ls) <- L.lines `fmap` L.getContents
	let n = fst . fromJust . L.readInt $ l
	let strings = listArray (1, 2 * n) . concatMap L.words . init $ ls
	let nums = map (fst . fromJust . L.readInt) . L.words . last $ ls
	printResult . isLexographic strings $ nums

isLexographic :: Array Int L.ByteString -> [Int] -> Bool
isLexographic strings (ix:ixs) = foldl' process start ixs /= ""
	where
		ixMap x = let (!f, !s) = (strings ! (2 * x - 1), strings ! (2 * x)) in if f <= s then (f, s) else (s, f)
		start = fst . ixMap $ ix
		process !acc !x
			| acc == "" = ""
			| otherwise = if acc <= f
							then f
							else if acc <= s
								then s
								else ""
			where !(f, s) = ixMap x
isLexographic _ _ = True

printResult :: Bool -> IO ()
printResult b = putStrLn (if b then "YES" else "NO")

{-# LANGUAGE OverloadedStrings, BangPatterns #-}

import Data.Array
import Data.Maybe
import Data.List
import qualified Data.ByteString.Lazy.Char8 as L

main :: IO ()
main = do
	(l:ls) <- L.lines `fmap` L.getContents
	let n = fst . fromJust . L.readInt $ l
	let strings = listArray (1, 2 * n) . concatMap L.words . init $ ls
	let nums = map (fst . fromJust . L.readInt) . L.words . last $ ls
	printResult . isLexographic strings $ nums

isLexographic :: Array Int L.ByteString -> [Int] -> Bool
isLexographic strings (ix:ixs) = foldl' process start ixs /= ""
	where
		ixMap x = (strings ! (2 * x - 1), strings ! (2 * x))
		start = let (!f, !s) = ixMap ix in if f <= s then f else s
		process !acc !x
			| acc == "" = ""
			| otherwise = if acc <= f
							then f
							else if acc <= s
								then s
								else ""
			where (!f, !s) = ixMap x
isLexographic _ _ = True

printResult :: Bool -> IO ()
printResult b = putStrLn (if b then "YES" else "NO")

{-# LANGUAGE OverloadedStrings, BangPatterns #-}

import Data.Array
import Data.Maybe
import Data.List
import qualified Data.ByteString.Lazy.Char8 as L

main :: IO ()
main = do
	(l:ls) <- L.lines `fmap` L.getContents
	let n = fst . fromJust . L.readInt $ l
	let strings = listArray (1, 2 * n) . concatMap L.words . init $ ls
	let nums = map (fst . fromJust . L.readInt) . L.words . last $ ls
	printResult . isLexographic strings $ nums

isLexographic :: Array Int L.ByteString -> [Int] -> Bool
isLexographic strings ixs = foldl' process "a" ixs /= ""
	where
		 process !acc !x
		 	| acc == "" = ""
		 	| otherwise = if acc <= f
		 					then f
		 					else if acc <= s
		 						then s
		 						else ""
		 	where (!f, !s) = (strings ! (2 * x - 1), strings ! (2 * x))

printResult :: Bool -> IO ()
printResult b = putStrLn (if b then "YES" else "NO")