Vasya is a school PE teacher. Unlike other PE teachers, Vasya doesn't like it when the students stand in line according to their height. Instead, he demands that the children stand in the following order: a1, a2, ..., an, where ai is the height of the i-th student in the line and n is the number of students in the line. The children find it hard to keep in mind this strange arrangement, and today they formed the line in the following order: b1, b2, ..., bn, which upset Vasya immensely. Now Vasya wants to rearrange the children so that the resulting order is like this: a1, a2, ..., an. During each move Vasya can swap two people who stand next to each other in the line. Help Vasya, find the sequence of swaps leading to the arrangement Vasya needs. It is not required to minimize the number of moves.

The first line contains an integer n (1 ≤ n ≤ 300) which is the number of students. The second line contains n space-separated integers ai (1 ≤ ai ≤ 109) which represent the height of the student occupying the i-th place must possess. The third line contains n space-separated integers bi (1 ≤ bi ≤ 109) which represent the height of the student occupying the i-th place in the initial arrangement. It is possible that some students possess similar heights. It is guaranteed that it is possible to arrange the children in the required order, i.e. a and b coincide as multisets.

In the first line print an integer k (0 ≤ k ≤ 106) which is the number of moves. It is not required to minimize k but it must not exceed 106. Then print k lines each containing two space-separated integers. Line pi, pi + 1 (1 ≤ pi ≤ n - 1) means that Vasya should swap students occupying places pi and pi + 1.

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

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

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


One particularly well-known fact about zombies is that they move and think terribly slowly. While we still don't know why their movements are so sluggish, the problem of laggy thinking has been recently resolved. It turns out that the reason is not (as previously suspected) any kind of brain defect – it's the opposite! Independent researchers confirmed that the nervous system of a zombie is highly complicated – it consists of n brains (much like a cow has several stomachs). They are interconnected by brain connectors, which are veins capable of transmitting thoughts between brains. There are two important properties such a brain network should have to function properly:   It should be possible to exchange thoughts between any two pairs of brains (perhaps indirectly, through other brains).  There should be no redundant brain connectors, that is, removing any brain connector would make property 1 false. If both properties are satisfied, we say that the nervous system is valid. Unfortunately (?), if the system is not valid, the zombie stops thinking and becomes (even more) dead. Your task is to analyze a given nervous system of a zombie and find out whether it is valid.

The first line of the input contains two space-separated integers n and m (1 ≤ n, m ≤ 1000) denoting the number of brains (which are conveniently numbered from 1 to n) and the number of brain connectors in the nervous system, respectively. In the next m lines, descriptions of brain connectors follow. Every connector is given as a pair of brains a b it connects (1 ≤ a, b ≤ n, a ≠ b).

The output consists of one line, containing either yes or no depending on whether the nervous system is valid.

import Control.Monad (replicateM)
--import Data.Graph.Inductive
--import Data.Graph.Inductive.Query.BFS
import Control.Applicative ((<$>))
import qualified Data.Map.Strict as M
import qualified Data.Set as S

type Node = Int
type AdjList = M.Map Node [Node]

readNums :: IO [Int]
readNums = ((map read) . words) <$> getLine

yesNo :: Bool -> String
yesNo True = "yes"
yesNo False = "no"

edgeListToAdj :: Int -> [[Int]] ->  AdjList
edgeListToAdj n es = let adjList = M.fromList [(i, []) | i <- [1..n]] in
    foldl (\adj [x, y] -> ((M.adjust (x:) y) . (M.adjust (y:) x)) adj) adjList es

bfs :: AdjList -> Node -> [Node]
bfs adjList i = bfs' marking [i] where
    isMarked = S.member
    unMarkedNeighbours marking' i = [v | v <- M.findWithDefault [] i adjList, not (isMarked v marking')]
    mark = S.insert
    markNodes vs marking' = foldl (\m v -> mark v m) marking' vs
    marking = mark i $ S.fromList []
    bfs' marking' []  = S.toList marking'
    bfs' marking' (v:vs) = bfs' (markNodes (unMarkedNeighbours marking' v) marking') (vs ++ (unMarkedNeighbours marking' v))

isConnected :: AdjList -> Bool
isConnected adjList = let n = M.size adjList in
    if n == 0 then
        True
    else
        length (bfs adjList 1) == n

main = do
    [n, m] <- readNums
    connectors <- replicateM m readNums
    putStrLn $ yesNo $ n <= 1 ||  (n == m + 1  && isConnected (edgeListToAdj n connectors))

import Control.Monad (replicateM)
import Data.List(nub, sort)
import Control.Applicative ((<$>))

