Consider a sequence of distinct integers $$$a_1, \ldots, a_n$$$, each representing one node of a graph. There is an edge between two nodes if the two values are not coprime, i. e. they have a common divisor greater than $$$1$$$.There are $$$q$$$ queries, in each query, you want to get from one given node $$$a_s$$$ to another $$$a_t$$$. In order to achieve that, you can choose an existing value $$$a_i$$$ and create new value $$$a_{n+1} = a_i \cdot (1 + a_i)$$$, with edges to all values that are not coprime with $$$a_{n+1}$$$. Also, $$$n$$$ gets increased by $$$1$$$. You can repeat that operation multiple times, possibly making the sequence much longer and getting huge or repeated values. What's the minimum possible number of newly created nodes so that $$$a_t$$$ is reachable from $$$a_s$$$?Queries are independent. In each query, you start with the initial sequence $$$a$$$ given in the input.

The first line contains two integers $$$n$$$ and $$$q$$$ ($$$2 \leq n \leq 150\,000$$$, $$$1 \leq q \leq 300\,000$$$) — the size of the sequence and the number of queries. The second line contains $$$n$$$ distinct integers $$$a_1, a_2, \ldots, a_n$$$ ($$$2 \leq a_i \leq 10^6$$$, $$$a_i \neq a_j$$$ if $$$i \ne j$$$). The $$$j$$$-th of the following $$$q$$$ lines contains two distinct integers $$$s_j$$$ and $$$t_j$$$ ($$$1 \leq s_j, t_j \leq n$$$, $$$s_j \neq t_j$$$) — indices of nodes for $$$j$$$-th query.

Print $$$q$$$ lines. The $$$j$$$-th line should contain one integer: the minimum number of new nodes you create in order to move from $$$a_{s_j}$$$ to $$$a_{t_j}$$$.

NoteIn the first example, you can first create new value $$$2 \cdot 3 = 6$$$ or $$$10 \cdot 11 = 110$$$ or $$$3 \cdot 4 = 12$$$. None of that is needed in the first query because you can already get from $$$a_1 = 2$$$ to $$$a_2 = 10$$$.In the second query, it's optimal to first create $$$6$$$ or $$$12$$$. For example, creating $$$6$$$ makes it possible to get from $$$a_1 = 2$$$ to $$$a_3 = 3$$$ with a path $$$(2, 6, 3)$$$.  In the last query of the second example, we want to get from $$$a_3 = 7$$$ to $$$a_5 = 25$$$. One way to achieve that is to first create $$$6 \cdot 7 = 42$$$ and then create $$$25 \cdot 26 = 650$$$. The final graph has seven nodes and it contains a path from $$$a_3 = 7$$$ to $$$a_5 = 25$$$.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative (liftA2)
import Control.Monad (forM_, guard, replicateM, when)
import Control.Monad.ST (ST, runST)
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.IArray (Array, elems)
import Data.Array.ST (MArray (newArray), STUArray, freeze, newListArray, readArray, writeArray)
import Data.Array.Unboxed (UArray, accumArray, (!))
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.IntSet as S
import Data.List (group, sort, unfoldr)
import Data.Maybe (fromJust)
import Debug.Trace (trace)

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

testCase :: Scanner String
testCase = do
  n <- int
  q <- int
  as <- n >< int
  qs <- q >< pair int int
  return . unlines . map show $ solve n as qs

type VVI = Array Int [Int]
type VSI = Array Int S.IntSet

solve :: Int -> [Int] -> [(Int, Int)] -> [Int]
solve n as = map query
  where
    query (u, v)
      | cu == cv = 0
      | cv `S.member` (adj ! cu) = 1
      | otherwise = 2
      where
        cu = dsu ! u
        cv = dsu ! v

    ps :: VVI
    ps = accumArray' (:) [] (1, lim) $ do
      (a, i) <- zip as [1 .. n]
      (,i) <$> factorize a
    dsu = buildDSU n $ concat [zip xs (tail xs) | xs <- elems ps, not (null xs)]

    adj :: VSI
    adj = accumArray' S.insert S.empty (1, n) $ do
      (a, i) <- zip as [1 .. n]
      let nodes = dsu ! i : [dsu ! head ns | f <- factorize (a + 1),
                                       let ns = ps ! f,
                                       not (null ns)]
      [(u, v) | u <- nodes, v <- nodes]

lim = 1 + 10 ^ 6
primes = sieve lim

factorize :: Int -> [Int]
factorize = map head . group . unfoldr f
  where
    f 1 = Nothing
    f n = let p = primes ! n in Just (p, n `div` p)

accumArray' f = accumArray (flip f)

-------------------------- Template ------------------------------------------
-- sieve
sieve :: Int -> UArray Int Int
sieve n =
  accumArray min n (1, n) $
    (1, 1) : do
      i <- [2 .. n]
      zip [i, 2 * i .. n] $ repeat i

-- DSU --
data DSU s = DSU {parentST :: STUArray s Int Int, sizeST :: STUArray s Int Int}

mkDSU :: Int -> ST s (DSU s)
mkDSU n = DSU <$> newListArray (1, n) [1 .. n] <*> newArray (1, n) 1

find :: Int -> DSU s -> ST s Int
find u dsu@(DSU par _) = do
  p <- readArray par u
  if p == u
    then return u
    else do
      p' <- find p dsu
      writeArray par u p'
      return p'

merge :: Int -> Int -> DSU s -> ST s Bool
merge u v dsu@(DSU par sz) = do
  u <- find u dsu
  v <- find v dsu
  when (u /= v) $ do
    su <- readArray sz u -- su = sz[pu]
    sv <- readArray sz v -- sv = sz[pv]
    let s = su + sv
    let (u', v') = if su >= sv then (u, v) else (v, u)
    writeArray par v' u' -- par[v] = u
    writeArray sz u' s -- sz[u] = s
  return $ u /= v

same :: Int -> Int -> DSU s -> ST s Bool
same u v dsu = (==) <$> find u dsu <*> find v dsu

buildDSU :: Int -> [(Int, Int)] -> UArray Int Int
buildDSU n edges = runST $ do
  dsu <- mkDSU n
  forM_ edges $ \(u, v) -> merge u v dsu
  forM_ [1 .. n] $ \u -> find u dsu
  freeze $ parentST dsu

-- Scanner --
type Scanner = State [C.ByteString]

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

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Array.ST
import Control.Monad.ST

import qualified Data.IntSet as S

sieve :: Int -> UArray Int Int
sieve n = accumArray min n (1, n) $ (1, 1) : do
  i <- [2..n]
  zip [i, 2*i .. n] $ repeat i

extractFactors :: UArray Int Int -> Int -> [Int]
extractFactors lpf = let
  go 1 = []
  go x = let  p = lpf ! x  in  p : go (quot x p)
  in  map head . group . go

dsuFind :: STUArray s Int Int -> Int -> ST s Int
dsuFind arr x = do
  p <- readArray arr x
  if  p == x
    then  pure x
    else  do
    p2 <- readArray arr x
    writeArray arr x p2
    dsuFind arr p2

merge :: (Int, Int) -> [(Int, Int)] -> UArray Int Int
merge bnds pairs = runSTUArray $ do
  par <- newListArray bnds $ range bnds
  sz <- newArray bnds 1 :: ST s (STUArray s Int Int)
  forM_ pairs $ \(x, y) -> do
    p <- dsuFind par x
    q <- dsuFind par y
    when (p /= q) $ do
      ps <- readArray sz p
      qs <- readArray sz q
      let  (s, t) = if  ps >= qs  then  (p, q)  else  (q, p)
      writeArray par t s
      writeArray sz s (ps + qs)
  forM_ (range bnds) $ \x -> dsuFind par x >>= writeArray par x
  pure par

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, q] <- readInts
  aLi <- readInts
  let
    a :: UArray Int Int
    a = listArray (1, n) aLi
    m = 1 + foldl' max 1 (elems a)
    lpf = sieve m
    direct :: Array Int [Int]
    direct = accumArray (flip (:)) [] (1, m) $ do
      (i, ai) <- assocs a
      [(p, i) | p <- extractFactors lpf ai]
    components = merge (1, n) [(v1, v2) | v1 : vs <- elems direct, v2 <- vs]
    oneSteps :: Array Int S.IntSet
    oneSteps = accumArray (flip S.insert) (S.empty) (1, m) $ do
      (i, ai) <- assocs a
      let
        js = components ! i : do
          p <- extractFactors lpf (ai + 1)
          j <- take 1 $ direct ! p
          pure $ components ! j
      [(j1, j2) | j1 <- js, j2 <- js]
  replicateM_ q $ do
    [s, t] <- map (components !) <$> readInts
    putInts $ pure $ if  s == t
      then  0
      else  if  S.member s (oneSteps ! t)
      then  1
      else  2

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative (liftA2)
import Control.Monad (forM_, guard, replicateM, when)
import Control.Monad.ST (ST, runST)
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.IArray (Array, elems)
import Data.Array.ST (MArray (newArray), STUArray, freeze, newListArray, readArray, writeArray)
import Data.Array.Unboxed (UArray, accumArray, (!))
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.IntSet as S
import Data.List (group, sort, unfoldr)
import Data.Maybe (fromJust)
import Debug.Trace (trace)

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

testCase :: Scanner String
testCase = do
  n <- int
  q <- int
  as <- n >< int
  qs <- q >< pair int int
  return . unlines . map show $ solve n as qs

type VVI = Array Int [Int]
type VSI = Array Int S.IntSet

solve :: Int -> [Int] -> [(Int, Int)] -> [Int]
solve n as = map query
  where
    query (u, v)
      | cu == cv = 0
      | cv `S.member` (adj ! cu) = 1
      | otherwise = 2
      where
        cu = dsu ! u
        cv = dsu ! v

    ps :: VVI
    ps = accumArray' (:) [] (1, lim) $ do
      (a, i) <- zip as [1 .. n]
      (,i) <$> factorize a
    dsu = buildDSU n $ concat [zip xs (tail xs) | xs <- elems ps, not (null xs)]

    adj :: VSI
    adj = accumArray' S.insert S.empty (1, n) $ do
      (a, i) <- zip as [1 .. n]
      let nodes = i : [dsu ! head ns | f <- factorize (a + 1),
                                       let ns = ps ! f,
                                       not (null ns)]
      [(u, v) | u <- nodes, v <- nodes]

