import Control.Arrow ((>>>))
import Data.Bool (bool)
import Data.List (tails, inits)

main :: IO ()
main =
  interact $
    words
      >>> drop 1
      >>> chunksOf 2
      >>> map (solve >>> bool "No" "Yes")
      >>> unlines

solve :: [String] -> Bool
solve [s, t] = t `elem` concatMap (map (take n) . tails) [p ++ tail (reverse p) | p <- inits s, not . null $ p]
  where
    n = length t

-- Template --
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [q] <- readInts
  replicateM_ q $ do
    s <- P.unpack <$> readLine
    t <- P.unpack <$> readLine
    let  opts = [v ++ drop 1 (reverse si) | si <- inits s, v <- tails si]
    lift $ B.hPutBuilder stdout $ if  any (t `isPrefixOf`) opts
      then  B.string7 "YES\n"
      else  B.string7 "NO\n"

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 (replicateM_)
import Data.List (inits, tails, isPrefixOf)

allPaths :: String -> [String]
allPaths s = [suffs ++ drop 1 (reverse prefs) |
  prefs <- inits s,
  suffs <- tails prefs
  ]

main :: IO ()
main = do
  q <- readLn
  replicateM_ q $ do
    s <- getLine
    t <- getLine
    let paths = allPaths s
    putStrLn $ if any (t `isPrefixOf`) paths
      then "YES" else "NO"


    import qualified Data.ByteString.Char8 as BS
    import Control.Monad
    import Data.Array.IO
    import Data.List
    import Data.Maybe
    import System.IO
    import System.IO.Unsafe

    deb s e = unsafePerformIO $ do
        hPutStrLn stderr s
        return e

    parseInt = fst . fromJust . BS.readInt
    parseInteger = fst . fromJust . BS.readInteger

    solve :: Int -> [(Int, Char, Int)] -> [(Int, Int)]
    solve n uws =
        let
            ws = sort uws
        in
            go ws []
        where
            go :: [(Int, Char, Int)] -> [(Int, Int)] -> [(Int, Int)]
            go [] [] = []
            go [] [_] = []
            go [] ((x,i):(y,j):ss) =
                let
                    k = (2*n-x-y) `div` 2
                in
                    (k,i) : (k,j) : go [] ss
            go ((x, d, i):ws) ss
                | d == 'R' = go ws ((x,i):ss)
                | d == 'L' =
                    case ss of
                        [] ->
                            go ws ((-x,i):ss)
                        ((y,j):ss) ->
                            let
                                k = (x-y) `div` 2
                            in
                                (k,i) : (k,j) : go ws ss

    main = do
        tn <- parseInt <$> BS.getLine
        forM_ [1..tn] (\_ -> do
            [m, n] <- map parseInt . BS.words <$> BS.getLine
            xs <- map parseInt . BS.words <$> BS.getLine
            ds <- map BS.head . BS.words <$> BS.getLine
            let w = zip3 xs ds [0::Int ..]
                (w0, w1) = partition (\(x,_,_) -> even x) w
                r0 = solve n w0
                r1 = solve n w1
            r <- newArray (0, m-1) (-1) :: IO (IOUArray Int Int)
            forM_ (r0 ++ r1) (\(x, i) -> writeArray r i x)

            putStrLn . unwords . map show =<< getElems r
         )

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: Int -> [(Int, Char, Int)] -> [(Int, Int)]
solve n uws =
    let
        ws = sort uws
    in
        go ws []
    where
        go :: [(Int, Char, Int)] -> [(Int, Int)] -> [(Int, Int)]
        go [] [] = []
        go [] [_] = []
        go [] ((x,i):(y,j):ss) =
            let
                k = (2*n-x-y) `div` 2
            in
                (k,i) : (k,j) : go [] ss
        go ((x, d, i):ws) ss
            | d == 'R' = go ws ((x,i):ss)
            | d == 'L' =
                case ss of
                    [] ->
                        go ws ((-x,i):ss)
                    ((y,j):ss) ->
                        let
                            k = (x-y) `div` 2
                        in
                            (k,i) : (k,j) : go ws ss

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        [m, n] <- map parseInt . BS.words <$> BS.getLine
        xs <- map parseInt . BS.words <$> BS.getLine
        ds <- map BS.head . BS.words <$> BS.getLine
        let w = zip3 xs ds [0::Int ..]
            (w0, w1) = partition (\(x,_,_) -> even x) w
            r0 = solve n w0
            r1 = solve n w1
            r = elems $ runSTUArray $ do
                ra <- newArray (0, m-1) (-1)
                forM_ (r0 ++ r1) (\(x, i) -> writeArray ra i x)
                return ra
        putStrLn . unwords . map show $ r

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: Int -> [(Int, Char, Int)] -> [(Int, Int)]
solve n uws =
    let
        ws = sort uws
    in
        go ws []
    where
        go :: [(Int, Char, Int)] -> [(Int, Int)] -> [(Int, Int)]
        go [] [] = []
        go [] [_] = []
        go [] ((x,i):(y,j):ss) =
            let
                k = (2*n-x-y) `div` 2
            in
                (k,i) : (k,j) : go [] ss
        go ((x, d, i):ws) ss
            | d == 'R' = go ws ((x,i):ss)
            | d == 'L' =
                case ss of
                    [] ->
                        go ws ((-x,i):ss)
                    ((y,j):ss) ->
                        let
                            k = (x-y) `div` 2
                        in
                            (k,i) : (k,j) : go ws ss

main = do
    tn <- parseInt <$> BS.getLine
    forM_ [1..tn] (\_ -> do
        [m, n] <- map parseInt . BS.words <$> BS.getLine
        xs <- map parseInt . BS.words <$> BS.getLine
        ds <- map BS.head . BS.words <$> BS.getLine
        let w = zip3 xs ds [0::Int ..]
            (w0, w1) = partition (\(x,_,_) -> even x) w
            r0 = solve n w0
            r1 = solve n w1
            r = elems $ runSTUArray $ do
                ra <- newArray (0, m-1) (-1)
                forM_ (r0 ++ r1) (\(x, i) -> writeArray ra i x)
                return ra
        putStrLn . unwords . map show $ r
     )

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Data.Array.IO
import Data.List
import Data.Maybe
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: Int -> [(Int, Char, Int)] -> [(Int, Int)]
solve n uws =
    let
        ws = sort uws
    in
        go ws []
    where
        go :: [(Int, Char, Int)] -> [(Int, Int)] -> [(Int, Int)]
        go [] [] = []
        go [] [_] = []
        go [] ((x,i):(y,j):ss) =
            let
                k = (2*n-x-y) `div` 2
            in
                (k,i) : (k,j) : go [] ss
        go ((x, d, i):ws) ss
            | d == 'R' = go ws ((x,i):ss)
            | d == 'L' =
                case ss of
                    [] ->
                        go ws ((-x,i):ss)
                    ((y,j):ss) ->
                        let
                            k = (x-y) `div` 2
                        in
                            (k,i) : (k,j) : go ws ss

main = do
    tn <- parseInt <$> BS.getLine
    forM_ [1..tn] (\_ -> do
        [m, n] <- map parseInt . BS.words <$> BS.getLine
        xs <- map parseInt . BS.words <$> BS.getLine
        ds <- map BS.head . BS.words <$> BS.getLine
        let w = zip3 xs ds [0::Int ..]
            (w0, w1) = partition (\(x,_,_) -> even x) w
            r0 = solve n w0
            r1 = solve n w1
        r <- newArray (0, m-1) (-1) :: IO (IOArray Int Int)
        forM_ (r0 ++ r1) (\(x, i) -> writeArray r i x)

        putStrLn . unwords . map show =<< getElems r
     )


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

main = do
  getLine
  as <- sort . map read . words <$> getLine :: IO [Integer]
  print $ minimum $
    takeWhile
      (<= sum as)
      [ sum $ abs <$> zipWith (-) as (iterate (* c) 1)
        | c <- [1 ..]
      ]

import Data.List ( sort, foldl' )

cost :: [Integer] -> Integer -> (Integer, Integer)
cost li c = let
  inp = zip li $ iterate (* c) 1
  fun (p, q) (val, tar) = let
    diff = tar - val
    in  seq p $ seq q $ (p + max 0 diff, q - min 0 diff)
  in  foldl' fun (0, 0) inp

-- no need to special-case n=1 or n=2 for performance reasons since n>=3
solve :: [Integer] -> Integer
solve li = let
  sli = sort li
  (c1, c2) = cost sli 1
  fun x k = let
    (p, q) = cost sli k
    in  if  x < p  then  x  else  fun (min x $ p + q) (k+1)
  in  fun (c1 + c2) 2

main :: IO ()
main = do
  _nStr <- getLine
  li <- map read . words <$> getLine
  print (solve li)

import Data.List ( sort, foldl' )

cost :: [Integer] -> Integer -> (Integer, Integer)
cost li c = let
  inp = zip li $ iterate (* c) 1
  fun (p, q) (val, tar) = let
    diff = tar - val
    in  seq p $ seq q $ (p + max 0 diff, q - min 0 diff)
  in  foldl' fun (0, 0) inp

-- no need to special-case n=1 or n=2 for performance reasons since n>=3
solve :: [Integer] -> Integer
solve li = let
  sli = sort li
  (c1, c2) = cost sli 1
  fun x k = let
    (p, q) = cost li k
    in  if  x < p  then  x  else  fun (min x $ p + q) (k+1)
  in  fun (c1 + c2) 2

main :: IO ()
main = do
  _nStr <- getLine
  li <- map read . words <$> getLine
  print (solve li)


{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (nk : l : rest) = itoline (solve (last $ linetois nk) (linetois l)) : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: Int -> [Int] -> Integer
solve k as  =  1 + toInteger m + toInteger k * (toInteger mc - 1) where
  (mc,m) = if null l then (1,-1) else maximum l
  l = [(length t, head t)  | t <- group $ sort $ [(k - (a `mod` k)) `mod` k | a <- as, a `mod` k /= 0]]

import Control.Monad
import Data.IntMap
import Data.List
import Data.Tuple

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [_,k] <- fmap read . words <$> getLine
    a <- fmap swap . toList . fromListWith (+) . fmap (\x -> (x,1)) . mfilter ((/=) 0) . fmap (\x -> mod (k - mod x k) k) . fmap read . words <$> getLine
    print $ if a == [] then 0 else let (c,m) = maximum a in (fromIntegral c - 1) * fromIntegral k + fromIntegral m + 1

import Control.Monad
import Data.List

main = do
    p <- read <$> getLine :: IO Int
    replicateM_ p solveCase
solveCase = do
    [n,k] <- fmap read . words <$> getLine :: IO [Integer]
    as <- fmap read . words <$> getLine :: IO [Integer]
    solveCaseP k as
solveCaseP k as = let as' = fmap (\a -> k - a)
                          . dropWhile (== 0)
                          . sort
                          $ fmap (\a -> a `mod` k) as
                      (b,c) = if null as' then (1,-1) else findPlurality as'
                  in print $ k*(b-1)+(c+1)

findPlurality as = (\a -> (fromIntegral (length a), head a))
                   . foldl1' (\a b -> if length a >= length b then a else b)
                   $ group as

import Control.Monad
import Data.IntMap
import Data.List
import Data.Tuple

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n,k] <- fmap read . words <$> getLine
    a <- fmap swap . toList . fromListWith (+) . fmap (\x -> (x,1)) . mfilter ((/=) 0) . fmap (\x -> mod (k - mod x k) k) . fmap read . words <$> getLine
    print $ if a == [] then 0 else let (c,m) = maximum a in (fromIntegral c - 1) * k + fromIntegral m + 1

import Control.Monad
import Data.IntMap
import Data.List
import Data.Tuple

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n,k] <- fmap read . words <$> getLine
    a <- fmap swap . toList . fromListWith (+) . fmap (\x -> (x,1)) . mfilter ((/=) 0) . fmap (\x -> mod (k - mod x k) k) . fmap read . words <$> getLine
    print $ if a == [] then 0 else let (c,m) = maximum a in (c - 1) * k + m + 1

import Control.Monad
import Data.IntMap
import Data.List
import Data.Tuple

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n,k] <- fmap read . words <$> getLine
    (c,m) <- maximum . fmap swap . toList . fromListWith (+) . fmap (\x -> (mod (k - mod x k) k,1)) . fmap read . words <$> getLine
    print $ (c - 1) * k + m + 1

