Dora loves adventures quite a lot. During some journey she encountered an amazing city, which is formed by $$$n$$$ streets along the Eastern direction and $$$m$$$ streets across the Southern direction. Naturally, this city has $$$nm$$$ intersections. At any intersection of $$$i$$$-th Eastern street and $$$j$$$-th Southern street there is a monumental skyscraper. Dora instantly became curious and decided to explore the heights of the city buildings.When Dora passes through the intersection of the $$$i$$$-th Eastern and $$$j$$$-th Southern street she examines those two streets. After Dora learns the heights of all the skyscrapers on those two streets she wonders: how one should reassign heights to the skyscrapers on those two streets, so that the maximum height would be as small as possible and the result of comparing the heights of any two skyscrapers on one street wouldn't change.Formally, on every of $$$nm$$$ intersections Dora solves an independent problem. She sees $$$n + m - 1$$$ skyscrapers and for each of them she knows its real height. Moreover, any two heights can be compared to get a result "greater", "smaller" or "equal". Now Dora wants to select some integer $$$x$$$ and assign every skyscraper a height from $$$1$$$ to $$$x$$$. When assigning heights, Dora wants to preserve the relative order of the skyscrapers in both streets. That is, the result of any comparison of heights of two skyscrapers in the current Eastern street shouldn't change and the result of any comparison of heights of two skyscrapers in current Southern street shouldn't change as well. Note that skyscrapers located on the Southern street are not compared with skyscrapers located on the Eastern street only. However, the skyscraper located at the streets intersection can be compared with both Southern and Eastern skyscrapers. For every intersection Dora wants to independently calculate the minimum possible $$$x$$$.For example, if the intersection and the two streets corresponding to it look as follows:  Then it is optimal to replace the heights of the skyscrapers as follows (note that all comparisons "less", "equal", "greater" inside the Eastern street and inside the Southern street are preserved)  The largest used number is $$$5$$$, hence the answer for this intersection would be $$$5$$$.Help Dora to compute the answers for each intersection.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 1000$$$) — the number of streets going in the Eastern direction and the number of the streets going in Southern direction. Each of the following $$$n$$$ lines contains $$$m$$$ integers $$$a_{i,1}$$$, $$$a_{i,2}$$$, ..., $$$a_{i,m}$$$ ($$$1 \le a_{i,j} \le 10^9$$$). The integer $$$a_{i,j}$$$, located on $$$j$$$-th position in the $$$i$$$-th line denotes the height of the skyscraper at the intersection of the $$$i$$$-th Eastern street and $$$j$$$-th Southern direction.

Print $$$n$$$ lines containing $$$m$$$ integers each. The integer $$$x_{i,j}$$$, located on $$$j$$$-th position inside the $$$i$$$-th line is an answer for the problem at the intersection of $$$i$$$-th Eastern street and $$$j$$$-th Southern street.

NoteIn the first example, it's not possible to decrease the maximum used height for the problem at any intersection, hence we don't have to change any heights.In the second example, the answers are as follows:   For the intersection of the first line and the first column  For the intersection of the first line and the second column  For the intersection of the second line and the first column  For the intersection of the second line and the second column