lim = 10 ^ 6
primes = sieve lim

factorize :: Int -> [Int]
factorize = map head . group . unfoldr f
  where
    f 1 = Nothing
    f n = let p = primes ! n in Just (p, n `div` p)

accumArray' f = accumArray (flip f)

-------------------------- Template ------------------------------------------
-- sieve
sieve :: Int -> UArray Int Int
sieve n =
  accumArray min n (1, n) $
    (1, 1) : do
      i <- [2 .. n]
      zip [i, 2 * i .. n] $ repeat i

-- DSU --
data DSU s = DSU {parentST :: STUArray s Int Int, sizeST :: STUArray s Int Int}

mkDSU :: Int -> ST s (DSU s)
mkDSU n = DSU <$> newListArray (1, n) [1 .. n] <*> newArray (1, n) 1

find :: Int -> DSU s -> ST s Int
find u dsu@(DSU par _) = do
  p <- readArray par u
  if p == u
    then return u
    else do
      p' <- find p dsu
      writeArray par u p'
      return p'

merge :: Int -> Int -> DSU s -> ST s Bool
merge u v dsu@(DSU par sz) = do
  u <- find u dsu
  v <- find v dsu
  when (u /= v) $ do
    su <- readArray sz u -- su = sz[pu]
    sv <- readArray sz v -- sv = sz[pv]
    let s = su + sv
    let (u', v') = if su >= sv then (u, v) else (v, u)
    writeArray par v' u' -- par[v] = u
    writeArray sz u' s -- sz[u] = s
  return $ u /= v

same :: Int -> Int -> DSU s -> ST s Bool
same u v dsu = (==) <$> find u dsu <*> find v dsu

buildDSU :: Int -> [(Int, Int)] -> UArray Int Int
buildDSU n edges = runST $ do
  dsu <- mkDSU n
  forM_ edges $ \(u, v) -> merge u v dsu
  forM_ [1 .. n] $ \u -> find u dsu
  freeze $ parentST dsu

-- Scanner --
type Scanner = State [C.ByteString]

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

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Array.ST
import Control.Monad.ST

import qualified Data.IntSet as S

sieve :: Int -> UArray Int Int
sieve n = accumArray min n (1, n) $ (1, 1) : do
  i <- [2..n]
  zip [i, 2*i .. n] $ repeat i

extractFactors :: UArray Int Int -> Int -> [Int]
extractFactors lpf = let
  go 1 = []
  go x = let  p = lpf ! x  in  p : go (quot x p)
  in  map head . group . go

dsuFind :: STUArray s Int Int -> Int -> ST s Int
dsuFind arr x = do
  p <- readArray arr x
  if  p == x
    then  pure x
    else  do
    p2 <- readArray arr x
    writeArray arr x p2
    dsuFind arr p2

merge :: (Int, Int) -> [(Int, Int)] -> UArray Int Int
merge bnds pairs = runSTUArray $ do
  par <- newListArray bnds $ range bnds
  sz <- newArray bnds 1 :: ST s (STUArray s Int Int)
  forM_ pairs $ \(x, y) -> do
    p <- dsuFind par x
    q <- dsuFind par y
    when (p /= q) $ do
      ps <- readArray sz p
      qs <- readArray sz q
      let  (s, t) = if  ps >= qs  then  (p, q)  else  (q, p)
      writeArray par t s
      writeArray sz s (ps + qs)
  forM_ (range bnds) $ \x -> dsuFind par x >>= writeArray par x
  pure par

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, q] <- readInts
  aLi <- readInts
  let
    a :: UArray Int Int
    a = listArray (1, n) aLi
    m = 1 + foldl' max 1 (elems a)
    lpf = sieve m
    direct :: Array Int [Int]
    direct = accumArray (flip (:)) [] (1, m) $ do
      (i, ai) <- assocs a
      [(p, i) | p <- extractFactors lpf ai]
    components = merge (1, n) [(v1, v2) | v1 : vs <- elems direct, v2 <- vs]
    oneSteps :: Array Int S.IntSet
    oneSteps = accumArray (flip S.insert) (S.empty) (1, m) $ do
      (i, ai) <- assocs a
      let  ic = components ! i
      p <- extractFactors lpf (ai + 1)
      j <- take 1 $ direct ! p
      let  jc = components ! j
      [(ic, jc), (jc, ic)]
  replicateM_ q $ do
    [s, t] <- map (components !) <$> readInts
    putInts $ pure $ if  s == t
      then  0
      else  if  S.member s (oneSteps ! t)
      then  1
      else  2

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


Theater stage is a rectangular field of size n × m. The director gave you the stage's plan which actors will follow. For each cell it is stated in the plan if there would be an actor in this cell or not.You are to place a spotlight on the stage in some good position. The spotlight will project light in one of the four directions (if you look at the stage from above) — left, right, up or down. Thus, the spotlight's position is a cell it is placed to and a direction it shines.A position is good if two conditions hold:   there is no actor in the cell the spotlight is placed to;  there is at least one actor in the direction the spotlight projects. Count the number of good positions for placing the spotlight. Two positions of spotlight are considered to be different if the location cells or projection direction differ.

The first line contains two positive integers n and m (1 ≤ n, m ≤ 1000) — the number of rows and the number of columns in the plan. The next n lines contain m integers, 0 or 1 each — the description of the plan. Integer 1, means there will be an actor in the corresponding cell, while 0 means the cell will remain empty. It is guaranteed that there is at least one actor in the plan.

Print one integer — the number of good positions for placing the spotlight.

NoteIn the first example the following positions are good:  the (1, 1) cell and right direction;  the (1, 1) cell and down direction;  the (1, 3) cell and left direction;  the (1, 3) cell and down direction;  the (1, 4) cell and left direction;  the (2, 2) cell and left direction;  the (2, 2) cell and up direction;  the (2, 2) and right direction;  the (2, 4) cell and left direction. Therefore, there are 9 good positions in this example.

import Control.Monad
import Data.Array.IArray
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Array.MArray.Safe
import Data.Maybe (fromJust)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts = (map parseInt . BS8.words) `fmap` BS.getLine :: IO [Int]
parseInt = fst . fromJust . BS8.readInt

type Position = (Int, Int)
type Board = UArray (Int, Int) Bool
type Visible = UArray (Int, Int) Bool

main = do
    [n, m] <- getInts
    board <- toTable n m `fmap` replicateM n getInts
    let actorExists = map (checkExist board n m) [(-1,0), (1,0), (0,-1), (0,1)]
    print $ sum $ map (length . (goodPositions board n m)) actorExists

visitOrder n m dir = case dir of
    (-1,0) -> ([1..n], [1..m])
    (1,0) -> ([1..n], [m,m-1..1])
    (0,-1) -> ([1..n], [1..m])
    (0,1) -> ([n,n-1..1], [1..m])

checkExist :: Board -> Int -> Int -> (Int,Int) -> Visible
checkExist board n m (dirX,dirY) = runSTUArray $ do
    a <- newArray ((1,1),(n,m)) False
    let (rows, cols) = visitOrder n m (dirX,dirY)
    forM_ rows $ \y -> do
        forM_ cols $ \x -> do
            let y' = y + dirY
            let x' = x + dirX
            if 1 <= y' && y' <= n && 1 <= x' && x' <= m
            then do
                prev <- readArray a (y',x')
                writeArray a (y,x) (prev || board ! (y',x'))
            else return ()
    return a

toTable :: Int -> Int -> [[Int]] -> Board
toTable n m board = listArray ((1,1),(n,m)) [x == 1 | row <- board, x <- row]

goodPositions :: Board -> Int -> Int -> Visible -> [Position]
goodPositions board n m good = [(i,j) | i <- [1..n], j <- [1..m], board ! (i,j) == False, good ! (i,j)]

import Control.Monad
import Control.DeepSeq
import Control.Exception
import Data.Array.IArray
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Array.MArray.Safe
import Data.Maybe (fromJust)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts = (map parseInt . BS8.words) `fmap` BS.getLine :: IO [Int]
parseInt = fst . fromJust . BS8.readInt

type Position = (Int, Int)
type Board = UArray (Int, Int) Int
type Visible = UArray (Int, Int) Bool

main = do
    [n, m] <- getInts
    board <- toTable n m `fmap` replicateM n getInts
    evaluate board
    let actorExists = map (checkExist board n m) [(-1,0), (1,0), (0,-1), (0,1)]
    print $ sum $ map (length . (goodPositions board n m)) actorExists

visitOrder n m dir = case dir of
    (-1,0) -> ([1..n], [1..m])
    (1,0) -> ([1..n], [m,m-1..1])
    (0,-1) -> ([1..n], [1..m])
    (0,1) -> ([n,n-1..1], [1..m])

checkExist :: Board -> Int -> Int -> (Int,Int) -> Visible
checkExist board n m (dirX,dirY) = runSTUArray $ do
    a <- newArray ((1,1),(n,m)) False
    let (rows, cols) = visitOrder n m (dirX,dirY)
    forM_ rows $ \y -> do
        forM_ cols $ \x -> do
            let y' = y + dirY
            let x' = x + dirX
            if 1 <= y' && y' <= n && 1 <= x' && x' <= m
            then do
                prev <- readArray a (y',x')
                writeArray a (y,x) (prev || board ! (y',x') == 1)
            else return ()
    return a
{-
checkExist board n m (dirX,dirY) = a where
    a = array ((1,1),(n,m)) [((i,j), force $ check i j) | i <- [1..n], j <- [1..m]]
    check i j
        | valid i' j' = a ! (i',j') || board ! (i',j') == 1
        | otherwise = False
        where
            valid i j = 1 <= i && i <= n && 1 <= j && j <= m
            i' = i + dirY
            j' = j + dirX
-}

toTable :: Int -> Int -> [[Int]] -> Board
toTable n m board = listArray ((1,1),(n,m)) [x | row <- board, x <- row]

