{-# LANGUAGE BangPatterns #-}

main=interact$show.solve.lines

solve :: [String] -> Int
solve [ss',ps'] = if length ps' > length ss'
                     then 0
                     else go 0 (foldr put counter0 ss0) (Q ss0 []) ss
   where
     ps = foldr put counter0 ps'
     counter0 = ['a'..'z']>>[0]
     (ss0,ss) = splitAt (length ps') ss'
     go !ans !counter q [] = if isGood counter ps then ans+1 else ans
     go !ans !counter queue (c:cs) = go ans' (put c $ del x counter) (push c q) cs
        where
          (x,q) = pop queue
          ans' = if isGood counter ps then ans+1 else ans

isGood !xs !ys = and $ zipWith (<=) xs ys
put :: Char -> [Int] -> [Int]
put '?' !xs = xs
put !c !xs = ys ++ (z+1):zs
   where
     (ys,(z:zs)) = splitAt (fromEnum c-97) xs
del '?' !xs = xs
del !c !xs = ys ++ (z-1):zs
   where
     (ys,(z:zs)) = splitAt (fromEnum c-97) xs

data Queue = Q String String

push :: Char -> Queue -> Queue
push x (Q f r) = Q f (x:r)

pop :: Queue -> (Char, Queue)
pop (Q [] rs) = pop (Q (reverse rs) [])
pop (Q (f:fs) rs) = (f,Q fs rs)

import qualified Data.Map as M
f=filter
u=M.unionWith(+)
k=M.fromListWith(+)
g n h=(<=l '?'h).sum.f(>0).M.elems$u n(fmap negate h)
l=(maybe 0 id.).M.lookup
m=k.map a
a x=(x,1)
d x=(x,-1)
b n l=scanl u(m$take n l)$zipWith(\x y->k[a x,d y])(drop n l)l
s[s,p]=f(g(m p))(b (length p) s)
main=interact$show.length.s.words

import qualified Data.Map as M
f=filter
u=M.unionWith(+)
k=M.fromListWith(+)
g n h=(<=M.findWithDefault 0'?'h).sum.f(>0).M.elems$u n(fmap negate h)
m l=k[(x,1)|x<-l]
b n l=scanl u(m$take n l)$zipWith(\x y->k[(x,1),(y,-1)])(drop n l)l
s[s,p]=f(g$m p)$b(length p)s
main=interact$show.length.s.words

import qualified  Data.Map as M
import Debug.Trace
import Data.Maybe
import Data.Char

compareMaps text pat = and $ map check ['a'..'z']
  where check a = M.lookup a text <= M.lookup a pat

anagram_count s p = if length s < length p
                    then 0
                    else mycount patMap textMap s trail
  where patMap = getMyMap p
        textMap = getMyMap $ take (length p) s
        trail = drop (length p) s

mycount patMap textMap _ [] = if compareMaps textMap patMap
                              then 1
                              else 0
mycount patMap textMap (l:lead) (t:trail) = let rec = mycount patMap newTextMap lead trail
                                                newTextMap = updateMap (removeMap textMap l) t
                                                cmp = compareMaps textMap patMap
                                            in if cmp
                                               then 1 + rec
                                               else rec

removeMap m c = if c == '?'
                then m
                else let newC = (fromJust $ M.lookup c m) - 1
                     in if newC == 0
                        then M.delete c m
                        else M.insert c newC m

updateMap :: M.Map Char Int -> Char -> M.Map Char Int
updateMap m '?' = m
updateMap m c = if M.member c m
                then let cur = fromJust $ M.lookup c m
                     in M.insert c (cur+1) m
                else M.insert c 1 m

getMyMap :: String -> M.Map Char Int
getMyMap s = foldl updateMap M.empty s

strip :: String -> String
strip = f.f where f = reverse.dropWhile isSpace

main = do
	line <- getLine
	let s = strip line
	line <- getLine
	let p = strip line
            ans = anagram_count s p
	putStrLn $ show ans

import qualified Data.Map as Map
import Data.Map(Map)

isGood need have = (<= get '?' have) . sum . filter (>0) . Map.elems $
                   (Map.unionWith (+) need (fmap negate have))

get x = maybe 0 id . Map.lookup x
add x = Map.insertWith (+) x 1
sub x = Map.insertWith (+) x (-1)

mkMap = foldr add Map.empty

balances n l = scanl (flip($))
               (mkMap (take n l))
               (zipWith (.) (map add (drop n l)) (map sub l))

solve s p = length $ filter (isGood (mkMap p)) (balances (length p) s)

s [s, p] = solve s p

main = interact $ show . s . words

import Data.List(sort)
import Control.Applicative
import Data.ByteString(ByteString)
import qualified Data.ByteString.Char8 as B

main = do s <- B.getLine
          p <- B.sort <$> B.getLine
          print $ solve s p

solve :: ByteString -> ByteString -> Int
solve s p = length $ filter (flip eqString p . B.sort) $ take (ls-lp+1) $ f lp s
   where lp = B.length p
         ls = B.length s

eqString :: ByteString -> ByteString -> Bool
eqString xs ys = eqString' xs' ys qs
   where (qs,xs') = B.span ('?'==) xs

eqString' xs ys qs
  | B.null ys = True
  | B.null xs && B.null qs = False
  | B.null xs = (B.length ys) <= (B.length qs)
  | B.head xs == B.head ys = eqString' (B.tail xs) (B.tail ys) qs
  | B.null qs = False
  | otherwise = eqString' xs (B.tail ys) (B.tail qs)

f n xs
  | B.null xs = []
  | otherwise = (B.take n xs): f n (B.tail xs)
{-
f n [] = []
f n xxs@(x:xs) = (take n xxs): f n xs
-}
{-
eqString' _ [] _ = True
eqString' [] (_:ys) [] = False
eqString' [] (_:ys) (_:qs) = eqString' [] ys qs
eqString' (x:xs) (y:ys) qs
  | x == y    = eqString' xs ys qs
  | null qs   = False
  | otherwise = eqString' (x:xs) ys $ tail qs
-}

{-# LANGUAGE BangPatterns #-}

main=interact$show.solve.lines

solve :: [String] -> Int
solve [ss',ps'] = go 0 (foldr put counter0 ss0) (Q ss0 []) ss
   where
     ps = foldr put counter0 ps'
     counter0 = ['a'..'z']>>[0]
     (ss0,ss) = splitAt (length ps') ss'
     go !ans !counter q [] = if isGood counter ps then ans+1 else ans
     go !ans !counter queue (c:cs) = go ans' (put c $ del x counter) (push c q) cs
        where
          (x,q) = pop queue
          ans' = if isGood counter ps then ans+1 else ans

isGood !xs !ys = and $ zipWith (<=) xs ys
put :: Char -> [Int] -> [Int]
put '?' !xs = xs
put !c !xs = ys ++ (z+1):zs
   where
     (ys,(z:zs)) = splitAt (fromEnum c-97) xs
del '?' !xs = xs
del !c !xs = ys ++ (z-1):zs
   where
     (ys,(z:zs)) = splitAt (fromEnum c-97) xs

data Queue = Q String String

push :: Char -> Queue -> Queue
push x (Q f r) = Q f (x:r)

pop :: Queue -> (Char, Queue)
pop (Q [] rs) = pop (Q (reverse rs) [])
pop (Q (f:fs) rs) = (f,Q fs rs)

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

main = do s <- B.init <$> B.getLine
          p <- B.sort <$> B.getLine
          print $ solve s p

solve :: ByteString -> ByteString -> Int
solve s p = length $ filter (flip eqString p . B.sort) $ take (ls-lp+1) $ f lp s
   where lp = B.length p
         ls = B.length s

eqString :: ByteString -> ByteString -> Bool
eqString xs ys = eqString' xs' ys qs
   where (qs,xs') = B.span ('?'==) xs

eqString' xs ys qs
  | B.null ys              = True
  | B.null xs && B.null qs = False
  | B.null xs              = (B.length ys) <= (B.length qs)
  | B.head xs == B.head ys = eqString' (B.tail xs) (B.tail ys) qs
  | B.null qs              = False
  | otherwise              = eqString' xs (B.tail ys) (B.tail qs)

f n xs
  | B.null xs = []
  | otherwise = (B.take n xs): f n (B.tail xs)

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

main = do s <- B.getLine
          p <- B.sort <$> B.getLine
          print $ solve s p
          B.putStrLn $ B.append s p

solve :: ByteString -> ByteString -> Int
solve s p = length $ filter (flip eqString p . B.sort) $ take (ls-lp+1) $ f lp s
   where lp = B.length p
         ls = B.length s

eqString :: ByteString -> ByteString -> Bool
eqString xs ys = eqString' xs' ys qs
   where (qs,xs') = B.span ('?'==) xs

eqString' xs ys qs
  | B.null ys = True
  | B.null xs && B.null qs = False
  | B.null xs = (B.length ys) <= (B.length qs)
  | B.head xs == B.head ys = eqString' (B.tail xs) (B.tail ys) qs
  | B.null qs = False
  | otherwise = eqString' xs (B.tail ys) (B.tail qs)

f n xs
  | B.null xs = []
  | otherwise = (B.take n xs): f n (B.tail xs)

import Control.Applicative
import Data.ByteString(ByteString)
import qualified Data.ByteString.Char8 as B
import Debug.Trace

infixr 0 .$.
(.$.) :: Show a => (a -> b) -> a -> b
f .$. x = trace (show x) f x

main = do s <- B.getLine
          p <- B.sort <$> B.getLine
          print $ solve s p

solve :: ByteString -> ByteString -> Int
solve s p = length $ filter (flip eqString p . B.sort) .$. take (ls-lp+1) $ f lp s
   where lp = B.length p
         ls = B.length s

eqString :: ByteString -> ByteString -> Bool
eqString xs ys = eqString' xs' ys qs
   where (qs,xs') = B.span ('?'==) xs

eqString' xs ys qs
  | B.null ys              = True
  | B.null xs && B.null qs = False
  | B.null xs              = (B.length ys) <= (B.length qs)
  | B.head xs == B.head ys = eqString' (B.tail xs) (B.tail ys) qs
  | B.null qs              = False
  | otherwise              = eqString' xs (B.tail ys) (B.tail qs)

f n xs
  | B.null xs = []
  | otherwise = (B.take n xs): f n (B.tail xs)


module Main where

import Data.Ratio
import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = let x2 = x^2 in [(a, b) | a <- [1..x], b <- [(a+1)..x], a^2 + b^2 == x2]

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(ia:ib:[]) -> do
        -- triangle coords currently are p0: (0, sa), p1: (sb, 0), p2: (0, 0)
        let sa = min ia ib
            sb = max ia ib
            toRatios  = S.fromList . map (uncurry (%)) . triples
            common    = S.intersection (toRatios sa) (toRatios sb)
            multi x r = floor . sqrt . fromIntegral $ x ^ 2 `div` (numerator r ^ 2 + denominator r ^ 2)

        case S.elems common of
            []  -> putStrLn "NO"
            r:_ -> do

                let msa = multi sa r
                    msb = multi sb r
                    display x y = putStrLn $ show x ++ " " ++ show y

                putStrLn "YES"
                display (-msa * denominator r) (msa * numerator r)
                display (msb * numerator r) (msb * denominator r)
                display 0 0

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

import Control.Applicative
import Control.Monad
import qualified Data.IntSet as IS
import Data.Maybe

main = do
  ab <- map read.words <$> getLine
  case solve ab of
    Nothing -> putStrLn "NO"
    Just [(x1,y1),(x2,y2)] -> do
      putStrLn "YES"
      putStrLn "0 0"
      putStrLn $ shows x1 " " ++ show y1
      putStrLn $ shows x2 " " ++ show y2

solve :: [Int] -> Maybe [(Int,Int)]
solve [a,b] = listToMaybe candidates
   where
     !squares = IS.fromList [x*x|x<-[1..1000]]
     !bb = b * b
     candidates = do
       x<-[1..1000]
       let !xx = x*x
           !yy = bb - xx
       guard $ yy `IS.member` squares
       let !y = intSqrt yy
       guard $ a*y`rem`b == 0 && a*x`rem`b == 0
       let !x' = - a * y `div` b
           !y' = a * x `div` b
       guard $ x /= x' && y /= y'
       [[(x,y),(x',y')]]

intSqrt :: Int -> Int
intSqrt = floor.sqrt.fromIntegral

import Data.Maybe
import Control.Monad
import Control.Arrow
main = interact $ format . solve . parse
format Nothing = "NO"
format (Just ((a,b),(c,d))) = unlines [ "YES"
                                      , "0 0"
                                      , show a ++ " " ++ show b
                                      , show (a+c) ++ " " ++ show (b+d) ]
parse = map read . words
solve [i,j] = listToMaybe $ do
  (a,b) <- unsquare i
  (_c,_d) <- unsquare j
  (c,d) <- [(_c,-_d),(_d,-_c)]
  guard (b /= -d)
  guard (a*c + b*d == 0)
  return ((a,b),(c,d))
unsquare :: Int -> [(Int,Int)]
unsquare x = merge (map (second (x^2 -)) squares) (reverse squares)
squares = map (id &&& (^2)) [1..999]
merge :: [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)]
merge as@((a,sa):as') bs@((b,sb):bs') = case compare sa sb of
  EQ -> (a,b) : (merge as' bs')
  LT -> merge as bs'
  GT -> merge as' bs
merge _ _ = []

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import qualified Data.IntSet as IS

main = do
  ab <- fmap(map read.words)getLine
  case solve ab of
    Nothing -> putStrLn "NO"
    Just [(x1,y1),(x2,y2)] -> do
      putStrLn "YES"
      putStrLn "0 0"
      putStrLn $ shows x1 " " ++ show y1
      putStrLn $ shows x2 " " ++ show y2

solve :: [Int] -> Maybe [(Int,Int)]
solve [a,b] = case filter isValid candidates of
                [] -> Nothing
                ((x,y):_) -> Just [(x,y),(-a*y`quot`b,a*x`quot`b)]
   where
     !squares = IS.fromList [x*x|x<-[1..1000]]
     !bb = b * b
     isValid (x,y) = (x*a)`rem`b==0 && (y*a)`rem`b==0
     candidates = do
       x<-[1..1000]
       let !xx = x*x
           !yy = bb - xx
       [(x,intSqrt yy)|yy `IS.member` squares]

intSqrt :: Int -> Int
intSqrt = floor.sqrt.fromIntegral

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

import Control.Applicative
import Control.Monad
import qualified Data.IntSet as IS
import Data.Maybe

main = do
  ab <- map read.words <$> getLine
  case solve ab of
    Nothing -> putStrLn "NO"
    Just [(x1,y1),(x2,y2)] -> do
      putStrLn "YES"
      putStrLn "0 0"
      putStrLn $ shows x1 " " ++ show y1
      putStrLn $ shows x2 " " ++ show y2

solve :: [Int] -> Maybe [(Int,Int)]
solve [a,b] = listToMaybe candidates
   where
     !squares = IS.fromList [x*x|x<-[1..1000]]
     !bb = b * b
     candidates = do
       x<-[1..1000]
       let !xx = x*x
           !yy = bb - xx
       guard $ yy `IS.member` squares
       let !y = intSqrt yy
       guard $ a*y`rem`b == 0 && a*x`rem`b == 0
       let !x' = - a * y `div` b
           !y' = b * x `div` b
       guard $ x /= x' && y /= y'
       [[(x,y),(x',y')]]

intSqrt :: Int -> Int
intSqrt = floor.sqrt.fromIntegral

module Main where

import System.IO

import Data.Ratio
import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = [(min a b, max a b) | m <- [2..top], n <- [1..(m-1)], let a = m^2 - n^2, let b = 2 * m * n, m^2 + n^2 == x]
    where top = floor . sqrt . fromIntegral $ x

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) -> do
        -- triangle coords currently are p0: (0, sa), p1: (sb, 0), p2: (0, 0)
        let toRatios  = S.fromList . map (uncurry (%)) . triples
            common    = S.intersection (toRatios sa) (toRatios sb)
            multi x r = floor . sqrt . fromIntegral $ x ^ 2 `div` (numerator r ^ 2 + denominator r ^ 2)

        case S.elems common of
            []  -> putStrLn "NO"
            r:_ -> do

                let msa = multi sa r
                    msb = multi sb r
                    display x y = putStrLn $ show x ++ " " ++ show y

                putStrLn "YES"
                display (-msa * denominator r) (msa * numerator r)
                display (msb * numerator r) (msb * denominator r)
                display 0 0

module Main where

import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = filter (\(a,b) -> a /= 0 && b /= 0) [(min a b, max a b) | m <- [2..top], n <- [1..(m-1)], let a = m^2 - n^2, let b = 2 * m * n, m^2 + n^2 == x]
    where top = floor . sqrt . fromIntegral $ x

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) ->
        case (triples sa, triples sb) of
            (a@(a1,a2):_, b@(b1,b2):_) -> do
                putStrLn "YES"
                if a == b && a1 == a2
                    then putStrLn "NO"
                    else putStrLn $ show a1 ++ " " ++ show a2 ++ "\n" ++ show b2 ++ " " ++ show b1
                putStrLn "0 0"

            _ -> putStrLn "NO"

module Main where

import Data.Ratio
import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = let x2 = x^2 in [(a, b) | a <- [1..x], b <- [(a+1)..x], a^2 + b^2 == x2]

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) -> do
        -- triangle coords currently are p0: (0, sa), p1: (sb, 0), p2: (0, 0)
        let toRatios  = S.fromList . map (uncurry (%)) . triples
            common    = S.intersection (toRatios sa) (toRatios sb)
            multi x r = floor . sqrt . fromIntegral $ x ^ 2 `div` (numerator r ^ 2 + denominator r ^ 2)

        case S.elems common of
            []  -> putStrLn "NO"
            r:_ -> do

                let msa = multi sa r
                    msb = multi sb r
                    display x y = putStrLn $ show x ++ " " ++ show y

                putStrLn "YES"
                display (-msa * denominator r) (msa * numerator r)
                display (msb * numerator r) (msb * denominator r)
                display 0 0

module Main where

import System.IO

import Data.Ratio
import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = [(min a b, max a b) | m <- [2..top], n <- [1..(m-1)], let a = m^2 - n^2, let b = 2 * m * n, m^2 + n^2 == x]
    where top = floor . sqrt . fromIntegral $ x

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) ->
        case (triples sa, triples sb) of
            (a@(a1,a2):_, b@(b1,b2):_) -> do
                putStrLn "YES"
                putStrLn $ show a1 ++ " " ++ show a2 ++ "\n" ++ show (if a == b then -b1 else b1) ++ " " ++ show b2
                putStrLn "0 0"

            _ -> putStrLn "NO"

module Main where

import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = filter (\(a,b) -> a /= 0 && b /= 0) [(min a b, max a b) | m <- [2..top], n <- [1..(m-1)], let a = m^2 - n^2, let b = 2 * m * n, m^2 + n^2 == x]
    where top = floor . sqrt . fromIntegral $ x

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) ->
        case (triples sa, triples sb) of
            (a@(a1,a2):_, b@(b1,b2):_) -> do
                if a == b && a1 == a2
                    then putStrLn "NO"
                    else do
                        putStrLn "YES"
                        putStrLn $ show a1 ++ " " ++ show a2 ++ "\n" ++ show b2 ++ " " ++ show b1
                        putStrLn "0 0"

            _ -> putStrLn "NO"

import Data.Maybe
import Control.Monad
import Control.Arrow
main = interact $ format . solve . parse
format Nothing = "NO"
format (Just ((a,b),(c,d))) = unlines [ "YES"
                                      , "0 0"
                                      , show a ++ " " ++ show b
                                      , show (a+c) ++ " " ++ show (b+d) ]
parse = map read . words
solve [i,j] = listToMaybe $ do
  (a,b) <- unsquare i
  (_c,_d) <- unsquare j
  (c,d) <- [(_c,-_d),(_d,-_c)]
  guard (b /= d)
  guard (a*c + b*d == 0)
  return ((a,b),(c,d))
unsquare :: Int -> [(Int,Int)]
unsquare x = merge (map (second (x^2 -)) squares) (reverse squares)
squares = map (id &&& (^2)) [1..999]
merge :: [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)]
merge as@((a,sa):as') bs@((b,sb):bs') = case compare sa sb of
  EQ -> (a,b) : (merge as' bs')
  LT -> merge as bs'
  GT -> merge as' bs
merge _ _ = []


{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

module Main where
import           Control.Monad                  ( replicateM_ )
import           Data.Array.Unboxed             ( (!)
                                                , (//)
                                                , IArray(..)
                                                , UArray
                                                , listArray
                                                )
import           Data.Bits                      ( Bits(..) )
import           Data.Foldable                  ( Foldable(..) )
import           Data.List                      ( sort )

qpow :: Int -> Int -> Int -> Int
qpow a b m = qpow' (a `mod` m) b m
  where
    qpow' a 0 m = 1 `mod` m
    qpow' a b m | odd b     = s * s * a `mod` m
                | otherwise = s * s `mod` m
      where
        b' = b `shiftR` 1
        s  = qpow' a b' m

arrange :: Int -> Int -> Int
arrange x y = product [x, x - 1 .. x - y + 1]

-- >>> arrange 5 <$> [1..5]
-- [5,20,60,120,120]

compose :: Int -> Int -> Int
compose x y = arrange x y `div` product [1 .. x]

-- >>> f [1,2,5] [3,4]
-- [[1,3],[1,4],[2,3],[2,4],[5,3],[5,4]]

isPrime :: Int -> Bool
isPrime n = go 2
  where
    go d | d * d > n      = True
         | n `rem` d == 0 = False
         | otherwise      = go (d + 1)

primes :: [Int]
primes = filter isPrime [2 ..]

initial :: Int -> Int -> UArray (Int, Int) Bool
initial n m = listArray ((1, 1), (n, m)) (repeat True)

-- >>> initial 2 2
-- array ((1,1),(2,2)) [((1,1),True),((1,2),True),((2,1),True),((2,2),True)]

intact :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Int -> Bool
intact arr l r h b = and [ arr ! (x, y) | x <- [l .. r], y <- [h, b] ]

-- >>> intact (initial 2 2) 1 2 1 2
-- True

fall :: UArray (Int, Int) Bool -> (Int, Int) -> UArray (Int, Int) Bool
fall arr p = arr // [(p, False)]

-- >>> fall (initial 2 2) (1, 1)
-- array ((1,1),(2,2)) [((1,1),False),((1,2),True),((2,1),True),((2,2),True)]

count :: UArray (Int, Int) Bool -> Int
count arr = foldl' (\acc (x, y, a, b) -> if intact arr x y a b then acc + 1 else acc)
                   0
                   [ (x, y, a, b) | x <- [1 .. n], y <- [x .. n], a <- [1 .. m], b <- [a .. m] ]
    where (n, m) = snd $ bounds arr

{-

>>> n = 7
>>> m = 4
>>> arr = initial n m

>>> count arr
280

>>> ((\x -> count . fall arr . (x,) <$> [1..m]) <$> [1..n])
[[252,252,252,252],[232,232,232,232],[220,220,220,220],[216,216,216,216],[220,220,220,220],[232,232,232,232],[252,252,252,252]]

>>> ps = (\[a,b]->(a,b)) <$> sequence [[1..n], [1..m]]

>>> ps
[(1,1),(1,2),(1,3),(1,4),(2,1),(2,2),(2,3),(2,4),(3,1),(3,2),(3,3),(3,4),(4,1),(4,2),(4,3),(4,4),(5,1),(5,2),(5,3),(5,4),(6,1),(6,2),(6,3),(6,4),(7,1),(7,2),(7,3),(7,4)]

-- >>> sequence [ps, ps]

>>> count . foldl fall arr <$> sequence [ps,ps]

-}

diff :: Int -> [Int] -> ([Int], Int)
diff zero =
    (\(acc, zs) -> if zs > 0 then (0 : acc, zs) else (acc, 0))
        . foldr (\(a, b) (acc, zs) -> if a - b == 0 then (acc, zs + 1) else (a - b : acc, zs)) ([], zero)
        . (zip =<< tail)

-- >>> diff 1 [0, 1]
-- ([0,1],1)

go :: Int -> [Int] -> Int
go _    [0, x] = x
go _    [x]    = x
go zero xs     = go (max 0 (zs - 1)) (sort di) where (di, zs) = diff zero xs

{-

>>> go 0 [1,10,100]
81

>>> go 0 [4,8,9,13]
3

>>> go 0 [0,0,0,8,13]
1

>>> go 0 [2,4,8,16,32,64]
2

-}

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n  <- readLn @Int
        xs <- map (read @Int) . words <$> getLine
        print $ go 0 xs

{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -O2  #-}

module Main where
import           Control.Monad                  ( replicateM_ )
import           Data.Array.Unboxed             ( (!)
                                                , (//)
                                                , IArray(..)
                                                , UArray
                                                , listArray
                                                )
import           Data.Bits                      ( Bits(..) )
import           Data.Foldable                  ( Foldable(..) )
import           Data.List                      ( sort )

qpow :: Int -> Int -> Int -> Int
qpow a b m = qpow' (a `mod` m) b m
  where
    qpow' a 0 m = 1 `mod` m
    qpow' a b m | odd b     = s * s * a `mod` m
                | otherwise = s * s `mod` m
      where
        b' = b `shiftR` 1
        s  = qpow' a b' m

arrange :: Int -> Int -> Int
arrange x y = product [x, x - 1 .. x - y + 1]

-- >>> arrange 5 <$> [1..5]
-- [5,20,60,120,120]

compose :: Int -> Int -> Int
compose x y = arrange x y `div` product [1 .. x]

-- >>> f [1,2,5] [3,4]
-- [[1,3],[1,4],[2,3],[2,4],[5,3],[5,4]]

isPrime :: Int -> Bool
isPrime n = go 2
  where
    go d | d * d > n      = True
         | n `rem` d == 0 = False
         | otherwise      = go (d + 1)

primes :: [Int]
primes = filter isPrime [2 ..]

initial :: Int -> Int -> UArray (Int, Int) Bool
initial n m = listArray ((1, 1), (n, m)) (repeat True)

-- >>> initial 2 2
-- array ((1,1),(2,2)) [((1,1),True),((1,2),True),((2,1),True),((2,2),True)]

intact :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Int -> Bool
intact arr l r h b = and [ arr ! (x, y) | x <- [l .. r], y <- [h, b] ]

-- >>> intact (initial 2 2) 1 2 1 2
-- True

fall :: UArray (Int, Int) Bool -> (Int, Int) -> UArray (Int, Int) Bool
fall arr p = arr // [(p, False)]

-- >>> fall (initial 2 2) (1, 1)
-- array ((1,1),(2,2)) [((1,1),False),((1,2),True),((2,1),True),((2,2),True)]

count :: UArray (Int, Int) Bool -> Int
count arr = foldl' (\acc (x, y, a, b) -> if intact arr x y a b then acc + 1 else acc)
                   0
                   [ (x, y, a, b) | x <- [1 .. n], y <- [x .. n], a <- [1 .. m], b <- [a .. m] ]
    where (n, m) = snd $ bounds arr

{-

>>> n = 7
>>> m = 4
>>> arr = initial n m

>>> count arr
280

>>> ((\x -> count . fall arr . (x,) <$> [1..m]) <$> [1..n])
[[252,252,252,252],[232,232,232,232],[220,220,220,220],[216,216,216,216],[220,220,220,220],[232,232,232,232],[252,252,252,252]]

>>> ps = (\[a,b]->(a,b)) <$> sequence [[1..n], [1..m]]

>>> ps
[(1,1),(1,2),(1,3),(1,4),(2,1),(2,2),(2,3),(2,4),(3,1),(3,2),(3,3),(3,4),(4,1),(4,2),(4,3),(4,4),(5,1),(5,2),(5,3),(5,4),(6,1),(6,2),(6,3),(6,4),(7,1),(7,2),(7,3),(7,4)]

-- >>> sequence [ps, ps]

>>> count . foldl fall arr <$> sequence [ps,ps]

-}

diff :: Int -> [Int] -> ([Int], Int)
diff zero =
    (\(acc, zs) -> if zs > 0 then (0 : acc, zs) else (acc, 0))
        . foldr (\(a, b) (acc, zs) -> if a - b == 0 then (acc, zs + 1) else (a - b : acc, zs)) ([], zero)
        . (zip =<< tail)

-- >>> diff 1 [0, 1]
-- ([0,1],1)

go :: Int -> [Int] -> Int
go _    [0, x] = x
go _    [x]    = x
go zero xs     = go (max 0 (zs - 1)) (sort di) where (di, zs) = diff zero xs

{-

>>> go 0 [1,10,100]
81

>>> go 0 [4,8,9,13]
3

>>> go 0 [0,0,0,8,13]
1

>>> go 0 [2,4,8,16,32,64]
2

-}

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n  <- readLn @Int
        xs <- map (read @Int) . words <$> getLine
        print $ go 0 xs

{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

module Main where
import           Data.Array.Unboxed             ( (!)
                                                , (//)
                                                , IArray(..)
                                                , UArray
                                                , listArray
                                                )
import           Data.Bits                      ( Bits(..) )
import           Data.Foldable                  ( Foldable(..) )
import           Data.List                      ( sort )

qpow :: Int -> Int -> Int -> Int
qpow a b m = qpow' (a `mod` m) b m
  where
    qpow' a 0 m = 1 `mod` m
    qpow' a b m | odd b     = s * s * a `mod` m
                | otherwise = s * s `mod` m
      where
        b' = b `shiftR` 1
        s  = qpow' a b' m

arrange :: Int -> Int -> Int
arrange x y = product [x, x - 1 .. x - y + 1]

-- >>> arrange 5 <$> [1..5]
-- [5,20,60,120,120]

compose :: Int -> Int -> Int
compose x y = arrange x y `div` product [1 .. x]

-- >>> f [1,2,5] [3,4]
-- [[1,3],[1,4],[2,3],[2,4],[5,3],[5,4]]

isPrime :: Int -> Bool
isPrime n = go 2
  where
    go d | d * d > n      = True
         | n `rem` d == 0 = False
         | otherwise      = go (d + 1)

primes :: [Int]
primes = filter isPrime [2 ..]

initial :: Int -> Int -> UArray (Int, Int) Bool
initial n m = listArray ((1, 1), (n, m)) (repeat True)

-- >>> initial 2 2
-- array ((1,1),(2,2)) [((1,1),True),((1,2),True),((2,1),True),((2,2),True)]

intact :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Int -> Bool
intact arr l r h b = and [ arr ! (x, y) | x <- [l .. r], y <- [h, b] ]

-- >>> intact (initial 2 2) 1 2 1 2
-- True

fall :: UArray (Int, Int) Bool -> (Int, Int) -> UArray (Int, Int) Bool
fall arr p = arr // [(p, False)]

-- >>> fall (initial 2 2) (1, 1)
-- array ((1,1),(2,2)) [((1,1),False),((1,2),True),((2,1),True),((2,2),True)]

count :: UArray (Int, Int) Bool -> Int
count arr = foldl' (\acc (x, y, a, b) -> if intact arr x y a b then acc + 1 else acc)
                   0
                   [ (x, y, a, b) | x <- [1 .. n], y <- [x .. n], a <- [1 .. m], b <- [a .. m] ]
    where (n, m) = snd $ bounds arr

{-

>>> n = 7
>>> m = 4
>>> arr = initial n m

>>> count arr
280

>>> ((\x -> count . fall arr . (x,) <$> [1..m]) <$> [1..n])
[[252,252,252,252],[232,232,232,232],[220,220,220,220],[216,216,216,216],[220,220,220,220],[232,232,232,232],[252,252,252,252]]

>>> ps = (\[a,b]->(a,b)) <$> sequence [[1..n], [1..m]]

>>> ps
[(1,1),(1,2),(1,3),(1,4),(2,1),(2,2),(2,3),(2,4),(3,1),(3,2),(3,3),(3,4),(4,1),(4,2),(4,3),(4,4),(5,1),(5,2),(5,3),(5,4),(6,1),(6,2),(6,3),(6,4),(7,1),(7,2),(7,3),(7,4)]

-- >>> sequence [ps, ps]

>>> count . foldl fall arr <$> sequence [ps,ps]

-}

diff :: Int -> [Int] -> ([Int], Int)
diff zero =
    (\(acc, zs) -> if zs > 0 then (0 : acc, zs) else (acc, 0))
        . foldr (\(a, b) (acc, zs) -> if a - b == 0 then (acc, zs + 1) else (a - b : acc, zs)) ([], zero)
        . (zip =<< tail)

-- >>> diff 1 [0, 1]
-- ([0,1],1)

go :: Int -> [Int] -> Int
go _    [0, x] = x
go _    [x]    = x
go zero xs     = go (max 0 (zs - 1)) (sort di) where (di, zs) = diff zero xs

{-

>>> go 0 [1,10,100]
81

>>> go 0 [4,8,9,13]
3

>>> go 0 [0,0,0,8,13]
1

>>> go 0 [2,4,8,16,32,64]
2

-}

main :: IO ()
main = do
    n  <- readLn @Int
    xs <- map (read @Int) . words <$> getLine
    print $ go 0 xs


{-# LANGUAGE BangPatterns #-}

import Control.Applicative

main = do
  [n,d,l] <- map read.words <$> getLine
  putStrLn.unwords.map show $ solve n d l []

solve 2 !d l ans
  | d>0 && d+1<=l = [d+1,1] ++ ans
  | d==0 = 1:1:ans
  | d<0 && 1-d<=l = [1,1-d] ++ ans
  | otherwise = [-1]
solve 3 !d l ans
  | d>0 && d<=2*l-1 = let q = div (d+1) 2 in ans ++ [q,1,q]
  | d==0 && l>=2 = ans ++ [1,2,1]
  | d<0 && 2-d<=l = ans ++ [1,2-d,1]
  | otherwise = [-1]
solve !n d l ans
  | d>0 = solve (n-2) (d-l+1) l $ [l,1] ++ ans
  | d==0 = solve (n-2) 0 l $ 1:1:ans
  | d<0 = solve (n-2) (d+l-1) l $ [1,l] ++ ans
  | otherwise = [-1]

import Monad (liftM)
import Prelude hiding (print)

solve :: [Integer] -> [Integer]
solve [n, d, l]  =  case as of
  Just as  ->  reverse as
  Nothing  ->  [-1]
  where
    as  =  rec l d n
    rec l d 1
      | 1 <= d && d <= l  =  Just [d]
      | otherwise  =  Nothing
    rec l d n
      | even n && d <  0  =  fmap (l:) $ rec l (d+l) (n-1)
      | even n && d >= 0  =  fmap (1:) $ rec l (d+1) (n-1)
      | 2 * d < l + 1     =  fmap (1:) $ rec l (d-1) (n-1)
      | otherwise         =  fmap (l:) $ rec l (d-l) (n-1)

print :: Show a => [a] -> IO ()
print [a]  =  putStrLn (show a)
print (x:xs)  =  putStr (show x ++ " ") >> print xs

main :: IO ()
main  =  liftM (map read . words) getLine >>= print . solve

import Control.Applicative

magic :: [Int] -> Int
magic [x] = x
magic [] = 0
magic (x:y:xs) = (x - y) + magic xs

solve :: Int -> Int -> Int -> Maybe [Int]
solve n d l = add (d - initialSum) initial where
    initial = take n $ repeat 1
    initialSum = magic initial

    add :: Int -> [Int] -> Maybe [Int]
    add 0 xs = Just xs
    add _ [] = Nothing
    add a [x]
        | 1 <= x + a && x + a <= l = Just [x + a]
        | otherwise = Nothing
    add a (x:y:xs)
        | a > 0 = if x + a <= l
            then Just (x+a : y : xs)
            else do
                res <- add (a - (l-x)) xs
                return $ l:y:res
        | a < 0 = if y - a <= l
            then Just (x : y - a : xs)
            else do
                res <- add (a + (l - y)) xs
                return $ x:l:res

main = do
    [n, d, l] <- map read <$> words <$> getLine
    putStrLn $ case solve n d l of
        Nothing -> "-1"
        Just xs -> concatMap ((++" ") . show) xs

module Main where

import Control.Applicative
import Data.List

solve n d l = adjust (sum ls) ls []
  where
    adjust sm [] acc
      | sm == d   = map abs $ reverse acc
      | otherwise = [-1]
    adjust sm (x:xs) acc
      | x < 0 && sm > d = let diff = min (sm-d) (l-1) in
                          adjust (sm-diff) xs (x-diff:acc)
      | x > 0 && sm < d = let diff = min (d-sm) (l-1) in
                          adjust (sm+diff) xs (x+diff:acc)
      | otherwise = adjust sm xs (x:acc)
    ls = take n $ intersperse (-1) (repeat 1)

main = do
  [n,d,l] <- map read . words <$> getLine
  putStrLn $ unwords . map show $ solve n d l

main = do
    str <- getLine
    putStr $ unwords $ map show $ f $ map (\x -> read x :: Int) $ words str

f :: [Int]->[Int]
f [n,d,l]
    | (od * l - ev) < d = [-1]
    | (od - ev * l) > d = [-1]
    | otherwise = f1 n l 1 (d-od+ev)
    where
        od = ((div n 2) + (mod n 2))
        ev = (div n 2)

f1 :: Int->Int->Int->Int->[Int]
f1 n l pos rest
    | pos==n+1 = []
    | rest==0 = 1:(f1 n l (pos+1) 0)
    | oddness==1 = maxv:(f1 n l (pos+1) (rest-maxv+1))
    | oddness==0 = minv:(f1 n l (pos+1) (rest+minv-1))
    where
    oddness = mod pos 2
    maxv = 1 + min (l-1) (max rest 0)
    minv = 1 + min (l-1) (max (-rest) 0)


import Data.Functor ((<$>))

main :: IO ()
main = getLine >> solve <$> (lines <$> getContents) >>= mapM_ putStrLn

solve :: [String] -> [String]
solve xss = [ [ if x == '-' then '-' else "BW" !! ((i + j) `mod` 2) | (j, x) <- zip [0..] xs ] | (i, xs) <- zip [0..] xss ]

import Data.List

main = do
	getLine
	interact $ unlines . putChess . lines

putChess :: [String] -> [String]
putChess ss = zipWith tchess ss $ cycle "BW"

tchess :: String -> Char -> String
tchess [] _ = ""
tchess ('-':xs) 'W' = '-' : (tchess xs 'B')
tchess ('-':xs) 'B' = '-' : (tchess xs 'W')
tchess (_:xs) 'W' = 'W' : (tchess xs 'B')
tchess (_:xs) 'B' = 'B' : (tchess xs 'W')

import Data.Functor ((<$>))
import Data.List (tails)

main :: IO ()
main = getLine >> solve <$> (lines <$> getContents) >>= mapM_ putStrLn

solve :: [String] -> [String]
solve = zipWith (zipWith $ \x y -> if y == '-' then y else x) $ tails (cycle "BW")

import Data.List
main = do
  getLine
  mapM_ putStrLn . zipWith row (tails (cycle "BW")) . lines =<< getContents
row = zipWith cell
cell _ '-' = '-'
cell c  _  =  c

import Data.List

main = do
  getLine
  interact $ unlines.f.lines

f :: [String] -> [String]
f css = zipWith (zipWith g) css . tails $ cycle "BW"

g '-' c = '-'
g _ c = c

import Data.List

main = do
	getLine
	interact $ unlines.f.lines

f :: [String] -> [String]
f x = zipWith (zipWith g ) x   (tails $ cycle "BW")

g '-' x = '-'
g _ x = x

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

place :: Bool -> Char -> Char
place True  '.' = 'B'
place False '.' = 'W'
place _     c   = c

placeRow :: Bool -> String -> String
placeRow b = zipWith place (iterate not b)

main :: IO ()
main = do
	[n,_] <- inputInts
	board <- replicateM n getLine
	mapM_ putStrLn $ zipWith placeRow (iterate not True) board


import Control.Applicative

import qualified Data.ByteString.Char8 as B
import Data.Int

main = do
    B.getLine
    l1 <- B.unpack <$> B.getLine
    l2 <- B.unpack <$> B.getLine
    print $ solve l1 l2

modulo = 1000000007

modBase n = mod n modulo

solve :: String -> String -> Int64
solve l1 l2 = a
    where
        (a,_,_,_) = e l1 l2

len = fromIntegral . length

e :: String -> String -> (Int64,Int64,Int64,Int64)
e [] [] = (0,0,0,1)
e (x:xs) (y:ys) = (a,b,c,d)
    where
        as = assign x y
        (a',b',c',d') = e xs ys
        a = modBase $
            modBase (a' * len (filter (const True) as)) +
            modBase (b' * len (filter (\ (x,y) -> x > y) as)) +
            modBase (c' * len (filter (\ (x,y) -> x < y) as))
        b = modBase $
            modBase (b' * len (filter (\ (x,y) -> x <= y) as)) +
            modBase (d' * len (filter (\ (x,y) -> x <  y) as))
        c = modBase $
            modBase (c' * len (filter (\ (x,y) -> x >= y) as)) +
            modBase (d' * len (filter (\ (x,y) -> x >  y) as))
        d = modBase (d' * len (filter (\ (x,y) -> x == y) as))

assign :: Char -> Char -> [(Char,Char)]
assign '?' '?' = [ (a,b) | a <- ['0'..'9'],b <- ['0'..'9']]
assign '?' c   = [ (a,c) | a <- ['0'..'9']]
assign  c  '?' = [ (c,b) | b <- ['0'..'9']]
assign  c  d   = [ (c,d)]

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

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

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

toPairs (x:y:xys) = (x,y) : toPairs xys
toPairs _ = []

main :: IO ()
main = do
  [_,xs,ys] <- B.words <$> B.getContents
  let cnt = B.count '?' xs + B.count '?' ys
  print . (`mod`1000000007) $ 10^cnt - (solveLTEQ xs ys + solveGTEQ xs ys - solveEQ xs ys)

solveLTEQ :: B.ByteString -> B.ByteString -> Integer
solveLTEQ xs ys = go 1 xs ys
   where
     go !res xs0 ys0 | B.null xs0 && B.null ys0 = res
     go !res xs0 ys0
       | x=='?' = if y=='?' then go (res *% 55) xs ys else go (res *% (read[y]+1)) xs ys
       | y=='?' = go (res *% (10-read[x])) xs ys
       | x <= y = go res xs ys
       | otherwise = 0
      where
        Just (x,xs) = B.uncons xs0
        Just (y,ys) = B.uncons ys0

solveEQ :: B.ByteString -> B.ByteString -> Integer
solveEQ xs ys = go 1 xs ys
   where
     go !res xs0 ys0 | B.null xs0 && B.null ys0 = res
     go !res xs0 ys0
       | x=='?' = if y=='?' then go (res *% 10) xs ys else go res xs ys
       | y=='?' || x==y = go res xs ys
       | otherwise = 0
      where
        Just (x,xs) = B.uncons xs0
        Just (y,ys) = B.uncons ys0

solveGTEQ :: B.ByteString -> B.ByteString -> Integer
solveGTEQ xs ys = go 1 xs ys
   where
     go !res xs0 ys0 | B.null xs0 && B.null ys0 = res
     go !res xs0 ys0
       | x=='?' = if y=='?' then go (res *% 55) xs ys else go (res *% (10-read[y])) xs ys
       | y=='?' = go (res *% (read[x]+1)) xs ys
       | x >= y = go res xs ys
       | otherwise = 0
      where
        Just (x,xs) = B.uncons xs0
        Just (y,ys) = B.uncons ys0

infixl 7  *%
(*%) :: Integer -> Integer -> Integer
x *% y = x * y `rem` 1000000007
{-# INLINE (*%) #-}

import Control.Applicative

import qualified Data.ByteString.Char8 as B
import Data.Int
import qualified Data.Array as A

main = do
    getLine
    l1 <- getLine
    l2 <- getLine
    print $ solve l1 l2

modulo = 1000000007

modBase n = mod n modulo

solve :: String -> String -> Int64
solve l1 l2 = a
    where
        (a,_,_,_) = e l1 l2

e :: String -> String -> (Int64,Int64,Int64,Int64)
e [] [] = (0,0,0,1)
e (x:xs) (y:ys) = (modBase a,modBase b,modBase c,modBase d)
    where
        as = assign x y
        (a',b',c',d') = e xs ys
        a = a' * ptns A.! (x',y',0) + b' * ptns A.! (x',y',1)+ c' * ptns A.! (x',y',2)
        b = b' * ptns A.! (x',y',3) + d' * ptns A.! (x',y',2)
        c = c' * ptns A.! (x',y',4) + d' * ptns A.! (x',y',1)
        d = d' * ptns A.! (x',y',5)
        f op = fromIntegral $ length $ filter (uncurry op) as
        t x y = True
        x' = conv x
        y' = conv y
digit = ['0'..'9']
assign :: Char -> Char -> [(Char,Char)]
assign '?' '?' = [ (a,b) | a <- digit,b <- digit]
assign '?' c   = [ (a,c) | a <- digit]
assign  c  '?' = [ (c,b) | b <- digit]
assign  c  d   = [ (c,d) ]

conv '?' = ':'
conv c   = c

convI ':' = '?'
convI c    = c

ptns :: A.Array (Char,Char,Int) Int64
ptns = A.listArray (('0','0',0),(':',':',5)) [ f c1 c2 i | c1 <- ['0'..':'], c2 <- ['0'..':'], i <- [0..5]]
    where
        f c1 c2 i = case i of
            0 -> fromIntegral $ length $ filter (const True) as
            1 -> fromIntegral $ length $ filter (uncurry (>)) as
            2 -> fromIntegral $ length $ filter (uncurry (<)) as
            3 -> fromIntegral $ length $ filter (uncurry (<=)) as
            4 -> fromIntegral $ length $ filter (uncurry (>=)) as
            5 -> fromIntegral $ length $ filter (uncurry (==)) as
            where
                as = assign (convI c1) (convI c2)

import Control.Applicative
import Control.Arrow
import Data.List

main = do
    n <- read <$> getLine
    let m = if even n then n `div` 2 else n `div` 2 + 1
    b <- (words >>> sort >>> group >>> map ((<=m).length) >>> and ) <$> getLine
    let s = (if b then "YES" else "NO")
    putStrLn s


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

solve n =
  aux [1..n]
  where aux [] = []
        aux (a:[]) = [a]
        aux (a:as) = a : last as : aux (init as)

main = do
  n <- read `fmap` getLine :: IO Int
  putStrLn $ intercalate " " $ map show $ solve n

main = do getLine >>= putStrLn . unwords . map show . gao . read where
	gao n = [if odd i then 1 + div i 2 else n - div i 2 | i <- [0 .. n - 1]]

main = readLn >>= putStrLn.unwords.map show.solve

solve :: Int -> [Int]
solve n = sortFrog 0 [1..n]

sortFrog _ [] = []
sortFrog 0 xs = head xs : sortFrog 1 (tail xs)
sortFrog 1 xs = last xs : sortFrog 0 (init xs)

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

solve n =
  aux [1..n]
  where aux [] = []
        aux (a:[]) = [a]
        aux (a:as) = a : last as : init as

main = do
  n <- read `fmap` getLine :: IO Int
  putStrLn $ intercalate " " $ map show $ solve n

import List
main = do getLine >>= putStrLn . unwords . map show . gao . read where
	gao n = let (o, e) = partition odd [1 .. n] in o ++ reverse e


module Main where

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

main = do
  n <- liftM read getLine :: IO Int

  cards <- replicateM n $ do
    [a, b] <- liftM ( map read . words ) getLine
    return (a, b)

  let
    (counter, score, pendings) =
      foldl
        ( \(counter, score, pendings) (a, b) ->
          if b == 0
            then (counter, score, a:pendings)
            else (counter+b-1, score+a, pendings) )
        (1, 0, [])
        cards

    ans = score + ( sum $ take counter $ sortBy (comparing (0-)) pendings )

  putStrLn $ show ans

import Data.List

parse :: [String] -> [[Int]]
parse stuff = map parseL stuff
    where parseL line = reverse $ map read (words line)

solve cards = subsolve 0 1 (reverse $ sort cards)
    where subsolve acc 0 _ = acc
          subsolve acc _ [] = acc
          subsolve acc cnt ([b,a]:xs) = subsolve (acc + a) (cnt + b - 1) xs

main = do
  n <- getLine
  cards <- sequence [getLine | _ <- [1.. (read n)]]
  print . solve . parse $ cards

import Control.Monad
import Data.List
solve xs =  s' + s''
      where s' = sum $ map fst xs'
            k = (sum $ map snd xs') - length xs' + 1
            xs' = [x | x <- xs , snd x > 0]
            s'' =sum $ map fst $ take k $ (reverse . sortBy (\a b -> compare (fst a) (fst b)))  (xs \\ xs')
tuplify2 :: [a] -> (a,a)
tuplify2 [x,y] = (x,y)
main=do
        n <- fmap read $ getLine
        xs <-  forM [1..n] (\_ -> getLine >>= (return . tuplify2 . map (read::String->Int) . words))
        print $ solve xs

import List (partition, sortBy)

{-
import HUnit

testOneCard :: Test
testOneCard  =  Test "TestOneCard" $
    assertEq 2 (solve [(2,0)])

testAllCardsZero :: Test
testAllCardsZero  =  Test "TestAllCardsZero" $
    assertEq 3 (solve [(1,0),(3,0),(2,0)])

testInput :: Test
testInput  =  TestList "TestInput"
    [Test "1" $ assertEq 2 (solve [(2,0),(1,0)]),
     Test "2" $ assertEq 3 (solve [(2,0),(1,0),(0,2)])]

test :: IO ()
test  =  mapM_ run
    [testOneCard,
     testAllCardsZero,
     testInput]

--------------------------------------------------------------------------------
-}

type Card  =  (Int, Int)

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

readCard :: IO Card
readCard  =  do
    [a, b]  <-  Main.reads
    return (a, b)

solve :: [Card] -> Int
solve cards  =  sum (map fst notZero)
  + sum (map fst (take (sum (map snd notZero) + 1 - length notZero) zero'))
  where
    (zero, notZero)  =  partition ((== 0) . snd) cards
    zero'  =  reverse (sortBy (\c1 c2 -> compare (fst c1) (fst c2)) zero)

main :: IO ()
main  =  do
    [n]  <-  Main.reads
    cards  <-  mapM (const readCard) [1..n]
    print $ solve cards

import Data.List
type Card = (Integer, Integer)
readCard :: String -> Card
readCard str = ((read suf)::Integer, (read pre)::Integer)
    where (pre, suf) = break (== ' ') str
calc :: [Card] -> Integer
calc xs = sum $map snd $ pre ++ suf'
    where xs' =  reverse . sort $ xs
          (pre, suf) = break ((== 0).fst) xs'
          t = 1 + sum (map fst pre) -  genericLength pre
          suf' = take (fromIntegral t) suf

main = interact $ show . calc . map readCard . tail . lines

import IO
import Data.List
import Debug.Trace

swap (x, y) = (y, x)

getInteger :: IO Int
getInteger = do
    line <- getLine
    return (read line)

getIntegers :: IO [Int]
getIntegers = do
    line <- getLine
    return (map read (words line))

readNumbers :: Int -> IO [(Int, Int)]
readNumbers 0 = return ([])
readNumbers count = do
    --putTraceMsg ("count = " ++ (show count))
    [first, second] <- getIntegers
    --putTraceMsg ("first = " ++ (show first) ++ ", second = " ++ (show second))
    numbers <- (readNumbers $ count - 1)
    return ([(first, second)] ++ numbers)

runAux :: [(Int, Int)] -> Int -> Int
runAux [] stack = 0
runAux (x:xs) stack =
    if stack == 0 then 0
    else fst x + runAux xs (stack - 1 + snd x)

run :: [(Int, Int)] -> Int
run x = runAux sorted 1
    where secondLess = (\a b -> if swap a > swap b  then LT else GT)
          sorted = sortBy secondLess x

main = do
    n <- getInteger
    --putTraceMsg ("N = " ++ show n)
    numbers <- (readNumbers n)
    let result = run numbers
    putStrLn $ show result

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

solve :: [(Int, Int)] -> Int -> Int
solve []          _ = 0
solve _           0 = 0
solve ((a, b):xs) n = a + (solve xs $ n - 1 + b)

main = do
  n <- read <$> getLine
  a <- forM [1..n] $ \x ->
    map read <$> (words <$> getLine)
  let arr = map (\(x, y) -> (-y, -x)) $ sort $ map (\[x,y] -> (-y, -x)) a
  print $ solve arr 1

import Data.List
import Control.Applicative

main = do _ <- getLine
          xys <- map ((\[x,y] -> (y,x)) . map read . words) . lines <$> getContents
          print $ solve xys

solve :: [(Int,Int)] -> Int
solve xys = fst $ foldl' f (0,1) $ sortBy (flip compare) xys

f :: (Int,Int) -> (Int,Int) -> (Int,Int)
f (p,r) (b,a)
  | r == 0    = (p,0)
  | otherwise = (p+a,r+b-1)

import Control.Applicative
import Data.List

getCard :: Int -> IO [(Int, Int)]
getCard 0 = return []
getCard n = do
  (a:b:_) <- map read <$> (words <$> getLine)
  cards <- getCard $ n - 1
  return $ (-b, -a): cards

solve :: [(Int, Int)] -> Int -> Int
solve [] _ = 0
solve _ 0 = 0
solve (c:cs) n = -(snd c) + solve cs (n - (fst c) - 1)

main = do
  n <- read <$> getLine
  xs <- getCard n
  print $ solve (sort xs) 1

import Data.List

main:: IO ()
main = do cs <- getContents
          (putStr .show .solve .parse) cs

parse_step::String->(Int,Int)
parse_step s = (x,y)
               where [x,y] = map (\x -> read x::Int) (words s)

parse::String->[(Int,Int)]
parse s = foldr (\x y->(parse_step x):y ) [] ss
           where ss = (tail .lines) s

splitf :: (a->Bool)-> [a]->([a],[a])
splitf f l = foldr (\x (tr,fa)->if (f x)
                                then ((x:tr),fa)
                                else (tr,x:fa)) ([],[]) l

hasB :: (Int,Int) -> Bool
hasB (_,b) = (b /= 0)

plus_cards::[(Int,Int)]->(Int,Int)
plus_cards = foldl (\(xa,ya) (xb,yb)->(xa+xb,ya+yb)) (0,0)

cardcomp::(Int,Int)->(Int,Int)->Ordering
cardcomp (x1,_) (x2,_) = compare x2 x1

solve::[(Int,Int)] -> Int
solve l =  totalA + totalB
           where
             (bcard,acard) = splitf hasB l
             (totalB,k)    = plus_cards bcard
             (totalA,_)    = plus_cards (take (k+1-(length bcard)) (sortBy cardcomp acard))

import Data.List

main = do
	nS <- getLine
	let n = read nS :: Int
	strs <- getNLines n []
	let css = (map (\(a:b:_) -> (read a, read b)) $ map words strs) :: [(Int,Int)]
	putStrLn.show $ solve css

getNLines 0 acc = return (reverse acc)
getNLines n acc = do
	x <- getLine
	getNLines (n-1) (x:acc)

solve css = sl' (sBysnd css) 1 0

sl' :: [(Int, Int)] -> Int -> Int -> Int
sl' (c:cs) 0 acc = acc
sl' [] n acc = acc
sl' (c:cs) n acc
	| (snd c == 0) = (acc + (sum $ take (n) $ map fst (reverse $ sort (c:cs))))
	| otherwise = sl' cs ((snd c) + n - 1) (acc + (fst c))

sBysnd (a:as) = sortBy (\x y -> compare (snd y) (snd x)) (a:as)

import Data.List

main:: IO ()
main = do cs <- getContents
          (putStr .show .solve .parse) cs

parse_step::String->(Int,Int)
parse_step s = (x,y)
               where [x,y] = map (\x -> read x::Int) (words s)

parse::String->[(Int,Int)]
parse s = foldr (\x y->(parse_step x):y ) [] ss
           where ss = (tail .lines) s

splitf :: (a->Bool)-> [a]->([a],[a])
splitf f l = foldr (\x (tr,fa)->if (f x)
                                then ((x:tr),fa)
                                else (tr,x:fa)) ([],[]) l

hasB :: (Int,Int) -> Bool
hasB (_,b) = (b /= 0)

plus_cards::[(Int,Int)]->(Int,Int)
plus_cards = foldl (\(xa,ya) (xb,yb)->(xa+xb,ya+yb)) (0,0)

cardcomp::(Int,Int)->(Int,Int)->Ordering
cardcomp (x1,_) (x2,_) = compare x2 x1

solve::[(Int,Int)] -> Int
solve l =  totalA + totalB
           where
             (bcard,acard) = splitf hasB l
             (totalB,k)    = plus_cards bcard
             (totalA,_)    = plus_cards (take (k+1) (sortBy cardcomp acard))


{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List (group, sort)
import Data.Map ((!))
import qualified Data.Map as M
-- import Debug.Trace

import Data.Maybe (fromJust)
import System.IO
import Text.Read

getNums :: IO [Int]
getNums = do
  line <- B.getLine
  return $ map ((fst . fromJust) . B.readInt) . B.split ' ' $ line

main :: IO ()
main = do
  t <- readLn :: IO Integer
  forM_ [1 .. t] handleCase

handleCase :: Integer -> IO ()
handleCase c = do
  [n, k] <- getNums
  putStrLn $ unwords $ map show $ solve n k

solveEasy :: Int -> [Int]
solveEasy n
  | n `mod` 2 == 1 = [1, (n - 1) `div` 2, (n -1) `div` 2]
  | n `mod` 4 == 0 = [n `div` 2, n `div` 4, n `div` 4]
  | n `mod` 4 == 2 = [2, (n - 1) `div` 2, (n -1) `div` 2]

solve n k = replicate (k - 3) 1 ++ solveEasy (n - (k - 3))

import Control.Monad
import Data.List
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapS

main = do
    t <- readLn
    replicateM_ t testcase

testcase :: IO ()
testcase = do
    firstLine <- getLine
    let [n,k] = map read . words $ firstLine
    putStrLn $ solve n k

solve :: Int -> Int -> String
solve n k = unwords . map show $ sol
    where
        sol = solve3 (n-k+3) ++ replicate (k-3) 1

solve3 :: Int -> [Int]
solve3 n
    | odd n =  [1, (n-1) `div` 2, (n-1) `div` 2]
    | n `mod` 4 == 0 =  [n `div` 2 , n `div` 4, n `div` 4]
    | otherwise = [2, (n-2) `div` 2, (n-2) `div` 2]

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

solve :: Int -> [Int]
solve n
  | odd n = 1 : replicate 2 (div n 2)
  | mod n 4 == 0 = div n 2 : replicate 2 (div n 4)
  | otherwise = 2 : replicate 2 (div n 2 - 1)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    putInts $ solve (n - (k - 3)) ++ replicate (k - 3) 1

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

import Control.Monad
import Data.List
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapS

main = do
    t <- readLn
    replicateM_ t testcase

testcase :: IO ()
testcase = do
    firstLine <- getLine
    let [n,k] = map read . words $ firstLine
    putStrLn $ solve n k

solve :: Int -> Int -> String
solve n k = unwords . map show $ sol
    where
        sol = solve3 n ++ replicate (k-3) 1

solve3 :: Int -> [Int]
solve3 n
    | odd n =  [1, (n-1) `div` 2, (n-1) `div` 2]
    | n `mod` 4 == 0 =  [n `div` 2 , n `div` 4, n `div` 4]
    | otherwise = [2, (n-2) `div` 2, (n-2) `div` 2]


import Data.Maybe
import Data.List
import Data.Function

doit :: Int -> [(Int, Int)] -> Maybe [(Int, Int)]
doit n lst = let sz = length lst
                 k  = n - (snd . head $ lst)
             in if sz `mod` k == 0 then Just $ doit' 0 0 k lst else Nothing

doit' :: Int -> Int -> Int -> [(Int, Int)] -> [(Int, Int)]
doit' _ _ _ [] = []
doit' cur n ma (x:xs)
  | n == ma = doit' (cur + 1) 0 ma (x:xs)
  | otherwise = (fst x, cur) : doit' cur (n + 1) ma xs

summarize :: [Maybe [(Int, Int)]] -> Maybe [Int]
summarize lst
  | any isNothing lst = Nothing
  | otherwise = Just . map snd . sortBy (compare `on` fst) . concat . map fst . scanl f ([], 1) $ lst

f :: ([(Int, Int)], Int) -> Maybe [(Int, Int)] -> ([(Int, Int)], Int)
f (_, start) (Just lst) = (map (\(a, b) -> (a, b + start)) lst, start + maximum (map snd lst) + 1)

main = do
  n <- readLn
  l <- fmap (summarize . map (doit n) . groupBy ((==) `on` snd) . sortBy (compare `on` snd) . zip [0..] . map read . words) getLine
  putStrLn $ case l of
    Nothing -> "Impossible"
    Just x -> "Possible\n" ++ (unwords . map show $ x)

import Data.List

f::Int->Int->Int->Int->Int->[(Int,Int)]->[(Int,Int)]
f _ _ _ _ _ []=[]
f c n _ a _ _
    |a<n || a<c =[]
f c n 0 a o ((x,y):xs)=f c (n+1) x a x ((x,y):xs)
f c n d a o ((x,y):xs)
       |o/=x=[]
       |otherwise=(y,n):(f (c+1) n (d-1) a o xs)

f2::Int->Int->Int->[Int]->[Int]->Bool
f2 _ _ _ [] _=True
f2 _ 0 _ _ []=True
f2 n c c3 xs []=f2 n c c3 xs [(-1)]
f2 n 0 c3 (x:xs) (c2:ys)=f2 n c2 c2 (x:xs) ys
f2 n c c3 (x:xs) (c2:ys)
     |x+c3/=n=False
     |otherwise=f2 n (c-1) c3 xs (c2:ys)

main = do
       e<-getLine
       es<-getLine
       let n=read e::Int
           xs=map read (words es)::[Int]
           ys=map (n - ) xs
           zs=sort $ zip ys [(1::Int)..(n::Int)]
           ans=sort (f 0 0 0 n 0 zs)
           ans2=(map snd ans)
           t1=group $ sort ans2
           t2=map length t1
--       print t2
--       print (reverse (sort xs))
       putStrLn $ if length(ans)==n && f2 n (head t2) (head t2) (reverse (sort xs)) (tail t2)
                      then "Possible\n"++(unwords ( map show ( ans2)))
                      else "Impossible"

import Data.List

f ::Int->Int->Int->Int->[Int]->[Int]
f _ _ _ _ []=[]
f n _ a _ _
   |n>a=[]
f n 0 a _ (x:xs)=f (n+1) (a-x) a x (x:xs)
f n d a o (x:xs)
     |o/=x=[]
     |otherwise=n:f n (d-1) a o xs

main =do
      e<-getLine
      es<-getLine
      let x=read e::Int
      let xs=map read (words es)::[Int]
          ys=sort xs
          ans=f 0 0 x 0 ys
      putStrLn $ if (length ans)==x then "Possible\n"++(unwords (map show ans)) else "Impossible"

import Data.List

f::Int->Int->Int->Int->Int->[(Int,Int)]->[(Int,Int)]
f _ _ _ _ _ []=[]
f c n _ a _ _
    |a<n || a<c =[]
f c n 0 a o ((x,y):xs)=f c (n+1) x a x ((x,y):xs)
f c n d a o ((x,y):xs)
       |o/=x=[]
       |otherwise=(y,n):(f (c+1) n (d-1) a o xs)

f2::Int->Int->[Int]->[Int]->Bool
f2 _ _ [] _=True
f2 _ _ _ []=True
f2 n 0 (x:xs) (c2:ys)=f2 n c2 (x:xs) ys
f2 n c (x:xs) (c2:ys)
     |x+c2/=n=False
     |otherwise=f2 n (c-1) xs (c2:ys)

main = do
       e<-getLine
       es<-getLine
       let n=read e::Int
           xs=map read (words es)::[Int]
           ys=map (n - ) xs
           zs=sort $ zip ys [(1::Int)..(n::Int)]
           ans=sort (f 0 0 0 n 0 zs)
           ans2=(map snd ans)
           t1=group $ sort ans2
           t2=map length t1
       putStrLn $ if length(ans)==n &&  f2 n (head t2) (reverse (sort xs)) t2
                      then "Possible\n"++(unwords ( map show ( ans2)))
                      else "Impossible"


{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (forM, liftM)
import Control.Monad.ST
import Data.Array.ST
import Debug.Trace (trace)
import qualified Data.ByteString.Lazy.Char8 as BS

data Query = Set Int Int
           | Add Int
           | Get Int
           deriving (Show)

type Values s      = STArray s Int (Int, Int)
type PartialSums s = STArray s Int Int

readInt :: BS.ByteString -> Int
readInt s = case BS.readInt s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Int"

parseQueries :: [Int] -> [Query]
parseQueries [] = []
parseQueries (1:v:x:qs) = (Set v x) : (parseQueries qs)
parseQueries (2:y:qs)   = (Add y)   : (parseQueries qs)
parseQueries (3:q:qs)   = (Get q)   : (parseQueries qs)

solve :: Int -> Int -> [Int] -> [Query] -> [Int]
solve n m vs qs = runST $ do
  values <- newListArray (1, n) (zip vs [0, 0 ..]) :: ST s (Values s)
  sums   <- newArray (0, m) 0 :: ST s (PartialSums s)
  result <- forM (zip qs [1 .. m]) $ \(query, timestamp) -> do
    cur <- readArray sums (timestamp - 1)
    writeArray sums timestamp cur
    case query of
      Set v x -> writeArray values v (x, timestamp) >> return (-1)
      Add y   -> writeArray sums timestamp (cur + y) >> return (-1)
      Get q   -> do (x, time) <- readArray values q
                    prev      <- readArray sums time
                    return (x + cur - prev)
  return $ filter (>= 0) result

main = do
  (n:m:cs) <- liftM (map readInt . BS.words) BS.getContents
  let (values, qs) = splitAt n cs
      queries      = parseQueries qs
  let result = solve n m values queries
  mapM_ print result

import Control.Monad (liftM, mapM_)
import Data.Array.IO
import Data.Array.MArray
import Data.Array.ST
import Data.Array.Unboxed
import Prelude hiding (read, reads)

read :: String -> Int
read ('-':s)  =  (-1) * read s
read s  =  read' 0 s
  where
    read' a ""  =  a
    read' a (c:s)  =  read' a' s
      where
        a'  =  10*a + fromEnum c - fromEnum '0'

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

solve :: Int -> [Int] -> [Int] -> IO ()
solve n xs ys  =  do
    array  <-  newArray_ (1, n)
    sequence_ [writeArray array i a | (i, a) <- zip [1..] xs]
    solve' array 0 ys
  where
    solve' :: IOUArray Int Int -> Int -> [Int] -> IO ()
    solve' _ _ []  =  return ()
    solve' array acc (1 : i : a : ys)  =  do
        writeArray array i (a - acc)
        solve' array acc ys
    solve' array acc (2 : s : ys)  =  do
        solve' array (acc + s) ys
    solve' array acc (3 : i : ys)  =  do
        a  <-  readArray array i
        print (acc + a)
        solve' array acc ys

main :: IO ()
main  =  do
    ints  <-  reads
    let [n, m]  =  take 2 ints
    let xs  =  take n $ drop 2 ints
    let ys  =  drop (n + 2) ints
    solve n xs ys


import Control.Monad
main = do
  n <- fmap read getLine
  forM [1..n]
    (\_ -> do
        [a,b] <- fmap (map read.words) getLine
        print $ calc a b)
calc :: Int -> Int -> Int
calc a b = 1 + div ((abs $ a-b)-1) 10

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
module Main (main) where
import System.IO
import Data.Ord
import Data.Int
import Data.Bits
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict (StateT)
import qualified Control.Monad.Trans.State.Strict as StateT
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C

getNewLine :: SIO ByteString
getNewLine = (lift $ C.hGetLine stdin) >>= (\z -> let x = C.dropWhile isSpace z in if C.null x then getNewLine else return x)

getRemain :: ByteString -> SIO ByteString
getRemain b = let bns = C.dropWhile isSpace b in
                if C.null bns then getNewLine >>= liftM2 (>>=) StateT.put (const . return)
                else return bns

data HInt
data HInt64
data HNormal
data HString
data HList

type SIO a = StateT ByteString IO a

class IOInteract a where
    convert :: ByteString -> (a, ByteString)
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convert = convertp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType Int = HInt
    IOType Int64 = HInt64
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertp :: flag -> ByteString -> (a, ByteString)
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertp _ x = let (a, b) = C.break isSpace x in (read $ C.unpack a, b)
    toShowSp _ x = shows x

instance IOInteractp HInt Int where
    convertp _ x = fromMaybe (error "parse") $ C.readInt x
    toShowSp _ x = shows x

instance IOInteractp HInt64 Int64 where
    convertp _ x = let (a, b) = fromMaybe (error "parse") $ C.readInteger x in (fromIntegral a, b)
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertp _ x = let (a, b) = C.break isSpace x in (C.unpack a, b)
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertp _ x = let (a, b) = convert x in ([a], b)
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => SIO a
get = uncurry (flip (liftM2 seq . StateT.put) . return) =<< fmap convert . getRemain =<< StateT.get
put :: IOInteract a => a -> SIO ()
put = lift . (hPutStr stdout) . toShow
putln :: IOInteract a => a -> SIO ()
putln = lift . (hPutStrLn stdout) . toShow
flush :: SIO ()
flush = lift (hFlush stdout)

main :: IO ()
main = StateT.evalStateT main_ C.empty

main_ :: SIO ()
-------------------------------------------- template ------------------------------------------------------
-- for io performance comparison from @Russell_Emerine's code
main_ = do
  t <- get
  replicateM_ t f1

f1 :: SIO ()
f1 = do
  (a, b) <- liftM2 (,) get get
  putln $ f2 a b

f2 :: Int64 -> Int64 -> Int64
f2 a b = (div (abs (a - b) + 9) 10)

import Control.Monad ( replicateM_ )

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [a, b] <- map read . words <$> getLine
    let  x = abs (a - b) :: Integer
    print $ div (x+9) 10

import Control.Monad

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [a, b] <- map read . words <$> getLine
    putStrLn $ show $ div (abs (a - b) + 9) 10

import Control.Monad

getInt :: IO Int
getInt = readLn

getFloat :: IO Float
getFloat = readLn

getDouble :: IO Double
getDouble = readLn

countMoves :: Int -> Int -> Int
countMoves n1 n2 =
  case abs (n1 - n2) of
    0 -> 0
    n -> if n `mod` 10 == 0 then n `div` 10 else n `div` 10 + 1

main :: IO ()
main = do
  n <- getInt
  replicateM_ n $ do
    n1 : n2 : _ <- map (read :: String -> Int) . words <$> getLine
    print $ countMoves n1 n2


module Main where
import Control.Monad

solve::Int->Int->Int->Int->Int
solve a b c d = do
    if (a * d == b * c)
        then 0
    else if (a * c == 0)
        then 1
    else if (rem (a * d) (b * c) == 0)
        then 1
    else if (rem (b * c) (a * d) == 0)
        then 1
    else 2

main = do
  line<-getLine
  let nTerm=read line::Int
  replicateM_ nTerm$do
    line<-getLine
    let (a:b:c:d:_)=map read (words line)::[Int]
    --line<-getLine
    --let nlist=map read (words line)::[Int]
    print (solve a b c d)

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [a,b,c,d] <- ri
        return ((a,b),(c,d))
    mapM_ (putStrLn.show.solve) tcs

solve ((aa,bb),(cc,dd)) = cntNum
  where
    gAB = gcd aa bb
    gCD = gcd cc dd
    (a,b) = (aa `div` gAB,  bb `div` gAB)
    (c,d) = (cc `div` gCD,  dd `div` gCD)
    ad = a*d
    bc = b*c
    lcmN = lcm ad bc
    cntNum = length . filter (/=lcmN) $ [ad,bc]


main = interact $ concat . map (solveList . map readI . words) . tail . lines

solveList [n, k] = showL (filter isGood [1..n])
  where
    isGood num
        | num == k  = False
        | num < (k+1) `div` 2  = False
        | otherwise  = True

readI s = read s :: Int

showL xs = show (length xs) ++ "\n" ++ (unwords . map show) xs ++ "\n"

module Main where

import Control.Monad

main :: IO ()
main = do
    n <- ((read :: String -> Int) <$> getLine)
    replicateM_ n action

action = do
    [n, k] <- (map (read :: String -> Int) . words) <$> getLine
    print $ (k `div` 2) + max 0 (n - k)
    putStr $ concatMap (\x -> show x ++ " ") $ mkFst k
    putStrLn $ concatMap (\x -> show x ++ " ") [k+1..n]

mkFst x
    | odd x = [(x+1) `div` 2..(x-1)]
    | even x = [x `div` 2..(x-1)]

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n, k] <- getInts
    let xs = filter (/=k) [(k+1)`quot`2..n]
    C.putStrLn $ C.pack $ show $ length xs
    C.putStrLn $ C.pack $ unwords $ map show xs


{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k] <- map read . words <$> getLine
  [l1, r1] <- map read . words <$> getLine
  [l2, r2] <- map read . words <$> getLine
  if r1 >= l2 && r2 >= l1
    then do
      let i = minimum [r1 - l1, r2 - l2, r1 - l2, r2 - l1]
      let u = maximum [r1 - l1, r2 - l2, r1 - l2, r2 - l1]
      if i * n >= k
        then print 0
        else do
          let k' = k - i * n
          let d = u - i
          if n * d >= k'
            then print k'
            else print $ n * d + 2 * (k' - n * d)
    else do
      let i = max (l1 - r2) (l2 - r1)
      let u = max (r2 - l1) (r1 - l2)
      if u >= k
        then print $ i + k
        else
          if u * n >= k
            then print $ (u + i) * (k `div` u) + min (2 * (k `mod` u)) (i + k `mod` u)
            else print $ (u + i) * n + 2 * (k - u * n)

solveCase :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer
  -> Integer
solveCase n k x1 y1 x2 y2
  | x1 > x2   = solveCase n k x2 y2 x1 y1 -- canonicalize
  | x2 <= y1  = let  -- overlap
    existingOverlap = n * (min y1 y2 - x2)
    attainableOverlap = n * (max y1 y2 - x1)
    in  if  k <= attainableOverlap
        then  max 0 $ k - existingOverlap
        else  2*k - existingOverlap - attainableOverlap
  | otherwise  = let
    value = y2 - x1
    separation = x2 - y1
    cost = value + separation
    in
      case  divMod k value  of
        (0, _)  -> k + x2 - y1
        (q, r)
          | q < n      -> q * cost + min (2*r) (separation + r)
          | otherwise  -> n * cost + 2 * (k - n * value)

soln :: [Integer] -> [Integer]
soln (n : k : x1 : y1 : x2 : y2 : excess)
  = solveCase n k x1 y1 x2 y2 : soln excess
soln _ = []

main :: IO ()
main = interact (unlines . map show . soln . map read . tail . words)

solveCase :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer
  -> Integer
solveCase n k x1 y1 x2 y2
  | x1 > x2   = solveCase n k x2 y2 x1 y1 -- canonicalize
  | x2 <= y1  = let  -- overlap
    existingOverlap = n * (min y1 y2 - x2)
    attainableOverlap = n * (max y1 y2 - x1)
    in  if  k <= attainableOverlap
        then  max 0 $ k - existingOverlap
        else  2*k - existingOverlap - attainableOverlap
  | otherwise  = let
    value = y2 - x1
    separation = x2 - y1
    cost = value + separation
    in
      case  divMod k value  of
        (0, _)  -> k + x2 - y1
        (q, r)
          | q < n      -> q * cost + min (2*r) (separation + r)
          | otherwise  -> q * cost + 2 * (k - n * value)

soln :: [Integer] -> [Integer]
soln (n : k : x1 : y1 : x2 : y2 : excess)
  = solveCase n k x1 y1 x2 y2 : soln excess
soln _ = []

main :: IO ()
main = interact (unlines . map show . soln . map read . tail . words)


d 0 k=[[]]
d n k=do{f<-[0..k];o<-d(n-1)$k-f;[f:o]}
b d(s,l)|d+l*10>10.5=[]|1>0=[(s,d/10+l)]
s([n,k,a]:t)=fmap(g(read a)0 0).sequence.($map(\[s,l]->(read s,read l/100))t).zipWith b=<<d(read n)(read k)
g e s p []|p>0=1|1>0=e/(e+s)
g e s p ((q,l):t)=l*g e s(p+1)t+(1-l)*g e(s+q)(p-1)t
main=interact$show.maximum.s.map words.lines

module Main where

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

main = do
    [n, k, a] <- ( map read . words ) `liftM` getLine

    senators <- replicateM n $ do
        [level, loyalty] <- ( map read . words ) `liftM` getLine :: IO [Int]
        return (level, loyalty)

    let vote = voteDist n
        candy = candyDist n k

    --putStrLn $ show $ candy
    --putStrLn $ show $ vote

    let prob = foldl' (\best cdist ->
                let senators' = zipWith (\(level, loyalty) c -> (level, fromIntegral (min (loyalty + 10 * c) 100) / 100)) senators cdist
                    winProb = foldl' (\prevProb vdist ->
                        let winCount = length $ filter (==True) vdist
                            prob = product $ zipWith (\(level, loyalty) v -> if v then loyalty else 1 - loyalty) senators' vdist
                            b = sum $ zipWith (\(level, loyalty) v -> if v then 0 else level) senators' vdist
                            winProb = if winCount > n `div` 2
                                then 1
                                else (fromIntegral a :: Double) / (fromIntegral (a + b) :: Double)
                        in if prob > 0 then prevProb + prob * winProb else prevProb
                        ) 0 vote
                in max winProb best
            ) 0 candy

    printf "%.10f\n" prob

candyDist :: Int -> Int -> [[Int]]
candyDist 0 0 = [[]]
candyDist 0 _ = []
candyDist n k = [0..k] >>= \k' -> map (k':) $ candyDist (n-1) (k-k')

voteDist :: Int -> [[Bool]]
voteDist 0 = [[]]
voteDist n = [True, False] >>= \v -> map (v:) $ voteDist (n-1)

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Ord
import Control.Applicative
import Control.Monad
import qualified Data.Map as Map
import Data.Map(Map)
import Data.List
import Control.Arrow
import Data.Maybe

parseSenator :: [String] -> (Double, Integer)
parseSenator [str, loyalty] = (read str, read loyalty `div` 10)

distr 0 k = return []
distr n k = do
  first <- [0..k]
  others <- distr (n-1) (k-first)
  return (first : others)

bribe d (s, l)
  | newL > 10 = Nothing
  | otherwise = Just (s, newL)
                where
                  newL = d+l

main = do
  [n, k, a] <- map read . words <$> getLine
  senators <- sequence $ genericReplicate n $ parseSenator . words <$> getLine
  let distributions = distr (n+1) k -- +1 to account for "keep candy" scenario
      fight s = fromIntegral a / (fromIntegral a + s)
      s l = go l 0 0
        where
          go [] s p | p > 0 = 1
           | otherwise = fight s
          go ((ss, l) : t) s p = l' * go t s (p+1) + (1-l') * go t (s+ss) (p-1)
            where l' = fromIntegral l / 10
      solve distribution = do
        candiedSenators <- sequence $ map maybeToList $ zipWith bribe distribution senators
        return $ s candiedSenators
      result = maximum $ solve =<< distributions :: Double
  putStrLn $ show result


module Main where

import Control.Monad

main :: IO ()
main =
  do _ <- getLine
     l <- liftM ((++ ['0', '1']) . (map head) . words) getLine
     (print :: Int -> IO ()) $ max 0 $ (\x -> x - 2) $ fst $ foldl (\(c, x) y -> if y == '1' then (c + 1, True) else if x then (c + 1, False) else (c, False)) (0, False) l
     return ()

main :: IO()
main = print . solve 0 0 . map read . tail . words =<< getContents

solve :: Int -> Int -> [Int] -> Int
solve _ _ []    = 0
solve i _ (0:x) = solve i 0 x
solve _ 1 (1:x) = 1 + solve 1 1 x
solve i 0 (1:x) = i + 1 + solve 1 1 x

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . calAns . findIndices (== 1). tail . getIntArray

calAns :: [Int] -> Int
calAns [] = 0
calAns (x:[]) = 1
calAns (x:y:xs) = calAns (y:xs) + min (y - x) 2

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . calAns . findIndices (== 1). tail . getIntArray

calAns :: [Int] -> Int
calAns [] = 0
calAns (x:[]) = 1
calAns (x:y:xs) = calAns (y:xs) + if y - x >= 2 then 2 else y - x

import qualified Data.List as L
drop0::[[Int]] -> [[Int]]
drop0 [] = []
drop0 x = if (head.head) x == 0 then tail x else x
drop0'::[[Int]] -> [[Int]]
drop0' [] = []
drop0' x = if (head.last) x == 0 then init x else x
transform :: [[Int]] -> [[Int]]
transform = map (\xs -> if head xs == 0 then [0] else xs)
main :: IO()
main = do
  _ <- getLine
  numbers <- fmap (map read.words) getLine :: IO[Int]
  print$sum$map length.transform.drop0'.drop0.L.group$numbers

import Data.List
main=interact$show.max 0.pred.sum.map(succ.length).filter((>0).head).group.map read.tail.words

import Data.List (group)

main :: IO ()
main = getContents >>= print . solve . map read . tail . words

solve :: [Int] -> Int
solve = max 0 . pred . sum . map (succ . length) . filter ((>0) . head) . group

main = getLine >> getLine >>= return . f 0 . words >>= print

f n ("0" : as) = f n as
f n ("1" : as) = f (n + c + 2) tail
  where
    (front, tail) = span (== "1") as
    c = length front
f 0 [] = 0 :: Int
f n [] = n - 1

solve :: [String] -> Int
solve x = count_groups ("0":x) + max ((sum $ map read x) - 1) 0 where
	count_groups [] = 0
	count_groups [x] = 0
	count_groups (x:t@(y:z)) = if x == "0" && y == "1" then 1 + count_groups z else count_groups t

main = interact $ show.solve.words.last.lines

pre ('0':xs) = pre xs
pre (' ':xs) = pre xs
pre xs = xs

solve [] = 0
solve (' ':xs) = solve xs
solve ['0'] = 0
solve ('0':' ':'0':xs) = solve ('0':xs)
solve ('0':' ':'1':xs) = 1 + solve ('1':xs)
solve ('1':xs) = 1 + solve xs

main = do
    n <- getLine
    n <- getLine
    print(solve(pre n))

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

process [] n  = n
process (s:ss) n  | s==1 = process ss (n+1)
                  | otherwise=  process (dropWhile (==0) ss) (n+1)
main= do
	getLine
	s<-  map (fst.fromJust.C.readInt). C.words <$> C.getLine :: IO [Int]
	print $ process (reverse (dropWhile (==0) (reverse (dropWhile (==0) s)))) 0

import qualified Data.List as L
drop0::[[Int]] -> [[Int]]
drop0 [] = []
drop0 x = if (head.head) x == 0 then tail x else x
drop0'::[[Int]] -> [[Int]]
drop0' [] = []
drop0' x = if (head.last) x == 0 then tail x else x
transform :: [[Int]] -> [[Int]]
transform = map (\xs -> if head xs == 0 then [0] else xs)
main :: IO()
main = do
  _ <- getLine
  numbers <- fmap (map length.transform.drop0'.drop0.L.group.map read.words) getLine :: IO[Int]
  print$sum numbers


import Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        putStrLn "2"
        putStrLn $ unlines $ map (\(a, b) -> unwords [show a, show b]) $ solve $ [n,n-1..1]

solve :: [Int] -> [(Int, Int)]
solve [] = error "Solve called on empty list."
solve (x:[])
        | x == 2 = []
        | otherwise = error ("Minimum not reached: " ++ show x)
solve (a:b:xs) = (a, b):(solve $ (quot (a + b + 1) 2):xs)

import Control.Monad (forM_)

solve :: Int -> [String]
solve 3 = ["1 3"]
solve 2 = ["1 2"]
solve n = (show (n - 2) ++ " " ++ show n) : solve (n - 1)

solve' :: Int -> [String]
solve' 3 = "3 1" : "2 2" : []
solve' 2 = "2 1" : []
solve' n = (show (n - 2) ++ " " ++ show n) : (show (n - 1) ++ " " ++ show (n - 1)) : solve (n - 1)

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] $ \_ -> do
    n <- pure . read =<< getLine
    putStrLn "2"
    mapM_ putStrLn . solve' $ n

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> map (read >>> solve >>> showAns)
      >>> concat
      >>> unlines
  where
    showAns (x, ys) = show x : map showII ys
    showII (x, y) = show x ++ " " ++ show y

solve :: Int -> (Int, [(Int, Int)])
solve n = (2, ((n - 1, n) :) . reverse $ zip [1 .. n] [3 .. n])


import Char
main = interact solve
solve input = output where
  [[a0,b0],[c]] = map words $ lines input
  a = read a0 :: Integer
  b = if b0=="R" then 0 else read b0 :: Integer
  output = c1
  c0 = fromBase c a
  c1 = toBase c0 b
fromBase :: String -> Integer -> Integer
fromBase x y = fromBase' (map toNumber x) y
fromBase' :: [Integer] -> Integer -> Integer
fromBase' [] y = 0
fromBase' [x] y = x
fromBase' (x:y:xs) z = fromBase' (x*z+y:xs) z
toNumber :: Char -> Integer
toNumber x = toInteger $ ord x - if '0'<=x && x<='9' then ord '0' else ord 'A' - 10
toBase :: Integer -> Integer -> String
toBase x y = if y==0 then roman x else toBase' x y
toBase' :: Integer -> Integer -> String
toBase' x y
  | x<y && x<10 = show x
  | x<y         = [chr $ fromIntegral x - 10 + ord 'A']
  | otherwise   = toBase' (div x y) y ++ toBase' (mod x y) y
roman :: Integer -> String
roman x
  | x>=1000 = "M" ++(roman (x-1000))
  | x>=900  = "CM"++(roman (x-900))
  | x>=500  = "D" ++(roman (x-500))
  | x>=400  = "CD"++(roman (x-400))
  | x>=100  = "C" ++(roman (x-100))
  | x>=90   = "XC"++(roman (x-90))
  | x>=50   = "L" ++(roman (x-50))
  | x>=40   = "XL"++(roman (x-40))
  | x>=10   = "X" ++(roman (x-10))
  | x>=9    = "IX"++(roman (x-9))
  | x>=5    = "V" ++(roman (x-5))
  | x>=4    = "IV"++(roman (x-4))
  | x>=1    = "I" ++(roman (x-1))
  | otherwise = ""

import Data.Char
ord' = fromIntegral.ord
chr' = chr.fromIntegral
toA::Integer->Integer->[Char]
toA a x = reverse $ toA' a x where
    toA' a x = let
        x' = x `mod` a
        x1 = x `div` a
        s | x' < 10 = chr' (x' + ord' '0')
          | x' >= 10 = chr' (x' + ord' 'A' - 10) in
        if x1 > 0 then s:(toA' a x1) else [s]
fromA::Integer->[Char]->Integer
fromA a ss = fromA' a 0 ss where
    fromA' a sum (s:ss) | s `elem` ['0'..'9'] = fromA' a (sum * a
                            + (ord' s - ord' '0')) ss
                        | s `elem` ['A'..'Z'] = fromA' a (sum * a
                            + (ord' s - ord' 'A' + 10)) ss
    fromA' a sum [] = sum
toRoman x | x > 1000 = replicate (x `div` 1000) 'M' ++ toRoman (x `mod` 1000)
          | x `div` 100 > 0 = (case (x `div` 100) of
                1 -> "C"
                2 -> "CC"
                3 -> "CCC"
                4 -> "CD"
                5 -> "D"
                6 -> "DC"
                7 -> "DCC"
                8 -> "DCCC"
                9 -> "CM") ++ toRoman (x `mod` 100)
          | x `div` 10 > 0 = (case (x `div` 10) of
                1 -> "X"
                2 -> "XX"
                3 -> "XXX"
                4 -> "XL"
                5 -> "L"
                6 -> "LX"
                7 -> "LXX"
                8 -> "LXXX"
                9 -> "XC") ++ toRoman (x `mod` 10)
          | x > 0 = case x of
                1 -> "I"
                2 -> "II"
                3 -> "III"
                4 -> "IV"
                5 -> "V"
                6 -> "VI"
                7 -> "VII"
                8 -> "VIII"
                9 -> "IX"
          | x == 0 = ""

main = do
    [a', b'] <- words `fmap` getLine
    let a = read a'
    x <- fromA a `fmap` getLine
    putStr (if b' == "R" then toRoman $ fromIntegral x else toA (read b') x)

import Data.List
import Data.Char

toBase :: Integer -> Integer -> [Integer]
toBase b v = toBase' [] v where
  toBase' a 0 = a
  toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b

fromBase :: Integer -> [Integer] -> Integer
fromBase b ds = foldl' (\n k -> n * b + k) 0 ds

toAlphaDigits :: [Integer] -> [Char]
toAlphaDigits = map convert where
  convert n | n < 10    = chr ((fromIntegral n) + ord '0')
            | otherwise = chr ((fromIntegral n) + ord 'A' - 10)

fromAlphaDigits :: [Char] -> [Integer]
fromAlphaDigits = map convert where
 convert c | isDigit c = toInteger (ord c - ord '0')
           | isUpper c = toInteger (ord c - ord 'A' + 10)
           | isLower c = toInteger (ord c - ord 'a' + 10)

rep x 0 = []
rep x n = x : rep x (n-1)

toRoman x
  | x >= 1000 = let (q,r) = x `divMod` 1000
                in rep 'M' q ++ toRoman r
  | x >= 100 = toRomanCent x (x `div` 100)
  | x >= 10 = toRomanDec x (x `div` 10)
  | x > 0 = toRomanUn x
  | otherwise = []

toRomanCent x q
  | q >= 9 = "CM" ++ toRoman (x - 900)
  | q >= 5 = "D" ++ toRoman (x - 500)
  | q >= 4 = "CD" ++ toRoman (x - 400)
  | otherwise = rep 'C' q ++ toRoman (x - 100*q)

toRomanDec x q
  | q >= 9 = "XC" ++ toRoman (x - 90)
  | q >= 5 = "L" ++ toRoman (x - 50)
  | q >= 4 = "XL" ++ toRoman (x - 40)
  | otherwise = rep 'X' q ++ toRoman (x - 10*q)

toRomanUn x
  | x >= 9 = "IX"
  | x >= 5 = "V" ++ toRoman (x - 5)
  | x >= 4 = "IV"
  | otherwise = rep 'I' x

main = do
  fstLine <- getLine
  let bases = words fstLine
      inBase = read $ head bases
      outBase = if (head.head.tail $ bases) == 'R'
                then Nothing
                else Just $ read $ head.tail $ bases
  -- print bases
  inputStr <- getLine
  let input = fromBase inBase $ fromAlphaDigits inputStr
  putStrLn $ case input of 0 -> "0"
                           _ -> case outBase of
                                     Nothing -> toRoman input
                                     Just base ->
                                       toAlphaDigits $ toBase base input

import Data.Char
toA a x = reverse $ toA' a x where
    toA' a x = let
        x' = x `mod` a
        x1 = x `div` a
        s | x' < 10 = chr (x' + ord '0')
          | x' >= 10 = chr (x' + ord 'A' - 10) in
        if x1 > 0 then s:(toA' a x1) else [s]
fromA a ss = fromA' a 0 ss where
    fromA' a sum (s:ss) | s `elem` ['0'..'9'] = fromA' a (sum * a + (ord s - ord '0')) ss
                        | s `elem` ['A'..'Z'] = fromA' a (sum * a + (ord s - ord 'A' + 10)) ss
    fromA' a sum [] = sum
toRoman x | x > 1000 = replicate (x `div` 1000) 'M' ++ toRoman (x `mod` 1000)
          | x `div` 100 > 0 = (case (x `div` 100) of
                1 -> "C"
                2 -> "CC"
                3 -> "CCC"
                4 -> "CD"
                5 -> "D"
                6 -> "DC"
                7 -> "DCC"
                8 -> "DCC"
                9 -> "CM") ++ toRoman (x `mod` 100)
          | x `div` 10 > 0 = (case (x `div` 10) of
                1 -> "X"
                2 -> "XX"
                3 -> "XXX"
                4 -> "XL"
                5 -> "L"
                6 -> "LX"
                7 -> "LXX"
                8 -> "LXXX"
                9 -> "XC") ++ toRoman (x `mod` 10)
          | x > 0 = case x of
                1 -> "I"
                2 -> "II"
                3 -> "III"
                4 -> "IV"
                5 -> "V"
                6 -> "VI"
                7 -> "VII"
                8 -> "VIII"
                9 -> "IX"
          | x == 0 = ""

main = do
    [a', b'] <- words `fmap` getLine
    let a = read a'
    x <- fromA a `fmap` getLine
    putStr (if b' == "R" then toRoman x else toA (read b') x)

import Data.Char
ord' = fromIntegral.ord
chr' = chr.fromIntegral
toA::Integer->Integer->[Char]
toA a x = reverse $ toA' a x where
    toA' a x = let
        x' = x `mod` a
        x1 = x `div` a
        s | x' < 10 = chr' (x' + ord' '0')
          | x' >= 10 = chr' (x' + ord' 'A' - 10) in
        if x1 > 0 then s:(toA' a x1) else [s]
fromA::Integer->[Char]->Integer
fromA a ss = fromA' a 0 ss where
    fromA' a sum (s:ss) | s `elem` ['0'..'9'] = fromA' a (sum * a
                            + (ord' s - ord' '0')) ss
                        | s `elem` ['A'..'Z'] = fromA' a (sum * a
                            + (ord' s - ord' 'A' + 10)) ss
    fromA' a sum [] = sum
toRoman x | x > 1000 = replicate (x `div` 1000) 'M' ++ toRoman (x `mod` 1000)
          | x `div` 100 > 0 = (case (x `div` 100) of
                1 -> "C"
                2 -> "CC"
                3 -> "CCC"
                4 -> "CD"
                5 -> "D"
                6 -> "DC"
                7 -> "DCC"
                8 -> "DCC"
                9 -> "CM") ++ toRoman (x `mod` 100)
          | x `div` 10 > 0 = (case (x `div` 10) of
                1 -> "X"
                2 -> "XX"
                3 -> "XXX"
                4 -> "XL"
                5 -> "L"
                6 -> "LX"
                7 -> "LXX"
                8 -> "LXXX"
                9 -> "XC") ++ toRoman (x `mod` 10)
          | x > 0 = case x of
                1 -> "I"
                2 -> "II"
                3 -> "III"
                4 -> "IV"
                5 -> "V"
                6 -> "VI"
                7 -> "VII"
                8 -> "VIII"
                9 -> "IX"
          | x == 0 = ""

main = do
    [a', b'] <- words `fmap` getLine
    let a = read a'
    x <- fromA a `fmap` getLine
    putStr (if b' == "R" then toRoman $ fromIntegral x else toA (read b') x)

import Data.List
import Data.Char

toBase :: Integer -> Integer -> [Integer]
toBase b v = toBase' [] v where
  toBase' a 0 = a
  toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b

fromBase :: Integer -> [Integer] -> Integer
fromBase b ds = foldl' (\n k -> n * b + k) 0 ds

toAlphaDigits :: [Integer] -> [Char]
toAlphaDigits = map convert where
  convert n | n < 10    = chr ((fromIntegral n) + ord '0')
            | otherwise = chr ((fromIntegral n) + ord 'A' - 10)

fromAlphaDigits :: [Char] -> [Integer]
fromAlphaDigits = map convert where
 convert c | isDigit c = toInteger (ord c - ord '0')
           | isUpper c = toInteger (ord c - ord 'A' + 10)
           | isLower c = toInteger (ord c - ord 'a' + 10)

rep x 0 = []
rep x n = x : rep x (n-1)

toRoman x
  | x >= 1000 = let (q,r) = x `divMod` 1000
                in rep 'M' q ++ toRoman r
  | x >= 100 = toRomanCent x (x `div` 100)
  | x >= 10 = toRomanDec x (x `div` 10)
  | x > 0 = toRomanUn x
  | otherwise = []

toRomanCent x q
  | q >= 9 = "CM" ++ toRoman (x - 900)
  | q >= 5 = "D" ++ toRoman (x - 500)
  | q >= 4 = "CD" ++ toRoman (x - 400)
  | otherwise = rep 'C' q ++ toRoman (x - 100*q)

toRomanDec x q
  | q >= 9 = "XC" ++ toRoman (x - 90)
  | q >= 5 = "L" ++ toRoman (x - 50)
  | q >= 4 = "XL" ++ toRoman (x - 40)
  | otherwise = rep 'X' q ++ toRoman (x - 10*q)

toRomanUn x
  | x >= 9 = "IX"
  | x >= 5 = "V" ++ toRoman (x - 5)
  | x >= 4 = "IV"
  | otherwise = rep 'I' x

main = do
  fstLine <- getLine
  let bases = words fstLine
      inBase = read $ head bases
      outBase = if (head.head.tail $ bases) == 'R'
                then Nothing
                else Just $ read $ head.tail $ bases
  -- print bases
  inputStr <- getLine
  let input = fromBase inBase $ fromAlphaDigits inputStr
  putStrLn $ case outBase of Nothing -> toRoman input
                             Just 0 -> "0"
                             Just base -> toAlphaDigits $ toBase base input

import Data.List
import Data.Char

toBase :: Integer -> Integer -> [Integer]
toBase b v = toBase' [] v where
  toBase' a 0 = a
  toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b

fromBase :: Integer -> [Integer] -> Integer
fromBase b ds = foldl' (\n k -> n * b + k) 0 ds

toAlphaDigits :: [Integer] -> [Char]
toAlphaDigits = map convert where
  convert n | n < 10    = chr ((fromIntegral n) + ord '0')
            | otherwise = chr ((fromIntegral n) + ord 'A' - 10)

fromAlphaDigits :: [Char] -> [Integer]
fromAlphaDigits = map convert where
 convert c | isDigit c = toInteger (ord c - ord '0')
           | isUpper c = toInteger (ord c - ord 'A' + 10)
           | isLower c = toInteger (ord c - ord 'a' + 10)

rep x 0 = []
rep x n = x : rep x (n-1)

toRoman x
  | x >= 1000 = let (q,r) = x `divMod` 1000
                in rep 'M' q ++ toRoman r
  | x >= 100 = toRomanCent x (x `div` 100)
  | x >= 10 = toRomanDec x (x `div` 10)
  | x > 0 = toRomanUn x
  | otherwise = []

toRomanCent x q
  | q >= 9 = "CM" ++ toRoman (x - 900)
  | q >= 5 = "D" ++ toRoman (x - 500)
  | q >= 4 = "CD" ++ toRoman (x - 400)
  | otherwise = rep 'C' q ++ toRoman (x - 100*q)

toRomanDec x q
  | q >= 9 = "XC" ++ toRoman (x - 90)
  | q >= 5 = "L" ++ toRoman (x - 50)
  | q >= 4 = "XL" ++ toRoman (x - 40)
  | otherwise = rep 'X' q ++ toRoman (x - 10*q)

toRomanUn x
  | x >= 9 = "IX"
  | x >= 5 = "V" ++ toRoman (x - 5)
  | x >= 4 = "IV"
  | otherwise = rep 'I' x

main = do
  fstLine <- getLine
  let bases = words fstLine
      inBase = read $ head bases
      outBase = if (head.head.tail $ bases) == 'R'
                then Nothing
                else Just $ read $ head.tail $ bases
  -- print bases
  inputStr <- getLine
  let input = fromBase inBase $ fromAlphaDigits inputStr
  putStrLn $ case outBase of Nothing -> toRoman input
                             Just base -> toAlphaDigits $ toBase base input

import Data.List
import Data.Char

toBase :: Int -> Int -> [Int]
toBase b v = toBase' [] v where
  toBase' a 0 = a
  toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b

fromBase :: Int -> [Int] -> Int
fromBase b ds = foldl' (\n k -> n * b + k) 0 ds

toAlphaDigits :: [Int] -> String
toAlphaDigits = map convert where
  convert n | n < 10    = chr (n + ord '0')
            | otherwise = chr (n + ord 'A' - 10)

fromAlphaDigits :: String -> [Int]
fromAlphaDigits = map convert where
 convert c | isDigit c = ord c - ord '0'
           | isUpper c = ord c - ord 'A' + 10
           | isLower c = ord c - ord 'a' + 10

rep :: Char -> Int -> String
rep x 0 = []
rep x n = x : rep x (n-1)

toRoman :: Int -> String
toRoman x
  | x >= 1000 = let (q,r) = x `divMod` 1000
                in rep 'M' q ++ toRoman r
  | x >= 100 = toRomanCent x (x `div` 100)
  | x >= 10 = toRomanDec x (x `div` 10)
  | x > 0 = toRomanUn x
  | otherwise = []

toRomanCent x q
  | q >= 9 = "CM" ++ toRoman (x - 900)
  | q >= 5 = "D" ++ toRoman (x - 500)
  | q >= 4 = "CD" ++ toRoman (x - 400)
  | otherwise = rep 'C' q ++ toRoman (x - 100*q)

toRomanDec x q
  | q >= 9 = "XC" ++ toRoman (x - 90)
  | q >= 5 = "L" ++ toRoman (x - 50)
  | q >= 4 = "XL" ++ toRoman (x - 40)
  | otherwise = rep 'X' q ++ toRoman (x - 10*q)

toRomanUn x
  | x >= 9 = "IX"
  | x >= 5 = "V" ++ toRoman (x - 5)
  | x >= 4 = "IV"
  | otherwise = rep 'I' x

main = do
  fstLine <- getLine
  let bases = words fstLine
      inBase = read $ head bases
      outBase = if (head.head.tail $ bases) == 'R'
                then Nothing
                else Just $ read $ head.tail $ bases
  -- print bases
  inputStr <- getLine
  let input = fromBase inBase $ fromAlphaDigits inputStr
  putStrLn $ case outBase of Nothing -> toRoman input
                             Just base -> toAlphaDigits $ toBase base input


{-# 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
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = do
	t <- readInt
	replicateM t solve

solve = do
	n <- readInt
	print $ ( n + 1 ) `div` 2

solve :: Integer -> Integer
solve n = (n-1) `div` 2 + 1

readInt :: IO Integer
readInt = do
    line <- getLine
    let a = read line :: Integer
    return a

main :: IO ()
main = do
    t <- readInt
    for t where
        for 0 = return ()
        for t = do
            n <- readInt
            putStrLn $ show $ solve n
            for (t-1)

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

main = getLine >>= flip replicateM_ test . read

test = getLine >>= print . (`div` 2) . succ . read

import           Control.Monad (forM_, replicateM_)

sol n = if even n then n `div` 2 else n `div` 2 + 1

main = do
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    print $ sol n

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

onecase = do
		x<- read <$> getLine ::IO Int
		print $ div (x+1) 2

main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase

import Control.Monad

main = do
  t <- readLn :: IO Int
  forM_ [1 .. t] $ \_ -> do
    n <- readLn :: IO Int
    print $ (n + 1) `div` 2

import           Control.Monad

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    n <- read <$> getLine :: IO Int
    print ((n-1) `div` 2 + 1)