import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Arrow ((&&&), (***))
import Control.Monad.Trans.State
import Data.Bifunctor (bimap)
import Data.Function (on)
import Data.Maybe
import Data.Semigroup (Min(..))
import Data.Tuple (swap)
import qualified Data.Set as Set

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

import Debug.Trace

type Cost = Maybe (Min Int)
type Range = (Int, Int)
type Pos = (Range, Maybe Int,  (Cost, Cost))

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n,m] <- getInts 2
    ps <- Set.fromList <$> getInts n
    rs <- fmap concat $ replicateM m $ do
      ~[l, r] <- getInts 2
      pure $! do
        guard $! Set.null
          $ Set.takeWhileAntitone (<=r)
          $ Set.dropWhileAntitone (<l)
          $ ps
        pure $! (l, r)
    let
      rs' = foldl' excludeCover Set.empty $ sortOn swap rs
      excludeCover :: Set.Set Range -> Range -> Set.Set Range
      excludeCover s x@(l, r) =
        if Set.null $ Set.dropWhileAntitone ((<l) . fst) s
          then (Set.insert x s) else s
      run :: Set.Set Range -> [(Set.Set Range, Set.Set Range)]
      run s = let s0 = (s, Set.empty)
        in go s0
        where
          go s'@(sl, sr) = s':case Set.maxView sl of
            Just (v, sl') -> go (sl', Set.insert v sr)
            _ -> []
      getBest :: (Int, Int) -> Int -> Set.Set Range -> Int -> (Int, Int)
      getBest (c1, c2) l s r = foldl1' (\(x1, y1) (x2,y2)->(min x1 x2, min y1 y2)) $ map step $  run s
        where
          gol sl = case Set.lookupMax sl of
            Just (l', _) -> let dl = l' - l in min (c1 + 2 * dl) (c2 + dl)
            otherwise -> min c1 c2
          gor cl sr = case Set.lookupMin sr of
            Just (_, r') -> let dr = r - r' in (cl + dr, cl + 2 * dr)
            otherwise -> (cl, cl)
          step (sl, sr) = let cl = gol sl in gor cl sr
      best =
        let
          Just (a0, ps') = Set.minView ps
          s0 = case Set.lookupMin rs' of
            Just (_, r0) -> if r0 < a0 then (a0 - r0, 2 * (a0 - r0)) else (0, 0)
            _ -> (0,0)
          step (l, s) r = let
            ss' = Set.takeWhileAntitone ((<=r).snd) $ Set.dropWhileAntitone ((<=l).snd) $ rs'
            in (r, getBest s l ss' r)
          (lastl, (lastcl, lastcr)) = Set.foldl' step (a0, s0) ps'
        in case Set.lookupMax rs' of
          Just (maxl, _) -> if maxl <= lastl
            then min lastcl lastcr
            else let
              dl = maxl - lastl
              in min (lastcl + 2 * dl) (lastcr + dl)
          _ -> 0
    pure $! putInts [best]

type SP = State [P.ByteString]

readInt :: P.ByteString -> Int
readInt = fst . fromJust . P.readInt

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map readInt <$> getNext k

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

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

suffMins :: UArray Int Int -> UArray Int Int
suffMins arr = let
  (p, q) = bounds arr
  step (ix, val) = (ix - 1, min val (arr ! (ix - 1)))
  in  array (p, q + 1) $ take (rangeSize (p, q + 1))
  $ iterate step (q + 1, maxBound)

binSearch :: Integral t => (t -> Bool) -> t -> t -> t
binSearch fun = let
  go li ri = if  li == ri
    then  li
    else  let
    mi = li + quot (ri - li) 2
    in  if  fun mi
    then  go li mi
    else  go (mi+1) ri
  in  go

type UA = UArray Int Int
data Info = Info !Int64 !Int64 deriving (Eq, Ord, Show)

getCost :: Info -> Int -> Int -> Int64
getCost (Info c2 c1) pos tarPos = let
  rdist = fromIntegral $ tarPos - pos
  in  if  rdist <= 0
  then  c2
  else  min (c2 + 2 * rdist) (c1 + rdist)

solve :: UA -> UA -> UA -> Int64
solve as startPts necessities = let
  (1, n) = bounds as
  (_, stopPt) = bounds necessities
  leftPos = as ! 1
  leftTar = necessities ! 1
  leftDist = fromIntegral $ max 0 $ leftPos - leftTar
  startInfo = Info leftDist $ 2 * leftDist
  step :: Info -> Int -> Info
  step prevInfo ix = let
    oldPos = as ! (ix - 1)
    newPos = as ! ix
    oldRix = binSearch (\j -> startPts ! j > oldPos) 1 stopPt
    newRix = binSearch (\j -> startPts ! j > newPos) 1 stopPt
    newC !k = foldl' min maxBound $ do
      let
        leftOpts = oldPos : map (startPts !) [oldRix .. newRix - 1]
        rightOpts = map (necessities !) [oldRix .. newRix]
      (ltar, rtar) <- zip leftOpts rightOpts
      pure $ getCost prevInfo oldPos ltar
        + k * fromIntegral (newPos - min newPos rtar)
    in  Info (newC 1) (newC 2)
  finalInfo = foldl' step startInfo [2 .. n]
  in  getCost finalInfo (as ! n) (startPts ! (stopPt - 1))

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    aLi <- getInts n
    lr <- replicateM m $ do
      ~[lj, rj] <- getInts 2
      lj `seq` rj `seq` pure (lj, rj)
    let
      intArr :: Array Int (Int, Int)
      intArr = listArray (1, m) $ sort lr
      startPts = listArray (1, m) $ map fst $ elems intArr
      necessity = suffMins $ listArray (1, m) $ map snd $ elems intArr
      a = listArray (1, n) $ sort aLi
    pure $ putInt64s [solve a startPts necessity]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> Builder
putInt64s vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.int64Dec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> int64Dec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

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

solve :: IO ()
solve = do
    ~[n, m] <- readInts
    as <- readInts
    lrs <- replicateM m readInts
    let veryLeft = -10^9 - 1 :: Int64
        big      =  10^16    :: Int64

        a :: Array Int Int64
        a = listArray (0, n) $ (veryLeft:) $ map fromIntegral $ sort as

        b :: Array Int [(Int64, Int64)]
        b = accumArray (flip (:)) [] (0, n) lrs'  where
            lrs' = mapMaybe (f . map fromIntegral) $ reverse $ sort lrs
            f ~[l, r]
                | i <= n && a!i <= r = Nothing
                | otherwise = Just (i - 1, (l, r))
                where i = binSearchA (>=l) a
        sz = listArray (0, n) $ map length $ elems b

        la :: Array Int (Array Int Int64)
        la = listArray (0, n) $
            [ listArray (1, sz!i) $ map (fromIntegral . fst) lrs
            | (i, lrs) <- assocs b
            ]
        rmin :: Array Int [Int64]
        rmin = listArray (0, n) $
            [ scanr1 min $ map (fromIntegral . snd) lrs
            | (i, lrs) <- assocs b
            ]

        dp :: Array Int [Int64]
        dp = fArray (0, n) f where
            f 0 = take (1 + sz!0) $ 0 : repeat big
            f i = map g [0..sz!i] where
                (rminPrv, szPrv, dpPrv) = (rmin!(i - 1), sz!(i - 1), dp!(i - 1))
                pre = listArray (0, szPrv - 1) $ scanl1 min $ zipWith (-) dpPrv rminPrv
                suf = listArray (0, szPrv - 1) $ scanr1 min $ zipWith (-) dpPrv $ map (*2) rminPrv
                (rminaPrv, dpaPrv) = (listArray (1, szPrv) rminPrv, listArray (0, szPrv) dpPrv)
                g 0 = minimum $ dpaPrv!szPrv : [a!i + dx - rx | (dx, rx) <- zip dpPrv rminPrv]
                g j = onlyRight `min` left `min` right where
                    onlyRight    = la!i!j - a!i + dpaPrv!szPrv
                    rightFirst k = 2 * la!i!j - a!i - rminaPrv!(k + 1)
                    leftFirst  k = a!i + la!i!j - 2 * rminaPrv!(k + 1)
                    k            = binSearch (\k -> leftFirst k < rightFirst k) 0 (szPrv - 1)
                    right | k - 1 < 0     = big
                          | otherwise     = pre!(k - 1) + 2 * la!i!j - a!i
                    left  | szPrv - 1 < k = big
                          | otherwise     = suf!k + a!i + la!i!j

    print $ last $ dp!n

binSearch :: Integral i => (i -> Bool) -> i -> i -> i
binSearch f = go where
    go l h
        | l > h     = l
        | f m       = go l (m - 1)
        | otherwise = go (m + 1) h
        where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l h where (l, h) = bounds a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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

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

solve :: IO ()
solve = do
    ~[n, m] <- readInts
    as <- readInts
    lrs <- replicateM m readInts
    let veryLeft = -10^9 - 1 :: Int64
        big      =  10^16    :: Int64

        a :: Array Int Int64
        a = listArray (0, n) $ (veryLeft:) $ map fromIntegral $ sort as

        b :: Array Int [(Int64, Int64)]
        b = accumArray (flip (:)) [] (0, n) lrs'  where
            lrs' = mapMaybe (f . map fromIntegral) $ reverse $ sort lrs
            f ~[l, r]
                | i <= n && a!i <= r = Nothing
                | otherwise = Just (i - 1, (l, r))
                where i = binSearchA (>=l) a
        sz = listArray (0, n) $ map length $ elems b

        la :: Array Int (Array Int Int64)
        la = listArray (0, n) $
            [ listArray (1, sz!i) $ map (fromIntegral . fst) lrs
            | (i, lrs) <- assocs b
            ]
        rmin :: Array Int [Int64]
        rmin = listArray (0, n) $
            [ scanr1 min $ map (fromIntegral . snd) lrs
            | (i, lrs) <- assocs b
            ]

        stepDp :: [Int64] -> Int -> [Int64]
        stepDp dpPrv i = map f [0..sz!i] where
            (rminPrv, szPrv) = (rmin!(i - 1), sz!(i - 1))
            pre = listArray (0, szPrv - 1) $ scanl1 min $ zipWith (-) dpPrv rminPrv
            suf = listArray (0, szPrv - 1) $ scanr1 min $ zipWith (-) dpPrv $ map (*2) rminPrv
            (rminaPrv, dpaPrv) = (listArray (1, szPrv) rminPrv, listArray (0, szPrv) dpPrv)
            f 0 = minimum $ dpaPrv!szPrv : [a!i + dx - rx | (dx, rx) <- zip dpPrv rminPrv]
            f j = onlyRight `min` left `min` right where
                onlyRight    = la!i!j - a!i + dpaPrv!szPrv
                rightFirst k = 2 * la!i!j - a!i - rminaPrv!(k + 1)
                leftFirst  k = a!i + la!i!j - 2 * rminaPrv!(k + 1)
                k            = binSearch (\k -> leftFirst k < rightFirst k) 0 (szPrv - 1)
                right | k - 1 < 0     = big
                      | otherwise     = pre!(k - 1) + 2 * la!i!j - a!i
                left  | szPrv - 1 < k = big
                      | otherwise     = suf!k + a!i + la!i!j

    print $ last $ foldl' stepDp (take (1 + sz!0) $ 0 : repeat big) [1..n]

binSearch :: Integral i => (i -> Bool) -> i -> i -> i
binSearch f = go where
    go l h
        | l > h     = l
        | f m       = go l (m - 1)
        | otherwise = go (m + 1) h
        where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l h where (l, h) = bounds a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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


import Control.Monad
import Text.Printf

g :: Double -> Double
g x  = x - fromIntegral (floor x)

delta = foldl (\acc x -> acc + (g x)) 0.0

fracs = length . filter (\x -> g x > 0)

iter del = foldl (\acc x -> min acc (abs (fromIntegral(x)-del))) (read "Infinity")

limits n xs = let count = fracs xs in
  if (count >= n) then (count-n, n) else (0, count)

ans n xs = iter (delta xs) ys
  where ys = [fst(limits n xs)..snd(limits n xs)]

main = do
  n <- readLn :: IO Int
  x <- getLine
  let xs = map read $ words x :: [Double]
  printf "%.3f" (ans n xs)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = do
    n <- readLine
    as <- readsLine
    printf "%.3f\n" $ solve n as

solve :: Int -> [Double] -> Double
solve n as = minimum [ abs $ itof z - y | z <- [max 0 (n-k)..n]]
    where
    as' = map (\x -> x - itof (floor x)) as
    k   = length $ filter (==0) as'
    y   = sum as'

import Control.Monad
import Text.Printf

g :: Double -> Double
g x  = x - fromIntegral (floor x)

delta = foldl (\acc x -> acc + (g x)) 0.0

fracs = foldl (\acc x -> if (g x > 0.0001) then (acc + 1) else acc) 0

iter del = foldl (\acc x -> min acc (abs (fromIntegral(x)-del))) (read "Infinity")

limits n xs = let count = fracs xs in
  if (count >= n) then (count-n, n) else (0, count)

ans n xs = iter (delta xs) ys
  where ys = [fst(limits n xs)..snd(limits n xs)]

main = do
  n <- readLn :: IO Int
  x <- getLine
  let xs = map read $ words x :: [Double]
  printf "%.3f" (ans n xs)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = do
    n <- readLine
    as <- readsLine
    printf "%.3f\n" $ solve n as

solve :: Int -> [Double] -> Double
solve n as | even k = abs y
           | odd  k = min (abs y) (abs (1+y))
    where
    as' = map (\x -> x - itof (floor x)) as
    k   = length $ filter (/=0) as'
    y   = itof (div k 2) - sum as'


{-# LANGUAGE NumericUnderscores #-}

import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as BS

skipWhitespace :: BS.ByteString -> BS.ByteString
skipWhitespace = BS.dropWhile (`elem` " \r\n\t")

readInts :: BS.ByteString -> [Int]
readInts line = case BS.readInt line of Just (x, t) -> x : (readInts (skipWhitespace t))
                                        Nothing -> []
readInt :: BS.ByteString -> Int
readInt line = let [x] = readInts line in x

data Node = Null | Node { leftBound :: Int, rightBound :: Int, sum :: Int, leftChild :: Node, rightChild :: Node }
    deriving (Show, Eq)

isLeaf :: Node -> Bool
isLeaf node = leftBound node == rightBound node

middle :: Node -> Int
middle node = (leftBound node + rightBound node) `div` 2

inside :: Node -> Int -> Bool
inside node pos = leftBound node <= pos && pos <= rightBound node

ensureLeftChild :: Node -> Node
ensureLeftChild node | isLeaf node = node
                     | leftChild node == Null = Node (leftBound node) (rightBound node) (Main.sum node) (makeLeftChild node) (rightChild node)
                     | otherwise = node
    where makeLeftChild :: Node -> Node
          makeLeftChild node = Node (leftBound node) (middle node) 0 Null Null

ensureRightChild :: Node -> Node
ensureRightChild node | isLeaf node = node
                      | rightChild node == Null = Node (leftBound node) (rightBound node) (Main.sum node) (leftChild node) (makeRightChild node)
                      | otherwise = node
    where makeRightChild :: Node -> Node
          makeRightChild node = Node (middle node + 1) (rightBound node) 0 Null Null

emptyRoot :: Node
emptyRoot = Node 0 1_000_000_000 0 Null Null

increment :: Int -> Node -> Node
increment position node | isLeaf node = makeNode Null Null
                        | position <= middle node = let node' = ensureLeftChild node
                                                    in makeNode (increment position (leftChild node')) (rightChild node')
                        | otherwise = let node' = ensureRightChild node
                                      in makeNode (leftChild node') (increment position (rightChild node'))
    where makeNode = Node (leftBound node) (rightBound node) (Main.sum node + 1)

getSum :: Int -> Int -> Node -> Int
getSum l r Null = 0
getSum l r node | l > r = 0
                | l <= leftBound node && rightBound node <= r = Main.sum node
                | r < leftBound node || rightBound node < l = 0
                | otherwise = getSum l r (leftChild node) + getSum l r (rightChild node)

solve :: [Int] -> Int
solve = go emptyRoot 1
    where go :: Node -> Int -> [Int] -> Int
          go node _ [] = 0
          go node i (x:xs) = if x < i
                             then let node' = increment i node in (getSum 0 (x - 1) node') + go node' (i + 1) xs
                             else go node (i + 1) xs

testCaseMain :: Int -> IO ()
testCaseMain _ = do n <- readInt <$> BS.getLine
                    a <- readInts <$> BS.getLine
                    print (solve a)

main :: IO ()
main = do t <- readInt <$> BS.getLine
          forM_ [1 .. t] testCaseMain

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe, catMaybes)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, nub, intercalate)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.String (fromString)
import Data.Bits (shift)
import Data.Binary (encode, decode)

-- road map in reverse, and the number of cities, init pen state
type Domain = [Int]
type CoDomain = Int
type Solver  = Domain -> CoDomain

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

printAns :: CoDomain -> IO ()
printAns xs = putStrLn $ show xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xs <- readChar8
  return xs

-- eliminate duplicate
cal :: Int -> Int
cal n = (n-1) * n `div` 2

solve :: Solver
solve xs = ans - beta
  where ys = sort $ filter (\(x, y)-> x < y) $ zip xs [1..]
        ans = fst $ foldl insertCount (0, Set.empty) ys
        insertCount :: (Int, Set Int) -> (Int, Int) -> (Int, Set Int)
        insertCount (c, s) (a, i) = (Set.findIndex a (Set.insert a s) + c, Set.insert i s)
        beta = 0

main :: IO ()
main = do
  [n] <- readChar8
  replicateM_ n $ printAns =<< solve <$> parse
  return ()

import           Data.List
import qualified Data.Char as DC
import qualified Data.Set as Set
import qualified Data.Map as Map
import Control.Monad (replicateM)

tSecond (_, z, _) = z
tFirst (o, _, _) = o
tThird (_, _, v) = v

mapLookup e m = unwrap $ Map.lookup e m
unwrap (Just x) = x
unwrap Nothing = 0

solveCase :: IO ()
solveCase = do
    n <- fmap (read :: String -> Int) getLine
    rarr <- fmap (map (read :: String -> Int) . words) getLine
    putStrLn $ show $ tSecond $ foldl (\tp el -> if (fst el) > (snd el) then (Set.insert (fst el) (tFirst tp), (tSecond tp) + (Set.findIndex (mapLookup ((snd el) - 1) (tThird tp)) (tFirst tp)), Map.insert (fst el) (fst el) (tThird tp)) else ((tFirst tp), (tSecond tp), Map.insert (fst el) (mapLookup (fst el - 1) (tThird tp)) (tThird tp) )) (Set.singleton 0, 0, Map.singleton 0 0) $ zip [1..n] rarr

solve :: Int -> IO ()
solve 0 = do
    return ()
solve cases_left = do
    solveCase
    solve $ cases_left - 1

main = do
    s_testcases <- getLine
    solve $ (read s_testcases :: Int)

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

count :: [Int] -> Int -> [Int]
count [] i = []
count (x:xs) i = (if x <= i then 1 else 0) : (count xs $ i + 1)
count' arr = count arr 0

pref :: [Int] -> Int -> [Int]
pref [] prev = []
pref (x:xs) prev = (x + prev) : (pref xs (x + prev))
pref' arr = pref arr 0

fromJust Nothing = 0
fromJust (Just x) = x

solve :: [Int] -> Int -> Int
solve arr n =
    sum $ map (\(i, b) -> (fromJust $ Map.lookup (i-2) cnt) * b)
        $ filter (\(i, b) -> 1 < i && i < n)
        $ zip tl (count tl 1)
    where
        tl = tail arr
        cntArr = pref' $ count' arr
        cnt = Map.fromList $ zip [0..(n-1)] cntArr

testcase 0 = return ()
testcase t = do
    n <- readLn :: IO Int
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show $ solve arr n
    testcase (t - 1)

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

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

count :: [Int] -> Int -> [Int]
count [] i = []
count (x:xs) i = (if x <= i then 1 else 0) : (count xs $ i + 1)
count' arr = count arr 0

pref :: [Int] -> Int -> [Int]
pref [] prev = []
pref (x:xs) prev = (x + prev) : (pref xs (x + prev))
pref' arr = pref arr 0

fromJust Nothing = 0
fromJust (Just x) = x

solve :: [Int] -> Int -> Int
solve arr n =
    sum $ map (\(i, b) -> (fromJust $ Map.lookup (i-2) cnt) * b)
        $ filter (\(i, b) -> 1 < i && i < n)
        $ zip tl (count tl 1)
    where
        tl = tail arr
        cntArr = pref' $ count' arr
        cnt = Map.fromList $ zip [0..(n-1)] cntArr

testcase 0 = return ()
testcase t = do
    n <- readLn :: IO Int
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show $ (solve arr n) `mod` 1000000007
    testcase (t - 1)

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

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

count :: [Int] -> Int -> [Int]
count [] i = []
count (x:xs) i = (if x <= i then 1 else 0) : (count xs $ i + 1)
count' arr = count arr 0

pref :: [Int] -> Int -> [Int]
pref [] prev = []
pref (x:xs) prev = (x + prev) : (pref xs (x + prev))
pref' arr = pref arr 0

solve :: [Int] -> Int -> Int
solve arr n =
    sum $ map (\(i, b) -> if 1 < i && i < n then cnt !! (i-2) * b else 0) $ zip tl (count tl 1)
    where
        tl = tail arr
        cnt = pref' $ count' arr

testcase 0 = return ()
testcase t = do
    n <- readLn :: IO Int
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show arr
    putStrLn $ show $ count arr 0
    putStrLn $ show $ pref (count arr 0) 0
    putStrLn $ show $ (solve arr n) `mod` 1000000007
    testcase (t - 1)

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


{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import           Control.Applicative (liftA2)
import           Control.Monad.State ()

main :: IO ()
main = getLine >> LC.getContents
  >>= mapM_ ((\(a, b) -> putStr (show a) >> putStrLn (' ':show b)) . solve)
  . ints
  . LC.lines

ints :: [LC.ByteString] -> [Int]
ints !str = fst . fromJust . LC.readInt <$> str

solve :: Int -> (Int, Int)
solve !p = (2, p - 1)

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import Control.Monad.State ( replicateM_ )

main :: IO ()
main = do
  !t <- readLn
  replicateM_ t
    $ do
      !p <- getLine
      let b=let n=read p::Int in show (n-1)
      putStrLn $ '2':' ':b

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import Control.Monad.State ( replicateM_ )

main :: IO ()
main = do
  t <- readLn
  replicateM_ t
    $ do
      p <- getLine
      let (a, b) = ("2",let n=read p::Int in show (n-1))
      putStrLn $ a ++ (' ':b)

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import Control.Monad.State ( replicateM_ )

main :: IO ()
main = do
  t <- readLn
  replicateM_ t
    $ do
      p <- readLn
      let (a, b) = solve p
      putStr $ show a
      putStrLn $ ' ':show b

ints :: [LC.ByteString] -> [Int]
ints !str = fst . fromJust . LC.readInt <$> str

solve :: Int -> (Int, Int)
solve !p = (2, p - 1)

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import           Control.Applicative (liftA2)
import           Control.Monad.State ()

main :: IO ()
main = getLine >> LC.getContents
  >>= mapM_ ((\(a, b) -> putStr (show a) >> putStrLn (' ':show b)) . solve)
  . ints
  . LC.lines

ints :: [LC.ByteString] -> [Int]
ints str = fst . fromJust . LC.readInt <$> str

solve :: Int -> (Int, Int)
solve p = (2, p - 1)

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import           Control.Applicative (liftA2)
import           Control.Monad.State ()

main :: IO ()
main = getLine >> LC.getContents
  >>= mapM_ ((\[a, b] -> putStr (show a) >> putStrLn (' ':show b)) . solve)
  . ints
  . LC.lines

ints :: [LC.ByteString] -> [Int]
ints str = fst . fromJust . LC.readInt <$> str

solve :: Int -> [Int]
solve p = [2, p - 1]

import Control.Monad

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

subMain = do
    p <- readLn :: IO Int
    putStrLn $ "2 " ++ show (p - 1)

module Main where

main :: IO ()
main = do
    t <- readLn :: IO Int
    mapM_ subMain [1,2 .. t]

subMain :: Int -> IO ()
subMain test = do
    p <- readLn :: IO Int
    putStrLn ("2 " ++ show (p - 1))

main = do
    t <- read <$> getLine :: IO Int
    mapM_ solve [1..t]

solve :: Int -> IO ()
solve _ = do
    n <- read <$> getLine :: IO Int
    putStrLn $ show ((n - 1) `quot` 2) ++ " " ++ show (n - 1)

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    words
      >>> drop 1
      >>> map (read >>> subtract 1 >>> show >>> ("2 " ++))
      >>> unlines

import Control.Monad

solve 5 = [2,4]
solve x = [2,b] where b = div x 2

printResult = do
    p <- readLn :: IO Int
    putStrLn . unwords . map show $ solve p

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


{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

type IMap = IOUArray (Int,Int) Bool
-- type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: IMap -> Int -> Int -> [[Char]] -> IO ()
go arr 0 n [] = return ()
go arr m n (x:xs) =  do
  sequence_ [writeArray arr (n, j) b | (j,b) <- zipWith (\a m -> (m+n, case a of '1' -> True; '0'->False)) x [0..m-1], b]
  go arr (m-1) (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  arr <- newArray ((1,1), (n, n)) False
  xss <- replicateM n getLine
  go arr n 1 xss
  return $ (n, arr)

findM :: (a -> IO Bool) -> [a] -> IO (Maybe a)
findM f [] = return Nothing
findM f (x:xs) = liftM3 bool (findM f xs) (return (Just x))  (f x)

-- chunks to maximum connected component
chucks :: IMap -> Int -> Int -> IO [(Int, Int)]
chucks m l r =
  maybe (return []) (\r0 -> ((l, r0) :) <$> chucks m (r0+1) r)
    =<< findM ((readArray m) . (l,)) (reverse [l..r])

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

-- chunks sub maximum connected part
-- try to join maximum connected part to the root
solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r =
  do
    idxx <- chucks m (l+1) r
    foldlM f True idxx >> return ()
  where
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = do
      solve1 m l0 r0
      res <- findM ((readArray m) . (l,)) ([l0..r])
      -- get the first possible connect component from l to (l0, r0, r)
      case res of
        Just i ->  case (i > r0, b) of
            -- (l0, r0, i, r)
            -- (l, r0) is not connected while (l, l0-1),
            -- (l0, r0) must be connected to l through i (or the component where i belong),
            -- (r0+1, i-1) must contains another maximum connected components or violate the hypothesis (l0, r0 is maximum)
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible: At least (l, r) is connected by chucks"

-- try for the automatically generated if not fixed
solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

type IMap = IOUArray (Int,Int) Bool
-- type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: IMap -> Int -> [[Char]] -> IO ()
go arr n [] = return ()
go arr n (x:xs) =  do
  sequence_ [writeArray arr (n, j) b | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  go arr (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  arr <- newArray ((1,1), (n, n)) False
  xss <- replicateM n getLine
  go arr 1 xss
  return $ (n, arr)

findM :: (a -> IO Bool) -> [a] -> IO (Maybe a)
findM f [] = return Nothing
findM f (x:xs) = liftM3 bool (findM f xs) (return (Just x))  (f x)

-- chunks to maximum connected component
chucks :: IMap -> Int -> Int -> IO [(Int, Int)]
chucks m l r =
  maybe (return []) (\r0 -> ((l, r0) :) <$> chucks m (r0+1) r)
    =<< findM ((readArray m) . (l,)) (reverse [l..r])

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

-- chunks sub maximum connected part
-- try to join maximum connected part to the root
solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r =
  do
    idxx <- chucks m (l+1) r
    foldlM f True idxx >> return ()
  where
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = do
      solve1 m l0 r0
      res <- findM ((readArray m) . (l,)) ([l0..r])
      -- get the first possible connect component from l to (l0, r0, r)
      case res of
        Just i ->  case (i > r0, b) of
            -- (l0, r0, i, r)
            -- (l, r0) is not connected while (l, l0-1),
            -- (l0, r0) must be connected to l through i (or the component where i belong),
            -- (r0+1, i-1) must contains another maximum connected components or violate the hypothesis (l0, r0 is maximum)
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible: At least (l, r) is connected by chucks"

-- try for the automatically generated if not fixed
solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

type IMap = IOUArray (Int,Int) Bool
-- type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: IMap -> Int -> Int -> [[Char]] -> IO ()
go arr 0 n [] = return ()
go arr m n (x:xs) =  do
  sequence_ [writeArray arr (n, j) b | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..m-1], b]
  go arr (m-1) (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  arr <- newArray ((1,1), (n, n)) False
  xss <- replicateM n getLine
  go arr n 1 xss
  return $ (n, arr)

findM :: (a -> IO Bool) -> [a] -> IO (Maybe a)
findM f [] = return Nothing
findM f (x:xs) = liftM3 bool (findM f xs) (return (Just x))  (f x)

-- chunks to maximum connected component
chucks :: IMap -> Int -> Int -> IO [(Int, Int)]
chucks m l r =
  maybe (return []) (\r0 -> ((l, r0) :) <$> chucks m (r0+1) r)
    =<< findM ((readArray m) . (l,)) (reverse [l..r])

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

-- chunks sub maximum connected part
-- try to join maximum connected part to the root
solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r =
  do
    idxx <- chucks m (l+1) r
    foldlM f True idxx >> return ()
  where
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = do
      solve1 m l0 r0
      res <- findM ((readArray m) . (l,)) ([l0..r])
      -- get the first possible connect component from l to (l0, r0, r)
      case res of
        Just i ->  case (i > r0, b) of
            -- (l0, r0, i, r)
            -- (l, r0) is not connected while (l, l0-1),
            -- (l0, r0) must be connected to l through i (or the component where i belong),
            -- (r0+1, i-1) must contains another maximum connected components or violate the hypothesis (l0, r0 is maximum)
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible: At least (l, r) is connected by chucks"

-- try for the automatically generated if not fixed
solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

type IMap = IOUArray (Int,Int) Bool
-- type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: IMap -> Int -> Int -> [[Char]] -> IO ()
go arr 0 n [] = return ()
go arr m n (x:xs) =  do
  sequence_ [writeArray arr (n, j) b | (j,b) <- zipWith (\a m -> (m+n, case a of '1' -> True; '0'->False)) x [0..m-1], b]
  go arr (m-1) (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  arr <- newArray ((1,1), (n, n)) False
  xss <- replicateM n getLine
  go arr n 1 xss
  return $ (n, arr)

findM :: (a -> IO Bool) -> [a] -> IO (Maybe a)
findM f [] = return Nothing
findM f (x:xs) = do
  b <- f x
  if b then return (Just x) else findM f xs

-- chunks to maximum connected component
chucks :: IMap -> Int -> Int -> IO [(Int, Int)]
chucks m l r = go m l
  where
    go m l = do
      res <- findM ((readArray m) . (l,)) (reverse [l..r])
      case res of
        Just r0 ->
          ((l, r0) :) <$> go m (r0+1)
        Nothing -> return []

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

-- chunks sub maximum connected part
-- try to join maximum connected part to the root
solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r =
  do
    idxx <- chucks m (l+1) r
    foldlM f True idxx >> return ()
  where
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = do
      solve1 m l0 r0
      res <- findM ((readArray m) . (l,)) ([l0..r])
      -- get the first possible connect component from l to (l0, r0, r)
      case res of
        Just i ->  case (i > r0, b) of
            -- (l0, r0, i, r)
            -- (l, r0) is not connected while (l, l0-1),
            -- (l0, r0) must be connected to l through i (or the component where i belong),
            -- (r0+1, i-1) must contains another maximum connected components or violate the hypothesis (l0, r0 is maximum)
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible: At least (l, r) is connected by chucks"

-- try for the automatically generated if not fixed
solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> Int -> [[Char]] -> Set (Int, Int)
go 0 n [] = Set.empty
go m n (x:xs) =
   Set.fromList [(n,j)
    | (j,b) <- zipWith (\a m -> (m+n, case a of '1' -> True; '0'->False))
      x [0..m-1], b]
  `Set.union` go (m-1) (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ assert (n==length xss) (n, go n 1 xss)

-- chunks to maximum connected component
chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = go m l
  where
    go m l = case find ((`Set.member` m) . (l,)) (reverse [l..r]) of
      Just r0 -> (l, r0):go m (r0+1)
      Nothing -> []

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

-- chunks sub maximum connected part
-- try to join maximum connected part to the root
solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx >> return ()
  where
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = solve1 m l0 r0 >>
      -- get the first possible connect component from l to (l0, r0, r)
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  case (i > r0, b) of
            -- (l0, r0, i, r)
            -- (l, r0) is not connected while (l, l0-1),
            -- (l0, r0) must be connected to l through i (or the component where i belong),
            -- (r0+1, i-1) must contains another maximum connected components or violate the hypothesis (l0, r0 is maximum)
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible: At least (l, r) is connected by chucks"

-- try for the automatically generated if not fixed
solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> Int -> [[Char]] -> Set (Int, Int)
go 0 n [] = Set.empty
go m n (x:xs) =
   Set.fromList [(n,j)
    | (j,b) <- zipWith (\a m -> (m+n, case a of '1' -> True; '0'->False))
      x [0..m-1], b]
  `Set.union` go (m-1) (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ assert (n==length xss) (n, go n 1 xss)

-- chunks to maximum connected component
chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r =
  case find ((`Set.member` m) . (l,)) (reverse [l..r]) of
    Just r0 -> (l, r0):chucks m (r0+1) r
    Nothing -> []

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx >> return ()
  where
    -- chunks sub maximum connected part
    -- try to join maximum connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = solve1 m l0 r0 >>
      -- get the first possible connect component from l to (l0, r0, r)
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  case (i > r0, b) of
            -- (l0, r0, i, r)
            -- (l, r0) is not connected while (l, l0-1),
            -- (l0, r0) must be connected to l through i (or the component where i belong),
            -- (r0+1, i-1) must contains another maximum connected components or violate the hypothesis (l0, r0 is maximum)
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible: At least (l, r) is connected by chucks"

-- try for the automatically generated if not fixed
solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> Int -> [[Char]] -> Set (Int, Int)
go 0 n [] = Set.empty
go m n (x:xs) =
   Set.fromList [(n,j)
    | (j,b) <- zipWith (\a m -> (m+n, case a of '1' -> True; '0'->False))
      x [0..m-1], b]
  `Set.union` go (m-1) (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ assert (n==length xss) (n, go n 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    -- find the right most part
    idxx = find ((`Set.member` m) . (l,)) $ reverse [l..r]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx >> return ()
  where
    -- chunks sub connected part
    -- try to join connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = solve1 m l0 r0 >>
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  case (i > r0, b) of
            -- (l, r0) is not connected while (l, l0-1) and (l0, i) do,
            -- (l0, r0) must be connected to l through i(or the component where i belong),
            -- (r0+1, i-1) must contains another maximum connected components or violate the hypothesis
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible"

-- try for the automatically generated if not fixed

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> Int -> [[Char]] -> Set (Int, Int)
go 0 n [] = Set.empty
go m n (x:xs) =
   Set.fromList [(n,j)
    | (j,b) <- zipWith (\a m -> (m+n, case a of '1' -> True; '0'->False))
      x [0..m-1], b]
  `Set.union` go (m-1) (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ assert (n==length xss) (n, go n 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    -- find the right most part
    idxx = find ((`Set.member` m) . (l,)) $ reverse [l..r]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx >> return ()
  where
    -- chunks sub connected part
    -- try to join connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = solve1 m l0 r0 >>
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  case (i > r0, b) of
            -- (l, r0) is not connected while (l, l0-1) and (l0, i) do,
            -- (l0, r0) must be connected to l by i, (r0+1, i-1) must not be connected to i
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible"

-- try for the automatically generated if not fixed

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> Int -> [[Char]] -> Set (Int, Int)
go 0 n [] = Set.empty
go m n (x:xs) =
   Set.fromList [(n,j)
    | (j,b) <- zipWith (\a m -> (m+n, case a of '1' -> True; '0'->False))
      x [0..length x-1], b]
  `Set.union` go (m-1) (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ assert (n==length xss) (n, go n 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    -- find the right most part
    idxx = find ((`Set.member` m) . (l,)) $ reverse [l..r]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx >> return ()
  where
    -- chunks sub connected part
    -- try to join connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = solve1 m l0 r0 >>
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  case (i > r0, b) of
            -- (l, r0) is not connected while (l, l0-1) and (l0, i) do,
            -- (l0, r0) must be connected to l by i, (r0+1, i-1) must not be connected to i
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible"

-- try for the automatically generated if not fixed

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, case a of '1' -> True; '0'->False)) x [0..length x-1], b]
  `Set.union` go (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ assert (n==length xss) (n, go 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    -- find the right most part
    idxx = find ((`Set.member` m) . (l,)) $ reverse [l..r]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx >> return ()
  where
    -- chunks sub connected part
    -- try to join connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = solve1 m l0 r0 >>
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  case (i > r0, b) of
            -- (l, r0) is not connected while (l, l0-1) and (l0, i) do,
            -- (l0, r0) must be connected to l by i, (r0+1, i-1) must not be connected to i
            (True, True) -> printResult (l0, i) >> return False
            -- (l, r0) is not connected and (l, l0-1) do not, just connect l0 to l
            (True, False) -> printResult (l, l0) >> return b
            -- (l, r0) is connected, reoriented (l0, r0) to i, connect i to l
            (False, _) -> printResult (l, i) >> return True
        Nothing -> error "impossible"

-- try for the automatically generated if not fixed

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  `Set.union` go (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    -- find the right most part
    idxx = find ((`Set.member` m) . (l,)) $ reverse [l..r]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    -- chunks sub connected part
    -- try to join connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    -- b is wether already connected for (l, l0-1)
    f b (l0, r0) = solve1 m l0 r0 >>
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  case (i > r0, b) of
            (False, _) -> printResult (l, i) >> return True
            (True, True) -> printResult (r0, i) >> return False
            (True, False) -> printResult (l, l0) >> return b
        Nothing -> error "impossible"

-- try for the automatically generated if not fixed

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromAscList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  `Set.union`  go (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    -- find the right most part
    idxx = find ((`Set.member` m) . (l,)) $ reverse [l..r]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    -- chunks sub connected part
    -- try to join connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    f b (l0, r0) = solve1 m l0 r0 >>
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  case (i > r0, b) of
            (False, _) -> printResult (l, i) >> return True
            (True, True) -> printResult (l0, i) >> return False
            (True, False) -> printResult (l, l0) >> return b
        Nothing -> error "impossible"

-- try for the automatically generated if not fixed

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromAscList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  `Set.union`  go (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    -- find the right most part
    idxx = find ((`Set.member` m) . (l,)) $ reverse [l..r]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    -- chunks sub connected part
    -- try to join connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    -- then we decide where to attach (l0, r0).
    f b (l0, r0) = solve1 m l0 r0 >>
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  case (i > r0, b) of
            (False, _) -> printResult (l, i) >> return True
            (True, True) -> printResult (r0, i) >> return False
            (True, False) -> printResult (l, l0) >> return b
        Nothing -> error "impossible"

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromAscList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  `Set.union`  go (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    -- find the right most part
    idxx = find ((`Set.member` m) . (l,)) $ reverse [l..r]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    -- chunks sub connected part
    -- try to join connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    f b (l0, r0) = solve1 m l0 r0 >>
      case find ((`Set.member` m) . (l,)) [l0..r] of
        Just i ->  (case (i > r0, b) of
            (False, _) -> printResult (l, i) >> return True
            (True, True) -> printResult (r0, i) >> return False
            (True, False) -> printResult (l, l0) >> return b)
        Nothing -> return b

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromAscList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  `Set.union`  go (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    -- find the right most part
    idxx = find ((`Set.member` m) . (l,)) $ reverse [l..r]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    -- chunks sub connected part
    -- try to join connected part to the root
    idxx = chucks m (l+1) r
    --  for each (l0, r0), we solve as sub problem
    f b (l0, r0) = solve1 m l0 r0 >> case find ((`Set.member` m) . (l,)) [l0..r] of
      Just i ->  (case (i > r0, b) of
          (False, _) -> printResult (l, i) >> return True
          (True, True) -> printResult (r0, i) >> return False
          (True, False) -> printResult (l, l0) >> return b )
      Nothing -> return b

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromAscList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  `Set.union`  go (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    idxx = find ((`Set.member` m) . (l,)) [r0 | r0 <- reverse [l..r]]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    idxx = chucks m (l+1) r
    f b (l0, r0) = case find ((`Set.member` m) . (l,)) [l0..r] of
      Just i ->  (case (i > r0, b) of
          (False, _) -> printResult (l, i) >> return True
          (True, True) -> printResult (r0, i) >> return False
          (True, False) -> printResult (l, l0) >> return b ) <* solve1 m l0 r0
      Nothing -> return b

solve :: Solver
solve (n, m) = solve1 m 1 n

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromAscList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [1..length x], b]
  `Set.union`  go (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 1 xss)

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    idxx = find ((`Set.member` m) . (l,)) [r0 | r0 <- reverse [l..r]]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show i ++ " " ++ show j

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    idxx = chucks m (l+1) r
    f b (l0, r0) = case find ((`Set.member` m) . (l,)) [l0..r] of
      Just i ->  (case (i > r0, b) of
          (False, _) -> printResult (l, i) >> return True
          (True, True) -> printResult (r0, i) >> return False
          (True, False) -> printResult (l, l0) >> return b ) <* solve1 m l0 r0
      Nothing -> return b

solve :: Solver
solve (n, m) = solve1 m 0 (n-1)

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromAscList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  `Set.union`  go (n+1) xs
parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 0 xss)

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    idxx = find ((`Set.member` m) . (l,)) [r0 | r0 <- reverse [l..r]]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show (i+1) ++ " " ++ show (j+1)

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    idxx = chucks m (l+1) r
    f b (l0, r0) = case find ((`Set.member` m) . (l,)) [l0..r] of
      Just i ->  (case (i > r0, b) of
          (False, _) -> printResult (l, i) >> return True
          (True, True) -> printResult (r0, i) >> return False
          (True, False) -> printResult (l, l0) >> return b ) <* solve1 m l0 r0
      Nothing -> return b
solve :: Solver
solve (n, m) = solve1 m 0 (n-1)

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

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

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromAscList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  `Set.union`  go (n+1) xs
parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 0 xss)

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    idxx = find ((`Set.member` m) . (l,)) [r0 | r0 <- reverse [l..r]]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show (i+1) ++ " " ++ show (j+1)

solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    idxx = chucks m (l+1) r
    f b (l0, r0) = case find ((`Set.member` m) . (l,)) [l0..r] of
      Just i -> solve1 m l0 r0 >> (case (i > r0, b) of
          (False, _) -> printResult (l, i) >> return True
          (True, True) -> printResult (r0, i) >> return False
          (True, False) -> printResult (l, l0) >> return b )
      Nothing -> return b
solve :: Solver
solve (n, m) = solve1 m 0 (n-1)

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class

type IMap = Set (Int, Int)
type Domain = (Int, IMap)
type CoDomain = IO ()
type Solver  = Domain -> IO ()

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

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

-- printAns :: CoDomain -> IO ()
-- printAns = putStrLn . showResult

go :: Int -> [[Char]] -> Set (Int, Int)
go n [] = Set.empty
go n (x:xs) =
   Set.fromAscList [(n,j) | (j,b) <- zipWith (\a m -> (m+n, a=='1')) x [0..length x-1], b]
  `Set.union`  go (n+1) xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xss <- replicateM n getLine
  return $ (n, go 0 xss)

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

chucks :: IMap -> Int -> Int -> [(Int, Int)]
chucks m l r = case idxx of
  Just r0 -> (l, r0):chucks m (r0+1) r
  Nothing -> []
  where
    idxx = find ((`Set.member` m) . (l,)) [r0 | r0 <- reverse [l..r]]

printResult :: (Int ,Int)  -> IO ()
printResult (i, j) = putStrLn $ show (i+1) ++ " " ++ show (j+1)
solve1 :: IMap -> Int -> Int -> IO ()
solve1 m l r = foldlM f True idxx  >> return ()
  where
    idxx = chucks m (l+1) r
    f b (l0, r0) = case find ((`Set.member` m) . (l,)) [l0..r] of
      Just i -> solve1 m l0 r0 >> (case (i > r0, b) of
          (False, _) -> printResult (l, i) >> return True
          (True, True) -> printResult (r0, i) >> return False
          (True, False) -> printResult (l, l0) >> return b )
      Nothing -> return b

solve :: Solver
solve (n, m) = solve1 m 0 (n-1)

main :: IO ()
main = do
  [n] <- readChar8
  xs <- replicateM n $ solve <$> parse
  sequence_ xs
  return ()


type Long = Int

solve :: Long -> Long -> IO ()
solve n s
    | n > (s `div` 2)   = putStrLn "NO"
    | otherwise = do
        putStrLn "YES"
        putStrLn $ unwords $ map show $ (s-n+1):replicate (n-1) 1
        print (s `div` 2)

main :: IO ()
main = do
    (n:s:_) <- readWords
    solve n s

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

main = do
    (n:s:_) <- map read . words <$> getLine
    if s >= n * 2
        then do
            putStrLn "YES"
            putStrLn $ unwords . map show $ (s - n + 1) : replicate (n - 1) 1
            print $ div s 2
        else putStrLn "NO"


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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  replicateM_ t $ do
    [c, d] <- getInts 2
    let
      s = c - d
      w = c + d
    putInts . pure $ if  odd s
      then  0-1
      else  (if  s == 0  then  0  else  1) + (if  w == 0  then  0  else  1)

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

import Control.Monad
import Data.List

calc :: Int -> Int -> Int
calc c d =
  let diff = abs (c-d) in
    if (diff == 0) && (c == 0) then 0
    else if diff == 0 then 1
    else if diff `mod` 2 == 1 then -1
    else 2

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [c,d] = map read $ words line :: [Int]
    putStrLn $ show $ calc c d

module Main where

testCase :: Integer -> IO ()
testCase 0 = return ()
testCase n = do
    x <- getLine
    a <- return $ map (read :: String -> Integer) (words x)
    v1 <- return $ head a
    v2 <- return $ head $ tail a
    res <- return $
        if v1 == v2 then
            if v1 == 0 then 0
            else 1
        else
            if mod (v1 + v2) 2 == 0 then 2
            else -1
    print res
    testCase (n-1)

main :: IO ()
main = do
    x <- getLine
    n <- return (read x :: Integer)
    testCase n

main = do
    t <- read <$> getLine :: IO Int
    mapM_ main' [1..t]

main' :: Int -> IO ()
main' _ = do
    [a, b] <- map read . words <$> getLine :: IO [Int]
    print $ solve a b

solve :: Int -> Int -> Int
solve a b
    | a == 0 && b == 0  = 0
    | a == b            = 1
    | even $ a + b      = 2
    | otherwise         = -1

{-# 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 input) >>> map (solve >>> output) >>> C.unlines

type Input = (Int, Int)
type Output = Int

input :: Scanner Input
input = pair int int

output :: Output -> C.ByteString
output = showB

solve :: Input -> Output
solve (0, 0) = 0
solve (x, y)
  | x == y = 1
  | even (x + y) = 2
solve _ = -1

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