goodPositions :: Board -> Int -> Int -> Visible -> [Position]
goodPositions board n m good = [(i,j) | i <- [1..n], j <- [1..m], board ! (i,j) == 0, good ! (i,j)]


This is an interactive problem.Now Serval is a senior high school student in Japari Middle School. However, on the way to the school, he must go across a pond, in which there is a dangerous snake. The pond can be represented as a $$$n \times n$$$ grid. The snake has a head and a tail in different cells, and its body is a series of adjacent cells connecting the head and the tail without self-intersecting. If Serval hits its head or tail, the snake will bite him and he will die.Luckily, he has a special device which can answer the following question: you can pick a rectangle, it will tell you the number of times one needs to cross the border of the rectangle walking cell by cell along the snake from the head to the tail. The pictures below show a possible snake and a possible query to it, which will get an answer of $$$4$$$.    Today Serval got up too late and only have time to make $$$2019$$$ queries. As his best friend, can you help him find the positions of the head and the tail?Note that two cells are adjacent if and only if they have a common edge in the grid, and a snake can have a body of length $$$0$$$, that means it only has adjacent head and tail.Also note that the snake is sleeping, so it won't move while Serval using his device. And what's obvious is that the snake position does not depend on your queries.

The first line contains a single integer $$$n$$$ ($$$2\leq n \leq 1000$$$) — the size of the grid.

When you are ready to answer, you should print ! x1 y1 x2 y2, where $$$(x_1, y_1)$$$ represents the position of the head and $$$(x_2,y_2)$$$ represents the position of the tail. You can print head and tail in any order.

Note        The pictures above show our queries and the answers in the first example. We first made a query for $$$(1,1)$$$ and got an answer $$$1$$$, then found that it must be connected to exactly one other cell. Then we made a query for $$$(1,2)$$$ and got an answer of $$$0$$$, then knew that the snake never entered it. So the cell connected to $$$(1,1)$$$ must be $$$(2,1)$$$. Then we made a query for $$$(2,2)$$$ and got an answer $$$0$$$, then knew that it never entered $$$(2,2)$$$ as well. So the snake cannot leave $$$(2,1)$$$, which implies that the answer is $$$(1,1)$$$ and $$$(2,1)$$$.      The pictures above show our queries and the answers in the second example. By making query to $$$(2,2)$$$ and receiving $$$2$$$, we found that the snake occupies $$$(2,2)$$$. And by making query to rectangle from $$$(2,1)$$$ to $$$(2,3)$$$ and receiving answer $$$0$$$, we knew that it never goes out of the rectangle from $$$(2,1)$$$ to $$$(2,3)$$$. Since the first answer is $$$2$$$, both $$$(2,1)$$$ and $$$(2,3)$$$ must be occupied but none of others, so the answer is $$$(2,1)$$$ and $$$(2,3)$$$.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

test :: (Int,Int) -> (Int,Int) -> IO Int
test (x1,y1) (x2,y2) = do
  putStrLn $ unwords $ ("?":) $ map show $ [x1,y1,x2,y2]
  hFlush stdout
  reply <- readInt <$> getLine
  when (reply < 0) $ exitFailure
  return reply

testOdd :: (Int, Int) -> (Int, Int) -> IO Bool
testOdd p1 p2 = odd <$> test p1 p2

swapWith False = id
swapWith True = swap

main :: IO ()
main = do
  n <- readInt <$> getLine
  ((x1,y1),(x2,y2)) <- query n
  putStrLn $ unwords $ ("!":) $ map show $ [x1,y1,x2,y2]

query :: Int -> IO ((Int,Int),(Int,Int))
query n = do
  res_lr <- findLRUD False n
  case res_lr of
    Just (x1,x2) -> do
      y1 <- findLine False n x1
      y2 <- findLine False n x2
      return ((x1,y1),(x2,y2))
    Nothing -> do
      Just (y1,y2) <- findLRUD True n
      x <- findLine True n y1
      return ((x,y1),(x,y2))

findLRUD :: Bool -> Int -> IO (Maybe (Int,Int))
findLRUD xyflg n = go1 1
  where
    tst x = (testOdd `on` swapWith xyflg) (x,1) (x,n)
    go1 x
      | x >= n = return Nothing
      | otherwise = do
          b <- tst x
          if not b then go1 (x+1) else Just . (x,) <$> go2 (x+1)
    go2 x
      | x >= n = return n
      | otherwise = do
          b <- tst x
          if not b then go2 (x+1) else return x

findLine :: Bool -> Int -> Int -> IO Int
findLine flgSwap n x = go 0 n
  where
    swp = swapWith flgSwap
    go !lty !geqy
      | geqy - lty <= 1 = return geqy
      | otherwise = do
          b <- (testOdd `on` swp) (x,lty+1) (x,midy)
          if b then go lty midy else go midy geqy
      where
        midy = lty + shiftR (geqy - lty) 1

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

test :: (Int,Int) -> (Int,Int) -> IO Int
test (x1,y1) (x2,y2) = do
  putStrLn $ unwords $ ("?":) $ map show $ [x1,y1,x2,y2]
  hFlush stdout
  reply <- readInt <$> getLine
  when (reply < 0) $ exitFailure
  return reply

testOdd :: (Int, Int) -> (Int, Int) -> IO Bool
testOdd p1 p2 = odd <$> test p1 p2

swapWith False = id
swapWith True = swap

main :: IO ()
main = do
  n <- readInt <$> getLine
  ((x1,y1),(x2,y2)) <- query n
  putStrLn $ unwords $ ("!":) $ map show $ [x1,y1,x2,y2]

query :: Int -> IO ((Int,Int),(Int,Int))
query n = do
  res_lr <- findLRUD False n
  res_ud <- findLRUD True n
  case (res_lr,res_ud) of
    (Nothing,Nothing) -> exitFailure
    (Just (x1,x2),Nothing) -> do
      y <- findLine False n x1
      return ((x1,y),(x2,y))
    (Nothing, Just (y1,y2)) -> do
      x <- findLine True n y1
      return ((x,y1),(x,y2))
    (Just (x1,x2), Just (y1,y2)) -> do
      b <- testOdd (x1,y1) (x1,y1)
      return $ if b then ((x1,y1),(x2,y2)) else ((x1,y2),(x2,y1))

findLRUD :: Bool -> Int -> IO (Maybe (Int,Int))
findLRUD xyflg n = go1 1
  where
    tst x = (testOdd `on` swapWith xyflg) (x,1) (x,n)
    go1 x
      | x >= n = return Nothing
      | otherwise = do
          b <- tst x
          if not b then go1 (x+1) else Just . (x,) <$> go2 (x+1)
    go2 x
      | x >= n = return n
      | otherwise = do
          b <- tst x
          if not b then go2 (x+1) else return x

findLine :: Bool -> Int -> Int -> IO Int
findLine flgSwap n x = go 0 n
  where
    swp = swapWith flgSwap
    go !lty !geqy
      | geqy - lty <= 1 = return geqy
      | otherwise = do
          b <- (testOdd `on` swp) (x,lty+1) (x,midy)
          if b then go lty midy else go midy geqy
      where
        midy = lty + shiftR (geqy - lty) 1

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

test :: (Int,Int) -> (Int,Int) -> IO Int
test (x1,y1) (x2,y2) = do
  putStrLn $ unwords $ ("?":) $ map show $ [x1,y1,x2,y2]
  hFlush stdout
  reply <- readInt <$> getLine
  when (reply < 0) $ exitFailure
  return reply

testOdd :: (Int, Int) -> (Int, Int) -> IO Bool
testOdd p1 p2 = odd <$> test p1 p2

swapWith False = id
swapWith True = swap

main :: IO ()
main = do
  n <- readInt <$> getLine
  ((x1,y1),(x2,y2)) <- query n
  putStrLn $ unwords $ ("!":) $ map show $ [x1,y1,x2,y2]

query :: Int -> IO ((Int,Int),(Int,Int))
query n = do
  res_lr <- findLRUD False n
  res_ud <- findLRUD True n
  case (res_lr,res_ud) of
    (Nothing,Nothing) -> exitFailure
    (Just (x1,x2),Nothing) -> do
      y <- findLine False n x1
      return ((x1,y),(x2,y))
    (Nothing, Just (y1,y2)) -> do
      x <- findLine True n y1
      return ((x,y1),(x,y2))
    (Just (x1,x2), Just (y1,y2)) -> do
      b <- testOdd (x1,y1) (x1,y1)
      return $ if b then ((x1,y1),(x2,y2)) else ((x1,y2),(x2,y1))

findLRUD :: Bool -> Int -> IO (Maybe (Int,Int))
findLRUD xyflg n = go1 2
  where
    tst x = (test `on` swapWith xyflg) (x,1) (x,n)
    go1 x = case compare x n of
      GT -> return Nothing
      EQ -> do
        b <- odd <$> tst n
        return $ if b then Just (n-1,n) else Nothing
      LT -> do
        b <- tst x
        if | testBit b 0 -> do
               b <- tst (x+1)
               if | testBit b 0 -> return $ Just (x,x+1)
                  | testBit b 1 -> Just . (x,) <$> go2 (x+3)
                  | otherwise   -> return $ Just (x-1,x)
           | testBit b 1 -> Just . (x-1,) <$> go2 (x+2)
           | otherwise   -> go1 (x+2)
    go2 x = case compare x (n+1) of
      GT -> return n
      EQ -> do
        b <- odd <$> tst n
        return $ if b then n else n-1
      LT -> do
        b <- tst x
        if | testBit b 0 -> return x
           | testBit b 1 -> go2 (x+2)
           | otherwise -> return (x-1)

findLine :: Bool -> Int -> Int -> IO Int
findLine flgSwap n x = go 0 n
  where
    swp = swapWith flgSwap
    go !lty !geqy
      | geqy - lty <= 1 = return geqy
      | otherwise = do
          b <- (testOdd `on` swp) (x,lty+1) (x,midy)
          if b then go lty midy else go midy geqy
      where
        midy = lty + shiftR (geqy - lty) 1

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N


