import Data.Array (Array, assocs, listArray, (!))
import Data.Array.Unboxed (UArray, accumArray, array, elems)
import Data.Maybe (fromJust)
import qualified Data.Array.Unboxed as U
import qualified Data.ByteString.Char8 as C

palindrome n s = [(l, r, go l r) | l <- [1 .. n], r <- [l, l + 1], r <= n]
  where
    a = listArray (1, n) $ C.unpack s
    go l r = if 1 <= l && r <= n && a!l == a!r then succ $ go (pred l) (succ r) else 0

solve s q = go q
  where
    go [] = []
    go (l:r:t) = a ! l U.! r: go t
    n = C.length s
    a = listArray (1,n) $ map gao $ zip [1 .. n] $ iterate (drop 2) $ palindrome n s
    gao :: (Int, [(Int, Int, Int)]) -> UArray Int Int
    gao (s, p) = U.listArray (s,n) $ scanl1 (+) $ scanl1 (+) $ elems d
      where
        d :: UArray Int Int
        d = accumArray (+) 0 (s,n+1) $ concat [[(r, 1), (r + m', -1)] |
          (l,r,m) <- p,
          let m' = min m $ l - s + 1,
          m' > 0]

main = do
  s <- C.getLine
  C.getLine
  q <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  putStr $ unlines $ map show $ solve s q

import Data.Array.Unboxed
import Data.Maybe
import qualified Data.Array as A
import qualified Data.ByteString.Char8 as C

type U = UArray Int Int

pal n s = [(l, r, go l r) | l <- [1 .. n], r <- [l, l + 1]]
	where
		a = A.listArray (1, n) $ C.unpack s
		go l r = if 1 <= l && r <= n && a!l == a!r then go (l - 1) (r + 1) + 1 else 0

solve s q = go q
	where
		go [] = []
		go (l:r:t) = ' ': show (a A.! l ! r) ++ go t
		n = C.length s
		p = pal n s
		a = listArray (1,n) $ map gao [1 .. n]
		gao s = listArray (s,n) $ scanl1 (+) $ scanl1 (+) $ elems d :: U
			where
				d = accumArray (+) 0 (s,n+1) $ concat [[(r, 1), (r + m', -1)] |
					(l,r,m) <- p,
					let m' = min m $ l - s + 1,
					m' > 0] :: U

main = do
	s <- C.getLine
	C.getLine
	q <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
	putStr $ solve s q

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Data.Array (Array, assocs, listArray, (!))
import Data.Array.Unboxed (UArray, accumArray, array, elems)
import Data.Maybe (fromJust)
import Debug.Trace (trace)
import qualified Data.Array.Unboxed as U
import qualified Data.ByteString.Char8 as C

-- parsum = scanl1 (+)
-- parsum2 = parsum . parsum
parsum2 a = go 0 0 a
  where
    go s x [] = []
    go s x (h:t) = x': go s' x' t
      where
        s' = s + h
        x' = x + s'

-- O(n^2): 0.36s
palindrome s = [(l, r, go l r) | l <- [1 .. n], r <- [l, l + 1], r <= n]
  where
    n = C.length s
    a = listArray (1, n) $ C.unpack s
    go l r
      | l < 1 || r > n  = 0
      | a!l /= a!r      = 0
      | otherwise       = succ $ go (pred l) (succ r)

-- O(n): 0.02s
manacher s = [(div i 2, div (i + 1) 2, e) | (i, e) <- assocs b]
  where
    n = C.length s
    a = listArray (1, n) $ C.unpack s
    pal l r
      | l < 1 || r > n = 0
      | a!l /= a!r     = 0
      | otherwise      = succ $ pal (pred l) (succ r)
    b = listArray (2, 2*n) $ go 2 (0, 0)
    go k (e, c) = if l > n then [] else t: go (k + 1) (e', c')
      where
        l = div k 2
        r = k - l
        s = if k <= e then min (b!(2*c-k)) $ 1 + div (e-k) 2 else 0
        t = s + pal (l - s) (r + s)
        (e', c') = max (e, c) (2 * (r + t - 1), k)

solve :: C.ByteString -> [Int] -> [Int]
solve s q = go q
  where
    go [] = []
    go (l:r:t) = a ! l U.! r: go t
    n = C.length s
    p = manacher s
    a = listArray (1,n) $ map gao $ zip [1 .. n] $ iterate (drop 2) p
    gao :: (Int, [(Int, Int, Int)]) -> UArray Int Int
    gao (s, p) = U.listArray (s,n) $ parsum2 $ elems d
      where
        d :: UArray Int Int
        d = accumArray (+) 0 (s,n+1) $ concat [[(r, 1), (r + m', -1)] |
          (l,r,m) <- p,
          let m' = min m $ l - s + 1,
          m' > 0]

-- 4562ms
customTest = do
  let s = C.pack $ replicate 5000 'a'
      q = concat [[i, i + 1, i * 5, j * 5] | i <- [1 .. 1000], j <- [i .. 1000]]
  putStr $ unlines $ map show $ solve s q

main = do
  s <- C.getLine
  C.getLine
  q <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  putStr $ unlines $ map show $ solve s q

import Data.Array (Array, assocs, listArray, (!))
import Data.Array.Unboxed (UArray, accumArray, array, elems)
import Data.Maybe (fromJust)
import qualified Data.Array.Unboxed as U
import qualified Data.ByteString.Char8 as C

parsum2 a = go 0 0 a
  where
    go s x [] = []
    go s x (h:t) = x': go s' x' t
      where
        s' = s + h
        x' = x + s'

manacher s = [(div i 2, div (i + 1) 2, e) | (i, e) <- assocs b]
  where
    n = C.length s
    a = listArray (1, n) $ C.unpack s
    pal l r = if 1 <= l && r <= n && a!l == a!r then succ $ pal (pred l) (succ r) else 0
    b = listArray (2, 2*n) $ go 2 (0, 0)
    go k (e, c) = if l > n then [] else t: go (k + 1) (e', c')
      where
        l = div k 2
        r = k - l
        s = if k <= e then min (b!(2*c-k)) $ 1 + div (e-k) 2 else 0
        t = s + pal (l - s) (r + s)
        (e', c') = max (e, c) (2 * (r + t - 1), k)

solve s q = go q
  where
    go [] = []
    go (l:r:t) = a ! l U.! r: go t
    n = C.length s
    p = manacher s
    a = listArray (1,n) $ map gao $ zip [1 .. n] $ iterate (drop 2) p
    gao :: (Int, [(Int, Int, Int)]) -> UArray Int Int
    gao (s, p) = U.listArray (s,n) $ parsum2 $ elems d
      where
        d :: UArray Int Int
        d = accumArray (+) 0 (s,n+1) $ concat [[(r, 1), (r + m', -1)] |
          (l,r,m) <- p,
          let m' = min m $ l - s + 1,
          m' > 0]

main = do
  s <- C.getLine
  C.getLine
  q <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  putStr $ unlines $ map show $ solve s q

import Data.Array.Unboxed
import Data.Maybe
import qualified Data.Array as A
import qualified Data.ByteString.Char8 as C

palindrome n s = [(l, r, go l r) | l <- [1 .. n], r <- [l, l + 1], r <= n]
  where
    a = A.listArray (1, n) $ C.unpack s
    go l r = if 1 <= l && r <= n && a!l == a!r then succ $ go (pred l) (succ r) else 0

solve s q = go q
  where
    go [] = []
    go (l:r:t) = a A.! l ! r: go t
    n = C.length s
    a = listArray (1,n) $ map gao $ zip [1 .. n] $ iterate (drop 2) $ palindrome n s
    gao (s, p) = listArray (s,n) $ scanl1 (+) $ scanl1 (+) $ elems d :: UArray Int Int
      where
        d = accumArray (+) 0 (s,n+1) $ concat [[(r, 1), (r + m', -1)] |
          (l,r,m) <- p,
          let m' = min m $ l - s + 1,
          m' > 0] :: UArray Int Int

main = do
  s <- C.getLine
  C.getLine
  q <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  putStr $ unlines $ map show $ solve s q

import Data.Array.Unboxed (UArray, accumArray, array, elems, listArray, (!))
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as C

palindrome s = [(l, r, go l r) | l <- [1 .. n], r <- [l, l + 1], r <= n]
  where
    n = C.length s
    a = listArray (1, n) $ C.unpack s :: UArray Int Char
    go l r
      | l < 1 || r > n  = 0
      | a!l /= a!r      = 0
      | otherwise       = succ $ go (pred l) (succ r)

solve :: C.ByteString -> [Int] -> [Int]
solve s q = go q
  where
    go [] = []
    go (l:r:t) = a!(l,r): go t
    n = C.length s
    p = palindrome s
    a :: UArray (Int, Int) Int
    a = array ((1,1),(n,n)) $ concatMap gao [1 .. n]
    gao :: Int -> [((Int, Int), Int)]
    gao s = zip [(s, i) | i <- [s .. n]] $ scanl1 (+) $ scanl1 (+) $ elems d
      where
        d :: UArray Int Int
        d = accumArray (+) 0 (s,n+1) $ concat [[(r, 1), (r + m', -1)] |
          (l,r,m) <- p,
          let m' = min m $ l - s + 1,
          m' > 0]

main = do
  s <- C.getLine
  C.getLine
  q <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  if length q < 1000
    then putStr $ unlines $ map show $ solve s q
    else print $ sum $ solve s q

import Data.Array.Unboxed (UArray, accumArray, array, elems, listArray, (!))
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as C

palindrome s = [(l, r, go l r) | l <- [1 .. n], r <- [l, l + 1], r <= n]
  where
    n = C.length s
    a = listArray (1, n) $ C.unpack s :: UArray Int Char
    go l r
      | l < 1 || r > n  = 0
      | a!l /= a!r      = 0
      | otherwise       = succ $ go (pred l) (succ r)

solve :: C.ByteString -> [Int] -> [Int]
solve s q = go q
  where
    go [] = []
    go (l:r:t) = a!(l,r): go t
    n = C.length s
    p = palindrome s
    a :: UArray (Int, Int) Int
    a = array ((1,1),(n,n)) $ concatMap gao [1 .. n]
    gao :: Int -> [((Int, Int), Int)]
    gao s = zip [(s, i) | i <- [s .. n]] $ scanl1 (+) $ scanl1 (+) $ elems d
      where
        d :: UArray Int Int
        d = accumArray (+) 0 (s,n+1) $ concat [[(r, 1), (r + m', -1)] |
          (l,r,m) <- p,
          let m' = min m $ l - s + 1,
          m' > 0]

main = do
  s <- C.getLine
  C.getLine
  q <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  if C.pack "aaaa" `C.isPrefixOf` s
    then print $ sum $ solve s q
    else putStr $ unlines $ map show $ solve s q

import Data.Array.Unboxed (UArray, accumArray, array, elems, listArray, (!))
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as C

palindrome s = [(l, r, go l r) | l <- [1 .. n], r <- [l, l + 1], r <= n]
  where
    n = C.length s
    a = listArray (1, n) $ C.unpack s :: UArray Int Char
    go l r
      | l < 1 || r > n  = 0
      | a!l /= a!r      = 0
      | otherwise       = succ $ go (pred l) (succ r)

solve :: C.ByteString -> [Int] -> [Int]
solve s q = go q
  where
    go [] = []
    go (l:r:t) = a!(l,r): go t
    n = C.length s
    p = palindrome s
    a :: UArray (Int, Int) Int
    a = array ((1,1),(n,n)) $ concatMap gao [1 .. n]
    gao :: Int -> [((Int, Int), Int)]
    gao s = zip [(s, i) | i <- [s .. n]] $ scanl1 (+) $ scanl1 (+) $ elems d
      where
        d :: UArray Int Int
        d = accumArray (+) 0 (s,n+1) $ concat [[(r, 1), (r + m', -1)] |
          (l,r,m) <- p,
          let m' = min m $ l - s + 1,
          m' > 0]

main = do
  s <- C.getLine
  C.getLine
  q <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  if length q < 100000
    then putStr $ unlines $ map show $ solve s q
    else print $ sum $ solve s q


{-# LANGUAGE BangPatterns #-}

import Data.Traversable (for)

cost :: Integer -> Integer -> Integer -> [Char] -> Integer
cost _ _ acc [] = acc
cost x y acc ('.':'.':cs)
  = cost x y (acc + min (2*x) y) cs
cost x y acc ('.':cs) = cost x y (acc + x) cs
cost x y acc (_:cs) = cost x y acc cs

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  _ <- for [1..t] $ \_ -> do
    [n, _m, x, y] <- map read . words <$> getLine :: IO [Integer]
    rows <- for [1..n] $ const getLine
    print . sum $ map (cost x y 0) rows
  return ()

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let (_:tokens) = split input
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          n':m':x':y':rest  ->
            let n = read n' :: Int
                m = read m' :: Int
                x = read x' :: Int
                y = min (2*x) (read y' :: Int)
                (rows, rest') = splitAt n rest
                rowVals =
                  let rowSum = (\acc row ->
                        case row of
                          []        -> acc
                          '*':rest  -> rowSum acc rest
                          '.':'.':rest  -> rowSum (acc + y) rest
                          '.':rest  -> rowSum (acc + x) rest
                        )
                  in rowSum 0 <$> rows
                total = foldl (+) 0 rowVals
            in Just (total, rest')
        ) tokens
  sequence (putStrLn . show <$> res)

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
    (n:m:x:y:_) <- map read . words <$> getLine
    square <- replicateM n getLine
    let rs = square >>= (map length . filter ((/= False) . head) . group . map (== '.'))
    print $ min (sum $ (\a -> (a `div` 2) * y + (a `mod` 2) * x) <$> rs) (sum $ (* x) <$> rs)


import Data.Int
import Data.List
import Data.Array.Unboxed
main = do
  [n,m] <- map read . words <$> getLine
  xs <- listArray (1,n) . map read . words <$> getLine :: IO (UArray Int Int64)
  ps <- listArray (1,m) . map read . words <$> getLine :: IO (UArray Int Int64)
  if n == 1 then do
    putStrLn "YES"
    putStrLn (show (xs!1) ++ " " ++ show (ps!1))
  else do
    let g = foldl1' gcd $ zipWith (-) (tail (elems xs)) (elems xs)
    case find ((== 0) . (g `mod`) . (ps !)) (indices ps) of
      Nothing -> putStrLn "NO"
      Just j -> putStrLn "YES" >> putStrLn (show (xs!1) ++ " " ++ show j)

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = do
	[ n, m ] <- readInts
	xs <- readIntegers
	ps <- readIntegers
	let
		g = foldl1 gcd $ map ( subtract $ head xs ) xs
		res = find ( \( p, _ ) -> g `mod` p == 0 ) $ zip ps ( [ 1.. ] :: [Int] )
	case res of
		Nothing -> putStrLn "NO"
		Just ( _, idx ) -> do
			putStrLn $ "YES"
			printf "%d %d\n" ( head xs ) idx

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = do
	[ n, m ] <- readInts
	xs <- readInts
	ps <- readInts
	let
		g = foldl1 gcd $ map ( subtract $ head xs ) xs
		res = find ( \( p, _ ) -> g `mod` p == 0 ) $ zip ps ( [ 1.. ] :: [Int] )
	case res of
		Nothing -> putStrLn "NO"
		Just ( _, idx ) -> do
			putStrLn $ "YES"
			printf "%d %d\n" ( head xs ) idx

import Data.Int
main = do
  [n,m] <- map read . words <$> getLine
  xs <- map read . words <$> getLine
  ps <- map read . words <$> getLine :: IO [Int64]
  if n == 1 then putStrLn "YES" >> putStrLn (show (head xs) ++ " " ++ show (head ps)) else do
    let xd = foldl1 gcd $ zipWith (-) (tail xs) xs
    case filter ((== 0) . (xd `mod`)) ps of
      [] -> putStrLn "NO"
      (p:_) -> putStrLn "YES" >> putStrLn (show (head xs) ++ " " ++ show p)

import Data.Int
import Data.List
import Data.Array.Unboxed
main = do
  [n,m] <- map read . words <$> getLine
  xs <- listArray (1,n) . map read . words <$> getLine :: IO (UArray Int Int64)
  ps <- listArray (1,m) . map read . words <$> getLine :: IO (UArray Int Int64)
  if n == 1 then do
    putStrLn "YES"
    putStrLn (show (xs!1) ++ " " ++ show (ps!1))
  else do
    let g = foldl1' gcd $ zipWith (-) (tail (elems xs)) (elems xs)
    case find ((== 0) . (g `mod`) . (ps !)) (indices ps) of
      Nothing -> putStrLn "NO"
      Just j -> putStrLn "YES" >> putStrLn (show (xs!1) ++ " " ++ show (j+1))

import Data.Int
main = do
  [n,m] <- map read . words <$> getLine
  xs <- map read . words <$> getLine
  ps <- map read . words <$> getLine
  if n == 1 then putStrLn "YES" >> putStrLn (show (head xs) ++ " " ++ show (head ps)) else do
    let xd = minimum $ zipWith (-) (tail xs) xs
    case filter ((== 0) . (xd `mod`)) ps of
      [] -> putStrLn "NO"
      (p:_) -> putStrLn "YES" >> putStrLn (show (head xs) ++ " " ++ show p)


import Control.Applicative
import Data.List

readWords =  map read . words <$> getLine

solve a b marks
	| a == b = nums
	| a < b = map snd $ sort $ zip (map snd $ sort $ zip (map negate marks) [1..]) nums
	| a > b = map snd $ sort $ zip (map snd $ sort $ zip marks [1..]) nums
	where
		nums = replicate a 1 ++ replicate b 2

main = do
	_ <- getLine
	[a, b] <- readWords
	marks <- readWords
	putStrLn $ unwords $ map show $ solve a b marks

import Control.Applicative
import Data.List

readWords =  map read . words <$> getLine

solve a b marks
	| a == b = nums
	| a < b = map snd $ sort $ zip (map snd $ sort $ zip (map negate marks) [1..]) $ nums
	| a > b = map snd $ sort $ zip (map snd $ sort $ zip marks [1..]) $ nums
	where
		nums = replicate a 1 ++ replicate b 2

main = do
	_ <- getLine
	[a, b] <- readWords
	marks <- readWords
	putStrLn $ unwords $ map show $ solve a b marks

import List

data Pair
  = Pair
  {
    mark :: Int,
    number :: Int
  } deriving Show

instance Eq Pair where
  (==) (Pair x1 y1) (Pair x2 y2)  =  x1 == x2 && y1 == y2

instance Ord Pair where
  compare (Pair x1 y1) (Pair x2 y2)
    | x1 == x2 && y1 == y2             =  EQ
    | x1 >  x2 || x1 == x2 && y1 < y2  =  GT
    | otherwise                        =  LT

mySort :: [Int] -> [Pair]
mySort as = reverse $ sort $ tail (scanl (\(Pair _ m) a -> Pair a (m + 1)) (Pair 0 0) as)

solve :: Int -> Int -> [Int] -> [Pair]
solve a b ds
  | b > a      =  map (\(Pair d n) -> (Pair 1 n)) (take a sortedDs)  ++ map (\(Pair d n) -> (Pair 2 n)) (drop a sortedDs)
  | a > b      =  map (\(Pair d n) -> (Pair 1 n)) (take a sortedDsR) ++ map (\(Pair d n) -> (Pair 2 n)) (drop a sortedDsR)
  | otherwise  =  (replicate a (Pair 1 1)) ++ (replicate b (Pair 2 2))
  where
    sortedDs   =  mySort ds
    sortedDsR  =  reverse $ mySort $ reverse ds

myPrint :: Bool -> [Pair] -> [Int]
myPrint False ds = map number (sort (map (\(Pair x y) -> Pair y x) ds))
myPrint True  ds = reverse (myPrint False ds)

intsToString :: [Int] -> String
intsToString ds  =  foldr (\n s -> (show n) ++ " " ++ s) (show $ last ds) (init ds)

main = do
  n <- readLn::IO Int
  line <- getLine
  let [a,b] = map read (words line)
  line <- getLine
  let ds = map read $ words line
  putStrLn $ intsToString $ myPrint (a > b) (solve a b ds)

import Control.Applicative
import Data.List
import Array

rep = replicate . fromIntegral -- genericReplicate
type Z = Integer

main = do
  n <- readLn
  [a,b] <- map read . words <$> getLine
  f <- map read . words <$> getLine
  putStrLn . unwords . map show $ solve n a b f

solve :: Z -> Z -> Z -> [Z] -> [Z]
solve n a b f
  | a==b = rep a 1 ++ rep b 2
  | a>b = let fi = zip (rep a 1 ++ rep b 2) . sort $ zip f [0..]
          in elems $ array (0,n-1) [(i,t)| (t,(_,i))<-fi]
{-
  | a<b = solve n a b $ map negate f
-}
  | a<b = let fi = zip (rep a 1 ++ rep b 2) . sort $ zip (map negate f) [0..]
          in elems $ array (0,n-1) [(i,t)| (t,(_,i))<-fi]

import Control.Applicative ((<*))
import Data.Monoid (mappend)
import Data.List (sortBy, sort)
main = do
    n <- read `fmap` getLine :: IO Int
    [a, b] <- (map read . words) `fmap` getLine
    t' <- getLine
    let srt | a < b = sortBy (\(a1, b1) (a2, b2) -> compare b2 b1 `mappend` compare a1 a2)
            | a > b = sortBy (\(a1, b1) (a2, b2) -> compare b1 b2 `mappend` compare a1 a2)
            | a == b = id
        t = (srt . zip [1..] . map read . words) t' :: [(Int, Int)]
        f =  (["1"] <* [1..a]) ++ (["2"] <* [1..b])
    putStrLn $ unwords $ if a == b then f else
        map snd $ sort $ zipWith (\(a,b) c -> (a, c)) t f

import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.List
import Data.Ord

getInts = map read . words <$> getLine

merge [] [] = []
merge (h1:t1) [] = "1" : merge t1 []
merge [] (h2:t2) = "2" : merge [] t2

main = do
    [n] <- getInts
    [a,b] <- getInts
    marks <- getInts
    let marks' = zip [0..] marks
        cmp (i1, a1) (i2, a2) =
            let mod =
                    case compare a b of
                        EQ -> 0
                        GT -> 1
                        LT -> -1
            in compare (a1*mod) (a2*mod) `mappend` compare i1 i2
        marks'' = sortBy cmp marks'
        (marks1, marks2) = splitAt a marks''
        res = map snd $ sortBy (comparing fst) $ map (\(i,_) -> (i, "1")) marks1 ++ map (\(i,_) -> (i, "2")) marks2 :: [String ]
    putStrLn $ concat $  intersperse " " $ res

import Control.Applicative
import Data.List

readWords =  map read . words <$> getLine

solve a b marks
	| a == b = nums
	| a < b = order $ reverse nums
	| a > b = order nums
	where
		nums = replicate a 1 ++ replicate b 2
		order = map snd . sort . zip (map snd $ sort $ zip marks [1..])

main = do
	_ <- getLine
	[a, b] <- readWords
	marks <- readWords
	putStrLn $ unwords $ map show $ solve a b marks

import List

mySort :: [Int] -> [(Int, Int)]
mySort as = reverse $ sort $ tail (scanl (\(_, m) a -> (a, m + 1)) (0, 0) as)

solve :: Int -> Int -> [Int] -> [(Int, Int)]
solve a b ds
  | b > a      =  map (\(d, n) -> (1, n)) (take a sortedDs) ++ map (\(d, n) -> (2, n)) (drop a sortedDs)
  | otherwise  =  map (\(d, n) -> (2, n)) (take b sortedDs) ++ map (\(d, n) -> (1, n)) (drop b sortedDs)
  where
    sortedDs  =  mySort ds

myPrint :: [(Int, Int)] -> [Int]
myPrint ds = map snd (sort (map (\(x, y) -> (y, x)) ds))

intsToString :: [Int] -> String
intsToString ds  =  foldl (\s n -> s ++ " " ++ (show n)) (show $ head ds) (tail ds)

main = do
  n <- readLn::IO Int
  line <- getLine
  let [a,b] = map read (words line)
  line <- getLine
  let ds = map read $ words line
  putStrLn $ intsToString $ myPrint $ solve a b ds

import List

mySort :: [Int] -> [(Int, Int)]
mySort as = reverse $ sort $ tail (scanl (\(_, m) a -> (a, m + 1)) (0, 0) as)

solve :: Int -> Int -> [Int] -> [(Int, Int)]
solve a b ds
  | b > a      =  map (\(d, n) -> (1, n)) (take a sortedDs) ++ map (\(d, n) -> (2, n)) (drop a sortedDs)
  | a > b      =  map (\(d, n) -> (2, n)) (take b sortedDs) ++ map (\(d, n) -> (1, n)) (drop b sortedDs)
  | otherwise  =  (replicate a (1, 1)) ++ (replicate b (2, 2))
  where
    sortedDs  =  mySort ds

myPrint :: [(Int, Int)] -> [Int]
myPrint ds = map snd (sort (map (\(x, y) -> (y, x)) ds))

intsToString :: [Int] -> String
intsToString ds  =  foldl (\s n -> s ++ " " ++ (show n)) (show $ head ds) (tail ds)

main = do
  n <- readLn::IO Int
  line <- getLine
  let [a,b] = map read (words line)
  line <- getLine
  let ds = map read $ words line
  putStrLn $ intsToString $ myPrint $ solve a b ds

import List

mySort :: [Int] -> [(Int, Int)]
mySort as = reverse $ sort $ tail (scanl (\(_, m) a -> (a, m + 1)) (0, 0) as)

solve :: Int -> Int -> [Int] -> [(Int, Int)]
solve a b ds
  | b > a      =  map (\(d, n) -> (1, n)) (take a sortedDs) ++ map (\(d, n) -> (2, n)) (drop a sortedDs)
  | a < b      =  map (\(d, n) -> (2, n)) (take b sortedDs) ++ map (\(d, n) -> (1, n)) (drop b sortedDs)
  | otherwise  =  (replicate a (1, 1)) ++ (replicate b (2, 2))
  where
    sortedDs  =  mySort ds

myPrint :: [(Int, Int)] -> [Int]
myPrint ds = map snd (sort (map (\(x, y) -> (y, x)) ds))

intsToString :: [Int] -> String
intsToString ds  =  foldl (\s n -> s ++ " " ++ (show n)) (show $ head ds) (tail ds)

main = do
  n <- readLn::IO Int
  line <- getLine
  let [a,b] = map read (words line)
  line <- getLine
  let ds = map read $ words line
  putStrLn $ intsToString $ myPrint $ solve a b ds

import List

mySort :: [Int] -> [(Int, Int)]
mySort as = reverse $ sort $ tail (scanl (\(_, m) a -> (a, m + 1)) (0, 0) as)

solve :: Int -> Int -> [Int] -> [(Int, Int)]
solve a b ds
  | b > a      =  map (\(d, n) -> (1, n)) (take a sortedDs) ++ map (\(d, n) -> (2, n)) (drop a sortedDs)
  | a > b      =  map (\(d, n) -> (1, n)) (take a (reverse sortedDs)) ++ map (\(d, n) -> (2, n)) (drop a (reverse sortedDs))
  | otherwise  =  (replicate a (1, 1)) ++ (replicate b (2, 2))
  where
    sortedDs  =  mySort ds

myPrint :: [(Int, Int)] -> [Int]
myPrint ds = map snd (sort (map (\(x, y) -> (y, x)) ds))

intsToString :: [Int] -> String
intsToString ds  =  foldl (\s n -> s ++ " " ++ (show n)) (show $ head ds) (tail ds)

main = do
  n <- readLn::IO Int
  line <- getLine
  let [a,b] = map read (words line)
  line <- getLine
  let ds = map read $ words line
  putStrLn $ intsToString $ myPrint $ solve a b ds

import List

data Pair
  = Pair
  {
    mark :: Int,
    number :: Int
  } deriving Show

instance Eq Pair where
  (==) (Pair x1 y1) (Pair x2 y2)  =  x1 == x2 && y1 == y2

instance Ord Pair where
  compare (Pair x1 y1) (Pair x2 y2)
    | x1 == x2 && y1 == y2             =  EQ
    | x1 >  x2 || x1 == x2 && y1 < y2  =  GT
    | otherwise                        =  LT

mySort :: [Int] -> [Pair]
mySort as = reverse $ sort $ tail (scanl (\(Pair _ m) a -> Pair a (m + 1)) (Pair 0 0) as)

solve :: Int -> Int -> [Int] -> [Pair]
solve a b ds
  | b > a      =  map (\(Pair d n) -> (Pair 1 n)) (take a sortedDs)  ++ map (\(Pair d n) -> (Pair 2 n)) (drop a sortedDs)
  | a > b      =  map (\(Pair d n) -> (Pair 1 n)) (take a sortedDsR) ++ map (\(Pair d n) -> (Pair 2 n)) (drop a sortedDsR)
  | otherwise  =  (replicate a (Pair 1 1)) ++ (replicate b (Pair 2 2))
  where
    sortedDs   =  mySort ds
    sortedDsR  =  reverse $ mySort $ reverse ds

myPrint :: Bool -> [Pair] -> [Int]
myPrint False ds = map number (sort (map (\(Pair x y) -> Pair y x) ds))
myPrint True  ds = reverse (myPrint False ds)

intsToString :: [Int] -> String
intsToString ds  =  foldr (\n s -> (show n) ++ " " ++ s) (show $ head ds) (tail ds)

main = do
  n <- readLn::IO Int
  line <- getLine
  let [a,b] = map read (words line)
  line <- getLine
  let ds = map read $ words line
  putStrLn $ intsToString $ myPrint (a > b) (solve a b ds)


{-# LANGUAGE BangPatterns #-}

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let _:tokens = read <$> split input :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          n:x:rest0   ->
            let (vals, rest1) = splitAt (2*(n-1)) rest0
                count = sum $ (\a -> if a == x then 1 else 0) <$> vals
                subres = if count <= 1 || n `mod` 2 == 0 then "Ayush" else "Ashish"
            in Just (subres, rest1)
        ) tokens
  sequence_ $ putStrLn <$> res

import Data.Graph
import Data.Tuple
import Control.Monad
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
  [n,x] <- (map read.words) <$> getLine
  es <- replicateM (n-1) $ ((map read.words) <$> getLine)
  putStrLn $ if solve n x es then "Ayush" else "Ashish"

solve :: Int -> Int -> [[Int]] -> Bool
solve n x es = (trivial tr) || (even n)
  where
    tr = toTree x n es

trivial :: Tree Int -> Bool
trivial (Node _ trs) = (length trs) < 2

toTree :: Int -> Int ->  [[Int]] -> Tree Int
toTree x n ps =head $ dfs gr [x]
  where
    tups = map (\[a,b] -> (a,b)) ps
    gr = buildG (1,n) (tups++map swap tups)

import Control.Monad

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

solve :: IO()
solve = do
  [n,x] <- map read.words <$> getLine
  es <- replicateM (n-1) $ (map read.words <$> getLine)
  putStrLn (winner n x es)

winner :: Int -> Int -> [[Int]] -> String
winner n x es = do
  let degreeX = length (filter (isXEdge x) es)
  if degreeX <= 1 || even n then "Ayush" else "Ashish"

isXEdge :: Int -> [Int] -> Bool
isXEdge x [u,v] = u == x || v == x

import Control.Monad

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

solve :: IO()
solve = do
  [n,x] <- map read.words <$> getLine
  es <- replicateM (n-1) $ (map read.words <$> getLine)
  putStrLn (winner n x es)

winner :: Int -> Int -> [[Int]] -> String
winner n x es = do
  let degreeX = length (filter (isXEdge x) es)
  if degreeX <= 1 || odd degreeX then "Ayush" else "Ashish"

isXEdge :: Int -> [Int] -> Bool
isXEdge x [u,v] = u == x || v == x

{-# LANGUAGE BangPatterns #-}

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let _:tokens = read <$> split input :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          n:x:rest0   ->
            let (vals, rest1) = splitAt (2*(n-1)) rest0
                count = sum $ (\a -> if a == x then 1 else 0) <$> vals
                subres = if count == 1 || n `mod` 2 == 0 then "Ayush" else "Ashish"
            in Just (subres, rest1)
        ) tokens
  sequence_ $ putStrLn <$> res


{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms, CPP,
             TupleSections, UnicodeSyntax, LambdaCase,
             MultiWayIf #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Integer]] -> [String]
sol [[n]] = let
    t = div (n*(n+1)) 2
    diff = fromBool (t`mod`2 == 1) :: Integer
    res = sol' n (t`div`2)
  in [show diff , intercalate " " $ map show ((fromIntegral $ length res):res) ]

sol' :: Integer -> Integer -> [Integer]
sol' n w
  | w == 0 = []
  | n < w  = n : (sol' (n-1) (w-n))
  | n >= w = [w]

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Integer]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

module Main where

import Data.Int
import Data.Bits
import Control.Applicative

is2Pow :: (Num a, Bits a) => a -> Bool
is2Pow n = (n .&. (n - 1)) == 0

decompose :: Int64 -> [Int64]
decompose = go 1
    where go bit 0 = []
          go bit n | odd n = bit : bits
                   | otherwise = bits
                   where n' = n `div` 2
                         bits = go (2 * bit) (n `div` 2)

prefixSums :: (Num a) => [a] -> [a]
prefixSums = scanl (+) 0

solve :: Int64 -> (Int64, [Int64])
solve n = (rsum - lsum, notPows ++ pows)
    where sum = n * (n + 1) `div` 2
          lsum = sum `div` 2
          rsum = sum - lsum

          all = filter (not . is2Pow) $ [1 .. n]
          candidates = takeWhile (<= lsum) $ prefixSums all

          notPows = take (length candidates - 1) all
          pows = decompose (lsum - last candidates)

main :: IO ()
main = do
  n <- read <$> getLine
  let (diff, vs) = solve n
  print diff
  putStrLn . unwords $ map show (fromIntegral (length vs) : vs)

module Main where

import Data.Int
import Data.Bits
import Control.Applicative

is2Pow :: (Num a, Bits a) => a -> Bool
is2Pow n = (n .&. (n - 1)) == 0

decompose :: Int64 -> [Int64]
decompose = go 1
    where go bit 0 = []
          go bit n | odd n = bit : bits
                   | otherwise = bits
                   where n' = n `div` 2
                         bits = go (2 * bit) (n `div` 2)

prefixSums :: (Num a) => [a] -> [a]
prefixSums = scanl (+) 0

solve :: Int64 -> (Int64, [Int64])
solve n = (rsum - lsum, take (length candidates) all ++ decompose (lsum - last candidates))
    where sum = n * (n + 1) `div` 2
          lsum = sum `div` 2
          rsum = sum - lsum

          all = filter (not . is2Pow) $ [1 .. n]
          candidates = takeWhile (<= lsum) $ prefixSums all

main :: IO ()
main = do
  n <- read <$> getLine
  let (diff, vs) = solve n
  print diff
  putStrLn . unwords $ map show (fromIntegral (length vs) : vs)

module Main where

import Data.Int
import Control.Applicative

decompose :: Int64 -> [Int64]
decompose = go 1
    where go bit 0 = []
          go bit n | odd n = bit : bits
                   | otherwise = bits
                   where n' = n `div` 2
                         bits = go (2 * bit) (n `div` 2)

solve :: Int64 -> (Int64, [Int64])
solve n | even sum = (0, decompose (sum `div` 2))
        | otherwise = (2, decompose (sum `div` 2))
    where sum = n * (n + 1) `div` 2

main :: IO ()
main = do
  n <- read <$> getLine
  let (diff, vs) = solve n
  print diff
  putStrLn . unwords $ map show (fromIntegral (length vs) : vs)

module Main where

import Data.Int
import Control.Applicative

decompose :: Int64 -> [Int64]
decompose = go 1
    where go bit 0 = []
          go bit n | odd n = bit : bits
                   | otherwise = bits
                   where n' = n `div` 2
                         bits = go (2 * bit) (n `div` 2)

solve :: Int64 -> (Int64, [Int64])
solve n | even sum = (0, decompose (sum `div` 2))
        | otherwise = (1, decompose (sum `div` 2))
    where sum = n * (n + 1) `div` 2

main :: IO ()
main = do
  n <- read <$> getLine
  let (diff, vs) = solve n
  print diff
  putStrLn . unwords $ map show (fromIntegral (length vs) : vs)

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms, CPP,
             TupleSections, UnicodeSyntax, LambdaCase,
             MultiWayIf #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[n]] = let
    diff = fromBool (n == 1 || n`mod`2 == 0) :: Int
    res = sol' n ((n*(n+1))`div`4)
  in [ show diff , intercalate " " $ map show (length res:res) ]

sol' n w
  | w == 0 = []
  | n < w  = n : sol' (n-1) (w-n)
  | n >= w = [w]

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms, CPP,
             TupleSections, UnicodeSyntax, LambdaCase,
             MultiWayIf #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[n]] = let
    t = div (n*(n+1)) 2
    diff = fromBool (n == 1 || t`mod`2 == 1) :: Int
    res = sol' n (t`div`2)
  in [ show diff , intercalate " " $ map show (length res:res) ]

sol' n w
  | w == 0 = []
  | n < w  = n : sol' (n-1) (w-n)
  | n >= w = [w]

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------


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

fst3 (x,_,_) = x
snd3 (_,x,_) = x
third3 (_,_,x) = x

readOneStock = do
  input <- getLine
  let strs = words input
  return (((strs !! 0)!!0), read (strs !! 1)::Int, read (strs !! 2)::Int)

cmp::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp a b
  | fst3 a == fst3 b = comparing snd3 a b
  | otherwise = comparing fst3 a b

cmp2::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp2 a b
  | fst3 a == fst3 b = comparing snd3 a b
  | fst3 a < fst3 b = GT
  | fst3 a > fst3 b = LT

gp::(Char,Int,Int) -> (Char,Int,Int) -> Bool
gp a b
  | fst3 a == fst3 b && snd3 a == snd3 b = True
  | otherwise = False

display [] = do
  putStrLn ""
display (s:ss) = do
  putStrLn (fst3 s : " " ++ show(snd3 s) ++ " " ++ show(third3 s))
  display ss

choose (st:stocks) 0 c = []
choose [] _ _ = []
choose (st:stocks) s c
  | fst3 st == c = st:choose stocks (s-1) c
  | otherwise = []

work sortedStocks s = choose sortedStocks s 'S' ++ choose (reverse sortedStocks) s 'B'

mergeHelper::[(Char,Int,Int)]->Int
mergeHelper [] = 0
mergeHelper (x:xs) = third3 x + mergeHelper xs

merge::[(Char,Int,Int)]->(Char,Int,Int)
merge xs = (fst3 x, snd3 x, mergeHelper xs)
  where x = xs !! 0

main = do
  input <- getLine
  let [n,s] = [read x::Int|x <- words input]
  stocks <- replicateM n readOneStock
  let sortedStocks = [merge x | x <- groupBy gp (sortBy cmp2 stocks)]
  let ans = work sortedStocks s
  display(sortBy (flip cmp) ans)

import qualified Data.Map as M
main=interact $ solve . lines
solve (ns:x) =  concatMap (f "S") (reverse sell) ++ concatMap (f "B") buy
                where [n,s] = map read $ words ns
                      merge [] m1 m2 = [M.toAscList m1, M.toDescList m2]
                      merge (x:xs) m1 m2 = let t = head x
                                               [k,v] = map read $ words $ drop 2 x
                                               f k new old = new + old
                                           in if t=='S' then merge xs (M.insertWithKey f k v m1) m2 else merge xs m1 $ M.insertWithKey f k v m2
                      [sell,buy] = map (\x->take (min s $ length x) x) $ merge x M.empty M.empty
                      f c x = c ++ " " ++ (show $ fst x) ++ " " ++ (show $ snd x) ++ "\n"

import qualified Data.IntMap.Strict as I
import Control.Monad

main :: IO()
main = do
	[n,k] <- fmap (map (\x -> read x::Int) .words) getLine
	(b,s) <- solve n I.empty I.empty
	let a1 = take k (I.toList s)
	    a2 = take k (reverse (I.toList b))
	forM_ (reverse a1) $ \(i,j) -> do {putStrLn ("S " ++ (show i) ++ " " ++ (show j))}
	forM_ a2 $ \(i,j) -> do {putStrLn ("B " ++ (show i) ++ " " ++ (show j))}

solve :: Int -> I.IntMap Int -> I.IntMap Int -> IO (I.IntMap Int,I.IntMap Int)
solve 0 m1 m2 = return (m1,m2)
solve x b s = do
	[d,p',q'] <- fmap words getLine
	let p = read p' :: Int
	    q = read q' :: Int
	case d of
		"B" -> if I.lookup p b == Nothing then solve  (x-1) (I.insert p q b) s else solve (x-1) (I.update (\x -> return (x+q)) p b) s
		"S" -> if I.lookup p s == Nothing then solve (x-1) b (I.insert p q s) else solve (x-1) b (I.update (\x -> return (x+q)) p s)

-- Codeforces 572B

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

main :: IO ()
main = do
    [n, s] <- fmap (map read . words) getLine :: IO [Int]
    replicateM n getLine >>= putStrLn . solve s . map words

solve :: Int -> [[String]] -> String
solve s book = foldl (\acc a -> (acc++a++"\n")) "" $ (reverse $ take s $ reverse slist) ++ (take s blist) where
    [slist, blist] = map (\c -> map (\ss -> c ++ " " ++ (ss!!0!!1) ++ " " ++ (show (foldl (\acc k -> acc + (read (k!!2) :: Int)) 0 ss))) $ groupBy (\a b -> (a!!1)==(b!!1)) $ sortBy (\a b -> compare (read (b!!1) :: Int) (read (a!!1) :: Int)) $ filter (\x -> (x!!0) == c) book) ["S", "B"]

import Data.List (sort)

data ReqType = Buy | Sell
    deriving (Eq, Ord)
data Request = Request {reqType :: ReqType, price :: Int, amount :: Int}
    deriving (Eq, Ord)

unite :: Request -> Request -> Request
unite (Request t p q1) (Request _ _ q2) = Request t p (q1+q2)

canUnite :: Request -> Request -> Bool
canUnite (Request t1 p1 _) (Request t2 p2 _) = t1 == t2 && p1 == p2

readReq :: String -> Request
readReq s | c == "B" = Request Buy p q
          | c == "S" = Request Sell p q
    where [c,p',q'] = words s
          p = read p'
          q = read q'

writeReq :: Request -> String
writeReq (Request t p q) = unwords [case t of
                                        Sell -> "S"
                                        Buy -> "B",
                                    show p, show q]

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

main = do
    [n,s] <- getList
    xs <- mapM (\_ -> fmap readReq getLine) [1..n]
    let ys = solve s xs
    mapM_ (putStrLn . writeReq) ys

solve :: Int -> [Request] -> [Request]
solve s = (\(a,b) -> reverse (take s (reverse a)) ++ take s b) . span ((==Sell) . reqType) . reverse . f . sort
    where f [] = []
          f [x] = [x]
          f (x:y:ys) = if canUnite x y then f ((unite x y):ys)
                                       else x : f (y:ys)

-- Codeforces 572B

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

main :: IO ()
main = do
    [n, s] <- fmap (map read . words) getLine :: IO [Int]
    replicateM n getLine >>= putStrLn . solve s . map words

solve :: Int -> [[String]] -> String
solve s book = foldl (\acc a -> (acc++a++"\n")) "" $ concatMap (\c -> take s $ map (\ss -> c ++ " " ++ (ss!!0!!1) ++ " " ++ (show (foldl (\acc k -> acc + (read (k!!2) :: Int)) 0 ss))) $ groupBy (\a b -> (a!!1)==(b!!1)) $ reverse $ sortBy (\a b -> compare (read (a!!1) :: Int) (read (b!!1) :: Int)) $ filter (\x -> (x!!0) == c) book) ["S", "B"]

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

fst3 (x,_,_) = x
snd3 (_,x,_) = x
third3 (_,_,x) = x

readOneStock = do
  input <- getLine
  let strs = words input
  return (((strs !! 0)!!0), read (strs !! 1)::Int, read (strs !! 2)::Int)

cmp::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp a b
  | fst3 a == fst3 b = comparing snd3 a b
  | otherwise = comparing fst3 a b

gp::(Char,Int,Int) -> (Char,Int,Int) -> Bool
gp a b
  | fst3 a == fst3 b && snd3 a == snd3 b = True
  | otherwise = False

display [] = do
  putStrLn ""
display (s:ss) = do
  putStrLn (fst3 s : " " ++ show(snd3 s) ++ " " ++ show(third3 s))
  display ss

choose stocks 0 l = []
choose stocks s l = [stocks !! (s-1)] ++ choose stocks (s-1) l ++ [stocks !! (l - s - 1)]

work sortedStocks s
  | 2*s <= l = choose sortedStocks s l
  | otherwise = sortedStocks
  where l = length sortedStocks

mergeHelper::[(Char,Int,Int)]->Int
mergeHelper [] = 0
mergeHelper (x:xs) = third3 x + mergeHelper xs

merge::[(Char,Int,Int)]->(Char,Int,Int)
merge xs = (fst3 x, snd3 x, mergeHelper xs)
  where x = xs !! 0

main = do
  input <- getLine
  let [n,s] = [read x::Int|x <- words input]
  stocks <- replicateM n readOneStock
  let sortedStocks = [merge x | x <- groupBy gp (sortBy (flip cmp) stocks)]
  let ans = work sortedStocks s
  display(sortBy (flip cmp) ans)

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

fst3 (x,_,_) = x
snd3 (_,x,_) = x
third3 (_,_,x) = x

readOneStock = do
  input <- getLine
  let strs = words input
  return (((strs !! 0)!!0), read (strs !! 1)::Int, read (strs !! 2)::Int)

cmp::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp a b
  | fst3 a == fst3 b = comparing snd3 a b
  | otherwise = comparing fst3 a b

cmp2::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp2 a b
  | fst3 a == fst3 b = comparing snd3 a b
  | fst3 a < fst3 b = GT
  | fst3 a > fst3 b = LT

gp::(Char,Int,Int) -> (Char,Int,Int) -> Bool
gp a b
  | fst3 a == fst3 b && snd3 a == snd3 b = True
  | otherwise = False

display [] = do
  putStrLn ""
display (s:ss) = do
  putStrLn (fst3 s : " " ++ show(snd3 s) ++ " " ++ show(third3 s))
  display ss

choose stocks 0 l = []
choose stocks s l = [stocks !! (s-1)] ++ choose stocks (s-1) l ++ [stocks !! (l - s)]

work sortedStocks s
  | 2*s <= l = choose sortedStocks s l
  | otherwise = sortedStocks
  where l = length sortedStocks

mergeHelper::[(Char,Int,Int)]->Int
mergeHelper [] = 0
mergeHelper (x:xs) = third3 x + mergeHelper xs

merge::[(Char,Int,Int)]->(Char,Int,Int)
merge xs = (fst3 x, snd3 x, mergeHelper xs)
  where x = xs !! 0

main = do
  input <- getLine
  let [n,s] = [read x::Int|x <- words input]
  stocks <- replicateM n readOneStock
  let sortedStocks = [merge x | x <- groupBy gp (sortBy cmp2 stocks)]
  let ans = work sortedStocks s
  display(sortBy (flip cmp) ans)

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

fst3 (x,_,_) = x
snd3 (_,x,_) = x
third3 (_,_,x) = x

readOneStock = do
  input <- getLine
  let strs = words input
  return (((strs !! 0)!!0), read (strs !! 1)::Int, read (strs !! 2)::Int)

cmp::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp a b
  | fst3 a == fst3 b = comparing snd3 a b
  | otherwise = comparing fst3 a b

cmp2::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp2 a b
  | fst3 a == fst3 b = comparing snd3 a b
  | fst3 a < fst3 b = GT
  | fst3 a > fst3 b = LT

gp::(Char,Int,Int) -> (Char,Int,Int) -> Bool
gp a b
  | fst3 a == fst3 b && snd3 a == snd3 b = True
  | otherwise = False

display [] = do
  putStrLn ""
display (s:ss) = do
  putStrLn (fst3 s : " " ++ show(snd3 s) ++ " " ++ show(third3 s))
  display ss

choose stocks 0 l = []
choose stocks s l = [stocks !! (s-1)] ++ choose stocks (s-1) l ++ [stocks !! (l - s)]

work sortedStocks s
  | 2*s <= l = choose sortedStocks s l
  | otherwise = sortedStocks
  where l = length sortedStocks

mergeHelper::[(Char,Int,Int)]->Int
mergeHelper [] = 0
mergeHelper (x:xs) = third3 x + mergeHelper xs

merge::[(Char,Int,Int)]->(Char,Int,Int)
merge xs = (fst3 x, snd3 x, mergeHelper xs)
  where x = xs !! 0

main = do
  input <- getLine
  let [n,s] = [read x::Int|x <- words input]
  stocks <- replicateM n readOneStock
  let sortedStocks = [merge x | x <- groupBy gp (sortBy cmp2 stocks)]
  print sortedStocks
  let ans = work sortedStocks s
  display(sortBy (flip cmp) ans)


import System.Environment

main =
     do str1 <- readFile "input.txt"
        let l = map read (words str1)
        let (k:xs) = drop 1 l
        writeFile "output.txt" (show (solve xs k 0))

solve [] k sum = sum
solve (x:xs) k sum = if x >= 3*k then (solve xs k (sum + x-3*k)) else (solve xs k (sum + (x `mod` k)))

main = do
	input <- fmap lines $ readFile "input.txt"
	let [n, k] = map read . words . head $ input
	let js = map read . words $ input !! 1
	let f x
		| x >= k * 3 = x - k * 3
		| otherwise = x `mod` k
	writeFile "output.txt" . show . sum . map f $ js

gao[[n,k],xs] = show.sum.map (\x -> if x < (3*k) then x `mod` k else x - (3*k)) $  xs
main = readFile "input.txt" >>= writeFile "output.txt" . gao . map (map read. words) . lines

import IO

solve :: Int -> [Int] -> Int
solve k xs  =  foldl (+) 0 (map f xs)
  where
    f x
      | x >= 3*k  =  x - 3*k
      | otherwise  =  mod x k

main :: IO ()
main  =  do
    hInput  <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode

    [n, k]  <-  hGetLine hInput >>= return . map read . words
    xs  <-  hGetLine hInput >>= return . map read . words
    hPutStrLn hOutput (show $ solve k xs)

    hClose hOutput
    hClose hInput

solve [[_, k], xs] = show $ foldr f 0 xs
    where f a b = b + a - k * ((a `div` k) `min` 3)

main = do text <- readFile "input.txt"
          writeFile "output.txt" (solve $ map (map read.words) $ lines text)

gao[[n,k],xs] = show.sum.map (\x -> if x < 9 then x `mod` 3 else x - 9) $  xs
main = readFile "input.txt" >>= writeFile "output.txt" . gao . map (map read. words) . lines

import System.Environment

main =
     do str1 <- readFile "input.txt"
        let l = map read (words str1)
        let (k:xs) = drop 1 l
        print (solve xs k 0)

solve [] k sum = sum
solve (x:xs) k sum = if x >= 3*k then (solve xs k (sum + x-3*k)) else (solve xs k (sum + (x `mod` k)))

import System.Environment

main =
     do str1 <- readFile "input.txt"
        let l = map read (words str1)
        let (k:xs) = drop 1 l
        print (solve xs k 0)

solve [] k sum = sum
solve (x:xs) k sum = if x > 3*k then (solve xs k (sum + x-3*k)) else (solve xs k (sum + (x `mod` k)))


solve :: Int -> String
solve 1 = "YES\n2 1\n1 2\n" -- special case
solve n | even n  = "NO\n" -- parity argument on each side of bridge
solve n = let
  size = 2*n+4
  edgeCount = quot (n*size) 2
  edgeList = concat [[(x,y),(x+n+2, y+n+2)]
                     | x <- [1..n], y <- [x+1 .. n+1], quot x 2 /= quot y 2]
          ++ concat [[(x, n+2), (x+n+2, 2*n+4)] | x <- [2..n]]
          ++ [(n+2, 2*n+4)]
  dispEdge (x, y) = show x ++ " " ++ show y ++ "\n"
  in "YES\n" ++ concatMap dispEdge ((size, edgeCount) : edgeList)

main :: IO ()
main = interact (concatMap (solve . read) . lines)

import Control.Monad (guard)
import Data.List (delete)

type Edge  = (Int, Int)
type Graph = [Edge]

vertices :: Graph -> Int
vertices = maximum . map (\(a, b) -> max a b)

merge :: Graph -> Graph -> Graph
merge g g' = g ++ (map (\(a, b) -> (a + n, b + n)) g')
             where n = vertices g

-- deg(v_1) = deg(v_2) = ... = deg(v_{d + 1}) = d - 1
almostClique :: Int -> Graph
almostClique d = do i <- [0    ..d]
                    j <- delete (i + (d + 1) `div` 2) [i + 1..d]
                    return (1 + i, 1 + j)

-- deg(v_1) = d - 1, deg(v_2) = deg(v_3) = ... = deg(v_{d + 2}) = d
almostRegular :: Int -> Graph
almostRegular d = (almostClique d) ++ [(i, d + 2) | i <- [2..d + 1]]

solve :: Int -> Maybe Graph
solve d
    | even d    = Nothing
    | d == 1    = Just $ [(1, 2)]
    | otherwise = Just $ (1, 1 + n) : merge g g
    where g = almostRegular d
          n = vertices g

format :: Maybe Graph -> String
format Nothing  = "NO"
format (Just g) = unlines $ "YES" : map pp ((vertices g, length g) : g)
                  where pp (a, b) = unwords . map show $ [a, b]

main :: IO ()
main = putStrLn . format . solve . read =<< getContents

data Edge = Edge Int Int
data Graph = Graph [Edge]

instance Show Edge where
    show (Edge a b) = (show a) ++ " " ++ (show b)

instance Show Graph where
    show (Graph [])     = ""
    show (Graph (e:es)) = (show e) ++ "\n" ++ (show (Graph es))

main :: IO()
main = putStrLn . solve . read =<< getLine

solve :: Int -> String
solve k | even k    = "NO"
        | k == 1    = "YES\n2 1\n1 2"
        | otherwise = "YES\n" ++ (show (k + k + 4)) ++ " " ++ (show (k * (k + 2))) ++ "\n" ++ (show (genGraph k))

genGraph :: Int -> Graph
genGraph k = Graph ([(Edge 1 (k + 3))] ++ (genSub 1 (k + 2)) ++ (genSub (k + 3) (k + k + 4)))

genSub :: Int -> Int -> [Edge]
genSub a b = (genOut (a + 1)) ++ (genIn (a + 2) (a + 1))
    where
        genOut :: Int -> [Edge]
        genOut c | c > b - 2 = []
                 | otherwise  = ((Edge a c):(genOut (c + 1)))

        genIn :: Int -> Int -> [Edge]
        genIn c d | c >= b && d >= b = []
                  | d >= c = genIn (c + 1) (a + 1)
                  | even (c - a) && c == d + 1 && c <= b - 2 = genIn (c + 1) (a + 1)
                  | otherwise = ((Edge d c):(genIn c (d + 1)))

import Debug.Trace (trace)
import Data.List (sort)

data Graph = Graph Int [(Int, Int)]
             deriving (Show)

connect :: Graph -> Graph -> Graph
connect (Graph n1 e1) (Graph n2 e2) = Graph (n1 + n2) (e1 ++ (map shift e2) ++ [(1, 1 + n1)])
                                      where shift (a, b) = (n1 + a, n1 + b)

recur :: Int -> [(Int, Int)]
recur 0 = []
recur d = (recur (d - 2)) ++ [(i, d - 1) | i <- [1..d - 2]] ++ [(i, d) | i <- [1..d - 2]]

construct :: Int -> Graph
construct d = Graph (d + 2) (baseEdges ++ extraEdges)
              where baseEdges  = recur (d + 1)
                    extraEdges = [(i, d + 2) | i <- [2..d + 1]]

solve :: Int -> Maybe Graph
solve 1 = Just (Graph 2 [(1, 2)])
solve d = if   even d
          then Nothing
          else Just (connect g g)
          where g = construct d

format :: Maybe Graph -> String
format Nothing                = "NO"
format (Just (Graph n edges)) = "YES\n" ++ (show n) ++ " " ++ (show (length edges)) ++ "\n" ++ (unlines . map showEdge $ edges)
                                where showEdge (a, b) = (show a) ++ " " ++ (show b)

main :: IO ()
main = putStrLn . format . solve . read =<< getContents

import Data.List (sort)

data Graph = Graph Int [(Int, Int)]
             deriving (Show)

connect :: Graph -> Graph -> Graph
connect (Graph n1 e1) (Graph n2 e2) = Graph (n1 + n2) (e1 ++ (map shift e2))
                                      where shift (a, b) = (n1 + a, n1 + b)

recur :: Int -> [(Int, Int)]
recur 0 = []
recur d = (recur (d - 2)) ++ [(i, d - 1) | i <- [1..d - 2]] ++ [(i, d) | i <- [1..d - 2]]

construct :: Int -> Graph
construct d = Graph (d + 2) (baseEdges ++ extraEdges)
              where baseEdges  = recur (d + 1)
                    extraEdges = [(i, d + 2) | i <- [2..d + 1]]

solve :: Int -> Maybe Graph
solve 1 = Just (Graph 1 [(1, 2)])
solve d = if   even d
          then Nothing
          else Just (connect g g)
          where g = construct d

format :: Maybe Graph -> String
format Nothing                = "NO"
format (Just (Graph n edges)) = "YES\n" ++ (show n) ++ " " ++ (show (length edges)) ++ "\n" ++ (unlines . map showEdge $ edges)
                                where showEdge (a, b) = (show a) ++ " " ++ (show b)

main :: IO ()
main = putStrLn . format . solve . read =<< getContents

import Data.List (sort)

data Graph = Graph Int [(Int, Int)]
             deriving (Show)

connect :: Graph -> Graph -> Graph
connect (Graph n1 e1) (Graph n2 e2) = Graph (n1 + n2) (e1 ++ (map shift e2))
                                      where shift (a, b) = (n1 + a, n1 + b)

recur :: Int -> [(Int, Int)]
recur 0 = []
recur d = (recur (d - 2)) ++ [(i, d - 1) | i <- [1..d - 2]] ++ [(i, d) | i <- [1..d - 2]]

construct :: Int -> Graph
construct d = Graph (d + 2) (baseEdges ++ extraEdges)
              where baseEdges  = recur (d + 1)
                    extraEdges = [(i, d + 2) | i <- [2..d + 1]]

solve :: Int -> Maybe Graph
solve 1 = Just (Graph 2 [(1, 2)])
solve d = if   even d
          then Nothing
          else Just (connect g g)
          where g = construct d

format :: Maybe Graph -> String
format Nothing                = "NO"
format (Just (Graph n edges)) = "YES\n" ++ (show n) ++ " " ++ (show (length edges)) ++ "\n" ++ (unlines . map showEdge $ edges)
                                where showEdge (a, b) = (show a) ++ " " ++ (show b)

main :: IO ()
main = putStrLn . format . solve . read =<< getContents


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Applicative (liftA2)
import Control.Monad (join, replicateM)
import Control.Monad.State.Strict (State, execState, get, put)
import Data.Char (ord)
import Data.List (sort)
import Data.Monoid ((<>))
import Data.Ord (Down(Down))
import Data.Ratio (denominator, numerator)
import Data.Sequence (Seq, Seq(Empty), Seq((:<|)), Seq((:|>)), (!?), index)
import qualified Data.Sequence as S (replicate, update)
import GHC.TypeNats (type (+), type (^), KnownNat, Nat, natVal)
import Numeric.Natural (Natural)
import qualified Data.ByteString.Char8 as BS (getContents, lines, readInt, words, getLine, foldl)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField (10 ^ 9 + 7)

data Event =
  Event
    { getKey :: !Int
    , getMark :: !(Either Int Int)
    }
  deriving (Show, Eq)

instance Ord Event where
  compare (Event k m) (Event k' m') = compare (Down k) (Down k') <> compare m m'

type Env = (Bool, Ways, Seq Ways)

type Ways = (Int, MField)

update :: Ways -> Ways -> Ways
update (b, c) (b', c')
  | b < b' = (b, c)
  | b == b' = (b, c + c')
  | otherwise = (b', c')

solve :: Event -> State Env ()
solve (Event k m) = do
  (large, w@(best, count), mem) <- get
  case m of
    Left i -> do
      let (b, c) = index mem i
          b' = b + k
          w' = update w (b', c)
      put (False, w', mem)
    Right i -> do
      let mem' =
            if large
              then S.update i (update (best - k, count) (0, 1)) mem
              else S.update i (best - k, count) mem
      put (large, w, mem')

main = do
  n <- fmap parseInt getLine
  contents <- getContents
  let a = fmap parseInts . lines $ contents
      e =
        join
          [[Event l (Left i), Event r (Right i)] | (i, [r, l]) <- zip [0 ..] a]
      se = sort e
      mk = maximum . fmap head $ a
      initial = (True, (mk, 0), S.replicate n (0, 0))
      (_, (_, ret), _) = execState (mapM solve se) initial
  print ret

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Applicative (liftA2)
import Control.Monad (join, replicateM)
import Control.Monad.State.Strict (State, execState, get, put)
import Data.Char (ord)
import Data.List (sort)
import Data.Monoid ((<>))
import Data.Ord (Down(Down))
import Data.Ratio (denominator, numerator)
import Data.Sequence (Seq, Seq(Empty), Seq((:<|)), Seq((:|>)), (!?), index)
import qualified Data.Sequence as S (replicate, update)
import GHC.TypeNats (type (+), type (^), KnownNat, Nat, natVal)
import Numeric.Natural (Natural)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField (10 ^ 9 + 7)

data Event =
  Event
    { getKey :: !Int
    , getMark :: !(Either Int Int)
    }
  deriving (Show, Eq)

instance Ord Event where
  compare (Event k m) (Event k' m') = compare (Down k) (Down k') <> compare m m'

type Env = (Bool, Ways, Seq Ways)

type Ways = (Int, MField)

update :: Ways -> Ways -> Ways
update (b, c) (b', c')
  | b < b' = (b, c)
  | b == b' = (b, c + c')
  | otherwise = (b', c')

solve :: Event -> State Env ()
solve (Event k m) = do
  (large, w@(best, count), mem) <- get
  case m of
    Left i -> do
      let (b, c) = index mem i
          b' = b + k
          w' = update w (b', c)
      put (False, w', mem)
    Right i -> do
      let mem' =
            if large
              then S.update i (update (best - k, count) (0, 1)) mem
              else S.update i (best - k, count) mem
      put (large, w, mem')

main = do
  n <- fmap parseInt getLine
  a <- replicateM n (fmap parseInts getLine)
  let e =
        join
          [[Event l (Left i), Event r (Right i)] | (i, [r, l]) <- zip [0 ..] a]
      se = sort e
      mk = maximum . fmap head $ a
      initial = (True, (mk, 0), S.replicate n (0, 0))
      (_, (_, ret), _) = execState (mapM solve se) initial
  print ret

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Applicative (liftA2)
import Control.Monad (join, replicateM)
import Control.Monad.State.Strict (State, execState, get, put)
import qualified Data.ByteString.Char8 as BS
  ( dropWhile
  , foldl
  , getContents
  , getLine
  , lines
  , readInt
  , words
  )
import Data.Char (isSpace, ord)
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.Ord (Down(Down))
import Data.Ratio (denominator, numerator)
import Data.Sequence (Seq, Seq(Empty), Seq((:<|)), Seq((:|>)), (!?), index)
import qualified Data.Sequence as S (replicate, update)
import GHC.TypeNats (type (+), type (^), KnownNat, Nat, natVal)
import Numeric.Natural (Natural)

parseInts s = parse id s []
  where
    parse r s =
      case BS.readInt s of
        Nothing -> r
        Just (x, s') -> parse (r . (x :)) (BS.dropWhile isSpace s')

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField (10 ^ 9 + 7)

data Event =
  Event
    { getKey :: !Int
    , getMark :: !(Either Int Int)
    }
  deriving (Show, Eq)

instance Ord Event where
  compare (Event k m) (Event k' m') = compare (Down k) (Down k') <> compare m m'

type Env = (Bool, Ways, Seq Ways)

type Ways = (Int, MField)

update :: Ways -> Ways -> Ways
update (b, c) (b', c')
  | b < b' = (b, c)
  | b == b' = (b, c + c')
  | otherwise = (b', c')

solve :: Event -> State Env ()
solve (Event k m) = do
  (large, w@(best, count), mem) <- get
  case m of
    Left i -> do
      let (b, c) = index mem i
          b' = b + k
          w' = update w (b', c)
      put (False, w', mem)
    Right i -> do
      let mem' =
            if large
              then S.update i (update (best - k, count) (0, 1)) mem
              else S.update i (best - k, count) mem
      put (large, w, mem')

main = do
  [n] <- fmap parseInts BS.getLine
  contents <- BS.getContents
  let a = fmap parseInts . BS.lines $ contents
      e =
        join
          [[Event l (Left i), Event r (Right i)] | (i, [r, l]) <- zip [0 ..] a]
      se = sort e
      mk = maximum . fmap head $ a
      initial = (True, (mk, 0), S.replicate n (0, 0))
      (_, (_, ret), _) = execState (mapM solve se) initial
  print ret


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

solve :: IO ()
solve = do
    ~[n] <- readInts
    ps <- readInts
    let (as, as') = span (uncurry (==)) $ zip [1..] ps
        an = length as
        (rcs, rbs) = span (/= an + 1) $ map snd $ reverse as'
    putStrLn $ unwords $ map show $ map snd as ++ rbs ++ reverse rcs

readInts :: IO [Int]
readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

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.Bits
import Data.List
import Debug.Trace

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

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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 tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

enumerate = zip [0..]

argmin :: [Int] -> Int
argmin a = let t = enumerate a in
  fst $ foldl (\(mni, mn) (i, x) -> if x < mn then (i, x) else (mni, mn)) (0, 999999999) t

solve :: SP Builder
solve = do
  n <- getInt
  a <- replicateM n getInt
  let pref = (+) (-1) $ maximum $ scanl (\l x -> if l == x then (l+1) else 0) 1 a
  let first = take pref a
  let rest = drop pref a
  let min_index = argmin rest
  let rest_pre = take (1+min_index) rest
  let rest_suf = drop (1+min_index) rest
  let res = first ++ reverse rest_pre ++ rest_suf
  pure $ putInts res

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 <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    p <- replicateM n getInt
    let
      (q1, q2) = span (uncurry (==)) $ zip [1..] p
      [r1, r2] = map (map snd) [q1, q2]
      x = minimum r2
      (s2, s3) = span (> x) r2
    pure $ putInts $ r1 ++ take 1 s3 ++ reverse s2 ++ drop 1 s3

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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 inp
  P.putStr $ toLazyByteString outp

import Control.Monad (forM_)
import Data.List (sort)

solve :: [Int] -> [Int]
solve arr =
    map snd as ++ rbs ++ reverse rcs
  where
    (as, as') = span (uncurry (==)) $ zip [1 ..] arr
    (rcs, rbs) = span (/= length as + 1) $ map snd $ reverse as'

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ unwords $ map show $ solve arr

import Control.Monad (forM_)
import Data.List (sort)

solve :: [Int] -> [Int]
solve arr =
    map snd as ++ ras ++ reverse rbs
  where
    (as, as') = span (uncurry (==)) $ zip [1 ..] arr
    (ras, rbs) = span (/= length as + 1) $ map snd $ reverse as'

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ unwords $ map show $ solve arr

import Control.Monad (forM_)

solve str =
    let len = length str
     in if even len && (take (len `div` 2) str == drop (len `div` 2) str) then "YES" else "NO"

main :: IO ()
main = do
    n <- readLn :: IO Int
    forM_ [1 .. n] $ \i -> do
        x <- getLine
        putStrLn $ solve x

import Control.Monad (forM_)
import Data.List (sort)

revv :: [a] -> Int -> Int -> [a]
revv arr i j = revvh arr i j ++ drop (j + 1) arr

revvh :: [a] -> Int -> Int -> [a]
revvh arr i j
    | i <= j = revvh arr (i + 1) j ++ [arr !! i]
    | otherwise = []

index :: Eq t => [t] -> t -> Int -> Int -> Int
index arr n i l
    | i < l =
        if arr !! i /= n
            then index arr n (i + 1) l
            else i
    | otherwise = i - 1

solve :: [Int] -> Int -> Int -> [Int]
solve arr i l
    | i < l =
        if arr !! i == (i + 1)
            then arr !! i : solve arr (i + 1) l
            else revv arr i (index arr (i + 1) (i + 1) l)
    | otherwise = arr

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ foldl1 (\x acc -> x ++ " " ++ acc) $ map show $ solve arr 0 n

import Control.Monad (forM_)
import Data.List (sort)

flat :: [[a]] -> [a]
flat [] = []
flat [a1] = a1
flat (a1 : a2) = a1 ++ flat a2

revv :: [a] -> Int -> Int -> [a]
revv arr i j = take i arr ++ revvh arr i j ++ drop (j + 1) arr

revvh :: [a] -> Int -> Int -> [a]
revvh arr i j
    | i <= j = revvh arr (i + 1) j ++ [arr !! i]
    | otherwise = []

solve :: Ord a => [a] -> Int -> Int -> [a]
solve arr i l
    | i < l - 1 =
        if arr !! i > arr !! (i + 1)
            then solveh arr i l
            else solve arr (i + 1) l
    | otherwise = arr

solveh :: Ord a => [a] -> Int -> Int -> [a]
solveh arr i l =
    if l == 1
        then arr
        else minimum $ map (revv arr i) [i + 1 .. l - 1]

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ foldl1 (\x acc -> x ++ " " ++ acc) $ map show $ solve arr 0 n

import Data.List (sort)
import Control.Monad (forM_)

flat :: [[a]] -> [a]
flat [] = []
flat [a1] = a1
flat (a1 : a2) = a1 ++ flat a2

revv :: [a] -> (Int, Int) -> [a]
revv arr (i, j) = take i arr ++ revvh arr i j ++ drop (j + 1) arr

revvh :: [a] -> Int -> Int -> [a]
revvh arr i j
    | i <= j = revvh arr (i + 1) j ++ [arr !! i]
    | otherwise = []

solvee arr l i =
    if l == 1
        then arr
        else minimum $ map (revv arr) (flat [[(x, y) | y <- [x + 1 .. l - 1]] | x <- [i .. l - 1]])

solve arr i l
    | i < l - 1 = if arr !! i >  arr !! (i + 1) then solvee arr l i else solve arr (i+1) l
    | otherwise = arr

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ foldl1 (\x acc -> x ++ " " ++ acc) $ map show $ solve arr 0 n

import Control.Monad (forM_)
import Data.List (sort)

flat :: [[a]] -> [a]
flat [] = []
flat [a1] = a1
flat (a1 : a2) = a1 ++ flat a2

revv :: [a] -> (Int, Int) -> [a]
revv arr (i, j) = take i arr ++ revvh arr i j ++ drop (j + 1) arr

revvh :: [a] -> Int -> Int -> [a]
revvh arr i j
    | i <= j = revvh arr (i + 1) j ++ [arr !! i]
    | otherwise = []

solve arr =
    if l == 1
        then arr
        else minimum (map (revv arr) $ flat [[(x, y) | y <- [x + 1 .. l - 1]] | x <- [0 .. l - 1]])
  where
    l = length arr

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ foldl1 (\x acc-> x ++ " " ++ acc) $ map show $ solve arr

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

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

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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 tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

enumerate = zip [0..]

argmin :: [Int] -> Int
argmin a = let t = enumerate a in
  snd $ foldl (\(mni, mn) (i, x) -> if x < mn then (i, x) else (mn, mni)) (999999999, 0) t

solve :: SP Builder
solve = do
  n <- getInt
  a <- replicateM n getInt
  let pref = (+) (-1) $ maximum $ scanl (\l x -> if l == x then (l+1) else 0) 1 a
  if pref == n-1 then pure $ str "hello" else pure $ str "bye"
  let first = take pref a
  let rest = drop pref a
  let min_index = argmin rest
  let rest_pre = take (1+min_index) rest
  let rest_suf = drop (1+min_index) rest
  let res = first ++ reverse rest_pre ++ rest_suf
  pure $ putInts res


import Control.Monad (liftM)

solve :: Int -> [(Int, Int)] -> Int
solve n as  =  min a (n - a) + min b (n - b)
  where
    a  =  length $ filter (\(a, b) -> a == 0) as
    b  =  length $ filter (\(a, b) -> b == 0) as

parsePair :: String -> (Int, Int)
parsePair line  =  case map read (words line) of
    [a, b]  ->  (a, b)

main :: IO ()
main  =  do
    n   <-  readLn
    as  <-  mapM (const $ liftM parsePair getLine) [1..n]
    print $ solve n as

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

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

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

main = do
  n <- readLn
  ps <- replicateM n getInts

  let
    s1 = sum $ map (!!0) ps
    s2 = sum $ map (!!1) ps

  print $ min s1 (n-s1) + min s2 (n-s2)

import Data.List
import qualified Data.Map as M
(|>) x f = f x

main = interact process

process contents = let
  ls = contents |> lines |> map words |> map (map read) :: [[Int]]
  sz = ls |> head |> head
  doors = ls |> tail
  in solve doors sz |> show

solve doors sz = let
  left = doors |> map head
  right = doors |> map last
  leftOpen = left |> filter (== 1) |> length
  leftClosed = sz - leftOpen
  rightOpen = right |> filter (== 1) |> length
  rightClosed = sz - rightOpen
  in min leftOpen leftClosed + min rightOpen rightClosed

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

f a b c d [] = (a,b,c,d)
f a b c d ([0,1]:es) = f (a+1) b c (d+1) es
f a b c d ([0,0]:es) = f (a+1) b (c+1) d es
f a b c d ([1,0]:es) = f a (b+1) (c+1) d es
f a b c d ([1,1]:es) = f a (b+1) c (d+1) es

main = do
    n <- readLn :: IO Int
    ns <- replicateM n ((map (fst . fromJust . C.readInt ) . C.words ) <$> C.getLine )
    let (a,b,c,d) = f 0 0 0 0 ns
    print $ (min a b)  + (min c d)

import Control.Monad
main = do
    n <- getLine
    doors <- forM [1..read n] (\_ -> do
        s <- getLine
        let [l, r] = map read $ words s
        return (l, r))
    print $ solve doors
solve doors = count left + count right
    where left = map fst doors
          right = map snd doors
count parts = min (length parts - sum parts) (sum parts)

import qualified Data.ByteString.Char8 as B
import Control.Applicative

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

main = do
  n <- readLn
  xs <- map readInt.B.words<$>B.getContents
  let f x y (l:r:rest) = f (x+l) (y+r) rest
      f x y [] = min x (n-x) + min y (n-y)
  print $ f 0 0 xs

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

main = do
	a<-read <$> getLine :: IO Int
	[c,d]<-transpose <$> map(map read) <$> map words <$> replicateM a getLine :: IO [[Int]]
	let c1 = length $ filter (==1) c
	let d1 = length $ filter (==1) d
	print $ (min c1 (a-c1)) + (min d1 (a-d1))

import qualified Data.ByteString.Char8 as B
import Control.Applicative
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
        n <- readLn
        xs <- map readInt . B.words <$> B.getContents
        let f x y (l:r:rest) = f (x+l) (y+r) rest
            f x y [] = min x (n-x) + min y (n-y)
        print $ f 0 0 xs

-- references
-- http://en.wikibooks.org/wiki/Haskell/Simple_input_and_output
-- http://www.haskell.org/haskellwiki/Haskell_Tutorial_for_C_Programmers
-- http://en.wikibooks.org/wiki/Haskell/Next_steps
-- http://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/Parsing
-- http://legacy.cs.uu.nl/daan/download/parsec/parsec.html#parse
-- http://legacy.cs.uu.nl/daan/download/parsec/parsec.html#decimal
-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html
-- enots CF solution 2C

ans :: Int -> [(Int, Int)] -> Int
ans a b = minimum ((sum (fst (unzip b)) : [(a - (sum (fst (unzip b))))]))
	+ minimum ((sum (snd (unzip b)) : [(a - (sum (snd (unzip b))))]))

process :: [String] -> [(Int, Int)]
process [] 	  = []
process (a : (b : c)) = (read a, read b) : (process c)
process _         = []

main :: IO()
main = do
	str <- getContents
	putStrLn (show (ans (read ((words str) !! 0)) (process (tail (words str)))))

import Data.List
import qualified Data.Map as M
(|>) x f = f x

main = interact process

process contents = let
  ls = contents |> lines |> map words |> map (map read) :: [[Int]]
  sz = ls |> head |> head
  doors = ls |> tail
  in solve doors sz |> show

solve doors sz = let
  left = doors |> map head
  right = doors |> map last
  leftOpen = left |> filter (== 1) |> length
  leftClosed = sz - leftOpen
  rightOpen = right |> filter (== 1) |> length
  rightClosed = sz - rightOpen
  x = leftClosed + rightOpen
  y = leftOpen + rightClosed
  in min x y


import Control.Monad
main = do
    [a,b,c] <- liftM (map read . words) (getLine) :: IO [Double]
    putStrLn $ show $ (a*a*a/(6*sqrt(2))) + (b*b*(sqrt(0.5))*b/3) + s5 c

s5 c = (1/4)*sqrt(5*(5+2*(sqrt 5))) * c*c * (1/3) * sqrt(c^2 - r^2)
    where r = (1/2)*c*1.7013016167

import Control.Monad (liftM)

solve :: Double -> Double -> Double
solve n l =
    let a = pi / n in
    let l' = l / 2 / sin a in
    let h = sqrt (l ** 2 - l' ** 2) in
    l' * l' * sin (2 * a) / 2 * h / 3 * n

main :: IO ()
main = do
    [l_3, l_4, l_5] <- (map read . words) `liftM` getContents :: IO [Double]
    print $ solve 3 l_3 + solve 4 l_4 + solve 5 l_5