import Data.Array as A
import Data.List

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. split. fmap (fmap read. words). lines
    where split a = (a !! 0 !! 0, init. tail $ a, last a)
          prep = fork (id, fmap toTpl, id)
            where fork (f, g, h) (a, b, c) = (f a, g b, h c)
                  toTpl a = (a !! 0, a !! 1)

printAns x = case x of
    Nothing -> "NO"
    Just v -> unlines ["YES", show v]

solve :: Int -> [(Int, Int)] -> [Int] -> Maybe Int
solve n edges colors =
    fmap fst. find sufficient. A.assocs. countForVertices $ importantEdges
    where
        importantEdges = filter isImportant edges
            where isImportant (u, v) = colorArr A.! u /= colorArr A.! v
                  colorArr = A.listArray bounds colors
        countForVertices = A.accumArray (\v _ -> v+1) 0 bounds. undirect
            where undirect = concatMap (\(u,v) -> [(u,v), (v,u)])
        sufficient = (== (length importantEdges)). snd
        bounds = (1, n)

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

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function (on)
import           Data.Array
-- import           Data.Array.Unboxed
-- import           Data.Array.IArray
-- import           Data.Array.ST
-- import           Data.Array.MArray
-- import           Data.Array.Unsafe
import           Data.Ix
import           Data.Maybe
import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
import           Data.Graph
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntSet (IntSet)
-- import qualified Data.IntSet as S
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as M
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S
-- import           Debug.Trace

main = do
  v <- readInt1 <$> BS.getLine
  es <- map readInt2 <$> replicateM (v-1) BS.getLine
  cs <- readIntN <$> BS.getLine
  -- print $ fst . maximumBy (compare `on` snd) . assocs . outdegree . buildG (1,v) $ es ++ map swap es
  format $ solve v es cs

format :: Maybe Int -> IO ()
format Nothing = putStrLn "NO"
format (Just a) = do
  putStrLn "YES"
  print a

hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]

solve :: Int -> [Edge] -> [Int] -> Maybe Int
solve v es cs = if
  | uniColor cs -> Just 1
  | maxDiffEdges == cntDiffColor (edges graph) -> Just maxDiffNode
  | otherwise -> Nothing
  where
    uniColor (c:cs) = all (==c) cs
    graph = buildG (1,v) $ es ++ map swap es
    -- maxDegNode = fst . maximumBy (compare `on` snd) . assocs $ outdegree graph
    -- maxDegEdges = map (,maxDegNode) $ graph!maxDegNode
    color = listArray (1,v) cs
    isDiffColor (a,b) = (color!a) /= (color!b)
    cntDiffColor = length . filter isDiffColor
    diffEdgeHist = hist (1,v) . concatMap fromTuple . filter isDiffColor $ edges graph
    maxDiffEdges = maximum $ elems diffEdgeHist
    maxDiffNode = fst . maximumBy (compare `on` snd) . assocs $ diffEdgeHist

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

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

readInt641 :: BS.ByteString -> Int64
readInt641 = fromIntegral . fst . fromJust . BS.readInteger

readInt642 :: BS.ByteString -> (Int64,Int64)
readInt642 = toTuple . readInt64N

readInt643 :: BS.ByteString -> (Int64,Int64,Int64)
readInt643 = toTriple . readInt64N

readInt64N :: BS.ByteString -> [Int64]
readInt64N =  map readInt641 . BS.words

readInteger1 :: BS.ByteString -> Integer
readInteger1 = fst . fromJust . BS.readInteger

readInteger2 :: BS.ByteString -> (Integer,Integer)
readInteger2 = toTuple . readIntegerN

readInteger3 :: BS.ByteString -> (Integer,Integer,Integer)
readInteger3 = toTriple . readIntegerN

readIntegerN :: BS.ByteString -> [Integer]
readIntegerN =  map readInteger1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

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

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

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

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array
import Data.Tuple
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = map readInt . B.words