Dreamoon is a big fan of the Codeforces contests.One day, he claimed that he will collect all the places from $$$1$$$ to $$$54$$$ after two more rated contests. It's amazing!Based on this, you come up with the following problem:There is a person who participated in $$$n$$$ Codeforces rounds. His place in the first round is $$$a_1$$$, his place in the second round is $$$a_2$$$, ..., his place in the $$$n$$$-th round is $$$a_n$$$.You are given a positive non-zero integer $$$x$$$.Please, find the largest $$$v$$$ such that this person can collect all the places from $$$1$$$ to $$$v$$$ after $$$x$$$ more rated contests.In other words, you need to find the largest $$$v$$$, such that it is possible, that after $$$x$$$ more rated contests, for each $$$1 \leq i \leq v$$$, there will exist a contest where this person took the $$$i$$$-th place.For example, if $$$n=6$$$, $$$x=2$$$ and $$$a=[3,1,1,5,7,10]$$$ then answer is $$$v=5$$$, because if on the next two contest he will take places $$$2$$$ and $$$4$$$, then he will collect all places from $$$1$$$ to $$$5$$$, so it is possible to get $$$v=5$$$.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 5$$$) denoting the number of test cases in the input. Each test case contains two lines. The first line contains two integers $$$n, x$$$ ($$$1 \leq n, x \leq 100$$$). The second line contains $$$n$$$ positive non-zero integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 100$$$).

For each test case print one line containing the largest $$$v$$$, such that it is possible that after $$$x$$$ other contests, for each $$$1 \leq i \leq v$$$, there will exist a contest where this person took the $$$i$$$-th place.

NoteThe first test case is described in the statement.In the second test case, the person has one hundred future contests, so he can take place $$$1,2,\ldots,99$$$ and place $$$101$$$ on them in some order, to collect places $$$1,2,\ldots,101$$$.

import Control.Arrow
import Data.List (sort)

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

process :: [[Int]] -> [Int]
process [] = []
process ([_,x]:a:ps) = ((get x 1) . uniq . sort) a : process ps

get :: Int -> Int -> [Int] -> Int
get n _ [] = n
get n r (y:ys)
  | y == r = 1 + get n (r + 1) ys
  | n >= 1 = 1 + get (n - 1) (r + 1) (y:ys)
  | otherwise = 0