{-# LANGUAGE BangPatterns #-}
module Main where

import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.State
import Data.Int

import Data.Array.Unboxed ((!))

import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.Array as A
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as AU
import qualified Data.List as L

readInt :: Num a => BS.ByteString -> a
readInt bs = case BS.readInt bs of
  Just (i, _) -> fromIntegral i
  Nothing -> error $ "Not an integer: " ++ show bs

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents

type LineReader a = State [BS.ByteString] a

currentLine :: LineReader BS.ByteString
currentLine = do
  ls <- get
  let (x, xs) = case ls of
        [] -> error "No remain lines."
        l -> (head l, tail l)
  put xs
  return x

restLines :: LineReader [BS.ByteString]
restLines = do
  xs <- get
  put []
  return xs

readDim :: BS.ByteString -> (Int32, Int32)
readDim line =
  let [m, n] = map readInt $ BS.words line in (m, n)

readHeights :: [BS.ByteString] -> [[Int32]]
readHeights = map (map readInt . BS.words)

type XY = (Int32, Int32)
type HM = AU.UArray XY Int32

data Pair a b = P !a !b

data Pos = PS {
  lt :: !Int32,
  ge :: !Int32
}

toArray :: Int32 -> Int32 -> [[Int32]] -> HM
toArray m n hs = AU.listArray ((1, 1), (m, n)) $ mconcat hs

g :: HM -> [XY] -> [Pair XY Pos]
g arr xys = e $ mconcat $ zipWith f [0..] gs
  where
    gs = L.groupBy (\x y -> arr ! x == arr ! y) $ L.sortOn (arr!) xys
    numV = fromIntegral $ length gs
    f i = map (flip P p)
      where
        p = PS{lt = i, ge = numV - i}

    m !x y = y
    e [] = []
    e (x:xs) = m (m x (e xs)) (x:xs)

solve :: HM -> A.Array XY Int32
solve hs = STA.runSTArray $ do
  answer <- STA.newArray ((1, 1), (n ,m)) (PS 0 0)
  let ua (P x y) = updateAnswer' answer x y
  getNormalPos ua
  getTransPos ua
  STA.mapArray (\(PS x y) -> x + y) answer
  where
    (_, (n, m)) = AU.bounds hs
    getPos mkXy runDim fixedDim = g hs $ map (mkXy fixedDim) runDim

    getNormalPos ua = forM_ [1..n] $ mapM_ ua . getPos (,) [1..m]
    getTransPos ua = forM_ [1..m] $ mapM_ ua . getPos (flip (,)) [1..n]

    updateAnswer PS{lt = lt1, ge = ge1} PS{lt = lt2, ge = ge2} =
      PS{lt = max lt1 lt2, ge = max ge1 ge2}

    updateAnswer' :: STA.STArray s XY Pos -> XY -> Pos -> ST s ()
    updateAnswer' ans xy new = do
      old <- STA.readArray ans xy
      STA.writeArray ans xy (updateAnswer old new)

main :: IO ()
main = do
  ls <- readLines
  let (answer, _) = flip runState ls $ do
      (n, m) <- readDim <$> currentLine
      hs <- toArray n m . readHeights <$> restLines
      return $ solve hs
  let (_, (n ,m)) = A.bounds answer
  let out = unlines $ flip map [1..n] $ \i -> unwords $
        flip map [1..m] $ \j -> show . (answer!) $ (i, j)
  putStrLn out

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()
printList = putStrLn . intercalate " " . map show :: [Int] -> IO ()

---- Answer Code Section ----

type Int2D = Array Int (Array Int Int)

minifyLine line = map (\h -> Set.findIndex h set + 1) line where
    set = foldl (flip Set.insert) Set.empty line

process :: [[Int]] -> Int -> Int -> [[Int]]
process area n m = [ [ solve i j | j <- [1..m] ] | i <- [1..n] ] where
    iLines = map minifyLine area
    jLines = map minifyLine (transpose area)
    iLines' = force $ listArray (1, n) $ map (listArray (1, m)) iLines :: Int2D
    jLines' = force $ listArray (1, m) $ map (listArray (1, n))jLines :: Int2D
    iMaxs = force $ listArray (1, n) $ map maximum iLines :: Array Int Int
    jMaxs = force $ listArray (1, m) $ map maximum jLines :: Array Int Int
    solve i j = max maxI maxJ where
        iOffset = max (jLines' ! j ! i - iLines' ! i ! j) 0
        jOffset = max (iLines' ! i ! j - jLines' ! j ! i) 0
        maxI = iMaxs ! i + iOffset
        maxJ = jMaxs ! j + jOffset

main = do
    n:m:[] <- getInts
    area <- replicateM n getInts
    printArea $ process area n m

printArea = printStrs . map (intercalate " " . map show) :: [[Int]] -> IO ()


You are given a tree of $$$n$$$ vertices numbered from $$$1$$$ to $$$n$$$, with edges numbered from $$$1$$$ to $$$n-1$$$. A tree is a connected undirected graph without cycles. You have to assign integer weights to each edge of the tree, such that the resultant graph is a prime tree.A prime tree is a tree where the weight of every path consisting of one or two edges is prime. A path should not visit any vertex twice. The weight of a path is the sum of edge weights on that path.Consider the graph below. It is a prime tree as the weight of every path of two or less edges is prime. For example, the following path of two edges: $$$2 \to 1 \to 3$$$ has a weight of $$$11 + 2 = 13$$$, which is prime. Similarly, the path of one edge: $$$4 \to 3$$$ has a weight of $$$5$$$, which is also prime.  Print any valid assignment of weights such that the resultant tree is a prime tree. If there is no such assignment, then print $$$-1$$$. It can be proven that if a valid assignment exists, one exists with weights between $$$1$$$ and $$$10^5$$$ as well.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains one integer $$$n$$$ ($$$2 \leq n \leq 10^5$$$) — the number of vertices in the tree. Then, $$$n-1$$$ lines follow. The $$$i$$$-th line contains two integers $$$u$$$ and $$$v$$$ ($$$1 \leq u, v \leq n$$$) denoting that edge number $$$i$$$ is between vertices $$$u$$$ and $$$v$$$. It is guaranteed that the edges form a tree. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, if a valid assignment exists, then print a single line containing $$$n-1$$$ integers $$$a_1, a_2, \dots, a_{n-1}$$$ ($$$1 \leq a_i \le 10^5$$$), where $$$a_i$$$ denotes the weight assigned to the edge numbered $$$i$$$. Otherwise, print $$$-1$$$. If there are multiple solutions, you may print any.

NoteFor the first test case, there are only two paths having one edge each: $$$1 \to 2$$$ and $$$2 \to 1$$$, both having a weight of $$$17$$$, which is prime.  The second test case is described in the statement.It can be proven that no such assignment exists for the third test case.

import Data.Array
import Data.Array.ST
import Numeric (readDec)
import Data.Char (isSpace)
import Data.List (find)
import Control.Monad (replicateM, replicateM_)
import Control.Applicative (liftA, liftA2)
 -- Tree with node data of type a, and edge data of type b
type Tree a b = Array a [(a, b)]

data StopReason = EndOfPath | NotATree

main :: IO ()
main = read <$> getLine >>= flip replicateM_ singleCase

singleCase :: IO ()
singleCase = read <$> getLine >>=
             \n -> replicateM (n-1) getPair >>=
                   printWeights . liftA (assignWeights (n-1)) .
                   findPath . createT n

printWeights :: Maybe (Array Int Int) -> IO ()
printWeights Nothing = print (-1 :: Int)
printWeights (Just a) = mapM_ (\x -> putStr $ show x ++ " " ) a >> putStrLn ""

getPair :: IO (Int, Int)
getPair = getLine >>= \s -> case map read (words s) of
                              [v1, v2] -> return (v1, v2)
                              _        -> error "Expecting two integers to represent an edge"

createT :: Int -> [(Int, Int)] -> Tree Int Int
createT n = accumArray (flip (:)) [] (1, n) .
            concatMap (\(e, (v1, v2)) -> [(v1, (v2,e)), (v2, (v1, e))]) .
            zip [(1::Int)..]

findPath :: Tree Int Int -> Maybe [Int]
findPath t = case t!1 of
               [(v, e)] -> liftA (e:) $ findPathFrom 1 v t
               [(v1, e1), (v2, e2)] ->
                 liftA2 (++) (reverse <$> findPathFrom 1 v1 t)
                 $ liftA (\l -> e1:e2:l) (findPathFrom 1 v2 t)
               _ -> Nothing

findPathFrom :: Int -> Int -> Tree Int Int -> Maybe [Int]
findPathFrom p c t = case findNext p c t of
                       Right (v, e) -> liftA (e:) $ findPathFrom c v t
                       Left EndOfPath -> Just []
                       Left NotATree -> Nothing

assignWeights :: Int -> [Int] -> Array Int Int
assignWeights nedges edgeorder = let a = 3:2:a in
                                   array (1, nedges) $ zip edgeorder a

findNext :: Int -> Int -> Tree Int Int -> Either StopReason (Int, Int)
findNext prev curr t = case t!curr of
                         [(prev, _)] -> Left EndOfPath
                         [(v1, e1), (v2, e2)] -> if (v1 == prev)
                                                 then Right (v2, e2)
                                                 else if (v2 == prev)
                                                      then Right (v1, e1)
                                                      else error "One vertex must be previous: Tree corruption."
                         _ -> Left NotATree

import Data.Array
import Numeric (readDec)
import Data.Char (isSpace)
import Data.List (find)
import Control.Monad (replicateM, replicateM_)
import Control.Applicative (liftA2)
 -- Tree with node data of type a, and edge data of type b
type Tree a b = Array a [(a, b)]

getPair :: String -> (Int, Int)
getPair s = case (readDec s) of
              [(i1, s1)] -> case (readDec (dropWhile isSpace s1)) of
                              [(i2, [])] -> (i1, i2)
                              _          -> error "Not a pair of ints"

readPairs :: Int -> IO [(Int, Int)]
readPairs n = replicateM n (getPair <$> getLine)

cAL :: Int -> [(Int, Int)] -> Tree Int Int
cAL n el = accumArray (flip (:)) [] (1,n) adjL
  where adjL = concat $ zipWith (\e (v1, v2) -> [(v1, (v2, e))
                                                ,(v2, (v1, e))]) [1..n] el

readTreeInt :: Int -> IO (Tree Int Int)
readTreeInt n =  cAL n <$> readPairs (n-1)

printArrayLn :: (Show a) => [a] -> IO ()
printArrayLn xs = mapM_ (\x -> putStr (show x) >> putStr " ") xs >> putStrLn ""

singleCase :: IO ()
singleCase = read <$> getLine >>= readTreeInt >>= printArrayLn . soln

main :: IO ()
main = read <$> getLine >>= \n -> replicateM_ n singleCase

soln :: Tree Int Int -> [Int]
soln t = case colorEdges t of
           Just cs -> map (\c -> if c then 2 else 3) cs
           Nothing  -> [-1]

colorEdges :: Tree Int Int -> Maybe [Bool]
colorEdges t =  evenPos <$> findPath t

evenPos :: [a] -> [Bool]
evenPos [] = []
evenPos [_] = [False]
evenPos (x:y:xs) = False:True:evenPos xs

findPath :: Tree Int Int -> Maybe [Int] -- list of edges if the tree is a path
findPath t = case t!1 of
               [(v1, e1)] -> liftA2 (:) (Just e1) (trav t v1 (a//[(1, True), (v1, True)]))
               [(v1, e1), (v2, e2)] -> liftA2 (:) (Just e1) (trav t v1 (a//[(1, True), (v1, True)]))
                                       `maybeconcat`
                                       liftA2 (:) (Just e2) (trav t v2 (a//[(1, True), (v2, True)]))
  where a = fmap (const False) t
        -- trav :: Tree Int Int -> Int -> Array Int Bool -> Maybe [Int]
        -- trav = undefined
        maybeconcat xm ym = liftA2 (++) xm (reverse <$> ym)

trav :: (Ix a, Eq b) => Tree a b -> a -> Array a Bool -> Maybe [b]
trav t v a = case filter (\(v, _) -> not (a!v)) (t!v) of
                       [(vn, en)] ->  liftA2 (:) (Just en) (trav t vn (a//[(vn, True)]))
                       [] -> Just []
                       _ -> Nothing

import Data.Array
import Numeric (readDec)
import Data.Char (isSpace)
import Data.List (find)
import Control.Monad (replicateM, replicateM_)
 -- Tree with node data of type a, and edge data of type b
type Tree a b = Array a [(a, b)]

getPair :: String -> (Int, Int)
getPair s = case (readDec s) of
              [(i1, s1)] -> case (readDec (dropWhile isSpace s1)) of
                              [(i2, [])] -> (i1, i2)
                              _          -> error "Not a pair of ints"

readPairs :: Int -> IO [(Int, Int)]
readPairs n = replicateM n (getPair <$> getLine)

cAL :: Int -> [(Int, Int)] -> Tree Int Int
cAL n el = accumArray (flip (:)) [] (1,n) adjL
  where adjL = concat $ zipWith (\e (v1, v2) -> [(v1, (v2, e))
                                                ,(v2, (v1, e))]) [1..n] el

readTreeInt :: Int -> IO (Tree Int Int)
readTreeInt n =  cAL n <$> readPairs (n-1)

soln :: Tree Int Int -> [Int]
soln t = case rangeSize (bounds t) of
           2 -> [3]
           3 -> [2, 3]
           _ -> case validTree t of
                  Just i -> primesWith2At i (rangeSize (bounds t))
                  Nothing -> [-1]

primesWith2At :: Int -> Int -> [Int]
primesWith2At i n = take (i-1) [3,3..] ++ (2:take (n-i-1) [3,3..])

printArrayLn :: (Show a) => [a] -> IO ()
printArrayLn xs = mapM_ (\x -> putStr (show x) >> putStr " ") xs >> putStrLn ""

singleCase :: IO ()
singleCase = read <$> getLine >>= readTreeInt >>= printArrayLn . soln

main :: IO ()
main = read <$> getLine >>= \n -> replicateM_ n singleCase

findDegrees :: Tree Int Int -> Array Int Int
findDegrees = fmap length

degreeDigest :: Tree Int Int -> Maybe (Int, Int)
degreeDigest t = case f (findDegrees t) of
                   [v1, v2] -> Just (v1, v2)
                   _        -> Nothing
  where
    f :: Array Int Int -> [Int]
    f a = filter (\i -> a!i/=1) $ indices a

findEdge :: Tree Int Int -> (Int, Int) -> Maybe Int
findEdge t (v1, v2) = fst <$> find (\ve -> v2 == fst ve) (t!v1)

validTree :: Tree Int Int -> Maybe Int -- return the edge which will have 2
validTree t = findEdge t =<< degreeDigest t


Polycarp remembered the $$$2020$$$-th year, and he is happy with the arrival of the new $$$2021$$$-th year. To remember such a wonderful moment, Polycarp wants to represent the number $$$n$$$ as the sum of a certain number of $$$2020$$$ and a certain number of $$$2021$$$.For example, if:   $$$n=4041$$$, then the number $$$n$$$ can be represented as the sum $$$2020 + 2021$$$;  $$$n=4042$$$, then the number $$$n$$$ can be represented as the sum $$$2021 + 2021$$$;  $$$n=8081$$$, then the number $$$n$$$ can be represented as the sum $$$2020 + 2020 + 2020 + 2021$$$;  $$$n=8079$$$, then the number $$$n$$$ cannot be represented as the sum of the numbers $$$2020$$$ and $$$2021$$$. Help Polycarp to find out whether the number $$$n$$$ can be represented as the sum of a certain number of numbers $$$2020$$$ and a certain number of numbers $$$2021$$$.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case contains one integer $$$n$$$ ($$$1 \leq n \leq 10^6$$$) — the number that Polycarp wants to represent as the sum of the numbers $$$2020$$$ and $$$2021$$$.

For each test case, output on a separate line:    "YES" if the number $$$n$$$ is representable as the sum of a certain number of $$$2020$$$ and a certain number of $$$2021$$$;  "NO" otherwise.  You can output "YES" and "NO" in any case (for example, the strings yEs, yes, Yes and YES will be recognized as positive).

import Control.Monad
import Data.Bool

answer :: Integer -> Bool
answer n =
  let divnum = div n 2020 in
  (2020 * divnum) <= n && n <= (2021 * divnum)

main = do
  n <- read <$> getLine
  replicateM_ n $ do
    i <- read <$> getLine
    putStrLn $ bool "NO" "YES" $ answer i

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

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))

import Data.Array((!))
import Control.Monad(replicateM)
import Data.Maybe

solve n = mod2020 <= div2020
	where
		mod2020 = mod n 2020
		div2020 = div n 2020

plotResult True = putStrLn "YES"
plotResult False = putStrLn "NO"

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[n] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve n

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
    x <- readLn :: IO Int
    let d = x `div` 2020
        r = x `mod` 2020
    putStrLn . yesOrNo . (d>=) $ r

main = interact $ unlines . map (solve . read) . tail . lines

solve n
    | n - x * 2020 <= x = "YES"
	| otherwise = "NO"
  where x = n `div` 2020

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

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

test :: IO ()
test = do
  n <- read <$> getLine :: IO Integer
  putStrLn $ bool "YES" "NO" $ n `mod` 2020 > n `div` 2020

good :: Int -> Bool
good n
    | n < 0     = False
    | otherwise = n `mod` 2020 == 0 || good (n - 2021)

process :: [String] -> String
process (_ : inp) = unlines $ map solve inp
    where solve s = if good (read s :: Int) then "YES" else "NO"

main :: IO ()
main = interact (process . lines)

-- Trying to use only ByteString I/O with a state monad this contest

import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.ByteString.Lazy.Char8 as P

getSLine :: Monad m => StateT P.ByteString m P.ByteString
getSLine = do
  (out, next) <- P.break (== '\n') <$> get
  put $ P.tail next
  pure out

readInts :: Monad m => StateT P.ByteString m [Int]
readInts = do
  currLine <- getSLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

-- There has to be a combinator for this. But where?
outLine :: P.ByteString -> StateT P.ByteString IO ()
outLine v = StateT $ \s -> ((), s) <$ P.putStrLn v

main :: IO ()
main = (P.getContents >>=) $ evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    let  w = mod (0-n) 2021
    outLine . P.pack $ if  n >= w * 2020
      then  "YES"
      else  "NO"


As their story unravels, a timeless tale is told once again...Shirahime, a friend of Mocha's, is keen on playing the music game Arcaea and sharing Mocha interesting puzzles to solve. This day, Shirahime comes up with a new simple puzzle and wants Mocha to solve them. However, these puzzles are too easy for Mocha to solve, so she wants you to solve them and tell her the answers. The puzzles are described as follow.There are $$$n$$$ squares arranged in a row, and each of them can be painted either red or blue.Among these squares, some of them have been painted already, and the others are blank. You can decide which color to paint on each blank square.Some pairs of adjacent squares may have the same color, which is imperfect. We define the imperfectness as the number of pairs of adjacent squares that share the same color.For example, the imperfectness of "BRRRBBR" is $$$3$$$, with "BB" occurred once and "RR" occurred twice.Your goal is to minimize the imperfectness and print out the colors of the squares after painting.

Each test contains multiple test cases.  The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Each test case consists of two lines. The first line of each test case contains an integer $$$n$$$ ($$$1\leq n\leq 100$$$) — the length of the squares row. The second line of each test case contains a string $$$s$$$ with length $$$n$$$, containing characters 'B', 'R' and '?'. Here 'B' stands for a blue square, 'R' for a red square, and '?' for a blank square.

For each test case, print a line with a string only containing 'B' and 'R', the colors of the squares after painting, which imperfectness is minimized. If there are multiple solutions, print any of them.

NoteIn the first test case, if the squares are painted "BRRBRBR", the imperfectness is $$$1$$$ (since squares $$$2$$$ and $$$3$$$ have the same color), which is the minimum possible imperfectness.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

module Main where

import qualified Data.ByteString.Char8 as C8
import           Control.Monad.Reader (replicateM_)

readInput :: C8.ByteString -> [[Int]]
readInput = map
  (map
     (\str -> let (Just (i, _)) = C8.readInt str
              in i)
   . C8.words)
  . C8.lines

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t
    $ do
      n <- readLn :: IO Int
      colors <- head . C8.words <$> C8.getLine
      C8.putStrLn $ solve colors

solve :: C8.ByteString -> C8.ByteString
solve xs
  | C8.unpack xs == "?" = "B"
  | countMarks (C8.length xs - 1) xs == 0 = xs
  | otherwise = let len = C8.length rr - 1
                    rr = C8.pack . insertR $ C8.unpack xs
                    bb = C8.pack . insertB $ C8.unpack xs
                in if countImp len rr > countImp len bb
                   then bb
                   else rr

insertR :: String -> String
insertR [y] = [y]
insertR (x:y:xs)
  | x == '?' = insertR ('R':y:xs)
  | otherwise = if x == 'B' && y == '?'
                then insertR (x:'R':xs)
                else if x == 'R' && y == '?'
                     then insertR (x:'B':xs)
                     else x:insertR (y:xs)

insertB :: String -> String
insertB [y] = [y]
insertB (x:y:xs)
  | x == '?' = insertB ('B':y:xs)
  | otherwise = if x == 'B' && y == '?'
                then insertR (x:'R':xs)
                else if x == 'R' && y == '?'
                     then insertR (x:'B':xs)
                     else x:insertR (y:xs)

countImp :: Num p => Int -> C8.ByteString -> p
countImp 0 _ = 0
countImp len xs =
  if xs `C8.index` len == xs `C8.index` (len - 1) || xs `C8.index` len == '?'
  then 1 + countImp (len - 1) xs
  else countImp (len - 1) xs

countMarks :: Num p => Int -> C8.ByteString -> p
countMarks (-1) _ = 0
countMarks len xs = if xs `C8.index` len == '?'
                    then 1 + countMarks (len - 1) xs
                    else countMarks (len - 1) xs
{-
>>>solve "?B"
"RB"
>>>countMarks 1 "?B"
1

>>>solve "?R??RB??B?"
"BRBRRBRBBR"

>>>solve "?R??RB??B?"
"BRBRRBRBBR"

>>>insertR "?B"
"RB"

>>>insert
Variable not in scope: insert

>>>solve "BR?"
"BRB"

-}

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
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)

main :: IO ()
main = C.interact $ runScanner (numberOf (int *> str)) >>> map (solve >>> C.pack) >>> C.unlines

solve :: String -> String
solve = reverse . tail . scanl fill 'R'  . reverse . scanl1 fill
  where
    fill 'R' '?' = 'B'
    fill 'B' '?' = 'R'
    fill _ c = c

twice :: (a -> a) -> (a -> a)
twice f = f . f

-------------------------- 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 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

import qualified Data.List
import qualified Data.Map
import qualified Data.Set
import Control.Monad

calc :: String -> String
calc [] = []
calc ('R':'?':xs) = 'R':(calc ('B':xs))
calc ('B':'?':xs) = 'B':(calc ('R':xs))
calc ('?':'R':xs) = 'B':(calc ('R':xs))
calc ('?':'B':xs) = 'R':(calc ('B':xs))
calc ('?':'?':xs) = calc ('?':(calc ('?':xs)))
calc ['?'] = ['B']
calc (x:xs) = x:(calc xs)

main = do
  entry <- getLine
  let timer = read entry :: Int
  forM_ [1..timer] $ \_ -> do
    n <- getLine
    array <- getLine
    putStrLn $ calc array

import Control.Monad
import Data.List

calc :: String -> String
calc [] = []
calc ('R':'?':xs) = 'R':(calc ('B':xs))
calc ('B':'?':xs) = 'B':(calc ('R':xs))
calc ('?':'R':xs) = 'B':(calc ('R':xs))
calc ('?':'B':xs) = 'R':(calc ('B':xs))
calc ('?':'?':xs) = calc ('?':(calc ('?':xs)))
calc ['?'] = ['B']
calc (x:xs) = x:(calc xs)

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    unused <- getLine
    line <- getLine
    putStrLn $ calc line

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

module Main where

import qualified Data.ByteString.Char8 as C8
import           Control.Monad.Reader (replicateM_)

readInput :: C8.ByteString -> [[Int]]
readInput = map
  (map
     (\str -> let (Just (i, _)) = C8.readInt str
              in i)
   . C8.words)
  . C8.lines

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t
    $ do
      n <- readLn :: IO Int
      colors <- head . C8.words <$> C8.getLine
      C8.putStrLn $ solve colors

solve :: C8.ByteString -> C8.ByteString
solve xs
  | C8.unpack xs == "?" = "B"
  | countImp (C8.length xs - 1) xs == 0 = xs
  | countMarks (C8.length xs - 1) xs == 0 = xs
  | otherwise = let len = C8.length rr - 1
                    rr = C8.pack . insertR $ C8.unpack xs
                    bb = C8.pack . insertB $ C8.unpack xs
                in if countImp len rr > countImp len bb
                   then bb
                   else rr

insertR :: String -> String
insertR [y] = [y]
insertR (x:y:xs)
  | x == '?' = insertR ('R':y:xs)
  | otherwise = if x == 'B' && y == '?'
                then insertR (x:'R':xs)
                else if x == 'R' && y == '?'
                     then insertR (x:'B':xs)
                     else x:insertR (y:xs)

insertB :: String -> String
insertB [y] = [y]
insertB (x:y:xs)
  | x == '?' = insertB ('B':y:xs)
  | otherwise = if x == 'B' && y == '?'
                then insertR (x:'R':xs)
                else if x == 'R' && y == '?'
                     then insertR (x:'B':xs)
                     else x:insertR (y:xs)

countImp :: Num p => Int -> C8.ByteString -> p
countImp 0 _ = 0
countImp len xs =
  if xs `C8.index` len == xs `C8.index` (len - 1) || xs `C8.index` len == '?'
  then 1 + countImp (len - 1) xs
  else countImp (len - 1) xs

countMarks :: Num p => Int -> C8.ByteString -> p
countMarks (-1) _ = 0
countMarks len xs = if xs `C8.index` len == '?'
                    then 1 + countMarks (len - 1) xs
                    else countMarks (len - 1) xs
{-
>>>solve "?BB"
"RBB"
>>>countMarks 2 "?BB"
1

>>>solve "?R??RB??B?"
"BRBRRBRBBR"

>>>solve "?R??RB??B?"
"BRBRRBRBBR"

>>>solve "BR?"
"BRB"

-}

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

module Main where

import qualified Data.ByteString.Char8 as C8
import           Control.Monad.Reader (replicateM_)

readInput :: C8.ByteString -> [[Int]]
readInput = map
  (map
     (\str -> let (Just (i, _)) = C8.readInt str
              in i)
   . C8.words)
  . C8.lines

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t
    $ do
      n <- readLn :: IO Int
      colors <- head . C8.words <$> C8.getLine
      C8.putStrLn $ solve colors

solve :: C8.ByteString -> C8.ByteString
solve xs
  | C8.unpack xs == "?" = "B"
  | countImp (C8.length xs - 1) xs == 0 = xs
  | countMarks (C8.length xs - 1) xs == 0 = xs
  | otherwise = let len = C8.length rr - 1
                    rr = C8.pack . insertR $ C8.unpack xs
                    bb = C8.pack . insertB $ C8.unpack xs
                in if countImp len rr > countImp len bb
                   then bb
                   else rr

insertR :: String -> String
insertR [y] = [y]
insertR (x:y:xs)
  | x == '?' = insertR ('R':y:xs)
  | otherwise = if x == 'B' && y == '?'
                then insertR (x:'R':xs)
                else if x == 'R' && y == '?'
                     then insertR (x:'B':xs)
                     else x:insertR (y:xs)

insertB :: String -> String
insertB [y] = [y]
insertB (x:y:xs)
  | x == '?' = insertB ('B':y:xs)
  | otherwise = if x == 'B' && y == '?'
                then insertR (x:'R':xs)
                else if x == 'R' && y == '?'
                     then insertR (x:'B':xs)
                     else x:insertR (y:xs)

countImp :: Num p => Int -> C8.ByteString -> p
countImp 0 _ = 0
countImp len xs =
  if xs `C8.index` len == xs `C8.index` (len - 1) || xs `C8.index` len == '?'
  then 1 + countImp (len - 1) xs
  else countImp (len - 1) xs

countMarks 0 _ = 0
countMarks len xs = if xs `C8.index` len == '?'
                    then 1 + countMarks (len - 1) xs
                    else countMarks (len - 1) xs
{-
>>>solve "BB?"
"BBR"

>>>solve "?R??RB??B?"
"BRBRRBRBBR"

>>>solve "?R??RB??B?"
"BRBRRBRBBR"

>>>solve "BR?"
"BRB"

-}

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

module Main where

import qualified Data.ByteString.Char8 as C8
import           Control.Monad.Reader (replicateM_)

readInput :: C8.ByteString -> [[Int]]
readInput = map
  (map
     (\str -> let (Just (i, _)) = C8.readInt str
              in i)
   . C8.words)
  . C8.lines

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t
    $ do
      n <- readLn :: IO Int
      colors <- C8.getLine
      C8.putStrLn $ solve colors

solve :: C8.ByteString -> C8.ByteString
solve xs
  | xs == "?" = "B"
  | countImp (C8.length xs - 1) xs == 0 = xs
  | otherwise = let len = C8.length xs - 2
                    rr = head . C8.words . C8.pack . insertR $ C8.unpack xs
                    bb = head . C8.words . C8.pack . insertB $ C8.unpack xs
                in if countImp len rr > countImp len bb
                   then bb
                   else rr

insertR :: String -> String
insertR [y] = []
insertR (x:y:xs)
  | x == '?' = 'R':insertR ('R':y:xs)
  | otherwise = if x == 'B' && y == '?'
                then 'R':insertR ('R':xs)
                else if x == 'R' && y == '?'
                     then 'B':insertR ('B':xs)
                     else y:insertR (y:xs)

insertB :: String -> String
insertB [y] = []
insertB (x:y:xs)
  | x == '?' = 'B':insertB ('B':y:xs)
  | otherwise = if x == 'B' && y == '?'
                then 'R':insertR ('R':xs)
                else if x == 'R' && y == '?'
                     then 'B':insertR ('B':xs)
                     else y:insertR (y:xs)

countImp :: Num p => Int -> C8.ByteString -> p
countImp 0 _ = 0
countImp len xs = if xs `C8.index` len == xs `C8.index` (len - 1)
                  then 1 + countImp (len - 1) xs
                  else countImp (len - 1) xs
{-
>>>solve "B"
"B"

>>>solve "?R??RB??B?"
"BRBRRBRBBR"

>>>solve "?R??RB??B?"
"BRBRRBRBBR"

>>>solve "BR"
"BR"

-}

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
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)

main :: IO ()
main = C.interact $ runScanner (numberOf str) >>> map (solve >>> showB) >>> C.unlines

solve :: String -> String
solve = twice $ reverse . scanl1 fill
  where
    fill 'R' '?' = 'B'
    fill 'B' '?' = 'R'
    fill _ c = c

twice :: (a -> a) -> (a -> a)
twice f = f . f

-------------------------- 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 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show


Consider all binary strings of length $$$m$$$ ($$$1 \le m \le 60$$$). A binary string is a string that consists of the characters 0 and 1 only. For example, 0110 is a binary string, and 012aba is not. Obviously, there are exactly $$$2^m$$$ such strings in total.The string $$$s$$$ is lexicographically smaller than the string $$$t$$$ (both have the same length $$$m$$$) if in the first position $$$i$$$ from the left in which they differ, we have $$$s[i] < t[i]$$$. This is exactly the way strings are compared in dictionaries and in most modern programming languages when comparing them in a standard way. For example, the string 01011 is lexicographically smaller than the string 01100, because the first two characters are the same, and the third character in the first string is less than that in the second.We remove from this set $$$n$$$ ($$$1 \le n \le \min(2^m-1, 100)$$$) distinct binary strings $$$a_1, a_2, \ldots, a_n$$$, each of length $$$m$$$. Thus, the set will have $$$k=2^m-n$$$ strings. Sort all strings of the resulting set in lexicographical ascending order (as in the dictionary).We number all the strings after sorting from $$$0$$$ to $$$k-1$$$. Print the string whose index is $$$\lfloor \frac{k-1}{2} \rfloor$$$ (such an element is called median), where $$$\lfloor x \rfloor$$$ is the rounding of the number down to the nearest integer.For example, if $$$n=3$$$, $$$m=3$$$ and $$$a=[$$$010, 111, 001$$$]$$$, then after removing the strings $$$a_i$$$ and sorting, the result will take the form: $$$[$$$000, 011, 100, 101, 110$$$]$$$. Thus, the desired median is 100.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then, $$$t$$$ test cases follow. The first line of each test case contains integers $$$n$$$ ($$$1 \le n \le \min(2^m-1, 100)$$$) and $$$m$$$ ($$$1 \le m \le 60$$$), where $$$n$$$ is the number of strings to remove, and $$$m$$$ is the length of binary strings. The next $$$n$$$ lines contain $$$a_1, a_2, \ldots, a_n$$$ — distinct binary strings of length $$$m$$$. The total length of all given binary strings in all test cases in one test does not exceed $$$10^5$$$.

Print $$$t$$$ answers to the test cases. For each test case, print a string of length $$$m$$$ — the median of the sorted sequence of remaining strings in the corresponding test case.

NoteThe first test case is explained in the statement.In the second test case, the result after removing strings and sorting is $$$[$$$001, 010, 101, 110$$$]$$$. Therefore, the desired median is 010.

import           Data.List
import           Control.Monad
import qualified Data.Set                      as Set
import           Data.Char
import           Data.Int
-- import           Debug.Trace

-- debug = flip trace

fromBinary :: String -> Int64
fromBinary = fromBinary' . reverse

fromBinary' :: String -> Int64
fromBinary' []       = 0
fromBinary' (x : xs) = fromIntegral (ord x - ord '0') + (2 * fromBinary' xs)

toBinary :: Int64 -> Int64 -> String
toBinary m = reverse . toBinary' m

toBinary' :: Int64 -> Int64 -> String
toBinary' 0 _ = []
toBinary' m x = chr (fromIntegral r + ord '0') : toBinary' (m - 1) q
    where (q, r) = divMod x 2

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : _ <- map read . words <$> getLine :: IO [Int64]
        as        <- map fromBinary <$> replicateM (fromIntegral n) getLine
        let ans = solve m n (Set.fromList as)
        putStrLn . toBinary m $ ans

solve :: Int64 -> Int64 -> Set.Set Int64 -> Int64
solve m n as = go lo hi as (div (k + 1) 2)
  where
    lo = 0
    hi = 2 ^ m - 1
    k  = 2 ^ m - n

go :: Int64 -> Int64 -> Set.Set Int64 -> Int64 -> Int64
go lo hi as k | lo > hi            = error "Wrong recursion"
              | k <= leftCount     = go lo (mid - 1) left k
              | hasMid             = go (mid + 1) hi right (k - leftCount)
              | k == leftCount + 1 = mid
              | otherwise          = go (mid + 1) hi right (k - leftCount - 1)
  where
    mid                   = div (lo + hi) 2
    (left, hasMid, right) = Set.splitMember mid as
    leftSize              = fromIntegral $ Set.size left
    leftCount             = mid - lo - leftSize -- `debug` unwords
    --     (zipWith
    --         (\x y -> x ++ " = " ++ y ++ ", ")
    --         (words "lo hi mid k leftCount left right hasMid")
    --         (  map show [lo, hi, mid, k, mid - lo - leftSize]
    --         ++ map show [left, right]
    --         ++ [show hasMid]
    --         )
    --     )

import Control.Monad (replicateM_, replicateM)
import Data.Bits
import qualified Data.Sequence as S
import Data.Sequence ((<|), (|>))
import Data.Foldable (toList)

type Str = S.Seq Char

readInt :: IO Int
readInt = read <$> getLine

readStrings :: Int -> IO [Str]
readStrings n = replicateM n (S.fromList <$> getLine)

pow2Of :: Int -> Integer
pow2Of = shiftL 1

getMatchingPrefixes :: Int -> Str -> [Str] -> Int
getMatchingPrefixes prefSize pref = length . filter (==pref) . map (S.take prefSize)

getAllowed :: Int -> Int -> Str -> [Str] -> Integer
getAllowed m prefSize pref xss =
    pow2Of (m - prefSize) - toInteger (getMatchingPrefixes prefSize pref xss)

getMedian :: Int -> Int -> [Str] -> Str
getMedian n m xss = go medianPos S.empty [1..m] where
    medianPos = (pow2Of m - (toInteger n) + 1) `div` 2
    go _ _ [] = S.empty
    go searchSize pref (prefSize : xs) = bit <| go newSearchSize (pref |> bit) xs where
        allowedNumStrings = getAllowed m prefSize (pref |> '0') xss
        bit =
            if searchSize <= allowedNumStrings then '0'
            else '1'
        newSearchSize =
            if searchSize <= allowedNumStrings then searchSize
            else searchSize - allowedNumStrings

main =
    readInt >>= \t ->
    replicateM_ t (
        (map read) . words <$> getLine >>= \[n, m] ->
        readStrings n >>= \xss ->
        putStrLn $ toList $ getMedian n m xss
    )

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

binaryMedian :: Int -> [String] -> String
binaryMedian width _remove = toByte width median'
    where
        median = 2^(width-1) - 1
        remove = fromByte width `map` _remove
        (_, median', _) = foldl' go (False, median, Set.empty) remove

        go (isOdd, med, seen) rem = (isOdd', med', seen') where
                isOdd'= not isOdd
                seen' = Set.insert rem seen
                get f = head $ dropWhile (`Set.member` seen) (tail $ iterate f med)
                med' =
                    if  not isOdd && rem <= med then get succ
                    else if isOdd && rem >= med then get pred
                    else med

fromBit '0' = 0
fromBit '1' = 1

toBit 0 = '0'
toBit 1 = '1'

fromByte m = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte m = foldl' go "" . take m . iterate (`div` 2)
    where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Int, [String])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

{-# LANGUAGE TupleSections #-}

import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

readInput :: IO (Int, [String])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

binaryMedian :: Int -> [String] -> String
binaryMedian m _remove = toBinary m median
    where
        (_, median, _) = foldl' go (False, 2^(m-1) - 1, Set.empty) remove
        remove = map (fromBinary m) _remove

        go (isOdd, med, seen) rem =
            let isOdd' = not isOdd
                seen' = Set.insert rem seen
                find = get med seen
                med' =
                    if  not isOdd && rem <= med then find succ
                    else if isOdd && rem >= med then find pred
                    else med
            in (isOdd', med', seen')

        get n seen f = let n' = f n in
            if Set.member n' seen
                then get n' seen f
                else n'

fromBit :: Num p => Char -> p
fromBit '0' = 0
fromBit '1' = 1

toBit :: (Eq a, Num a) => a -> Char
toBit 0 = '0'
toBit 1 = '1'

fromBinary :: (Foldable t, Num a) => p -> t Char -> a
fromBinary m = foldl' (\n c -> 2 * n + fromBit c) 0

toBinary :: Integral a => Int -> a -> [Char]
toBinary m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

{-# LANGUAGE TupleSections #-}

import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

readInput :: IO (Int, [String])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

binaryMedian :: (Int, [String]) -> String
binaryMedian (m, _remove) = toBinary m median
    where
        (_, median, _) = foldl' go (False, 2^(m-1) - 1, Set.empty) remove
        remove = map (fromBinary m) _remove

        go (isOdd, med, seen) rem =
            let isOdd' = not isOdd
                seen' = Set.insert rem seen
                find = get med seen
                med' =
                    if  not isOdd && rem <= med then find succ
                    else if isOdd && rem >= med then find pred
                    else med
            in (isOdd', med', seen')

        get n seen f = let n' = f n in
            if Set.member n' seen
                then get n' seen f
                else n'

fromBit :: Num p => Char -> p
fromBit '0' = 0
fromBit '1' = 1

toBit :: (Eq a, Num a) => a -> Char
toBit 0 = '0'
toBit 1 = '1'

fromBinary :: (Foldable t, Num a) => p -> t Char -> a
fromBinary m = foldl' (\n c -> 2 * n + fromBit c) 0

toBinary :: Integral a => Int -> a -> [Char]
toBinary m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (binaryMedian <$> readInput >>= putStrLn)

{-# LANGUAGE TupleSections #-}

import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

binaryMedian :: (Int, [String]) -> String
binaryMedian (m, _remove) = toBinary m median
    where
        (_, median, _) = foldl' go (False, 2^(m-1) - 1, Set.empty) remove
        remove = map (fromBinary m) _remove

        go (isOdd, med, seen) rem =
            let isOdd' = not isOdd
                seen' = Set.insert rem seen
                find = get med seen
                med' =
                    if  not isOdd && rem <= med then find succ
                    else if isOdd && rem >= med then find pred
                    else med
            in (isOdd', med', seen')

        get n seen f = let n' = f n in
            if Set.member n' seen
                then get n' seen f
                else n'

fromBit '0' = 0
fromBit '1' = 1

toBit 0 = '0'
toBit 1 = '1'

fromBinary m = foldl' (\n c -> 2 * n + fromBit c) 0

toBinary m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)

main = do
    t <- read <$> getLine
    replicateM_ t (binaryMedian <$> readInput >>= putStrLn)

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

binaryMedian :: Int -> [String] -> String
binaryMedian width _remove = toByte width median'
    where
        median = 2^(width-1) - 1
        remove = fromByte `map` _remove
        (_, median', _) = foldl' go (False, median, Set.empty) remove

        go (isOdd, med, seen) rem = (isOdd', med', seen') where
                isOdd'= not isOdd
                seen' = Set.insert rem seen
                get f = head $ dropWhile (`Set.member` seen) (tail $ iterate f med)
                med' =
                    if  not isOdd && rem <= med then get succ
                    else if isOdd && rem >= med then get pred
                    else med

fromBit :: Num p => Char -> p
fromBit '0' = 0
fromBit '1' = 1

toBit :: (Eq a, Num a) => a -> Char
toBit 0 = '0'
toBit 1 = '1'

fromByte :: [Char] -> Integer
fromByte = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte :: Integral a => Int -> a -> [Char]
toByte m = foldl' go "" . take m . iterate (`div` 2)
    where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Int, [String])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int

binaryMedian :: Width -> [Byte] -> Byte
binaryMedian width _remove = toByte width median'
    where
        median = 2^(width-1) - 1
        remove = fromByte `map` _remove
        (_, median', _) = foldl' go (False, median, Set.empty) remove

        go (isOdd, med, seen) rem = (isOdd', med', seen') where
                isOdd'= not isOdd
                seen' = Set.insert rem seen
                get f = head $ dropWhile (`Set.member` seen) (tail $ iterate f med)
                med' =
                    if  not isOdd && rem <= med then get succ
                    else if isOdd && rem >= med then get pred
                    else med

fromBit :: Bit -> Integer
fromBit '0' = 0
fromBit '1' = 1

toBit :: Integer -> Bit
toBit 0 = '0'
toBit 1 = '1'

fromByte :: Byte -> Integer
fromByte = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte :: Width -> Integer -> Byte
toByte m = foldl' go "" . take m . iterate (`div` 2)
    where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Width, [Byte])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

{-# LANGUAGE TupleSections #-}

import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

binaryMedian :: Int -> [String] -> String
binaryMedian m _remove = toBinary m median
    where
        (_, median, _) = foldl' go (False, 2^(m-1) - 1, Set.empty) remove
        remove = map (fromBinary m) _remove

        go (isOdd, med, seen) rem =
            let isOdd' = not isOdd
                seen' = Set.insert rem seen
                find = get med seen
                med' =
                    if  not isOdd && rem <= med then find succ
                    else if isOdd && rem >= med then find pred
                    else med
            in (isOdd', med', seen')

        get n seen f = let n' = f n in
            if Set.member n' seen
                then get n' seen f
                else n'

fromBit :: Num p => Char -> p
fromBit '0' = 0
fromBit '1' = 1

toBit :: (Eq a, Num a) => a -> Char
toBit 0 = '0'
toBit 1 = '1'

fromBinary :: (Foldable t, Num a) => p -> t Char -> a
fromBinary m = foldl' (\n c -> 2 * n + fromBit c) 0

toBinary :: Integral a => Int -> a -> [Char]
toBinary m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)

readInput :: IO (Int, [String])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

{- LANGUAGE BANGPATTERNS -}

import Data.Traversable (for)
import Data.Foldable (foldl', for_)
import Data.List (sort, unfoldr)

readBits :: String -> Integer
readBits = ($ 0) $ foldl' (\x y -> case  y  of
  '0' -> 2*x
  '1' -> 2*x+1
  _ -> error "bit"
  )

toBits :: Int -> Integer -> String
toBits k val = reverse . take k $ unfoldr step val  where
  step x = case  quotRem x 2  of
    (x', 0) -> Just ('0', x')
    (x', 1) -> Just ('1', x')
    _ -> error "overflow??"

--mockup to work around small size limits
data Seq t
  = Empty
  | Single t
  | Node !Integer (Seq t) (Seq t)

size :: Seq t -> Integer
size Empty = 0
size (Single _) = 1
size (Node sz _ _) = sz

deleteAt :: Integer -> Seq t -> Seq t
deleteAt k s = case  s  of
  _ | k < 0 || k >= size s  -> s
  Single _  -> Empty
  Node n le ri -> let  excess = k - size le  in  if  excess >= 0
    then  Node (n-1) le (deleteAt excess ri)
    else  Node (n-1) (deleteAt k le) ri
  -- in all cases this is caught by the first pattern, but GHC can't tell that
  Empty -> s

outOfBounds :: t
outOfBounds = error "index: out of bounds"

index :: Seq t -> Integer -> t
index Empty _ = outOfBounds
index (Single v) 0 = v
index (Single _) _ = outOfBounds
index (Node n le ri) k = let  excess = k - size le  in case  ()  of
  () | k < 0 || k >= n  -> outOfBounds
  () | excess < 0  -> index le k
  () | otherwise   -> index ri excess

fromFunction :: Integer -> (Integer -> t) -> Seq t
fromFunction = go 0  where
  go start stop fun = case  stop - start  of
    len | len < 0   -> error "fromFunction: negative length"
    len | len == 0  -> Empty
    len | len == 1  -> Single (fun start)
    len  -> Node len (go start mid fun) (go mid stop fun)  where
      mid = quot (start + stop) 2

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  for_ [1..t] $ \_ -> do
    [n, k] <- (map read . words) <$> getLine :: IO [Int]
    let tot = 2 ^ k :: Integer
    removalList <- for [1..n] $ \_ -> readBits <$> getLine
    let rl = reverse $ sort removalList :: [Integer]
        startSeq = fromFunction tot id :: Seq Integer
        whatsLeft = foldl' (flip deleteAt) startSeq rl :: Seq Integer
        ix = div (tot - fromIntegral (length rl) - 1) 2
        tar = index whatsLeft ix
    putStrLn (toBits k tar)

import Control.Monad (replicateM_, replicateM)
import Data.Bits
import qualified Data.Sequence as S
import Data.Sequence ((<|), (|>))
import Data.Foldable (toList)

type Str = S.Seq Char

readInt :: IO Int
readInt = read <$> getLine

readStrings :: Int -> IO [Str]
readStrings n = replicateM n (S.fromList <$> getLine)

pow2Of :: Int -> Int
pow2Of = shiftL 1

getMatchingPrefixes :: Int -> Str -> [Str] -> Int
getMatchingPrefixes prefSize pref = length . filter (==pref) . map (S.take prefSize)

getAllowed :: Int -> Int -> Str -> [Str] -> Int
getAllowed m prefSize pref xss =
    pow2Of (m - prefSize) - (getMatchingPrefixes prefSize pref xss)

getMedian :: Int -> Int -> [Str] -> Str
getMedian n m xss = go medianPos S.empty [1..m] where
    medianPos = (pow2Of m - n + 1) `div` 2
    go :: Int -> Str -> [Int] -> Str
    go _ _ [] = S.empty
    go searchSize pref (prefSize : xs) = bit <| go newSearchSize (pref |> bit) xs where
        allowedNumStrings = getAllowed m prefSize (pref |> '0') xss
        bit =
            if searchSize <= allowedNumStrings then '0'
            else '1'
        newSearchSize =
            if searchSize <= allowedNumStrings then searchSize
            else searchSize - allowedNumStrings

main =
    readInt >>= \t ->
    replicateM_ t (
        (map read) . words <$> getLine >>= \[n, m] ->
        readStrings n >>= \xss ->
        putStrLn $ toList $ getMedian n m xss
    )

import Control.Monad (replicateM_, replicateM)
import Data.Bits
import qualified Data.Sequence as S
import Data.Sequence ((<|), (|>))
import Data.Foldable (toList)

type Str = S.Seq Char

readInt :: IO Int
readInt = read <$> getLine

readStrings :: Int -> IO [Str]
readStrings n = replicateM n (S.fromList <$> getLine)

pow2Of :: Int -> Int
pow2Of = shiftL 1

getMatchingPrefixes :: Int -> Str -> [Str] -> Int
getMatchingPrefixes prefSize pref = length . filter (==pref) . map (S.take prefSize)

getAllowed :: Int -> Int -> Str -> [Str] -> Int
getAllowed m prefSize pref xss =
    pow2Of (m - prefSize) - (getMatchingPrefixes prefSize pref xss)

getMedian :: Int -> Int -> [Str] -> Str
getMedian n m xss = go medianPos S.empty [1..m] where
    medianPos = (pow2Of m - n + 1) `div` 2
    go :: Int -> Str -> [Int] -> Str
    go _ _ [] = S.empty
    go searchSize pref (prefSize : xs) = bit <| go newSearchSize (pref |> bit) xs where
        allowedNumStrings = getAllowed m prefSize (pref |> '0') xss
        bit =
            if searchSize <= allowedNumStrings then '0'
            else '1'
        newSearchSize =
            if searchSize <= allowedNumStrings then searchSize
            else searchSize - allowedNumStrings

main =
    readInt >>= \t ->
    replicateM_ t (
        (map read) . words <$> getLine >>= \[n, m] ->
        readStrings n >>= \xss ->
        print $ show (maxBound :: Int)
        --putStrLn $ toList $ getMedian n m xss
    )

import Control.Monad (replicateM_, replicateM)
import Data.Bits
import qualified Data.Sequence as S
import Data.Sequence ((<|), (|>))
import Data.Foldable (toList)

type Str = S.Seq Char

readInt :: IO Int
readInt = read <$> getLine

readStrings :: Int -> IO [Str]
readStrings n = replicateM n (S.fromList <$> getLine)

pow2Of :: Int -> Int
pow2Of = shiftL 1

getMatchingPrefixes :: Int -> Str -> [Str] -> Int
getMatchingPrefixes prefSize pref = length . filter (==pref) . map (S.take prefSize)

getAllowed :: Int -> Int -> Str -> [Str] -> Int
getAllowed m prefSize pref xss =
    pow2Of (m - prefSize) - (getMatchingPrefixes prefSize pref xss)

getMedian :: Int -> Int -> [Str] -> Str
getMedian n m xss = go medianPos S.empty [1..m] where
    medianPos = (pow2Of m - n - 1) `div` 2
    go :: Int -> Str -> [Int] -> Str
    go _ _ [] = S.empty
    go searchSize pref (prefSize : xs) = bit <| go newSearchSize (pref |> bit) xs where
        allowedNumStrings = getAllowed m prefSize (pref |> '0') xss
        bit =
            if searchSize + 1 <= allowedNumStrings then '0'
            else '1'
        newSearchSize =
            if searchSize + 1 <= allowedNumStrings then searchSize
            else searchSize - allowedNumStrings

main =
    readInt >>= \t ->
    replicateM_ t (
        (map read) . words <$> getLine >>= \[n, m] ->
        readStrings n >>= \xss ->
        putStrLn $ toList $ getMedian n m xss
    )

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

-- type Bit   = Char
-- type Byte  = [Bit]
-- type Width = Int    -- width of byte

binaryMedian :: Int -> [String] -> String
binaryMedian width _remove = toByte width median'
    where
        median = 2^(width-1) - 1
        remove = fromByte width `map` _remove
        (_, median', _) = foldl' go (False, median, Set.empty) remove

        go (isOdd, med, seen) rem = (isOdd', med', seen') where
                isOdd'= not isOdd
                seen' = Set.insert rem seen
                get f = head $ dropWhile (`Set.member` seen) (tail $ iterate f med)
                med' =
                    if  not isOdd && rem <= med then get succ
                    else if isOdd && rem >= med then get pred
                    else med

fromBit :: Char -> Int
fromBit '0' = 0
fromBit '1' = 1

toBit :: Int -> Char
toBit 0 = '0'
toBit 1 = '1'

fromByte :: Int -> String -> Int
fromByte m = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte :: Int -> Int -> String
toByte m = foldl' go "" . take m . iterate (`div` 2)
    where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Int, [String])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

binaryMedian :: Width -> [Byte] -> Byte
binaryMedian width _remove = toByte width median'
    where
        median = 2^(width-1) - 1
        remove = fromByte width `map` _remove
        (_, median', _) = foldl' go (False, median, Set.empty) remove

        go (isOdd, med, seen) rem = (isOdd', med', seen') where
                isOdd'= not isOdd
                seen' = Set.insert rem seen
                get f = head $ dropWhile (`Set.member` seen) (tail $ iterate f med)
                med' =
                    if  not isOdd && rem <= med then get succ
                    else if isOdd && rem >= med then get pred
                    else med

fromBit :: Bit -> Int
fromBit '0' = 0
fromBit '1' = 1

toBit :: Int -> Bit
toBit 0 = '0'
toBit 1 = '1'

fromByte :: Width -> Byte -> Int
fromByte m = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte :: Width -> Int -> Byte
toByte m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)
    -- foldl' go "" . take m . iterate (`div` 2)
    -- where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Width, [Byte])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

{-# LANGUAGE TupleSections #-}

import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

binaryMedian :: Width -> [Byte] -> Byte
binaryMedian m _remove = toBinary m median
    where
        (_, median, _) = foldl' go (False, 2^(m-1) - 1, Set.empty) remove
        remove = map (fromBinary m) _remove

        go (isOdd, med, seen) rem =
            let isOdd' = not isOdd
                seen' = Set.insert rem seen
                find = get med seen
                med' =
                    if  not isOdd && rem <= med then find succ
                    else if isOdd && rem >= med then find pred
                    else med
            in (isOdd', med', seen')

        get n seen f = let n' = f n in
            if Set.member n' seen
                then get n' seen f
                else n'

fromBit :: Bit -> Int
fromBit '0' = 0
fromBit '1' = 1

toBit :: Int -> Bit
toBit 0 = '0'
toBit 1 = '1'

fromBinary :: Width -> Byte -> Int
fromBinary m = foldl' (\n c -> 2 * n + fromBit c) 0

toBinary :: Width -> Int -> Byte
toBinary m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)

readInput :: IO (Width, [Byte])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

-- binaryMedian :: Width -> [Byte] -> Byte
-- binaryMedian width _remove = toByte width median'
--     where
--         median = 2^(width-1) - 1
--         remove = fromByte width `map` _remove
--         (_, median', _) = foldl' go (False, median, Set.empty) remove

--         go (isOdd, med, seen) rem = (isOdd', med', seen') where
--                 isOdd'= not isOdd
--                 seen' = Set.insert rem seen
--                 get f = head $ dropWhile (`Set.member` seen) (tail $ iterate f med)
--                 med' =
--                     if  not isOdd && rem <= med then get succ
--                     else if isOdd && rem >= med then get pred
--                     else med
binaryMedian :: Width -> [Byte] -> String
binaryMedian m _remove = toByte m median
    where
        (_, median, _) = foldl' go (False, 2^(m-1) - 1, Set.empty) remove
        remove = map (fromByte m) _remove

        go (isOdd, med, seen) rem =
            let isOdd' = not isOdd
                seen' = Set.insert rem seen
                find = get med seen
                med' =
                    if  not isOdd && rem <= med then find succ
                    else if isOdd && rem >= med then find pred
                    else med
            in (isOdd', med', seen')

        get n seen f = let n' = f n in
            if Set.member n' seen
                then get n' seen f
                else n'

fromBit :: Bit -> Int
fromBit '0' = 0
fromBit '1' = 1

toBit :: Int -> Bit
toBit 0 = '0'
toBit 1 = '1'

fromByte :: Width -> Byte -> Int
fromByte m = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte :: Width -> Int -> Byte
toByte m = foldl' go "" . take m . iterate (`div` 2)
    where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Width, [Byte])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

binaryMedian :: Width -> [Byte] -> Byte
binaryMedian width _remove = toByte width median'
    where
        median = 2^(width-1) - 1
        remove = fromByte width `map` _remove
        (_, median', _) = foldl' go (False, median, Set.empty) remove

        go (isOdd, med, seen) rem = (isOdd', med', seen') where
                isOdd'= not isOdd
                seen' = Set.insert rem seen
                get f = head $ dropWhile (`Set.member` seen') (iterate f med)
                med' =
                    if  not isOdd && rem <= med then get succ
                    else if isOdd && rem >= med then get pred
                    else med

fromBit :: Bit -> Int
fromBit '0' = 0
fromBit '1' = 1

toBit :: Int -> Bit
toBit 0 = '0'
toBit 1 = '1'

fromByte :: Width -> Byte -> Int
fromByte m = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte :: Width -> Int -> Byte
toByte m = foldl' go "" . take m . iterate (`div` 2)
    where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Width, [Byte])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

binaryMedian :: Width -> [Byte] -> Byte
binaryMedian width _remove = toByte width median'
    where
        median = 2^(width-1) - 1
        remove = fromByte width `map` _remove
        (_, median', _) = foldl' go (False, median, Set.empty) remove

        go (isOdd, med, seen) rem = (isOdd', med', seen') where
                isOdd'= not isOdd
                seen' = Set.insert rem seen
                -- get f = head $ dropWhile (`Set.member` seen) (tail $ iterate f med)
                get f n = let n' = f n in
                    if Set.member n' seen
                        then get f n'
                        else n'
                med' =
                    if  not isOdd && rem <= med then get succ med
                    else if isOdd && rem >= med then get pred med
                    else med

fromBit :: Bit -> Int
fromBit '0' = 0
fromBit '1' = 1

toBit :: Int -> Bit
toBit 0 = '0'
toBit 1 = '1'

fromByte :: Width -> Byte -> Int
fromByte m = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte :: Width -> Int -> Byte
toByte m = foldl' go "" . take m . iterate (`div` 2)
    where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Width, [Byte])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

-- binaryMedian :: Width -> [Byte] -> Byte
-- binaryMedian width _remove = toByte width median'
--     where
--         median = 2^(width-1) - 1
--         remove = fromByte width `map` _remove
--         (_, median', _) = foldl' go (False, median, Set.empty) remove

--         go (isOdd, med, seen) rem = (isOdd', med', seen') where
--                 isOdd'= not isOdd
--                 seen' = Set.insert rem seen
--                 get f = head $ dropWhile (`Set.member` seen) (tail $ iterate f med)
--                 med' =
--                     if  not isOdd && rem <= med then get succ
--                     else if isOdd && rem >= med then get pred
--                     else med
binaryMedian :: Width -> [Byte] -> String
binaryMedian m _remove = toByte m median
    where
        (_, median, _) = foldl' go (False, 2^(m-1) - 1, Set.empty) remove
        remove = map (fromByte m) _remove

        go (isOdd, med, seen) rem =
            let isOdd' = not isOdd
                seen' = Set.insert rem seen
                find = get med seen
                med' =
                    if  not isOdd && rem <= med then find succ
                    else if isOdd && rem >= med then find pred
                    else med
            in (isOdd', med', seen')

        get n seen f = let n' = f n in
            if Set.member n' seen
                then get n' seen f
                else n'

fromBit '0' = 0
fromBit '1' = 1

toBit 0 = '0'
toBit 1 = '1'

fromBinary m = foldl' (\n c -> 2 * n + fromBit c) 0

toBinary m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)

-- fromBit :: Bit -> Int
-- fromBit '0' = 0
-- fromBit '1' = 1

-- toBit :: Int -> Bit
-- toBit 0 = '0'
-- toBit 1 = '1'

fromByte :: Width -> Byte -> Int
fromByte m = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte :: Width -> Int -> Byte
toByte m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)
    -- foldl' go "" . take m . iterate (`div` 2)
    -- where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Width, [Byte])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

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

{-# LANGUAGE TupleSections #-}
import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

binaryMedian :: Width -> [Byte] -> Byte
binaryMedian width _remove = toByte width median'
    where
        median = 2^(width-1) - 1
        remove = fromByte width `map` _remove
        (_, median', _) = foldl' go (False, median, Set.empty) remove

        go (isOdd, med, seen) rem = (isOdd', med', seen') where
                isOdd'= not isOdd
                seen' = Set.insert rem seen
                get f = head $ dropWhile (`Set.member` seen) (tail $ iterate f med)
                med' =
                    if  not isOdd && rem <= med then get succ
                    else if isOdd && rem >= med then get pred
                    else med

fromBit :: Bit -> Int
fromBit '0' = 0
fromBit '1' = 1

toBit :: Int -> Bit
toBit 0 = '0'
toBit 1 = '1'

fromByte :: Width -> Byte -> Int
fromByte m = foldl' go 0
    where go num bit = 2*num + fromBit bit

toByte :: Width -> Int -> Byte
toByte m = foldl' go "" . take m . iterate (`div` 2)
    where go bits k = toBit (k `mod` 2) : bits

readInput :: IO (Width, [Byte])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

{-# LANGUAGE TupleSections #-}

import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

binaryMedian :: Int -> [String] -> String
binaryMedian m _remove = toBinary m median
    where
        (_, median, _) = foldl' go (False, 2^(m-1) - 1, Set.empty) remove
        remove = map (fromBinary m) _remove

        go (isOdd, med, seen) rem =
            let isOdd' = not isOdd
                seen' = Set.insert rem seen
                find = get med seen
                med' =
                    if  not isOdd && rem <= med then find succ
                    else if isOdd && rem >= med then find pred
                    else med
            in (isOdd', med', seen')

        get n seen f = let n' = f n in
            if Set.member n' seen
                then get n' seen f
                else n'

fromBit :: Char -> Int
fromBit '0' = 0
fromBit '1' = 1

toBit :: (Eq a, Num a) => a -> Char
toBit 0 = '0'
toBit 1 = '1'

fromBinary :: p -> String -> Int
fromBinary m = foldl' (\n c -> 2 * n + fromBit c) 0

toBinary :: Integral a => Int -> a -> [Char]
toBinary m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)

readInput :: IO (Int, [String])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

{-# LANGUAGE TupleSections #-}

import           Control.Monad ( replicateM_ )
import           Data.List     ( foldl' )
import qualified Data.Set as Set

type Bit   = Char
type Byte  = [Bit]
type Width = Int    -- width of byte

binaryMedian :: Int -> [String] -> String
binaryMedian m _remove = toBinary m median
    where
        (_, median, _) = foldl' go (False, 2^(m-1) - 1, Set.empty) remove
        remove = map (fromBinary m) _remove

        go (isOdd, med, seen) rem =
            let isOdd' = not isOdd
                seen' = Set.insert rem seen
                find = get med seen
                med' =
                    if  not isOdd && rem <= med then find succ
                    else if isOdd && rem >= med then find pred
                    else med
            in (isOdd', med', seen')

        get n seen f = let n' = f n in
            if Set.member n' seen
                then get n' seen f
                else n'

fromBit :: Char -> Int
fromBit '0' = 0
fromBit '1' = 1

toBit :: (Eq a, Num a) => a -> Char
toBit 0 = '0'
toBit 1 = '1'

fromBinary :: Int -> String -> Int
fromBinary m = foldl' (\n c -> 2 * n + fromBit c) 0

toBinary :: Integral a => Int -> a -> [Char]
toBinary m num =
    foldl' (\b k -> toBit (k `mod` 2):b) "" (take m $ iterate (`div` 2) num)

readInput :: IO (Int, [String])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry binaryMedian <$> readInput >>= putStrLn)

import Data.Sequence (Seq, deleteAt, index, fromFunction)
import Data.Traversable (for)
import Data.Foldable (foldl', for_)
import Data.List (sort, unfoldr)

readBits :: String -> Int
readBits = foldl' (\x y -> case y of { '0' -> 2*x; '1' -> 2*x+1; _ -> error "bit" }) 0

toBits :: Int -> Int -> String
toBits k val = reverse . take k $ unfoldr step val  where
  step x = case  quotRem x 2  of
    (x', 0) -> Just ('0', x')
    (x', 1) -> Just ('1', x')
    _ -> error "overflow"

main :: IO ()
main = do
  print (maxBound :: Int)
  t <- read <$> getLine :: IO Int
  for_ [1..t] $ \_ -> do
    [n, k] <- (map read . words) <$> getLine :: IO [Int]
    let tot = 2 ^ k :: Integer
        tot' = fromInteger tot :: Int
    if  tot > fromIntegral (maxBound :: Int)
      then  error "too big? ask for 64-bit Int"
      else  return ()
    removalList <- for [1..n] $ \_ -> readBits <$> getLine
    let rl = reverse $ sort removalList :: [Int]
        startSeq = fromFunction tot' id :: Seq Int
        whatsLeft = foldl' (flip deleteAt) startSeq rl :: Seq Int
        ix = div (tot' - length rl - 1) 2
        tar = index whatsLeft ix
    putStrLn (toBits k tar)


Sometimes it is not easy to come to an agreement in a bargain. Right now Sasha and Vova can't come to an agreement: Sasha names a price as high as possible, then Vova wants to remove as many digits from the price as possible. In more details, Sasha names some integer price $$$n$$$, Vova removes a non-empty substring of (consecutive) digits from the price, the remaining digits close the gap, and the resulting integer is the price.For example, is Sasha names $$$1213121$$$, Vova can remove the substring $$$1312$$$, and the result is $$$121$$$.It is allowed for result to contain leading zeros. If Vova removes all digits, the price is considered to be $$$0$$$.Sasha wants to come up with some constraints so that Vova can't just remove all digits, but he needs some arguments supporting the constraints. To start with, he wants to compute the sum of all possible resulting prices after Vova's move.Help Sasha to compute this sum. Since the answer can be very large, print it modulo $$$10^9 + 7$$$.

The first and only line contains a single integer $$$n$$$ ($$$1 \le n < 10^{10^5}$$$).

In the only line print the required sum modulo $$$10^9 + 7$$$.

import Control.Monad
import Data.Char

getList :: (Read t) => IO [t]
getList = getLine >>= return . (map read) . words

getOne :: (Read t) => IO t
getOne = getLine >>= return . read

main :: IO ()
main = do
  -- t <- getOne
  let t = 1
  replicateM_ t solve

toMod :: Integral t => t -> t
toMod = (`mod` 1000000007)
digitToInteger :: Char -> Integer
digitToInteger = fromIntegral . digitToInt

solve :: IO ()
solve = do
  num <- getLine
  print $ countAns (reverse num) 1 0 (fromIntegral $ length num) 0
  where
    countAns [] _ _ _ _= 0
    countAns (x:xs) t i len s = toMod $ digitToInteger x * (toMod (t * (len-1-i) * (len-i) `div` 2) + s) + countAns xs (toMod $ t * 10) (i + 1) len (toMod $ s + t * (i + 1))


Three little pigs from all over the world are meeting for a convention! Every minute, a triple of 3 new pigs arrives on the convention floor. After the $$$n$$$-th minute, the convention ends.The big bad wolf has learned about this convention, and he has an attack plan. At some minute in the convention, he will arrive and eat exactly $$$x$$$ pigs. Then he will get away.The wolf wants Gregor to help him figure out the number of possible attack plans that involve eating exactly $$$x$$$ pigs for various values of $$$x$$$ ($$$1 \le x \le 3n$$$). Two attack plans are considered different, if they occur at different times or if the sets of little pigs to eat are different.Note that all queries are independent, that is, the wolf does not eat the little pigs, he only makes plans!

The first line of input contains two integers $$$n$$$ and $$$q$$$ ($$$1 \le n \le 10^6$$$, $$$1 \le q \le 2\cdot 10^5$$$), the number of minutes the convention lasts and the number of queries the wolf asks. Each of the next $$$q$$$ lines contains a single integer $$$x_i$$$ ($$$1 \le x_i \le 3n$$$), the number of pigs the wolf will eat in the $$$i$$$-th query.

You should print $$$q$$$ lines, with line $$$i$$$ representing the number of attack plans if the wolf wants to eat $$$x_i$$$ pigs. Since each query answer can be large, output each answer modulo $$$10^9+7$$$.

NoteIn the example test, $$$n=2$$$. Thus, there are $$$3$$$ pigs at minute $$$1$$$, and $$$6$$$ pigs at minute $$$2$$$. There are three queries: $$$x=1$$$, $$$x=5$$$, and $$$x=6$$$.If the wolf wants to eat $$$1$$$ pig, he can do so in $$$3+6=9$$$ possible attack plans, depending on whether he arrives at minute $$$1$$$ or $$$2$$$.If the wolf wants to eat $$$5$$$ pigs, the wolf cannot arrive at minute $$$1$$$, since there aren't enough pigs at that time. Therefore, the wolf has to arrive at minute $$$2$$$, and there are $$$6$$$ possible attack plans.If the wolf wants to eat $$$6$$$ pigs, his only plan is to arrive at the end of the convention and devour everybody.Remember to output your answers modulo $$$10^9+7$$$!

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.Int
import Data.Array.Unboxed
import Data.Array.ST.Safe

p :: Int
p = 10 ^ (9 :: Integer) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
x +! y = cv (x + y)

(-!) :: Int -> Int -> Int
x -! y = cv (x + p - y)

infixl 6 +!
infixl 6 -!

(*!) :: Int -> Int -> Int
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral $ rem (x64 * y64) p64

infixl 7 *!

getInvs :: Int -> UArray Int Int
getInvs n = runSTUArray $ do
  ans <- newArray_ (1, n)
  writeArray ans 1 1
  forM_ [2 .. n] $ \i -> let
    (q, r) = quotRem p i
    in  do
    v <- readArray ans r
    writeArray ans i $ (p - q) *! v
  pure ans

soln :: Int -> UArray Int Int
soln n = runSTUArray $ let
  k = 3 * (n + 1)
  invs = getInvs k
  choices = scanl' (\x i -> x *! (k + 1 - i) *! invs ! i) 1 [1 .. k]
  i3 = invs ! 3
  in  do
  arr <- newListArray (0, k) choices
  writeArray arr 0 0
  forM_ [0 .. k - 3] $ \i -> do
    v1 <- readArray arr (i + 1)
    let  v0 = v1 *! i3
    writeArray arr i v0
    writeArray arr (i + 1) 0
    v2 <- readArray arr (i + 2)
    writeArray arr (i + 2) (v2 -! v1)
    v3 <- readArray arr (i +! 3)
    writeArray arr (i + 3) (v3 -! v0)
  pure arr

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, q] <- readInts
  let  ans = soln n
  replicateM_ q $ do
    [x] <- readInts
    putInts [ans ! x]

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


Orac is studying number theory, and he is interested in the properties of divisors.For two positive integers $$$a$$$ and $$$b$$$, $$$a$$$ is a divisor of $$$b$$$ if and only if there exists an integer $$$c$$$, such that $$$a\cdot c=b$$$.For $$$n \ge 2$$$, we will denote as $$$f(n)$$$ the smallest positive divisor of $$$n$$$, except $$$1$$$.For example, $$$f(7)=7,f(10)=2,f(35)=5$$$.For the fixed integer $$$n$$$, Orac decided to add $$$f(n)$$$ to $$$n$$$. For example, if he had an integer $$$n=5$$$, the new value of $$$n$$$ will be equal to $$$10$$$. And if he had an integer $$$n=6$$$, $$$n$$$ will be changed to $$$8$$$.Orac loved it so much, so he decided to repeat this operation several times.Now, for two positive integers $$$n$$$ and $$$k$$$, Orac asked you to add $$$f(n)$$$ to $$$n$$$ exactly $$$k$$$ times (note that $$$n$$$ will change after each operation, so $$$f(n)$$$ may change too) and tell him the final value of $$$n$$$.For example, if Orac gives you $$$n=5$$$ and $$$k=2$$$, at first you should add $$$f(5)=5$$$ to $$$n=5$$$, so your new value of $$$n$$$ will be equal to $$$n=10$$$, after that, you should add $$$f(10)=2$$$ to $$$10$$$, so your new (and the final!) value of $$$n$$$ will be equal to $$$12$$$.Orac may ask you these queries many times.

The first line of the input is a single integer $$$t\ (1\le t\le 100)$$$: the number of times that Orac will ask you. Each of the next $$$t$$$ lines contains two positive integers $$$n,k\ (2\le n\le 10^6, 1\le k\le 10^9)$$$, corresponding to a query by Orac. It is guaranteed that the total sum of $$$n$$$ is at most $$$10^6$$$.

Print $$$t$$$ lines, the $$$i$$$-th of them should contain the final value of $$$n$$$ in the $$$i$$$-th query by Orac.

NoteIn the first query, $$$n=5$$$ and $$$k=1$$$. The divisors of $$$5$$$ are $$$1$$$ and $$$5$$$, the smallest one except $$$1$$$ is $$$5$$$. Therefore, the only operation adds $$$f(5)=5$$$ to $$$5$$$, and the result is $$$10$$$.In the second query, $$$n=8$$$ and $$$k=2$$$. The divisors of $$$8$$$ are $$$1,2,4,8$$$, where the smallest one except $$$1$$$ is $$$2$$$, then after one operation $$$8$$$ turns into $$$8+(f(8)=2)=10$$$. The divisors of $$$10$$$ are $$$1,2,5,10$$$, where the smallest one except $$$1$$$ is $$$2$$$, therefore the answer is $$$10+(f(10)=2)=12$$$.In the third query, $$$n$$$ is changed as follows: $$$3 \to 6 \to 8 \to 10 \to 12$$$.

import Control.Monad

f :: Int -> Int -> Int
f n k
  | even n = n+2*k
  | odd n = n+2*(k-1)+head (filter (\x -> mod n x == 0) [3,5..])

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n,k] <- map read . words <$> getLine
    print $ f n k

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

routine :: IO ()
routine = do
    [n,k] <- (map (read ::String -> Int).words) <$> getLine
    print $ solve n k

solve :: Int -> Int -> Int
solve n k
  | odd n = solve (n+sm) (k-1)
  | even n = n+2*k
  | otherwise = error "Lol"
  where
    sm = head $ filter (\x -> n `mod` x == 0) [2..]

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

type Long = Int

smallestDivisor :: Int -> Int
smallestDivisor n =
    case L.find (\d -> n `mod` d == 0) [2..1001] of
        Nothing -> n
        Just d -> d

solve :: Int -> Int -> Int
solve n 1 = n + smallestDivisor n
solve n k = (2*k-2) + n + smallestDivisor n

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:k:_) <- readWords
    print $ solve n k
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine

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

mf n = head [i|i<-[2..n], mod n i ==0]
ans 0 n = n
ans k n | even n = n+k*2
	| otherwise = (n+(mf n)) +(k-1)*2

onecase = do
		[n,k]<-map read <$> words <$> getLine ::IO [Int]
		print $  ans k n

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

import Data.Map as M
import Data.List as L

smallerDiv :: Integer -> Integer
smallerDiv n = head $ L.filter (\x -> mod n x == 0) [2..]

fun :: Integer -> Integer -> Integer
fun k n
  | even n = n+2*k
  | otherwise = fun (k-1) (n+smallerDiv n)

parseInput :: String -> (Integer, Integer)
parseInput raw = (n, k)
                  where n = read n' :: Integer
                        k = read k' :: Integer
                        [n', k'] = words raw

solve :: String -> String
solve input = show (fun k n)
  where (n, k) = parseInput input

main :: IO()
main = interact (unlines . L.map solve . tail . lines)

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

routine :: IO ()
routine = do
    [n,k] <- (map (read ::String -> Int).words) <$> getLine
    print $ solve n k

solve :: Int -> Int -> Int
solve n k
  | odd n = solve (n+sm) (k-1)
  | even n = n+2*k
  | otherwise = error "Lol"
  where
    sm = head $ filter (\x -> x `mod` n == 0) [2..]

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

mf n = head [i|i<-[2..n], mod n i ==0]
ans 0 n = n
ans k n | even n = n+k*2
	| otherwise = (n*2) +(k-1)*2

onecase = do
		[n,k]<-map read <$> words <$> getLine ::IO [Int]
		print $  ans k n

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


The administration of the Tomsk Region firmly believes that it's time to become a megacity (that is, get population of one million). Instead of improving the demographic situation, they decided to achieve its goal by expanding the boundaries of the city.The city of Tomsk can be represented as point on the plane with coordinates (0; 0). The city is surrounded with n other locations, the i-th one has coordinates (xi, yi) with the population of ki people. You can widen the city boundaries to a circle of radius r. In such case all locations inside the circle and on its border are included into the city.Your goal is to write a program that will determine the minimum radius r, to which is necessary to expand the boundaries of Tomsk, so that it becomes a megacity.

The first line of the input contains two integers n and s (1 ≤ n ≤ 103; 1 ≤ s < 106) — the number of locatons around Tomsk city and the population of the city. Then n lines follow. The i-th line contains three integers — the xi and yi coordinate values of the i-th location and the number ki of people in it (1 ≤ ki < 106). Each coordinate is an integer and doesn't exceed 104 in its absolute value. It is guaranteed that no two locations are at the same point and no location is at point (0; 0).

In the output, print "-1" (without the quotes), if Tomsk won't be able to become a megacity. Otherwise, in the first line print a single real number — the minimum radius of the circle that the city needs to expand to in order to become a megacity. The answer is considered correct if the absolute or relative error don't exceed 10 - 6.

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Text.Printf

readInts = map (fst.fromJust.B.readInt) . B.words <$> B.getLine

main = do
  [n, s] <- readInts
  ls <- replicateM n readInts
  let
    binary_search :: Float -> Float -> Int -> Float
    binary_search _ ub 100 = ub
    binary_search lb ub depth = if can mid then binary_search lb mid (depth+1)else binary_search mid ub (depth+1)
      where
        mid = (lb+ub) / 2
    can r = total >= 1000000
      where
        total = s + (sum $ map (\[x,y,p] -> if doesContain x y r then p else 0) ls)
    doesContain x y r = x'*x' + y'*y' <= r*r
      where
        x' = fromIntegral x
        y' = fromIntegral y
    result = binary_search 0 14200 0
    in putStrLn $ if result > 14150 then "-1" else printf "%.7f" result

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  [n, s] <- map read.words <$> getLine :: IO [Int]
  xyks <- parse.map readInt.B.words <$> B.getContents
  if isValid s xyks then print $ solve s [(rr,k)|(x,y,k)<-xyks,let !rr=fi x*fi x+fi y*fi y]
  else print (-1)

fi :: Int -> Int64
fi = fromIntegral

isValid :: Int -> [(Int,Int,Int)] -> Bool
isValid s xyks= s + sum[k|(_,_,k)<-xyks] >= 1000000

parse :: [Int] -> [(Int,Int,Int)]
parse (x:y:k:xyks) = (x,y,k) : parse xyks
parse _ = []

solve :: Int -> [(Int64,Int)] -> Double
solve s rrks = sqrt.fromIntegral $ lowerBound p 0 $ fst $ maximum rrks
   where
     p rr = s + sum[k|(rr',k)<-rrks,rr'<=rr] >= 1000000

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections, NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import Data.Bits
import Data.Char
import Data.Either
import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

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

import Debug.Trace
import Text.Printf
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

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

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

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

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

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

fi = fromIntegral

main :: IO ()
main = do
	[n, pop] <- inputIntegers
	cities <- replicateM (fi n) $ do
		[x, y, pop] <- inputIntegers
		return (sqrt ((fi x) ** 2 + (fi y) ** 2), pop)
	let x = listToMaybe . dropWhile (\(_,p) -> p < 10^6) . scanl (\(r1,p1) (r2,p2) -> (r2,p1+p2)) (0,fi pop) $ sort cities
	case x of
		Just (r,_) -> print r
		Nothing -> print (-1)