{-# LANGUAGE BangPatterns #-}

import Data.Array.IO
import Data.Array.Unboxed
import Data.Array.Base(unsafeRead,unsafeWrite,unsafeAt)
import qualified Data.ByteString.Char8 as B
import Control.Applicative

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

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

for :: Int -> Int -> (Int -> IO ()) -> IO ()
for !n !m f = go n
   where
     go !i
       | i<m = f i >> go (i+1)
       | otherwise = return ()

main = do
  [n,m,_] <- map read.words <$> getLine
  (dists,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray (0,m*n*n-1) dists :: IO (IOUArray Int Int)

  rep m $ \i->
    rep n $ \x->
      rep n $ \s->
        rep n $ \t-> do
          dst <- unsafeRead d $ i*n*n+s*n+t
          dsx <- unsafeRead d $ i*n*n+s*n+x
          dxt <- unsafeRead d $ i*n*n+x*n+t
          unsafeWrite d (i*n*n+s*n+t) $ min dst $ dsx+dxt

  dist <- unsafeFreeze d :: IO (UArray Int Int)

  dp <- newArray (0,(n+1)*n*n-1) 60000000 :: IO (IOUArray Int Int)

  rep n $ \s->
    rep n $ \t-> do
      unsafeWrite dp (s*n+t) $! minimum [unsafeAt dist (car*n*n+s*n+t)|car<-[0..m-1]]

  for 1 (n+1) $ \k->
    rep n $ \s->
      rep n $ \t->
        rep n $ \x-> do
           dst <- unsafeRead dp $ (k*n*n+s*n+t)
           dsx <- unsafeRead dp $ ((k-1)*n*n+s*n+x)
           dxt <- unsafeRead dp $ (x*n+t)
           unsafeWrite dp (k*n*n+s*n+t) $ min dst $ dsx+dxt

  ans <- unsafeFreeze dp :: IO (UArray Int Int)

  let solve :: [Int] -> String
      solve [] = []
      solve (s:t:k:stks) = shows(unsafeAt ans(min n k*n*n+(s-1)*n+t-1))"\n" ++ solve stks

  putStr $ solve stks

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

import Control.Applicative
import Control.Monad
import Data.Array.IO
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B

rep :: Int -> (Int -> IO ()) -> IO ()
rep !n f=go 1 where go !i=when(i<=n)$f i>>go(i+1)

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

main = do
  [n,m,_] <- map read.words <$> getLine
  (dists,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray ((1,1,1),(m,n,n)) dists  :: IO (IOUArray (Int,Int,Int) Int)

  rep m $ \i->
    rep n $ \x->
      rep n $ \s->
        rep n $ \t-> do
          dst <- readArray d (i,s,t)
          dsx <- readArray d (i,s,x)
          dxt <- readArray d (i,x,t)
          writeArray d (i,s,t) $ min dst (dsx+dxt)

  dist <- unsafeFreeze d :: IO (UArray (Int,Int,Int) Int)

  dp <- newArray ((0,1,1),(n,n,n)) 60000000 :: IO (IOUArray (Int,Int,Int) Int)

  rep n $ \s->
    rep n $ \t->
      writeArray dp (0,s,t) $ minimum [dist!(car,s,t)|car<-[1..m]]

  rep n $ \k->
    rep n $ \s->
      rep n $ \t->
        rep n $ \x-> do
          dst <- readArray dp (k,s,t)
          dsx <- readArray dp (k-1,s,x)
          dxt <- readArray dp (0,x,t)
          writeArray dp (k,s,t) $ min dst (dsx+dxt)

  ans <- unsafeFreeze dp :: IO (UArray (Int,Int,Int) Int)

  let solve [] = []
      solve (s:t:k:stks) = shows(ans!(min n k,s,t))"\n" ++ solve stks

  putStr $ solve stks

{-# OPTIONS_GHC -O2 -fvia-C -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}

import Data.Array.IO
import Data.Array.Unboxed
import Data.Array.Base(unsafeRead,unsafeWrite,unsafeAt)
import qualified Data.ByteString.Char8 as B
import Control.Applicative

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

main = do
  [n,m,_] <- map read.words <$> getLine
  (disList,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray (0,m*n*n-1)  disList  :: IO (IOUArray Int Int)

  let runFloyd :: Int -> Int -> Int -> Int -> IO ()
      runFloyd !i !x !s !t
        | t<=n-1 = step >> runFloyd i x s (t+1)
        | s<n-1 = runFloyd i x (s+1) 0
        | x<n-1 = runFloyd i (x+1) 0 0
        | i<m-1 = runFloyd (i+1) 0 0 0
        | otherwise = return ()
       where
         step :: IO ()
         step = do
           dst <- unsafeRead d $! i*n*n+s*n+t
           dsx <- unsafeRead d $! i*n*n+s*n+x
           dxt <- unsafeRead d $! i*n*n+x*n+t
           unsafeWrite d (i*n*n+s*n+t) $! min dst $! dsx+dxt

  runFloyd 0 0 0 0
  dist <- unsafeFreeze d :: IO (UArray Int Int)
  dp <- newArray (0,(n+1)*n*n-1) 60000000 :: IO (IOUArray Int Int)

  let runInit :: Int -> Int -> IO ()
      runInit !s !t
        | t<=n-1 = step >> runInit s (t+1)
        | s<n-1  = runInit (s+1) 0
        | otherwise = return ()
       where
         step :: IO ()
         step = unsafeWrite dp (s*n+t) $! minimum $! [unsafeAt dist (car*n*n+s*n+t)|car<-[0..m-1]]

  let runDP ::  Int -> Int -> Int -> Int -> IO ()
      runDP !k !s !t !x
        | x<=n-1 = step >> runDP k s t (x+1)
        | t<n-1 = runDP k s (t+1) 0
        | s<n-1 = runDP k (s+1) 0 0
        | k<n   = runDP (k+1) 0 0 0
        | otherwise = return ()
       where
         step :: IO ()
         step = do
           dst <- unsafeRead dp $! (k*n*n+s*n+t)
           dsx <- unsafeRead dp $! ((k-1)*n*n+s*n+x)
           dxt <- unsafeRead dp $! (x*n+t)
           unsafeWrite dp (k*n*n+s*n+t) $! min dst $! dsx+dxt

  runInit 0 0
  runDP 1 0 0 0
  ans <- unsafeFreeze dp :: IO (UArray Int Int)

  let solve :: [Int] -> String
      solve [] = []
      solve (s:t:k:stks) = shows(unsafeAt ans(min n k*n*n+(s-1)*n+t-1))"\n" ++ solve stks

  putStr $ solve stks

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

import Control.Applicative
import Control.Monad
import Data.Array.Base hiding (readArray, writeArray, (!))
import Data.Array.IO (IOUArray)
import qualified Data.ByteString.Char8 as B
import Data.Ix
import GHC.Arr (unsafeIndex)

(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=case bounds a of lr->unsafeAt a$unsafeIndex lr i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}

rep :: Int -> Int -> (Int -> IO ()) -> IO ()
rep !s !t f=go s where go !i=when(i<=t)$f i>>go(i+1)
{-# INLINE rep #-}

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

main = do
  [n,m,_] <- map read.words <$> getLine
  (dists,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray ((1,1,1),(m,n,n)) dists  :: IO (IOUArray (Int,Int,Int) Int)

  rep 1 m $ \i->
    rep 1 n $ \x->
      rep 1 n $ \s->
        rep 1 n $ \t-> do
          dst <- readArray d (i,s,t)
          dsx <- readArray d (i,s,x)
          dxt <- readArray d (i,x,t)
          writeArray d (i,s,t) $ min dst (dsx+dxt)

  dist <- unsafeFreeze d :: IO (UArray (Int,Int,Int) Int)

  dp <- newArray ((0,1,1),(n,n,n)) 60000000 :: IO (IOUArray (Int,Int,Int) Int)

  rep 1 n $ \s->
    rep 1 n $ \t->
      writeArray dp (0,s,t) $ minimum [dist!(car,s,t)|car<-[1..m]]

  rep 1 n $ \k->
    rep 1 n $ \s->
      rep 1 n $ \t->
        rep 1 n $ \x-> do
          dst <- readArray dp (k,s,t)
          dsx <- readArray dp (k-1,s,x)
          dxt <- readArray dp (0,x,t)
          writeArray dp (k,s,t) $ min dst (dsx+dxt)

  ans <- unsafeFreeze dp :: IO (UArray (Int,Int,Int) Int)

  let solve [] = []
      solve (s:t:k:stks) = shows(ans!(min n k,s,t))"\n" ++ solve stks

  putStr $ solve stks

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

import Control.Applicative
import Control.Monad
import Data.Array.Base hiding (readArray, writeArray, (!))
import Data.Array.IO (IOUArray)
import qualified Data.ByteString.Char8 as B
import Data.Ix
import GHC.Arr (unsafeIndex)

(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=case bounds a of lr->unsafeAt a$unsafeIndex lr i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}

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

main = do
  [n,m,_] <- map read.words <$> getLine
  (dists,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray ((1,1,1),(m,n,n)) dists  :: IO (IOUArray (Int,Int,Int) Int)

  forM_ [1..m] $ \i->
    forM_ [1..n] $ \x->
      forM_ [1..n] $ \s->
        forM_ [1..n] $ \t-> do
          dst <- readArray d (i,s,t)
          dsx <- readArray d (i,s,x)
          dxt <- readArray d (i,x,t)
          writeArray d (i,s,t) $ min dst (dsx+dxt)

  dist <- unsafeFreeze d :: IO (UArray (Int,Int,Int) Int)

  dp <- newArray ((0,1,1),(n,n,n)) 60000000 :: IO (IOUArray (Int,Int,Int) Int)

  forM_ [1..n] $ \s->
    forM_ [1..n] $ \t->
      writeArray dp (0,s,t) $ minimum [dist!(car,s,t)|car<-[1..m]]

  forM_ [1..n] $ \k->
    forM_ [1..n] $ \s->
      forM_ [1..n] $ \t->
        forM_ [1..n] $ \x-> do
          dst <- readArray dp (k,s,t)
          dsx <- readArray dp (k-1,s,x)
          dxt <- readArray dp (0,x,t)
          writeArray dp (k,s,t) $ min dst (dsx+dxt)

  ans <- unsafeFreeze dp :: IO (UArray (Int,Int,Int) Int)

  let solve [] = []
      solve (s:t:k:stks) = shows(ans!(min n k,s,t))"\n" ++ solve stks

  putStr $ solve stks

{-# OPTIONS_GHC -O2 #-}

import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Monad

readInt s = let Just (n,_) = B.readInt s in n

parse :: [[Int]] -> ([Int],[[Int]],[[Int]])
parse ([n,m,r]:xss) = let (disList,stks) = splitAt (m*n) xss
                      in ([n,m,r],disList,stks)

rep :: (Monad m) => Int -> (Int -> m ()) -> m ()
rep n f = rep' 1
   where rep' i
           | i <= n = f i >> rep' (i+1)
           | otherwise = return ()

main = do

  ([n,m,r],disList,stks) <- parse.map (map readInt.B.words).B.lines <$> B.getContents

  let dis :: UArray (Int,Int,Int) Int
      dis = runSTUArray $ do
        d <- newListArray ((1,1,1),(m,n,n)) $ concat disList
        rep m $ \i->
          rep n $ \x->
            rep n $ \s->
              rep n $ \t-> do
                dst <- readArray d (i,s,t)
                dsx <- readArray d (i,s,x)
                dxt <- readArray d (i,x,t)
                let tmp = dst+dxt
                when (tmp < dst) $
                  writeArray d (i,s,t) tmp
        return d

  let dp :: Array (Int,Int,Int) Int
      dp = array ((1,1,0),(n,n,n)) $ map (\x->(x,f x)) $ [(s,t,k)|s<-[1..n],t<-[1..n],k<-[0..n]]
      f (s,t,0) = minimum [dis!(i,s,t)|i<-[1..m]]
      f (s,t,k) = minimum [dp!(s,x,k-1)+dp!(x,t,0)|x<-[1..n]]

  putStr.unlines.map (\[s,t,k]->show $ dp!(s,t,min n k)) $ stks

{-# OPTIONS_GHC -O2 #-}

import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import Data.Word
import Control.Applicative
import Control.Monad

readInt s = let Just (n,_) = B.readInt s in n

parse :: [[Int]] -> ([Word8],[[Int]],[[Word8]])
parse ([n,m,r]:xss) = let (disList,stks) = splitAt (m*n) xss
                      in (map fromIntegral [n,m,r],disList,map (map fromIntegral) stks)

rep :: (Monad m) => Word8 -> (Word8 -> m ()) -> m ()
rep n f = rep' 1
   where rep' i
           | i <= n = f i >> rep' (i+1)
           | otherwise = return ()

main = do
  ([n,m,r],disList,stks) <- parse.map (map readInt.B.words).B.lines <$> B.getContents

  let dis :: UArray (Word8,Word8,Word8) Int
      dis = runSTUArray $ do
        d <- newListArray ((1,1,1),(m,n,n)) $ concat disList
        rep m $ \car->
          rep n $ \x->
            rep n $ \s->
              rep n $ \t-> do
                dst <- readArray d (car,s,t)
                dsx <- readArray d (car,s,x)
                dxt <- readArray d (car,x,t)
                writeArray d (car,s,t) $ min dst (dsx + dxt)
        return d

  let solve :: UArray (Word8,Word8,Word8) Int
      inf = 60000000
      solve = runSTUArray $ do
        dp <- newArray ((1,1,0),(n,n,n)) inf
        rep n $ \s->
          rep n $ \t->
            writeArray dp (s,t,0) $ minimum [dis!(car,s,t)|car<-[1..m]]
        rep n $ \k->
          rep n $ \s->
            rep n $ \t->
              rep n $ \x-> do
                dst <- readArray dp (s,t,k)
                dsx <- readArray dp (s,x,k-1)
                dxt <- readArray dp (x,t,0)
                writeArray dp (s,t,k) $ min dst (dsx+dxt)
        return dp

  putStr.unlines.map (\[s,t,k]->show $ solve!(s,t,min n k)) $ stks


-- 15A

import List (sortBy)
import Monad (liftM)

parse :: String -> (Int, Int)
parse line  =  case words line of
    [s1, s2]  ->  (read s1, read s2)

solve :: Int -> [(Int, Int)] -> Int
solve t xs  =  2 + sum (zipWith f xs' (tail xs'))
  where
    xs'  =  sortBy (\a b -> compare (fst a) (fst b)) xs
    f (x1, a1) (x2, a2)
      | d < 2 * t  =  0
      | d > 2 * t  =  2
      | otherwise  =  1
      where
        d  =  (2 * x2 - a2) - (2 * x1 + a1)

main :: IO ()
main  =  do
    (_, t)  <-  liftM parse getLine
    xs      <-  liftM (map parse . lines) getContents
    print $ solve t xs

import List
import Control.Monad

solve t hs = show.(+2). sum $ [fits a b | (a,b) <- zip hs (tail hs)]
    where fits (x1, t1) (x2, t2) | 2*(x2-x1) - (t1+t2) == 2*t = 1
                                 | 2*(x2-x1) - (t1+t2) > 2*t  = 2
                                 | otherwise = 0

ints = fmap (map read . words) getLine

main = do
    [n, t] <- ints
    replicateM n ints >>= putStrLn . solve t . sort . (map (\[a,b]->(a,b)))

import Data.List( sort)
main = do
    n:[t] <- return . map read . words =<< getLine
    let packDataLine = do
	    [x,a] <- return . map read . words =<< getLine
	    return (x,a)
	packDataLine::IO (Int,Int)
    address <- sequence . take n $ repeat packDataLine
    let sAdd = sort address
	widths = [2*(fst b - fst a) - snd b - snd a | (a,b) <- zip sAdd (tail sAdd)]
	list = map (\w -> if 2*t<w then 2 else if 2*t == w then 1 else 0) widths
    print $ 2+sum list

import Data.List( sort)
main = do
    n:[t] <- return . map read . words =<< getLine
    let packDataLine = do
	    [x,a] <- return . map read . words =<< getLine
	    return (x,a)
	packDataLine::IO (Int,Int)
    address <- sequence . take n $ repeat packDataLine
    let sAdd = sort address
	widths = [fst b - fst a - (snd b + snd a)`div`2 | a<-sAdd, b<- tail sAdd]
	list = map (\w -> if t<w then 2 else if t == w then 1 else 0) widths
    print $ 2+sum list


{-# LANGUAGE OverloadedStrings, FlexibleContexts, RankNTypes #-}
import Control.Monad
import Control.Applicative
import Control.Monad.ST
import Data.Int
import Data.Maybe
import Data.List
import Data.Functor
import Data.Ix
import Data.Bool
import Data.Array.Unboxed as UA
import Data.Array.IArray as IA
import Data.Array.IO.Safe as IOA
import Data.Array.ST.Safe as SA
import Data.Array.MArray.Safe as MA
import Data.Array as A
import qualified Data.ByteString.Char8 as B8
import Text.Printf

-- import Debug.Trace
-- debug = flip trace

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

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

modifyArray :: (MA.MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray array i func = do
    e <- MA.readArray array i
    MA.writeArray array i $ func e

type Vertex = Int
type Vertices = [Vertex]
data Graph = Graph {
    getN :: Int,
    getAdjacents :: A.Array Int Vertices }

findSizes :: forall s. Int -> Graph -> A.Array Int Int
findSizes v graph = SA.runSTArray $ do
    let n = getN graph
    let adjacents = getAdjacents graph

    weights <- SA.newArray (1, n) 0 :: ST s (STArray s Int Int)
    let dfsWeights weights v parent = do
        childWeights <- forM (adjacents UA.! v) $ \u -> do
            if (u /= parent)
                then dfsWeights weights u v
                else return 0

        let weight = 1 + (sum childWeights)
        SA.writeArray weights v weight
        return $ weight
    dfsWeights weights v (-1)

    sizes <- SA.newArray (1, n) 0
    let dfsSizes sizes v parent upSize = do
        vWeight <- SA.readArray weights v
        childSizes <- forM (adjacents IA.! v) $ \u -> do
            uWeight <- SA.readArray weights u
            if (u /= parent)
                then do
                    dfsSizes sizes u v (upSize + vWeight - uWeight)
                    return uWeight
                else return 0
        let vSize = (foldr1 max $ upSize : childSizes) -- `debug` ("v = " ++ (show v) ++ ", sizes = " ++ (show $ upSize : childSizes))
        SA.writeArray sizes v vSize
        return vSize
    dfsSizes sizes v (-1) 0
    return sizes

findLeafEdge :: Int -> Int -> Graph -> (Int, Int)
findLeafEdge v parent graph = edge
    where
        n = getN graph
        adjacents = getAdjacents graph
        dfs v parent
            | (length $ adjacents IA.! v) /= 1 =
                let childEdges = (flip map) (adjacents IA.! v) $ \u ->
                        if u /= parent
                            then dfs u v
                            else Nothing
                    childEdge = msum childEdges
                in childEdge
            | otherwise = Just (v, parent)
        edge = fromJust $ dfs v parent

readGraph :: IO Graph
readGraph = do
    n <- B8.getLine <&> readIntB8
    adjacents <- MA.newArray (1, n) [] :: IO (IOA.IOArray Int Vertices)
    forM_ [2..n] $ \_ -> do
        [a, b] <- B8.getLine <&> B8.words <&> map readIntB8
        modifyArray adjacents a ((:) b)
        modifyArray adjacents b ((:) a)
    adjacentsA <- MA.freeze adjacents
    return $ Graph n adjacentsA

solve :: Graph -> ((Int, Int), (Int, Int))
solve graph = answer
--        `debug` ("sizes = " ++ show sizes)
    where
        n = getN graph
        sizes = findSizes 1 graph
        minSize = foldr1 min sizes
        centroids = map fst . filter (\(i, e) -> e == minSize) $ UA.assocs sizes

        defaultEdge = (1, head $ (getAdjacents graph) IA.! 1)
        leafEdge = findLeafEdge (centroids !! 0) (centroids !! 1) graph
        answer
            | (length centroids) == 1 = (defaultEdge, defaultEdge)
            | otherwise = (leafEdge, (centroids !! 1, fst leafEdge))

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        graph <- readGraph
        let ((a, b), (c, d)) = solve graph
        printf "%d %d\n" a b
        printf "%d %d\n" c d

import Control.Monad
import Data.Maybe
import Data.List
import Data.Array
import Text.Printf
import qualified Data.ByteString.Char8 as C

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

main :: IO ()
main = do
  [caseNum] <- getInts
  forM_ [1..caseNum] $ \_ -> do
    [n] <- getInts
    edges <- map (\[x, y] -> (x, y)) <$> replicateM (n - 1) getInts
    let es = listArray (1, n) $ map (map snd) $
                groupBy (\(a, _) (b, _) -> a == b) $ sortBy (\(a, _) (b, _) -> compare a b) $
                concat $ map (\(x, y) -> [(x, y), (y, x)]) edges
        dfs par u = let ps = map (dfs u) $ filter (/= par) $ es ! u
                        rr = join $ find isJust $ map (\(r, _, _) -> r) ps
                        result = if isJust rr
                                   then rr
                                   else find (\(_, _, sz) -> 2 * sz == n) ps >>= (\(_, v, _) -> Just (u, v))
                    in (result, u, sum (1 : map (\(_, _, sz) -> sz) ps))
        ans = let (result, _, _) = dfs 1 1
              in case result of
                Nothing -> [edges !! 0, edges !! 0]
                Just (u, v) -> let w = fromJust $ find (/= v) (es ! u) in [(u, w), (v, w)]
    forM_ ans (\(x, y) -> printf "%d %d\n" x y)


import qualified Data.Set as Set
import Data.List
import Control.Monad
import Data.Char

readInts = fmap (map read.words) getLine :: IO [Integer]

printArray [] = ""
printArray (x:xs) = show(x) ++" " ++ printArray xs

solve [] cnt r = r
solve (x:xs) cnt r = if (x>0) then solve xs (max (cnt-1) (x-1)) (1:r)
    else do
        if (cnt > 0) then solve xs (cnt-1) (1:r)
        else (solve xs cnt (0:r) )

printS = do
    n<-readLn :: IO Int
    a<-readInts
    let b = reverse a
    putStrLn $ printArray $ solve b 0 []

main = do
    t<-readLn :: IO Int
    replicateM_ t printS

f :: Int -> IO()
f 0 = return ()
f n = do {
    x <- getLine;
    l <- getLine;
    putStrLn (concatMap ( (  ++ [' ']).show ) ( sol (read x) (map read (words l)) ));
    f (n-1)
}

sol2 :: Int -> [Int] -> [Int] -> [Int]
sol2 _ li [] = li
sol2 n li (x:xs)
    | n > x = sol2 (n-1) (1:li) xs
    | x > 0 = sol2 (x-1) (1:li) xs
    | otherwise = sol2 0 (0:li) xs

sol :: Int -> [Int] -> [Int]
sol n li = sol2 0 [] (reverse li)

main = do {
    x <- getLine;
    f (read x)
}


main :: IO ()
main = interact  ((\stdin -> solve (stdin !! 1) (stdin !! 2)) . lines)

solve :: String -> String -> String
solve pattern str =
    if any (=='*') pattern then
    let p = prefix pattern
        s = suffix pattern in
    if (length p) + (length s) > (length str) then "NO" else
    if (and (zipWith (==) p str)) && (and (zipWith (==) s (reverse str))) then
    "YES" else "NO" else if pattern == str then "YES" else "NO"

prefix :: String -> String
prefix str = takeWhile (/='*') str

suffix = prefix . reverse

import Data.List

toint s = (read s) :: Int

doit s t =
  case (dropWhile (/='*') s) of
    "" -> s == t
    bb ->
      let b = tail bb in
      let a = takeWhile (/='*') s in
      (isPrefixOf a t) && (isSuffixOf b t) && length a + length b <= length t

solve::String -> String
solve ss =
  let [_,_,s,t] = words ss in
  if doit s t then
    "YES\n"
  else
    "No\n"

main = interact solve

import Control.Monad
import Data.Bool
import Data.Function
import Data.Tuple
import Data.Maybe
import Data.Tree
import Data.Graph
import Data.Array.IArray
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as B

iogetints :: IO [Int]
iogetints = getLine >>= (return . map read . words)

freadEdgeList :: IO [Edge]
freadEdgeList = B.getContents >>= (return . pairify . map (fst . fromJust . B.readInt) . B.words)

indexed :: [a] -> [(Int, a)]
indexed = go 0 where
	go :: Int -> [a] -> [(Int, a)]
	go _ [] = []
	go i (x:xs) = (i, x) : (go (succ i) xs)

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
	go (Node x ts) = f x (map go ts)

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

buildTree :: Int -> Vertex -> [Edge] -> Tree Vertex
buildTree n r es = fdfs (-1) r where
	g = accumArray (flip (:)) [] (1, n) $ ap (++) (map swap) $ es :: Graph
	fdfs :: Vertex -> Vertex -> Tree Vertex
	fdfs p v = Node v $ map (fdfs v) $ delete p $ g!v

both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)

solve :: String -> String -> Bool
solve s1 s2 = ans where
	ss = split (dropDelims $ oneOf "*") s1
	ans = if(length ss == 1 || (length s1) > (succ $ length s2)) then (s1 == s2) else
		(&&) (all id $ zipWith (==) (head ss) s2) (all id $ zipWith (==) (reverse $ last ss) (reverse s2))

main :: IO ()
main = do
	[n, m] <- iogetints
	s1 <- getLine
	s2 <- getLine
	putStrLn $ bool "NO" "YES" $ solve s1 s2

import Data.List

toint s = (read s) :: Int

doit s t =
  case (dropWhile (/='*') s) of
    "" -> s == t
    bb ->
      let b = tail bb in
      let a = takeWhile (/='*') s in
      (isPrefixOf a t) && (isSuffixOf b t)

solve::String -> String
solve ss =
  let [_,_,s,t] = words ss in
  if doit s t then
    "YES\n"
  else
    "No\n"

main = interact solve

main :: IO ()
main = interact  ((\stdin -> solve (stdin !! 1) (stdin !! 2)) . lines)

solve :: String -> String -> String
solve pattern str =
    let p = prefix pattern
        s = suffix pattern in
    if (length p) + (length s) > (length str) then "NO" else
    if (and (zipWith (==) p str)) && (and (zipWith (==) s (reverse str))) then
    "YES" else "NO"

prefix :: String -> String
prefix str = takeWhile (/='*') str

suffix = prefix . reverse

import Control.Monad
import Data.Bool
import Data.Function
import Data.Tuple
import Data.Maybe
import Data.Tree
import Data.Graph
import Data.Array.IArray
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as B

iogetints :: IO [Int]
iogetints = getLine >>= (return . map read . words)

freadEdgeList :: IO [Edge]
freadEdgeList = B.getContents >>= (return . pairify . map (fst . fromJust . B.readInt) . B.words)

indexed :: [a] -> [(Int, a)]
indexed = go 0 where
	go :: Int -> [a] -> [(Int, a)]
	go _ [] = []
	go i (x:xs) = (i, x) : (go (succ i) xs)

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
	go (Node x ts) = f x (map go ts)

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

buildTree :: Int -> Vertex -> [Edge] -> Tree Vertex
buildTree n r es = fdfs (-1) r where
	g = accumArray (flip (:)) [] (1, n) $ ap (++) (map swap) $ es :: Graph
	fdfs :: Vertex -> Vertex -> Tree Vertex
	fdfs p v = Node v $ map (fdfs v) $ delete p $ g!v

both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)

solve :: String -> String -> Bool
solve s1 s2 = ans where
	ss = split (dropDelims $ oneOf "*") s1
	ans = if(length ss == 1) then (s1 == s2) else
		(&&) (all id $ zipWith (==) (head ss) s2) (all id $ zipWith (==) (reverse $ last ss) (reverse s2))

main :: IO ()
main = do
	[n, m] <- iogetints
	s1 <- getLine
	s2 <- getLine
	putStrLn $ bool "NO" "YES" $ solve s1 s2

import Control.Monad
import Data.Bool
import Data.Function
import Data.Tuple
import Data.Maybe
import Data.Tree
import Data.Graph
import Data.Array.IArray
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as B

iogetints :: IO [Int]
iogetints = getLine >>= (return . map read . words)

freadEdgeList :: IO [Edge]
freadEdgeList = B.getContents >>= (return . pairify . map (fst . fromJust . B.readInt) . B.words)

indexed :: [a] -> [(Int, a)]
indexed = go 0 where
	go :: Int -> [a] -> [(Int, a)]
	go _ [] = []
	go i (x:xs) = (i, x) : (go (succ i) xs)

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
	go (Node x ts) = f x (map go ts)

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

buildTree :: Int -> Vertex -> [Edge] -> Tree Vertex
buildTree n r es = fdfs (-1) r where
	g = accumArray (flip (:)) [] (1, n) $ ap (++) (map swap) $ es :: Graph
	fdfs :: Vertex -> Vertex -> Tree Vertex
	fdfs p v = Node v $ map (fdfs v) $ delete p $ g!v

both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)

solve :: String -> String -> Bool
solve s1 s2 = ans where
	ss = split (dropDelims $ oneOf "*") s1
	ans = if(length ss == 1) then (s1 == s2) else
		(&&) (all id $ zipWith (==) (head ss) s2) (all id $ zipWith (==) (reverse $ last ss) (reverse s2))

main :: IO ()
main = do
	[n, m] <- iogetints
	s1 <- getLine
	s2 <- getLine
	print $ bool "NO" "YES" $ solve s1 s2


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

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInteger
	print $ 1 + length ( takeWhile ( <= n ) [ 10 ^ i | i <- [ 1 .. ] ] )

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), (<|), (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

infixl 0 >$>
(>$>) = flip ($)

main = interact $
  lines >>> drop 1 >>> map (length >>> show) >>> unlines


{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Monad
import Control.Monad.State
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = do
  n <- popInt
  as <- popInts
  return $ bshow (solve n as)

solve n as = length $ filter (/= minimum as) as

module Main where

    del :: Eq a => [a] -> a -> [a]
    del s x = filter (/= x) s

    solve :: IO ()
    solve = do
        getLine
        s <- getLine
        let a = map (\x -> read x :: Integer) $ words s
        print $ length $ del a $ minimum a

    iter :: Integer -> IO ()
    iter 1 = solve
    iter x = do
        solve
        iter $ x - 1

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

{-# LANGUAGE OverloadedStrings, FlexibleContexts, ConstraintKinds #-}

main = interact $ unlines.map show.f.tail.lines

f :: [String] -> [Int]
f [] = []
f (_:b:xs) = g (read <$> words b) : f xs

g :: [Int] -> Int
g [] = 0
g b = let m = minimum b in length $ filter (> m) b

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

discardSmallest :: Eq a => [a] -> [a]       -- list must be sorted
discardSmallest []     = []
discardSmallest (x:xs) = dropWhile (== x) xs

solution :: [Int] -> Int
solution = length . discardSmallest . sort

main = do
	numTests <- read <$> getLine
	tests <- sequence $ replicate numTests $ do
		_ <- getLine 		-- length of list
		map read . words <$> getLine
	mapM_ (putStrLn . show . solution) tests

import Control.Monad
import Data.Maybe
import Data.List
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
    _ <- C.getLine
    as <- getInts
    let minValue = minimum as
    C.putStrLn $ C.pack $ show $ length $ filter (/= minValue) as

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

type SIO = StateT P.ByteString IO

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    let  v = minimum a
    putInts [length $ filter (> v) a]

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

module Main where

    del :: Eq a => [a] -> a -> [a]
    del s x = filter (/= x) s

    solve :: IO ()
    solve = do
        getLine
        s <- getLine
        let a = map (\x -> read x :: Integer) $ words s
        print $ length $ del a $ maximum a

    iter :: Integer -> IO ()
    iter 1 = solve
    iter x = do
        solve
        iter $ x - 1

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


import Data.Bits (xor)

countInv :: [Int] -> Int
countInv [] = 0
countInv (x:xs) = countInv xs `xor` (length (filter (< x) xs) `mod` 2)

process :: Int -> Int -> IO ()
process 0 _ = return ()
process m inv = do
    [l, r] <- fmap (map read . words) getLine
    let c = r - l + 1
    let newInv = inv `xor` ((c * (c - 1) `div` 2) `mod` 2)
    putStrLn $ if newInv == 0 then "even" else "odd"
    process (m - 1) newInv

main :: IO ()
main = do
    n <- readLn :: IO Int
    a <- fmap (map read . words) getLine
    m <- readLn :: IO Int
    let inv = countInv a
    process m inv

main :: IO ()
main = do
    getLine
    nums <- fmap (map read . words) getLine :: IO [Int]
    let isOdd = odd $ countInv nums
    getLine
    invs <- fmap (map readPair . lines) getContents :: IO [(Int, Int)]
    main' isOdd invs
    where
        main' :: Bool -> [(Int, Int)] -> IO ()
        main' _ [] = return ()
        main' isOdd (i:is) = do
            let tmp = process isOdd i
            putStrLn (if tmp then "odd" else "even")
            main' tmp is

readPair :: String -> (Int, Int)
readPair s = let (a:b:_) = map read $ words s
    in (a, b)
process :: Bool -> (Int, Int) -> Bool
process inp (l, r) = case (r-l+1) `div` 2 `mod` 2 of
    0 -> inp
    1 -> not inp

countInv :: [Int] -> Int
countInv nums = countInv' nums 0
    where
        countInv' (n:ns) ans = countInv' ns (ans + sum (map (\x -> if x < n then 1 else 0) ns))
        countInv' _ ans = ans

main :: IO ()
main = do
    getLine
    nums <- fmap (map read . words) getLine :: IO [Int]
    let isOdd = odd $ countInv nums
    getLine
    invs <- fmap (map readPair . lines) getContents :: IO [(Int, Int)]
    main' isOdd invs
    where
        main' :: Bool -> [(Int, Int)] -> IO ()
        main' _ [] = return ()
        main' isOdd (i:is) = do
            let tmp = process isOdd i
            putStrLn (if tmp then "odd" else "even")
            main' tmp is

readPair :: String -> (Int, Int)
readPair s = let (a:b:_) = map read $ words s
    in (a, b)
process :: Bool -> (Int, Int) -> Bool
process inp (l, r) = case (r-l+1) `div` 2 `mod` 2 of
    0 -> inp
    1 -> not inp

countInv :: [Int] -> Int
countInv nums = countInv' nums 0
    where
        countInv' (n:ns) ans = countInv' ns (ans + sum (map (\x -> if x > n then 1 else 0) ns))
        countInv' _ ans = ans

import Data.Bits (xor)

countInv :: [Int] -> Int
countInv [] = 0
countInv (x:xs) = countInv xs + length (filter (< x) xs)

process :: Int -> Int -> IO ()
process 0 _ = return ()
process m inv = do
    [l, r] <- fmap (map read . words) getLine
    let c = r - l + 1
    let newInv = inv `xor` ((c * (c - 1) `div` 2) `mod` 2)
    putStrLn $ if newInv == 0 then "even" else "odd"
    process (m - 1) newInv

main :: IO ()
main = do
    n <- readLn :: IO Int
    a <- fmap (map read . words) getLine
    m <- readLn :: IO Int
    let inv = countInv a
    process m inv


solve :: [Int] -> Int
solve (_ : h : xs) = sum $ map (\x -> if x <= h then 1 else 2) xs

main :: IO ()
main = interact $ show . solve . map read . words

module Main
    where

import System.IO

solve first second =
    foldr (\a s -> s + if a <= h then 1 else 2) 0 friends
    --sum . map (\a -> if a <= h then 1 else 2) $ friends
    where
        h =
            case words first of
                _ : h' : _ ->
                    read h' :: Int
        friends =
            map read . words $ second

main = do
    first <- getLine
    second <- getLine
    print $ solve first second

module Main
    where

import System.IO

solve first second =
    sum . map (\a -> if a <= h then 1 else 2) $ friends
    where
        h =
            case words first of
                _ : h' : _ ->
                    read h' :: Int
        friends =
            map read . words $ second

main = do
    first <- getLine
    second <- getLine
    print $ solve first second

import Control.Monad

sol :: [Int] -> Int -> Int
sol [] h = 0
sol heights h = if (head heights) > h
  then 2 + (sol (tail heights) h)
  else 1 + (sol (tail heights) h)

main :: IO ()
main = do
  [n, h] <- fmap (map read.words) getLine
  heights <- fmap (map read.words) getLine
  print (sol heights h)

module Main where

main :: IO ()
main = do
    [n, h] <- getInts
    as <- getInts
    print $ totWidth h as

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

--totWidth :: Num a => a -> [a] -> a
totWidth _ [] = 0
totWidth h (a : as) = singleWidth h a + totWidth h as

--singleWidth :: Num a => a -> a -> a
singleWidth h a = if a <= h then 1 else 2

test :: Bool
test = totWidth 10 [2, 2, 5] == 3 && totWidth 10 [9, 10, 11, 3] == 5 && totWidth 10 [11, 12, 23, 14] == 8 && totWidth 7 [4, 5, 14] == 4 && totWidth 1 [1, 1, 1, 1, 1, 1] == 6 && totWidth 5 [7, 6, 8, 9, 10, 5] == 11

import Data.Functor

main :: IO()
main = do
    [n, h] <- map read . words <$> getLine
    a <- map read . words <$> getLine
    let m = length $ filter (> h) a
    print $ n + m

conv lst uu
  | (null lst) = uu
  | otherwise = conv (tail lst) (uu ++ [(read (head lst))::Int])

findwidth lst height width
  | (null lst) = width
  | otherwise = if (head lst) > height
                then findwidth (tail lst) height (width + 2)
                else findwidth (tail lst) height (width + 1)

main = do
  ff <- getLine
  gg <- getLine
  let aa = (read (head (words ff)))::Int
      bb = (read (last (words ff)))::Int
      cc = conv (words gg) []

      ans = findwidth cc bb 0
  putStrLn (show ans)

f :: Int -> Int -> Int
f x h =
  if x > h
    then 2
    else 1

result :: [Int] -> Int -> Int
result xs h =
  if null xs
    then 0
    else (f (head xs) h) + result (tail xs) h

main = do
  line <- getLine
  let [n, h] = take 2 (map read $ words line :: [Int])
  line2 <- getLine
  let xs = take n (map read $ words line2 :: [Int])
  let p = result xs h
  print p

main = do
    [n, h] <- fmap (map read . words) getLine
    elems <- fmap (map read . words) getLine
    print (solve h elems)

value :: Int -> Int -> Int
value h x = if x > h then 2 else 1

solve :: Int -> [Int] -> Int
solve h elems = sum (map (value h) elems)

import Data.Char
import Control.Monad

readIntImpl :: Int -> Bool -> IO Int
readIntImpl x flag = do
    c <- getChar
    if c `elem` ['0'..'9']
        then do
            let d = digitToInt c
            y <- readIntImpl (x*10+d) True
            return y
    else if flag
        then
            return x
        else do
            y <- readIntImpl x False
            return y

readInt = readIntImpl 0 False
readArr n readFunc = replicateM n readFunc

main = do
    n <- readInt
    h <- readInt
    arr <- readArr n readInt
    let ans = sum [ if x > h then 2 else 1 | x <- arr]
    putStrLn (show(ans))

main = do
  [n, h] <- fmap (map read . words) getLine
  xs <- fmap (map read . words) getLine :: IO [Int]

  print $ sum $ map (\x -> if x <= h then 1 else 2) xs

solve :: [[Int]] -> Int
solve [[_,h],a] = (length $ filter (<=h) a) + 2*(length $ filter (>h) a)
main = interact $ show . solve . map (map read . words) . take 2 . lines

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

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

main = do
  [n,h] <- fmap (map read . words) getLine
  inp <- fmap (map read . words) getLine
  print $ solve h inp

solve :: Int -> [Int] -> Int
solve h = sum . map f
    where
      f a | a > h = 2
          | otherwise = 1

solve :: Int -> [Int] -> Int
solve h (x:xs) = if x > h then 2 + solve h xs else 1 + solve h xs
solve h _ = 0

main = do
    firstLine <- getLine
    secondLine <- getLine
    let h = read $ (tail $ words firstLine) !! 0
    let friends = map read $ words secondLine
    putStrLn . show $ solve h friends

module Main where

solve (h:xs) = length  $ xs ++ filter (>h) xs

main :: IO ()
main = print . solve . drop 1 . map (read:: String -> Int) . words =<< getContents

module Main where

solve (h:xs) = length (xs ++ filter (>h) xs)

main :: IO ()
main = print . solve . drop 1 . map (read:: String -> Int) . words =<< getContents

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  solve. tail.concat =<< forM [1..2] (\i-> (map (fst.fromJust.C.readInt).C.words) <$> C.getLine)
solve::[Int]->IO ()
solve (x:xs) = print $ foldr (\a b -> if a>x then 2+b else 1+b) 0 xs

import Control.Applicative

solve :: Int -> [Int] -> Int
solve h = sum.fmap f
    where f a
            | a > h = 2
            | otherwise = 1
main = do
    _:h:as <- fmap read.concatMap words.lines <$> getContents
    print $ solve h as

{-#LANGUAGE OverloadedStrings#-}
module Main where
import Data.Text (pack, unpack, splitOn)
main :: IO ()
main = do
    [_,h] <- readInts
    hs <- readInts
    putStrLn $ show (solve h hs)
    where
        readInts :: IO [Int]
        readInts = fmap (map ((read ::String ->Int). unpack)
                    . splitOn " " . pack) getLine

solve :: Int -> [Int] -> Int
solve h = foldr (\x acc -> if x > h then acc + 2 else acc + 1) 0

import Control.Monad

main = readInput >>= putStrLn . show . count

readInput :: IO (Int, [Int])
readInput = liftM2 toTuple getLine getLine
  where toTuple a b = (h, map read $ words b)
          where fstL = words a
                h = read $ fstL !! 1

count :: (Int, [Int]) -> Int
count (h, hs) = foldr (\curr ans -> if h < curr
                                    then ans + 2
                                    else ans + 1)
                      0 hs

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

width :: Int -> Int -> Int
width x h
    | x > h     = 2
    | otherwise = 1

main :: IO ()
main = do
    [n, h] <- (map readInt . words) <$> getLine
    arr <- (map readInt . words) <$> getLine
    let answer = sum . map (`width` h) $ arr
    printf "%d\n" answer

import Control.Monad

main = do
    firstLine <- getLine
    let [_, h] = map read (words firstLine)

    secondLine <- getLine
    let arr = map read (words secondLine)

    print $ sum $ map (process h) arr
        where
            process :: Int -> Int -> Int
            process h a
                | a <= h = 1
                | otherwise = 2

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

main=do
   [a,b]<- map read <$> words <$> getLine ::IO [Int]
   c<- map read <$> words <$> getLine ::IO [Int]
   putStrLn $ show $ (length c) + length (filter (>b) c)

main = print . solve . map read . words =<< getContents
solve (n:h:ns) = length (ns ++ filter (>h) ns :: [Int])

main :: IO ()
main = do
  [n, h] <- map read . words <$> getLine
  a <- map read . words <$> getLine
  print $ solve h a

solve :: Int -> [Int] -> Int
solve h = sum . map f
  where
    f a =
      if a > h
        then 2
        else 1

import Control.Monad
import Control.Applicative

main = do [n, h] <- map read . words <$> getLine
          as <- map read . words <$> getLine
          print $ solve n h as

solve :: Int -> Int -> [Int] -> Int
solve n h as = foldr (+) 0 $ map (\a -> if h < a then 2 else 1) as

import Control.Monad
import Control.Applicative

main = do [n, h] <- map read . words <$> getLine
          as <- map read . words <$> getLine
          print $ solve n h as

solve :: Int -> Int -> [Int] -> Int
solve n h as = n + (length $ filter (\a -> h < a) as)

-- Vicfred
-- https://codeforces.com/problemset/problem/677/A

main :: IO ()
main = do
    [n,h] <- map read . words <$> getLine
    a <- map read . words <$> getLine
    let m = length $ filter (>h) a
    print $ n + m

zabor :: [Int] -> Int -> Int
zabor [] _ = 0
zabor (x:xs) n
    | (x <= n) = 1 + zabor xs n
    | otherwise = 2 + zabor xs n
func :: [String] -> [Int]
func list = map (\x -> read x::Int) list

main :: IO()
main = do
    inputOne <- getLine
    inputTwo <- getLine
    a <- return $ (func $ words inputOne)!!1
    b <- return $ func $ words inputTwo
    putStrLn $ show $ zabor b a

import Control.Applicative( (<$>))
main = do
    tokens <- return . words =<< getContents
    let n:fence:heights = read <$> tokens
    print $ sum $ (\h->if h>fence then 2 else 1) <$> take n heights

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

ans a b c d k  | z >k = "-1"
               | otherwise = show z1 ++ " " ++ show z2

	where 	z1= (div (a-1) c )+1
		z2 = (div (b-1) d) +1
		z= z1+z2

main= do
	   [a,b]<-map read <$> words <$> getLine::IO [Int]
           c<- map read <$> words<$> getLine::IO [Int]
	   let d = length $ filter (>b) c
           print $ a+d

main :: IO ()
main = do
    [n, h] <- map (read :: String -> Int) . words <$> getLine
    print =<< sum . map ((1+) . fromEnum . (h<) . (read :: String -> Int)) . words <$> getLine

getResult _ [] = 0
getResult h (x:xs) = cur + getResult h xs
    where cur = if x > h then 2 else 1

main = do
    nh_ln <- getLine
    nums_ln <- getLine

    let nh = map (read :: String -> Int) (words nh_ln)
    let nums = map (read :: String -> Int) (words nums_ln)

    putStrLn . show $ getResult (nh !! 1) nums

--ghc 7.10

minRoadWidth :: (Ord a, Integral b) => a -> [a] -> b
minRoadWidth h a = sum . map (\x -> if x > h then 2 else 1) $ a

main = do
    nhStr <- getLine
    let [n,h] = map read . words $ nhStr :: [Int]
    aStr <- getLine
    let a = map read .words $ aStr :: [Int]
    print $ minRoadWidth h a

main :: IO ()
main = do
        [[_,h],a] <- readLoL :: IO [[Int]]
        print $ answer h a

answer :: Int -> [Int] -> Int
answer h = sum . fmap (\a -> if a <= h then 1 else 2)

-- Boilerplate
readLoL :: (Read a) => IO [[a]]
readLoL = fmap parseMatrix getContents

parseMatrix :: (Read a) => String -> [[a]]
parseMatrix = (fmap.fmap) read . tokenizeMatrix

tokenizeMatrix :: String -> [[String]]
tokenizeMatrix = fmap words . lines

main = interact $ show . f . tail . map read . words

f :: [Int] -> Int
f (b : xs) = sum (map (\x -> if x > b then 2 else 1) xs)


import Data.List
import Control.Monad

solve :: ([Int], [Int]) -> Maybe [Int]
solve (xs, ys)
  | null is = Nothing
  | otherwise = Just is
  where
    is = xs `intersect` ys

printS :: Maybe [Int] -> IO ()
printS Nothing = putStrLn "NO"
printS (Just (x:_)) = putStrLn "YES" >> putStrLn ("1 " ++ show x)

getTest :: IO ([Int], [Int])
getTest = getLine >> do
  xs <- map read . words <$> getLine
  ys <- map read . words <$> getLine
  return (xs, ys)

main :: IO ()
main = do
  t <- read <$> getLine
  tests <- replicateM t getTest
  mapM_ (printS . solve) tests

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import qualified Data.Set as S

onecase = do
		getLine
		x<- map read <$> words <$> getLine ::IO [Int]
		y<- map read <$> words <$> getLine ::IO [Int]
		let xx = S.fromList x
		let yy = S.fromList y
		let zz = S.intersection xx yy
		putStrLn $ if S.null zz then "NO" else "YES\n1 " ++ show (head (S.elems zz))

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


{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray)

-- road map in reverse, and the number of cities, init pen state
type Road = Map Int (Map Int Int)
type Domain = (Road, Int, IOUArray Int Int, IOUArray Int Bool)
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

pairToElem :: (Int, Int) -> (Int, Map Int Int)
pairToElem (a, b) = (a, Map.singleton b 1)

pairToRevElem :: (Int, Int) -> (Int, Map Int Int)
pairToRevElem (a, b) = (b, Map.singleton a 1)

insertAll :: IOUArray Int Int -> [(Int, Int)] -> IO ()
insertAll arr = mapM_ (uncurry $ writeArray arr)

parse :: IO Domain
parse = do
  [cities, roadsNumber] <- readChar8
  pairs <- replicateM roadsNumber getPair
  visited <- newArray (1,cities) False
  let roads = fromListWith (Map.unionWith (+)) $ pairToElem <$> pairs
  pen <- newArray (1, cities) 0
  insertAll pen $ Map.toList $ ((+1) . sum . Map.elems) <$> roads
  let revRoads = fromListWith (Map.unionWith (+)) $ pairToRevElem <$> pairs
  return $ (revRoads, cities, pen, visited)

-- (dist, target)
dij :: Road -> (Set (Int, Int), IOUArray Int Int, IOUArray Int Bool) -> IO Int
dij roads (a, pen, visited) = go a-- traceShow ((d, i), newPen, que) $
  where
    go ::  Set (Int, Int) -> IO Int
    go que = do
       ((d, i), nQue) <- deleteFindMinNotMeet visited que
       writeArray visited i True
       let children = fromMaybe empty $ roads !? i
       -- reduce children penetration if visiting
       _ <- traverseWithKey (\k v -> writeArray pen k =<< (flip (-) v) <$> readArray pen k) children
       childQue <- mapM (\j -> do
                  c <- readArray pen j
                  return (d + c, j)) $ Map.keys children
       let newQue = union nQue (Set.fromList childQue)
       if i == 1 then return d else go newQue

deleteFindMinNotMeet :: IOUArray Int Bool -> Set (Int, Int) -> IO ((Int, Int), Set (Int, Int))
deleteFindMinNotMeet visited que = do
  flag <- readArray visited i
  if flag then deleteFindMinNotMeet visited nQue else return ans
  where ans@((d, i), nQue) = deleteFindMin que

solve :: Solver
solve (roads, n, pen, visited) = dij roads (Set.singleton (0, n), pen, visited)

main :: IO ()
main = do
  printAns =<< solve =<< parse

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray)

-- road map in reverse, and the number of cities, init pen state
type Road = Map Int (Map Int Int)
type Domain = (Road, Int, IOUArray Int Int, IOUArray Int Bool)
type Dist = Map Int Int
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

pairToElem :: (Int, Int) -> (Int, Map Int Int)
pairToElem (a, b) = (a, Map.singleton b 1)

pairToRevElem :: (Int, Int) -> (Int, Map Int Int)
pairToRevElem (a, b) = (b, Map.singleton a 1)

insertAll :: IOUArray Int Int -> [(Int, Int)] -> IO ()
insertAll arr [] = return ()
insertAll arr ((i, e):xs) = writeArray arr i e >> insertAll arr xs

parse :: IO Domain
parse = do
  [cities, roadsNumber] <- readChar8
  pairs <- replicateM roadsNumber getPair
  -- let [cities, roadsNumber] = [20000,20000]
  -- pairs <- gen
  visited <- newArray (1,cities) False
  let roads = fromListWith (Map.unionWith (+)) $ pairToElem <$> pairs
  pen <- newArray (1, cities) 0
  insertAll pen $ Map.toList $ ((+1) . sum . Map.elems) <$> roads
  let revRoads = fromListWith (Map.unionWith (+)) $ pairToRevElem <$> pairs
  return $ (revRoads, cities, pen, visited)

-- (dist, target)
dij :: Road -> (Set (Int, Int), IOUArray Int Int, IOUArray Int Bool) -> IO Int
dij roads (a, pen, visited) = go a-- traceShow ((d, i), newPen, que) $
  where
    go ::  Set (Int, Int) -> IO Int
    go que = do
       ((d, i), nQue) <- deleteFindMinNotMeet visited que
       writeArray visited i True
       let children = fromMaybe empty $ roads !? i
       _ <- traverseWithKey (\k v -> (\u -> writeArray pen k (u - v)) =<< readArray pen k) children
       childQue <- mapM (\j -> do
                  c <- readArray pen j
                  return (d + c, j)) $  Map.keys children
       let newQue = union nQue (Set.fromList childQue)
       if i == 1 then return d else go newQue

deleteFindMinNotMeet :: IOUArray Int Bool -> Set (Int, Int) -> IO ((Int, Int), Set (Int, Int))
deleteFindMinNotMeet visited que = do
  flag <- readArray visited i
  if flag then deleteFindMinNotMeet visited nQue else return ans
  where ans@((d, i), nQue) = deleteFindMin que

solve :: Solver
solve (roads, n, pen, visited) = dij roads (Set.singleton (0, n), pen, visited)

-- gen :: IO [(Int,Int)]
-- gen = do
--   xs :: [(Int, Int)] <- replicateM 20000 $ liftM2 (,) (randomRIO (1, 2*10^5)) (randomRIO (1, 2*10^5))
--   let path = take 19999 $ zip [1..] [2..]
--   return $ xs ++ path

main :: IO ()
main = do
  printAns =<< solve =<< parse

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)

-- road map in reverse, and the number of cities, init pen state
type Road = Map Int (Map Int Int)
type Domain = (Road, Int, Dist)
type Dist = Map Int Int
type CoDomain = Int
type Solver  = Domain -> CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

pairToElem :: (Int, Int) -> (Int, Map Int Int)
pairToElem (a, b) = (a, Map.singleton b 1)

pairToRevElem :: (Int, Int) -> (Int, Map Int Int)
pairToRevElem (a, b) = (b, Map.singleton a 1)

parse :: IO Domain
parse = do
  [cities, roadsNumber] <- readChar8
  pairs <- replicateM roadsNumber getPair
  let roads = fromListWith (Map.unionWith (+)) $ pairToElem <$> pairs
  let revRoads = fromListWith (Map.unionWith (+)) $ pairToRevElem <$> pairs
  return $ (revRoads, cities, ((+1) . sum . Map.elems) <$> roads)

-- (dist, target)
dij :: Road -> (Set (Int, Int), Dist, Set Int) -> Int
dij roads (que, pen, visited) = -- traceShow ((d, i), newPen, que) $
  if i == 1 then d else dij roads (newQue, newPen, Set.insert i visited)
  where ((d, i), nQue) = deleteFindMinNotMeet visited que
        children = Map.filter (`Set.notMember` visited) $ fromMaybe empty $ roads !? i
        childrenSet = Set.fromList $ Map.keys children
        newPen = Map.unionWith (-) pen children
        newQue = union (Set.map (\j -> (d + findWithDefault 0 j newPen, j)) childrenSet) nQue

deleteFindMinNotMeet :: Set Int -> Set (Int, Int) -> ((Int, Int), Set (Int, Int))
deleteFindMinNotMeet visited que = if i `Set.notMember` visited then ans else deleteFindMinNotMeet visited nQue
  where ans@((d, i), nQue) = deleteFindMin que

solve :: Solver
solve (roads, n, pen) = dij roads (Set.singleton (0, n), pen, Set.empty)

main :: IO ()
main = printAns <$> solve =<< parse


import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

testCase :: IO a -> IO ()
testCase f = do
  t <- read <$> getLine
  replicateM_ t f

main = testCase $ do
  [a0, a1, a2] <- map read . words <$> getLine
  [b0, b1, b2] <- map read . words <$> getLine
  print $ 2 * (min a2 b1 - max (b2 - max (a2 - b1) 0 - a0) 0)

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> [Int] -> Int
solve a b = 2 * a2b1min - 2 * fuck
    where
        a2b1min = min a2 b1
        fuck = min mya1 myb2
        a0 = head a
        a1 = last $ take 2 a
        a2 = last a
        b0 = head b
        b1 = last $ take 2 b
        b2 = last b
        mya1 = a1 - min a1 b0
        myb2 = b2 - min a0 b2

deal :: IO()
deal = do
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    putStrLn $ show $ solve a b

main :: IO()
main = getLine >>= flip replicateM_ deal . read

import Control.Monad (replicateM_)

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [x1, y1, z1] <- map read . words <$> getLine :: IO [Int]
    [x2, y2, z2] <- map read . words <$> getLine
    let
      plus = min z1 y2 -- greedily pair a-2s with b-1s
      soaks = x1 + z1 - plus -- options for wasting a b-2
      minus = max 0 $ z2 - soaks
    print $ 2 * (plus - minus)

module Main where

import Control.Monad

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    let readSeq = fmap read . words <$> getLine
    firstSeq <- readSeq
    secondSeq <- readSeq
    print $ solve firstSeq secondSeq

solve :: [Int] -> [Int] -> Int
solve [x1, y1, z1] [x2, y2, z2] =
  let a = min z1 y2 -- number of pairs (2, 1)
      b = y1 - (x2 + y2 - a) -- minimum number of pairs (1, 2)
   in 2 * (a - max b 0)

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> [Int] -> Int
solve a b = 2 * a2b1min - 2 * fuck
    where
        a2b1min = min a2 b1
        fuck = min mya1 myb2
        a0 = head a
        a1 = last $ take 2 a
        a2 = last a
        b0 = head b
        b1 = last $ take 2 b
        b2 = last b
        mya1 = a1 - min a1 a0
        myb2 = b2 - min a0 b2

deal :: IO()
deal = do
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    putStrLn $ show $ solve a b

main :: IO()
main = getLine >>= flip replicateM_ deal . read

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> [Int] -> Int
solve a b = 2 * a2b1min
    where
        a2b1min = min a2 b1
        a2 = last a
        b1 = last $ take 2 b

deal :: IO()
deal = do
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    putStrLn $ show $ solve a b

main :: IO()
main = getLine >>= flip replicateM_ deal . read

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> [Int] -> Int
solve a b = 2 * a2b1min - 2 * fuck
    where
        a2b1min = min a2 b1
        fuck = min a1 b2 - min paira1  pairb2
        a0 = head a
        a1 = last $ take 2 a
        a2 = last a
        b0 = head b
        b1 = last $ take 2 b
        b2 = last b
        paira1 = min a1 b0
        pairb2 = min a0 b2

deal :: IO()
deal = do
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    putStrLn $ show $ solve a b

main :: IO()
main = getLine >>= flip replicateM_ deal . read


import Control.Monad ( when, forM_, replicateM_ )
import Data.Array.IO
    ( IOArray, readArray, writeArray, MArray(newArray) )
import Data.Array (assocs, listArray, (!))
import Data.Array.Unsafe (unsafeFreeze)
import System.IO
    ( hSetBuffering,
      stdout,
      BufferMode(BlockBuffering) )
import Text.Printf (printf)
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

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

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

erat stop = do
  sieve <- newArray (2, stop) True::IO (IOArray Int Bool)
  forM_ [2..stop] $ \idx ->
    do
      isPrime <- readArray sieve idx
      when isPrime $
           forM_ [idx*2, idx*3 .. stop] $ \k ->
             writeArray sieve k False
  pure sieve

primes max = [n | (n, isPrime) <- assocs . unsafePerformIO $ erat max >>= unsafeFreeze, isPrime]

modU = 1000000007

maxPrime = 8000
allPrimes = listArray (0::Int, length genPrimes - 1) genPrimes
  where
    genPrimes = primes maxPrime

readInt::String -> Int
readInt = read

solve = do
  [n] <- getInts
  forM_ [0..(n - 1)] $ \idx ->
    printf "%d " $ allPrimes!idx
  printf "\n"

main = do
  hSetBuffering stdout $ BlockBuffering(Just 50)
  [t] <- getInts
  replicateM_ t solve

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.Array.IO
import Data.Array (assocs, listArray, (!))
import Data.Array.Unsafe (unsafeFreeze)
import GHC.IO (unsafePerformIO)
import Text.Printf (printf)
import System.IO (hSetBuffering, stdout, BufferMode (BlockBuffering))

erat stop = do
  sieve <- newArray (2, stop) True::IO (IOArray Int Bool)
  forM_ [2..stop] $ \idx ->
    do
      isPrime <- readArray sieve idx
      when isPrime $
           forM_ [idx*2, idx*3 .. stop] $ \k ->
             writeArray sieve k False
  pure sieve

primes max = [n | (n, isPrime) <- assocs . unsafePerformIO $ erat max >>= unsafeFreeze, isPrime]

modU = 1000000007

maxPrime = 8000
allPrimes = listArray (0::Int, (length genPrimes) - 1) $ genPrimes
  where
    genPrimes = primes maxPrime

readInt::String -> Int
readInt = read

solve = do
  n <- fmap readInt getLine
  forM_ [0..(n - 1)] $ \idx ->
    printf "%d " $ allPrimes!idx
  printf "\n"

main = do
  -- hSetBuffering stdout $ BlockBuffering(Just 0x186A0)
  t <- fmap readInt getLine
  replicateM_ t solve

module Main where
import Control.Monad
import Data.List
main = do
  n <- read <$> getLine
  replicateM_ n $ do
    m <- read <$> getLine
    putStrLn . intercalate " " . fmap show $ [2..m+1]

import Control.Arrow ((>>>))
import Control.Monad (forM_, replicateM_, when)
import Data.Array (assocs, listArray, (!))
import Data.Array.ST (runSTArray, newArray, readArray, writeArray)
import Data.Array.Unsafe (unsafeFreeze)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import System.IO
  ( BufferMode (BlockBuffering),
    hSetBuffering,
    stdout,
  )
import System.IO.Unsafe (unsafePerformIO)
import Text.Printf (printf)

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

erat stop =
  runSTArray $
    newArray (2, stop) True
      >>= \sieve ->
        mapM_
          ( \idx ->
              readArray sieve idx
                >>= \isPrime ->
                  when isPrime $
                    mapM_
                      (\k -> writeArray sieve k False)
                      [idx * 2, idx * 3 .. stop]
          )
          [2 .. stop]
          >> return sieve

primes max = [n | (n, isPrime) <- assocs (erat max), isPrime]

modU = 1000000007

maxPrime = 8000
allPrimes = listArray (0::Int, length genPrimes - 1) genPrimes
  where
    genPrimes = primes maxPrime

solve n = C.pack . unwords $ fmap (show . (allPrimes!)) [0..(n-1)]

main = C.interact $ C.lines >>> drop 1 >>> map (solve . parseInt) >>> C.unlines

import Control.Monad ( when, forM_, replicateM_ )
import Data.Array.IO
    ( IOArray, readArray, writeArray, MArray(newArray) )
import Data.Array (assocs, listArray, (!))
import Data.Array.Unsafe (unsafeFreeze)
import System.IO
    ( hSetBuffering,
      stdout,
      BufferMode(BlockBuffering) )
import Text.Printf (printf)
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import Control.Arrow ((>>>))

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

erat stop = do
  sieve <- newArray (2, stop) True::IO (IOArray Int Bool)
  forM_ [2..stop] $ \idx ->
    do
      isPrime <- readArray sieve idx
      when isPrime $
           forM_ [idx*2, idx*3 .. stop] $ \k ->
             writeArray sieve k False
  pure sieve

primes max = [n | (n, isPrime) <- assocs . unsafePerformIO $ erat max >>= unsafeFreeze, isPrime]

modU = 1000000007

maxPrime = 8000
allPrimes = listArray (0::Int, length genPrimes - 1) genPrimes
  where
    genPrimes = primes maxPrime

solve n = C.pack . unwords $ fmap (show . (allPrimes!)) [0..(n-1)]

main = C.interact $ C.lines >>> drop 1 >>> map (solve . parseInt) >>> C.unlines

import Control.Arrow ((>>>))
import Control.Monad (forM_, replicateM_, when)
import Data.Array (assocs, listArray, (!))
import Data.Array.ST (runSTArray, newArray, readArray, writeArray)
import Data.Array.Unsafe (unsafeFreeze)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import System.IO
  ( BufferMode (BlockBuffering),
    hSetBuffering,
    stdout,
  )
import System.IO.Unsafe (unsafePerformIO)
import Text.Printf (printf)

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

erat stop =
  runSTArray $
    newArray (2, stop) True
      >>= \sieve ->
        mapM_
          ( \idx ->
              readArray sieve idx
                >>= \isPrime ->
                  when isPrime $
                    mapM_
                      (\k -> writeArray sieve k False)
                      [idx * 2, idx * 3 .. stop]
          )
          [2 .. stop]
          >> return sieve

primes max = [n | (n, isPrime) <- assocs (erat max), isPrime]

modU = 1000000007

maxPrime = 8000

allPrimes = listArray (0 :: Int, length genPrimes - 1) genPrimes
  where
    genPrimes = primes maxPrime

solve n = C.pack . unwords $ fmap (show . (allPrimes !)) [0 .. (n -1)]

main = C.interact $ C.lines >>> map (solve . parseInt) >>> C.unlines


main :: IO()
main = getContents >>= mapM_ print . solve . lines

solve :: [String] -> [Int]
solve (x:xs) =
    let n = head (map read (words x))
        grids = map (map read . words) (take n xs)
        rounds = map (map read . words) (drop n xs)
        scores = map row_score grids
    in solve' grids scores rounds
        where
            solve' :: [[Int]] -> [Int] -> [[Int]] -> [Int]
            solve' _  _ [] = []
            solve' grids scores ([x,y]:xs) =
                let (new_grids, new_scores, val) = (solve_at grids scores x y)
                in val:(solve' new_grids new_scores xs)

            row_score :: [Int] -> Int
            row_score x = row_score' x 0

            row_score' :: [Int] -> Int -> Int
            row_score' [] cnt = cnt
            row_score' (x:xs) cnt | x == 1 = row_score' xs (cnt+1)
                                  | otherwise = max cnt (row_score' xs 0)

            solve_at :: [[Int]] -> [Int] -> Int -> Int -> ([[Int]], [Int], Int)
            solve_at grids scores x y =
                let new_grids = update_grid grids x y 1
                    new_scores = update_score new_grids scores x 1
                in (new_grids, new_scores, (max_score new_scores))

            update_grid :: [[Int]] -> Int -> Int -> Int -> [[Int]]
            update_grid [] _ _ _ = []
            update_grid (g:gs) x y r | x == r = (update_row g y 1):(update_grid gs x y (r+1))
                                     | otherwise = g:(update_grid gs x y (r+1))

            update_score :: [[Int]] -> [Int] -> Int -> Int -> [Int]
            update_score [] [] _ _ = []
            update_score (g:gs) (s:ss) x r | x == r = (row_score g):(update_score gs ss x (r+1))
                                           | otherwise = s:(update_score gs ss x (r+1))

            max_score :: [Int] -> Int
            max_score [] = 0
            max_score (x:xs) = max x (max_score xs)

            update_row :: [Int] -> Int -> Int -> [Int]
            update_row [] _ _ = []
            update_row (x:xs) y c | y == c = (1-x):(update_row xs y (c+1))
                                  | otherwise = x:(update_row xs y (c+1))

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine :: IO [Int]
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- getInts
  as <- replicateM n $ map read . words <$> getLine :: IO [[Int]]

  a <- newListArray ((1, 1), (n, m)) $ concat as :: IO (IOUArray (Int, Int) Int)
  let
    f x = if null ls then 0 else maximum ls
      where ls = map length . filter (\g -> head g == 1) $ group x

  ms <- newListArray (1, n) $ map f as :: IO (IOUArray Int Int)

  replicateM q (do
    [i, j] <- getInts
    v <- readArray a (i, j)
    writeArray a (i, j) (1-v)

    c <- f <$> mapM (\j -> readArray a (i, j)) [1..m]
    writeArray ms i c

    m <- maximum <$> mapM (readArray ms) [1..n]
    print m
    )

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine :: IO [Int]
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- getInts
  as <- replicateM n $ map read . words <$> getLine :: IO [[Int]]

  a <- newListArray ((1, 1), (n, m)) $ concat as :: IO (IOUArray (Int, Int) Int)
  let
    f x = if null ls then 0 else maximum ls
      where ls = map length . filter (\g -> head g == 1) $ group x

  ms <- newListArray (1, n) $ map f as :: IO (IOUArray Int Int)

  replicateM q (do
    [i, j] <- getInts
    v <- readArray a (i, j)
    writeArray a (i, j) (1-v)

    c <- readArray ms i
    writeArray ms i (c-v+(1-v))

    m <- maximum <$> mapM (readArray ms) [1..n]
    print m
    )

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine :: IO [Int]
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- getInts
  as <- replicateM n $ map read . words <$> getLine :: IO [[Int]]

  a <- newListArray ((1, 1), (n, m)) $ concat as :: IO (IOArray (Int, Int) Int)

  replicateM q (do
    [i, j] <- getInts
    readArray a (i, j) >>= \v -> writeArray a (i, j) (1-v)

    s <- maximum <$> mapM (\i -> sum <$> mapM (\j -> readArray a (i, j)) [1..m]) [1..n]
    print s
    )

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine :: IO [Int]
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- getInts
  as <- replicateM n $ map read . words <$> getLine :: IO [[Int]]

  a <- newListArray ((1, 1), (n, m)) $ concat as :: IO (IOArray (Int, Int) Int)

  replicateM q (do
    [i, j] <- getInts
    readArray a (i, j) >>= \v -> writeArray a (i, j) (1-v)

    s <- maximum <$> mapM (\i -> maximum . map length . group <$> mapM (\j -> readArray a (i, j)) [1..m]) [1..n]
    print s
    )


import Control.Monad

main = do
    q <- readInt
    submain q
    return q

readInt = do
    raw_q <- getLine
    let q = read raw_q :: Int
    return q

readlist = do
    inp <- getLine
    let v = words inp
    let ret = map read v
    return ret

submain:: Int -> IO ()
submain q = do
    when (q > 0) $ do
        sz <- readInt
        v <- readlist
        putStrLn $ if (solve v sz) then "YES" else "NO"
        submain $ q - 1
        return ()

solve :: [Int] -> Int -> Bool
solve [] _ = False
solve v sz = cw (+) v sz || cw (-) v sz

cw :: (Int -> Int -> Int) -> [Int] -> Int -> Bool
cw _ [] _        = True
cw _ (x:[]) _    = True
cw f (x:y:xs) sz = nextTerm && (toNext || toFirst)
    where nextTerm = cw f (y:xs) sz
          toNext = y == (f x 1)
          toFirst = y == (f x (1 - sz))

data Point = Point Float Float
myfun p1 p2 = distance p1 p2
distance (Point x1 y1) (Point x2 y2) =
    sqrt $ dx * dx + dy * dy
    where dx = x1 - x2
          dy = y1 - y2

import Control.Monad

readInt :: String -> Int
readInt = read

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

printLines :: [String] -> IO ()
printLines x = mapM_ putStrLn x

readLines :: Int -> IO [String]
readLines x = replicateM x $
  do
    _ <- getLine
    getLine

oneGreater x y = y == x + 1

isPerm :: Int -> [Int] -> Bool
isPerm _ [] = True
isPerm _ [x] = True
isPerm len (x:y:xs) = (x `mod` len) + 1 == y && isPerm len (y:xs)

check :: [Int] -> Bool
check list = a || b
  where a = isPerm (length list) list
        b = isPerm (length list) $ reverse list

getList :: String -> [Int]
getList x = map read (words x)

main = do
  q <- getLine
  input <- readLines (readInt q)
  printLines $ map yesno $ map (check . getList) input

import Control.Monad

readInt :: String -> Int
readInt = read

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

printLines :: [String] -> IO ()
printLines x = mapM_ putStrLn x

readLines :: Int -> IO [String]
readLines x = replicateM x $
  do
    _ <- getLine
    getLine

oneGreater x y = y == x + 1

wraps len x y = x == len - 1 && y == 1

isPerm :: Int -> [Int] -> Bool
isPerm _ [] = True
isPerm _ [x] = True
isPerm len (x:y:xs) = (oneGreater x y || wraps len x y) && isPerm len xs

check :: [Int] -> Bool
check list = a || b
  where a = isPerm (length list) list
        b = isPerm (length list) $ reverse list

getList :: String -> [Int]
getList x = map read (words x)

main = do
  q <- getLine
  input <- readLines (readInt q)
  printLines $ map yesno $ map (check . getList) input


--
-- 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-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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
        s   <- getLine
        [w] <- ri
        return (s, w)
    mapM_ (putStrLn.solve) tcs

solve (s,w) = map fst . L.sortOn snd . drop delCnt $ wi
  where
    wi = L.sortBy (flip compare) . (`zip`inds) $ s

    psums = scanl add 0 wi  where  add n (c,_) = n + (1 + (ord c - ord 'a'))

    cost = last psums
    delCost = cost - w

    delCnt = fromJust . L.findIndex (>=delCost) $ psums

inds = [1..] :: [Int]

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

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

--

import Data.Char
import Data.List
import qualified Data.Map.Strict as M

solve :: (C.ByteString, Int) -> C.ByteString
solve (s, p) = C.pack $ map (\x -> chr $ x + ord 'a' - 1) res
 where
  s' = map (\c -> 1 + ord c - ord 'a') $ C.unpack s
  ogLocs = M.fromListWith (++) [(x, [i]) | (x, i) <- zip s' [0 ..]]

  rm [] = Nothing
  rm [_] = Nothing
  rm (x : xs) = Just xs

  work ls c
    | c <= p = ls
    | otherwise = case M.lookupMax ls of
      Just (x, _) -> work (M.update rm x ls) (c - x)
      Nothing -> ls
  finalLocs = work ogLocs (sum s')

  res = map fst $ sortOn snd [(x, i) | (x, is) <- M.toList finalLocs, i <- is]

input :: Scanner (C.ByteString, Int)
input = (,) <$> bstr <*> int

output :: C.ByteString -> C.ByteString
output = id

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

-- Scanner

type Scanner = State [C.ByteString]

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

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

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

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

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

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

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

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

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x

-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: String -> Int -> String
solve s p = solve'
    where
        maxA :: Int
        maxA = ord 'z' - ord 'a' + 1

        priceC :: Char -> Int
        priceC c = ord c - ord 'a' + 1

        sortedC :: [Char]
        sortedC = reverse $ sort s

        sPrice :: Int
        sPrice = sum . map priceC $ s

        finalStringChars :: [Char]
        finalStringChars = finalStringChars' (sPrice - p) sortedC

        finalStringChars' :: Int -> [Char] -> [Char]
        finalStringChars' price cs | price <= 0 = cs
        finalStringChars' price (c:otherCs) = finalStringChars' (price - priceC c) otherCs

        solve' :: String
        solve' = ST.runST $ do
            cntA <- MA.newArray (1, maxA) 0 :: ST.ST s (STA.STUArray s Int Int)
            forM_ finalStringChars $ \c -> do
                modifyArray cntA (priceC c) succ

            flip S.execStateT ([] :: String) $ do
                forM_ (reverse s) $ \c -> do
                    cnt <- T.lift $ MA.readArray cntA (priceC c)
                    M.when (cnt > 0) $ do
                        T.lift $ modifyArray cntA (priceC c) pred
                        S.modify (c:)
                        return ()

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        s <- B8.getLine <&> B8.unpack . head . B8.words
        p <- B8.getLine <&> readIntB8
        let answer = solve s p
        B8.putStrLn $ B8.pack answer