readNums :: IO [Int]
readNums = ((map read) . words) <$> getLine

yesNo :: Bool -> String
yesNo True = "Yes"
yesNo False = "No"

main = do
    [n, m] <- readNums
    connectors <- replicateM m readNums
    let cond_num_edges = m == n - 1
    let cond_unique = (length . nub . sort) connectors == n - 1
    let cond_nodes = (n == 1 && m == 0) || (length . nub . concat) connectors == n
    putStrLn $ yesNo $ cond_num_edges && cond_unique && cond_nodes

import Control.Monad (replicateM)
import Data.List(nub, sort)
import Control.Applicative ((<$>))

readNums :: IO [Int]
readNums = ((map read) . words) <$> getLine

yesNo :: Bool -> String
yesNo True = "yes"
yesNo False = "no"

main = do
    [n, m] <- readNums
    connectors <- replicateM m readNums
    let cond_num_edges = m == n - 1
    let cond_unique = (length . nub . sort) connectors == n - 1
    let cond_nodes = (n == 1 && m == 0) || (length . nub . concat) connectors == n
    putStrLn $ yesNo $ cond_num_edges && cond_unique && cond_nodes

import Control.Monad (replicateM)
import Data.List(nub)
import Control.Applicative ((<$>))

readNums :: IO [Int]
readNums = ((map read) . words) <$> getLine

yesNo :: Bool -> String
yesNo True = "Yes"
yesNo False = "No"

main = do
    [n, m] <- readNums
    connectors <- replicateM m readNums
    let cond_num_edges = m == n -1
    let cond_nodes = (n == 1 && m == 0) || (length . nub . concat) connectors == n
    putStrLn $ yesNo $ cond_num_edges && cond_nodes


You are playing a game on a $$$n \times m$$$ grid, in which the computer has selected some cell $$$(x, y)$$$ of the grid, and you have to determine which one. To do so, you will choose some $$$k$$$ and some $$$k$$$ cells $$$(x_1, y_1),\, (x_2, y_2), \ldots, (x_k, y_k)$$$, and give them to the computer. In response, you will get $$$k$$$ numbers $$$b_1,\, b_2, \ldots b_k$$$, where $$$b_i$$$ is the manhattan distance from $$$(x_i, y_i)$$$ to the hidden cell $$$(x, y)$$$ (so you know which distance corresponds to which of $$$k$$$ input cells). After receiving these $$$b_1,\, b_2, \ldots, b_k$$$, you have to be able to determine the hidden cell. What is the smallest $$$k$$$ for which is it possible to always guess the hidden cell correctly, no matter what cell computer chooses?As a reminder, the manhattan distance between cells $$$(a_1, b_1)$$$ and $$$(a_2, b_2)$$$ is equal to $$$|a_1-a_2|+|b_1-b_2|$$$.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The description of test cases follows.  The single line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 10^9$$$) — the number of rows and the number of columns in the grid.

For each test case print a single integer — the minimum $$$k$$$ for that test case.

NoteIn the first test case, the smallest such $$$k$$$ is $$$2$$$, for which you can choose, for example, cells $$$(1, 1)$$$ and $$$(2, 1)$$$.Note that you can't choose cells $$$(1, 1)$$$ and $$$(2, 3)$$$ for $$$k = 2$$$, as both cells $$$(1, 2)$$$ and $$$(2, 1)$$$ would give $$$b_1 = 1, b_2 = 2$$$, so we wouldn't be able to determine which cell is hidden if computer selects one of those.In the second test case, you should choose $$$k = 1$$$, for it you can choose cell $$$(3, 1)$$$ or $$$(1, 1)$$$.

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 = interact $ unlines . map (show . sum . map f . words) . tail . lines where f "1" = 0; f _ = 1

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


The Bitlandians are quite weird people. They have very peculiar customs.As is customary, Uncle J. wants to have n eggs painted for Bitruz (an ancient Bitland festival). He has asked G. and A. to do the work.The kids are excited because just as is customary, they're going to be paid for the job! Overall uncle J. has got n eggs. G. named his price for painting each egg. Similarly, A. named his price for painting each egg. It turns out that for each egg the sum of the money both A. and G. want for the painting equals 1000.Uncle J. wants to distribute the eggs between the children so as to give each egg to exactly one child. Also, Uncle J. wants the total money paid to A. to be different from the total money paid to G. by no more than 500.Help Uncle J. Find the required distribution of eggs or otherwise say that distributing the eggs in the required manner is impossible.

The first line contains integer n (1 ≤ n ≤ 106) — the number of eggs. Next n lines contain two integers ai and gi each (0 ≤ ai, gi ≤ 1000; ai + gi = 1000): ai is the price said by A. for the i-th egg and gi is the price said by G. for the i-th egg.