import Control.Monad
import Data.List

main = do
    p <- read <$> getLine :: IO Int
    replicateM_ p solveCase
solveCase = do
    [n,k] <- fmap read . words <$> getLine :: IO [Int]
    as <- fmap read . words <$> getLine :: IO [Int]
    solveCaseP n k as
solveCaseP n k as = let as' = fmap (\a -> k - a)
                            . dropWhile (== 0)
                            . sort
                            $ fmap (\a -> a `mod` k) as
                        (b,c) = if null as' then (1,-1) else findPlurality as'
                    in print $ k*(b-1)+(c+1)

findPlurality as = (\a -> (length a, head a))
                   . foldl1' (\a b -> if length a >= length b then a else b)
                   $ group as

import Control.Monad
import Data.List

main = do
    p <- read <$> getLine :: IO Int
    print p
    replicateM_ p solveCase
solveCase = do
    [n,k] <- fmap read . words <$> getLine :: IO [Int]
    as <- fmap read . words <$> getLine :: IO [Int]
    solveCaseP n k as
solveCaseP n k as = let as' = fmap (\a -> k - a)
                            . dropWhile (== 0)
                            . sort
                            $ fmap (\a -> a `mod` k) as
                        (b,c) = if null as' then (1,-1) else findPlurality as'
                    in print $ k*(b-1)+(c+1)

findPlurality as = (\a -> (length a, head a))
                   . foldl1' (\a b -> if length a >= length b then a else b)
                   $ group as

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (nk : l : rest) = itoline (solve (last $ linetois nk) (linetois l)) : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: Int -> [Int] -> Int
solve k as  =  1 + m + k * (mc - 1) where
  (mc,m) = if null l then (1,-1) else maximum l
  l = [(length t, head t)  | t <- group $ sort $ [(k - (a `mod` k)) `mod` k | a <- as, a `mod` k /= 0]]


getinp :: IO [Int]
getinp = map read . words <$> getLine

do_solve :: Int -> IO ()
do_solve 0 = return ()
do_solve n = do
    vals <- getinp
    frst <- getinp
    scnd <- getinp
    putStrLn $ id $ let f = maximum frst; s = maximum scnd in if f >= s then "YES" else "NO"
    do_solve (n - 1)

main :: IO ()
main = do
    ntest <- getinp
    do_solve $ head ntest

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

onecase = do
		getLine
		a<- map read <$> words <$> getLine::IO [Int]
		b<- map read <$> words <$> getLine::IO [Int]
		putStrLn $ if maximum a > maximum b then "YES" else "NO"

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

--ghc 7.10

winner :: [Int] -> [Int] -> String
winner as bs
    | maximum as > maximum bs = "YES"
    | otherwise = "NO"

process :: Int -> IO ()
process 0 = return ()
process t = do
    line1 <- getLine
    line2 <- getLine
    let as = map read . words $ line2
    line3 <- getLine
    let bs = map read . words $ line3
    putStrLn $ winner as bs
    process (t-1)

main = do
    tStr <- getLine
    let t = read tStr :: Int
    process t

import Control.Monad
import Data.Bool

main = getLine >>= flip replicateM_ test . read

test = do
    getLine
    as <- map read . words <$> getLine :: IO [Integer]
    bs <- map read . words <$> getLine :: IO [Integer]
    putStrLn $ bool "NO" "YES" $ maximum as > maximum bs


import List
main = interact (show.s.map read.words)
s (n:b:xs) = foldl f b (init(tails xs)) where f z y = max z (b`mod`a+b`div`a*maximum y) where a=head y

getArray = fmap (map read . words) getLine

main = do
	[n, b] <- getArray
	a <- getArray
	putStrLn $ show $ maximum $ b: zipWith (\x y -> b + div b x * (y - x)) (scanl1 min a) (tail a)

getArray = fmap (map read . words) getLine

main = do
	[n, b] <- getArray
	a <- getArray
	putStrLn $ show $ maximum $ zipWith (\x y -> b + div b y * (x - y)) a $ scanl1 min a

--

import Array

