Rhodoks has a tree with $$$n$$$ vertices, but he doesn't remember its structure. The vertices are indexed from $$$1$$$ to $$$n$$$.A segment $$$[l,r]$$$ ($$$1 \leq l \leq r \leq n$$$) is good if the vertices with indices $$$l$$$, $$$l + 1$$$, ..., $$$r$$$ form a connected component in Rhodoks' tree. Otherwise, it is bad.For example, if the tree is the one in the picture, then only the segment $$$[3,4]$$$ is bad while all the other segments are good.  For each of the $$$\frac{n(n+1)}{2}$$$ segments, Rhodoks remembers whether it is good or bad. Can you help him recover the tree? If there are multiple solutions, print any.It is guaranteed that the there is at least one tree satisfying Rhodoks' description.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \leq t \leq 1000$$$). The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 2000$$$) — the number of vertices in the tree. Then $$$n$$$ lines follow. The $$$i$$$-th of these lines contains a string $$$good_i$$$ of length $$$n+1-i$$$ consisting of 0 and 1. If the segment $$$[i,i+j-1]$$$ is good then the $$$j$$$-th character of $$$good_i$$$ is 1, otherwise $$$j$$$-th character of $$$good_i$$$ is 0. It is guaranteed that the there is at least one tree consistent with the given data.  It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2000$$$.

For each test case, print $$$n-1$$$ lines describing the tree you recover.  The $$$i$$$-th line should contain two integers $$$u_i$$$ and $$$v_i$$$ ($$$1 \leq u_i,v_i \leq n$$$), denoting an edge between vertices $$$u_i$$$ and $$$v_i$$$. If there are multiple solutions, print any.

NoteThe first test case is explained in the statement.In the second test case, one possible tree is as follows:  In the third test case, one possible tree is as follows:

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


Petya and Vasya are competing with each other in a new interesting game as they always do.At the beginning of the game Petya has to come up with an array of $$$N$$$ positive integers. Sum of all elements in his array should be equal to $$$S$$$. Then Petya has to select an integer $$$K$$$ such that $$$0 \leq K \leq S$$$.In order to win, Vasya has to find a non-empty subarray in Petya's array such that the sum of all selected elements equals to either $$$K$$$ or $$$S - K$$$. Otherwise Vasya loses.You are given integers $$$N$$$ and $$$S$$$. You should determine if Petya can win, considering Vasya plays optimally. If Petya can win, help him to do that.

The first line contains two integers $$$N$$$ and $$$S$$$ ($$$1 \leq N \leq S \leq 10^{6}$$$) — the required length of the array and the required sum of its elements.

If Petya can win, print "YES" (without quotes) in the first line. Then print Petya's array in the second line. The array should contain $$$N$$$ positive integers with sum equal to $$$S$$$. In the third line print $$$K$$$. If there are many correct answers, you can print any of them. If Petya can't win, print "NO" (without quotes). You can print each letter in any register (lowercase or uppercase).

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"

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


William has two numbers $$$a$$$ and $$$b$$$ initially both equal to zero. William mastered performing three different operations with them quickly. Before performing each operation some positive integer $$$k$$$ is picked, which is then used to perform one of the following operations: (note, that for each operation you can choose a new positive integer $$$k$$$)  add number $$$k$$$ to both $$$a$$$ and $$$b$$$, or  add number $$$k$$$ to $$$a$$$ and subtract $$$k$$$ from $$$b$$$, or  add number $$$k$$$ to $$$b$$$ and subtract $$$k$$$ from $$$a$$$. Note that after performing operations, numbers $$$a$$$ and $$$b$$$ may become negative as well.William wants to find out the minimal number of operations he would have to perform to make $$$a$$$ equal to his favorite number $$$c$$$ and $$$b$$$ equal to his second favorite number $$$d$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The only line of each test case contains two integers $$$c$$$ and $$$d$$$ $$$(0 \le c, d \le 10^9)$$$, which are William's favorite numbers and which he wants $$$a$$$ and $$$b$$$ to be transformed into.

For each test case output a single number, which is the minimal number of operations which William would have to perform to make $$$a$$$ equal to $$$c$$$ and $$$b$$$ equal to $$$d$$$, or $$$-1$$$ if it is impossible to achieve this using the described operations.