If it is impossible to assign the painting, print "-1" (without quotes). Otherwise print a string, consisting of n letters "G" and "A". The i-th letter of this string should represent the child who will get the i-th egg in the required distribution. Letter "A" represents A. and letter "G" represents G. If we denote the money Uncle J. must pay A. for the painting as Sa, and the money Uncle J. must pay G. for the painting as Sg, then this inequality must hold: |Sa  -  Sg|  ≤  500.  If there are several solutions, you are allowed to print any of them.

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

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 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 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 = 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 "?"
-}


Maxim has opened his own restaurant! The restaurant has got a huge table, the table's length is p meters.Maxim has got a dinner party tonight, n guests will come to him. Let's index the guests of Maxim's restaurant from 1 to n. Maxim knows the sizes of all guests that are going to come to him. The i-th guest's size (ai) represents the number of meters the guest is going to take up if he sits at the restaurant table.Long before the dinner, the guests line up in a queue in front of the restaurant in some order. Then Maxim lets the guests in, one by one. Maxim stops letting the guests in when there is no place at the restaurant table for another guest in the queue. There is no place at the restaurant table for another guest in the queue, if the sum of sizes of all guests in the restaurant plus the size of this guest from the queue is larger than p. In this case, not to offend the guest who has no place at the table, Maxim doesn't let any other guest in the restaurant, even if one of the following guests in the queue would have fit in at the table.Maxim is now wondering, what is the average number of visitors who have come to the restaurant for all possible n! orders of guests in the queue. Help Maxim, calculate this number.

The first line contains integer n (1 ≤ n ≤ 50) — the number of guests in the restaurant. The next line contains integers a1, a2, ..., an (1 ≤ ai ≤ 50) — the guests' sizes in meters. The third line contains integer p (1 ≤ p ≤ 50) — the table's length in meters.  The numbers in the lines are separated by single spaces.

In a single line print a real number — the answer to the problem. The answer will be considered correct, if the absolute or relative error doesn't exceed 10 - 4.

NoteIn the first sample the people will come in the following orders:   (1, 2, 3) — there will be two people in the restaurant;  (1, 3, 2) — there will be one person in the restaurant;  (2, 1, 3) — there will be two people in the restaurant;  (2, 3, 1) — there will be one person in the restaurant;  (3, 1, 2) — there will be one person in the restaurant;  (3, 2, 1) — there will be one person in the restaurant. In total we get (2 + 1 + 2 + 1 + 1 + 1) / 6 = 8 / 6 = 1.(3).

import Control.Monad;
import Data.Array.IO;
import Data.Functor;
import Data.Array;

fact :: Integer -> Integer
fact 0 = 1
fact n = n * fact (n - 1)

main :: IO ()
main = do
  n <- read <$> getLine
  aisList <- (map read . words) <$> getLine
  let ais = array (1, n) $ zip [1 .. ] aisList
  p <- read <$> getLine

  contribs <- forM [1 .. n] (\ex -> do
    f <- newArray ((0, 0), (50, 50)) 0 :: IO (IOArray (Integer, Integer) Integer)
    writeArray f (0, 0) 1

    forM_ [1 .. n] (\j ->
      unless (ex == j) $
        forM_ (reverse [0 .. n-1]) (\k ->
          forM_ (reverse [0 .. p - ais ! j]) (\l -> do
              oldVal <- readArray f (k + 1, l + ais ! j)
              incr   <- readArray f (k, l)
              writeArray f (k + 1, l + ais ! j) (oldVal + incr)
              )
          )
      )

    sum <$> forM [0 .. n-1] (\j ->
      sum <$> forM [0 .. p - ais ! ex] (\k -> do
        t <- readArray f (j, k)
        -- print $ "f[" ++ show j ++ "," ++ show k ++ "] = " ++ show t
        return $ t * fact j * fact (n - j - 1)
        )
      )

    -- print $ "ex = " ++ show ex ++ " total appearances = " ++ show tot
    )

  let ways  = (fromInteger $ sum contribs) :: Double
      total = (fromInteger $ fact n)       :: Double
  print $ ways / total