solve :: Int -> [(Int, Int)] -> [Int] -> Maybe Int
solve n g cs' =
  let
    bnd = (1, n)
    cs = listArray bnd cs'
    diffs = filter (\(u, v) -> cs!u /= cs!v) g
    ln = length diffs
  in
    fst <$> (find (\(u, c) -> c == ln) . assocs . accumArray (\c u -> c + 1) 0 bnd $ concatMap (\(u, v) -> [(u, v), (v, u)]) diffs)

main = do
  n <- readInt <$> B.getLine
  g <- map ((\(u:v:_) -> (u, v)) . readInts) <$> replicateM (n - 1) B.getLine
  cs <- readInts <$> B.getLine
  putStrLn $ maybe "NO" (("YES\n" ++) . show) $ solve n g cs

import Data.Array as A
import Data.List

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. split. fmap (fmap read. words). lines
    where split a = (head a !! 0, init. tail $ a, last a)
          prep = fork (id, fmap toTpl, id)
            where fork (f, g, h) (a, b, c) = (f a, g b, h c)
                  toTpl a = (a !! 0, a !! 1)

printAns x = case x of
    Nothing -> "NO"
    Just v -> unlines ["YES", show v]

solve :: Int -> [(Int, Int)] -> [Int] -> Maybe Int
solve n edges colors =
    fmap fst. find sufficient. A.assocs. countForVertices $ importantEdges
    where
        importantEdges = filter isImportant edges
            where isImportant (u, v) = colorArr A.! u /= colorArr A.! v
                  colorArr = A.listArray bounds colors
        countForVertices = A.accumArray (\v _ -> v+1) 0 bounds. undirect
            where undirect = concatMap (\(u,v) -> [(u,v), (v,u)])
        sufficient = (==) importantCnt. snd
            where importantCnt = length importantEdges
        bounds = (1, n)


import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

type Long = Int

solve :: Double -> Double
solve n = r*2 * cos (pi * abs (i/n - 1/4))
    where
        r = 0.5 / sin (pi/2/n)
        i = fromIntegral $ round (n/4)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:_) <- readWords
    print $ solve n
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine

import Data.List

solve :: Double -> Double
solve n = cos(pi/(4*n))/sin(pi/(2*n))

main = interact $
          (intercalate "\n")
          . (map (show . solve . read))
          . (drop 1)
          . words


import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if midZero then 1 else 0)
        midZero = odd n && C.index str (n `div` 2) == '0'
        z = C.count '0' str
        result
            | m == 0 = "BOB"
            | m == 1 && midZero && z > 1 = "ALICE"
            | m == 1 && midZero = "BOB"
            | m == 2 && midZero && z == 2 = "DRAW"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import           Control.Monad

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        _ <- getLine
        s <- getLine
        let winner = if reverse s == s
                        then solvePalin s
                        else solveNonPalin s
        putStrLn winner

countZeros :: String -> Int
countZeros = length . filter (== '0')

solvePalin :: String -> String
solvePalin s = let z = countZeros s in if even z || z == 1
                                        then "BOB"
                                        else "ALICE"

solveNonPalin :: String -> String
solveNonPalin s
  | even n || countZeros s /= 2  = "ALICE"
  | otherwise                    = if s !! quot n 2 == '0'
                                      then "DRAW"
                                      else "ALICE"
  where n = length s

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if midZero then 1 else 0)
        midZero = odd n && C.index str (n `div` 2) == '0'
        z = C.count '0' str
        result
            | m == 0 = "BOB"
            | m == 1 && midZero && z > 1 = "ALICE"
            | m == 1 && midZero = "BOB"
            | m == 2 && midZero && z == 2 = "DRAW"
            | m == 2 && midZero = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if odd n && C.index str (n `div` 2) == '0' then 1 else 0)
        z = C.count '0' str
        result
            | m == 0 = "BOB"
            | m == 1 && (odd n && C.index str (n `div` 2) == '0') && z > 1 = "ALICE"
            | m == 1 && (odd n && C.index str (n `div` 2) == '0') = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if odd n && C.index str (n `div` 2) == '0' then 1 else 0)
        result
            | m == 1 && (odd n && C.index str (n `div` 2) == '0') || m == 0 = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if odd n && C.index str (n `div` 2) == '0' then 1 else 0)
        z = C.count '0' str
        result
            | z - m >= 2 && m == 0 = "BOB"
            | z == 1 && odd n && C.index str (n `div` 2) == '0' = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if odd n && C.index str (n `div` 2) == '0' then 1 else 0)
        z = C.count '0' str
        result
            | z - m >= 2 && m == 0 = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result