solve :: Int -> Array Int Int -> Int
solve b a  =  maximum $ b : [solve' i j | i <- [1..n], j <- [i+1..n]]
  where
    n  =  snd $ bounds a
    solve' i j
      | a ! i <= a ! j  =  div b (a ! i) * (a ! j) + mod b (a ! i)
      | otherwise  =  b

main :: IO ()
main  =  do
    [n, b]  <-  fmap (map read . words) getLine
    xs      <-  fmap (map read . words) getLine
    let array  =  listArray (1, n) xs
    print $ solve b array

import Data.List (maximumBy)

createWay [] = []
createWay xs = (map (\z -> (y, z)) xs):createWay ys
  where (y:ys) = xs

solve (x:xs) = maximum $ map (\(a, b) -> (x `div` a) * b + (x `mod` a)) $ concat $ createWay xs

main = interact (show.solve.map read.tail.words)

import Data.List
main = interact solve
solve input = output where
  [[n,b],a] = map (map (read::String->Int)) $ map words $ lines input
  output = show $ answer a + b
  answer [] = 0
  answer (x:xs) = foldl' max (answer xs) [div b x * (y-x)|y<-xs,y>x]

main = do
    let i = fmap (map read . words) getLine :: IO [Int]
    [n, b] <- i
    a <- i
    if n == 1
        then print b
        else print $ max b $ foldl1 max $ zipWith (\x y -> b`mod`x+b`div`x*y) (init a) (tail $ scanr1 max a)

main = do
	n:b:a <- fmap (map read . words) getContents
	putStrLn $ show $ maximum $ zipWith (\x y -> b + div b y * (x - y)) a $ scanl1 min a

getArray = fmap (map read . words) getLine

main = do
	[n, b] <- getArray
	a <- getArray
	putStrLn $ show $ maximum $ zipWith (\x y -> b + div b x * (y - x)) a $ scanl1 min a

--

import Data.List (maximumBy)

createWay [] = []
createWay xs = (map (\z -> (y, z)) xs):createWay ys
  where (y:ys) = xs

getMax xs = maximumBy p $ filter (\(a, b) -> a <= b) $ concat $ createWay xs
  where p (a1, b1) (a2, b2) = compare (b1 - a1) (b2 - a2)

solve (x:xs) = (x `div` a) * b + (x `mod` a)
  where (a, b) = getMax xs

main = interact (show.solve.map read.tail.words)


import Data.List
import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    [n,k] <- map read . words <$> getLine
    as <- map read . words <$> getLine
    let rs = findIndices odd (0:as)
        l = length rs
    if l < k || odd l /= odd k then putStrLn "NO" else do
      putStrLn "YES"
      putStrLn $ unwords $ map show $ init (drop (l-k) rs) ++ [n]

main = interact $ unlines . process . tail . lines

process :: [String] -> [String]
process [] = []
process (a:b:xs) = (work a b) : (process xs)

work :: String -> String -> String
work a b
  | len < k = "NO"
  | odd (len - k) = "NO"
  | otherwise = "YES\n" ++ unwords(map show $ take (k-1) odds ++ [n])
  where
    n : k : _ = (map read $ words a) :: [Int]
    arr = (map read $ words b) :: [Integer]
    odds = map snd $ filter (odd . fst) $ zip arr [1..]
    len = length odds

import Control.Monad (replicateM_)

findSegments :: Int -> Int -> [Int] -> [Int]
findSegments n k xs
    | numOdds < k || (numOdds - k) `mod` 2 == 1 = []
    | otherwise = (take (k - 1) $ map snd odds) ++ [n]
    where
        odds = filter (\(x, _) -> x `mod` 2 == 1) (zip xs [1..n])
        numOdds = length odds

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

main =
    read <$> getLine >>= \q ->
    replicateM_ q (
        readLine >>= \[n, k] ->
        readLine >>= \xs ->
        putStrLn(
            let ans = findSegments n k xs in
                if null ans then "NO"
                else "YES\n" ++ unwords (map show ans)
        )
    )

import Data.List
import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    [n,k] <- map read . words <$> getLine
    as <- map read . words <$> getLine
    let rs = findIndices odd (0:as)
        l = length rs
    if l < k || odd l /= odd k then putStrLn "NO" else do
      putStrLn "YES"
      putStrLn $ unwords $ map show $ drop (l-k) rs

import Data.List
import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    [n,k] <- map read . words <$> getLine
    as <- map read . words <$> getLine
    let rs = findIndices odd (0:as)
        l = length rs
    if l < k || odd l /= odd k then putStrLn "NO" else do
      putStrLn "YES"
      putStrLn $ unwords $ map show $ drop (k-l) rs


import System.IO

getBestRun :: Int -> [Int] -> (Int, Int)
getBestRun n [] = (0, 0)
getBestRun n (x:xs) | x == n = (0, restBest)
                    | otherwise = (next + 1, best)
                    where (next, restBest) = getBestRun n xs
                          best = if next >= restBest then (next + 1) else restBest

getBestRunFromStr :: Int -> [String] -> Int
getBestRunFromStr n inps = let countArr = map (\x -> sum [1 | c <- x, c == '1']) inps
                               (next, best) = getBestRun n countArr
                           in best

main :: IO ()
main = do
    fstStr <- getLine
    let (n:d:_) = map (read :: String -> Int) $ words fstStr
    inpStrs <- (mapM (\_ -> getLine) [1..d])
    -- putStrLn . show $ getCountArr inpStrs
    putStrLn . show $ getBestRunFromStr n inpStrs
    return ()

import Data.List

main = getLine >> getContents >>= print . f . map length . filter ( id . head ) . group . map ( not . all ( == '1' ) ) . lines

f x
	| null x = 0
	| otherwise = maximum x

import Data.List

main :: IO()
main = print . solve . tail . lines =<< getContents

solve :: [String] -> Int
solve = maximum . (++) [0] . map length . filter head . group . map check

check :: String -> Bool
check s = length (filter (== '0') s) > 0

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

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

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

main = do
  [n, d] <- fmap (map read . words) getLine
  ls <- replicateM d getLine

  let xs = map length $ filter (id . head) $ group $ map (any (== '0')) ls
  print $ if null xs then 0 else maximum xs

import Data.List

main = do
    input <- getContents
    print $ sol $ tail $ lines input
    where sol xs = if any (elem '0') xs then (maximum . map length . filter (\x -> head x) . group . map (elem '0')) xs
                                        else 0

import Data.List
import Data.Char
main = do
  [n,d] <- map read . words <$> getLine
  print . maximum . (0 :) . map length . filter head . group . map ((< n) . sum . map digitToInt) . lines =<< getContents

import System.IO

getBestRun :: Int -> [Int] -> (Int, Int)
getBestRun n [] = (0, 0)
getBestRun n (x:xs) | x == n = (0, restBest)
                    | otherwise = (next + 1, best)
                    where (next, restBest) = getBestRun n xs
                          best = if next >= restBest then (next + 1) else restBest

getBestRunFromStr :: Int -> [String] -> Int
getBestRunFromStr n inps = let countArr = map (\x -> sum [1 | c <- x, c == '1']) inps
                               (next, best) = getBestRun n countArr
                           in best

main :: IO ()
main = do
    fstStr <- getLine
    let (n:d:_) = map (read :: String -> Int) $ words fstStr
    inpStrs <- (mapM (\_ -> getLine) [1..d])
    putStrLn . show $ getBestRunFromStr n inpStrs

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

main = do
  [n, d] <- map read . words <$> getLine
  [ss] <- transpose . map words <$> replicateM d getLine
  print $ maximum $ map length $ [] : (filter (any (== True)) $ group $ map (any (== '0')) ss)

import Data.List

main = getContents >>= print . maximum . map (\ls -> if head ls then length ls else 0) . group . map ('0' `elem`) . tail . lines

import Data.List( group)
main = do
    [n,d] <- return . map read . words =<< getLine
    abs <- sequence $ take d $ repeat getLine
    let isAbletoWin = not . cantWin
	cantWin = all (=='1')
	results = isAbletoWin `map` abs
	wins = filter (True `elem`) $ group results
	winconts =  length `map` wins
    if winconts == []
	then print 0
	else print $ maximum winconts

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

mymax e [] m n = max m n
mymax e (d:ds) m n | e/=d = mymax e ds m (n+1)
		   | otherwise = mymax e ds (max m n) 0

main = do
		[n,k]<- map read <$> words <$> getLine:: IO [Int]
		d<-replicateM k getLine
		let e= replicate n '1'
		print $ mymax e d 0 0

import Control.Applicative
import Control.Monad

beat = any (=='0')

check [] n     = [n]
check (l:ls) n =
    if beat l
        then n:check ls (n+1)
        else n:check ls 0

main = do
   [n, d] <- map read . words <$> getLine
   ls <- replicateM d getLine
   print $ maximum $ check ls 0

import Data.List (group)

process :: [[Char]] -> Int
process = maximum.map (\x -> if head x then length x else 0).group.map (any (=='0'))

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,d] <- fmap (map readInt.words) getLine
    xs <- fmap lines getContents
    print $ process xs

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List
-- Meat
solve :: [String]-> Int
solve = maximum.(0:).fmap length.filter head.group.fmap (elem '0')

-- Shit
main :: IO ()
main = do
        (_:es) <- readShit
        printShit [solve es]

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

yN :: Bool -> String
yN True = "YES"
yN False = "NO"

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

import Data.List
main=interact$show.maximum.(0:).fmap length.filter head.group.fmap(elem '0').tail.lines

import Data.List

main :: IO()
main = print . solve . tail . lines =<< getContents

solve :: [String] -> Int
solve = maximum . map length . group . map check

check :: String -> Bool
check s = length (filter (== '0') s) > 0

import Data.List

main = do
    input <- getContents
    print $ sol $ tail $ lines input
    where sol = (maximum . map length . group . map (elem '0'))


import Control.Monad

main :: IO ()
main = do
  n <- fmap read getLine
  replicateM_ n (do
    [a, b] <- map read . words <$> getLine
    putStrLn $ show $ (a + b - 1) `div` b * b - a)

main = interact $ unlines . map  ( show . (\ [b,a] -> if b `mod` a == 0 then 0 else a - (b `mod` a)) . map (read :: String -> Int) .  words) .  tail . lines

main :: IO ()
main = map (solve . parse) . tail . lines <$> getContents >>= mapM_ print
  where
    parse = f . words
    f [a, b] = (read a, read b)

solve :: (Int, Int) -> Int
solve (a, b) = ((a + b - 1) `div` b) * b - a

import Control.Monad (replicateM_)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

main = readLn >>= flip replicateM_ solve

solve = do
    [a,b] <- getList
    print $ (-a) `mod` b

-- PROBLEM: https://codeforces.com/contest/1328/problem/A

import Control.Arrow ((>>>))

main :: IO()
main =
  interact $
    lines >>> drop 1 >>> map ((words >>> map read) >>> solve >>> show) >>> unlines

solve :: [Int] -> Int
solve [u, v]
  | mod u v == 0 = 0
  | otherwise = v - mod u v

import Control.Monad

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        [a, b] <- map read . words <$> getLine
        let m = mod a b
        print $ if m == 0 then 0 else b - m

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

ans a b | z==0 = 0
        | otherwise = b-z
	where z= mod a b
onecase= do
		[a,b]<-map read <$> words<$> getLine ::IO [Int]
		print $ ans a b

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

import           Control.Monad
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    replicateM_ n $ print =<< (\[a,m]->(-a)`mod`m) . map (read :: String -> Int) . words <$> getLine

import           Control.Monad
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    replicateM_ n $ print =<< (\[a,m]->(m - a`mod`m)`mod`m) . map (read :: String -> Int) . words <$> getLine

import Data.List

process :: (Int,Int) -> Int
process (a,b) = (b - a) `mod` b

readInt :: String -> Int
readInt = read

readPair :: String -> (Int,Int)
readPair line = (a,b)
    where [a,b] = map readInt $ words line

main = do
    n <- fmap readInt getLine
    xs <- fmap (map readPair.lines) getContents
    sequence . map (print . process) $ xs

import Control.Monad
import Text.Printf

move :: Integer -> Integer -> Integer
move a b = case mod a b of
    0 -> 0
    c -> b - c

main = do
    i <- getLine
    let t = read i :: Integer
    forM_ [1..t] $ \ _ -> do
        ii <- getLine
        let [a,b] = map (\x -> read x :: Integer) $ words ii
        let c = move a b
        printf "%v\n" c

main :: IO ()

main = do
    getLine
    answers <- map (solve . map read . words) <$> lines <$> getContents :: IO [Int]
    mapM_ print answers

solve [x,y] = (-x) `mod` y

import Control.Arrow

main :: IO ()
main = interact $
    lines >>> tail >>> map supersolve >>> unlines

supersolve :: String -> String
supersolve = words >>> map read >>> solve2 >>> show

solve2 [a, b] = solve a b
solve2 [] = 0

solve :: Int -> Int -> Int
solve a b
    | a `mod` b == 0 = 0
    | otherwise = b - (a `mod` b)

import Control.Arrow

main = interact $
  lines >>> drop 1
  >>> map ((words >>> map read) >>> solve >>> show)
  >>> unlines

solve :: [Integer] -> Integer
solve [a, b]
  | d == 0 = 0
  | otherwise = b - d
    where d = a `mod` b

import Control.Monad (replicateM, forM_)

getSolution :: [Int] -> Int

getSolution (a : b : []) =

  let

    x = a `mod` b

  in case x of

    0 -> 0

    otherwise -> (b - x)

main = do

    -- could also do t <- readLn :: IO Int

    t <- fmap (read :: String -> Int) getLine

    -- putStrLn $ show t

    line <- replicateM t getLine

    let

        splitted = fmap words line

        casted   = (fmap . fmap) (read :: String -> Int) splitted

        solutions = fmap getSolution casted  -- [Int]

      in

        forM_ (fmap show solutions) putStrLn

main=interact$unlines.map s.drop 1.lines
s=show.t.map read.words
t[a,b]=mod(b-mod a b)b

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [x, y] <- getIntList
        print $ (y - x `mod` y) `mod` y

main = getLine >>= test.read
test 0 = return ();
test i = do
  (a:b:_) <- map read.words <$> getLine
  print $ (b - a `mod` b) `mod` b
  test (i - 1)


import Control.Monad

linha :: Int -> Int -> String
linha n m = [ "BW"!!pos | h <- [0..m-2], let pos = (n+h)`mod`2 ] ++ "B"

checkers :: Int -> Int -> [String]
checkers n m = [ [ "BW"!!pos | h <- [0..m-1], let pos = (i+h)`mod`2 ] | i <- [0..n-1] ]

foo :: Int -> Int -> [String]
foo n m | odd n && odd m = checkers n m
        | even n && even m = [linha 0 m] ++ (tail (checkers n m))
        | otherwise = (init (checkers n m)) ++ [linha (n-1) m]

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

