z l=[0,length(filter(=='R')l)-(if any(=='L')l then 1 else 0)]
s l=case span(=='.')l of
  (d,r)->map (+(length d+1))(z r)
main=interact$unwords.map show.s.(!!1).lines

main :: IO ()
main = interact $ unwords . map show . solve . (!! 1) . lines

solve :: String -> [Int]
solve s
  | r == 0 = [n + l, n]
  | l == 0 = [n + 1, n + r + 1]
  | otherwise = [n + 1, n + r]
  where
  (nn, t) = span (== '.') s
  (rr, u) = span (== 'R') t
  (ll, _) = span (== 'L') u
  n = length nn
  r = length rr
  l = length ll

import Data.List
main = interact $ (\(a,b) -> (show $ a+1) ++ " " ++ (show $ b+1)) . go . last . lines

go s | ('R'`elem`s) && ('L'`elem`s) = (fnd 'R',fnl 'R')
     | 'R'`elem`s                   = (fnd 'R',(fnl 'R')+1)
     | otherwise                    = (fnl 'L',(fnd 'L')-1)
                                      where lst c = elemIndices c s
                                            fnd   = head . lst
                                            fnl   = last . lst

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

solve :: String -> (Int, Int)
solve s
  | not (elem 'L' s)  =  (r1, rm+1)
  | not (elem 'R' s)  =  (lm, l1-1)
  | otherwise  =  (r1, l1-1)
  where
    l1  =  (+1) $ length $ takeWhile (/= 'L') s
    r1  =  (+1) $ length $ takeWhile (/= 'R') s
    lm  =  (+(l1-1)) $ length $ takeWhile (== 'L') $ dropWhile (/= 'L') s
    rm  =  (+(r1-1)) $ length $ takeWhile (== 'R') $ dropWhile (/= 'R') s

main :: IO ()
main  =  do
    getLine
    s  <-  getLine
    let (a, b)  =  solve s
    prints [a, b]

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

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

main::IO()
main = do
	num <- getLine
	input <- getLine
	let
		a = zip input [1..(read num)]
		cnt c = length $ filter ( (== c).fst ) a
		first c = foldl (\a b -> if (fst b)==c && a==0 then (snd b) else a) 0 a
		second c = foldl (\a b -> if (fst b)==c then (snd b) else a) 0 a
		(a1,a2) = if cnt 'R' > 0 then (first 'R',second 'R' + if cnt 'L' > 0 then 0 else 1) else (second 'L',(first 'L')-1)
	putStrLn $ (show a1) ++ " " ++ (show a2)

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

solve :: String -> (Int, Int)
solve s
  | not (elem 'L' s)  =  (r1, rm)
  | not (elem 'R' s)  =  (lm, l1)
  | otherwise  =  (r1, l1)
  where
    l1  =  (+1) $ length $ takeWhile (/= 'L') s
    r1  =  (+1) $ length $ takeWhile (/= 'R') s
    lm  =  (+(l1-1)) $ length $ takeWhile (== 'L') $ dropWhile (/= 'L') s
    rm  =  (+(r1-1)) $ length $ takeWhile (== 'R') $ dropWhile (/= 'R') s

main :: IO ()
main  =  do
    s  <-  getLine
    let (a, b)  =  solve s
    prints [a, b]

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

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

main::IO()
main = do
	num <- getLine
	input <- getLine
	let
		a = zip input [1..(read num)]
		cnt c = length $ filter ( (== c).fst ) a
		first c = foldl (\a b -> if (fst b)==c && a==0 then (snd b) else a) 0 a
		second c = foldl (\a b -> if (fst b)==c then (snd b) else a) 0 a
		(a1,a2) = if cnt 'R' > 0 then (first 'R',second 'R') else (second 'L',(first 'L')-1)
	putStrLn $ (show a1) ++ " " ++ (show a2)

z l=[0,length(filter(=='R')l)-(if any(=='L')l then 1 else 0)]
s l=case span(=='.')l of
  (d,r)->map (+(length d+1))(z r)
main=interact$show.s.(!!1).lines


main :: IO ()
main = interact processInput

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

processTest :: String -> String
processTest input = output
    where
        [a, b, x] = map read $ words input
        output = if isPairXMagic (a, b) x then "YES" else "NO"

isPairXMagic :: (Integer, Integer) -> Integer -> Bool
isPairXMagic (a, b) x
    | not (a <= b) = isPairXMagic (b, a) x
    | b < x = False
    | a == 0 = b == x
    | (b - x) `mod` a == 0 = True
    | otherwise = isPairXMagic (a, b `mod` a) x

main :: IO ()
main = interact processInput

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

processTest :: String -> String
processTest input = output
    where
        [a, b, x] = map read $ words input
        output = if isPairXMagic (a, b) x then "YES" else "NO"

isPairXMagic :: (Integer, Integer) -> Integer -> Bool
isPairXMagic (a, b) x
    | not (a <= b) = isPairXMagic (b, a) x
    | b < x = False
    | a == 0 && b /= x = False
    | (b - x) `mod` a == 0 = True
    | otherwise = isPairXMagic (a, b `mod` a) x