module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
main = B.interact exec
exec = B.pack . show . solve . map int . B.words
  where int = maybe undefined fst . B.readInt
solve (n:ls) = length $ filter (== 0) $ scanl1 (+) $  elems (accumArray (+) 0 (1, n) $ concat $ zipWith (\i l -> let lo = max 1 $ i -l in if lo > i - 1 then [] else [(max 1 $ i - l, 1), (i, -1)]) [1..] ls :: UArray Int Int)

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU
{-# LANGUAGE OverloadedStrings #-}

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

readI = fst . fromJust . C.readInt

main = C.interact $ C.pack . solve . map readI . C.words

solve (_:xs) = show ans
    where
        ans = fst $ foldl f (0, 0) $ reverse xs
        f (a, 0) x = (a + 1, x)
        f (a, k) x = (a, max (k-1) x)

module Main where
import Data.Array.Unboxed
main = interact exec
exec = show . solve . map read . words
solve (n:ls) = length $ filter (== 0) $ elems (accumArray (+) 0 (1, n) $ concat $ zipWith (\i l -> [(max 1 $ i - l, 1), (i, -1)]) [1..] ls :: UArray Int Int)


{-# OPTIONS_GHC -O3 -optc-O3 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, MagicHash #-}

import GHC.Prim (uncheckedIShiftL#,uncheckedIShiftRL#)
import GHC.Exts (Int(..))
import Control.Applicative ((<$>))
import Control.Monad (unless,when,forM_)
import Data.Array.Base
import Data.Array.IO (IOUArray)
import Data.Bits (testBit,shiftL,shiftR,xor,(.&.),(.|.))
import qualified Data.ByteString.Char8 as B (ByteString,readInt,words,getContents,getLine)
import Data.Int (Int64)
import Data.List (foldl')

infixl 8 .<<. , .>>.
(.<<.) :: Int -> Int -> Int
(I# x).<<.(I# i) = I# (uncheckedIShiftL# x i)
(.>>.) :: Int -> Int -> Int
(I# x).>>.(I# i) = I# (uncheckedIShiftRL# x i)
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

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

rep :: Int -> (Int -> IO ()) -> IO ()
rep !n f = go 0
   where
     go !i
       | i<n = f i >> go (i+1)
       | otherwise = return ()
{-# INLINE rep #-}

toDecimal :: [Int] -> Int64
toDecimal xs = foldl' (\x y->x`shiftL`1 + fromIntegral y) 0 xs
{-# INLINE toDecimal #-}

data SegTree = Node !Int !Int !(IOUArray Int Int) !(IOUArray Int Int) !SegTree !SegTree
             | Leaf !Int !(IOUArray Int Int)

merge :: SegTree -> SegTree -> IO SegTree
merge stx sty = do
  cnt <- newArray (0,19) 0 :: IO (IOUArray Int Int)
  f   <- newArray (0,19) 0 :: IO (IOUArray Int Int)
  rep 20 $ \b-> do
    x <- unsafeRead (getCnt stx) b
    y <- unsafeRead (getCnt sty) b
    unsafeWrite cnt b $! x+y
  return $! Node (getLeft stx) (getRight sty) cnt f stx sty

getLeft :: SegTree -> Int
getLeft (Node l _ _ _ _ _) = l
getLeft (Leaf k _) = k

getRight :: SegTree -> Int
getRight (Node _ r _ _ _ _) = r
getRight (Leaf k _ ) = k

getCnt :: SegTree -> IOUArray Int Int
getCnt (Node _ _ cnt _ _ _) = cnt
getCnt (Leaf _ cnt) = cnt

mkSegTree :: Int -> Int -> UArray Int Int  -> IO SegTree
mkSegTree l r arr
  | l/=r = do
      let !m = (l+r).>>.1
      lt <- mkSegTree l m arr
      rt <- mkSegTree (m+1) r arr
      merge lt rt
  | otherwise = do
      let !x = unsafeAt arr (l-1)
      cnt <- newListArray (0,19) $ map (\b->x.>>.b.&.1) [0..19]
      return $! Leaf l cnt

query :: Int -> Int -> SegTree -> IO ()
query kl kr segtree = mapM (go segtree) [19,18..0] >>= print.toDecimal
   where
     go (Node l r cnt flag lt rt) b = do
       if r<kl || kr<l
          then return 0
          else if kl<=l && r<=kr
                  then unsafeRead cnt b
                  else do
                    ql <- go lt b
                    qr <- go rt b
                    f <- unsafeRead flag b
                    if f==1
                       then  return $! min kr r-max kl l+1-ql-qr
                       else  return $! ql+qr
     go (Leaf k cnt) b
       | kl<=k && k<=kr = unsafeRead cnt b
       | otherwise = return 0

update :: Int -> Int -> Int -> SegTree -> IO ()
update kl kr x segtree = go segtree
   where
     !bs = filter (testBit x) [0..19]
     go (Node l r cnt flag lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then do
              forM_ bs $ \b-> do
                f <- unsafeRead flag b
                unsafeWrite flag b $! xor 1 f
                c <- unsafeRead cnt b
                unsafeWrite cnt b $! r-l+1-c
            else do
              go lt
              go rt
              forM_ bs $ \b-> do
                cntl <- unsafeRead (getCnt lt) b
                cntr <- unsafeRead (getCnt rt) b
                f <- unsafeRead flag b
                if f==1
                   then unsafeWrite cnt b $! r-l+1-cntl-cntr
                   else unsafeWrite cnt b $! cntl+cntr
     go (Leaf k cnt) = do
       when (kl<=k && k<=kr) $ do
         forM_ bs $ \b-> do
           c <- unsafeRead cnt b
           unsafeWrite cnt b $! xor 1 c

main = do
  n <- readLn
  arr <- listArray(0,n-1).map readInt.B.words <$> B.getLine :: IO (UArray Int Int)
  segtree <- mkSegTree 1 n arr
  queries <- map readInt.tail.B.words <$> B.getContents
  let parse (1:rest) = parse1 rest
      parse (_:rest) = parse2 rest
      parse _ = []
      parse1 (l:r:rest)   = query  l r   segtree : parse rest
      parse2 (l:r:x:rest) = update l r x segtree : parse rest
  sequence_ $ parse queries

{-# OPTIONS_GHC -O3 -optc-O3 #-}
{-# LANGUAGE BangPatterns, MagicHash #-}

import GHC.Prim (uncheckedIShiftL#,uncheckedIShiftRL#)
import GHC.Exts (Int(..))
import Data.Bits (testBit,shiftL,shiftR,xor,(.&.),(.|.))
import qualified Data.ByteString.Char8 as B (ByteString,readInt,words,getContents,getLine)
import Data.Int (Int64)
import Data.List (foldl')
import Control.Applicative ((<$>),(<*>))
import Control.Monad (unless,forM_)
import Data.Array.Base (UArray,listArray,newArray,unsafeAt,unsafeRead,unsafeWrite)
import Data.Array.IO (IOUArray)

infixl 8 .<<. , .>>.
(.<<.) :: Int -> Int -> Int
(I# x).<<.(I# i) = I# (uncheckedIShiftL# x i)
(.>>.) :: Int -> Int -> Int
(I# x).>>.(I# i) = I# (uncheckedIShiftRL# x i)
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

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

rep :: Int -> (Int -> IO ()) -> IO ()
rep !n f = go 0
   where
     go !i
       | i<n = f i >> go (i+1)
       | otherwise = return ()
{-# INLINE rep #-}

toDecimal :: [Int] -> Int64
toDecimal xs = foldl' (\x y->x`shiftL`1 + fromIntegral y) 0 xs
{-# INLINE toDecimal #-}

main = do
  n <- readLn
  arr <- listArray(0,n-1).map readInt.B.words <$> B.getLine :: IO (UArray Int Int)

  segtree <- newArray (0,20*(1.<<.18)-1) 0 :: IO (IOUArray Int Int)
  flag    <- newArray (0,20*(1.<<.18)-1) 0 :: IO (IOUArray Int Int)

  let build node l r = do
        if r-l==1
           then do
             let !al = unsafeAt arr l
             rep 20 $ \b-> do
               unsafeWrite segtree (b.<<.18+ node) $! al.>>.b.&.1
           else do
             let !nodel = node.<<.1 .|. 1
                 !noder = node.<<.1 + 2
                 !m = (l+r).>>.1
             build nodel l m
             build noder m r
             rep 20 $ \b-> do
               cntl <- unsafeRead segtree $! b.<<.18+nodel
               cntr <- unsafeRead segtree $! b.<<.18+noder
               unsafeWrite segtree (b.<<.18+ node)  $! cntl + cntr

  let query kl kr = mapM (go 0 0 n) [19,18..0] >>= print.toDecimal
        where
          go node l r b = do
            if r<=kl || kr<=l
               then return 0
               else if kl<=l && r<=kr
                       then unsafeRead segtree $! b.<<.18+node
                       else do
                         let !nodel = node.<<.1 .|. 1
                             !noder = node.<<.1 + 2
                             !m = (l+r).>>.1
                         ql <- go nodel l m b
                         qr <- go noder m r b
                         f <- unsafeRead flag $! b.<<.18+node
                         if f==1
                            then return $! min kr r-max kl l-ql-qr
                            else return $! ql+qr

  let update kl kr x = go 0 0 n
         where
           !bs = filter (testBit x) [0..19]
           go node l r = do
             unless (r<=kl || kr<=l) $ do
                if kl<=l && r<=kr
                   then do
                     forM_ bs $ \b-> do
                       let !i = b.<<.18 + node
                       f <- unsafeRead flag i
                       unsafeWrite flag i $! xor 1 f
                       cnt <- unsafeRead segtree i
                       unsafeWrite segtree i $! r-l-cnt
                   else do
                     let !nodel = node.<<.1 .|. 1
                         !noder = node.<<.1 + 2
                         !m = (l+r).>>.1
                     go nodel l m
                     go noder m r
                     forM_ bs $ \b-> do
                       cntl <- unsafeRead segtree $! b.<<.18+nodel
                       cntr <- unsafeRead segtree $! b.<<.18+noder
                       f <- unsafeRead flag $! b.<<.18 + node
                       if f==1
                          then unsafeWrite segtree (b.<<.18+node) $! r-l-cntl-cntr
                          else unsafeWrite segtree (b.<<.18+node) $! cntl+cntr

  let parse (1:rest) = parse1 rest
      parse (_:rest) = parse2 rest
      parse _ = []
      parse1 (l:r:rest)   = query  (l-1) r   : parse rest
      parse2 (l:r:x:rest) = update (l-1) r x : parse rest

  build 0 0 n
  queries <- map readInt.tail.B.words <$> B.getContents
  sequence_ $ parse queries


main :: IO ()
main = do
    inp <- getLine
    let l = map read $ words inp
        a = l!!0
        b = l!!1
        c = l!!2
    inp <- getLine
    let liste = map read $ words inp
    putStrLn $ show $ steps $ Just (liste,c,b,c,b)
    return ()
steps :: (Maybe ([Int],Int,Int,Int,Int)) -> Int
steps Nothing = -1
steps (Just x)  = 1+(steps $ step x)

step :: ([Int],Int,Int,Int,Int) -> Maybe ([Int],Int,Int,Int,Int)
step (liste,acc,batt,cacc,cbatt)
    |null liste        = Nothing
    |cacc==cbatt && cacc==0    = Nothing
    |(head liste) == 0 =
        if cacc==0
            then Just (tail liste,acc,batt,cacc,cbatt-1)
            else Just (tail liste,acc,batt,cacc-1,cbatt)
    |otherwise         =
        if cacc==acc || cbatt==0
            then Just (tail liste,acc,batt,cacc-1,cbatt)
            else Just (tail liste,acc,batt,cacc+1,cbatt-1)

analyze _ _ 0 0 _ = 0
analyze b a p q s
  | a == q = 1 + (analyze b a p (q - 1) (tail s))
  | p == 0 = 1 + (analyze b a p (q - 1) (tail s))
  | (head s) == 1 = 1 + (analyze b a (p - 1) (q + 1) (tail s))
  | q == 0 = 1 + (analyze b a (p - 1) q (tail s))
  | otherwise = 1 + (analyze b a p (q - 1) (tail s))

main = do
  line1 <- getLine
  line2 <- getLine
  let
    nums1 = map read (words line1)
    (n:b:a:_) = nums1
    s = (map read (words line2)) ++ (repeat 0)
  putStrLn (show (min n (analyze b a b a s)))

main :: IO ()
main = do
    inp <- getLine
    let l = map read $ words inp
        a = l!!0
        b = l!!1
        c = l!!2
    inp <- getLine
    let liste = map read $ words inp
    putStrLn $ show $ steps $ Just (liste,c,b,c,b)
    return ()
steps :: (Maybe ([Int],Int,Int,Int,Int)) -> Int
steps Nothing = -1
steps (Just x)  = 1+(steps $ step x)

step :: ([Int],Int,Int,Int,Int) -> Maybe ([Int],Int,Int,Int,Int)
step (liste,acc,batt,cacc,cbatt)
    |null liste        = Nothing
    |cacc==cbatt && cacc==0    = Nothing
    |(head liste) == 0 =
        if cacc==0
            then Just (tail liste,acc,batt,cacc,cbatt-1)
            else Just (tail liste,acc,batt,cacc-1,cbatt)
    |otherwise         =
        if cacc==acc
            then Just (tail liste,acc,batt,cacc-1,cbatt)
            else Just (tail liste,acc,batt,cacc+1,cbatt-1)

main :: IO ()
main = do
    inp <- getLine
    let l = map read $ words inp
        a = l!!0
        b = l!!1
        c = l!!2
    inp <- getLine
    let liste = map read $ words inp
    putStrLn $ show $ steps $ Just (liste,c,b,c,b)
    return ()
steps :: (Maybe ([Int],Int,Int,Int,Int)) -> Int
steps Nothing = 0
steps (Just x)  = 1+(steps $ step x)

step :: ([Int],Int,Int,Int,Int) -> Maybe ([Int],Int,Int,Int,Int)
step (liste,acc,batt,cacc,cbatt)
    |null liste        = Nothing
    |cacc==cbatt && cacc==0    = Nothing
    |(head liste) == 0 =
        if cacc==0
            then Just (tail liste,acc,batt,cacc,cbatt-1)
            else Just (tail liste,acc,batt,cacc-1,cbatt)
    |otherwise         =
        if cacc==acc
            then Just (tail liste,acc,batt,cacc-1,cbatt)
            else Just (tail liste,acc,batt,cacc+1,cbatt-1)

main :: IO ()
main = do
    inp <- getLine
    let l = map read $ words inp
        a = l!!0
        b = l!!1
        c = l!!2
    inp <- getLine
    let liste = map read $ words inp
    putStrLn $ show $ steps $ Just (liste,c,b,c,b)
    return ()
steps :: (Maybe ([Int],Int,Int,Int,Int)) -> Int
steps Nothing = -1
steps (Just x)  = 1+(steps $ step x)

step :: ([Int],Int,Int,Int,Int) -> Maybe ([Int],Int,Int,Int,Int)
step (liste,acc,batt,cacc,cbatt)
    |null liste        = Nothing
    |cacc==cbatt && cacc==0    = Nothing
    |(head liste) == 0 =
        if cacc==0
            then Just (tail liste,acc,batt,cacc,cbatt-1)
            else Just (tail liste,acc,batt,cacc-1,cbatt)
    |otherwise         =
        if cacc==acc || cacc==0
            then Just (tail liste,acc,batt,cacc-1,cbatt)
            else Just (tail liste,acc,batt,cacc+1,cbatt-1)


import Data.List

boolToAns :: Bool -> String
boolToAns x = if x then "YES" else "NO"

computeAnswer :: Integer -> String -> Bool
computeAnswer k str
    | any (=='x') firstSubstring = False
    | n0 + n1 + abs (n0-n1) > k = False
    | otherwise = True
  where
    classes :: [String]
    classes =
      map (map fst)
      $ groupBy (\x y -> snd x == snd y)
      $ sortOn (snd)
      $ zip str $ cycle [0..(k-1)]
    firstSubstring :: String
    firstSubstring = map repr classes
    repr :: String -> Char
    repr str
      | any (=='0') str && any (=='1') str = 'x'
      | any (=='1') str = '1'
      | any (=='0') str = '0'
      | otherwise = '?'
    count :: Char -> String -> Integer
    count c = genericLength . filter (==c)
    n0 = count '0' firstSubstring
    n1 = count '1' firstSubstring

answerTestcase :: IO ()
answerTestcase = do
  line1 <- getLine
  line2 <- getLine
  let k = readInt $ words line1 !! 1
  (putStrLn . boolToAns) $ computeAnswer k line2

readInt :: String -> Integer
readInt = read

main = (fmap readInt getLine) >>= (\t -> sequence (genericReplicate t answerTestcase))

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Control.Applicative
import Data.Int
import Data.Maybe
import Data.List
import Data.Functor
import Data.Bool
import Data.Array.Unboxed as UA
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

readInt64B8 :: B8.ByteString -> Int64
readInt64B8 = fromIntegral . fst . fromJust . B8.readInteger

solve :: Int -> Int -> B8.ByteString -> Bool
solve n k s = fromMaybe False result
    where
        result = do
            convolution <- convolution
            let zerosCount = B8.count '0' convolution
            let onesCount = B8.count '1' convolution
            let delta = k - zerosCount - onesCount
            return $ (abs $ zerosCount - onesCount) <= delta

        convolution = B8.pack <$> foldr (liftA2 (:)) (Just "") collapsedColumns
        collapsedColumns = map collapseColumn stripesColumns

        collapseColumn column
            | ('1' `B8.elem` column) && ('0' `B8.elem` column) = Nothing
            | ('1' `B8.elem` column) = Just '1'
            | ('0' `B8.elem` column) = Just '0'
            | otherwise = Just '?'

        stripesColumns = do
            groupId <- [0 .. k - 1]
            let columns = map (B8.index s) [groupId, groupId + k .. n - 1]
            return $ B8.pack columns

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        [n, k] <- B8.getLine <&> B8.words <&> map readIntB8
        s <- B8.getLine
        let answer = solve n k s
        printf "%s\n" $ ((bool "NO" "YES" answer)::String)


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)