Nastia has received an array of $$$n$$$ positive integers as a gift.She calls such an array $$$a$$$ good that for all $$$i$$$ ($$$2 \le i \le n$$$) takes place $$$gcd(a_{i - 1}, a_{i}) = 1$$$, where $$$gcd(u, v)$$$ denotes the greatest common divisor (GCD) of integers $$$u$$$ and $$$v$$$.You can perform the operation: select two different indices $$$i, j$$$ ($$$1 \le i, j \le n$$$, $$$i \neq j$$$) and two integers $$$x, y$$$ ($$$1 \le x, y \le 2 \cdot 10^9$$$) so that $$$\min{(a_i, a_j)} = \min{(x, y)}$$$. Then change $$$a_i$$$ to $$$x$$$ and $$$a_j$$$ to $$$y$$$.The girl asks you to make the array good using at most $$$n$$$ operations.It can be proven that this is always possible.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10\,000$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_{n}$$$ ($$$1 \le a_i \le 10^9$$$) — the array which Nastia has received as a gift. It's guaranteed that the sum of $$$n$$$ in one test doesn't exceed $$$2 \cdot 10^5$$$.

For each of $$$t$$$ test cases print a single integer $$$k$$$ ($$$0 \le k \le n$$$) — the number of operations. You don't need to minimize this number. In each of the next $$$k$$$ lines print $$$4$$$ integers $$$i$$$, $$$j$$$, $$$x$$$, $$$y$$$ ($$$1 \le i \neq j \le n$$$, $$$1 \le x, y \le 2 \cdot 10^9$$$) so that $$$\min{(a_i, a_j)} = \min{(x, y)}$$$ — in this manner you replace $$$a_i$$$ with $$$x$$$ and $$$a_j$$$ with $$$y$$$. If there are multiple answers, print any.

NoteConsider the first test case.Initially $$$a = [9, 6, 3, 11, 15]$$$.In the first operation replace $$$a_1$$$ with $$$11$$$ and $$$a_5$$$ with $$$9$$$. It's valid, because $$$\min{(a_1, a_5)} = \min{(11, 9)} = 9$$$.After this $$$a = [11, 6, 3, 11, 9]$$$.In the second operation replace $$$a_2$$$ with $$$7$$$ and $$$a_5$$$ with $$$6$$$. It's valid, because $$$\min{(a_2, a_5)} = \min{(7, 6)} = 6$$$.After this $$$a = [11, 7, 3, 11, 6]$$$ — a good array.In the second test case, the initial array is already good.

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

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


Inna and Dima decided to surprise Sereja. They brought a really huge candy matrix, it's big even for Sereja! Let's number the rows of the giant matrix from 1 to n from top to bottom and the columns — from 1 to m, from left to right. We'll represent the cell on the intersection of the i-th row and j-th column as (i, j). Just as is expected, some cells of the giant candy matrix contain candies. Overall the matrix has p candies: the k-th candy is at cell (xk, yk).The time moved closer to dinner and Inna was already going to eat p of her favourite sweets from the matrix, when suddenly Sereja (for the reason he didn't share with anyone) rotated the matrix x times clockwise by 90 degrees. Then he performed the horizontal rotate of the matrix y times. And then he rotated the matrix z times counterclockwise by 90 degrees. The figure below shows how the rotates of the matrix looks like.  Inna got really upset, but Duma suddenly understood two things: the candies didn't get damaged and he remembered which cells contained Inna's favourite sweets before Sereja's strange actions. Help guys to find the new coordinates in the candy matrix after the transformation Sereja made!

The first line of the input contains fix integers n, m, x, y, z, p (1 ≤ n, m ≤ 109; 0 ≤ x, y, z ≤ 109; 1 ≤ p ≤ 105). Each of the following p lines contains two integers xk, yk (1 ≤ xk ≤ n; 1 ≤ yk ≤ m) — the initial coordinates of the k-th candy. Two candies can lie on the same cell.

For each of the p candies, print on a single line its space-separated new coordinates.

NoteJust for clarity. Horizontal rotating is like a mirroring of the matrix. For matrix:QWER      REWQ ASDF  ->  FDSAZXCV      VCXZ

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'

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

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'


Formula One championship consists of series of races called Grand Prix. After every race drivers receive points according to their final position. Only the top 10 drivers receive points in the following order 25, 18, 15, 12, 10, 8, 6, 4, 2, 1. At the conclusion of the championship the driver with most points is the champion. If there is a tie, champion is the one with most wins (i.e. first places). If a tie still exists, it is chosen the one with most second places, and so on, until there are no more place to use for compare. Last year another scoring system was proposed but rejected. In it the champion is the one with most wins. If there is tie, champion is the one with most points. If a tie still exists it is proceeded the same way as in the original scoring system, that is comparing number of second, third, forth, and so on, places.You are given the result of all races during the season and you are to determine the champion according to both scoring systems. It is guaranteed, that both systems will produce unique champion.