{-# OPTIONS_GHC -O2 #-}

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

recurse :: Integral a => a -> a -> a -> Bool
recurse x a b
  | a<b = recurse x b a
  | x>a || b==0 = False
  | x `mod` b == a `mod` b = True
  | otherwise = recurse x b (a `mod` b)

solve :: IO ()
solve = do
  ~[a,b,x] <- readv
  let ans = recurse x a b
  putStrLn $ if ans then "YES" else "NO"

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

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

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

main = interact $ unlines . map (f . map read . words) . drop 1 . lines

f [a, b, x]
  | a > b = f [b, a, x]
  | b < x || (a == 0 && b /= x) = "NO"
  | a == 0 || mod (b - x) a == 0 = "YES"
  | otherwise = f [a, mod b a, x]


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

need 'W' = 1
need 'B' = -1

solve l = snd $ foldl f (repeat 0, 0) l where
  f (have, accum) row =
    let next_need = map need row in
    let res = sum $ snd $ mapAccumL (\adds (have, char) ->
              (need char - have, if adds == need char - have then 0 else 1)) 0 (zip have row) in
    (next_need, accum+res)

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

parse :: String -> [[Int]]
parse = map (map weight) . tail . lines
        where weight 'B' =  1
              weight 'W' = -1

diff :: [[Int]] -> [[Int]]
diff = d (zipWith (-)) . map (d (-))
       where d f l = (zipWith f l (tail l)) ++ [last l]

solve :: [[Int]] -> Int
solve = length . filter (/= 0) . concat . diff

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


import List
import Maybe
import Debug.Trace

infixr 0 $$
infixr 9 ...
f $$ x = traceShow x $ f x
f ... g = (f $$) . g

main = do
  getLine
  xs <- fmap (map read.words) getLine
  ys <- fmap (map read.words) getLine
  let answer = solve 1 xs ys
  print $ length answer
  mapM_ (putStrLn.f) answer
  where f(i,j) = show i ++ " " ++ show j

solve :: Int -> [Integer] -> [Integer] -> [(Int,Int)]
solve _ []     [] = []
solve n xxs@(x:xs) yys@(y:ys)
  | xxs == yys = []
  | otherwise  = swapSeq n (n+i) ++ solve (n+1) xs ys'
  where i    = fromJust $ elemIndex x yys
        ys'  = drop 1 $ update i y yys

update n x xs = as ++ x:drop 1 bs where (as,bs) = splitAt n xs

swapSeq i j = xs ++ (drop 1 $ reverse xs)
  where xs = zip [i..] [i+1..j]

module Main (main) where

import Data.List

readInt :: String -> Int
readInt = read

main = do
    input <- getLine
    let n = readInt input
    input <- getLine
    let xs = map readInt $ take n $ words input
    input <- getLine
    let ys = map readInt $ take n $ words input
    let (count, pairs) = solve n xs ys
    print count
    printPairs pairs where

    solve n xs ys = finder xs ys 0 0 [] where

        finder []     [] step s res = (s, res)
        finder (x:xs) ys step s res =
            finder xs (delete (ys!!found) ys) (step+1) (s+found) (res ++ [(step, (step+found))]) where

            found = case elemIndex x ys of
                Nothing -> 0
                Just a  -> a

    printPairs []     = return ()
    printPairs ((from, to):ps) = do
        printPair from to
        printPairs ps

    printPair from to | from == to = return ()
    printPair from to = do
        putStrLn $ show to ++ " " ++ show (to+1)
        printPair from (to-1)

import Control.Monad (liftM)
import Data.Array

type List  =  Array Int Int
type Swap  =  (Int, Int)

solve :: Int -> List -> List -> [Swap]
solve n as bs  =  solve' 1 bs
  where
    solve' i bs
      | i == n  =  []
      | as ! i == bs ! i  =  solve' (i + 1) bs
      | otherwise  =  swaps ++ solve' (i + 1) (bs // ((i, bs ! iM) : [(a, bs ! b) | (a,b) <- swaps]))
        where
          iM  =  fst $ head $ dropWhile ((/= as ! i) . snd) $ drop i $ assocs bs
          swaps  =  [(j, j-1) | j <- [iM, iM-1 .. i+1]]

prints :: [Swap] -> IO ()
prints swaps  =  print (length swaps) >> mapM_ print' swaps
  where
    print' (i,j)  =  putStrLn (show j ++ " " ++ show i)

main :: IO ()
main  =  do
    n  <-  readLn
    as  <-  liftM (listArray (1,n) . map read . words) getLine
    bs  <-  liftM (listArray (1,n) . map read . words) getLine
    prints $ solve n as bs

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

import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

debug = flip trace
-- debug = const

rearrange _ [] [] = []
rearrange pos (a:as) (b:bs)
  | a == b = rearrange (pos + 1) as bs
  | otherwise =
    let Just ind = elemIndex b (a:as)
        asnext = delete b (a:as)
    in (reverse $ map (+ pos) [0..ind - 1]) ++ rearrange (pos + 1) asnext bs

getInt = read `fmap` getLine :: IO Int
getInts = (map read . words) `fmap` getLine :: IO [Int]

printSwap ss =
  mapM_ (\s -> putStrLn (show s ++ " " ++ show (s+1))) ss

main = do
  n <- getInt
  as <- getInts
  bs <- getInts
  let arr = (rearrange 1 bs as)
  print $ length arr
  printSwap arr

import Data.Array

main = do
	[n] <- r
	a <- r
	b <- r
	putStrLn $ unlines $ let c = f n b ++ reverse (f n a) in show (length c): c where
		r = fmap (map read . words) getLine
		f n l = g [(j - 1, j) | i <- [1 .. n], j <- reverse [i + 1 .. n]] $ listArray (1, n) l
		g [] a = []
		g ((i, j): k) a = if a!i > a!j then (show i ++ " " ++ show j) : g k (a // [(i, a!j), (j, a!i)]) else g k a

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

gao :: Int -> [Int] -> ([String], [Int])
gao p [a] = ([], [a])
gao p (a:b:c) = (r ++ u ++ x, y ++ [last v]) where
	q = p + 1
	(r,h:t) = if a>b then ([show p ++ " " ++ show q], b:a:c) else ([], a:b:c)
	(u,v) = gao q t
	(x,y) = gao p (h:init v)

main = do
	getA
	a <- getA
	b <- getA
	putStrLn $ unlines $ let f = fst . gao 1; c = f a ++ reverse (f b) in show (length c): c

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

gao p [a] = ([], [a])
gao p (a:b:c) = (r ++ u ++ x, y ++ [last v]) where
	q = p + 1
	(r,h:t) = if a>b then ([show p ++ " " ++ show q], b:a:c) else ([], a:b:c)
	(u,v) = gao q t
	(x,y) = gao p (h:init v)

main = do
	getA
	a <- getA
	b <- getA
	putStrLn $ unlines $ let f = show . snd . gao 1; c = f b ++ reverse (f a) in show (length c): [c]

import List
import Maybe
import Debug.Trace

infixr 0 $$
infixr 9 ...
f $$ x = traceShow x $ f x
f ... g = (f $$) . g

main = do
  getLine
  xs <- fmap (map read.words) getLine
  ys <- fmap (map read.words) getLine
  mapM_ (putStrLn.f) $ solve 1 xs ys
  where f(i,j) = show i ++ " " ++ show j

solve :: Int -> [Integer] -> [Integer] -> [(Int,Int)]
solve _ []     [] = []
solve n xxs@(x:xs) yys@(y:ys)
  | xxs == yys = []
  | otherwise  = swapSeq n (n+i) ++ solve (n+1) xs ys'
  where i    = fromJust $ elemIndex x yys
        ys'  = drop 1 $ update i y yys

update n x xs = as ++ x:drop 1 bs where (as,bs) = splitAt n xs

swapSeq i j = xs ++ (drop 1 $ reverse xs)
  where xs = zip [i..] [i+1..j]

import Control.Monad (liftM)
import Data.Array

type List  =  Array Int Int
type Swap  =  (Int, Int)

solve :: Int -> List -> List -> [Swap]
solve n as bs  =  solve' 1 bs
  where
    solve' i bs
      | i == n  =  []
      | as ! i == bs ! i  =  solve' (i + 1) bs
      | otherwise  =  swaps ++ solve' (i + 1) (bs // ((i, bs ! iM) : [(a, bs ! b) | (a,b) <- swaps]))
        where
          iM  =  fst $ head $ dropWhile ((/= as ! i) . snd) $ drop i $ assocs bs
          swaps  =  [(j, j-1) | j <- [iM, iM-1 .. i+1]]

prints :: [Swap] -> IO ()
prints swaps  =  print (length swaps) >> mapM_ print' swaps
  where
    print' (i,j)  =  putStrLn (show i ++ " " ++ show j)

main :: IO ()
main  =  do
    n  <-  readLn
    as  <-  liftM (listArray (1,n) . map read . words) getLine
    bs  <-  liftM (listArray (1,n) . map read . words) getLine
    prints $ solve n as bs

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

import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

debug = flip trace
-- debug = const

rearrange _ [] [] = []
rearrange pos (a:as) (b:bs)
  | a == b = rearrange (pos + 1) as bs
  | otherwise =
    let Just ind = elemIndex b (a:as)
        asnext = delete b (a:as)
    in (reverse $ map (+ pos) [0..ind - 1]) ++ rearrange (pos + 1) asnext bs

getInt = read `fmap` getLine :: IO Int
getInts = (map read . words) `fmap` getLine :: IO [Int]

printSwap ss =
  mapM_ (\s -> putStrLn (show s ++ " " ++ show (s+1))) ss

main = do
  n <- getInt
  as <- getInts
  bs <- getInts
  let arr = (rearrange 1 as bs)
  print $ length arr
  printSwap arr


main = interact $ unlines . map (show . sum . map f . words) . tail . lines where f "1" = 0; f _ = 1

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    let  isOne k = if  k == 1  then  1  else  0
    pure $ putInts $ pure $ 2 - isOne n - isOne m -- no k >= 1 constraint...

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import qualified Data.ByteString.Char8 as B
import Data.Maybe (catMaybes)

main :: IO ()
main = B.interact processInput

processInput :: B.ByteString -> B.ByteString
processInput = B.unlines . map processTest . drop 1 . B.lines

processTest :: B.ByteString -> B.ByteString
processTest = B.pack . show . findMinK . map fst . catMaybes . map B.readInteger . B.words

findMinK :: [Integer] -> Integer
findMinK field_sizes = fromIntegral $ length $ filter (/= 1) field_sizes

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput = unlines . map processTest . drop 1 . lines

processTest :: String -> String
processTest = show . findMinK . map read . words

findMinK :: [Integer] -> Integer
findMinK field_sizes = fromIntegral $ length $ filter (/= 1) field_sizes

main :: IO ()
main = interact $ unlines . map (show . f . map read . words) . tail . lines where
    f [1, 1] = 0
    f [1, _] = 1
    f [_, 1] = 1
    f _      = 2

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    pure $ putInts $ pure $ if  min n m == 1
      then  1
      else  2

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


import Data.Char
import Data.Text as T
import Data.ByteString as ByteString
import Data.Word

{-
strToInts :: String -> [Int]
strToInts str = map (\x -> read x :: Int) (words str)
-}

{-
class IntParser a where
          toInt :: a -> Int

instance IntParser ByteString where
     toInt bs = ByteString.Conversion.FromByteString bs :: Int

instance IntParser String where
     toInt s = read s :: Int
-}

class CharWord8Funcs a where
	getDigit :: a -> Int
	isSpace :: a -> Bool
	isDigit :: a -> Bool

instance CharWord8Funcs Char where
	getDigit ch = digitToInt ch
	isSpace ch = Data.Char.isSpace ch
	isDigit ch = Data.Char.isDigit ch

instance CharWord8Funcs Word8 where
	getDigit w = fromIntegral (w - 48) :: Int
	isSpace w = w == 32 || w <= 13
	isDigit w = w >= 48 && w < 58

{-
class StringByteStringFuncs a where
	empty :: a -> Bool

instance StringByteStringFuncs Foldable where
	empty s = Prelude.null s

instance StringByteStringFuncs ByteString where
	empty bs = ByteString.null bs
-}

-- getNumber :: String -> (Int, String) -- (number, rest)
getNumber [] = error "can't getNumber from invalid string"
getNumber (ch:t)
	|(Main.isSpace ch) || ch == '+' || ch == '-' = do
		let (number, rest) = getNumber t
		((if ch == '-' then -1 else 1) * number, rest)
	|otherwise = do
		let (number, rest, ex10) = getNumber' (ch:t)
		if ex10 < 0 then getNumber []
		else (number, rest)

getNumber' [] = (0, [], -1)
getNumber' (ch:t)
	| Main.isDigit ch == False = (0, t, -1)
	| otherwise = do
		let (number, rest, ex10) = getNumber' t
		(number + ((10^(ex10 + 1)) * Main.getDigit ch), rest, ex10 + 1)

getNumberFromBytes str
	|ByteString.null str = error "can't getNumberFromBytes from invalid string"
	|otherwise = do
		let (w, t) = (ByteString.head str, ByteString.tail str)
		if (Main.isSpace w) || w == 43 || w == 45 then do
			let (number, rest) = getNumberFromBytes t
			((if w == 45 then -1 else 1) * number, rest)
		else do
			let (number, rest, ex10) = getNumberFromBytes' str
			if ex10 < 0 then getNumberFromBytes ByteString.empty
			else (number, rest)

getNumberFromBytes' str
	|ByteString.null str = (0, str, -1)
	|otherwise = do
		let (w, t) = (ByteString.head str, ByteString.tail str)
		if (Main.isDigit w == False) then (0, t, -1)
		else do
		let (number, rest, ex10) = getNumberFromBytes' t
		(number + ((10^(ex10 + 1)) * Main.getDigit w), rest, ex10 + 1)

-- getNNumbers :: String -> Int -> ([Int], String) -- (numbers, rest)
getNNumbers str 0 = ([], str)
getNNumbers str n = do
	let (number, rest1) = getNumber str
	let (numbers, rest2) = getNNumbers rest1 (n - 1)
	(number : numbers, rest2)

readInput :: Int -> String -> Int
readInput n str = do
	if n > 0 then do
		let (number, rest1) = getNumber str
		let (_, rest2) = getNumber rest1
		number + readInput (n - 1) rest2
	else 0

printRes 0 l = return ()
printRes n l = do
	Prelude.putChar l
	printRes (n - 1) l

main = do
	contents <- Prelude.getContents
	let (n, rest) = getNumber contents
	let sumA = readInput n rest
	let thousands = div sumA 1000
	let countOfG = (thousands + if (sumA - (thousands * 1000)) > 500 then 1 else 0)
	let countOfA = n - countOfG
	printRes countOfA 'A'
	printRes countOfG 'G'
	Prelude.putStrLn ""

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

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

gao :: Int -> String -> [(Int, Int)] -> String
gao _ s [] = reverse s
gao d s ((a, g): t)
  | d + a <= 500  = gao (d + a) ('A':s) t
  | otherwise     = gao (d - g) ('G':s) t

main :: IO ()
main = do
  (_:a) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  putStrLn $ gao 0 "" $ pairs a

import qualified Data.ByteString.Char8 as B

readInt bs = case B.readInt bs of Just (n,_) -> n
main = B.getContents >>= putStr . solve 0 . tail . map readInt . B.words
    where
        solve diff (a:g:rest)
            | diff + a <= 500 = 'A' : solve (diff + a) rest
            | otherwise = 'G' : solve (diff - g) rest
        solve _ _ = []

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = putStrLn . solve . map (maybe 0 fst . B.readInt . head . B.words) . B.lines =<< B.getContents

solve :: [Int] -> String
solve (n : as) = replicate na 'A' ++ replicate ng 'G'
  where
  ng = (sum as + 500) `div` 1000
  na = n - ng

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

getMin a b = case compare (abs $ fst a) (abs $ fst b) of
  LT -> a
  _ -> b

groupByPairs (a:b:xs) = (a, b) : groupByPairs xs
groupByPairs list = []

solve (n:list) = let decide (d, acc) (x, y) = acc `seq` ((d + x, 'A' : acc) `getMin` (d - y, 'G' : acc))
                     -- holy crap %)
                     (x, ans) = foldl' decide (0, []) $ groupByPairs list
                 in if abs x <= 500 then ans else "-1"

parseInt = fst . fromJust . BS.readInt

main = BS.interact $ BS.pack . solve . map parseInt . BS.words

import qualified Data.ByteString.Char8 as BS
main = do getLine
          input <- BS.getContents
          putStrLn $ solve $ BS.lines input

{-splitBySpace :: String -> [String]-}
splitBySpace str = map BS.unpack (BS.words str)

getAsPrice strs = [read ((splitBySpace str)!!0)|str <- strs]
getGsPrice strs = [read $ (splitBySpace str)!!1|str <- strs]

solve2 [] [] (a,g) = ("",(a,g))
solve2 (x:pa) (y:pg) (a,g) = if abs (a+x-g) < abs (g+y-a)
                             then ("A" ++ fst(solve2 pa pg (a+x,g)), (a+x,g))
                             else ("G" ++ fst(solve2 pa pg (a,g+y)), (a,g+y))
{-solve3 [] [] = ""
solve3 (x:pa) (y:pg) = if abs (a+x-g) < abs (g+y-a) then "A"++(solve3 pa pg)
                   else "G" ++ (solve3 pa pg)
                       where a = fst (solve2 pa pg)
                             g = snd (solve2 pa pg)
-}

solve strs = if abs(a-g)>500 then "-1"
             else fst $ ret
                 where
                   ret = solve2 pa pg (0,0)
                       where
                         pa = getAsPrice strs
                         {-pg = getGsPrice strs-}
                         pg = map (1000 - ) pa
                   a = fst(snd(ret))
                   g = snd $ snd $ ret

import qualified Data.ByteString.Char8 as B

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

main=B.getContents>>=putStr.solve.map readInt.B.words

solve(_:xs) = go 0 xs
   where
     go d (a:g:rest)
       | d + a <= 500 = 'A' : go (d+a) rest
       | otherwise = 'G' : go (d-g) rest
     go _ _ = []

import Data.Char
import Data.Text as T
import Data.ByteString as ByteString
import Data.Word

{-
strToInts :: String -> [Int]
strToInts str = map (\x -> read x :: Int) (words str)
-}

{-
class IntParser a where
          toInt :: a -> Int

instance IntParser ByteString where
     toInt bs = ByteString.Conversion.FromByteString bs :: Int

instance IntParser String where
     toInt s = read s :: Int
-}

class CharWord8Funcs a where
	getDigit :: a -> Int
	isSpace :: a -> Bool
	isDigit :: a -> Bool

instance CharWord8Funcs Char where
	getDigit ch = digitToInt ch
	isSpace ch = Data.Char.isSpace ch
	isDigit ch = Data.Char.isDigit ch

instance CharWord8Funcs Word8 where
	getDigit w = fromIntegral (w - 48) :: Int
	isSpace w = w == 32 || w <= 13
	isDigit w = w >= 48 && w < 58

{-
class StringByteStringFuncs a where
	empty :: a -> Bool

instance StringByteStringFuncs Foldable where
	empty s = Prelude.null s

instance StringByteStringFuncs ByteString where
	empty bs = ByteString.null bs
-}

-- getNumber :: String -> (Int, String) -- (number, rest)
getNumber [] = error "can't getNumber from invalid string"
getNumber (ch:t)
	|(Main.isSpace ch) || ch == '+' || ch == '-' = do
		let (number, rest) = getNumber t
		((if ch == '-' then -1 else 1) * number, rest)
	|otherwise = do
		let (number, rest, ex10) = getNumber' (ch:t)
		if ex10 < 0 then getNumber []
		else (number, rest)

getNumber' [] = (0, [], -1)
getNumber' (ch:t)
	| Main.isDigit ch == False = (0, t, -1)
	| otherwise = do
		let (number, rest, ex10) = getNumber' t
		(number + ((10^(ex10 + 1)) * Main.getDigit ch), rest, ex10 + 1)

getNumberFromBytes str
	|ByteString.null str = error "can't getNumberFromBytes from invalid string"
	|otherwise = do
		let (w, t) = (ByteString.head str, ByteString.tail str)
		if (Main.isSpace w) || w == 43 || w == 45 then do
			let (number, rest) = getNumberFromBytes t
			((if w == 45 then -1 else 1) * number, rest)
		else do
			let (number, rest, ex10) = getNumberFromBytes' str
			if ex10 < 0 then getNumberFromBytes ByteString.empty
			else (number, rest)

getNumberFromBytes' str
	|ByteString.null str = (0, str, -1)
	|otherwise = do
		let (w, t) = (ByteString.head str, ByteString.tail str)
		if (Main.isDigit w == False) then (0, t, -1)
		else do
		let (number, rest, ex10) = getNumberFromBytes' t
		(number + ((10^(ex10 + 1)) * Main.getDigit w), rest, ex10 + 1)

-- getNNumbers :: String -> Int -> ([Int], String) -- (numbers, rest)
getNNumbers str 0 = ([], str)
getNNumbers str n = do
	let (number, rest1) = getNumber str
	let (numbers, rest2) = getNNumbers rest1 (n - 1)
	(number : numbers, rest2)

readInput :: Int -> ByteString -> Int
readInput n str = do
	if n > 0 then do
		let (number, rest1) = getNumberFromBytes str
		let (_, rest2) = getNumberFromBytes rest1
		number + readInput (n - 1) rest2
	else 0

printRes 0 l = return ()
printRes n l = do
	Prelude.putChar l
	printRes (n - 1) l

main = do
	contents <- ByteString.getContents
	let (n, rest) = getNumberFromBytes contents
	let sumA = readInput n rest
	let thousands = div sumA 1000
	let countOfG = (thousands + if (sumA - (thousands * 1000)) > 500 then 1 else 0)
	let countOfA = n - countOfG
	printRes countOfA 'A'
	printRes countOfG 'G'
	Prelude.putStrLn ""

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = print . solve . map (maybe 0 fst . B.readInt . head . B.words) . tail . B.lines =<< B.getContents

solve :: [Int] -> String
solve as = fst =<< scanl f ("", d) as
  where
  d = sum as
  f (_, s) a
    | s > 500 = ("G", s - 1000)
    | otherwise = ("A", s)

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = print . solve . map (maybe 0 fst . B.readInt . head . B.words) . B.lines =<< B.getContents

solve :: [Int] -> String
solve (n : as)
  | d > 500 = "-1"
  | otherwise = s
  where
  (s, d) = foldr f ("", sum as) as
  f _ (s, d)
    | d > 500 = ('G' : s, d - 1000)
    | otherwise = ('A' : s, d)

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

magicSort = sortBy (\(_,a,b) (_,c,d) -> compare (abs (c-d)) (abs (a-b)))

magicUnsort = sortBy (\(i,_) (j,_) -> compare i j)

solve xs ys = foldl decide (0, []) . magicSort . zip3 [1..] xs $ ys
  where
    decide (x, acc) (i, a, b) | x > 0  = (x - b, (i, 'G') : acc)
                              | x <= 0 = (x + a, (i, 'A') : acc)

parsePair :: IO (Int, Int)
parsePair = do
  [a, b] <- words <$> getLine
  return (read a, read b)

main = do
  n <- read <$> getLine
  (xs, ys) <- mapAndUnzipM (const $ parsePair) [1..n]
  let (x, zs) = solve xs ys
  if abs x <= 500 then
    let (_, answer) = unzip $ magicUnsort zs
    in putStrLn . reverse $ answer
  else
    putStrLn "-1"

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

magicSort = sortBy (\(_,a,b) (_,c,d) -> compare (abs (c-d)) (abs (a-b)))

magicUnsort = sortBy (\(i,_) (j,_) -> compare i j)

solve xs ys = foldl decide (z, []) . magicSort . zip3 [1..] xs $ ys
  where
    z = sum $ zipWith (-) xs ys
    decide (x, acc) (i, a, b) | x > 0  = (x - b, (i, 'G') : acc)
                              | x <= 0 = (x + a, (i, 'A') : acc)

parsePair :: IO (Int, Int)
parsePair = do
  [a, b] <- words <$> getLine
  return (read a, read b)

main = do
  n <- read <$> getLine
  (xs, ys) <- mapAndUnzipM (const $ parsePair) [1..n]
  let (x, zs) = solve xs ys
  if abs x <= 500 then
    let (_, answer) = unzip $ magicUnsort zs
    in putStrLn . reverse $ answer
  else
    putStrLn "-1"

import Data.List

simulate (_:xs) = foldl (\ x y -> x + (f y)) 0 $ map sort xs
  where
    f "++X" = 1
    f "--X" = -1
    f s = 0
simulate _ = 0

main = interact $ show . simulate . lines

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

magicSort = sortBy (\(_,a,b) (_,c,d) -> compare (abs (a-b)) (abs (c-d)))

magicUnsort = sortBy (\(i,_) (j,_) -> compare i j)

solve xs ys = foldl decide (0, []) . magicSort . zip3 [1..] xs $ ys
  where
    decide (x, acc) (i, a, b) | x > 0  = (x - b, (i, 'G') : acc)
                              | x <= 0 = (x + a, (i, 'A') : acc)

parsePair :: IO (Int, Int)
parsePair = do
  [a, b] <- words <$> getLine
  return (read a, read b)

main = do
  n <- read <$> getLine
  (xs, ys) <- mapAndUnzipM (const $ parsePair) [1..n]
  let (x, zs) = solve xs ys
  if abs x <= 500 then
    let (_, answer) = unzip $ magicUnsort zs
    in putStrLn . reverse $ answer
  else
    putStrLn "-1"

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

magicSort = sortBy (\(_,a,b) (_,c,d) -> compare (abs (a-b)) (abs (c-d)))

magicUnsort = sortBy (\(i,_) (j,_) -> compare i j)

solve xs ys = foldl decide (0, []) . magicSort . zip3 [1..] xs $ ys
  where
    decide (x, acc) (i, a, b) | x > 0 = (x - b, (i, 'G') : acc)
                              | x < 0 = (x + a, (i, 'A') : acc)
                              | b < a = (x - b, (i, 'G') : acc)
                              | True  = (x + a, (i, 'A') : acc)

parsePair :: IO (Int, Int)
parsePair = do
  [a, b] <- words <$> getLine
  return (read a, read b)

main = do
  n <- read <$> getLine
  (xs, ys) <- mapAndUnzipM (const $ parsePair) [1..n]
  let (x, zs) = solve xs ys
  if (abs x) <= 500 then
    let (_, answer) = unzip $ magicUnsort zs
    in putStrLn . reverse $ answer
  else
    putStrLn "-1"

import qualified Data.ByteString.Char8 as BS
main = do getLine
          input <- BS.getContents
          print $ solve $ BS.lines input

{-splitBySpace :: String -> [String]-}
splitBySpace str = map BS.unpack (BS.words str)

getAsPrice strs = [read ((splitBySpace str)!!0)|str <- strs]
getGsPrice strs = [read $ (splitBySpace str)!!1|str <- strs]

solve2 [] [] = (0,0)
solve2 (x:pa) (y:pg) = if abs (a+x-g) < abs (g+y-a) then (a+x,g) else (a,g+y)
    where a = fst (solve2 pa pg)
          g = snd (solve2 pa pg)
solve3 [] [] = ""
solve3 (x:pa) (y:pg) = if abs (a+x-g) < abs (g+y-a) then (solve3 pa pg) ++ "A"
                   else (solve3 pa pg) ++ "G"
                       where a = fst (solve2 pa pg)
                             g = snd (solve2 pa pg)

solve strs = if abs(a-g)>500 then "-1" else
                 solve3  pa pg
                        where
                          pa = getAsPrice strs
                          pg = getGsPrice strs
                          a = fst (solve2 pa pg) :: Int
                          g = snd (solve2 pa pg) :: Int

strToInts :: String -> [Int]
strToInts str = map (\x -> read x :: Int) (words str)

readInput :: IO Int -> IO [Int]
readInput nIO = do
	n <- nIO
	if n > 0 then do
		pairStr <- getLine
		let pair = strToInts pairStr
		tail <- readInput $ return (n - 1)
		return ((pair !! 0) : tail)
	else return []

main = do
	nStr <- getLine
	let n = strToInts nStr !! 0
	input <- readInput $ return n
	let sumA = sum input
	let thousands = div sumA 1000
	let countOfG = (thousands + if (sumA - (thousands * 1000)) > 500 then 1 else 0)
	let countOfA = n - countOfG
	let res = (take countOfA $ repeat 'A') ++ (take countOfG $ repeat 'G')
	print res

{-
strToInts :: String -> [Int]
strToInts str = map (\x -> read x :: Int) (words str)

readInput :: IO Int -> IO [(Int, Int)]
readInput nIO = do
	n <- nIO
	if n > 0 then do
		pairStr <- getLine
		let pair = strToInts pairStr
		tail <- readInput $ return (n - 1)
		return ((pair !! 0, pair !! 1) : tail)
	else return []

-- (resStr, aSum, gSum, aIndexes, gIndexes)
getMin :: [(Int, Int)] -> (String, Int, Int, [Int], [Int])
getMin list = getMin' list 0
getMin' :: [(Int, Int)] -> Int -> (String, Int, Int, [Int], [Int])
getMin' [] index = ("", 0, 0, [], [])
getMin' ((a, g):t) index = do
	let (resStr, aSum, gSum, aIndexes, gIndexes) = getMin' t (index+1)
	if a < g then ('A':resStr, aSum + a, gSum, index:aIndexes, gIndexes)
	else ('B':resStr, aSum, gSum + g, aIndexes, index:gIndexes)

main = do
	nStr <- getLine
	input <- readInput $ return (strToInts nStr !! 0)
	let res1 = getMin input
	let (strRes1, aSum1, gSum1, aIndexes1, gIndexes1) = res1
	let dif = abs(aSum1 - gSum1)

	if abs(aSum1 - gSum1) <= 500 then print strRes1
	else print "?"
-}


module Main where
    import Data.List

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let n = read ns :: Int
            a = map (\x -> read x :: Int) $ words s
            mn = minimum a
            Just pos = findIndex (== mn) a
        putStr $ concat $ map (++ "\n") $
            [show $ n - 1] ++ [concat $ map (\x -> show x ++ " ") $
                [pos + 1, i + 1, mn, mn + abs (pos - i)] |
                    i <- filter (/= pos) [0 .. n - 1]]

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

import Control.Monad
import Data.List
import Data.Maybe
import Text.Printf

solve xs n
  | length xs == 1 = putStrLn $ show 0
  | otherwise = do
      let idx = fromMaybe 0 $ findIndex (==mn) xs
          mn = minimum xs
      putStrLn $ show (n - 1)
      forM_ (zip [0..(n - 1)] [x | i <- [0..(n - 1)], let x = mn + abs (i - idx)]) $
        \(cur, num) ->
          if cur == idx
          then putStr ""
          else putStrLn $ unwords $ map show [idx + 1, cur + 1, mn, num]

main = do
  t <- getLine >>= return . read :: IO Int
  replicateM_ t $ do
    n <- getLine >>= return . read :: IO Int
    nums <- getLine >>= return . (fmap read) . words :: IO [Int]
    solve nums n

import Control.Monad
import Data.List
import Data.Maybe
import Text.Printf

solve xs n
  | length xs == 1 = print $ show 0
  | otherwise = do
      let idx = fromMaybe 0 $ findIndex (==mn) xs
          mn = minimum xs
      putStrLn $ show (n - 1)
      forM_ (zip [0..(n - 1)] [x | i <- [0..(n - 1)], let x = mn + abs (i - idx)]) $
        \(cur, num) ->
          if cur == idx
          then putStr ""
          else putStrLn $ unwords $ map show [idx + 1, cur + 1, mn, num]

main = do
  t <- getLine >>= return . read :: IO Int
  replicateM_ t $ do
    n <- getLine >>= return . read :: IO Int
    nums <- getLine >>= return . (fmap read) . words :: IO [Int]
    solve nums n

import Control.Monad
import Data.List
import Data.Maybe
import Text.Printf

solve xs n
  | length xs == 1 = print $ show 0
  | otherwise = do
      let idx = fromMaybe 0 $ findIndex (==mn) xs
          mn = minimum xs
      putStrLn $ show (n - 1)
      forM_ (zip [0..(n - 1)] [x | i <- [0..(n - 1)], let x = mn + abs (i - idx)]) $
        \(cur, num) ->
          if cur == idx
          then putStr ""
          else putStrLn $ unwords $ map show [idx + 1, cur + 1, cur, num]

main = do
  t <- getLine >>= return . read :: IO Int
  replicateM_ t $ do
    n <- getLine >>= return . read :: IO Int
    nums <- getLine >>= return . (fmap read) . words :: IO [Int]
    solve nums n

import Control.Monad
import Data.List
import Data.Maybe
import Text.Printf

solve xs n
  | length xs == 1 = print $ show 0
  | otherwise = do
      let idx = fromMaybe 0 $ findIndex (==mn) xs
          mn = minimum xs
      putStrLn $ show (n - 1)
      forM_ (zip [0..(n - 1)] [x | i <- [0..(n - 1)], let x = mn + abs (i - idx)]) $
        \(idx, num) ->
          if idx == mn
          then putStr ""
          else putStrLn $ unwords $ map show [idx, (idx + 1), num, (num + 1)]

main = do
  t <- getLine >>= return . read :: IO Int
  replicateM_ t $ do
    n <- getLine >>= return . read :: IO Int
    nums <- getLine >>= return . (fmap read) . words :: IO [Int]
    solve nums n

import Control.Monad
import Data.List
import Data.Maybe
import Text.Printf

solve xs n
  | length xs == 1 = print $ show 0
  | otherwise = do
      let idx = fromMaybe 0 $ findIndex (==mn) xs
          mn = minimum xs
      if idx == 0
      then do
        putStrLn $ show (n - 1)
      else do
        putStrLn $ show n
        putStrLn $ unwords $ map show [1, (idx + 1), mn, (mn + idx)]
      forM_ (zip [1..(n - 1)] [mn..(mn+n-2)]) $
        \(idx, num) ->
          putStrLn $ unwords $ map show [idx, (idx + 1), num, (num + 1)]

main = do
  t <- getLine >>= return . read :: IO Int
  replicateM_ t $ do
    n <- getLine >>= return . read :: IO Int
    nums <- getLine >>= return . (fmap read) . words :: IO [Int]
    solve nums n

import Control.Monad
import Data.List
import Data.Maybe
import Text.Printf

solve xs n
  | length xs == 1 = print $ show 0
  | otherwise = do
      let idx = fromMaybe 0 $ findIndex (==mn) xs
          mn = minimum xs
      if idx == 0
      then do
        putStrLn $ show (n - 1)
      else do
        putStrLn $ show n
        putStrLn $ unwords $ map show [1, mn, (idx + 1), (mn + idx)]
      forM_ (zip [2..(n - 1)] [(mn + 1)..(mn+n-2)]) $
        \(idx, num) ->
          putStrLn $ unwords $ map show [idx, num, (idx + 1), (num + 1)]

main = do
  t <- getLine >>= return . read :: IO Int
  replicateM_ t $ do
    n <- getLine >>= return . read :: IO Int
    nums <- getLine >>= return . (fmap read) . words :: IO [Int]
    solve nums n

module Main where
    import Data.List

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let n = read ns :: Int
            a = map (\x -> read x :: Int) $ words s
            mn = minimum a
            Just pos = findIndex (== mn) a
        putStr $ concat $ map (++ "\n") $
            [show $ n - 1] ++ [concat $ map (\x -> show x ++ " ") $
                [pos + 1, i + 1, mn, mn + abs (pos - i)] |
                    i <- filter (/= pos) [1 .. n - 1]]

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)