NoteLet us demonstrate one of the suboptimal ways of getting a pair $$$(3, 5)$$$:  Using an operation of the first type with $$$k=1$$$, the current pair would be equal to $$$(1, 1)$$$.  Using an operation of the third type with $$$k=8$$$, the current pair would be equal to $$$(-7, 9)$$$.  Using an operation of the second type with $$$k=7$$$, the current pair would be equal to $$$(0, 2)$$$.  Using an operation of the first type with $$$k=3$$$, the current pair would be equal to $$$(3, 5)$$$.

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

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'

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


Pavel made a photo of his favourite stars in the sky. His camera takes a photo of all points of the sky that belong to some rectangle with sides parallel to the coordinate axes.Strictly speaking, it makes a photo of all points with coordinates $$$(x, y)$$$, such that $$$x_1 \leq x \leq x_2$$$ and $$$y_1 \leq y \leq y_2$$$, where $$$(x_1, y_1)$$$ and $$$(x_2, y_2)$$$ are coordinates of the left bottom and the right top corners of the rectangle being photographed. The area of this rectangle can be zero.After taking the photo, Pavel wrote down coordinates of $$$n$$$ of his favourite stars which appeared in the photo. These points are not necessarily distinct, there can be multiple stars in the same point of the sky.Pavel has lost his camera recently and wants to buy a similar one. Specifically, he wants to know the dimensions of the photo he took earlier. Unfortunately, the photo is also lost. His notes are also of not much help; numbers are written in random order all over his notepad, so it's impossible to tell which numbers specify coordinates of which points.Pavel asked you to help him to determine what are the possible dimensions of the photo according to his notes. As there are multiple possible answers, find the dimensions with the minimal possible area of the rectangle.

The first line of the input contains an only integer $$$n$$$ ($$$1 \leq n \leq 100\,000$$$), the number of points in Pavel's records. The second line contains $$$2 \cdot n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_{2 \cdot n}$$$ ($$$1 \leq a_i \leq 10^9$$$), coordinates, written by Pavel in some order.

Print the only integer, the minimal area of the rectangle which could have contained all points from Pavel's records.

NoteIn the first sample stars in Pavel's records can be $$$(1, 3)$$$, $$$(1, 3)$$$, $$$(2, 3)$$$, $$$(2, 4)$$$. In this case, the minimal area of the rectangle, which contains all these points is $$$1$$$ (rectangle with corners at $$$(1, 3)$$$ and $$$(2, 4)$$$).