uniq :: (Eq a) => [a] -> [a]
uniq [] = []
uniq [x] = [x]
uniq (x:x':xs)
  | x == x' = ys
  | otherwise = x : ys
    where ys = uniq (x':xs)

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

readInt :: String -> Int
readInt = read

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

main :: IO ()
main = do
  t <- readLn :: IO Int
  putStr . unlines . map show =<<
    replicateM
      t
      (do [n, x] <- getInts
          solve 1 x . S.toAscList . S.fromList <$> getInts)

solve :: Int -> Int -> [Int] -> Int
solve v x [] = v + x - 1
solve v x (l:ls)
  | v == l = solve (v + 1) x ls
  | x > 0 = solve (v + 1) (x - 1) (l : ls)
  | otherwise = v - 1


Vasya is going to the Olympics in the city Ntown by train. The boy wants to read the textbook to prepare for the Olympics. He counted that he needed k hours for this. He also found that the light in the train changes every hour. The light is measured on a scale from 0 to 100, where 0 is very dark, and 100 is very light.Vasya has a train lighting schedule for all n hours of the trip — n numbers from 0 to 100 each (the light level in the first hour, the second hour and so on). During each of those hours he will either read the whole time, or not read at all. He wants to choose k hours to read a book, not necessarily consecutive, so that the minimum level of light among the selected hours were maximum. Vasya is very excited before the upcoming contest, help him choose reading hours.

The first input line contains two integers n and k (1 ≤ n ≤ 1000, 1 ≤ k ≤ n) — the number of hours on the train and the number of hours to read, correspondingly. The second line contains n space-separated integers ai (0 ≤ ai ≤ 100), ai is the light level at the i-th hour.

In the first output line print the minimum light level Vasya will read at. In the second line print k distinct space-separated integers b1, b2, ..., bk, — the indexes of hours Vasya will read at (1 ≤ bi ≤ n). The hours are indexed starting from 1. If there are multiple optimal solutions, print any of them. Print the numbers bi in an arbitrary order.

NoteIn the first sample Vasya should read at the first hour (light 20), third hour (light 30) and at the fourth hour (light 40). The minimum light Vasya will have to read at is 20.

import IO
import List
import Monad

solve :: Int -> Int -> [Int] -> (Int, [Int])
solve n k xs  =  (min, take k . map fst . filter ((min <=) . snd) . zip [1..] $ xs)
  where
    xs'  =  reverse (sort xs)
    min  =  xs' !! (k - 1)

main :: IO ()
main  =  do
    hInput  <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode

    [n, k]  <-  liftM (map read . words) (hGetLine hInput)
    xs      <-  liftM (map read . words) (hGetLine hInput)
    let (min, (y:ys))  =  solve n k xs
    hPrint hOutput min
    hPutStr hOutput (show y) >> mapM_ (hPutStr hOutput . (" " ++) . show) ys

    hClose hInput
    hClose hOutput

import Data.List

solve :: Int -> [Int] -> (Int, [Int])
solve k xs = (minimum $ map fst answer,
              map snd answer)
  where reversedFst (x, _) (y, _) = compare y x
        answer = take k $ sortBy reversedFst $ zip xs [1 .. ]

main = do (k:xs) <- fmap (tail . map read . words) $ readFile "input.txt"
          let (mn, bs) = solve k xs
          writeFile "output.txt" $ unlines [show mn, unwords $ map show bs]

import Data.List
import Data.Ord

main = readFile"input.txt">>=writeFile"output.txt".solve.map read.words

solve (_:k:xs) = case take k.sortBy(flip (comparing snd))$zip[1..]xs of
                   ans -> shows (minimum $map snd ans) "\n" ++ unwords(map (show.fst) ans)

import Data.List
import Data.Ord

main = readFile"input.txt">>=writeFile"output.txt".unwords.map show.solve.map read.words

solve (_:k:xs) = map fst.take k.sortBy(flip (comparing snd))$zip[1..]xs


Vasya and Petya are playing a simple game. Vasya thought of number x between 1 and n, and Petya tries to guess the number.Petya can ask questions like: "Is the unknown number divisible by number y?".The game is played by the following rules: first Petya asks all the questions that interest him (also, he can ask no questions), and then Vasya responds to each question with a 'yes' or a 'no'. After receiving all the answers Petya should determine the number that Vasya thought of.Unfortunately, Petya is not familiar with the number theory. Help him find the minimum number of questions he should ask to make a guaranteed guess of Vasya's number, and the numbers yi, he should ask the questions about.

A single line contains number n (1 ≤ n ≤ 103).

Print the length of the sequence of questions k (0 ≤ k ≤ n), followed by k numbers — the questions yi (1 ≤ yi ≤ n). If there are several correct sequences of questions of the minimum length, you are allowed to print any of them.

NoteThe sequence from the answer to the first sample test is actually correct.If the unknown number is not divisible by one of the sequence numbers, it is equal to 1.If the unknown number is divisible by 4, it is 4.If the unknown number is divisible by 3, then the unknown number is 3.Otherwise, it is equal to 2. Therefore, the sequence of questions allows you to guess the unknown number. It can be shown that there is no correct sequence of questions of length 2 or shorter.

import Data.List
main=interact $ solve. read
solve::Int->String
solve n = (show $ length nums) ++ "\n" ++ intercalate " " nums
        where primes = 2 : filter isPrime [3..]
              isPrime x = all ((/=0) . (mod x)) $ takeWhile ((<=x).(^2)) primes
              ps=takeWhile (<=n) primes
              f acc k x = if k>n then acc else f (k:acc) (x*k) x
              nums = map show . concat $ map (\x->f [] x x) ps

import Control.Applicative ((<$>))
import Control.Monad (forM_, when)
import Control.Monad.ST.Safe (ST)
import Data.Array.Unboxed (assocs)
import Data.Array.ST.Safe (STUArray, runSTUArray, newArray, readArray, writeArray)

sieve :: Int -> [Int]
sieve n = map fst . filter snd . assocs $ runSTUArray $ do
    arr <- newArray (2, n) True :: ST s (STUArray s Int Bool)
    forM_ [2..n] $ \i -> do
        b <- readArray arr i  -- if i is prime
        when b $ forM_ [i*i, i*i + i .. n] $ \i -> writeArray arr i False
    return arr

solve :: Int -> [Int]
solve n = concatMap run $ sieve n
    where run i = takeWhile (< n + 1) $ iterate (*i) i

main = do
    xs <- solve . read <$> getLine
    print $ length xs
    putStrLn . unwords $ map show xs

main = readLn >>= putStr . out . solve
out a = show (length a) ++ '\n' : (unwords $ map show a)

prime n = let nums = takeWhile (\x -> x * x <= n) [2..] in and $ map (\x -> n `rem` x /= 0) nums

solve n = concat $ map (\x -> takeWhile (<= n) $ iterate (x*) x) primes
  where primes = filter prime [2..n]

main = readLn >>= putStr . out . solve
out a = show (length a) ++ '\n' : (unwords $ map show a)

prime n = let nums = takeWhile ((<= n) . (^2)) [2..] in and $ map ((/=0) . (rem n)) nums

solve n = concat $ map (\x -> takeWhile (<= n) $ iterate (x*) x) primes
  where primes = filter prime [2..n]

import Text.Printf

sieve :: [Int]
sieve = sieve [2..]
    where
        sieve :: [Int] -> [Int]
        sieve (x:xs) = x:sieve [y | y <- xs, y `mod` x /= 0]

guesses :: Int -> [Int]
guesses n =
    let
        primes = takeWhile (<= n) sieve
    in
        concat [ primePowersUpToN x n x [] | x <- primes]
    where
        primePowersUpToN :: Int -> Int -> Int -> [Int] -> [Int]
        primePowersUpToN p n acc res
            | acc > n = res
            | otherwise = primePowersUpToN p n (acc * p) (acc:res)

main :: IO ()
main = do
    s <- getLine
    let n = read s :: Int
    let res = guesses n
    print $ length res
    mapM_ (printf "%d ") res

prime 2 = [2]
prime n | and (map (\x -> n `rem` x /= 0) pre) = pre++[n]
        | otherwise = pre
  where pre = prime (n-1)
isQ n (p:prime) f | n < p = True
                  | n `rem` p == 0 = if (f == 0 || f == p) then isQ (n `div` p) (p:prime) p else False
                  | f /= 0 = False
                  | otherwise = isQ n prime f
main = do
   w0 <- getLine
   let n = (read w0)::Int
   let p = prime 1000
   let kai = map show $ takeWhile (<=n) $ map fst $ filter (id.snd) $ zip [2..1000] (map(\n -> isQ n p 0) [2..1000])
   putStrLn $ show $ length kai
   putStrLn $ unwords kai

import Data.List
main=interact $ solve. read
solve::Int->String
solve n = (show $ length nums) ++ "\n" ++ intercalate " " nums
        where primes = 2 : filter isPrime [3..]
              isPrime x = all ((/=0) . (mod x)) $ takeWhile ((<=x).(^2)) primes
              ps=takeWhile (<=n) primes
              f acc x  = if x>=n then acc else f (x:acc) (x*x)
              nums = map show . concat $ map (f []) ps

import Data.List
main=interact $ solve. read
solve::Int->String
solve n = (show $ length nums) ++ "\n" ++ intercalate " " nums
        where primes = 2 : filter isPrime [3..]
              isPrime x = all ((/=0) . (mod x)) $ takeWhile ((<=x).(^2)) primes
              ps=takeWhile (<=n) primes
              f acc x  = if x>n then acc else f (x:acc) (x*x)
              nums = map show . concat $ map (f []) ps

import Control.Applicative ((<$>))
import Control.Monad (forM_, when)
import Control.Monad.ST.Safe (ST)
import Data.Array.Unboxed (assocs)
import Data.Array.ST.Safe (STUArray, runSTUArray, newArray, readArray, writeArray)

sieve :: Int -> [Int]
sieve n = map fst . filter snd . assocs $ runSTUArray $ do
    arr <- newArray (2, n) True :: ST s (STUArray s Int Bool)
    forM_ [2..n] $ \i -> do
        b <- readArray arr i  -- if i is prime
        when b $ forM_ [i*i, i*i + i .. n] $ \i -> writeArray arr i False
    return arr

solve :: Int -> [Int]
solve n = concatMap run $ sieve n
    where run i = takeWhile (< n + 1) $ iterate (*i) i

main = getLine >>= putStrLn . unwords . map show . solve . read

prime 2 = [2]
prime n | and (map (\x -> n `rem` x /= 0) pre) = pre++[n]
        | otherwise = pre
  where pre = prime (n-1)
isQ n (p:prime) f | n < p = True
                  | n `rem` p == 0 = if (f == 0 || f == p) then isQ (n `div` p) (p:prime) p else False
                  | f /= 0 = False
                  | otherwise = isQ n prime f
main = do
   w0 <- getLine
   let n = (read w0)::Int
   let p = prime 1000
   putStrLn $ unwords $ map show $ takeWhile (<=n) $ map fst $ filter (id.snd) $ zip [2..1000] (map(\n -> isQ n p 0) [2..1000])


When Valera has got some free time, he goes to the library to read some books. Today he's got t free minutes to read. That's why Valera took n books in the library and for each book he estimated the time he is going to need to read it. Let's number the books by integers from 1 to n. Valera needs ai minutes to read the i-th book.Valera decided to choose an arbitrary book with number i and read the books one by one, starting from this book. In other words, he will first read book number i, then book number i + 1, then book number i + 2 and so on. He continues the process until he either runs out of the free time or finishes reading the n-th book. Valera reads each book up to the end, that is, he doesn't start reading the book if he doesn't have enough free time to finish reading it. Print the maximum number of books Valera can read.

The first line contains two integers n and t (1 ≤ n ≤ 105; 1 ≤ t ≤ 109) — the number of books and the number of free minutes Valera's got. The second line contains a sequence of n integers a1, a2, ..., an (1 ≤ ai ≤ 104), where number ai shows the number of minutes that the boy needs to read the i-th book.

Print a single integer — the maximum number of books Valera can read.

import Data.Sequence as Q

readInts :: IO [Int]
readInts = do
    line <- getLine
    return $ map read $ words line

solve t books = go 0 0 [] books
    where
    go len sum buf [] = len
    go len sum buf rem@(b:bs) | sum+b <= t = go (len+1) (sum+b) (buf++[b]) bs
                              | len > 0 = max len $ go (len-1) (sum-(head buf)) (tail buf) rem
                              | otherwise = max len $ go len sum buf bs

solve2 t books = go 0 empty books
    where
    go sum buf [] = Q.length buf
    go sum buf rem@(b:bs) | sum+b <= t = go (sum+b) (b<|buf) bs
                          | otherwise = case viewr buf of
                                          EmptyR -> go sum buf bs
                                          s :> r -> max (Q.length buf) $ go (sum-r) s rem
main :: IO ()
main = do
    a <- readInts
    books <- readInts
    let (n, t) = (a!!0, a!!1)
    putStrLn $ show $ solve2 t books

import qualified Data.ByteString.Char8 as B

main = putStrLn .  show . solve . map (maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Int] -> Int
solve (n : t : as) = maximum $ map fst $ f as as (0, 0)
  where
  f [] _ x = [(0, 0)]
  f (a : as) (b : bs) (0, 0)
    |     a > t = f as bs (0, 0)
  f (a : as) (b : bs) (c, s)
    | s + a > t = (c - 1, s - b) : f (a : as) bs (c - 1, s - b)
    | otherwise = (c + 1, s + a) : f as (b : bs) (c + 1, s + a)

import Control.Monad (liftM)
import Data.Array ((!), listArray)
import Data.Char (ord)
import Data.List (intercalate)

solve :: Int -> [Int] -> Int
solve t as  =  solve' (r-l) s (l, r)
  where
    array  =  listArray (1, n) as
    n  =  length as
    l  =  1
    r  =  (+1) $ length $ tail $ takeWhile (<= t) $ scanl (+) 0 as
    s  =  sum $ take (r-1) as
    -- inv: sum [al .. ar-1] <= t
    --  && sum [al..ar] > t
    solve' ans s (l, r)
      | r > n  =  ans
      | otherwise  =  solve' ans' s' (l', r')
      where
        l'  =  l + 1
        (r', s')  =  findR (s - array ! l) r
        ans'  =  max ans (r'-l')
        findR s r
          | r > n  =  (r, s)
          | s' > t  =  (r, s)
          | otherwise  =  findR s' (r+1)
          where
            s'  =  s + array ! r

main :: IO ()
main  =  do
    [n, t]  <-  reads
    as  <-  reads
    print $ solve t as

  where

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' (10 * a + fromIntegral (ord c - ord '0')) s

main :: IO ()
main = getContents >>= print . solve . map read . words

solve :: [Int] -> Int
solve (_:t:as) = go 0 0 0 as as
  where go a k s xxs@(x:xs) (y:ys) | s + y <= t = go (max a (k + 1)) (k + 1) (s + y) xxs ys
                                   | otherwise = go a k (s + y - x) xs ys
        go a _ _ _ _ = a
solve _ = undefined

main = interact $ show . solve . map read . words
solve (m:t:as) = maximum $ 0 : go as as 0 0 where
  go ns@(n:ns') ps@(p:ps') r b | b > m = go ns' ps (r-p) (b-1)
                               | r + n > t = b : go ns ps' (r-p) (b-1)
                               | otherwise = b : go ns' ps (r+n) (b+1)
  go [] _ _ b = [b]
  go _ [] _ _ = []
test = [
    solve [4,5,3,1,2,1] == 3
  ]

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List

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

main = do
  [n,t] <- map read.words <$> getLine :: IO [Int]
  xs <- map readInt.B.words <$> B.getLine
  print $ solve t xs

data Queue = Q !Int !Int [Int] [Int]

solve t xs = maximum.snd $ mapAccumL enq (Q 0 0 [] []) xs
   where
     enq que@(Q cnt acc fs rs) x
       | x+acc<=t = (Q (cnt+1) (acc+x) fs (x:rs), cnt+1)
       | cnt == 0 = (Q 0 0 [] [], 0)
       | otherwise = enq (deq que) x
     deq (Q cnt acc (f:fs) rs) = Q (cnt-1) (acc-f) fs rs
     deq (Q cnt acc [] rs) = deq $ Q cnt acc (reverse rs) []

import Data.Maybe (fromMaybe)
import Data.Sequence (Seq(..), ViewL(..), viewl, (|>), (<|) )

import Data.List (foldl')
import Control.Monad (replicateM)

main :: IO ()
main = do
  (_:t:_) <- map read . words <$> getLine
  bookMins <- map read . words <$> getLine
  print $ maximum $ analyzeNextBook (t, Empty, []) bookMins

  where
    analyzeNextBook :: (Int, Seq Int, [Int]) -> [Int] -> [Int]
    analyzeNextBook (_, _, readBookCount) [] = readBookCount
    analyzeNextBook (minsLeft, readMins, readBookCount) (nextBookMins: unprocessed) =
      let newLeft = minsLeft - nextBookMins
          currBookCount = fromMaybe 0 $ safeHead readBookCount
      in if newLeft >= 0
         -- can read next one
         then analyzeNextBook (newLeft, readMins |> nextBookMins, currBookCount + 1 : readBookCount) unprocessed
         -- no mins left for next one
         else case viewl readMins of
                -- but none read ... so this book can't be read, skip it
                EmptyL -> analyzeNextBook (minsLeft, readMins, currBookCount : readBookCount) unprocessed
                -- try skipping first read and get back the minutes
                (firstMins :< restMins) -> analyzeNextBook (firstMins + minsLeft, restMins, currBookCount - 1 : readBookCount) (nextBookMins : unprocessed)

    safeHead [] = Nothing
    safeHead (x:xs) = Just x

import qualified Data.ByteString.Char8 as B
import Data.List

readInt bs = case B.readInt bs of Just (n,_) -> n
main = B.getContents >>= putStr . show . solve . map readInt . B.words

solve (n:k:a) = maximum $ map fst $ solve' a a (0, 0)
  where
      solve' [] _ x = [(0, 0)]
      solve' (a : as) (b : bs) (0, 0)
        |     a > k = solve' as bs (0, 0)
      solve' (a : as) (b : bs) (c, s)
        | s + a > k = (c - 1, s - b) : solve' (a : as) bs (c - 1, s - b)
        | otherwise = (c + 1, s + a) : solve' as (b : bs) (c + 1, s + a)

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate)

solve :: [Int] -> Int -> Int
solve as t  =  length $ takeWhile (<= t) $ tail $ scanl (+) 0 $ reverse as

main :: IO ()
main  =  do
    [n, t]  <-  reads
    as  <-  reads
    print $ solve as t

  where

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' (10 * a + fromIntegral (ord c - ord '0')) s

main = interact $ show . solve . map read . words
solve (m:t:as) = maximum $ 0 : go cas cas 0 0 where
  cas = as ++ as
  go ns@(n:ns') ps@(p:ps') r b | b > m = go ns' ps (r-p) (b-1)
                               | r + n > t = b : go ns ps' (r-p) (b-1)
                               | otherwise = b : go ns' ps (r+n) (b+1)
  go [] _ _ _ = []
  go _ [] _ _ = []

main = interact $ show . solve . map read . words
solve (m:t:as) = maximum $ 0 : go as as 0 0 where
  go ns@(n:ns') ps@(p:ps') r b | b > m = go ns' ps (r-p) (b-1)
                               | r + n > t = b : go ns ps' (r-p) (b-1)
                               | otherwise = b : go ns' ps (r+n) (b+1)
  go [] _ _ _ = []
  go _ [] _ _ = []

main = interact $ show . solve . map read . words
solve (m:t:as) = maximum $ 0 : go cas cas 0 0 where
  cas = as ++ as
  go ns@(n:ns') ps@(p:ps') r b | b > m = go ns' ps (r-p) (b-1)
                               | r + n > t = b : go ns ps' (r-p) (b-1)
                               | otherwise = go ns' ps (r+n) (b+1)
  go [] _ _ _ = []
  go _ [] _ _ = []

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B

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

main = do
  [n,t] <- map read.words <$> getLine :: IO [Int]
  xs <- map readInt.B.words <$> B.getLine
  print.length.dropWhile (t<) $ scanr1 (+) xs

import qualified Data.ByteString.Char8 as B
import Data.List

readInt bs = case B.readInt bs of Just (n,_) -> n
main = B.getContents >>= putStr . solve . map readInt . B.words

solve (n:k:a) = show . foldl max 0 $ zipWith delta z (inits z)
    where
        z = tail . scanl (+) 0 $ a
        delta cur prevs = binary (cur-k) prevs
        binary limit origin = length . dropWhile (<limit) $ origin


Cool J has recently become a businessman Mr. Jackson, and he has to make a lot of phone calls now. Today he has n calls planned. For each call we know the moment ti (in seconds since the start of the day) when it is scheduled to start and its duration di (in seconds). All ti are different. Mr. Jackson is a very important person, so he never dials anybody himself, all calls will be incoming.Mr. Jackson isn't Caesar and he can't do several things at once. If somebody calls him while he hasn't finished the previous conversation, Mr. Jackson puts the new call on hold in the queue. In this case immediately after the end of the current call Mr. Jackson takes the earliest incoming call from the queue and starts the conversation. If Mr. Jackson started the call at the second t, and the call continues for d seconds, then Mr. Jackson is busy at seconds t, t + 1, ..., t + d - 1, and he can start a new call at second t + d. Note that if Mr. Jackson is not busy talking when somebody calls, he can't put this call on hold.Mr. Jackson isn't Napoleon either, he likes to sleep. So sometimes he allows himself the luxury of ignoring a call, as if it never was scheduled. He can ignore at most k calls. Note that a call which comes while he is busy talking can be ignored as well.What is the maximum number of seconds Mr. Jackson can sleep today, assuming that he can choose an arbitrary continuous time segment from the current day (that is, with seconds from the 1-st to the 86400-th, inclusive) when he is not busy talking?Note that some calls can be continued or postponed to the next day or even later. However, the interval for sleep should be completely within the current day.

The first input line contains a pair of integers n, k (0 ≤ k ≤ n ≤ 4000) separated by a space. Following n lines contain the description of calls for today. The description of each call is located on the single line and consists of two space-separated integers ti and di, (1 ≤ ti, di ≤ 86400). All ti are distinct, the calls are given in the order of strict increasing ti. Scheduled times of calls [ti, ti + di - 1] can arbitrarily intersect.

Print a number from 0 to 86400, inclusive — the maximally possible number of seconds for Mr. Jackson to sleep today.

NoteIn the first sample the most convenient way is to ignore the first two calls.In the second sample it is best to ignore the third call. In this case Mr. Jackson will have been speaking:  first call: from 1-st to 20000-th second,  second call: from 20001-st to 30000-th second,  fourth call: from 30001-st to 40000-th second (the third call is ignored),  fifth call: from 80000-th to 139999-th second. Thus, the longest period of free time is from the 40001-th to the 79999-th second.

import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
import Control.Monad

f :: Int -> Int -> Int -> Int -> UArray Int Int -> UArray Int Int
f k t0 t1 d1 farr = listArray (0, k) [ f' i | i <- [0..k] ] where
    donotignore n = max 0 ((farr ! n) - (t1 - t0)) + d1
    doignore n    = (farr ! (n-1)) - (t1 - t0)

    f' 0 = donotignore 0
    f' n = min (doignore n) (donotignore n)

f0 k = listArray (0, k) $ repeat 0

solve k farr t0 [] = max ((86401 - t0) - (farr ! k)) 0
solve k farr t0 ((t1, d1):xs) = max ((t1 - t0) - (farr ! k))
                                    (solve k (f k t0 t1 d1 farr) t1 xs)

readInt = (\(Just (x,_)) -> x) . BS.readInt

main = do
    [n, k] <- liftM (map readInt . BS.words) BS.getLine
    list <- replicateM n $ do
        [t, d] <- liftM (map readInt . BS.words) BS.getLine
        return (t, d)

    print $ solve k (f0 k) 1 list

{-
 -
 - Yannis Chatzimichos
 - A.M.: 03108610
 -
 - http://codeforces.com/problemset/problem/158/E
 -
 -}

import Debug.Trace
import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

solve_cur_row :: Int -> Int -> [Int] -> (Int, [Int])
solve_cur_row t d [prev0]
  | t <= prev0  = (0, [prev0+d])
  | otherwise   = (t-prev0-1, [t+d-1])
solve_cur_row t d (prev0:prev1:prev_row)  =
  let
    cur0' = if t <= prev0 then prev0+d else t+d-1
    cur0 = min cur0' prev1
    (ans_rest, cur_rest) = solve_cur_row t d (prev1:prev_row)
    ans = if t <= prev0 then ans_rest else max ans_rest t-prev0-1
  in
    (ans, cur0:cur_rest)

solve :: [(Int, Int)] -> [Int] -> Int
{- solve x prev_row | trace("x: " ++ show x ++ "prev_row: " ++ show prev_row) False = undefined -}
solve [] prev_row = 86400 - minimum prev_row

solve (x:xs) prev_row =
  let
    (ans', cur_row) = solve_cur_row (fst x) (snd x) prev_row
  in
    max ans' (solve xs cur_row)

start n k list =
  print (solve list (take (k+1) [0,0..]))

main =
  do all <- BS.getContents
     let ((n, k), r1) = readPair all -- read the first two integers
     let list = readMany readPair r1 n
     start n k list
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readPair s = ((a, b), r2)
                where
                    Just (a, r1) = readInt s
                    Just (b, r2) = readInt r1
        readMany _ _  0 = []
        readMany readf s n = let
            (x, r) = readf s
          in
            x : readMany readf r (n-1)


You are given a non-empty string $$$s=s_1s_2\dots s_n$$$, which consists only of lowercase Latin letters. Polycarp does not like a string if it contains at least one string "one" or at least one string "two" (or both at the same time) as a substring. In other words, Polycarp does not like the string $$$s$$$ if there is an integer $$$j$$$ ($$$1 \le j \le n-2$$$), that $$$s_{j}s_{j+1}s_{j+2}=$$$"one" or $$$s_{j}s_{j+1}s_{j+2}=$$$"two".For example:  Polycarp does not like strings "oneee", "ontwow", "twone" and "oneonetwo" (they all have at least one substring "one" or "two"),  Polycarp likes strings "oonnee", "twwwo" and "twnoe" (they have no substrings "one" and "two"). Polycarp wants to select a certain set of indices (positions) and remove all letters on these positions. All removals are made at the same time.For example, if the string looks like $$$s=$$$"onetwone", then if Polycarp selects two indices $$$3$$$ and $$$6$$$, then "onetwone" will be selected and the result is "ontwne".What is the minimum number of indices (positions) that Polycarp needs to select to make the string liked? What should these positions be?

The first line of the input contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the input. Next, the test cases are given. Each test case consists of one non-empty string $$$s$$$. Its length does not exceed $$$1.5\cdot10^5$$$. The string $$$s$$$ consists only of lowercase Latin letters. It is guaranteed that the sum of lengths of all lines for all input data in the test does not exceed $$$1.5\cdot10^6$$$.

Print an answer for each test case in the input in order of their appearance. The first line of each answer should contain $$$r$$$ ($$$0 \le r \le |s|$$$) — the required minimum number of positions to be removed, where $$$|s|$$$ is the length of the given line. The second line of each answer should contain $$$r$$$ different integers — the indices themselves for removal in any order. Indices are numbered from left to right from $$$1$$$ to the length of the string. If $$$r=0$$$, then the second line can be skipped (or you can print empty). If there are several answers, print any of them.

10
onetwonetwooneooonetwooo
two
one
twooooo
ttttwo
ttwwoo
ooone
onnne
oneeeee
oneeeeeeetwooooo

NoteIn the first example, answers are:  "onetwone",  "testme" — Polycarp likes it, there is nothing to remove,  "oneoneone",  "twotwo". In the second example, answers are:   "onetwonetwooneooonetwooo",  "two",  "one",  "twooooo",  "ttttwo",  "ttwwoo" — Polycarp likes it, there is nothing to remove,  "ooone",  "onnne" — Polycarp likes it, there is nothing to remove,  "oneeeee",  "oneeeeeeetwooooo".

import Data.List
import Data.Maybe

main = interact $ unlines . map (\s -> (\lst -> (show $ length lst) ++ "\n" ++ unwords lst) $ map show $ solve 1 s $ length s) . tail . lines

solve :: Int -> String -> Int -> [Int]
solve pos s l = case s of
              [] -> []
              _ -> case twonePattern s of
                (rest, True, dl) -> next rest dl 'o'
                (_, False, _) -> case onePattern s of
                  (rest, True, dl) -> next rest dl 'n'
                  (_, False, _) -> case twoPattern s of
                    (rest, True, dl) -> next rest dl 'w'
                    (_, False, _) -> case s of
                      c:rest -> solve (pos + len) dropped_rest (l - len) where
                        dropped_rest = dropWhile (==c) rest
                        len = dropWhileLen (==c) rest + 1
                      _ -> []
              where
                next rest dl c = cur_pos : (solve (pos + dl) rest (l - dl)) where
                  cur_pos = pos + (fromJust $ elemIndex c s)

dropWhileLen cond s = case s of
                        c:rest -> if cond c then 1 + dropWhileLen cond rest else 0
                        _ -> 0

onePattern s = (isDropOnce ('e') . isDropOnce ('n') . isDropWhile ('o')) (s, True, 0)

twoPattern s = (isDropOnce ('o') . isDropOnce ('w') . isDropWhile ('t')) (s, True, 0)

twonePattern s = (isDropOnce ('e') . isDropOnce ('n') . isDropOnce ('o') . isDropOnce ('w') . isDropWhile ('t')) (s, True, 0)

isDropOnce :: Char -> (String, Bool, Int) -> (String, Bool, Int)
isDropOnce c (s, isPreDrop, l) = if not isPreDrop || s == []
                                        then (s, False, l)
                                        else if (==c) $ head s then (tail s, True, l+1)
                                        else (s, False, l)

isDropWhile :: Char -> (String, Bool, Int) -> (String, Bool, Int)
isDropWhile c (s, isPreDrop, l) = if not isPreDrop || s == []
                                        then (s, False, l)
                                        else if (==c) $ head s then (dropWhile (==c) s, True, l + dropWhileLen (==c) s)
                                        else (s, False, l)

import Data.List
import Data.Maybe

main = interact $ unlines . map ((\lst -> (show $ length lst) ++ "\n" ++ intercalate " " lst) . map show . solve 1) . tail . lines

solve :: Int -> String -> [Int]
solve pos s = case s of
              [] -> []
              _ -> case twonePattern s of
                (rest, True) -> next rest 'o'
                (_, False) -> case onePattern s of
                  (rest, True) -> next rest 'n'
                  (_, False) -> case twoPattern s of
                    (rest, True) -> next rest 'w'
                    (_, False) -> case s of
                      c:rest -> solve pos $ dropWhile (==c) rest
                      _ -> []
              where next rest c = pos + (fromJust $ elemIndex c s) : solve (length s - length rest + pos) rest

onePattern s = (isDropOnce ('e') . isDropOnce ('n') . isDropWhile ('o')) (s, True)

twoPattern s = (isDropOnce ('o') . isDropOnce ('w') . isDropWhile ('t')) (s, True)

twonePattern s = (isDropOnce ('e') . isDropWhile ('n') . isDropOnce ('o') . isDropWhile ('w') . isDropWhile ('t')) (s, True)

isDropOnce :: Char -> (String, Bool) -> (String, Bool)
isDropOnce c (s, isPreDrop) = if not isPreDrop || s == []
                                        then (s, False)
                                        else if (==c) $ head s then (tail s, True)
                                        else (s, False)

isDropWhile :: Char -> (String, Bool) -> (String, Bool)
isDropWhile c (s, isPreDrop) = if not isPreDrop || s == []
                                        then (s, False)
                                        else if (==c) $ head s then (dropWhile (==c) s, True)
                                        else (s, False)

import Data.List
import Data.Maybe

main = interact $ unlines . map ((\lst -> (show $ length lst) ++ "\n" ++ intercalate " " lst) . map show . solve 1) . tail . lines

solve :: Int -> String -> [Int]
solve pos s = case s of
              [] -> []
              _ -> case twonePattern s of
                (rest, True) -> next rest 'o'
                (_, False) -> case onePattern s of
                  (rest, True) -> next rest 'n'
                  (_, False) -> case twoPattern s of
                    (rest, True) -> next rest 'w'
                    (_, False) -> case s of
                      c:rest -> solve (length s - length dropped_rest + pos) dropped_rest where dropped_rest = dropWhile (==c) rest
                      _ -> []
              where next rest c = pos + (fromJust $ elemIndex c s) : solve (length s - length rest + pos) rest

onePattern s = (isDropOnce ('e') . isDropOnce ('n') . isDropWhile ('o')) (s, True)

twoPattern s = (isDropOnce ('o') . isDropOnce ('w') . isDropWhile ('t')) (s, True)

twonePattern s = (isDropOnce ('e') . isDropWhile ('n') . isDropOnce ('o') . isDropWhile ('w') . isDropWhile ('t')) (s, True)

isDropOnce :: Char -> (String, Bool) -> (String, Bool)
isDropOnce c (s, isPreDrop) = if not isPreDrop || s == []
                                        then (s, False)
                                        else if (==c) $ head s then (tail s, True)
                                        else (s, False)

isDropWhile :: Char -> (String, Bool) -> (String, Bool)
isDropWhile c (s, isPreDrop) = if not isPreDrop || s == []
                                        then (s, False)
                                        else if (==c) $ head s then (dropWhile (==c) s, True)
                                        else (s, False)


Let's imagine: there is a chess piece billiard ball. Its movements resemble the ones of a bishop chess piece. The only difference is that when a billiard ball hits the board's border, it can reflect from it and continue moving.More formally, first one of four diagonal directions is chosen and the billiard ball moves in that direction. When it reaches the square located on the board's edge, the billiard ball reflects from it; it changes the direction of its movement by 90 degrees and continues moving. Specifically, having reached a corner square, the billiard ball is reflected twice and starts to move the opposite way. While it moves, the billiard ball can make an infinite number of reflections. At any square of its trajectory the billiard ball can stop and on that the move is considered completed.  It is considered that one billiard ball a beats another billiard ball b if a can reach a point where b is located.You are suggested to find the maximal number of billiard balls, that pairwise do not beat each other and that can be positioned on a chessboard n × m in size.

The first line contains two integers n and m (2 ≤ n, m ≤ 106).

Print a single number, the maximum possible number of billiard balls that do not pairwise beat each other. Please do not use the %lld specificator to read or write 64-bit numbers in C++. It is preferred to use cin (also you may use the %I64d specificator).

gao [a, b]
	| a > b		= gao [b, a]
	| a == 1	= a
	| a == b	= a
	| otherwise	= gao [a, b - (b - 2) `div` (a - 1) * (a - 1)]
main = do getLine >>= print . gao . map read . words

z[a,b]=gcd a b+1
main=interact$show.z.map(pred.read).words

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative

solve :: Int -> Int -> Int
solve n m = gcd (n - 1) (m - 1) + 1

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

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative

solve :: Int -> Int -> Int
solve n m
    | n == m    = fromIntegral n
    | otherwise = simulate (0, 0) (1, 1) (n + m)
  where
    simulate (x, y) (dx, dy) answer
        | dx /= dx' && dy /= dy' = answer'
        | otherwise              = simulate (x', y') (dx', dy') answer'
      where
        xsteps = if dx < 0 then x else n - 1 - x
        ysteps = if dy < 0 then y else m - 1 - y
        steps = xsteps `min` ysteps
        x' = x + dx * steps
        y' = y + dy * steps
        dx' = if x' + dx >= n || x' + dx < 0 then -dx else dx
        dy' = if y' + dy >= m || y' + dy < 0 then -dy else dy
        answer' = answer `min` (x' + y')

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


Vasiliy finally got to work, where there is a huge amount of tasks waiting for him. Vasiliy is given a matrix consisting of n rows and m columns and q tasks. Each task is to swap two submatrices of the given matrix.For each task Vasiliy knows six integers ai, bi, ci, di, hi, wi, where ai is the index of the row where the top-left corner of the first rectangle is located, bi is the index of its column, ci is the index of the row of the top-left corner of the second rectangle, di is the index of its column, hi is the height of the rectangle and wi is its width.It's guaranteed that two rectangles in one query do not overlap and do not touch, that is, no cell belongs to both rectangles, and no two cells belonging to different rectangles share a side. However, rectangles are allowed to share an angle.Vasiliy wants to know how the matrix will look like after all tasks are performed.

The first line of the input contains three integers n, m and q (2 ≤ n, m ≤ 1000, 1 ≤ q ≤ 10 000) — the number of rows and columns in matrix, and the number of tasks Vasiliy has to perform. Then follow n lines containing m integers vi, j (1 ≤ vi, j ≤ 109) each — initial values of the cells of the matrix. Each of the following q lines contains six integers ai, bi, ci, di, hi, wi (1 ≤ ai, ci, hi ≤ n, 1 ≤ bi, di, wi ≤ m).

Print n lines containing m integers each — the resulting matrix.

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM, liftM2)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STArray, newArray, STUArray)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

-- repeatM :: (a -> m a) -> Int -> a -> m a
-- repeatM f 0 a = a
-- repeatM f n a = do
--   a' <- f a

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [a, b, c, d, h, w] = do
            p <- find (a-1) (b-1)
            q <- find (c-1) (d-1)

            followd (p, q) >>= followr
            followr (p, q) >>= followd
          where
            followd = follow True h
            followr = follow False w

            follow b c (p, q) = f' c p q
              where
                f' 0 p q = return (p, q)
                f' c p q = do
                  let
                    -- f :: Int -> ST s Int
                    f p = if b then readArray ds p else readArray rs p

                  p' <- f p
                  q' <- f q

                  let
                    swap :: STUArray s Int Int -> ST s ()
                    swap a = readArray a p' >>= \t -> readArray a q' >>= writeArray a p' >> writeArray a q' t

                  if b then swap rs else swap ds

                  f' (c-1) p' q'

            find x y = downs x 0 >>= rights y
              where
                rights 0 p = return p
                rights n p = right p >>= rights (n-1)

                downs 0 p = return p
                downs n p = down p >>= downs (n-1)

        downs 0 p = return []
        downs n p = do
          p' <- down p
          (p':) <$> downs (n-1) p'

        rights 0 p = return []
        rights n p = do
          p' <- right p
          (p':) <$> rights (n-1) p'

      mapM_ update qs

      ds <- downs n 0
      mapM (rights m) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM, liftM2)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STUArray, newArray, STUArray)
import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import Data.List (unfoldr)

readInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

{-# INLINEABLE iterateNM' #-}
iterateNM' :: Monad m => Int -> (a -> m a) -> a -> m a
iterateNM' n f a = loop n a
  where
    loop 0 a = return a
    loop n a = f a >>= loop (n-1)

{-# INLINEABLE iterateNM #-}
iterateNM n f a = loop n a
  where
    loop 0 a = return []
    loop n a = f a >>= \a' -> fmap (a':) (loop (n-1) a')

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [x1, y1, x2, y2, h, w] = do
            p <- find x1 y1
            q <- find x2 y2

            (uncurry rights) =<< downs p q
            (uncurry downs) =<< rights p q
          where
            find x y = iterateNM' (y-1) right 0 >>= iterateNM' (x-1) down

            swap :: STUArray s Int Int -> Int -> Int -> ST s ()
            swap a p q = readArray a p >>= \t -> readArray a q >>= writeArray a p >> writeArray a q t

            downs p q = loop h p q
              where
                loop 0 p q = return (p, q)
                loop n p q = do
                  p' <- down p
                  q' <- down q
                  swap rs p' q'
                  loop (n-1) p' q'

            rights p q = loop w p q
              where
                loop 0 p q = return (p, q)
                loop n p q = do
                  p' <- right p
                  q' <- right q
                  swap ds p' q'
                  loop (n-1) p' q'

      forM_ qs update

      ds <- iterateNM n down 0
      mapM (iterateNM m right) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STArray, newArray, STArray)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (unfoldr)
import Data.Char (isSpace)

readInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [a, b, c, d, h, w] = do
            p <- find (a-1) (b-1)
            q <- find (c-1) (d-1)

            followd (p, q) >>= followr
            followr (p, q) >>= followd
          where
            followd = follow True h
            followr = follow False w

            follow b c (p, q) = f' c p q
              where
                f' 0 p q = return (p, q)
                f' c p q = do
                  let f = if b then down else right

                  p' <- f p
                  q' <- f q

                  let
                    swap :: STArray s Int Int -> ST s ()
                    swap a = readArray a p' >>= \t -> readArray a q' >>= writeArray a p' >> writeArray a q' t

                  if b then swap rs else swap ds

                  f' (c-1) p' q'

            find x y = downs x 0 >>= rights y
              where
                rights 0 p = return p
                rights n p = right p >>= rights (n-1)

                downs 0 p = return p
                downs n p = down p >>= downs (n-1)

        downs 0 p = return []
        downs n p = do
          p' <- down p
          (p':) <$> downs (n-1) p'

        rights 0 p = return []
        rights n p = do
          p' <- right p
          (p':) <$> rights (n-1) p'

      mapM_ update qs

      ds <- downs n 0
      mapM (rights m) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM, liftM2)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STUArray, newArray, STUArray)
import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import Data.List (unfoldr)

readInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

{-# INLINEABLE iterateNM' #-}
iterateNM' :: Monad m => Int -> (a -> m a) -> a -> m a
iterateNM' n f a = loop n a
  where
    loop 0 a = return a
    loop n a = f a >>= loop (n-1)

{-# INLINEABLE iterateNM #-}
iterateNM n f a = loop n a
  where
    loop 0 a = return []
    loop n a = f a >>= \a' -> fmap (a':) (loop (n-1) a')

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [x1, y1, x2, y2, h, w] = do
            p <- find x1 y1
            q <- find x2 y2

            downs (p, q) >>= rights
            rights (p, q) >>= downs
          where
            find x y = iterateNM' (y-1) right 0 >>= iterateNM' (x-1) down

            swap :: STUArray s Int Int -> Int -> Int -> ST s ()
            swap a p q = readArray a p >>= \t -> readArray a q >>= writeArray a p >> writeArray a q t

            downs = iterateNM' h f
              where
                f (p, q) = do
                  p' <- down p
                  q' <- down q
                  swap rs p' q'
                  return (p', q')

            rights = iterateNM' w f
              where
                f (p, q) = do
                  p' <- right p
                  q' <- right q
                  swap ds p' q'
                  return (p', q')

      forM_ qs update

      ds <- iterateNM n down 0
      mapM (iterateNM m right) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM, liftM2)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STUArray, newArray, STUArray)
import qualified Data.ByteString.Char8 as B
import Data.List (unfoldr)
import Data.Char (isSpace)

readInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

{-# INLINEABLE iterateNM' #-}
iterateNM' :: Monad m => Int -> (a -> m a) -> a -> m a
iterateNM' n f a = loop n a
  where
    loop 0 a = return a
    loop n a = f a >>= loop (n-1)

{-# INLINEABLE iterateNM #-}
iterateNM n f a = loop n a
  where
    loop 0 a = return []
    loop n a = f a >>= \a' -> fmap (a':) (loop (n-1) a')

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [a, b, c, d, h, w] = do
            p <- find a b
            q <- find c d

            iterateNM' h down' (p, q) >>= iterateNM' w right'
            iterateNM' w right' (p, q) >>= iterateNM' h down'
          where
            find x y = iterateNM' (x-1) right 0 >>= iterateNM' (y-1) down

            swap :: STUArray s Int Int -> Int -> Int -> ST s ()
            swap a p q = readArray a p >>= \t -> readArray a q >>= writeArray a p >> writeArray a q t

            down' (p, q) = do
              p' <- down p
              q' <- down q
              swap ds p' q'
              return (p', q')

            right' (p, q) = do
              p' <- right p
              q' <- right q
              swap rs p' q'
              return (p', q')

      ds <- iterateNM n down 0
      mapM (iterateNM m right) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys


n people came to a party. Then those, who had no friends among people at the party, left. Then those, who had exactly 1 friend among those who stayed, left as well. Then those, who had exactly 2, 3, ..., n - 1 friends among those who stayed by the moment of their leaving, did the same.What is the maximum amount of people that could stay at the party in the end?

The first input line contains one number t — amount of tests (1 ≤ t ≤ 105). Each of the following t lines contains one integer number n (1 ≤ n ≤ 105).

For each test output in a separate line one number — the maximum amount of people that could stay in the end.

main :: IO ()
main = do
  line <- getLine
  calc (read line :: Int)

calc :: Int -> IO ()
calc 0 = return ()
calc (n+1) = do
  x <- getLine
  putStr ((show (max 0 ((read x :: Int) - 2))) ++ "\n")
  calc n
calc _ = return ()

{-# OPTIONS_GHC -fglasgow-exts -O2 -optc-O3 #-}

import qualified Data.ByteString.Lazy.Char8 as BS (getContents, split, readInt, lines, ByteString)
import Control.Applicative

check :: Int -> Int
check 1 = 0
check n = n - 2

main = do
    (t:ns) <- BS.lines `fmap` BS.getContents
    mapM_ print $ map (check . readInt) $ ns

readInt :: BS.ByteString -> Int
readInt x =
    case BS.readInt x of
          Just (i, _) -> i
          Nothing     -> error "Unparsable Integer"

import Control.Monad
main = do
  tcn <- readLn
  replicateM_ tcn $ do
    n <- readLn
    print $ max 0 (n-2)

import Control.Monad
main = readLn >>= \t -> replicateM_ t $ readLn >>= \n -> print $ max 0 (n-2)

import Control.Monad
main = do
  tcn <- readLn
  replicateM_ tcn $ do
    n <- readLn
    print $ n`div`2


Piegirl was asked to implement two table join operation for distributed database system, minimizing the network traffic.Suppose she wants to join two tables, A and B. Each of them has certain number of rows which are distributed on different number of partitions. Table A is distributed on the first cluster consisting of m partitions. Partition with index i has ai rows from A. Similarly, second cluster containing table B has n partitions, i-th one having bi rows from B. In one network operation she can copy one row from any partition to any other partition. At the end, for each row from A and each row from B there should be a partition that has both rows. Determine the minimal number of network operations to achieve this.

First line contains two integer numbers, m and n (1 ≤ m, n ≤ 105). Second line contains description of the first cluster with m space separated integers, ai (1 ≤ ai ≤ 109). Similarly, third line describes second cluster with n space separated integers, bi (1 ≤ bi ≤ 109).

Print one integer — minimal number of copy operations.

NoteIn the first example it makes sense to move all the rows to the second partition of the second cluster which is achieved in 2 + 6 + 3 = 11 operationsIn the second example Piegirl can copy each row from B to the both partitions of the first cluster which needs 2·3 = 6 copy operations.

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

parseInput :: IO ([Integer], [Integer])
parseInput = do
    _ <- getInts
    a <- getInts
    b <- getInts
    return (f a, f b)
    where
        readInt :: C.ByteString -> Int
        readInt = fst . fromJust . C.readInt

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

        f :: [Int] -> [Integer]
        f = map toInteger . sort

solve :: ([Integer], [Integer]) -> Integer
solve (as, bs) = min ab ba
    where
        ab = solve' as bs
        ba = solve' bs as

        solve' :: [Integer] -> [Integer] -> Integer
        solve' as bs = minimum $ map fst $ scanl f (10 ^ 20, 0) $ zip [0 ..] as
            where
                n = length as
                m = length bs
                sb = sum bs

                f :: (Integer, Integer) -> (Int, Integer) -> (Integer, Integer)
                f (_, sum) (i, a) = (sb * (toInteger (n - i)) + sum, sum + a)

main = putStrLn . show =<< solve <$> parseInput