main :: IO()
main = do
  t <- readLn :: IO Int

  forM_ [1..t] $ \i -> do
    a <- readInts
    let out = foo (a!!0) (a!!1)
    forM_ [0..(a!!0 - 1)] $ \l -> do
      putStrLn (out!!l)

{-# LANGUAGE ScopedTypeVariables #-}

reshape _ 0 _ = []
reshape w h elems =
  let (row, rest) = splitAt w elems in row : reshape w (h - 1) rest

f :: [Int] -> [[String]]
f [h, w] = reshape w h $ take (w * h) $ "W" : repeat "B"

splitInput :: String -> [[Int]]
splitInput = map (map read . words) . tail . lines

go :: String -> String
go input =
  let answers :: [[[String]]] = map f (splitInput input) in
  concat $ map (unlines . map concat) answers

main = interact go

solve :: Int -> Int -> String
solve n m
  | odd len = board
  | otherwise = if (odd m) then ((init board) ++ "B") else ("BB" ++ (drop 2 board))
  where len = n*m
        board = [printer i j | i <- [0..(n-1)], j <- [0..(m-1)]]

printer :: Int -> Int -> Char
printer i j
  | even i && even j = 'B'
  | even i && odd  j = 'W'
  | odd  i && even j = 'W'
  | otherwise        = 'B'

partitionBy :: Int -> String -> [String]
partitionBy _ "" = []
partitionBy n input = [(take n input)] ++ (partitionBy n (drop n input))

parse :: String -> String
parse contents = foldl (++) "" solutions
  where lines' = tail $ lines contents
        inputs = map (\[n', k'] -> (read n' :: Int, read k' :: Int)) $ map words lines'
        solutions = map (\(n, k) -> unlines (partitionBy k (solve n k))) inputs

main :: IO ()
main = do
  contents <- getContents
  putStr (parse contents)

import Control.Monad

type Test = (Integer, Integer)
type Row = [Char]
type Board = [Row]

getTests :: Int -> IO [Test]
getTests n = replicateM n getTest

getTest :: IO Test
getTest = do
    test <- getLine
    return $ parseTest test

parseTest :: String -> Test
parseTest str = (parsed !! 0, parsed !! 1)
    where parsed = map read (words str)

getAnswer :: [Test] -> [Board]
getAnswer [] = []
getAnswer ((n, m):rest) = if not $ odd (n*m)
                          then change board : (getAnswer rest)
                          else board : (getAnswer rest)
    where board = getChessBoard n m

change :: Board -> Board
change (first:rest) = if m > 1
                      then (removeOneW first):rest
                      else [first] ++ [removeOneW $ head rest] ++ (tail rest)
    where m = length first

removeOneW :: Row -> Row
removeOneW (symbol:rest) = if symbol == 'W'
                           then 'B':rest
                           else symbol: removeOneW rest

getChessBoard :: Integer -> Integer -> Board
getChessBoard n m = getChessBoard' n (getChessLine 'B' m)

getChessBoard' :: Integer -> Row -> Board
getChessBoard' 0 row = []
getChessBoard' n row = row : getChessBoard' (n - 1) (interchange row)

interchange :: Row -> Row
interchange [] = []
interchange (first:rest) = newSymbol : interchange rest
    where newSymbol = if first == 'W'
                      then 'B'
                      else 'W'

getChessLine :: Char -> Integer -> Row
getChessLine symbol 0 = []
getChessLine symbol m = symbol : getChessLine nextSymbol (m-1)
    where nextSymbol = if symbol == 'W'
                       then 'B'
                       else 'W'

printTest :: Board -> IO ()
printTest board = do
    mapM_ putStrLn board

main :: IO ()
main = do
    count <- getLine
    tests <- getTests $ read count
    mapM_ printTest (getAnswer tests)

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, m] <- getIntList
        putStr $ f n m

g :: Int -> String
g m = take m
      . concat
      $ repeat "BW"

r :: Char -> Char
r 'B' = 'W'
r 'W' = 'B'

s :: Int -> Int -> String
s n m = concat
        . map (++"\n")
        . take n
        $ iterate (map r) (g m)

f :: Int -> Int -> String
f n m
    | odd (n * m) = s n m
    | otherwise = 'B' : 'B' : (drop 2 $ s n m)