The first line contain integer t (1 ≤ t ≤ 20), where t is the number of races. After that all races are described one by one. Every race description start with an integer n (1 ≤ n ≤ 50) on a line of itself, where n is the number of clasified drivers in the given race. After that n lines follow with the classification for the race, each containing the name of a driver. The names of drivers are given in order from the first to the last place. The name of the driver consists of lowercase and uppercase English letters and has length at most 50 characters. Comparing of names should be case-sensetive.

Your output should contain exactly two line. On the first line is the name of the champion according to the original rule, and on the second line the name of the champion according to the alternative rule.

3
3
Hamilton
Vettel
Webber
2
Webber
Vettel
2
Hamilton
Vettel

2
7
Prost
Surtees
Nakajima
Schumacher
Button
DeLaRosa
Buemi
8
Alonso
Prost
NinoFarina
JimClark
DeLaRosa
Nakajima
Patrese
Surtees

NoteIt is not guaranteed that the same drivers participate in all races. For the championship consider every driver that has participated in at least one race. The total number of drivers during the whole season is not more then 50.

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

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


A long time ago in some country in Asia were civil wars.Each of n cities wanted to seize power. That's why sometimes one city gathered an army and sent it to campaign against another city.Road making was difficult, so the country had few roads, exactly n - 1. Also you could reach any city from any other city going on those roads.Even during the war the Oriental people remain spiritually rich and appreciate the beauty of nature. And to keep the memory of this great crusade for the centuries to come, they planted one beautiful tree by the road on which the army spent most time. The Oriental people love nature, that's why if there were several such roads, then one tree was planted by each of them.Recently, when the records of the war were found, it became clear that each city attacked each other one exactly once. There were exactly n(n - 1) attacks in total. Everyone has been wondering what road after those wars became the most beautiful, that is, by which road they planted the largest number of beautiful trees.

The first line contains an integer n (2 ≤ n ≤ 105), which represents the number of cities. Next n - 1 lines contain three integers each: the numbers of cities ai, bi (1 ≤ ai, bi ≤ n), connected by the i-th road and the number of days di the army spends to go on it (1 ≤ di ≤ 109). The lengths of several roads may coincide.