{-# 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 . (,)

{-
 - rotate clockwise
 - (i,j) n m -> (j,n-i+1) m n
 - horizontal rotate
 - (i,j) n m -> (i,m-j+1) m n
 -
 - (i,j)
 - -}

main = do
    [n,m,x,y,z,p] <- readInts
    l <- map (l2p . map readInt . B.words) . B.lines <$> B.getContents
    putStr $ unlines $ map (unwords . map show . p2l . solve n m x y z) l

rotateC ((n,m),(i,j)) = ((m,n),(j,n-i+1))
rotateH ((n,m),(i,j)) = ((n,m),(i,m-j+1))

times n f x = iterate f x !! n

solve n m x y z p = snd $ times (4 - mod z 4) rotateC$
                            times (mod y 2) rotateH $
                            times (mod x 4) rotateC ((n,m),p)

data Point = Point Int Int

instance Show Point where
    show (Point x y) = (show x) ++ " " ++ (show y)

getPoints :: Int -> IO [Point]
getPoints 0 = return []
getPoints n = do
    sXY <- getLine
    let
        [x, y] = map read $ words sXY
    rest <- getPoints (n - 1)
    return ((Point x y) : rest)

operX :: Int -> (Int, Int, [Point]) -> (Int, Int, [Point])
operX 0 (n, m, po) = (n, m, po)
operX t (n, m, po) = operX (t - 1) (m, n, po')
    where
        po' = map (\(Point x y) -> Point y (n + 1 - x)) po

operY :: Int -> (Int, Int, [Point]) -> (Int, Int, [Point])
operY 0 (n, m, po) = (n, m, po)
operY t (n, m, po) = operY (t - 1) (n, m, po')
    where
        po' = map (\(Point x y) -> Point x (m + 1 - y)) po

operZ :: Int -> (Int, Int, [Point]) -> (Int, Int, [Point])
operZ 0 (n, m, po) = (n, m, po)
operZ t (n, m, po) = operZ (t - 1) (m, n, po')
    where
        po' = map (\(Point x y) -> Point (m + 1 - y) x) po

main :: IO ()
main = do
    sNMXYZP <- getLine
    let
        [n, m, x, y, z, p] = map read $ words sNMXYZP
    po <- getPoints p

    let
        (n', m', po') = ((operZ (z `mod` 4)) . (operY (y `mod` 2)) . (operX (x `mod` 4))) (n, m, po)
    putStr $ unlines $ map show po'

import Control.Monad (replicateM_,forM_)

transX :: Int -> (Int,Int,Int,Int) -> (Int,Int,Int,Int)
transX k (n, m, i ,j) =
  case k `mod` 4 of
    0 -> (n, m, i, j)
    1 -> (m, n, j, n+1-i)
    2 -> (n, m, n+1-i, m+1-j)
    3 -> (m, n, m+1-j, i)

transY k (n, m, i, j) =
  case k `mod` 2 of
    0 -> (n, m, i, j)
    1 -> (n, m, i, m+1-j)

transZ k = transX (3*k)

trans :: Int -> Int -> Int -> (Int,Int,Int,Int) -> (Int,Int,Int,Int)
trans x y z = transZ z . transY y . transX x

main = do
  (n: m: x: y: z: p: _) <- (map read . words) `fmap` getLine
  replicateM_ p $ do
    (i:j:_) <- (map read. words) `fmap` getLine
    let (_,_,i',j') = trans x y z (n,m,i,j)
    putStrLn $ show i' ++ " " ++ show j'

data Point = Point Int Int

instance Show Point where
    show (Point x y) = (show x) ++ " " ++ (show y)

getPoints :: Int -> IO [Point]
getPoints 0 = return []
getPoints n = do
    sXY <- getLine
    let
        [x, y] = map read $ words sXY
    rest <- getPoints (n - 1)
    return ((Point x y) : rest)

operX :: Int -> Int -> [Point] -> Int -> [Point]
operX n m po 0 = po
operX n m po t = operX n m po' (t - 1)
    where
        po' = map (\(Point x y) -> Point y (n + 1 - x)) po

operY :: Int -> Int -> [Point] -> Int -> [Point]
operY n m po 0 = po
operY n m po t = operY n m po' (t - 1)
    where
        po' = map (\(Point x y) -> Point x (m + 1 - y)) po

operZ :: Int -> Int -> [Point] -> Int -> [Point]
operZ n m po 0 = po
operZ n m po t = operZ n m po' (t - 1)
    where
        po' = map (\(Point x y) -> Point (m + 1 - y) x) po

main :: IO ()
main = do
    sNMXYZP <- getLine
    let
        [n, m, x, y, z, p] = map read $ words sNMXYZP
    po <- getPoints p

    let
        poOX = operX n m po (x `mod` 4)
        poOY = operY n m poOX (y `mod` 2)
        poOZ = operZ n m poOY (z `mod` 4)
    putStr $ unlines $ map show poOZ

data Point = Point Int Int

instance Show Point where
    show (Point x y) = (show x) ++ " " ++ (show y)

getPoints :: Int -> IO [Point]
getPoints 0 = return []
getPoints n = do
    sXY <- getLine
    let
        [x, y] = map read $ words sXY
    rest <- getPoints (n - 1)
    return ((Point x y) : rest)

operX :: Int -> (Int, Int, [Point]) -> (Int, Int, [Point])
operX 0 (n, m, po) = (n, m, po)
operX t (n, m, po) = operX (t - 1) (m, n, po')
    where
        po' = map (\(Point x y) -> Point y (n + 1 - x)) po

operY :: Int -> (Int, Int, [Point]) -> (Int, Int, [Point])
operY 0 (n, m, po) = (n, m, po)
operY t (n, m, po) = operX (t - 1) (n, m, po')
    where
        po' = map (\(Point x y) -> Point x (m + 1 - y)) po

operZ :: Int -> (Int, Int, [Point]) -> (Int, Int, [Point])
operZ 0 (n, m, po) = (n, m, po)
operZ t (n, m, po) = operX (t - 1) (m, n, po')
    where
        po' = map (\(Point x y) -> Point (m + 1 - y) x) po

main :: IO ()
main = do
    sNMXYZP <- getLine
    let
        [n, m, x, y, z, p] = map read $ words sNMXYZP
    po <- getPoints p

    let
        (n', m', po') = ((operZ (z `mod` 4)) . (operY (y `mod` 2)) . (operX (x `mod` 4))) (n, m, po)
    putStr $ unlines $ map show po'


import Data.List
import Data.Ord
import Control.Monad

scoreTbl = [25, 18, 15, 12, 10, 8, 6, 4, 2, 1]

score (Just ix) | ix < 10 = scoreTbl !! ix
score _ = 0

score1 sss name =
  let nums = map (elemIndex name) sss in
  let tot = sum $ map score nums in
  let ords = map (\ix -> length $ filter (== Just ix) nums) [0..] in
  tot : ords

score2 sss name =
  let nums = map (elemIndex name) sss in
  let tot = sum $ map score nums in
  let (ord0 : ords) = map (\ix -> length $ filter (== Just ix) nums) [0..] in
  ord0 : tot : ords

main = do
  t <- readLn
  sss <- replicateM t $ do
    n <- readLn
    replicateM n getLine
  let names = nub $ concat sss
  putStrLn $ maximumBy (comparing $ score1 sss) names
  putStrLn $ maximumBy (comparing $ score2 sss) names

import Control.Monad (liftM, replicateM, replicateM_)
import Data.List (intercalate, sort, maximumBy)
import Data.Map (Map(), assocs, fromListWith)
import Prelude hiding (reads)

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

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

type Driver  =  (String, [Int])

scores :: Driver -> Int
scores  =  sum . map score . snd
  where
    score n
      | n > 10  =  0
      | otherwise  =  head $ drop (n-1)
          [25, 18, 15, 12, 10, 8, 6, 4, 2, 1]

compare' :: Ord a => [a] -> [a] -> Ordering
compare' [] []  =  EQ
compare' [] _  =  GT
compare' _ []  =  LT
compare' (a:as) (b:bs)
    | a == b  =  compare' as bs
    | otherwise  =  compare a b

compareI :: Driver -> Driver-> Ordering
compareI a b
  | scores a /= scores b  =  compare (scores a) (scores b)
  | otherwise  =  compare' (sort (snd b)) (sort (snd a))

compareII :: Driver -> Driver -> Ordering
compareII a b
  | wins a /= wins b  =  compare (wins a) (wins b)
  | scores a /= scores b  =  compare (scores a) (scores b)
  | otherwise  =  compare' (sort (snd b)) (sort (snd a))
  where
    wins  =  length . filter (== 1) . snd

readRace ::IO [String]
readRace  =  do
    n  <-  readLn
    replicateM n getLine

solve :: [[String]] -> (String, String)
solve ss  =  (fst $ maximumBy compareI assocs', fst $ maximumBy compareII assocs')
  where
    foldSS :: [(String, [Int])]
    foldSS  =  concatMap (flip zip (map return [1..])) ss
    drivers :: Map String [Int]
    drivers  =  fromListWith (++) foldSS
    assocs'  =  assocs drivers

main :: IO ()
main  =  do
    n  <-  readLn
    races  <-  replicateM n readRace
    putStrLn $ fst $ solve races
    putStrLn $ snd $ solve races

data Racer = Racer { name :: String
                   , score :: Int
                   , wins :: [Int]
                   } deriving (Show)

main :: IO ()
main = interact func

scores :: [Int]
scores = [25, 18, 15, 12, 10, 8, 6, 4, 2, 1]

func :: String -> String
func s = onechamp racerdata ++ "\n" ++ anotherchamp racerdata ++ "\n"
  where racedata = convert s
        racerdata = fromRaceData racedata []

(!!!) :: [Int] -> Int -> Int
lst !!! n = if (length lst) <= n then 0 else (lst !! n)

onechamp :: [Racer] -> String
onechamp rd = name . check 0 $ candicates 0 [] rd
  where candicates _ cs [] = cs
        candicates hi cs (r:rs) = if score r > hi
                                  then candicates (score r) [r] rs
                                  else if score r == hi
                                       then candicates hi (r:cs) rs
                                       else candicates hi cs rs
        check _ [] = error ""
        check _ (r:[]) = r
        check n (r:rs) = let up = filter (\x -> (wins r)!!!n < (wins x)!!!n) rs
                         in if null up
                            then check (n+1) $ r:(filter (\x -> (wins r)!!!n == (wins x)!!!n) rs)
                            else check n up

anotherchamp :: [Racer] -> String
anotherchamp rd = name $ check 1 $ checkPoint $ candicates 0 [] rd
  where candicates _ cs [] = cs
        candicates hi cs (r:rs) = if (wins r)!!!0 > hi
                                  then candicates ((wins r)!!!0) [r] rs
                                  else if (wins r)!!!0 == hi
                                       then candicates hi (r:cs) rs
                                       else candicates hi cs rs
        check _ [] = error ""
        check _ (r:[]) = r
        check n (r:rs) = let up = filter (\x -> (wins r)!!!n < (wins x)!!!n) rs
                         in if null up
                            then check (n+1) $ r:(filter (\x -> (wins r)!!!n == (wins x)!!!n) rs)
                            else check n up
        checkPoint [] = error ""
        checkPoint (r:[]) = [r]
        checkPoint (r:rs) = let up = filter (\x -> (score r) < (score x)) rs
                            in if null up
                               then r:(filter (\x -> (score r) == (score x)) rs)
                               else checkPoint up

fromRaceData :: [[String]] -> [Racer] -> [Racer]
fromRaceData [] racer = racer
fromRaceData (r:rs) racer = fromRaceData rs $ f (zip [0..] r) racer
  where f [] nowr = nowr
        f ((n, na):rest) nowr = let rc = getOrNew na racer
                                    newwin = plusWins n $ wins rc
                                    newsc = score rc + scores !!! n
                                in f rest $ update na (rc {score = newsc, wins = newwin}) nowr

getOrNew :: String -> [Racer] -> Racer
getOrNew na rs = let lst = filter (\r -> name r == na) rs
                 in if null lst
                    then Racer {name=na,score=0,wins=[]}
                    else head lst

update :: String -> Racer -> [Racer] -> [Racer]
update na new rs = new:filter (\r -> name r /= na) rs

convert :: String -> [[String]]
convert s = convert' n (tail ls)
        where ls = lines s
              n = read $ head ls :: Int
              convert' 0 _ = []
              convert' n' ls' = [take m (tail ls')] ++ convert' (n'-1) (drop m (tail ls'))
                where m = (read $ head ls')::Int

plusWins :: Int -> [Int] -> [Int]
plusWins 0 [] = [1]
plusWins n [] = 0:plusWins (n-1) []
plusWins 0 (x:xs) = (x+1):xs
plusWins n (x:xs) = x:plusWins (n-1) xs

import Control.Monad (liftM, replicateM, replicateM_)
import Data.List (intercalate, sort, maximumBy)
import Data.Map (Map(), assocs, fromListWith)
import Prelude hiding (reads)

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

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

type Driver  =  (String, [Int])

scores :: Driver -> Int
scores  =  sum . map score . snd
  where
    score n
      | n > 10  =  0
      | otherwise  =  head $ drop (n-1)
          [25, 18, 15, 12, 10, 8, 6, 4, 2, 1]

compareI :: Driver -> Driver-> Ordering
compareI a b
  | scores a /= scores b  =  compare (scores a) (scores b)
  | otherwise  =  compare (sort (snd b)) (sort (snd a))

compareII :: Driver -> Driver -> Ordering
compareII a b
  | wins a /= wins b  =  compare (wins a) (wins b)
  | scores a /= scores b  =  compare (scores a) (scores b)
  | otherwise  =  compare (sort (snd a)) (sort (snd b))
  where
    wins  =  length . filter (== 1) . snd

readRace ::IO [String]
readRace  =  do
    n  <-  readLn
    replicateM n getLine

solve :: [[String]] -> (String, String)
solve ss  =  (fst $ maximumBy compareI assocs', fst $ maximumBy compareII assocs')
  where
    foldSS :: [(String, [Int])]
    foldSS  =  concatMap (flip zip (map return [1..])) ss
    drivers :: Map String [Int]
    drivers  =  fromListWith (++) foldSS
    assocs'  =  assocs drivers

main :: IO ()
main  =  do
    n  <-  readLn
    races  <-  replicateM n readRace
    putStrLn $ fst $ solve races
    putStrLn $ snd $ solve races


module Main where

import Control.Monad
import Data.List
import Data.Ord

main = do
    n <- read `liftM` getLine :: IO Int
    age <- ( map read . words ) `liftM` getLine :: IO [Int]

    let walrus = zip [1..] age
        walrusByAge = groupBy (\a b -> snd a == snd b) $ sortBy (comparing snd) walrus
        (walrusUnpleasant, _) = foldl' (\(result, prevPos) ws ->
                let rightMost = maximum $ map fst ws
                    result' = map (\(i,_) -> (i, if i > prevPos then -1 else prevPos - i - 1)) ws
                in (result' ++ result, max rightMost prevPos)
            ) ([], 0) walrusByAge
    --putStrLn $ show walrusUnpleasant
    putStrLn $ unwords $ map (show.snd) $ sortBy (comparing fst) walrusUnpleasant

    return ()

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

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

parseInput = do
    n <- readInt
    replicateM n readInt
  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 = BS.putStrLn =<< solve . evalState parseInput <$> BS.getContents

solve :: [Int] -> ByteString
solve a = BS.unwords $ map (BS.pack . show) (elems arr)
  where
    n = length a

    pairs = zip a [1..]
    pairsG = groupBy ((==) `on` fst) $ sort pairs

    arr = array (1, n) $ go pairsG (-1) [] :: UArray Int Int

    go [] _ ans = ans
    go (xs:xss) lastPos ans = go xss lastPos' ans'
      where
        positions = map snd xs

        ans' = [(p, if p < lastPos then lastPos - p - 1 else (-1)) | p <- positions] ++ ans
        lastPos' = maximum positions `max` lastPos

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

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


main = do
    a<-getLine
    b<-getLine
    let
        cc x = length ( filter (=='1') x )
    if ( cc a+( if odd (cc a) then 1 else 0 ) ) >= cc b
    then
    	putStrLn "YES"
    else putStrLn "NO"

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

solve :: [String] -> String
solve s
  | xb <= xa + xa `mod` 2 = "YES"
  | otherwise = "NO"
  where
  [xa, xb] = [sum [1 | '1' <- x] | x <- s]

m=length.filter(=='1')
s[a,b]=(m a+1)`div`2*2>=m b
p x|x="YES"|otherwise="NO"
main=interact$p.s.lines

import Control.Monad (liftM)
import Prelude hiding (reads)

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

solve :: String -> String -> Bool
solve a b  =  a1 + a1 `mod` 2 >= b1
  where
    a1  =  length $ filter (== '1') a
    b1  =  length $ filter (== '1') b

main :: IO ()
main  =  do
    a  <-  getLine
    b  <-  getLine
    if solve a b
        then putStrLn "YES"
        else putStrLn "NO"

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

fail' :: ByteString -> ByteString -> Bool
fail' a b = all fail [0..size]
    where
    size = B.length a
    inc = if odd (B.count '1' a) then 1 else 0

    fail k
        | r /= B.take (size - k) b = True
        | size == k + B.length b   = False
        | otherwise = (dec + B.count '1' l) < B.count '1' (B.drop (size - k) b)
        where
        (l, r) = B.splitAt k a
        dec = if B.index b (size - k) == '1' then inc else (-inc)

solve a b = if fail' a b && fail' a' b then "NO" else "YES"
    where a' = B.snoc a $ if odd (B.count '1' a) then '1' else '0'

main :: IO ()
main = do
    a <- B.filter (`elem` "01") <$> getLine
    getLine >>= putStrLn . solve a . B.filter (`elem` "01")

import Data.List

count :: String -> Int
count xs =   length . filter ( == '1' ) $ xs

helper :: [String] -> String
helper [ xs , ys ] = if div ( n + 1 ) 2 >= div ( m + 1 ) 2 then "YES" else "NO" where
          n = count xs
          m = count ys

main = interact $ helper . lines

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: ByteString -> ByteString -> String
solve a b = if all fail [0..size] then "NO" else "YES"
    where
    size = B.length a
    inc = if B.count '1' a `mod` 2 /= 0 then 1 else 0

    fail k
        | r /= B.take (size - k) b = True
        | size == k + B.length b   = False
        | otherwise = (dec + B.count '1' l) < B.count '1' (B.drop (size - k) b)
        where
        (l, r) = B.splitAt k a
        dec = if B.index b (size - k) == '1' then inc else (-inc)

main :: IO ()
main = do
    a <- getLine
    getLine >>= putStrLn . solve a

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: ByteString -> ByteString -> String
solve a b = if all fail [0..size] then "NO" else "YES"
    where
    size = B.length a
    inc = if odd (B.count '1' a) then 1 else 0

    fail k
        | r /= B.take (size - k) b = True
        | size == k + B.length b   = False
        | otherwise = (dec + B.count '1' l) < B.count '1' (B.drop (size - k) b)
        where
        (l, r) = B.splitAt k a
        dec = if B.index b (size - k) == '1' then inc else (-inc)

main :: IO ()
main = do
    a <- B.init <$> getLine
    getLine >>= putStrLn . solve a . B.init

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: ByteString -> ByteString -> String
solve a b = if all fail [0..size] then "NO" else "YES"
    where
    size = B.length a
    inc = if odd (B.count '1' a) then 1 else 0

    fail k
        | r /= B.take (size - k) b = True
        | size == k + B.length b   = False
        | otherwise = (dec + B.count '1' l) < B.count '1' (B.drop (size - k) b)
        where
        (l, r) = B.splitAt k a
        dec = if B.index b (size - k) == '1' then inc else (-inc)

main :: IO ()
main = do
    a <- B.filter (`elem` "01") <$> getLine
    getLine >>= putStrLn . solve a . B.filter (`elem` "01")

import Data.Char

change::Char->Char->Char
change a b =chr ( (( ord a-ord '0' + ord b - ord '0' ) `mod` 2)  + ord '0' )

check::String->String->Int->Int->Char->Bool
check a b begin_a begin_b now = if begin_b==length b then True
                                else if (b!!begin_b)==now then check a b begin_a (begin_b+1) (change now (b!!begin_b))
								else if begin_a==length a then False
								else check a b (begin_a+1) begin_b (change now (a!!begin_a))

work::String->String->Int->Bool
work a b i = if length a<i then False
             else if ( reverse ( take i (reverse a) ) ) /= (take i b) then False
			 else check head_a b 0 i (chr ( length (filter (=='1') a) + ord '0' ))
				where head_a = take (length a - i) a

main::IO()
main = do
	a<-getLine
	b<-getLine
	let
		ans=foldl (\acc t -> acc || work a b t ) False [0..(length b)]
	putStrLn $ if ans==False then "NO" else "YES"

main = do
    a<-getLine
    b<-getLine
    let
        cc x = length ( filter (=='1') x )
    if ( cc a+( if odd ( length a ) then 1 else 0 ) ) >= cc b
    then
    	putStrLn "YES"
    else putStrLn "NO"

import Data.List

match :: [ String ] -> String
match [ a , b ] = matchHelp ( a ++ take ( length b  + 10 ) ['0','0'..] )  b where
      matchHelp :: String -> String -> String
      matchHelp [] ys = "NO"
      matchHelp t@( x:xs) ys
       | isPrefixOf ys t  = "YES"
       | otherwise = matchHelp xs ys

main = interact  $  match . lines

import Data.List

match :: [ String ] -> String
match [ a , b ] = matchHelp ( a ++ take ( length b ) ['0','0'..] )  b where
      matchHelp :: String -> String -> String
      matchHelp [] ys = "NO"
      matchHelp t@( x:xs) ys
       | isPrefixOf ys t  = "YES"
       | otherwise = matchHelp xs ys

main = interact  $  match . lines

import Data.List

parity ::  String  -> Char
parity xs  = if odd . length . filter ( == '1' ) $ xs then '1' else '0'

match :: [ String ] -> String
match [ a , b ] = matchHelp ( a ++ take ( length b  ) [ n , n ..] )  b where
      matchHelp :: String -> String -> String
      matchHelp [] ys = "NO\n"
      matchHelp t@( x:xs) ys
       | isPrefixOf ys t  = "YES\n"
       | otherwise = matchHelp xs ys
      n = parity a

main = interact  $  match . lines

import Data.List

match :: [ String ] -> String
match [ a , b ] = matchHelp ( a ++ take ( length b  + 10 ) ['0','0'..] )  b where
      matchHelp :: String -> String -> String
      matchHelp [] ys = "NO\n"
      matchHelp t@( x:xs) ys
       | isPrefixOf ys t  = "YES\n"
       | otherwise = matchHelp xs ys

main = interact  $  match . lines

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

solve :: [String] -> String
solve (a : b : _)
  | s || null b3 || (t && (mod (ij !! 0) 2 > 0 || ij !! 1 > 0)) = "YES"
  | otherwise = "NO"
  where
  a1 = reverse a
  b1 = reverse b
  x = length $ takeWhile (== '0') a1
  y = length $ takeWhile (== '0') b1
  b2 = drop (y - x) b1
  (s, _) = sub b2 a1 0
  b3 = dropWhile (== '0') b2
  (t, ij) = sub (tail b3) a1 0

sub :: String -> String -> Int -> (Bool, [Int])
sub [] b i = (True, [i, length $ filter (== '1') b])
sub _ [] _ = (False, [])
sub (x : a) (y : b) i
  | x /= y = (False, [])
  | otherwise = sub a b (if x == '1' then i + 1 else i)


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

getMin :: [Integer] -> Integer
getMin [] = 0
getMin xs = ((minimum &&& (length >>> fromIntegral >>> (`mod` 2))) >>> uncurry (*)) xs

main :: IO ()
main = do
    _ <- getLine
    xs <- liftM (map(read::String->Integer) . words) getLine
    print $ (((sum::[Integer] -> Integer)  *** ((sum &&& getMin) >>> uncurry (-))) >>> uncurry (+)) $ partition even xs

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

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

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

main = do
  getLine
  xs <- map fromIntegral <$> getInts :: IO [Int64]

  let
    (a, b) = partition even xs

  print $ sum a + sum (if even $ length b then b else (tail $ sort b))

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  getLine
  inp <- fmap (map read . words) getLine
  print $ solve inp

solve :: [Integer] -> Integer
solve = g . dropWhile (<=0) . sort
    where
      g [] = 0
      g x | even (sum x) = sum x
          | otherwise = sum prefix + sum suffix
          where
            (prefix, _:suffix) = break odd x

inp :: [Integer]
inp = [999999999, 999999999, 999999999, 999999999, 999999999]

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine >>=  \n-> (solve.concat =<< forM [1.. 1] ( \i -> map (fst.fromJust.C.readInteger).C.words<$>C.getLine))
solve xs = let fs= filter (\a->a `mod`2/=0) xs; m = if fs/=[] then minimum fs else 0 ; s=sum xs in if s `mod`2==0  then print s else print (s-m)

module Main where

import Data.List
import Data.String
import Data.Maybe
import Data.Either
import Data.Ord
import Control.Monad
import Control.Applicative
import Control.Arrow

main :: IO()
main = do
    _ <- liftM (read::String->Integer) getLine
    xs <- liftM (map(read::String->Integer) . words) getLine
    print $ foldl (+) 0 (filter even xs) + foldl (+) 0 (let ys = sort $ filter odd xs in if even (length ys) then ys else tail ys)

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

process a | even s = s
          | otherwise = s-m
  where s = sum a
        m = minimum $ filter odd a

main=do
  getLine
  a<- map read <$> words <$> getLine ::IO [Integer]
  print $ process a

import qualified Data.ByteString.Char8 as B
import Data.List
main = do
    B.getLine
    ns <- fmap (map readInteger . B.words) B.getLine
    let s = sum ns
    print $ if even s then s else s - minimum (filter odd ns)
readInteger s = i where Just (i,_) = B.readInteger s

import Data.List.Split

solve n
    | (length o) `rem` 2 == 0 = sum o + sum e
    | otherwise = sum e + sum o - minimum o
    where
        o = filter odd n
        e = filter even n

main = do
    name <- getLine
    s <- getLine
    let foo = solve (map (read) (splitOn " " s))
    putStrLn $ show foo

import Control.Monad
import Data.List

main = do
  getLine
  s <- getLine
  let ss = words s
      ns = sort $ map (\x -> read x :: Integer) ss
      summ = sum ns
  if even summ
    then putStrLn $ show summ
    else putStrLn $ show (summ - firstOdd ns)

firstOdd :: [Integer] -> Integer
firstOdd (x:xs)
  | odd x     = x
  | otherwise = firstOdd xs

solve a
	| even s    = s
	| otherwise = s - minimum [x | x <- a, odd x]
	where s = sum a

main = do
	_ <- getLine
	l <- getLine
	print $ solve (map read (words l))

solve a
	| even s    = s
	| otherwise = s - minimum (filter odd a)
	where s = sum a

main = do
	_ <- getLine
	l <- getLine
	print $ solve(map read (words l))

import Control.Applicative
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

myprint x1 = putStrLn $ intercalate " " $ map show x1

main= do
	n<-  read <$> getLine  ::IO Int
	s<- map (fst.fromJust.C.readInteger) . C.words <$> C.getLine ::IO [Integer]
	let ss = sum s
	let m = filter odd s
	if even (length m ) then print ss else print $ ss - minimum m

getLoL :: (Read a) => IO [[a]]
getLoL = fmap (fmap (fmap read . words) . lines) getContents

main :: IO ()
main = do
        [_, xs]  <- getLoL
        print $ solve xs

solve :: [Integer] -> Integer
solve xs = if even s then s else s - leastOdd
    where s = sum xs
          leastOdd = minimum [x | x <- xs, odd x]

import Data.List

solve xs | s `mod` 2 == 0 = s
         | m > 0          = s - (minimum os)
         | otherwise      = 0
         where
            s = sum xs
            os = filter odd xs
            m = length os

main :: IO ()
main = do
    input <- getContents
    let xs = map read $ words $ last $ lines input :: [Integer]
    print $ solve xs

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

main :: IO ()
main = do
    _ <- getLine
    xs <- liftM (map(read::String->Int) . words) getLine
    print $ ((sum *** (sum &&& ((minimum &&& (length >>> (`mod` 2))) >>> uncurry (*)) >>> uncurry (-))) >>> uncurry (+)) $ partition even xs

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  getLine
  inp <- fmap (map read . words) getLine
  print $ solve inp

solve :: [Int] -> Int
solve = g . takeWhile (>=0) . sort
    where
      g [] = 0
      g x | even (sum x) = sum x
          | otherwise = sum prefix + sum suffix
          where
            (prefix, _:suffix) = break odd x

inp :: [Int]
inp = [999999999, 999999999, 999999999, 999999999, 999999999]

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

process a | even s = s
          | otherwise = s-m
  where s = sum a
        m = minimum $ filter odd a

main=do
  getLine
  a<- map read <$> words <$> getLine ::IO [Int]
  print $ process a

import Control.Monad
import Data.List

main = do
  getLine
  s <- getLine
  let ss = words s
      ns = sort $ map (\x -> read x :: Int) ss
      summ = sum ns
  if even summ
    then putStrLn $ show summ
    else putStrLn $ show (summ - firstOdd ns)

firstOdd :: [Int] -> Int
firstOdd (x:xs)
  | odd x     = x
  | otherwise = firstOdd xs

solve a
	| even s    = s
	| otherwise = s - minimum a
	where s = sum a

main = do
	_ <- getLine
	l <- getLine
	print $ solve (map read (words l))

import Data.List

solve xs | s `mod` 2 == 0 = s
         | m > 0          = s - (minimum os)
         | otherwise      = 0
         where
            s = sum xs
            os = filter odd xs
            m = length os

main :: IO ()
main = do
    input <- getContents
    let xs = map read $ words $ last $ lines input :: [Int]
    print $ solve xs

import Data.List

solve xs | s `mod` 2 == 0 = s
         | m > 0          = s - head os
         | otherwise      = 0
         where
            os = sort $ filter odd xs
            m = length os
            s = sum xs

main :: IO ()
main = do
    input <- getContents
    let xs = map read $ words $ last $ lines input :: [Int]
    print $ solve xs


testcase :: Int->[Int]
testcase x  | mod x 3 == 0 = [(a+1), (a+2), a]
            | mod x 3 == 1 = [(b+1), (b+3), b]
            | mod x 3 == 2 = [(c+2), (c+3), c]
                where   a = div (x-3) 3
                        b = div (x-4) 3
                        c = div (x-5) 3

solve :: Int -> IO()
solve 0 = putStr ""
solve k = do
    line <- getLine
    let {   n = read ((words line) !! 0);
            a = testcase n;
            solution = unwords . map show $ a}
    putStrLn solution
    --putStrLn ("TEST: "++ show k)
    solve (k-1)

main::IO()
main = do
    line <- getLine
    let {a = read ((words  line) !! 0)}
    solve a

--Problem A, CF #797 (Div. 3)

-- boilerplate {{{1
-- vim: foldmethod=marker
-- pragmas {{{2
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}

module Main where -- {{{2

import Control.Applicative
import Control.Arrow ( (|||), (&&&) )
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Foldable hiding ( sum, product )
import Data.Function
import Data.Functor
import Data.IntMap ( IntMap )
import Data.IntSet ( IntSet )
import Data.List hiding ( sum, product )
import Data.Map ( Map )
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Semigroup ( Min(..), Max(..) )
import Data.Sequence ( Seq )
import Data.Set ( Set )
import Data.Text ( Text )
import Data.Traversable
import Data.Tuple
import Debug.Trace
import Prelude hiding ( sum, product )
import System.IO
-- import System.Random
import Text.Printf
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap           as IM
import qualified Data.IntSet           as IS
import qualified Data.Map              as LM
import qualified Data.Map.Strict       as M
import qualified Data.Sequence         as Q
import qualified Data.Set              as S
import qualified Data.Text             as T
import qualified Data.Text.IO          as T

-- utilites {{{2
readInt s = let Just (i,_) = C.readInt s in i :: Int
getInt = readInt <$> C.getLine
getInts = map readInt . C.words <$> C.getLine
putShows :: Show a => [a] -> IO ()
putShows = putStrLn . unwords . map show
ynq = putStrLn . bool "NO" "YES"
gcount g@(x:_) = (x, length g)
modulus = 10^9 + 7 :: Int
mod' x = rem x modulus
tri n = quot (n * n + n) 2
sum t     = foldl' (+) 0 t
product t = foldl' (*) 1 t
mprint :: Show a => String -> Maybe a -> IO ()
mprint s = maybe (putStrLn s) print
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM b t e = b >>= bool e t
whenM :: Monad m => m Bool -> m () -> m ()
whenM b t = ifM b t (pure ())

-- }}}1

main = getInt >>= flip replicateM_ docase

docase = do
    [n] <- getInts
    let (q,r) = quotRem n 3
    putShows $ case r of
        0 -> [q,q+1,q-1]
        1 -> [q,q+2,q-1]
        2 -> [q+1,q+2,q-1]

module Main where

import Data.List
import Data.Maybe
import qualified Data.Map.Strict as Map

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let sols = map (format . solve . parse) $ take t $ sep $ lines input
  mapM_ putStrLn sols

sep = id

parse = read

format = id

solve n = unwords $ map (show . (+b)) p
  where (b,x) = (n-3) `divMod` 3
        p = case x of
              0 -> [1,2,0]
              1 -> [1,3,0]
              2 -> [2,3,0]

{-# LANGUAGE LambdaCase #-}

module Main where

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

--

solve :: Int -> (Int, Int, Int)
solve n = case n `divMod` 3 of
  (k, 0) -> (k, k + 1, k - 1)
  (k, 1) -> (k, k + 2, k - 1)
  (k, 2) -> (k + 1, k + 2, k - 1)
  _ -> error "fuck"

input = int

output (a, b, c) = C.unwords . map (C.pack . show) $ [a, b, c]

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

-- Scanner

type Scanner = State [C.ByteString]

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

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith sp sc = evalState sc . sp

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

read' :: (C.ByteString -> Maybe (a, C.ByteString)) -> Scanner a
read' q = fst . fromJust . q <$> bstr

int :: Scanner Int
int = read' C.readInt

integer :: Scanner Integer
integer = read' C.readInteger

(><) :: Int -> Scanner a -> Scanner [a]
(><) = replicateM

numberOf :: Scanner a -> Scanner [a]
numberOf = (int >>=) . flip (><)

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> (Int, Int, Int)
solve s = (h2, h3, h1)
    where
        h1 = (s - 3) `div` 3
        h2 = (s - h1 - 1) `div` 2
        h3 = s - h1 - h2

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        s <- B8.getLine <&> readIntB8
        let (h1, h2, h3) = solve s
        printf "%d %d %d\n" h1 h2 h3


import Data.Maybe
import Data.Bool
import Control.Monad

convL2R :: Char -> Char
convL2R '[' = ']'
convL2R '{' = '}'
convL2R '(' = ')'
convL2R '<' = '>'
convL2R _ = undefined

isrbr :: Char -> Bool
isrbr ']' = True
isrbr '}' = True
isrbr ')' = True
isrbr '>' = True
isrbr _ = False

solve' :: String -> [Char] -> Maybe Int
solve' (x:xs) y
 | and [isrbr x, y == []] = Nothing
 | isrbr x = liftM2 (+) (if x == head y then Just 0 else Just 1) (solve' xs (tail y) )
 | otherwise = solve' xs ([convL2R x] ++ y)

solve' _ [] = Just 0
solve' _ _ = Nothing

solve :: String -> Maybe Int
solve x = solve' x []

pImpossible :: Maybe Int -> String

pImpossible Nothing = "Impossible\n"
pImpossible a = show $ fromJust a

parse :: String -> String

parse = pImpossible . solve . unwords. words

main = interact parse

import Data.Maybe
import Control.Applicative

close c
    | c == '[' = ']'
    | c == '(' = ')'
    | c == '<' = '>'
    | c == '{' = '}'

isOpen x = x == '{' || x == '[' || x == '<' || x == '('

fold :: [Char] -> [Char] -> Maybe Int
fold [] [] = Just 0
fold (x:xs) []
    | isOpen(x) = fold xs [x]
    | otherwise = Nothing

fold [] (p:ps) = Nothing

fold (x:xs) (p:ps)
    | x == '{' || x == '[' || x == '<' || x == '(' = fold xs (x:p:ps)
    | x == close p = fold xs ps
    | otherwise = pure (+) <*> Just 1 <*> fold xs ps

answer :: Maybe Int -> String
answer Nothing = "Impossible"
answer (Just i) = show(i)

main = getLine >>= (\s -> putStrLn $ answer $ fold s [])

close c
    | c == '[' = ']'
    | c == '(' = ')'
    | c == '<' = '>'
    | c == '{' = '}'

isOpen x = x == '{' || x == '[' || x == '<' || x == '('

fold :: [Char] -> [Char] -> Int
fold [] [] = 0
fold (x:xs) []
    | isOpen(x) = fold xs [x]
    | otherwise = -100000

fold [] (p:ps) =
    -10000000

fold (x:xs) (p:ps)
    | x == '{' || x == '[' || x == '<' || x == '(' = fold xs (x:p:ps)
    | x == close p = fold xs ps
    | otherwise = 1 + fold xs ps

answer i
    | i >= 0 = show i
    | otherwise = "Impossible"

main = getLine >>= (\s -> putStrLn $ answer (fold s []))

import Control.Monad

main = interact $ (\[s] -> case foldM f ("", 0) s of
                            Just ([], a) -> show a
                            _ -> "Impossible"
                  ) . words

f (s, a) c
    | elem c "<([{" = Just (c:s, a)
    | otherwise = case s of
                    [] -> Nothing
                    (x:r) -> Just (r, a + if x == l c then 0 else 1)

l '>' = '<'
l ')' = '('
l ']' = '['
l '}' = '{'

import Control.Monad

main = interact $ (\[s] -> case foldM f ("", 0) s of
                            Just ([], a) -> show a
                            _ -> "Impossible"
                  ) . words

f (s, a) c
    | elem c ['<', '(', '[', '{'] = Just (c:s, a)
    | otherwise = case s of
                    [] -> Nothing
                    (x:r) -> Just (r, a + if x == l c then 0 else 1)

l '>' = '<'
l ')' = '('
l ']' = '['
l '}' = '{'

fldl :: (Maybe (a, Int) -> b -> Maybe (a, Int)) -> Maybe (a, Int) -> [b] -> Maybe (a, Int)
fldl f st [] = st
fldl f st (x:xs) = fldl f (f st x) xs

solve :: Maybe (String, Int) -> Char -> Maybe (String, Int)
solve Nothing _ = Nothing
solve (Just x) '{' = Just (('{': fst x), snd x)
solve (Just x) '[' = Just (('[': fst x), snd x)
solve (Just x) '(' = Just (('(': fst x), snd x)
solve (Just x) '<' = Just (('<': fst x), snd x)
solve (Just ((x:xs), n)) '}' = if x == '{' then Just (xs, n) else Just (xs, n + 1)
solve (Just ((x:xs), n)) ']' = if x == '[' then Just (xs, n) else Just (xs, n + 1)
solve (Just ((x:xs), n)) ')' = if x == '(' then Just (xs, n) else Just (xs, n + 1)
solve (Just ((x:xs), n)) '>' = if x == '<' then Just (xs, n) else Just (xs, n + 1)
solve _ _ = Nothing

predicat :: Maybe (String, Int) -> String
predicat (Just ([], x)) = show x
predicat (Just (_, _)) = "Impossible"
predicat Nothing = "Impossible"

main :: IO()
main = getLine >>= \s -> putStrLn $ predicat $ fldl solve (Just ([], 0)) s

import Data.List

main = do
  s <- getLine

  let
    count [] [] = Just 0
    count [] _ = Nothing
    count (c:s) stack
      | c `elem` os = count s (c:stack)
      | null stack = Nothing
      | top `notElem` os = Nothing
      | otherwise = (+ a) `fmap` (count s (tail stack))
      where
        os = "[<{("
        cs = "]>})"
        a = if c `elemIndex` cs == top `elemIndex` os then 0 else 1
        top = head stack

    r = count s []

  case r of
    Nothing -> putStrLn "Impossible"
    Just c -> putStrLn $ show c

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

main = do
    s <- takeWhile (not . isSpace) . BS.unpack <$> BS.getLine
    putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    _   -> error ""

fldl :: ((a, Int) -> b -> (a, Int)) -> (a, Int) -> [b] -> (a, Int)
fldl f st [] = st
fldl f st (x:xs) = fldl f (f st x) xs

solve :: (String, Int) -> Char -> (String, Int)
solve x '{' = (('{': fst x), snd x)
solve x '[' = (('[': fst x), snd x)
solve x '(' = (('(': fst x), snd x)
solve x '<' = (('<': fst x), snd x)
solve ([], n) _ = (['>'], 0)
solve ((x:xs), n) '}' = if x == '{' then (xs, n) else (xs, n + 1)
solve ((x:xs), n) ']' = if x == '[' then (xs, n) else (xs, n + 1)
solve ((x:xs), n) ')' = if x == '(' then (xs, n) else (xs, n + 1)
solve ((x:xs), n) '>' = if x == '<' then (xs, n) else (xs, n + 1)
solve ((x:xs), n) _ = (['>'], 0)

predicat :: (String, Int) -> String
predicat ([], x) = show x
predicat (_, _) = "Impossible"

main :: IO()
main = getLine >>= \s -> putStrLn $ predicat $ fldl solve ([], 0) s

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

main = do
    s <- BS.unpack <$> BS.getLine
    putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    ')' -> '('
    ']' -> '['
    '}' -> '{'
    '>' -> '<'

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

main = do
    s <- BS.unpack <$> BS.getLine
    BS.getContents
    putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    ')' -> '('
    ']' -> '['
    '}' -> '{'
    '>' -> '<'

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

main = do
    s <- BS.unpack <$> BS.getLine
    putStrLn s
    --putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    _   -> error ""

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

main = do
    s <- BS.unpack <$> BS.getLine
    print $ length s
    --putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    _   -> error ""


import Control.Monad (liftM)
import Data.Char (ord)
import Data.Function (on)
import Data.List (intercalate, groupBy, sort, sortBy)

solve :: Integer -> [Integer] -> Int
solve k as  =  sum $ map (cut . sort . map fst) $ groupSnd $ sortSnd $ zip as $ map kClass as
  where
    sortSnd  =  sortBy (compare `on` snd)
    groupSnd  =  groupBy ((==) `on` snd)
    kClass x
      | x `mod` k == 0  =  kClass (x `div` k)
      | otherwise  =  x
    cut (a:b:xs)
      | a * k == b  =  1 + cut xs
      | otherwise  =  1 + cut (b:xs)
    cut xs  =  length xs

main :: IO ()
main  =  do
    [n, k]  <-  reads
    if k == 1 then
        print n
    else do
        as  <-  reads
        print $ solve k as

  where

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

import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Data.List(sort)

main = putStrLn . show . solve . map (toInteger . maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Integer] -> Int
solve (_ : 1 : as) = length as
solve (_ : k : as) = sum [(length x + 1) `div` 2 | (_, xs) <- M.toList $ M.fromListWith (++) [(root a, [a]) | a <- as], x <- split $ sort xs]
  where
  split (x : xs) = split' [[x]] xs
  split' ((a : xs) : xss) (b : ys)
    | a * k == b = split' ((b : a : xs) : xss) ys
    | otherwise  = split' ([b] : (a : xs) : xss) ys
  split' xss _ = xss
  root a
    | mod a k > 0 = a
    | otherwise   = root (div a k)

{-# LANGUAGE BangPatterns #-}

import qualified Data.IntSet as S
import Data.List

main = do
  [_, k] <- (map read . words) `fmap` getLine
  as     <- (map read . words) `fmap` getLine
  print (solve k as)

solve :: Int -> [Int] -> Int
solve k s = go S.empty (reverse $ sort s)
  where
    mx = maxBound `div` k
    go !s (x:xp) | x > mx || (x*k) `S.notMember` s = go (S.insert x s) xp
                 | otherwise                       = go s xp
    go  s   []   = S.size s

import Control.Applicative ((<$>), (<*>))
import Data.List (foldl', sort)
import qualified Data.Set as S

main :: IO ()
main = print =<< solve <$> (read <$> (!!1) <$> words <$> getLine) <*> (map read <$> words <$> getLine)

solve :: Integer -> [Integer] -> Int
solve k = S.size . foldl' (\s x -> if S.member x s then s else S.insert (k * x) s) S.empty . sort

import Data.List as List
import qualified Data.Set as Set

readInts :: String -> [Integer]
readInts str = map read (words str)

g :: Integer -> Set.Set Integer -> Integer -> Set.Set Integer
g k set x
 |Set.member (k*x) set = set
 |otherwise = Set.insert x set

main :: IO ()
main = do
  [_, k] <- fmap readInts getLine
  xs' <- fmap readInts getLine
  let xs = reverse $ List.sort xs'
  print $ Set.size $ foldl' (g k) Set.empty xs

import Data.List as List
import qualified Data.Set as Set

readInts :: String -> [Double]
readInts str = map read (words str)

g :: Double -> Set.Set Double -> Double -> Set.Set Double
g k set x
 |Set.member (k*x) set = set
 |otherwise = Set.insert x set

main :: IO ()
main = do
  [_, k] <- fmap readInts getLine
  xs' <- fmap readInts getLine
  let xs = reverse $ List.sort xs'
  print $ Set.size $ foldl' (g k) Set.empty xs

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import qualified Data.Set as S

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

main :: IO ()
main = do
  [n,k] <- map read.words <$> getLine
  xs <- map readInteger.B.words <$> B.getLine
  print $ solve k xs

solve :: Integer -> [Integer] -> Int
solve k xs = go 0 S.empty $ sort xs
   where
     go !res !set (x:xs)
       | x `S.member` set = go res set xs
       | otherwise = go (res+1) (S.insert (k*x) set) xs
     go res _ _ = res

import Control.Applicative ((<$>), (<*>))
import Data.List (foldl')
import qualified Data.Set as S

main :: IO ()
main = print =<< solve <$> (read <$> (!!1) <$> words <$> getLine) <*> (map read <$> words <$> getLine)

solve :: Integer -> [Integer] -> Int
solve k = S.size . foldl' (\s x -> if S.member x s then s else S.insert (k * x) s) S.empty

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import qualified Data.Set as S

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

main :: IO ()
main = do
  [n,k] <- map read.words <$> getLine
  xs <- map readInteger.B.words <$> B.getLine
  print $ solve k xs

solve :: Integer -> [Integer] -> Int
solve k xs = go 0 S.empty $ sort xs
   where
     go !res !set (x:xs)
       | x `S.member` set = go res (S.insert (k*x) set) xs
       | otherwise = go (res+1) (S.insert (k*x) set) xs
     go res _ _ = res

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import qualified Data.Set as S

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

main :: IO ()
main = do
  [n,k] <- map read.words <$> getLine
  xs <- map readInteger.B.words <$> B.getLine
  print $ solve k xs

solve :: Integer -> [Integer] -> Int
solve k xs = go 0 S.empty $ map (\ys->(length ys,ys!!0)) $ group $ sort xs
   where
     go !res !set ((l,x):xs)
       | x `S.member` set = go res (S.insert (k*x) set) xs
       | otherwise = go (res+l) (S.insert (k*x) set) xs
     go res _ _ = res