{-# LANGUAGE BangPatterns #-}

import           Control.Applicative
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Int
import qualified Data.List             as L

main :: IO ()
main = do
    n <- readLn
    xs <- map fromIntegral.L.unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print $ solve n xs

solve :: Int -> [Int64] -> Int64
solve 1 _ = 0
solve n xs = go res0 (tail left) [] right
  where
    !m = minimum xs
    !mm = maximum xs
    !res0 = (maximum left - minimum left) * (maximum right - minimum right)
    !sorted = L.sort xs
    (left, right) = splitAt n sorted
    go !res [] rs (x:xs)     = go res (reverse rs) [] (x:xs)
    go !res (f:fs) rs (x:xs) = go (min res $ (mm - m) * (x - f)) fs (x:rs) xs
    go res _ _ []            = res

import System.IO
import Control.Applicative
import qualified Data.ByteString as B
{-import Data.HashSet-}
import Data.Bits
import qualified Data.Map as Map
import Data.Tuple
import Data.List
import qualified Data.Text as T
import Data.Text.Read
import Data.Int
{-import Data.Either.Unwrap-}
{-sort = mergesort-}

parseTextInt :: T.Text -> Integer
parseTextInt txt = case decimal txt of
    Right (ans, _) -> ans
    _ -> error "Bad int"

parseIntLine input line_idx  = map (read ::String->Int) mywords
    where
        mylines = lines input !! line_idx
        mywords = words mylines

parseIntLineText :: String -> Int -> [Integer]
parseIntLineText input line_idx  = map parseTextInt mywords
    where
        mylines = T.lines (T.pack input) !! line_idx
        mywords = T.words mylines

solve :: String -> String
{-solve input = (show $ allAnswers n as) ++ "\n" -}
solve input = (show $ answer n as) ++ "\n"
    where
        as = parseIntLineText input 1
        n = (fromIntegral $ parseIntLineText input 0 !! 0) :: Int

answer :: Int -> [Integer] -> Integer
answer n as = foldl min (answer1 n sas) $ allAnswers n sas
    where
        sas = sort as

allAnswers :: Int -> [Integer] -> [Integer]
allAnswers n sas =  map (\(a, b) -> fullBoundaries * (b - a)) $ zip (take (n+1) sas) (drop (n-1) sas)
    where
        fullBoundaries = getBoundaries sas

answer1 n sas = (getBoundaries $ take n sas) * (getBoundaries $ drop n sas)

getBoundaries as = (last as) - (head as)

main = (solve <$> getContents) >>= putStr

mergesort'merge :: (Ord a) => [a] -> [a] -> [a]
mergesort'merge [] xs = xs
mergesort'merge xs [] = xs
mergesort'merge (x:xs) (y:ys)
    | (x < y) = x:mergesort'merge xs (y:ys)
    | otherwise = y:mergesort'merge (x:xs) ys

mergesort'splitinhalf :: [a] -> ([a], [a])
mergesort'splitinhalf xs = (take n xs, drop n xs)
    where n = (length xs) `div` 2

mergesort :: (Ord a) => [a] -> [a]
mergesort xs
    | (length xs) > 1 = mergesort'merge (mergesort ls) (mergesort rs)
    | otherwise = xs
    where (ls, rs) = mergesort'splitinhalf xs

import           Control.Applicative
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Int
import qualified Data.List             as L

main :: IO ()
main = do
    n <- readLn
    xs <- map fromIntegral.L.unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print $ solve n xs

solve :: Int -> [Int64] -> Int64
solve n xs = (maximum left - minimum left) * (maximum right - minimum right)
  where
    (left, right) = splitAt n $ L.sort xs

import System.IO
import Control.Applicative
import qualified Data.ByteString as B
{-import Data.HashSet-}
import Data.Bits
import qualified Data.Map as Map
import Data.Tuple
import Data.List
import qualified Data.Text as T
import Data.Text.Read
{-import Data.Either.Unwrap-}
{-sort = mergesort-}

parseTextInt :: T.Text -> Int
parseTextInt txt = case decimal txt of
    Right (ans, _) -> ans
    _ -> 0

parseIntLine input line_idx  = map (read ::String->Int) mywords
    where
        mylines = lines input !! line_idx
        mywords = words mylines

parseIntLineText input line_idx  = map parseTextInt mywords
    where
        mylines = T.lines (T.pack input) !! line_idx
        mywords = T.words mylines

solve :: String -> String
{-solve input = (show $ allAnswers n as) ++ "\n" -}
solve input = (show $ answer n as) ++ "\n"
    where
        as = parseIntLineText input 1
        n = parseIntLineText input 0 !! 0

answer :: Int -> [Int] -> Int
answer n as = foldl min (answer1 n sas) $! allAnswers n sas
    where
        sas = sort as

allAnswers :: Int -> [Int] -> [Int]
allAnswers n sas =  map (\(a, b) -> fullBoundaries * (b - a)) $ zip (take n sas) (drop n sas)
    where
        fullBoundaries = getBoundaries sas

answer1 n sas = (getBoundaries $ take n sas) * (getBoundaries $ drop n sas)

getBoundaries as = (last as) - (head as)

main = (solve <$> getContents) >>= putStr

mergesort'merge :: (Ord a) => [a] -> [a] -> [a]
mergesort'merge [] xs = xs
mergesort'merge xs [] = xs
mergesort'merge (x:xs) (y:ys)
    | (x < y) = x:mergesort'merge xs (y:ys)
    | otherwise = y:mergesort'merge (x:xs) ys

mergesort'splitinhalf :: [a] -> ([a], [a])
mergesort'splitinhalf xs = (take n xs, drop n xs)
    where n = (length xs) `div` 2

mergesort :: (Ord a) => [a] -> [a]
mergesort xs
    | (length xs) > 1 = mergesort'merge (mergesort ls) (mergesort rs)
    | otherwise = xs
    where (ls, rs) = mergesort'splitinhalf xs

import System.IO
import Control.Applicative
import qualified Data.ByteString as B
{-import Data.HashSet-}
import Data.Bits
import qualified Data.Map as Map
import Data.Tuple
import Data.List
import qualified Data.Text as T
import Data.Text.Read
import Data.Int
{-import Data.Either.Unwrap-}
{-sort = mergesort-}

parseTextInt :: T.Text -> Integer
parseTextInt txt = case decimal txt of
    Right (ans, _) -> ans
    _ -> error "Bad int"

parseIntLine input line_idx  = map (read ::String->Int) mywords
    where
        mylines = lines input !! line_idx
        mywords = words mylines

parseIntLineText :: String -> Int -> [Integer]
parseIntLineText input line_idx  = map parseTextInt mywords
    where
        mylines = T.lines (T.pack input) !! line_idx
        mywords = T.words mylines

solve :: String -> String
{-solve input = (show $ allAnswers n as) ++ "\n" -}
solve input = (show $ answer n as) ++ "\n"
    where
        as = parseIntLineText input 1
        n = (fromIntegral $ parseIntLineText input 0 !! 0) :: Int

answer :: Int -> [Integer] -> Integer
answer n as = foldl min (answer1 n sas) $ allAnswers n sas
    where
        sas = sort as

allAnswers :: Int -> [Integer] -> [Integer]
allAnswers n sas =  map (\(a, b) -> fullBoundaries * (b - a)) $ zip (take n sas) (drop n sas)
    where
        fullBoundaries = getBoundaries sas

answer1 n sas = (getBoundaries $ take n sas) * (getBoundaries $ drop n sas)

getBoundaries as = (last as) - (head as)

main = (solve <$> getContents) >>= putStr

mergesort'merge :: (Ord a) => [a] -> [a] -> [a]
mergesort'merge [] xs = xs
mergesort'merge xs [] = xs
mergesort'merge (x:xs) (y:ys)
    | (x < y) = x:mergesort'merge xs (y:ys)
    | otherwise = y:mergesort'merge (x:xs) ys

mergesort'splitinhalf :: [a] -> ([a], [a])
mergesort'splitinhalf xs = (take n xs, drop n xs)
    where n = (length xs) `div` 2

mergesort :: (Ord a) => [a] -> [a]
mergesort xs
    | (length xs) > 1 = mergesort'merge (mergesort ls) (mergesort rs)
    | otherwise = xs
    where (ls, rs) = mergesort'splitinhalf xs

import System.IO
import Control.Applicative
import qualified Data.ByteString as B
{-import Data.HashSet-}
import Data.Bits
import qualified Data.Map as Map
import Data.Tuple
import Data.List
import qualified Data.Text as T
import Data.Text.Read
import Data.Int
{-import Data.Either.Unwrap-}
{-sort = mergesort-}

parseTextInt :: T.Text -> Int64
parseTextInt txt = case decimal txt of
    Right (ans, _) -> ans
    _ -> 0

parseIntLine input line_idx  = map (read ::String->Int) mywords
    where
        mylines = lines input !! line_idx
        mywords = words mylines

parseIntLineText input line_idx  = map parseTextInt mywords
    where
        mylines = T.lines (T.pack input) !! line_idx
        mywords = T.words mylines

solve :: String -> String
{-solve input = (show $ allAnswers n as) ++ "\n" -}
solve input = (show $ answer n as) ++ "\n"
    where
        as = parseIntLineText input 1
        n = fromIntegral $ parseIntLineText input 0 !! 0

answer :: Int -> [Int64] -> Int64
answer n as = foldl min (answer1 n sas) $! allAnswers n sas
    where
        sas = sort as

allAnswers :: Int -> [Int64] -> [Int64]
allAnswers n sas =  map (\(a, b) -> fullBoundaries * (b - a)) $ zip (take n sas) (drop n sas)
    where
        fullBoundaries = getBoundaries sas

answer1 n sas = (getBoundaries $ take n sas) * (getBoundaries $ drop n sas)

getBoundaries as = (last as) - (head as)

main = (solve <$> getContents) >>= putStr

mergesort'merge :: (Ord a) => [a] -> [a] -> [a]
mergesort'merge [] xs = xs
mergesort'merge xs [] = xs
mergesort'merge (x:xs) (y:ys)
    | (x < y) = x:mergesort'merge xs (y:ys)
    | otherwise = y:mergesort'merge (x:xs) ys

mergesort'splitinhalf :: [a] -> ([a], [a])
mergesort'splitinhalf xs = (take n xs, drop n xs)
    where n = (length xs) `div` 2

mergesort :: (Ord a) => [a] -> [a]
mergesort xs
    | (length xs) > 1 = mergesort'merge (mergesort ls) (mergesort rs)
    | otherwise = xs
    where (ls, rs) = mergesort'splitinhalf xs

import System.IO
import Control.Applicative
import qualified Data.ByteString as B
{-import Data.HashSet-}
import Data.Bits
import qualified Data.Map as Map
import Data.Tuple
import Data.List
import qualified Data.Text as T
import Data.Text.Read
import Data.Int
{-import Data.Either.Unwrap-}
{-sort = mergesort-}

parseTextInt :: T.Text -> Integer
parseTextInt txt = case decimal txt of
    Right (ans, _) -> ans
    _ -> error "Division by zero"

parseIntLine input line_idx  = map (read ::String->Int) mywords
    where
        mylines = lines input !! line_idx
        mywords = words mylines

parseIntLineText input line_idx  = map parseTextInt mywords
    where
        mylines = T.lines (T.pack input) !! line_idx
        mywords = T.words mylines

solve :: String -> String
{-solve input = (show $ allAnswers n as) ++ "\n" -}
solve input = (show $ answer n as) ++ "\n"
    where
        as = parseIntLineText input 1
        n = (fromIntegral $ parseIntLineText input 0 !! 0) :: Int

answer :: Int -> [Integer] -> Integer
answer n as = foldl min (answer1 n sas) $! allAnswers n sas
    where
        sas = sort as

allAnswers :: Int -> [Integer] -> [Integer]
allAnswers n sas =  map (\(a, b) -> fullBoundaries * (b - a)) $ zip (take n sas) (drop n sas)
    where
        fullBoundaries = getBoundaries sas

answer1 n sas = (getBoundaries $ take n sas) * (getBoundaries $ drop n sas)

getBoundaries as = (last as) - (head as)

main = (solve <$> getContents) >>= putStr

mergesort'merge :: (Ord a) => [a] -> [a] -> [a]
mergesort'merge [] xs = xs
mergesort'merge xs [] = xs
mergesort'merge (x:xs) (y:ys)
    | (x < y) = x:mergesort'merge xs (y:ys)
    | otherwise = y:mergesort'merge (x:xs) ys

mergesort'splitinhalf :: [a] -> ([a], [a])
mergesort'splitinhalf xs = (take n xs, drop n xs)
    where n = (length xs) `div` 2

mergesort :: (Ord a) => [a] -> [a]
mergesort xs
    | (length xs) > 1 = mergesort'merge (mergesort ls) (mergesort rs)
    | otherwise = xs
    where (ls, rs) = mergesort'splitinhalf xs

import System.IO
import Control.Applicative
import qualified Data.ByteString as B
{-import Data.HashSet-}
import Data.Bits
import qualified Data.Map as Map
import Data.Tuple
import Data.List
import qualified Data.Text as T
import Data.Text.Read
import Data.Int
{-import Data.Either.Unwrap-}
{-sort = mergesort-}

parseTextInt :: T.Text -> Int64
parseTextInt txt = case decimal txt of
    Right (ans, _) -> ans
    _ -> error "Division by zero"

parseIntLine input line_idx  = map (read ::String->Int) mywords
    where
        mylines = lines input !! line_idx
        mywords = words mylines

parseIntLineText input line_idx  = map parseTextInt mywords
    where
        mylines = T.lines (T.pack input) !! line_idx
        mywords = T.words mylines

solve :: String -> String
{-solve input = (show $ allAnswers n as) ++ "\n" -}
solve input = (show $ answer n as) ++ "\n"
    where
        as = parseIntLineText input 1
        n = fromIntegral $ parseIntLineText input 0 !! 0

answer :: Int -> [Int64] -> Int64
answer n as = foldl min (answer1 n sas) $! allAnswers n sas
    where
        sas = sort as

allAnswers :: Int -> [Int64] -> [Int64]
allAnswers n sas =  map (\(a, b) -> fullBoundaries * (b - a)) $ zip (take n sas) (drop n sas)
    where
        fullBoundaries = getBoundaries sas

answer1 n sas = (getBoundaries $ take n sas) * (getBoundaries $ drop n sas)

getBoundaries as = (last as) - (head as)

main = (solve <$> getContents) >>= putStr

mergesort'merge :: (Ord a) => [a] -> [a] -> [a]
mergesort'merge [] xs = xs
mergesort'merge xs [] = xs
mergesort'merge (x:xs) (y:ys)
    | (x < y) = x:mergesort'merge xs (y:ys)
    | otherwise = y:mergesort'merge (x:xs) ys

mergesort'splitinhalf :: [a] -> ([a], [a])
mergesort'splitinhalf xs = (take n xs, drop n xs)
    where n = (length xs) `div` 2

mergesort :: (Ord a) => [a] -> [a]
mergesort xs
    | (length xs) > 1 = mergesort'merge (mergesort ls) (mergesort rs)
    | otherwise = xs
    where (ls, rs) = mergesort'splitinhalf xs

import System.IO
import Control.Applicative
{-import Data.HashSet-}
import Data.Bits
import qualified Data.Map as Map
import Data.Tuple
import Data.List
{-import Data.Sort-}

parseIntLine input line_idx  = map read $ words $ lines input !! line_idx

solve :: String -> String
solve input = (show $ answer n as) ++ "\n"
    where
        as = parseIntLine input 1
        n = parseIntLine input 0 !! 0

answer :: Int -> [Int] -> Int
answer n as = (getBoundaries $ take n sas) * (getBoundaries $ drop n sas)
    where
        sas = sort as

getBoundaries as = (head $ reverse as) - (head as)

main = (solve <$> getContents) >>= putStr


For some time the program of rounding numbers that had been developed by the Codeforces participants during one of the previous rounds, helped the citizens of Far Far Away to convert numbers into a more easily readable format. However, as time went by, the economy of the Far Far Away developed and the scale of operations grew. So the King ordered to found the Bank of Far Far Away and very soon even the rounding didn't help to quickly determine even the order of the numbers involved in operations. Besides, rounding a number to an integer wasn't very convenient as a bank needed to operate with all numbers with accuracy of up to 0.01, and not up to an integer.The King issued yet another order: to introduce financial format to represent numbers denoting amounts of money. The formal rules of storing a number in the financial format are as follows:   A number contains the integer part and the fractional part. The two parts are separated with a character "." (decimal point).  To make digits in the integer part of a number easier to read, they are split into groups of three digits, starting from the least significant ones. The groups are separated with the character "," (comma). For example, if the integer part of a number equals 12345678, then it will be stored in the financial format as 12,345,678  In the financial format a number's fractional part should contain exactly two digits. So, if the initial number (the number that is converted into the financial format) contains less than two digits in the fractional part (or contains no digits at all), it is complemented with zeros until its length equals 2. If the fractional part contains more than two digits, the extra digits are simply discarded (they are not rounded: see sample tests).  When a number is stored in the financial format, the minus sign is not written. Instead, if the initial number had the minus sign, the result is written in round brackets.  Please keep in mind that the bank of Far Far Away operates using an exotic foreign currency — snakes ($), that's why right before the number in the financial format we should put the sign "$". If the number should be written in the brackets, then the snake sign should also be inside the brackets. For example, by the above given rules number 2012 will be stored in the financial format as "$2,012.00" and number -12345678.9 will be stored as "($12,345,678.90)".The merchants of Far Far Away visited you again and expressed much hope that you supply them with the program that can convert arbitrary numbers to the financial format. Can you help them?

The input contains a number that needs to be converted into financial format. The number's notation length does not exceed 100 characters, including (possible) signs "-" (minus) and "." (decimal point). The number's notation is correct, that is:    The number's notation only contains characters from the set {"0" – "9", "-", "."}.  The decimal point (if it is present) is unique and is preceded and followed by a non-zero quantity on decimal digits  A number cannot start with digit 0, except for a case when its whole integer part equals zero (in this case the integer parts is guaranteed to be a single zero: "0").  The minus sign (if it is present) is unique and stands in the very beginning of the number's notation  If a number is identically equal to 0 (that is, if it is written as, for example, "0" or "0.000"), than it is not preceded by the minus sign.  The input data contains no spaces.  The number's notation contains at least one decimal digit.

Print the number given in the input in the financial format by the rules described in the problem statement.

NotePay attention to the second and third sample tests. They show that the sign of a number in the financial format (and consequently, the presence or absence of brackets) is determined solely by the sign of the initial number. It does not depend on the sign of the number you got after translating the number to the financial format.

main = do
 str <- getLine
 putStrLn.check (head str).format $ abs' str

check c str@(x:xs)
 = if x == ',' then f c xs else f c str
  where
    f c xs = if c == '-' then "($"++xs++")" else '$':xs

abs' (x:xs) = if x == '-' then xs else (x:xs)

format :: String -> String
format str = let intPart = takeWhile (/='.') str
                 floatPart = drop (1+length intPart) str
             in  intStr intPart ++ floatStr floatPart

floatStr str = "."++(take 2 $ take 2 str ++ repeat '0')

intStr :: String -> String
intStr str = let p = take (mod (length str) 3) str
             in f . (:) p . dataList $ drop (length p) str
 where
  f = init.concat.map (\a -> a++",")

dataList :: String -> [String]
dataList [] = []
dataList str = a: dataList b
 where
  (a,b) = splitAt 3 str

main = getLine >>= putStrLn.answer

answer :: String -> String
answer ('-':cs) = "($"++ format cs ++ ")"
answer str      =  "$"++ format str

format str
 = let intPart = takeWhile (/='.') str
       floatPart = drop (1+length intPart) $ str
   in  formatI intPart  ++ formatF floatPart

formatI str = fst$foldl f ([],3-mod (length str) 3) str
 where
  f (str,0) c = (str++","++[c] , 1)
  f (str,m) c = (str++[c],mod (m+1) 3)

formatF str = '.':(take 2 $ take 2 str ++ repeat '0')

import Data.Char
import Control.Applicative

main = do cs <- getLine
          putStrLn $ solve cs

solve :: String -> String
solve ccs@(c:cs) = h ++ "$"++ (reverse $ f $ reverse m)++ (g q) ++ t
   where (n,p) = span ('.'/=) ccs
         q = if null p then p else tail p
         m = if c=='-' then tail n else n
         h = if c == '-' then "(" else []
         t = if c == '-' then ")" else []

f [] = []
f [x] = [x]
f [x,y] = [x,y]
f [x,y,z] = [x,y,z]
f (x:y:z:xs) = [x,y,z]++","++(f xs)

g [] = ".00"
g [x] = "."++[x]++"0"
g (x:y:xs) = "."++[x,y]

import Data.List
import Data.Char

processFirst :: String -> String
processFirst xs
  | length  xs <= 3 = xs
  | otherwise =  ret ++ "," ++ processFirst ret'  where
      ( ret , ret' ) = splitAt 3 xs

processSecond :: String -> String
processSecond xs = ret where
   tmp = xs ++ "00000000000000000000000"
   ret = if null xs then ".00" else take 3 tmp

helpSolve :: String -> String
helpSolve xs =   ret where
   ( first , second ) = break ( =='.' ) xs
   ret = ( reverse . processFirst . reverse  $ first )  ++ processSecond second

solve :: String -> String
solve ( x : xs ) = ret where
  ret = if x == '-' then "($" ++ helpSolve xs ++ ")" else "$" ++ helpSolve ( x:xs )

main = interact $ unlines . map  solve . lines

{-
import HUnit

testZero :: Test
testZero  =  Test "TestZero" $ assertEq "$0.00" (solve 0)

testInput :: Test
testInput  =  TestList "TestInput"
    [Test "1" $ assertEq "$2,012.00" (solve 2012),
     Test "2" $ assertEq "($0.00)" (solve (-0.00987654321)),
     Test "3" $ assertEq "($12,345,678.90)" (solve (-12345678.9))]

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

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

solve :: Double -> String
solve d
  | d < 0  =  concat ["(", solve (-d), ")"]
  | otherwise  =  concat ["$", solve' n, ".", if a' == 0 then "00" else (show a')]
  where
    (n, a)  =  properFraction d
    a'  =  truncate (a * 100)
    solve' :: Int -> String
    solve' n  =  reverse (solve'' (reverse (show n)))
      where
        solve'' (s1:s2:s3:s)  =  s1:s2:s3:',':solve'' s
        solve'' s  =  s

main :: IO ()
main  =  readLn >>= putStrLn . solve

main = getLine >>= putStrLn.(:) '$'.check.format.abs'

check str@(x:xs)
 = if x == ',' then xs else str

abs' (x:xs) = if x == '-' then xs else (x:xs)

format :: String -> String
format str = let intPart = takeWhile (/='.') str
                 floatPart = drop (1+length intPart) str
             in  intStr intPart ++ floatStr floatPart

floatStr str = "."++(take 2 $ take 2 str ++ repeat '0')

intStr :: String -> String
intStr str = let p = take (mod (length str) 3) str
             in f . (:) p . dataList $ drop (length p) str
 where
  f = init.concat.map (\a -> a++",")

dataList :: String -> [String]
dataList [] = []
dataList str = a: dataList b
 where
  (a,b) = splitAt 3 str