Print on the first line two integers — the number of beautiful trees on the most beautiful road and the number of the most beautiful roads. Print on the second line the list of the most beautiful roads in the sorted order by the numbers' increasing. The roads are numbered from 1 to n - 1 in the order in which they are given in the input data. Please, do not use %lld specificator to write 64-bit integers in C++. It is preferred to use the cout stream (also you may use the %I64d specificator).

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, RankNTypes #-}
{-# 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 Control.Monad.ST
import Data.Array.ST

import GHC.Conc (par, pseq)

data Edge = Edge { fromE :: Int
                 , destE :: Int
                 , costE :: Int
                 , label :: Int
                 } deriving (Show, Eq)

instance Ord Edge where
    compare = comparing costE

parseInput = do
    n <- readInt
    es <- forM [1..n-1] $ \i -> Edge <$> readInt <*> readInt <*> readInt <*> return i
    return (n, es)
  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 = do
  (ans, edgeLabels) <- solve . evalState parseInput <$> BS.getContents
  putStrLn $ show ans ++ " " ++ show (length edgeLabels)
  putStrLn $ unwords $ map show edgeLabels

type UnionFind s = STArray s Int (Int,Int)

findAnc :: UnionFind s -> Int -> ST s (Int, Int)
findAnc uf a = do
    (fa,fnum) <- readArray uf a
    if fa == -1
      then
        return (a,fnum)
      else do
        ret <- findAnc uf fa
        writeArray uf a ret
        return ret

mergeComp :: Int -> Int -> UnionFind s -> ST s Bool
mergeComp x y uf = do
    (fx, nx) <- findAnc uf x
    (fy, ny) <- findAnc uf y
    if fx == fy
      then
        return False
      else do
        writeArray uf fy (fx, nx + ny)
        writeArray uf fx (-1, nx + ny)
        return True

solve :: (Int, [Edge]) -> (Int64, [Int])
solve (n, es) = (maxValue, maxList)
  where
    sorted = sort es
    grouped = groupBy ((==) `on` costE) sorted

    costLen = runSTUArray $ do
        uf <- newArray (1, n) (-1,1) :: ST s (UnionFind s)
        ans <- newArray (1, n-1) 0 :: ST s (STUArray s Int Int64)
        solving grouped uf ans
        return ans

    maxValue = maximum $ elems costLen
    maxList = [ i
              | i <- [1..n-1]
              , (costLen ! i) == maxValue
              ]

solving :: [[Edge]] -> UnionFind s -> STUArray s Int Int64 -> ST s ()
solving [] _ _ = return ()
solving (es:ess) uf ans = do
    ndsComp <- zip nds <$> mapM (findAnc uf) nds
    let addList = solveTree ndsComp es
    forM_ addList $ \(eID, delta) -> do
        val <- readArray ans eID
        writeArray ans eID (val + delta)
    forM_ es $ \e -> mergeComp (fromE e) (destE e) uf
    solving ess uf ans
  where
    nds = map head . group . sort $ map fromE es ++ map destE es

(!!!) :: IntMap a -> Int -> a
(!!!) = (IntMap.!)

solveTree :: [(Int, (Int, Int))] -> [Edge] -> [(Int, Int64)]
solveTree ndsComp es = ans
  where
    comps = map head . group . sort $ map (fst.snd) ndsComp

    swap (a, b) = (b, a)

    bnds = (1, 100000)

    comp2size
        | cnum < 10000 = let cache = IntMap.fromList $ map snd ndsComp in (cache !!!)
        | otherwise    = let cache = array bnds $ map snd ndsComp :: UArray Int Int in (cache !)

    node2comp
        | cnum < 10000 = let cache = IntMap.fromList $ map (fmap fst) ndsComp in (cache !!!)
        | otherwise    = let cache = array bnds $ map (fmap fst) ndsComp :: UArray Int Int in (cache !)

    comp2id
        | cnum < 10000 = let cache = IntMap.fromList $ zip comps [1..] in (cache !!!)
        | otherwise    = let cache = array bnds $ zip comps [1..] :: UArray Int Int in (cache !)

    id2comp = let cache = listArray (1, cnum) comps :: UArray Int Int in (cache !)
    id2size = let cache = listArray (1, cnum) $ map comp2size comps :: UArray Int Int in (cache !)

    cnum = length comps

    edgesID = [ (ia, ib)
              | e <- es
              , let ia = comp2id . node2comp $ fromE e
              , let ib = comp2id . node2comp $ destE e
              ]

    adjList = accumArray (flip (:)) [] (1, cnum) $ edgesID ++ map swap edgesID :: Array Int [Int]

    (subTreeSize, subTreeColor) = runST $ do
        sz <- newArray (1, cnum) 0 :: forall s. ST s (STUArray s Int Int)
        color <- newArray (1, cnum) 0 :: forall s. ST s (STUArray s Int Int)
        forM_ [1..cnum] $ \i -> do
            val <- readArray color i
            when (val == 0) $ dfs color i sz i 0 >> return ()
        szFreezed <- unsafeFreeze sz
        colorFreezed <- unsafeFreeze color
        return (szFreezed :: UArray Int Int, colorFreezed :: UArray Int Int)
      where
        dfs color root sz now prev = do
            writeArray color now root
            lst <- forM (adjList ! now) $ \chd -> do
                if chd == prev
                  then return 0
                  else dfs color root sz chd now
            let ret = sum lst + nowCompSize
            writeArray sz now ret
            return ret
          where
            nowCompSize = id2size now

    ans = [ (label e, delta)
          | e <- es
          , let ia = comp2id . node2comp $ fromE e
          , let ib = comp2id . node2comp $ destE e
          , let sa = subTreeSize ! ia
          , let sb = subTreeSize ! ib
          , let minv = sa `min` sb
          , let maxv = subTreeSize ! (subTreeColor ! ia)
          , let delta = fromIntegral minv * fromIntegral (maxv - minv) * 2 :: Int64
          ]

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

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

{-# 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 Control.Monad.ST
import Data.Array.ST

data Edge = Edge { fromE :: Int
                 , destE :: Int
                 , costE :: Int
                 , label :: Int
                 } deriving (Show, Eq)

instance Ord Edge where
    compare = comparing costE

parseInput = do
    n <- readInt
    es <- forM [1..n-1] $ \i -> Edge <$> readInt <*> readInt <*> readInt <*> return i
    return (n, es)
  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 = do
  (ans, edgeLabels) <- solve . evalState parseInput <$> BS.getContents
  putStrLn $ show ans ++ " " ++ show (length edgeLabels)
  putStrLn $ unwords $ map show edgeLabels

type UnionFind s = STArray s Int (Int,Int)

findAnc :: UnionFind s -> Int -> ST s (Int, Int)
findAnc uf a = do
    (fa,fnum) <- readArray uf a
    if fa == -1
      then
        return (a,fnum)
      else do
        ret <- findAnc uf fa
        writeArray uf a ret
        return ret

mergeComp :: Int -> Int -> UnionFind s -> ST s Bool
mergeComp x y uf = do
    (fx, nx) <- findAnc uf x
    (fy, ny) <- findAnc uf y
    if fx == fy
      then
        return False
      else do
        writeArray uf fy (fx, nx + ny)
        writeArray uf fx (-1, nx + ny)
        return True

solve :: (Int, [Edge]) -> (Int64, [Int])
solve (n, es) = (maxValue, maxList)
  where
    sorted = sort es
    grouped = groupBy ((==) `on` costE) sorted

    costLen = runSTUArray $ do
        uf <- newArray (1, n) (-1,1) :: ST s (UnionFind s)
        ans <- newArray (1, n-1) 0 :: ST s (STUArray s Int Int64)
        solving grouped uf ans
        return ans

    maxValue = maximum $ elems costLen
    maxList = [ i
              | i <- [1..n-1]
              , (costLen ! i) == maxValue
              ]

solving :: [[Edge]] -> UnionFind s -> STUArray s Int Int64 -> ST s ()
solving [] _ _ = return ()
solving (es:ess) uf ans = do
    ndsComp <- zip nds <$> mapM (findAnc uf) nds
    let addList = solveTree ndsComp es
    forM_ addList $ \(eID, delta) -> do
        val <- readArray ans eID
        writeArray ans eID (val + delta)
    forM_ es $ \e -> mergeComp (fromE e) (destE e) uf
    solving ess uf ans
  where
    nds = map fromE es ++ map destE es

(!!!) :: IntMap a -> Int -> a
(!!!) = (IntMap.!)

solveTree :: [(Int, (Int, Int))] -> [Edge] -> [(Int, Int64)]
solveTree ndsComp es = ans
  where
    comps = map head . group . sort $ map (fst.snd) ndsComp

    swap (a, b) = (b, a)

    comp2size = IntMap.fromList $ map snd ndsComp :: IntMap Int

    node2comp = IntMap.fromList $ map (fmap fst) ndsComp :: IntMap Int
    comp2node = IntMap.fromList $ map (swap . fmap fst) ndsComp :: IntMap Int

    comp2id = IntMap.fromList $ zip comps [1..] :: IntMap Int
    id2comp = listArray (1, cnum) $ comps :: UArray Int Int

    cnum = length comps

    edgesID = [ (ia, ib)
              | e <- es
              , let ca = node2comp !!! fromE e
              , let cb = node2comp !!! destE e
              , let ia = comp2id !!! ca
              , let ib = comp2id !!! cb
              ]

    adjList = accumArray (flip (:)) [] (1, cnum) $ edgesID ++ map swap edgesID :: Array Int [Int]

    subTreeSize = runSTUArray $ do
        sz <- newArray (1, cnum) 0 :: ST s (STUArray s Int Int)
        forM_ [1..cnum] $ \i -> do
            val <- readArray sz i
            when (val == 0) $ dfs sz i 0 >> return ()
        return sz
      where
        dfs :: STUArray s Int Int -> Int -> Int -> ST s Int
        dfs sz root prev = do
            lst <- forM (adjList ! root) $ \chd -> do
                if chd == prev
                  then return 0
                  else dfs sz chd root
            let ret = sum lst + rootCompSize
            writeArray sz root ret
            return ret
          where
            rootComp = id2comp ! root
            rootCompSize = comp2size !!! rootComp

    ans = [ (label e, delta)
          | e <- es
          , let ca = node2comp !!! fromE e
          , let cb = node2comp !!! destE e
          , let ia = comp2id !!! ca
          , let ib = comp2id !!! cb
          , let sa = subTreeSize ! ia
          , let sb = subTreeSize ! ib
          , let [minv, maxv] = sort [sa, sb]
          , let delta = fromIntegral minv * fromIntegral (maxv - minv) * 2 :: Int64
          ]

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

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


There are n walruses standing in a queue in an airport. They are numbered starting from the queue's tail: the 1-st walrus stands at the end of the queue and the n-th walrus stands at the beginning of the queue. The i-th walrus has the age equal to ai.The i-th walrus becomes displeased if there's a younger walrus standing in front of him, that is, if exists such j (i < j), that ai > aj. The displeasure of the i-th walrus is equal to the number of walruses between him and the furthest walrus ahead of him, which is younger than the i-th one. That is, the further that young walrus stands from him, the stronger the displeasure is.The airport manager asked you to count for each of n walruses in the queue his displeasure.

The first line contains an integer n (2 ≤ n ≤ 105) — the number of walruses in the queue. The second line contains integers ai (1 ≤ ai ≤ 109). Note that some walruses can have the same age but for the displeasure to emerge the walrus that is closer to the head of the queue needs to be strictly younger than the other one.

Print n numbers: if the i-th walrus is pleased with everything, print "-1" (without the quotes). Otherwise, print the i-th walrus's displeasure: the number of other walruses that stand between him and the furthest from him younger walrus.

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


This is an interactive problem.Alice and Bob are playing a game. There is $$$n\times n$$$ grid, initially empty. We refer to the cell in row $$$i$$$ and column $$$j$$$ by $$$(i, j)$$$ for $$$1\le i, j\le n$$$. There is an infinite supply of tokens that come in $$$3$$$ colors labelled $$$1$$$, $$$2$$$, and $$$3$$$.The game proceeds with turns as follows. Each turn begins with Alice naming one of the three colors, let's call it $$$a$$$. Then, Bob chooses a color $$$b\ne a$$$, chooses an empty cell, and places a token of color $$$b$$$ on that cell.We say that there is a conflict if there exist two adjacent cells containing tokens of the same color. Two cells are considered adjacent if they share a common edge.If at any moment there is a conflict, Alice wins. Otherwise, if $$$n^2$$$ turns are completed (so that the grid becomes full) without any conflicts, Bob wins.We have a proof that Bob has a winning strategy. Play the game as Bob and win.The interactor is adaptive. That is, Alice's color choices can depend on Bob's previous moves.

NoteThe final grid from the sample is pictured below. Bob wins because there are no two adjacent cells with tokens of the same color. $$$$$$\begin{matrix}2&3\\3&1\end{matrix}$$$$$$The sample is only given to demonstrate the input and output format. It is not guaranteed to represent an optimal strategy for Bob or the real behavior of the interactor.

{-# LANGUAGE ParallelListComp #-}
module Main where

import qualified Data.ByteString.Char8 as C
import Data.List
import GHC.IO.Handle (hSetBuffering)
import System.IO (stdout)
import System.IO (BufferMode(NoBuffering))

readInt = maybe undefined fst . C.readInt

solve:: Show a => [(a, a)] -> [(a, a)] -> Int -> Int -> IO ()
solve blacks whites step n
  | step == n*n = pure ()
  | otherwise = do
    ln <- fmap readInt C.getLine
    case ln of
      1 -> if not (null blacks)then
        let (i,j) = head blacks in do
          putStr "2 "
          putStrLn $ show i ++ " " ++ show j
          solve (tail blacks) whites (step + 1) n
        else
          let (i,j) = head whites in do
            putStr "3 "
            putStrLn $ show i ++ " " ++ show j
            solve blacks (tail whites) (step + 1) n
      2 -> if not (null whites) then
        let (i,j) = head whites in do
          putStr "1 "
          putStrLn $ show i ++ " " ++ show j
          solve blacks (tail whites) (step + 1) n
        else
          let (i,j) = head blacks in do
            putStr "3 "
            putStrLn $ show i ++ " " ++ show j
            solve (tail blacks) whites (step + 1) n
      _ -> if not (null whites) then
        let (i,j) = head whites in do
          putStr "1 "
          putStrLn $ show i ++ " " ++ show j
          solve blacks (tail whites) (step + 1) n
        else
          let (i,j) = head blacks in do
            putStr "2 "
            putStrLn $ show i ++ " " ++ show j
            solve (tail blacks) whites (step + 1) n

genB n = filter (\(x, y) -> even (x + y)) [(i, j) | i <- [1..n], j <- [1..n]]
genW n = filter (\(x, y) -> odd (x + y)) [(i, j) | i <- [1..n], j <- [1..n]]

main = do
  hSetBuffering stdout NoBuffering
  n <- fmap readInt C.getLine
  -- print $ genB n
  -- print $ genW n
  solve (genB n) (genW n) 0 n


You are fishing with polar bears Alice and Bob. While waiting for the fish to bite, the polar bears get bored. They come up with a game. First Alice and Bob each writes a 01-string (strings that only contain character "0" and "1") a and b. Then you try to turn a into b using two types of operations:  Write parity(a) to the end of a. For example, .  Remove the first character of a. For example, . You cannot perform this operation if a is empty. You can use as many operations as you want. The problem is, is it possible to turn a into b?The parity of a 01-string is 1 if there is an odd number of "1"s in the string, and 0 otherwise.

The first line contains the string a and the second line contains the string b (1 ≤ |a|, |b| ≤ 1000). Both strings contain only the characters "0" and "1". Here |x| denotes the length of the string x.

Print "YES" (without quotes) if it is possible to turn a into b, and "NO" (without quotes) otherwise.

NoteIn the first sample, the steps are as follows: 01011 → 1011 → 011 → 0110

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

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"

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

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

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