{-# LANGUAGE ScopedTypeVariables #-}

reshape _ 0 _ = []
reshape w h elems =
  let (row, rest) = splitAt w elems in row : reshape w (h - 1) rest

elemsList :: Int -> Int -> [String]
elemsList w h
 | odd (w * h) = take (w * h) $ cycle["B", "W"]
 | otherwise = (take (w * h - 1) $ cycle["B", "W"]) ++ ["B"]

f :: [Int] -> [[String]]
f [h, w] = reshape w h $ elemsList w h

splitInput :: String -> [[Int]]
splitInput = map (map read . words) . tail . lines

go :: String -> String
go input =
  let answers :: [[[String]]] = map f (splitInput input) in
  concat $ map (unlines . map concat) answers

main = interact go

solve :: Int -> Int -> String
solve n m
  | odd len = board
  | otherwise = if (odd m) then ((init board) ++ "B") else ("BB" ++ (drop 2 board))
  where len = n*m
        board = [printer i j | j <- [0..(m-1)], i <- [0..(n-1)]]

printer :: Int -> Int -> Char
printer i j
  | even i && even j = 'B'
  | even i && odd  j = 'W'
  | odd  i && even j = 'W'
  | otherwise        = 'B'

partitionBy :: Int -> String -> [String]
partitionBy _ "" = []
partitionBy n input = [(take n input)] ++ (partitionBy n (drop n input))

parse :: String -> String
parse contents = foldl (++) "" solutions
  where lines' = tail $ lines contents
        inputs = map (\[n', k'] -> (read n' :: Int, read k' :: Int)) $ map words lines'
        solutions = map (\(n, k) -> unlines (partitionBy k (solve n k))) inputs

main :: IO ()
main = do
  contents <- getContents
  putStr (parse contents)

solve :: Int -> Int -> String
solve n m
  | odd len = board
  | otherwise = (init board) ++ "B"
  where len = n*m
        board = [if even i then 'B' else 'W' | i <- [0..(len-1)]]

partitionBy :: Int -> String -> [String]
partitionBy _ "" = []
partitionBy n input = [(take n input)] ++ (partitionBy n (drop n input))

parse :: String -> String
parse contents = foldl (++) "" solutions
  where lines' = tail $ lines contents
        inputs = map (\[n', k'] -> (read n' :: Int, read k' :: Int)) $ map words lines'
        solutions = map (\(n, k) -> unlines (partitionBy k (solve n k))) inputs

main :: IO ()
main = do
  contents <- getContents
  putStr (parse contents)


import Prelude hiding (getLine)
import Control.Applicative ((<$>))
import Data.List (unfoldr, find)
import Control.Monad (forM_, forM)
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.Unboxed (listArray, UArray, (!))
import Data.Array.ST.Safe (STUArray, newArray, readArray, writeArray)

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

dump Nothing = putStrLn "NO"
dump (Just a) = do
    putStrLn "YES"
    forM_ a $ (\(x, y) -> putStrLn $ show x ++ " " ++ show y)

loop :: UArray Int Int -> STUArray s Int Bool -> Int -> ST s [Int]
loop arr tag i = do
    flag <- readArray tag i
    if flag then return []
    else writeArray tag i True >> (i:) <$> loop arr tag (arr ! i)

run :: Int -> [[Int]] -> Maybe [(Int, Int)]
run n a = case find ((== 1) . length) a of
    (Just [r]) -> Just . map ((,) r) $ [1..r - 1] ++ [r + 1..n]
    _          -> case any (odd . length) a of
        True  -> Nothing
        False -> case find ((== 2) . length) a of
            Nothing -> Nothing
            (Just [x, y]) -> Just $ (x, y): concatMap go a
                where
                go xs
                    | xs == [x, y] = []
                    | otherwise = zip xs (cycle [x, y])

solve :: Int -> [Int] -> Maybe [(Int, Int)]
solve n a = run n cycl
    where
    arr = listArray (1, n) a :: UArray Int Int

    cycl = filter (not . null) $ runST $ do
        tag <- newArray (1, n) False :: ST s (STUArray s Int Bool)
        mapM (loop arr tag) [1..n]

main = do
    [n] <- parse <$> getLine
    getLine >>= dump . solve n . parse

import Prelude hiding (getLine)
import Control.Applicative ((<$>))
import Data.List (unfoldr, find)
import Control.Monad (forM_, forM)
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.Unboxed (listArray, UArray, (!))
import Data.Array.ST.Safe (STUArray, newArray, readArray, writeArray)

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

dump 1 _ = putStrLn "YES"
dump _ [] = putStrLn "NO"
dump _ a = do
    putStrLn "YES"
    forM_ a $ (\(x, y) -> putStrLn $ show x ++ " " ++ show y)

loop :: UArray Int Int -> STUArray s Int Bool -> Int -> ST s [Int]
loop arr tag i = do
    flag <- readArray tag i
    if flag
    then return []
    else writeArray tag i True >> (i:) <$> loop arr tag (arr ! i)

run :: Int -> [[Int]] -> [(Int, Int)]
run n a = case find ((== 1) . length) a of
    (Just [r]) -> map ((,) r) $ [1..r - 1] ++ [r + 1..n]
    _          -> case any (odd . length) a of
        True  -> []
        False -> case find ((== 2) . length) a of
            Nothing -> []
            (Just [x, y]) -> (x, y): concatMap go a
                where
                go xs
                    | xs == [x, y] = []
                    | otherwise = zip xs (cycle [x, y])

solve :: Int -> [Int] -> [(Int, Int)]
solve n a = run n cycl
    where
    arr = listArray (1, n) a :: UArray Int Int

    cycl = filter (not . null) $ runST $ do
        tag <- newArray (1, n) False :: ST s (STUArray s Int Bool)
        mapM (loop arr tag) [1..n]

main = do
    [n] <- parse <$> getLine
    getLine >>= dump n . solve n . parse

import Prelude hiding (getLine)
import Control.Applicative ((<$>))
import Data.List (unfoldr, find)
import Control.Monad (forM_, forM)
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.Unboxed (listArray, UArray, (!))
import Data.Array.ST.Safe (STUArray, newArray, readArray, writeArray)

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

dump [] = putStrLn "NO"
dump a = do
    putStrLn "YES"
    forM_ a $ (\(x, y) -> putStrLn $ show x ++ " " ++ show y)

loop :: UArray Int Int -> STUArray s Int Bool -> Int -> ST s [Int]
loop arr tag i = do
    flag <- readArray tag i
    if flag
    then return []
    else writeArray tag i True >> (i:) <$> loop arr tag (arr ! i)

run :: Int -> [[Int]] -> [(Int, Int)]
run n a = case find ((== 1) . length) a of
    (Just [r]) -> map ((,) r) $ [1..r - 1] ++ [r + 1..n]
    _          -> case any (odd . length) a of
        True  -> []
        False -> case find ((== 2) . length) a of
            Nothing -> []
            (Just [x, y]) -> (x, y): concatMap go a
                where
                go xs
                    | xs == [x, y] = []
                    | otherwise = zip xs (cycle [x, y])

solve :: Int -> [Int] -> [(Int, Int)]
solve n a = run n cycl
    where
    arr = listArray (1, n) a :: UArray Int Int

    cycl = filter (not . null) $ runST $ do
        tag <- newArray (1, n) False :: ST s (STUArray s Int Bool)
        mapM (loop arr tag) [1..n]

main = do
    [n] <- parse <$> getLine
    getLine >>= dump . solve n . parse


import Data.List (scanl1, sort)
main = interact $ show . solve . map read . words
solve (_:a) = length $ filter (==0) $ scanl1 (+) $ zipWith (-) a $ sort a

import Data.List

main = do
    n <- getLine
    line <- getLine
    let mlist = (map read . words) line
    print (chack (sums 0 mlist) (sums 0 (sort mlist)) - 1)
        where
            sums c [] = [c]
            sums c (a:b) = [c + a] ++ sums (a + c) b
            chack [] [] = 0
            chack (a : xv) (b : zv) | a == b = 1 + chack xv zv
            chack (a : xv) (b : zv) = 0 + chack xv zv

import Data.List

main = do
    n <- getLine
    line <- getLine
    let mlist = (map read . words) line
    print (chack 0 0 mlist (sort mlist))
        where
            chack c d [] [] = 0
            chack c d (a : xv) (b : zv) | c == d = 1 +  chack (c+a) (d + b) xv zv
            chack c d (a : xv) (b : zv) = 0 + chack (c+a) (d + b) xv zv

import Control.Applicative

prefixMax = scanl1 max

suffixMin = scanr1 min

computeIndexes prefixMax suffixMin = foldl (\res (a, b) -> if a <= b then res+1 else res) 1 $ zip prefixMax $ drop 1 suffixMin

main = do
    n <- readLn
    list <- take n . map read <$> words <$> getLine :: IO [Integer]
    let max = prefixMax list
        min = suffixMin list
    print $ computeIndexes max min


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

onecase = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		print $ (^2)  $ min (max a (b+b)) (max b (a+a))

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

--- frederick99, 6/2020
--- https://codeforces.com/contest/1360/problem/A

import Control.Monad ( replicateM_ )

minSquare :: [Int] -> Int
minSquare [w, h] = max a (2*b) ^ 2
    where a = max w h
          b = min w h

readInput :: IO [Int]
readInput = map read . words <$> getLine

main :: IO ()
main = do
    x <- read <$> getLine
    replicateM_ x (minSquare <$> readInput >>= print)

import Control.Monad ( replicateM_ )

readInput = map read . words <$> getLine

minSquare [w, h] = (max a (2*b)) ^ 2
    where a = max w h
          b = min w h

main = do
    x <- read <$> getLine
    replicateM_ x (minSquare <$> readInput >>= print)

import Data.Array

memoize :: Ix i => (i,i) -> (i -> e) -> (i -> e)
memoize bnds fun = (array bnds [(i, fun i) | i <- range bnds] !)

listMemoize :: Ix i => (i,i) -> (i -> e) -> (i -> e)
listMemoize bnds fun = let li = map fun (range bnds) in
  \ix -> li !! (index bnds ix)

parse :: String -> [(Int, Int)]
parse inp = [(x, y) | [x, y] <- map (map read . words) . tail $ lines inp]

solve :: [(Int, Int)] -> [Int]
solve = map (\(x, y) -> let l = maximum [x, y, 2 * min x y] in l*l)

showAns :: [Int] -> String
showAns = unlines . map show

main :: IO ()
main = interact (showAns . solve . parse)

module Main where

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [a, b] <- sort <$> map (read) <$> words <$> getLine
        print $ sqr $ max b (a * 2)
                    where sqr x = x * x

import           Control.Monad

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

solve :: IO ()
solve = do
    [a, b] <- map read . words <$> getLine
    print $ min (area (2 * a) b) (area a (2 * b))
  where
    area :: Int -> Int -> Int
    area x y = max x y ^ 2

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

main = getLine >>= flip replicateM_ test . read

test = do
    (a:b:_) <- map read . words <$> getLine
    print $ minimum [max (max a b) (2 * min a b) ^ 2, (a + b) ^ 2]

module Main where

main = interact $ unlines . map ( show . (^2) .  (\[x,y] -> let z = min (y * 2) (x * 2) in if z >= max x y then z else max x y). map (read :: String -> Integer) . words ) . tail . lines

import Control.Monad (replicateM_)

getMinSquare [a, b] = side * side where
    side = max (2 * min a b) (max a b)

parseLine = fmap ((map read) . words) getLine

main =
    fmap read getLine >>= \t ->
    replicateM_ t (fmap getMinSquare parseLine >>= print)

module Main where

main = interact $ unlines . map ( show . (^2) .  (\[x,y] -> if x==y then x else min (y * 2) (x * 2) ). map (read :: String -> Integer) . words ) . tail . lines

module Main where

main = interact $ unlines . map ( show . (^2) .  (\[x,y] -> min (y * 2) (x * 2) ). map (read :: String -> Integer) . words ) . tail . lines

module Main where

main = interact $ unlines . map ( show . (^2) .  (\[x,y] -> max (y * 2) (x * 2) ). map (read :: String -> Integer) . words ) . tail . lines

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

onecase = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		print $ min (max a (b+b)) (max b (a+a))

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


{-# LANGUAGE Strict #-}
{-# LANGUAGE LambdaCase #-}
import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)
import Data.List (sort)
import Data.Array.Unboxed (accumArray, array, UArray)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = do
  n <- int
  xys <- numberOf (pair int int)
  return . show $ solve n xys

solve :: Int -> [(Int, Int)] -> Int
solve n xys = length [True | p <- ps, q <- ps, overlap p q] `div` 2
  where
    used = sort . uncurry (++) $ unzip xys
    unused = [1..2*n] `lsub` used
    s = length unused `div` 2
    (ls, rs) = splitAt s unused
    ps = sortP <$> xys ++ zip ls rs

overlap (x, y) (a, b) = (x < a && a < y && y < b) || (a < x && x < b && b < y)

sortP :: Ord a => (a, a) -> (a, a)
sortP (x, y) = if x <= y then (x, y) else (y, x)

lsub :: Eq a => [a] -> [a] -> [a]
lsub [] _ = []
lsub xs [] = xs
lsub (x:xs) (y:ys) = if x == y then lsub xs ys else x : lsub xs (y:ys)
-------------------------- Template ------------------------------------------
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 t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

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

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

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

import Data.Array.Unboxed

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    pts <- replicateM k $ do
      [xi, yi] <- readInts
      pure (xi, yi)
    let
      vis :: UArray Int Bool
      vis = accumArray (\_ _ -> True) False (1, 2*n) $ do
        (xi, yi) <- pts
        [(xi, ()), (yi, ())]
      unvis :: [Int]
      unvis = [i | (i, False) <- assocs vis]
      newpts = zip unvis $ drop (n-k) unvis
      allpts = [(min x y, max x y) | (x, y) <- pts ++ newpts]
      crossings = do
        (x, y) <- allpts
        (p, q) <- allpts
        guard $ x < p -- no double-counting
        guard $ not $ (x < p && q < y) -- not nested
        guard $ not (y < p) -- not disjoint, either -- How did I forget?
        pure [x, y, p, q]
    putInts [length crossings] -- Why is this Wrong Answer??

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.IntSet as IS

solve :: IO ()
solve = do
    [n, k] <- readMany :: IO [Int]
    a <- replicateM k $ sort <$> readMany :: IO [[Int]]
    let b = uncurry (zipWith (\x y -> [x, y])) $ splitAt (n - k) rem where
            rem = filter (`IS.notMember` used) [1..2*n]
            used = IS.fromList $ concat a
        isect [_, b] [c, d] = c < b && b < d
    print $ sum [1 | (x:ys) <- tails $ sort $ a ++ b, y <- ys, isect x y]

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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

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

import Data.Array.Unboxed

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    pts <- replicateM k $ do
      [xi, yi] <- readInts
      pure (xi, yi)
    let
      vis :: UArray Int Bool
      vis = accumArray (\_ _ -> True) False (1, 2*n) $ do
        (xi, yi) <- pts
        [(xi, ()), (yi, ())]
      unvis :: [Int]
      unvis = [i | (i, False) <- assocs vis]
      newpts = zip unvis $ drop (n-k) unvis
      allpts = [(min x y, max x y) | (x, y) <- pts ++ newpts]
      crossings = do
        (x, y) <- allpts
        (p, q) <- allpts
        guard $ x < p -- no double-counting
        guard $ not $ (x < p && q < y) || (p < x && y < q) -- not nested
        pure [x, y, p, q]
   -- putInts unvis
   -- forM_ allpts $ \(x, y) -> putInts [x, y]
    putInts [length crossings] -- Why is this Wrong Answer??
   -- forM_ crossings putInts
   -- putInts []

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

f ::Int->Int->String->[String]
f _ _ ""=[]
f n 0 str=(take n str):f n 0 (drop n str)
f n m str=((take (n-1) str)++"*"):f n (m-1) (drop (n-1) str)

main = do
       e<-getLine
       let t=(length e)
           (r,c,a)=head $ sort [(r,c,r*c-t)|r<-[1..5],c<-[1..20],r*c>=t,r*c-t<=r]
       putStrLn $ (show r)++" "++(show c)
       mapM_ putStrLn $ f c a e

import Data.List

pingo b culo concha [] = ""
pingo b culo concha s =
	let q = culo + (if concha > 0 then 1 else 0) in
	let t = take (b-q) s in
	t++(replicate q '*')++"\n"++(pingo b culo (concha-1) $ drop (b-q) s)

solve::String -> String
solve ss =
	let s = head $ words ss in
	let n = length s in
	let a = div (n+19) 20 in
	let b = div (n+a-1) a in
	let z = a*b-n in
	let culo = div z a in
	let concha = mod z a in
	show(a)++" "++show(b)++"\n"++pingo b culo concha s

main = do
  interact $ solve

import Data.List

pingo b [] = ""
pingo b s =
	let t = take b s in
	t++"\n"++(pingo b $ drop b s)

solve::String -> String
solve ss =
	let s = head $ words ss in
	let n = length s in
	let a = div (n+19) 20 in
	let b = div (n+a-1) a in
	let s2 = s ++ (replicate (a*b-n) '*') in
	show(a)++" "++show(b)++"\n"++pingo b s2

main = do
  interact $ solve


module Main where

import Data.List

getPows :: [Integer] -> Integer -> [Integer]
getPows lst sum = map (\x -> sum - x) lst

getIt :: [Integer] -> [(Integer, Integer)]
getIt (x:xs) = getPairLst xs 1 x

getPairLst :: [Integer] -> Integer -> Integer -> [(Integer, Integer)]
getPairLst [] numb curr = [(curr, numb)]
getPairLst (x:xs) numb curr = case (x == curr) of
                               (True) -> getPairLst xs (numb+1) curr
                               (False)-> (curr, numb) : getPairLst xs 1 x

giveNAnswer :: [(Integer, Integer)] -> Integer -> Integer
giveNAnswer (x:xs) prime = case ((snd x `mod` prime) == 0) of
                            (False) -> fst x
                            (True)  -> giveNAnswer (addLst xs ((fst x)+1) (snd x `div` prime )) prime

addLst :: [(Integer, Integer)] -> Integer -> Integer -> [(Integer, Integer)]
addLst [] fstX sndX = [(fstX, sndX)]
addLst (x:xs) fstX sndX = case (fstX == fst x) of
                            (True)  -> (fst x, (snd x)+sndX) : xs
                            (False) -> (fstX, sndX) :x: xs

powIt :: Integer -> Integer ->Integer
powIt _ 0 = 1
powIt based x = case (x `mod` 2) of
                    1 -> mod (based * (powIt based (x-1))) 1000000007
                    0 -> let r = powIt based (x `div` 2)
                         in mod (r*r) 1000000007

main :: IO()
main = do
        line1 <- getLine
        line2 <- getLine
        let [n,prime] = map read (words line1)
        let arr = map (read) (words line2)
        let sm = sum arr
        let ans = getIt $(sort (getPows arr sm))
        let x = min (giveNAnswer ans prime) sm
        print $ powIt prime x

import Data.List as List

readInts :: String -> [Integer]
readInts str = map read (words str)

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

g :: Integer -> Integer -> Integer -> [Integer] -> Integer
g _ 0 _ _ = 0
g x s offset as@(a:_) =
  if offset/=a
  then a-offset + (g x (s-a+offset) a as)
  else
      let k = length $ head $ List.group as in
      if mod (fromIntegral k) x /=0
      then 0
      else g x s offset ((replicate (div k $ fromInteger x) (offset+1)) ++ (drop k as))

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  let s = sum as'
  let as = map (s-) $ reverse $ List.sort as'
  print $ expmod 1 x $ g x s 0 as

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
itof :: Int -> Double
itof = fromIntegral

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,x] <- readLns
    as <- readInts
    print $ solve n x as

modulo = 1000000007

newtype Modulo = Modulo { getInteger :: Integer } deriving(Eq,Ord)
instance Num Modulo where
    Modulo a + Modulo b = Modulo ((a+b) `mod` modulo)
    Modulo a - Modulo b = Modulo ((a-b) `mod` modulo)
    Modulo a * Modulo b = Modulo ((a*b) `mod` modulo)
    abs (Modulo a) = Modulo (abs a)
    signum (Modulo a) = Modulo (signum a)
    fromInteger i = Modulo i

instance Show Modulo where
    show (Modulo i) = show i

solve :: Int -> Int -> [Int] -> Modulo
solve n x' as' = go bs
    where
    as = map fromIntegral as' :: [Integer]
    s = sum as
    x = fromIntegral x'
    bs = [(s - b,1) | b <- reverse as]
    go l | k1 `mod` x == 0 = go ((b+1,k1 `div` x):l2)
         | otherwise = Modulo x ^ min b s
        where
        (b,_) = head l
        (l1,l2) = span ((==b).fst) l
        k1 = sum $ map snd l1

module Main where

import Data.List

getPows :: [Integer] -> Integer -> [Integer]
getPows lst sum = map (\x -> sum - x) lst

getIt :: [Integer] -> [(Integer, Integer)]
getIt (x:xs) = getPairLst xs 1 x

getPairLst :: [Integer] -> Integer -> Integer -> [(Integer, Integer)]
getPairLst [] numb curr = [(curr, numb)]
getPairLst (x:xs) numb curr = case (x == curr) of
                               (True) -> getPairLst xs (numb+1) curr
                               (False)-> (curr, numb) : getPairLst xs 1 x

giveNAnswer :: [(Integer, Integer)] -> Integer -> Integer
giveNAnswer (x:xs) prime = case ((snd x `mod` prime) == 0) of
                            (False) -> fst x
                            (True)  -> giveNAnswer (addLst xs ((fst x)+1) (snd x `div` prime )) prime

addLst :: [(Integer, Integer)] -> Integer -> Integer -> [(Integer, Integer)]
addLst [] fstX sndX = [(fstX, sndX)]
addLst (x:xs) fstX sndX = case (fstX == fst x) of
                            (True)  -> (fst x, (snd x)+sndX) : xs
                            (False) -> (fst x, sndX) : xs

powIt :: Integer -> Integer ->Integer
powIt _ 0 = 1
powIt based x = case (x `mod` 2) of
                    1 -> mod (based * (powIt based (x-1))) 1000000007
                    0 -> let r = powIt based (x `div` 2)
                         in mod (r*r) 1000000007

main :: IO()
main = do
        line1 <- getLine
        line2 <- getLine
        let [n,prime] = map read (words line1)
        let arr = map (read) (words line2)
        let sm = sum arr
        let ans = getIt $(sort (getPows arr sm))
        let x = min (giveNAnswer ans prime) sm
        print $ powIt prime x

import Data.List as List

readInts :: String -> [Integer]
readInts str = map read (words str)

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

has :: Integer -> Integer -> Integer
has 0 _ = 0
has n x
 |mod n x == 0 = 1+(has (div n x) x)
 |otherwise = 0

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  if n==225 && x==5 then
    print $ map (\lst->(head lst, length lst)) $ List.group as'
  else
    return ()
  let as = reverse $ List.sort as'
  let s = sum as
  let an = head as
  let k = fromIntegral $ length $ head $ List.group as

  let r1 = s-an
  let r2 = (min (has k x) an)
  let result = expmod 1 x (r1+r2)
  --print (r1, r2, result)
  print result

import Data.List as List

readInts :: String -> [Integer]
readInts str = map read (words str)

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

has :: Integer -> Integer -> Integer
has 0 _ = 0
has n x
 |mod n x == 0 = 1+(has (div n x) x)
 |otherwise = 0

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  if n==225 && x==5 then
    print $ map (\lst->(head lst, length lst)) $ List.group as'
  else
    return ()
  let as = reverse $ List.sort as'
  let s = sum as
  let an = head as
  let k = fromIntegral $ length $ head $ List.group as

  let r1 = s-an
  let r2 = (min (has k x) an)
  let result = expmod 1 x (r1+r2)
  print (r1, r2, result)

import Data.List as List

readInts :: String -> [Integer]
readInts str = map read (words str)

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  let as = reverse $ List.sort as'
  let s = sum as
  let an = head as
  let k = fromIntegral $ length $ head $ List.group as
  print $ mod ((expmod 1 x (s-an)) * (gcd (expmod 1 x an) k)) modnum

import Data.List as List

readInts :: String -> [Integer]
readInts str = map read (words str)

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

has :: Integer -> Integer -> Integer
has 0 _ = 0
has n x
 |mod n x == 0 = 1+(has (div n x) x)
 |otherwise = 0

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  let as = reverse $ List.sort as'
  let s = sum as
  let an = head as
  let k = fromIntegral $ length $ head $ List.group as

  let r1 = s-an
  let r2 = (min (has k x) an)
  print $ expmod 1 x (r1+r2)


import Data.List (transpose)

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

solve :: [String] -> Int
solve xss = length [ () | xs <- xss, any (uncurry (==)) $ zip xs (map maximum $ transpose xss) ]

import Data.List

main :: IO()
main = print . solve . tail . lines =<< getContents

solve :: [String] -> Int
solve s = let s' = transpose s
              ms = map maximum s'
          in  length [x | x <- s, any (uncurry (==)) (zip x ms)]

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

poss :: [Int] -> [Int]
poss [] = []
poss lst = elemIndices mx lst
  where mx = maximum lst

toints :: [String] -> [[Int]]
toints = map . map $ digitToInt

calc :: [String] -> Int
calc = length . nub . foldl1 (++) . map poss . transpose . toints

main = do
  nm <- fmap words getLine
  let nmi = map (\x -> read x :: Int) nm
      n = nmi !! 0
      --m = nmi !! 1
  slist <- replicateM n getLine
  print $ calc slist

import List
import Data.Char
tapleMax ::(Int,Int) -> Int
tapleMax x | fst x >= snd x = fst x
           | otherwise = snd x
getMax ::[Int] -> [Int] -> [Int]
getMax a b = [tapleMax y|y <- getTaple a b]
getTaple ::[Int] -> [Int] ->[(Int,Int)]
getTaple [] [] = []
getTaple (x:xs) (y:ys) =(x,y):getTaple xs ys
getBest ::[[Int]] ->[Int]
getBest [x] = x
getBest (x:xs) = getMax x (getBest xs)
hasBest ::[Int] -> [Int] -> Bool
hasBest [] [] = False
hasBest (x:xs) (y:ys) | x<= y = True
                     | otherwise = hasBest xs ys
getAns ::[[Int]] -> Int
getAns a = length$filter (hasBest (getBest a)) a
main=interact$show.getAns.(map (map digitToInt)).(drop 2).words

import Array
import Char

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

getLines :: Int -> IO [String]
getLines n = sequence (replicate n getLine)

toArray2 :: (Char -> e) -> [String] -> Array (Int, Int) e
toArray2 parser lines = array ((0, 0), (n-1, m-1))
    [((i, j), parser (lines !! i !! j)) | i <- [0..n-1], j <- [0..m-1]]
  where
    n = length lines
    m = length (head lines)

getArray2 :: (Char -> e) -> (Int, Int) -> IO (Array (Int, Int) e)
getArray2 parser (n, _) = getLines n >>= return . toArray2 parser

solve :: (Int, Int) -> Array (Int, Int) Int -> Int
solve (n, m) a  =  length (filter (\i -> any (\j -> a ! (i, j) == maximum (map (\k -> a ! (k,j)) [0..n-1])) [0..m-1]) [0..n-1])

main :: IO ()
main  =  do
    [n, m] <- Main.reads
    a <- getArray2 digitToInt (n, m)
    print $ solve (n, m) a

--import Data.Vector
import Numeric
import Data.List
main = do
 nm <- getLine
 cs <- getContents
 let (n:m:_) = map (fst.head.readDec) $ words nm
 print.answer (n,m).take n.lines $ cs

answer :: (Int,Int) -> [[Char]] -> Int
answer (n,m) xs =
 let xy = split n [(x,y) | x <- [0..m-1],y <- [0..n-1]]
 in  length.group.sort.concat $ map (f xs) xy
 where
  f :: [[Char]] -> [(Int,Int)] -> [Int]
  f xs xys = let grades = map (value xs) xys
                 maX = foldl max '1' grades
             in third.foldl g (maX ,0, []) $ grades
  g (a,k,success) b = if a == b then (a,k+1,k:success)
                                else (a,k+1,  success)

count (a,k) b = if a < b && a /= 0 then (b,k+1) else (a,k)

third (_,_,x) = x

split n [] = []
split n xs = a:split n b
 where
  (a,b) = splitAt n xs

value xs (x,y) = (xs !! y ) !! x

import List

solve :: [[Char]] -> Int
solve grades = let gradesT = transpose grades
                   ms = map maximum gradesT
                   isSuccessful ts = not $ null $ filter (\(x, y) -> x == y) $ zip ts ms
               in length $ filter isSuccessful grades

main = interact $ show . solve . drop 2 . words

import Data.List

test1 = ["223",
         "232",
         "112"]

test2 = ["91728",
         "11828",
         "11111"]

solve :: [[Char]] -> Int
solve grades = let gradesT = transpose grades
                   ms = map maximum gradesT
                   isSuccessful ts = not $ null $ filter (\(x, y) -> x == y) $ zip ts ms
               in length $ filter isSuccessful grades

main = interact $ show . solve . drop 2 . words

import Data.List
main=interact$show.f.tail.lines
f y=length[x|x<-y,any(uncurry(==))$zip x$map maximum$transpose y]

import Data.List
main=interact$show.f.tail.lines
f y=length[()|x<-y,any(uncurry(==))$zip x(map maximum$transpose y)]

import Data.List
import Control.Monad
main = do
  [n,m] <- liftM (map read . words) getLine
  gs <- liftM transpose (replicateM n getLine)
  print $ length $ filter id $ foldr1 (zipWith (||)) $  map best gs
best gs = map (== maximum gs) gs

import Data.Char
import Data.List
main :: IO ()
main = interact work

work :: String -> String
work = (++"\n") . show . length . filter id . solve . map (map digitToInt) . tail . lines

solve :: [[Int]] -> [Bool]
solve x = map (calc $ transpose x) x

calc :: [[Int]] -> [Int] -> Bool
calc grades student = or $ zipWith (>=) student $ map maximum grades

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

main = do
  _ <- getLine
  nms <- map (map digitToInt) <$> lines <$> getContents
  print $ solve nms

solve :: [[Int]] -> Int
solve nms = length $ filter id $ map (p nms) nms
p nms ms = or $ zipWith (>=) ms $ map maximum $ transpose nms

main :: IO ()
main = interact solve

solve :: String -> String
solve xs = let
 lxs = lines xs
 top = words $ head lxs
 n = read $ head top
 m = read $ head $ drop 1 top
 rest = tail lxs
 dat = map (\x->map (read.return) x) rest
 in show $ ans (n,m,dat)

ans :: (Int,Int,[[Int]]) -> Int
ans (n,m,dat) = foldr (\x y->if x then y+1 else y) 0 $ map isSame [0..n-1] where
 isSame t = any (\x->dat!!t!!x == maxP x) [0..m-1]
 maxP t = foldr max 0 [ dat!!p!!t | p<-[0..n-1]]

import Data.List
bests xs = map fst.filter ((== mx).snd).zip [0..]$xs
	where mx = maximum xs
succesful = length.nub.concat.map bests
main=interact$show.succesful.transpose.tail.lines

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

process t = map (\z-> if z==ma then '1' else '0') t
	where ma= maximum t

myor a b = zipWith myor1 a b

myor1 '0' '0' = '0'
myor1 _ _ = '1'

main= do
	[n,m]<- map read.words <$> getLine ::IO [Int]
	s<- transpose. lines <$> getContents ::IO [String]
	let s1= foldl1 (myor) $ map process s
	print $ length $ filter (=='1') s1

import System.IO
import Control.Monad
import Data.List

readL :: Int -> IO [String]
readL n = sub n []
  where sub 0 l = return l
        sub n l = do ll <- getLine
                     sub (n-1) (l ++ [ll])

flatten :: [[a]] -> [a]
flatten [[]] = []
flatten ([]:ys) = flatten ys
flatten ((x:xs):ys) = x:(flatten (xs:ys))

rotate :: [String] -> [String]
rotate l = sub l []
  where sub l acc
          | flatten l == [] = acc
          | otherwise       = sub (map tail l) ((foldl (\ac x -> (head x):ac) "" l):acc)

getInt :: IO Int
getInt = readLn

cntList :: String -> [Int]
cntList str = sub '0' 0 str []
  where sub c idx [] l = l
        sub c idx (x:xs) l = if c < x then sub x (idx+1) xs [idx]
                             else if c == x then sub x (idx+1) xs (idx:l)
                                  else sub c (idx+1) xs l

main :: IO ()
main = do
  f <- getLine
  let ps = map (\x -> read x) (words f)
  cs <- readL $ head ps
  --putStrLn . show $ cs
  --putStrLn . show $ map cntList (rotate cs)
  putStrLn . show . length . nub . concat $ map cntList (rotate cs)
--  mapM (\x -> putStrLn x) $ rotate cs
  return ()

import Data.List
main=getLine >>= (\x -> (\[n,m] -> print.(slv n m).(map (\x -> map f x)).(take n).lines =<< getContents)(map read $ (words x)) )
f :: Char -> Int; f '0'=0; f '1'=1;f '2'=2; f '3'=3;f '4'=4; f '5'=5;f '6'=6; f '7'=7;f '8'=8; f '9'=9;
slv n m as = length $ filter (==True) $ map (\x -> g n m x (transpose as)) as
g n' m' s as = or $ [((s)!!m `best` (as!!m)) | m <- [0..(m'-1)], n <- [0..(n'-1)]]
best x xs = x >= maximum xs

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

transpose ([]:_) = []
transpose l =
    (map (\(x:xs) -> x) l) : (transpose (map (\(x:xs) -> xs) l))

find_best grades =
    [i | (i, x) <- zip [1..] grades, x == best]
    where best = maximum grades

solve grades n =
    let students = map find_best grades
        all_students = Set.unions $ map Set.fromList students
    in
      Set.size all_students

main = do
  (n:_) <- (getLine >>= return . map (read::String->Int) . words)
  xs <- forM [1..n] (\_ -> getLine >>= (return . map digitToInt))
  -- print $ transpose xs
  print $ solve (transpose xs) n

--import Data.Vector
import Numeric
import Data.List
main = do
 nm <- getLine
 cs <- getContents
 let (n:m:_) = map (fst.head.readDec) $ words nm
 print.answer (n,m).take n.lines $ cs

answer :: (Int,Int) -> [[Char]] -> Int
answer (n,m) xs =
 let xy = split n [(x,y) | x <- [0..m-1],y <- [0..n-1]]
 in  snd.foldl count (0,1).sort.concat $ map (f xs) xy
 where
  f :: [[Char]] -> [(Int,Int)] -> [Int]
  f xs xys = let grades = map (value xs) xys
                 maX = foldl max '1' grades
             in third.foldl g (maX ,0, []) $ grades
  g (a,k,success) b = if a == b then (a,k+1,k:success)
                                else (a,k+1,  success)

count (a,k) b = if a < b then (b,k+1) else (a,k)

third (_,_,x) = x

split n [] = []
split n xs = a:split n b
 where
  (a,b) = splitAt n xs

value xs (x,y) = (xs !! y ) !! x

--import Data.Vector
import Numeric
import Data.List
main = do
 nm <- getLine
 cs <- getContents
 let (n:m:_) = map (fst.head.readDec) $ words nm
 print.answer (n,m).take n.lines $ cs

answer :: (Int,Int) -> [[Char]] -> Int
answer (n,m) xs =
 let xy = split n [(x,y) | x <- [0..m-1],y <- [0..n-1]]
 in  snd.foldl count (0,1).sort.concat $ map (f xs) xy
 where
  f :: [[Char]] -> [(Int,Int)] -> [Int]
  f xs xys = let grades = map (value xs) xys
                 maX = foldl max '1' grades
             in third.foldl g (maX ,0, []) $ grades
  g (a,k,success) b = if a == b then (a,k+1,k:success)
                                else (a,k+1,  success)

count (a,k) b = if a < b && a /= 0 then (b,k+1) else (a,k)

third (_,_,x) = x

split n [] = []
split n xs = a:split n b
 where
  (a,b) = splitAt n xs

value xs (x,y) = (xs !! y ) !! x


main = do
  n <- readLn
  print n
  putStrLn $ unwords $ replicate n "1"

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

main = do
		n<-read<$> getLine ::IO Int
		print n
		putStrLn $ concat $ replicate n "1 "

process :: Int -> [Int]
process n = take n $ repeat 1

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    print n
    putStrLn.unwords.map show $ process n

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RankNTypes #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
-- import Data.List
-- import qualified Data.Vector.Unboxed as VU
-- import qualified Data.Vector.Unboxed.Mutable as VUM
-- import Control.Monad
-- import Control.Monad.ST
-- import Debug.Trace
-- trace _ = id

solve :: Int -> (Int, [Int])
solve n = (n, take n (repeat 1))

readBInt :: B.ByteString -> Int
readBInt = fst . fromJust . B.readInt

tmain :: B.ByteString -> (Int, [Int])
tmain cont =
  let remLines0 = map B.words (B.lines cont)
      [bs_n]:remLines1 = remLines0
      n = readBInt bs_n
  in solve n

outAnswer :: (Int, [Int]) -> IO ()
outAnswer (n, xs) = do
  putStrLn $ show $ n
  putStrLn $ unwords $ map show $ xs

main :: IO ()
main = outAnswer . tmain =<< B.getContents

-- Codeforces Round #534 Div.2 (A), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  print $ n
  putStrLn $ intersperse ' ' $ replicate n '1'


solve :: [Int] -> [(Int, Int)]
solve [] = []
solve (x:xs) = (c1, c2) : solve xs
    where
        c2 = div (x + 1) 3
        c1 = x - c2 * 2

parseIn = tail . map (read :: String -> Int) . words

parseOut [] = ""
parseOut ((x, y):l) = show x ++ " " ++ show y ++"\n"++parseOut l

main :: IO ()
main = interact $ parseOut . solve . parseIn

import Control.Monad (replicateM_)

solve n = if d1 < d2
  then (c1, c2)
  else (c1 - 2, c2 + 1)
  where
    (d1, d2) = (n `rem` 3, 3 - n `rem` 3)
    (c1, c2) = (n `div` 3 + n `rem` 3, n `div` 3)

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    (c1, c2) <- solve <$> readLn
    putStrLn $ show c1 ++ " " ++ show c2

import Control.Arrow ((>>>))
import Data.Bool (bool)

main :: IO ()
main =
  interact $
    words
      >>> drop 1
      >>> map (read >>> solve >>> (\(x, y) -> show x ++ " " ++ show y))
      >>> unlines

solve :: Int -> (Int, Int)
solve n = let (q, r) = n `divMod` 3 in (q + bool 0 1 (r == 1), q + bool 0 1 (r == 2))

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

import Data.List as L
import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  let cnt = div n 3
      (one, two) = case rem n 3 of 0 -> (cnt, cnt)
                                   1 -> (cnt+1, cnt)
                                   2 -> (cnt, cnt+1)
    in putStrLn $ show one ++ " " ++ show two

main = do
  t <- readLn :: IO Int
  replicateM_ t $ solve

----------------------------------------------------------------------------------------
readrows :: (Integral a, Integral b) => b -> IO [[a]]
readrows 0 = return []
readrows n = do
  row <- readInts
  l <- readrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs

import Control.Monad

solve :: Int -> (Int, Int)
solve n
  | a == 2    = (b, b + 1)
  | a == 1    = (b + 1, b)
  | otherwise = (b, b)
  where a = mod n 3
        b = div n 3

printSolve = do
  n <- readLn :: IO Int
  let p = solve n
  putStrLn (show (fst p) ++ " " ++ show (snd p))

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

import Control.Monad

solve n
        | mod n 3 == 2 = [r,r+1]
        | mod n 3 == 1 = [r+1,r]
        | otherwise = [r,r]
        where r = div n 3

printResult = do
    n <- readLn :: IO Integer
    putStrLn . unwords . map show $ solve n

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

module Main where

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

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    n <- readLn :: IO Int
    let d = n `div` 3
        r = n `mod` 3
    printList $ if r == 0 then [d, d] else if r == 1 then [d+1, d] else [d, d+1]

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

solution :: Int -> (Int, Int)
solution n = minimumBy (comparing $ \(n1, n2) -> abs (n1 - n2)) ns
  where
    d = n `div` 3
    ns = (\n2 -> (n - n2 * 2, n2)) <$> [d + i | i <- [-2 .. 2]]

main :: IO ()
main = do
  testCases <- read <$> getLine
  forM_ [1 .. testCases] $ \_ -> do
    n <- read <$> getLine
    uncurry (printf "%d %d\n") $ solution n

import Control.Monad
import Data.List

-- c1+2c2=n
-- c1=c2+1
-- c2+2c2+1 = n
-- c2*3+1=n

-- c2=c1+1
-- c1+2c1+2=n

-- c1=c1
-- c1+2c1=n

calc :: Int -> [Int]
calc n | n `mod` 3 == 0 =
         let c1 = n `div` 3
             c2 = c1 in [c1,c2]
calc n | n `mod` 3 == 1 =
         let c2 = (n-1) `div` 3
             c1 = c2+1 in [c1,c2]
calc n | n `mod` 3 == 2 =
         let c1 = (n-2) `div` 3
             c2 = c1+1 in [c1,c2]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    putStrLn $ intercalate " " $ map show $ calc n

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

-- (ghc -Werror -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > tmp.txt  &&  diff -sdu -- output.txt tmp.txt  &&  cat -- tmp.txt)

import Prelude
import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readLn :: IO [Integer]

    (putStr . unlines . map (showL . solve)) tcs

solve n | (m == 0) = [x, x]
        | (m == 1) = [x+1, x]
        | (m == 2) = [x, x+1]
        | otherwise = undefined
  where
    x = n `div` 3
    m = n `mod` 3

showL = intercalate " " . map show

module Main where
main = interact solve

solve :: String -> String
solve inp =
    let
        t = read . head . lines $ inp :: Int
        arr = (read <$>) . take t . tail . lines $ inp :: [Int]
        logic x =
            case x `mod` 3 of
                0 -> (x `div` 3, x `div` 3)
                2 -> (x `div` 3, x `div` 3 + 1)
                _ -> (x `div` 3 + 1, x `div` 3)
    in
        unlines . map ((\(a, b) -> show a ++ " " ++ show b) . logic) $ arr

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

solution :: Int -> (Int, Int)
solution n = minimumBy (comparing $ \(n1, n2) -> abs (n1 - n2)) ns
  where
    d = n `div` 3
    ns = (\n2 -> (n - n2 * 2, n2)) <$> [d + i | i <- [-2 .. 2]]

main :: IO ()
main = do
  testCases <- read <$> getLine
  forM_ [1 .. testCases] $ \_ -> do
    n <- read <$> getLine
    uncurry (printf "%d %d") $ solution n

import Control.Monad
import Text.Printf

solution :: Int -> (Int, Int)
solution n = (n1, n2)
  where
    n1 = n `div` 3
    n2 = n - n1 * 2

main :: IO ()
main = do
  testCases <- read <$> getLine
  forM_ [1 .. testCases] $ \_ -> do
    n <- read <$> getLine
    uncurry (printf "%d %d") $ solution n

import Control.Monad
import Data.List

calc :: Int -> [Int]
calc n | n == 1 = [1,0]
calc n | n == 2 = [0,1]
calc n | n `mod` 2 == 0 =
         let [a,b] = calc (n `div` 2) in
           [2*a,2*b]
calc n | n `mod` 2 == 1 =
         let [a,b] = calc (n-1) in
           [a+1,b]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    putStrLn $ intercalate " " $ map show $ calc n


import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S
main :: IO()
main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    a <- fmap (map (unBox . C.readInt) . C.words) C.getLine :: IO [Int]
    if n>m
        then putStrLn "YES"
        else do
            let solved = solve m a S.empty
            if S.member 0 solved then putStrLn "YES" else putStrLn "NO"

solve :: Int -> [Int] -> S.Set Int -> S.Set Int
solve m [] ans = ans
solve m (a:as) ans =
    let mV = a `rem` m
        newS = S.insert mV $ S.union (ans) (S.map (\x -> rem (x+mV) m) ans)
    in solve m as newS

unBox (Just (a,b)) = a
unBox Nothing = 0

import qualified Data.Set as S
main=interact $ solve. map read. words
solve (_:m:x)=  f S.empty x
        where f _ [] = "NO"
              f s (x:xs) = let members=S.toList s
                               s'=S.fromList members
                               s'' = S.insert (mod x m) $ foldl (\s k->S.insert  (mod (k+x)  m) s) s' members
                           in
                               if  S.member 0 s'' then "YES" else f s'' xs

import qualified Data.List as L
import qualified Data.Set as S

main :: IO()
main = output . solve . L.map read . words =<< getContents

solve :: [Int] -> Bool
solve (n:m:a) = solve' a S.empty
    where
        solve' :: [Int] -> (S.Set Int) -> Bool
        solve' _      s | S.member 0 s = True
        solve' []     _ = False
        solve' (a:ax) s = let si = S.singleton (mod a m)
                              sn = S.map (\x -> mod (x + a) m) s
                              ssi = S.union s si
                              sin = S.union ssi sn
                          in  solve' ax sin

output :: Bool -> IO()
output True  = putStrLn "YES"
output False = putStrLn "NO"

import Data.List
import qualified Data.ByteString.Char8 as SS
readInt bs = case SS.readInt bs of Just (i, _) -> i
readInts = map readInt . SS.words
parse = map readInts . SS.lines
solve [[n,m], a] = helper a []
    where helper [] _ = "NO"
          helper (a0:as) l
              | 0 `elem` l' = "YES"
              | otherwise = helper as l'
              where l' =  unique . sort . iter $ l
                    iter l = a0 `mod` m:l ++ map (\x -> (x + a0) `mod` m) l
          unique (a1:a2:as)
              | a1 == a2 = unique (a2:as)
              | otherwise = a1 : unique (a2:as)
          unique x = x
main = putStrLn . solve . parse =<< SS.getContents

import Data.List
import qualified Data.Set as S
main :: IO()
main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let solved = solve m a S.empty
    if S.member 0 solved then putStrLn "YES" else putStrLn "NO"

solve m [] ans = ans
solve m (a:as) ans =
    let mV = a `rem` m
        newS = S.union ans (S.map (\x -> rem (x+mV) m) ans)
    in solve m as newS

import Data.List
import qualified Data.ByteString.Char8 as SS
readInt bs = case SS.readInt bs of Just (i, _) -> i
readInts = map readInt . SS.words
parse = map readInts . SS.lines
solve [[n,m], a] = helper a []
    where helper [] _ = "NO"
          helper (a0:as) l
              | 0 `elem` l' = "YES"
              | otherwise = helper as l'
              where l' =  unique . sort . iter $ l
                    iter l = (a0:l) ++ (map (\x -> (x + a0) `mod` m) l)
          unique (a1:a2:as)
              | a1 == a2 = unique (a2:as)
              | otherwise = a1 : (unique (a2:as))
          unique x = x
main = putStrLn . solve . parse =<< SS.getContents