Given $$$n$$$, find any array $$$a_1, a_2, \ldots, a_n$$$ of integers such that all of the following conditions hold: $$$1 \le a_i \le 10^9$$$ for every $$$i$$$ from $$$1$$$ to $$$n$$$.$$$a_1 < a_2 < \ldots <a_n$$$For every $$$i$$$ from $$$2$$$ to $$$n$$$, $$$a_i$$$ isn't divisible by $$$a_{i-1}$$$It can be shown that such an array always exists under the constraints of the problem.

The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The only line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 1000$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^4$$$.

For each test case print $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ — the array you found. If there are multiple arrays satisfying all the conditions, print any of them.

NoteIn the first test case, array $$$[1]$$$ satisfies all the conditions.In the second test case, array $$$[2, 3]$$$ satisfies all the conditions, as $$$2<3$$$ and $$$3$$$ is not divisible by $$$2$$$.In the third test case, array $$$[111, 1111, 11111, 111111, 1111111, 11111111, 111111111]$$$ satisfies all the conditions, as it's increasing and $$$a_i$$$ isn't divisible by $$$a_{i-1}$$$ for any $$$i$$$ from $$$2$$$ to $$$7$$$.

import Control.Arrow ((>>>))
import Control.Monad (forM_, replicateM_, when)
import Data.Array (assocs, listArray, (!))
import Data.Array.ST (runSTArray, newArray, readArray, writeArray)
import Data.Array.Unsafe (unsafeFreeze)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import System.IO
  ( BufferMode (BlockBuffering),
    hSetBuffering,
    stdout,
  )
import System.IO.Unsafe (unsafePerformIO)
import Text.Printf (printf)

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

erat stop =
  runSTArray $
    newArray (2, stop) True
      >>= \sieve ->
        mapM_
          ( \idx ->
              readArray sieve idx
                >>= \isPrime ->
                  when isPrime $
                    mapM_
                      (\k -> writeArray sieve k False)
                      [idx * 2, idx * 3 .. stop]
          )
          [2 .. stop]
          >> return sieve

primes max = [n | (n, isPrime) <- assocs (erat max), isPrime]

modU = 1000000007

maxPrime = 8000
allPrimes = listArray (0::Int, length genPrimes - 1) genPrimes
  where
    genPrimes = primes maxPrime

solve n = C.pack . unwords $ fmap (show . (allPrimes!)) [0..(n-1)]

main = C.interact $ C.lines >>> drop 1 >>> map (solve . parseInt) >>> C.unlines

import Control.Monad ( when, forM_, replicateM_ )
import Data.Array.IO
    ( IOArray, readArray, writeArray, MArray(newArray) )
import Data.Array (assocs, listArray, (!))
import Data.Array.Unsafe (unsafeFreeze)
import System.IO
    ( hSetBuffering,
      stdout,
      BufferMode(BlockBuffering) )
import Text.Printf (printf)
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import Control.Arrow ((>>>))

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

erat stop = do
  sieve <- newArray (2, stop) True::IO (IOArray Int Bool)
  forM_ [2..stop] $ \idx ->
    do
      isPrime <- readArray sieve idx
      when isPrime $
           forM_ [idx*2, idx*3 .. stop] $ \k ->
             writeArray sieve k False
  pure sieve

primes max = [n | (n, isPrime) <- assocs . unsafePerformIO $ erat max >>= unsafeFreeze, isPrime]

modU = 1000000007

maxPrime = 8000
allPrimes = listArray (0::Int, length genPrimes - 1) genPrimes
  where
    genPrimes = primes maxPrime

solve n = C.pack . unwords $ fmap (show . (allPrimes!)) [0..(n-1)]

main = C.interact $ C.lines >>> drop 1 >>> map (solve . parseInt) >>> C.unlines

import Control.Monad ( when, forM_, replicateM_ )
import Data.Array.IO
    ( IOArray, readArray, writeArray, MArray(newArray) )
import Data.Array (assocs, listArray, (!))
import Data.Array.Unsafe (unsafeFreeze)
import System.IO
    ( hSetBuffering,
      stdout,
      BufferMode(BlockBuffering) )
import Text.Printf (printf)
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

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

erat stop = do
  sieve <- newArray (2, stop) True::IO (IOArray Int Bool)
  forM_ [2..stop] $ \idx ->
    do
      isPrime <- readArray sieve idx
      when isPrime $
           forM_ [idx*2, idx*3 .. stop] $ \k ->
             writeArray sieve k False
  pure sieve

primes max = [n | (n, isPrime) <- assocs . unsafePerformIO $ erat max >>= unsafeFreeze, isPrime]

modU = 1000000007

maxPrime = 8000
allPrimes = listArray (0::Int, length genPrimes - 1) genPrimes
  where
    genPrimes = primes maxPrime

readInt::String -> Int
readInt = read

solve = do
  [n] <- getInts
  forM_ [0..(n - 1)] $ \idx ->
    printf "%d " $ allPrimes!idx
  printf "\n"

main = do
  hSetBuffering stdout $ BlockBuffering(Just 50)
  [t] <- getInts
  replicateM_ t solve

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.Array.IO
import Data.Array (assocs, listArray, (!))
import Data.Array.Unsafe (unsafeFreeze)
import GHC.IO (unsafePerformIO)
import Text.Printf (printf)
import System.IO (hSetBuffering, stdout, BufferMode (BlockBuffering))

erat stop = do
  sieve <- newArray (2, stop) True::IO (IOArray Int Bool)
  forM_ [2..stop] $ \idx ->
    do
      isPrime <- readArray sieve idx
      when isPrime $
           forM_ [idx*2, idx*3 .. stop] $ \k ->
             writeArray sieve k False
  pure sieve

primes max = [n | (n, isPrime) <- assocs . unsafePerformIO $ erat max >>= unsafeFreeze, isPrime]

modU = 1000000007

maxPrime = 8000
allPrimes = listArray (0::Int, (length genPrimes) - 1) $ genPrimes
  where
    genPrimes = primes maxPrime

readInt::String -> Int
readInt = read

solve = do
  n <- fmap readInt getLine
  forM_ [0..(n - 1)] $ \idx ->
    printf "%d " $ allPrimes!idx
  printf "\n"

main = do
  -- hSetBuffering stdout $ BlockBuffering(Just 0x186A0)
  t <- fmap readInt getLine
  replicateM_ t solve

module Main where
import Control.Monad
import Data.List
main = do
  n <- read <$> getLine
  replicateM_ n $ do
    m <- read <$> getLine
    putStrLn . intercalate " " . fmap show $ [2..m+1]

import Control.Arrow ((>>>))
import Control.Monad (forM_, replicateM_, when)
import Data.Array (assocs, listArray, (!))
import Data.Array.ST (runSTArray, newArray, readArray, writeArray)
import Data.Array.Unsafe (unsafeFreeze)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import System.IO
  ( BufferMode (BlockBuffering),
    hSetBuffering,
    stdout,
  )
import System.IO.Unsafe (unsafePerformIO)
import Text.Printf (printf)

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

erat stop =
  runSTArray $
    newArray (2, stop) True
      >>= \sieve ->
        mapM_
          ( \idx ->
              readArray sieve idx
                >>= \isPrime ->
                  when isPrime $
                    mapM_
                      (\k -> writeArray sieve k False)
                      [idx * 2, idx * 3 .. stop]
          )
          [2 .. stop]
          >> return sieve

primes max = [n | (n, isPrime) <- assocs (erat max), isPrime]

modU = 1000000007

maxPrime = 8000

allPrimes = listArray (0 :: Int, length genPrimes - 1) genPrimes
  where
    genPrimes = primes maxPrime

solve n = C.pack . unwords $ fmap (show . (allPrimes !)) [0 .. (n -1)]

main = C.interact $ C.lines >>> map (solve . parseInt) >>> C.unlines


You are given an array of $$$n$$$ non-negative integers $$$a_1, a_2, \ldots, a_n$$$. You can make the following operation: choose an integer $$$x \geq 2$$$ and replace each number of the array by the remainder when dividing that number by $$$x$$$, that is, for all $$$1 \leq i \leq n$$$ set $$$a_i$$$ to $$$a_i \bmod x$$$.Determine if it is possible to make all the elements of the array equal by applying the operation zero or more times.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \leq a_i \leq 10^9$$$) where $$$a_i$$$ is the $$$i$$$-th element of the array. The sum of $$$n$$$ for all test cases is at most $$$2 \cdot 10^5$$$.

For each test case, print a line with YES if you can make all elements of the list equal by applying the operation. Otherwise, print NO. You may print each letter in any case (for example, "YES", "Yes", "yes", "yEs" will all be recognized as a positive answer).

NoteIn the first test case, one can apply the operation with $$$x = 3$$$ to obtain the array $$$[2, 2, 0, 2]$$$, and then apply the operation with $$$x = 2$$$ to obtain $$$[0, 0, 0, 0]$$$.In the second test case, all numbers are already equal.In the fourth test case, applying the operation with $$$x = 4$$$ results in the array $$$[1, 1, 1, 1]$$$.

{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE LambdaCase #-}

module Main where

import           Control.Applicative            ( liftA2 )
import           Control.Monad.State
import qualified Data.ByteString.Lazy.Char8    as C
import           Data.Function                  ( (&) )
import qualified Data.IntSet                   as S
import           Data.Maybe                     ( fromJust )

type Scanner = State [C.ByteString]

scan :: Scanner a -> C.ByteString -> a
scan input = evalState input . C.lines

line :: Scanner C.ByteString
line = get >>= \case
  []     -> error "eof"
  s : ss -> put ss >> return s

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

main :: IO ()
main = C.interact solve

solve :: C.ByteString -> C.ByteString
solve input =
  input
    & scan parse
    & map (format . answer)
    & C.unlines

parse :: Scanner [[Int]]
parse = do
  _ <- line
  many $ do
    _ <- line
    map (fst . fromJust . C.readInt) . C.words <$> line

format :: Bool -> C.ByteString
format True  = C.pack "YES"
format False = C.pack "NO"

answer :: [Int] -> Bool
answer xs | 1 `elem` xs = S.disjoint vs adj
          | otherwise   = True
  where
    vs  = S.fromList xs
    adj = S.fromList . concat $ [ [v - 1, v + 1] | v <- S.toList vs ]

sorted :: Ord a => [a] -> Bool
sorted xs = and [ x <= x' | x <- xs | x' <- tail xs ]


Mike and some bears are playing a game just for fun. Mike is the judge. All bears except Mike are standing in an n × m grid, there's exactly one bear in each cell. We denote the bear standing in column number j of row number i by (i, j). Mike's hands are on his ears (since he's the judge) and each bear standing in the grid has hands either on his mouth or his eyes.  They play for q rounds. In each round, Mike chooses a bear (i, j) and tells him to change his state i. e. if his hands are on his mouth, then he'll put his hands on his eyes or he'll put his hands on his mouth otherwise. After that, Mike wants to know the score of the bears.Score of the bears is the maximum over all rows of number of consecutive bears with hands on their eyes in that row.Since bears are lazy, Mike asked you for help. For each round, tell him the score of these bears after changing the state of a bear selected in that round.

The first line of input contains three integers n, m and q (1 ≤ n, m ≤ 500 and 1 ≤ q ≤ 5000). The next n lines contain the grid description. There are m integers separated by spaces in each line. Each of these numbers is either 0 (for mouth) or 1 (for eyes). The next q lines contain the information about the rounds. Each of them contains two integers i and j (1 ≤ i ≤ n and 1 ≤ j ≤ m), the row number and the column number of the bear changing his state.

After each round, print the current score of the bears.

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

solve :: [String] -> [Int]
solve (x:xs) =
    let n = head (map read (words x))
        grids = map (map read . words) (take n xs)
        rounds = map (map read . words) (drop n xs)
        scores = map row_score grids
    in solve' grids scores rounds
        where
            solve' :: [[Int]] -> [Int] -> [[Int]] -> [Int]
            solve' _  _ [] = []
            solve' grids scores ([x,y]:xs) =
                let (new_grids, new_scores, val) = (solve_at grids scores x y)
                in val:(solve' new_grids new_scores xs)

            row_score :: [Int] -> Int
            row_score x = row_score' x 0

            row_score' :: [Int] -> Int -> Int
            row_score' [] cnt = cnt
            row_score' (x:xs) cnt | x == 1 = row_score' xs (cnt+1)
                                  | otherwise = max cnt (row_score' xs 0)

            solve_at :: [[Int]] -> [Int] -> Int -> Int -> ([[Int]], [Int], Int)
            solve_at grids scores x y =
                let new_grids = update_grid grids x y 1
                    new_scores = update_score new_grids scores x 1
                in (new_grids, new_scores, (max_score new_scores))

            update_grid :: [[Int]] -> Int -> Int -> Int -> [[Int]]
            update_grid [] _ _ _ = []
            update_grid (g:gs) x y r | x == r = (update_row g y 1):(update_grid gs x y (r+1))
                                     | otherwise = g:(update_grid gs x y (r+1))

            update_score :: [[Int]] -> [Int] -> Int -> Int -> [Int]
            update_score [] [] _ _ = []
            update_score (g:gs) (s:ss) x r | x == r = (row_score g):(update_score gs ss x (r+1))
                                           | otherwise = s:(update_score gs ss x (r+1))

            max_score :: [Int] -> Int
            max_score [] = 0
            max_score (x:xs) = max x (max_score xs)

            update_row :: [Int] -> Int -> Int -> [Int]
            update_row [] _ _ = []
            update_row (x:xs) y c | y == c = (1-x):(update_row xs y (c+1))
                                  | otherwise = x:(update_row xs y (c+1))

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine :: IO [Int]
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- getInts
  as <- replicateM n $ map read . words <$> getLine :: IO [[Int]]

  a <- newListArray ((1, 1), (n, m)) $ concat as :: IO (IOUArray (Int, Int) Int)
  let
    f x = if null ls then 0 else maximum ls
      where ls = map length . filter (\g -> head g == 1) $ group x

  ms <- newListArray (1, n) $ map f as :: IO (IOUArray Int Int)

  replicateM q (do
    [i, j] <- getInts
    v <- readArray a (i, j)
    writeArray a (i, j) (1-v)

    c <- f <$> mapM (\j -> readArray a (i, j)) [1..m]
    writeArray ms i c

    m <- maximum <$> mapM (readArray ms) [1..n]
    print m
    )

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine :: IO [Int]
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- getInts
  as <- replicateM n $ map read . words <$> getLine :: IO [[Int]]

  a <- newListArray ((1, 1), (n, m)) $ concat as :: IO (IOUArray (Int, Int) Int)
  let
    f x = if null ls then 0 else maximum ls
      where ls = map length . filter (\g -> head g == 1) $ group x

  ms <- newListArray (1, n) $ map f as :: IO (IOUArray Int Int)

  replicateM q (do
    [i, j] <- getInts
    v <- readArray a (i, j)
    writeArray a (i, j) (1-v)

    c <- readArray ms i
    writeArray ms i (c-v+(1-v))

    m <- maximum <$> mapM (readArray ms) [1..n]
    print m
    )

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine :: IO [Int]
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- getInts
  as <- replicateM n $ map read . words <$> getLine :: IO [[Int]]

  a <- newListArray ((1, 1), (n, m)) $ concat as :: IO (IOArray (Int, Int) Int)

  replicateM q (do
    [i, j] <- getInts
    readArray a (i, j) >>= \v -> writeArray a (i, j) (1-v)

    s <- maximum <$> mapM (\i -> sum <$> mapM (\j -> readArray a (i, j)) [1..m]) [1..n]
    print s
    )

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine :: IO [Int]
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- getInts
  as <- replicateM n $ map read . words <$> getLine :: IO [[Int]]

  a <- newListArray ((1, 1), (n, m)) $ concat as :: IO (IOArray (Int, Int) Int)

  replicateM q (do
    [i, j] <- getInts
    readArray a (i, j) >>= \v -> writeArray a (i, j) (1-v)

    s <- maximum <$> mapM (\i -> maximum . map length . group <$> mapM (\j -> readArray a (i, j)) [1..m]) [1..n]
    print s
    )


There are $$$n$$$ students standing in a circle in some order. The index of the $$$i$$$-th student is $$$p_i$$$. It is guaranteed that all indices of students are distinct integers from $$$1$$$ to $$$n$$$ (i. e. they form a permutation).Students want to start a round dance. A clockwise round dance can be started if the student $$$2$$$ comes right after the student $$$1$$$ in clockwise order (there are no students between them), the student $$$3$$$ comes right after the student $$$2$$$ in clockwise order, and so on, and the student $$$n$$$ comes right after the student $$$n - 1$$$ in clockwise order. A counterclockwise round dance is almost the same thing — the only difference is that the student $$$i$$$ should be right after the student $$$i - 1$$$ in counterclockwise order (this condition should be met for every $$$i$$$ from $$$2$$$ to $$$n$$$). For example, if the indices of students listed in clockwise order are $$$[2, 3, 4, 5, 1]$$$, then they can start a clockwise round dance. If the students have indices $$$[3, 2, 1, 4]$$$ in clockwise order, then they can start a counterclockwise round dance.Your task is to determine whether it is possible to start a round dance. Note that the students cannot change their positions before starting the dance; they cannot swap or leave the circle, and no other student can enter the circle. You have to answer $$$q$$$ independent queries.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 200$$$) — the number of queries. Then $$$q$$$ queries follow. The first line of the query contains one integer $$$n$$$ ($$$1 \le n \le 200$$$) — the number of students. The second line of the query contains a permutation of indices $$$p_1, p_2, \dots, p_n$$$ ($$$1 \le p_i \le n$$$), where $$$p_i$$$ is the index of the $$$i$$$-th student (in clockwise order). It is guaranteed that all $$$p_i$$$ are distinct integers from $$$1$$$ to $$$n$$$ (i. e. they form a permutation).

For each query, print the answer on it. If a round dance can be started with the given order of students, print "YES". Otherwise print "NO".

import Control.Monad

main = do
    q <- readInt
    submain q
    return q

readInt = do
    raw_q <- getLine
    let q = read raw_q :: Int
    return q

readlist = do
    inp <- getLine
    let v = words inp
    let ret = map read v
    return ret

submain:: Int -> IO ()
submain q = do
    when (q > 0) $ do
        sz <- readInt
        v <- readlist
        putStrLn $ if (solve v sz) then "YES" else "NO"
        submain $ q - 1
        return ()

solve :: [Int] -> Int -> Bool
solve [] _ = False
solve v sz = cw (+) v sz || cw (-) v sz

cw :: (Int -> Int -> Int) -> [Int] -> Int -> Bool
cw _ [] _        = True
cw _ (x:[]) _    = True
cw f (x:y:xs) sz = nextTerm && (toNext || toFirst)
    where nextTerm = cw f (y:xs) sz
          toNext = y == (f x 1)
          toFirst = y == (f x (1 - sz))

data Point = Point Float Float
myfun p1 p2 = distance p1 p2
distance (Point x1 y1) (Point x2 y2) =
    sqrt $ dx * dx + dy * dy
    where dx = x1 - x2
          dy = y1 - y2

import Control.Monad

readInt :: String -> Int
readInt = read

yesno :: Bool -> String
yesno x = if x
  then "YES"
  else "NO"

printLines :: [String] -> IO ()
printLines x = mapM_ putStrLn x

readLines :: Int -> IO [String]
readLines x = replicateM x $
  do
    _ <- getLine
    getLine

oneGreater x y = y == x + 1

isPerm :: Int -> [Int] -> Bool
isPerm _ [] = True
isPerm _ [x] = True
isPerm len (x:y:xs) = (x `mod` len) + 1 == y && isPerm len (y:xs)

check :: [Int] -> Bool
check list = a || b
  where a = isPerm (length list) list
        b = isPerm (length list) $ reverse list

getList :: String -> [Int]
getList x = map read (words x)

main = do
  q <- getLine
  input <- readLines (readInt q)
  printLines $ map yesno $ map (check . getList) input

import Control.Monad

readInt :: String -> Int
readInt = read

yesno :: Bool -> String
yesno x = if x
  then "YES"
  else "NO"

printLines :: [String] -> IO ()
printLines x = mapM_ putStrLn x

readLines :: Int -> IO [String]
readLines x = replicateM x $
  do
    _ <- getLine
    getLine

oneGreater x y = y == x + 1

wraps len x y = x == len - 1 && y == 1

isPerm :: Int -> [Int] -> Bool
isPerm _ [] = True
isPerm _ [x] = True
isPerm len (x:y:xs) = (oneGreater x y || wraps len x y) && isPerm len xs

check :: [Int] -> Bool
check list = a || b
  where a = isPerm (length list) list
        b = isPerm (length list) $ reverse list

getList :: String -> [Int]
getList x = map read (words x)

main = do
  q <- getLine
  input <- readLines (readInt q)
  printLines $ map yesno $ map (check . getList) input


Let $$$s$$$ be a string of lowercase Latin letters. Its price is the sum of the indices of letters (an integer between 1 and 26) that are included in it. For example, the price of the string abca is $$$1+2+3+1=7$$$.The string $$$w$$$ and the integer $$$p$$$ are given. Remove the minimal number of letters from $$$w$$$ so that its price becomes less than or equal to $$$p$$$ and print the resulting string. Note that the resulting string may be empty. You can delete arbitrary letters, they do not have to go in a row. If the price of a given string $$$w$$$ is less than or equal to $$$p$$$, then nothing needs to be deleted and $$$w$$$ must be output.Note that when you delete a letter from $$$w$$$, the order of the remaining letters is preserved. For example, if you delete the letter e from the string test, you get tst.

The first line of input contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the test. The following are descriptions of $$$t$$$ test cases. Each case consists of two lines. The first of them is the string $$$w$$$, it is non-empty and consists of lowercase Latin letters. Its length does not exceed $$$2\cdot10^5$$$. The second line contains an integer $$$p$$$ ($$$1 \le p \le 5\,200\,000$$$). It is guaranteed that the sum of string lengths $$$w$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

Output exactly $$$t$$$ rows, the $$$i$$$-th of them should contain the answer to the $$$i$$$-th set of input data. Print the longest string that is obtained from $$$w$$$ by deleting letters such that its price is less or equal to $$$p$$$. If there are several answers, then output any of them. Note that the empty string  — is one of the possible answers. In this case, just output an empty string.

5

abca

2

abca

6

codeforces

1

codeforces

10

codeforces

100

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

{-# LANGUAGE Safe                #-}
{-# LANGUAGE ImportQualifiedPost #-}

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import System.IO                    (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L
import Data.Maybe

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        s   <- getLine
        [w] <- ri
        return (s, w)
    mapM_ (putStrLn.solve) tcs

solve (s,w) = map fst . L.sortOn snd . drop delCnt $ wi
  where
    wi = L.sortBy (flip compare) . (`zip`inds) $ s

    psums = scanl add 0 wi  where  add n (c,_) = n + (1 + (ord c - ord 'a'))

    cost = last psums
    delCost = cost - w

    delCnt = fromJust . L.findIndex (>=delCost) $ psums

inds = [1..] :: [Int]

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.State
import qualified Data.ByteString.Char8 as C
import Data.Maybe

--

import Data.Char
import Data.List
import qualified Data.Map.Strict as M

solve :: (C.ByteString, Int) -> C.ByteString
solve (s, p) = C.pack $ map (\x -> chr $ x + ord 'a' - 1) res
 where
  s' = map (\c -> 1 + ord c - ord 'a') $ C.unpack s
  ogLocs = M.fromListWith (++) [(x, [i]) | (x, i) <- zip s' [0 ..]]

  rm [] = Nothing
  rm [_] = Nothing
  rm (x : xs) = Just xs

  work ls c
    | c <= p = ls
    | otherwise = case M.lookupMax ls of
      Just (x, _) -> work (M.update rm x ls) (c - x)
      Nothing -> ls
  finalLocs = work ogLocs (sum s')

  res = map fst $ sortOn snd [(x, i) | (x, is) <- M.toList finalLocs, i <- is]

input :: Scanner (C.ByteString, Int)
input = (,) <$> bstr <*> int

output :: C.ByteString -> C.ByteString
output = id

main :: IO ()
main = C.interact $ C.unlines . map (output . solve) . runScanner (numberOf input)

-- 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 sp sc = evalState sc . sp

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

read' :: (C.ByteString -> Maybe (a, C.ByteString)) -> Scanner a
read' q = fst . fromJust . q <$> bstr

int :: Scanner Int
int = read' C.readInt

integer :: Scanner Integer
integer = read' C.readInteger

(><) :: Int -> Scanner a -> Scanner [a]
(><) = replicateM

numberOf :: Scanner a -> Scanner [a]
numberOf = (int >>=) . flip (><)

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x

-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: String -> Int -> String
solve s p = solve'
    where
        maxA :: Int
        maxA = ord 'z' - ord 'a' + 1

        priceC :: Char -> Int
        priceC c = ord c - ord 'a' + 1

        sortedC :: [Char]
        sortedC = reverse $ sort s

        sPrice :: Int
        sPrice = sum . map priceC $ s

        finalStringChars :: [Char]
        finalStringChars = finalStringChars' (sPrice - p) sortedC

        finalStringChars' :: Int -> [Char] -> [Char]
        finalStringChars' price cs | price <= 0 = cs
        finalStringChars' price (c:otherCs) = finalStringChars' (price - priceC c) otherCs

        solve' :: String
        solve' = ST.runST $ do
            cntA <- MA.newArray (1, maxA) 0 :: ST.ST s (STA.STUArray s Int Int)
            forM_ finalStringChars $ \c -> do
                modifyArray cntA (priceC c) succ

            flip S.execStateT ([] :: String) $ do
                forM_ (reverse s) $ \c -> do
                    cnt <- T.lift $ MA.readArray cntA (priceC c)
                    M.when (cnt > 0) $ do
                        T.lift $ modifyArray cntA (priceC c) pred
                        S.modify (c:)
                        return ()

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        s <- B8.getLine <&> B8.unpack . head . B8.words
        p <- B8.getLine <&> readIntB8
        let answer = solve s p
        B8.putStrLn $ B8.pack answer


Nauuo is a girl who loves playing cards.One day she was playing cards but found that the cards were mixed with some empty ones.There are $$$n$$$ cards numbered from $$$1$$$ to $$$n$$$, and they were mixed with another $$$n$$$ empty cards. She piled up the $$$2n$$$ cards and drew $$$n$$$ of them. The $$$n$$$ cards in Nauuo's hands are given. The remaining $$$n$$$ cards in the pile are also given in the order from top to bottom.In one operation she can choose a card in her hands and play it — put it at the bottom of the pile, then draw the top card from the pile.Nauuo wants to make the $$$n$$$ numbered cards piled up in increasing order (the $$$i$$$-th card in the pile from top to bottom is the card $$$i$$$) as quickly as possible. Can you tell her the minimum number of operations?

The first line contains a single integer $$$n$$$ ($$$1\le n\le 2\cdot 10^5$$$) — the number of numbered cards. The second line contains $$$n$$$ integers $$$a_1,a_2,\ldots,a_n$$$ ($$$0\le a_i\le n$$$) — the initial cards in Nauuo's hands. $$$0$$$ represents an empty card. The third line contains $$$n$$$ integers $$$b_1,b_2,\ldots,b_n$$$ ($$$0\le b_i\le n$$$) — the initial cards in the pile, given in order from top to bottom. $$$0$$$ represents an empty card. It is guaranteed that each number from $$$1$$$ to $$$n$$$ appears exactly once, either in $$$a_{1..n}$$$ or $$$b_{1..n}$$$.

The output contains a single integer — the minimum number of operations to make the $$$n$$$ numbered cards piled up in increasing order.

NoteExample 1We can play the card $$$2$$$ and draw the card $$$3$$$ in the first operation. After that, we have $$$[0,3,0]$$$ in hands and the cards in the pile are $$$[0,1,2]$$$ from top to bottom.Then, we play the card $$$3$$$ in the second operation. The cards in the pile are $$$[1,2,3]$$$, in which the cards are piled up in increasing order.Example 2Play an empty card and draw the card $$$1$$$, then play $$$1$$$, $$$2$$$, $$$3$$$ in order.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}
#ifndef DEBUG
{-# LANGUAGE Safe              #-}
#endif

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as C
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import qualified Data.List                  as L
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word
#ifdef DEBUG
import           Debug.Trace
#endif
import Foreign

main :: IO ()
main = do
  !n <- readLn :: IO Int
  xs <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
  ys <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
  print $ solve n xs ys

solve :: Int -> [Int] -> [Int] -> Int
solve n xs ys
  | Just res <- solveNon1 n xs ys = res
  | otherwise = n + lowerBound 0 n simulate
  where
    xs' = filter (/= 0) xs
    simulate i = go 1 (IS.fromList $ xs' ++ filter (/= 0) ys0) ys1
      where
        (ys0, ys1) = splitAt i ys
        go !acc !set (z:zs)
          | acc > n = True
          | IS.member acc set = go (acc+1) (IS.insert z set) zs
          | otherwise = False
        go _ _ [] = True

solveNon1 :: Int -> [Int] -> [Int] -> Maybe Int
solveNon1 n xs _ | elem 1 xs = Nothing
solveNon1 n xs ys
  | ys1 == [1..n-k], and (zipWith p ys0 [n-k+1..]) = Just k
  | otherwise = Nothing
 where
  (ys0, ys1) = span (/=1) ys
  !k = length ys0
  p 0 y = True
  p x y = x > y

lowerBound :: (Integral i) => i -> i -> (i -> Bool) -> i
lowerBound low high p = go low high
  where
    go !low !high
        | high <= low = high
        | p mid       = go low       mid
        | otherwise   = go (mid + 1) high
      where
        h = toInteger high
        l = toInteger low
        mid = fromIntegral $ l + div (h - l) 2
{-# INLINE lowerBound #-}


Polycarpus has a hobby — he develops an unusual social network. His work is almost completed, and there is only one more module to implement — the module which determines friends. Oh yes, in this social network one won't have to add friends manually! Pairs of friends are deduced in the following way. Let's assume that user A sent user B a message at time t1, and user B sent user A a message at time t2. If 0 < t2 - t1 ≤ d, then user B's message was an answer to user A's one. Users A and B are considered to be friends if A answered at least one B's message or B answered at least one A's message.You are given the log of messages in chronological order and a number d. Find all pairs of users who will be considered to be friends.

The first line of the input contains two integers n and d (1 ≤ n, d ≤ 1000). The next n lines contain the messages log. The i-th line contains one line of the log formatted as "Ai Bi ti" (without the quotes), which means that user Ai sent a message to user Bi at time ti (1 ≤ i ≤ n). Ai and Bi are non-empty strings at most 20 characters long, consisting of lowercase letters ('a' ... 'z'), and ti is an integer (0 ≤ ti ≤ 10000). It is guaranteed that the lines are given in non-decreasing order of ti's and that no user sent a message to himself. The elements in the lines are separated by single spaces.

In the first line print integer k — the number of pairs of friends. In the next k lines print pairs of friends as "Ai Bi" (without the quotes). You can print users in pairs and the pairs themselves in any order. Each pair must be printed exactly once.

4 1
vasya petya 1
petya vasya 2
anya ivan 2
ivan anya 4

NoteIn the first sample test case Vasya and Petya are friends because their messages' sending times are one second apart. Anya and Ivan are not, because their messages' sending times differ by more than one second.

import Data.Map (Map, empty, keys, fromListWith, member, (!))

{-
--------------------------------------------------------------------------------

import HUnit

testNoMessage :: Test
testNoMessage  =  Test "TestNoMessage" $
    assertEq [] (solve 0 [])

testInput :: Test
testInput  =  TestList "TestInput"
    [Test "1" $ assertEq [("petya", "vasya")] (solve 1
        [("vasya", "petya", 1),
         ("petya", "vasya", 2),
         ("anya", "ivan", 2),
         ("ivan", "anya", 4)
        ]),
     Test "2" $ assertEq [] (solve 1000 [("a", "b", 0)])]

testOnePairs :: Test
testOnePairs  =  Test "TestOnePairs" $
    assertEq [("petya", "vasya")]
        (solve 1000 [
            ("petya", "vasya", 1),
            ("vasya", "petya", 2)
        ])

testTwoPairs :: Test
testTwoPairs  =  Test "TestTwoPairs" $
    assertEq [("anya", "ivan"), ("petya", "vasya")] (solve 1000
        [("vasya", "petya", 1),
         ("petya", "vasya", 2),
         ("anya", "ivan", 2),
         ("ivan", "anya", 4)
        ])

testOneMessage :: Test
testOneMessage  =  TestList "TestOneMessage"
    [Test "1" $
        assertEq [] (solve 1000 [("vasya", "petya", 1)]),
     Test "2" $
        assertEq [] (solve 1000 [("petya", "vasya", 1)])
    ]

testNotMessageFromIvanToVasya :: Test
testNotMessageFromIvanToVasya  =  Test "TestNotMessageFromIvanToVasya" $
    assertEq [] (solve 1000
        [("ivan", "petya", 1),
         ("anya", "vasya", 2),
         ("vasya", "ivan", 3)])

testSynchronousMessages :: Test
testSynchronousMessages  =  Test "TestSynchronousMessages" $
    assertEq [] (solve 1000 [("petya", "vasya", 1), ("vasya", "petya", 1)])

testOneFriendButManyMessages :: Test
testOneFriendButManyMessages  =  Test "TestOneFriendButManyMessages" $
    assertEq [("petya", "vasya")]
        (solve 1 [
            ("petya", "vasya", 1),
            ("vasya", "petya", 2),
            ("petya", "vasya", 5),
            ("vasya", "petya", 6),
            ("petya", "vasya", 8),
            ("vasya", "petya", 9),
            ("petya", "vasya", 100),
            ("vasya", "petya", 101)
        ])

testAllFriends :: Test
testAllFriends  =  Test "TestAllFriends" $
    assertEq [("a","b"),("a","c"),("a","d"),("b","c"),("b","d"),("c","d")]
      (solve 3 [
          ("a","b",0),("a","c",0),("a","d",0),
          ("b","a",1),("b","c",1),("b","d",1),
          ("c","a",2),("c","b",2),("c","d",2),
          ("d","a",3),("d","b",3),("d","c",3)
      ])

testBig :: Test
testBig  =  Test "TestBig" $
    assertEq [] (solve 1000000
        (map (\n -> (longNameA n, longNameB n, n)) [1..1000]))

longNameA :: Int -> String
longNameA n  =  replicate 17 'a'
  ++ [(toEnum (fromEnum 'a' + mod n 26)), (toEnum (fromEnum 'a' + mod (div n 26) 26)),
    (toEnum (fromEnum 'a' + div (div n 26) 26))]

longNameB :: Int -> String
longNameB n  =  replicate 17 'b'
  ++ [(toEnum (fromEnum 'a' + mod n 26)), (toEnum (fromEnum 'a' + mod (div n 26) 26)),
    (toEnum (fromEnum 'a' + div (div n 26) 26))]

testManyMessages :: Test
testManyMessages  =  Test "TestManyMessages" $
    assertEq []
        (solve 1 (take 1000 (zip3 (cycle [a, b]) (cycle [b, a]) [0,2..])))
    where
        a  =  longNameA 0
        b  =  longNameB 0

tests :: Test
tests  =  TestList "Testing ... "
    [testNoMessage,
     testInput,
     testOnePairs,
     testTwoPairs,
     testOneMessage,
     testNotMessageFromIvanToVasya,
     testSynchronousMessages,
     testOneFriendButManyMessages,
     testAllFriends,
     testBig,
     testManyMessages
    ]

test :: IO ()
test  =  run tests

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

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

readMessage :: IO (String, String, Int)
readMessage  =  do
    line <- getLine
    let [s1, s2, s3]  =  words line
    return (s1, s2, read s3)

friend :: Int -> Map (String, String) [Int] -> (String, String) -> Bool
friend d map' (n1, n2)
  | n1 < n2 && member (n2, n1) map'  =  friend' (map' ! (n1, n2)) (map' ! (n2, n1))
  | otherwise  =  False
  where
    friend' ts1 ts2  =  not $ null [(t1, t2) | t1 <- ts1, t2 <- ts2, t1 /= t2, abs (t1 - t2) <= d]

solve :: Int -> [(String, String, Int)] -> [(String, String)]
solve d ms  =  filter (friend d map') (keys map')
  where
    map'  =  fromListWith (++) (map (\(n1, n2, t) -> ((n1, n2), [t])) ms)

printAns :: [(String, String)] -> IO ()
printAns friends  =  do
    print (length friends)
    mapM_ (\(s1, s2) -> putStrLn $ concat [s1, " ", s2]) friends

main :: IO ()
main  =  do
    [n, d] <- Main.reads
    messages <- mapM (const readMessage) [1..n]
    printAns $ solve d messages

import Data.List
import Control.Monad

swap (a, b) = (b, a)

solve d events =
  nubBy (\a b -> a == b || a == swap b)
  [(a1, b1) |
   (a1, b1, t1) <- events,
   (a2, b2, t2) <- events,
   a1 == b2, b1 == a2, t1 < t2,
   t2 - t1 <= d]

getEvent = do [name1, name2, t] <- fmap words getLine
              return (name1, name2, read t)

printFriends (name1, name2) =
  putStrLn (name1 ++ " " ++ name2)

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

          let friends = solve d events

          putStrLn $ show $ length friends
          sequence_ $ map printFriends friends

import System.IO
import List (nub)

readInt :: String -> Int
readInt s = read s

split :: String -> Char -> [String]
split [] _ = []
split (x:xs) c = y : ys
                 where (y, xs') = break (== c) (x:xs)
                       ys | xs' == [] = []
                          | otherwise = split (tail xs') c

fst3 (x, _, _) = x
snd3 (_, y, _) = y
thd3 (_, _, z) = z

format :: [String] -> [(String, String, Int)]
format xs = map f xs
                where f x = (y !! 0, y !! 1, readInt (y !! 2))
                        where y = split x ' '

isFriends :: Int -> (String, String, Int) -> (String, String, Int) -> Bool
isFriends d (a1, b1, t1) (a2, b2, t2) = (a1 == b2) && (b1 == a2) && (t2 - t1 <= d) && (t2 - t1 > 0)

getFriends :: Int -> [(String, String, Int)] -> [(String, String)]
getFriends _ [x] = []
getFriends d (x1@(a1, b1, t1):xs) = nub (map f (filter (isFriends d x1) xs) ++ getFriends d xs)
                                            where f (a, b, c) = (min a b, max a b)

list2string :: Show a => [a] -> String
list2string xs = foldr f "" xs
                    where f x y = (show x ++ "\n" ++ y)

output :: [(String, String)] -> String
output xs = show (length xs) ++ "\n" ++ (unlines $ map (\(x, y) -> x ++ " " ++ y) xs)

main :: IO()
main = do
        nd <- getLine
        journal <- getContents
        let d = readInt $ head $ tail $ split nd ' '
            in putStr (output $ getFriends d $ format $ lines journal)

import qualified Data.Set as S
import Control.Monad
main = do
  [n,d] <- liftM (map read . words) getLine
  ms <- replicateM n (liftM parse getLine)
  let fs = S.fromList $ do
             (a,b,t1) <- ms
             (a',b',t2) <- ms
             guard $ a == b' && b == a' && t2 - t1 > 0 && t2 - t1 <= d
             return (minMax a b)
  print (S.size fs)
  forM_ (S.elems fs) $ \(a,b) -> putStrLn $ a ++ " " ++ b
parse l = (a,b,read t) where [a,b,t] = words l
minMax a b = (min a b,max a b)

import Data.List

type Call = (String,String,Int)

main ::IO ()
main =
    do cs <- getContents
       (putStr . showSolve . solve . pIn) cs

showSolve ::[Call] ->String
showSolve [] = "0"
showSolve xs =
    (show .length) xs ++ (showPair xs)

showPair::[Call]->String
showPair [] = ""
showPair ((a,b,_):xs) =
    "\n" ++a ++ " " ++ b ++showPair xs

chg::[String]->(String,String,Int)
chg [s1,s2,s3] = (s1,s2,read s3::Int)

pIn :: String->(Int,[Call])
pIn s =
    (d,fs)
        where
          s1:s2 = lines s
          [_,d] = map read $ words s1
          fs = map (\x -> chg $ words x) s2

chk :: Int->Call->Call->Bool
chk d (a1,b1,t1) (a2,b2,t2)=
    a2==b1 && a1==b2&& 0< t2-t1 && t2-t1 <=d

isNoPair ::Call->Call->Bool
isNoPair (a1,b1,_) (a2,b2,_) = not ((a1==a2 && b1==b2) || (a1==b2 && b1==a2))

solve ::(Int,[Call])->[Call]
solve pin = solveC pin []

solveC ::(Int,[Call])->[Call] -> [Call]
solveC (_,[]) ret = ret
solveC (d,(x:xs)) ret =
     if any (chk d x) xs
     then solveC (d,(filter (isNoPair x) xs)) (x:ret)
     else solveC (d,xs) ret

import List

type People   =  String
type Message  =  ((People, People), Int)

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

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

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

parse :: String -> Message
parse line  =  ((w1, w2), read w3)
  where
    [w1, w2, w3]  =  words line

getPeoples :: [Message] -> [People]
getPeoples ms  =  nub (map (fst . fst) ms)

friend :: Int -> [Message] -> (People, People) -> Bool
friend d ms (p1, p2)  =  length friends > 0
  where
     friends  =  do
         m1 <- filter (\m -> fst m == (p1, p2)) ms
         m2 <- filter (\m -> fst m == (p2, p1)) ms
         if abs (snd m1 - snd m2) <= d then [(p1, p2)] else []

allPairs :: [a] -> [(a, a)]
allPairs xs  =  [(xs !! i, xs !! j) | i <- [0..n-1], j <- [0..n-1], i < j]
  where
    n = length xs

solve :: Int -> [Message] -> [(People, People)]
solve d ms  =  filter (friend d ms) (allPairs (getPeoples ms))

printAns :: [(People, People)] -> IO ()
printAns fs  =  print (length fs) >> sequence_ (map printAns' fs)
  where
    printAns' :: (People, People) -> IO ()
    printAns' (p1, p2)  =  putStr p1 >> putStr " " >> putStrLn p2

main = do
    [n, d] <- Main.reads
    lines <- getLines n
    let ms = map parse lines
    printAns (solve d ms)

import System.IO
import List (nub)

readInt :: String -> Int
readInt s = read s

split :: String -> Char -> [String]
split [] _ = []
split (x:xs) c = y : ys
                 where (y, xs') = break (== c) (x:xs)
                       ys | xs' == [] = []
                          | otherwise = split (tail xs') c

fst3 (x, _, _) = x
snd3 (_, y, _) = y
thd3 (_, _, z) = z

format :: [String] -> [(String, String, Int)]
format xs = map f xs
                where f x = (y !! 0, y !! 1, readInt (y !! 2))
                        where y = split x ' '

isFriends :: Int -> (String, String, Int) -> (String, String, Int) -> Bool
isFriends d (a1, b1, t1) (a2, b2, t2) = (a1 == b2) && (b1 == a2) && (t2 - t1 <= d)

getFriends :: Int -> [(String, String, Int)] -> [(String, String)]
getFriends _ [x] = []
getFriends d (x1@(a1, b1, t1):xs) = nub (map f (filter (isFriends d x1) xs) ++ getFriends d xs)
                                            where f (a, b, c) = (min a b, max a b)

list2string :: Show a => [a] -> String
list2string xs = foldr f "" xs
                    where f x y = (show x ++ "\n" ++ y)

output :: [(String, String)] -> String
output xs = show (length xs) ++ "\n" ++ (unlines $ map (\(x, y) -> x ++ " " ++ y) xs)

main :: IO()
main = do
        nd <- getLine
        journal <- getContents
        let d = readInt $ head $ tail $ split nd ' '
            in putStr (output $ getFriends d $ format $ lines journal)

import Data.Maybe
import Data.List
import Control.Monad
import Control.Arrow
import qualified Data.Map as M
import qualified Data.Set as S

main = do
  [n,d] <- liftM (map read . words) getLine
  ms <- replicateM n $ liftM words getLine
  let (_,s) = foldl' (ack d) (M.empty,S.empty) ms
  print (S.size s)
  forM_ (S.elems s) $ \(a,b) -> putStrLn $ a ++ " " ++ b
ack d (m,s) [a,b,t]
    | isJust (M.lookup (b,a) m >>= guard . uncurry (&&) . ((> 0) &&& (<= d)) . ((read t) -))
        = (m,S.insert (minMax a b) s)
    | otherwise
        = (M.insert (a,b) (read t) m,s)
minMax a b = (min a b,max a b)

import Data.Maybe
import Data.List
import Control.Monad
import qualified Data.Map as M
import qualified Data.Set as S

main = do
  [n,d] <- liftM (map read . words) getLine
  ms <- replicateM n $ liftM words getLine
  let (_,s) = foldl' (ack d) (M.empty,S.empty) ms
  print (S.size s)
  forM_ (S.elems s) $ \(a,b) -> putStrLn $ a ++ " " ++ b
ack d (m,s) [a,b,t]
    | isJust (M.lookup (b,a) m >>= guard . (<= d) . ((read t) -))
        = (m,S.insert (minMax a b) s)
    | otherwise
        = (M.insert (a,b) (read t) m,s)
minMax a b = (min a b,max a b)

import Data.Ord
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Monad
import Control.Arrow
main = do
  [n,d] <- liftM (map read . words) getLine
  ms <- replicateM n (liftM parse getLine)
  let (_,fs) = foldl' (process d) (M.empty,S.empty) $ sortBy (comparing thd) ms
  print (S.size fs)
  forM_ (S.elems fs) $ \(a,b) -> putStrLn $ a ++ " " ++ b
parse l = (a,b,read t) where [a,b,t] = words l
process d (l,f) (a,b,t) | isReciprocal = s' `seq` (l',s')
                        | otherwise    = (l',f)
    where isReciprocal = l' `seq`
                         maybe False (uncurry (&&) . ((>0) &&& (<=d)) . (t-))
                               (M.lookup (b,a) l)
          l' = M.insert (a,b) t l
          s' = S.insert (minMax a b) f
minMax = min &&& max >>> uncurry (&&&)
thd (_,_,t) = t

import Data.Maybe
import Data.List
import Control.Monad
import Control.Arrow
import qualified Data.Map as M
import qualified Data.Set as S
main = do
  [n,d] <- liftM (map read . words) getLine
  ms <- replicateM n $ liftM words getLine
  let (_,s) = foldl' (ack d) (M.empty,S.empty) ms
  print (S.size s)
  forM_ (S.elems s) $ \(a,b) -> putStrLn $ a ++ " " ++ b
ack d (m,s) [a,b,t]
    | isJust (M.lookup (b,a) m >>= guard . uncurry (&&) .
                                   ((> 0) &&& (<= d)) . (read t -))
        = (M.insert (a,b) (read t) m,S.insert (minMax a b) s)
    | otherwise
        = (M.insert (a,b) (read t) m,s)
minMax a b = (min a b,max a b)

import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Monad
import Control.Arrow
main = do
  [n,d] <- liftM (map read . words) getLine
  ms <- replicateM n (liftM parse getLine)
  let (_,fs) = foldl' (process d) (M.empty,S.empty) ms
  print (S.size fs)
  forM_ (S.elems fs) $ \(a,b) -> putStrLn $ a ++ " " ++ b
parse l = (a,b,read t) where [a,b,t] = words l
process d (l,f) (a,b,t) | isReciprocal = s' `seq` (l',s')
                        | otherwise    = (l',f)
    where isReciprocal = l' `seq`
                         liftM (uncurry (&&) . ((>0) &&& (<=d)) . (t-))
                               (M.lookup (b,a) l)
                         == Just True
          l' = M.insert (a,b) t l
          s' = S.insert (minMax a b) f
minMax a b = (min a b,max a b)

import Data.List

type Call = (String,String,Int)

main ::IO ()
main =
    do cs <- getContents
       (putStr . showSolve . solve . pIn) cs

showSolve ::[Call] ->String
showSolve [] = "0"
showSolve xs =
    (show .length) xs ++ (showPair xs)

showPair::[Call]->String
showPair [] = ""
showPair ((a,b,_):xs) =
    "\n" ++a ++ " " ++ b ++showPair xs

chg::[String]->(String,String,Int)
chg [s1,s2,s3] = (s1,s2,read s3::Int)

pIn :: String->(Int,[Call])
pIn s =
    (d,fs)
        where
          s1:s2 = lines s
          [_,d] = map read $ words s1
          fs = map (\x -> chg $ words x) s2

chk :: Int->Call->Call->Bool
chk d (a1,b1,t1) (a2,b2,t2)=
    a2==b1 && a1==b2&& 0< t2-t1 && t2-t1 <=d

isPair ::Call->Call->Bool
isPair (a1,b1,_) (a2,b2,_) = (a1==a2 && b1==b2) || (a1==b2 && b1==a2)

solve ::(Int,[Call])->[Call]
solve pin = solveC pin []

solveC ::(Int,[Call])->[Call] -> [Call]
solveC (_,[]) ret = ret
solveC (d,(x:xs)) ret =
     if any (chk d x) xs
     then solveC (d,(filter (isPair x) xs)) (filter (isPair x) (x:ret))
     else solveC (d,xs) ret


Squirrel Liss is interested in sequences. She also has preferences of integers. She thinks n integers a1, a2, ..., an are good.Now she is interested in good sequences. A sequence x1, x2, ..., xk is called good if it satisfies the following three conditions:  The sequence is strictly increasing, i.e. xi < xi + 1 for each i (1 ≤ i ≤ k - 1).  No two adjacent elements are coprime, i.e. gcd(xi, xi + 1) > 1 for each i (1 ≤ i ≤ k - 1) (where gcd(p, q) denotes the greatest common divisor of the integers p and q).  All elements of the sequence are good integers. Find the length of the longest good sequence.

The input consists of two lines. The first line contains a single integer n (1 ≤ n ≤ 105) — the number of good integers. The second line contains a single-space separated list of good integers a1, a2, ..., an in strictly increasing order (1 ≤ ai ≤ 105; ai < ai + 1).

Print a single integer — the length of the longest good sequence.

NoteIn the first example, the following sequences are examples of good sequences: [2; 4; 6; 9], [2; 4; 6], [3; 9], [6]. The length of the longest good sequence is 4.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.List

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

main = B.getContents >>= print . solve . map readInt . tail . B.words

solve [1] = 1
solve (1:xs) = solve xs
solve xs = runST $ do
  cnt <- newArray (0,100000) 0 :: ST s (STUArray s Int Int)
  forM_ xs $ \x -> do
    let ps = map head.group $ primeFactors x
    c <- (1+).maximum <$> mapM (unsafeRead cnt) ps
    forM_ ps $ \p -> do
      unsafeWrite cnt p c
  maximum <$> getElems cnt

smallPrimes :: [Int]
smallPrimes=2:[n|n<-[3,5..317],and.map((0<).rem n)$takeWhile(\x->x*x<=n)smallPrimes]

primeFactors :: Int -> [Int]
primeFactors n = go n smallPrimes
   where
     go !n pps@(p:ps)
       | n < p*p   = [n|n>1]
       | r > 0     = go n ps
       | otherwise = p:go q pps
      where
        (q,r) = quotRem n p
     go n [] = [n]


One very important person has a piece of paper in the form of a rectangle a × b.Also, he has n seals. Each seal leaves an impression on the paper in the form of a rectangle of the size xi × yi. Each impression must be parallel to the sides of the piece of paper (but seal can be rotated by 90 degrees).A very important person wants to choose two different seals and put them two impressions. Each of the selected seals puts exactly one impression. Impressions should not overlap (but they can touch sides), and the total area occupied by them should be the largest possible. What is the largest area that can be occupied by two seals?

The first line contains three integer numbers n, a and b (1 ≤ n, a, b ≤ 100). Each of the next n lines contain two numbers xi, yi (1 ≤ xi, yi ≤ 100).

Print the largest total area that can be occupied by two seals. If you can not select two seals, print 0.

NoteIn the first example you can rotate the second seal by 90 degrees. Then put impression of it right under the impression of the first seal. This will occupy all the piece of paper.In the second example you can't choose the last seal because it doesn't fit. By choosing the first and the third seals you occupy the largest area.In the third example there is no such pair of seals that they both can fit on a piece of paper.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

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

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	[ n, h, w ] <- readInts
	[ xs, ys ] <- transpose <$> replicateM n readInts
	let
		solve2 f = maximum $ ( 0 : ) $ [ f ( xs !! i ) ( ys !! i ) ( xs !! j ) ( ys !! j ) | i <- [ 0 .. n - 1 ], j <- [ 0 .. n - 1 ], i /= j ]
	print $ max ( solve2 $ solve h w ) ( solve2 $ solve w h )

solve h w x1 y1 x2 y2
	| x1 + x2 <= h && max y1 y2 <= w = res
	| x1 + y2 <= h && max y1 x2 <= w = res
	| y1 + y2 <= h && max x1 x2 <= w = res
	| otherwise = 0
	where
		res = ( x1 * y1 ) + ( x2 * y2 )

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List

main = B.getContents >>= print . evalState app . B.words

app = do
  n <- poi
  a <- poi
  b <- poi
  ss <- replicateM n $ liftM2 (,) poi poi
  return $ solve a b ss
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve a b = maximum . (0:) . map (\((x1, y1), (x2, y2)) -> x1 * y1 + x2 * y2) . filter (\((x1, y1), (x2, y2)) -> ok x1 y1 x2 y2 || ok x1 y1 y2 x2 || ok y1 x1 x2 y2 || ok y1 x1 y2 x2) . pairs
  where ok x1 y1 x2 y2 = x1 + x2 <= a && max y1 y2 <= b || y1 + y2 <= b && max x1 x2 <= a
pairs xs = [(a, b) | (a:bs) <- tails xs, b <- bs]

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

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

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	[ n, h, w ] <- readInts
	[ xs, ys ] <- transpose <$> replicateM n readInts
	let
		solve2 f = maximum $ ( 0 : ) $ [ f ( xs !! i ) ( ys !! i ) ( xs !! j ) ( ys !! j ) | i <- [ 0 .. n - 1 ], j <- [ 0 .. n - 1 ], i /= j ]
	print $ max ( solve2 $ solve h w ) ( solve2 $ solve w h )

solve h w x1 y1 x2 y2
	| x1 + x2 <= h && max y1 y2 <= w = res
	| x1 + y2 <= h && max y1 x2 <= w = res
	| otherwise = 0
	where
		res = ( x1 * y1 ) + ( x2 * y2 )

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

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

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	[ n, h, w ] <- readInts
	[ xs, ys ] <- transpose <$> replicateM n readInts
	print $ maximum $ ( 0 : ) $ [ solve h w ( xs !! i ) ( ys !! i ) ( xs !! j ) ( ys !! j ) | i <- [ 0 .. n - 1 ], j <- [ 0 .. i - 1 ] ]

solve h w x1 y1 x2 y2
	| x1 + x2 <= h && max y1 y2 <= w = res
	| x1 + y2 <= h && max y1 x2 <= w = res
	| x1 + x2 <= w && max y1 y2 <= h = res
	| x1 + y2 <= w && max y1 x2 <= h = res
	| x2 + x1 <= h && max y2 y1 <= w = res
	| x2 + y1 <= h && max y2 x1 <= w = res
	| x2 + x1 <= w && max y2 y1 <= h = res
	| x2 + y1 <= w && max y2 x1 <= h = res
	| otherwise = 0
	where
		res = ( x1 * y1 ) + ( x2 * y2 )

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List

main = B.getContents >>= print . evalState app . B.words

app = do
  n <- poi
  a <- poi
  b <- poi
  ss <- replicateM n $ liftM2 (,) poi poi
  return $ solve a b ss
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve a b = maximum . (0:) . map (\((x1, y1), (x2, y2)) -> x1 * y1 + x2 * y2) . filter (\((x1, y1), (x2, y2)) -> x1 + x2 <= a && max y1 y2 <= b || x1 + y2 <= a && max y1 x2 <= b || y1 + y2 <= b && max x1 x2 <= a || y1 + x2 <= b && max x1 y2 <= a) . pairs
pairs xs = [(a, b) | (a:bs) <- tails xs, b <- bs]


Maria is the most active old lady in her house. She was tired of sitting at home. She decided to organize a ceremony against the coronavirus.She has $$$n$$$ friends who are also grannies (Maria is not included in this number). The $$$i$$$-th granny is ready to attend the ceremony, provided that at the time of her appearance in the courtyard there will be at least $$$a_i$$$ other grannies there. Note that grannies can come into the courtyard at the same time. Formally, the granny $$$i$$$ agrees to come if the number of other grannies who came earlier or at the same time with her is greater than or equal to $$$a_i$$$.Grannies gather in the courtyard like that.  Initially, only Maria is in the courtyard (that is, the initial number of grannies in the courtyard is $$$1$$$). All the remaining $$$n$$$ grannies are still sitting at home. On each step Maria selects a subset of grannies, none of whom have yet to enter the courtyard. She promises each of them that at the time of her appearance there will be at least $$$a_i$$$ other grannies (including Maria) in the courtyard. Maria can call several grannies at once. In this case, the selected grannies will go out into the courtyard at the same moment of time. She cannot deceive grannies, that is, the situation when the $$$i$$$-th granny in the moment of appearing in the courtyard, finds that now there are strictly less than $$$a_i$$$ other grannies (except herself, but including Maria), is prohibited. Please note that if several grannies appeared in the yard at the same time, then each of them sees others at the time of appearance. Your task is to find what maximum number of grannies (including herself) Maria can collect in the courtyard for the ceremony. After all, the more people in one place during quarantine, the more effective the ceremony!Consider an example: if $$$n=6$$$ and $$$a=[1,5,4,5,1,9]$$$, then:  at the first step Maria can call grannies with numbers $$$1$$$ and $$$5$$$, each of them will see two grannies at the moment of going out into the yard (note that $$$a_1=1 \le 2$$$ and $$$a_5=1 \le 2$$$);  at the second step, Maria can call grannies with numbers $$$2$$$, $$$3$$$ and $$$4$$$, each of them will see five grannies at the moment of going out into the yard (note that $$$a_2=5 \le 5$$$, $$$a_3=4 \le 5$$$ and $$$a_4=5 \le 5$$$);  the $$$6$$$-th granny cannot be called into the yard  — therefore, the answer is $$$6$$$ (Maria herself and another $$$5$$$ grannies).

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the input. Then test cases follow. The first line of a test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of grannies (Maria is not included in this number). The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 2\cdot10^5$$$). It is guaranteed that the sum of the values $$$n$$$ over all test cases of the input does not exceed $$$10^5$$$.

For each test case, print a single integer $$$k$$$ ($$$1 \le k \le n + 1$$$) — the maximum possible number of grannies in the courtyard.

NoteIn the first test case in the example, on the first step Maria can call all the grannies. Then each of them will see five grannies when they come out. Therefore, Maria and five other grannies will be in the yard.In the second test case in the example, no one can be in the yard, so Maria will remain there alone.The third test case in the example is described in the details above.In the fourth test case in the example, on the first step Maria can call grannies with numbers $$$1$$$, $$$2$$$ and $$$3$$$. If on the second step Maria calls $$$4$$$ or $$$5$$$ (one of them), then when a granny appears in the yard, she will see only four grannies (but it is forbidden). It means that Maria can't call the $$$4$$$-th granny or the $$$5$$$-th granny separately (one of them). If she calls both: $$$4$$$ and $$$5$$$, then when they appear, they will see $$$4+1=5$$$ grannies. Despite the fact that it is enough for the $$$4$$$-th granny, the $$$5$$$-th granny is not satisfied. So, Maria cannot call both the $$$4$$$-th granny and the $$$5$$$-th granny at the same time. That is, Maria and three grannies from the first step will be in the yard in total.

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

main = getLine >>= flip replicateM_ test . read

test = do
    getLine
    as <- reverse . sort . (1 :) . map read . words <$> getLine
    print $ solve (length as) as

solve _ [] = 1
solve n (a:as)
    | a > n - 1 = solve (n - 1) as
    | otherwise = n

import Data.List

solve :: [[Int]] -> [Int]
solve [] = []
solve (x:y:ys) = (count (x) (reverse (sort y))) : (solve ys)

count :: [Int] -> [Int] -> Int
count [0] _ = 1
count [n] (x:xs)
	| x <= n 	= 	n + 1
	| otherwise = 	count [n-1] xs

main = do
	t' <- getLine
	let t = read t' :: Int
	fin <- getContents
	let input = map (map read) (map words (take (2*t) (lines fin))) :: [[Int]]
	let result = solve input
	mapM print result

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest
split = _split [] ""

_indexed acc _ [] = reverse acc
_indexed acc i (x:xs) = _indexed ((i,x):acc) (i+1) xs
indexed = _indexed [] 0

main = do
  input <- getContents
  let (_:tokens) = split input
      vals = read <$> tokens :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []      -> Nothing
          n:rest  ->
            let (thisCase, rest') = splitAt n rest
                sorted = sort thisCase
                cands = filter (\(i, val) -> val <= (i+1)) $ indexed sorted
                subres = case cands of
                          []  -> 1
                          _   -> 2 + (fst $ last cands)
            in Just (subres, rest')
        ) vals
  sequence_ (putStrLn <$> (show <$> res))

import Data.List (sort)
import Data.Traversable (for)

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  _ <- for [1..t] $ \_ -> do
    _n <- read <$> getLine :: IO Int
    a <- (map read . words) <$> getLine :: IO [Int]
    let s = zip [1..] (sort a)
        ans = 0 : [x | (x, k) <- s, x >= k]
    print (1 + last ans)
  return ()

import Data.List as L

solve' :: Int -> Int -> [Int] -> Int
solve' _ bestSoFar [] = bestSoFar
solve' idx bestSoFar (x:rest)
  | idx >= x  = solve' (idx+1) idx       rest
  | otherwise = solve' (idx+1) bestSoFar rest

solve :: [Int] -> Int
solve arr = 1 + solve' 0 0 sorted
  where sorted = 0:(L.sort arr)

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n arr = (take n arr):(groupByNLines n (drop n arr))

parse :: [String] -> String
parse [_, input] = show $ solve arr
  where arr = map (\x -> read x :: Int) $ words input

main :: IO ()
main = interact (unlines . map parse . groupByNLines 2. tail .lines)


Shaass has decided to hunt some birds. There are n horizontal electricity wires aligned parallel to each other. Wires are numbered 1 to n from top to bottom. On each wire there are some oskols sitting next to each other. Oskol is the name of a delicious kind of birds in Shaass's territory. Supposed there are ai oskols sitting on the i-th wire.  Sometimes Shaass shots one of the birds and the bird dies (suppose that this bird sat at the i-th wire). Consequently all the birds on the i-th wire to the left of the dead bird get scared and jump up on the wire number i - 1, if there exists no upper wire they fly away. Also all the birds to the right of the dead bird jump down on wire number i + 1, if there exists no such wire they fly away. Shaass has shot m birds. You're given the initial number of birds on each wire, tell him how many birds are sitting on each wire after the shots.

The first line of the input contains an integer n, (1 ≤ n ≤ 100). The next line contains a list of space-separated integers a1, a2, ..., an, (0 ≤ ai ≤ 100).  The third line contains an integer m, (0 ≤ m ≤ 100). Each of the next m lines contains two integers xi and yi. The integers mean that for the i-th time Shaass shoot the yi-th (from left) bird on the xi-th wire, (1 ≤ xi ≤ n, 1 ≤ yi). It's guaranteed there will be at least yi birds on the xi-th wire at that moment.

On the i-th line of the output print the number of birds on the i-th wire.

import Control.Applicative
import Control.Monad
import Data.Array

gao :: Array Int Int -> (Int, Int) -> Array Int Int
gao a (x, y) = a // [(i, a!i + j) | (i, j) <- d, bounds a `inRange` i]
  where
    z = a!x
    d = [(x - 1, y - 1), (x, -z), (x + 1, z - y)]

main :: IO ()
main = do
  n <- read <$> getLine
  a <- listArray (1, n) . map read . words <$> getLine
  m <- read <$> getLine
  b <- replicateM m $ do
    [i, j] <- map read . words <$> getLine
    return (i, j)
  putStr $ unlines $ map show $ elems $ foldl gao a b

import Control.Monad (liftM, replicateM)
import Data.Array (Array(), (!), (//), elems, listArray)
import Prelude hiding (reads)

readPair :: Read a => IO (a, a)
readPair  =  do
    [x, y]  <-  reads
    return (x, y)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Array Int Int -> [(Int, Int)] -> Array Int Int
solve array []  =  array
solve array ((x, y) : xs)  =  solve array' xs
  where
    array'  =  array // [(x, 0), (x - 1, array ! (x - 1) + (y - 1)), (x + 1, array ! (x + 1) + (array ! x) - y)]

print' :: Array Int Int -> IO ()
print'  =  mapM_ print . tail . init . elems

main :: IO ()
main  =  do
    n   <-  readLn
    xs  <-  reads
    let array  =  listArray (0, n+1) (0 : xs ++ [0])
    m  <-  readLn
    shoots  <-  replicateM m readPair
    print' $ solve array shoots

import Data.List

f::Int->Int->Int->[Int]->[Int]
f 1 1 t (x:[])=[0]
f 1 1 t (x:y:xs)=0:(y+x-t):xs
f n m t (x:y:[])
     |n==m=(x+t-1):0:[]
     |otherwise=0:(y+x-t):[]
f n m t (x:y:z:xs)
     |n==m=(x+t-1):0:(z+y-t):xs
     |otherwise=x:f n (m+1) t (y:z:xs)

f2::[String]->[Int]->[Int]
f2 [] ans=ans
f2 (s:str) ans=let (n:t:[])=map read (words s)::[Int]
               in if n==1 then f2 str (f 1 1 t ans)  else f2 str (f n 2 t ans)

main = do
       e<-getLine
       es<-getLine
       e2<-getLine
       es2<-getContents
       let xs=map read (words es)::[Int]
           ys=lines es2
       mapM_ putStrLn $ map show $ f2 ys xs

import Debug.Trace

main :: IO ()
main =
 putStrLn . unlines . map show . solve . lines =<< getContents

solve :: [String] -> [Int]
solve (_:numBirdsStr:_:killingsStr) =
  foldl update numBirds killings
  where
    numBirds = map read $ words numBirdsStr
    killings = map (tupify2 . (map read) . words) killingsStr
    tupify2 :: [a] -> (a, a)
    tupify2 [x, y] = (x, y)
    -- update :: numBirds -> (wire#, killed bird idx) -> numBirds'
    update :: [Int] -> (Int, Int) -> [Int]
    update birds (wire, killedBird) =
      let dUpper = killedBird - 1
          numBirdsOnWire = birds !! (wire - 1)
          dLower = numBirdsOnWire - dUpper - 1
          f i = if i == wire - 1 then
                  dUpper
                else
                  0
          g i = if i == wire + 1 then
                  dLower
                else
                  0
      in
       [birdQ + f i| (i, birdQ) <- zip [1..] birds, i < wire] ++ [0] ++ [birdQ + g i | (i, birdQ) <- zip [1..] birds, i > wire]
solve _ = error "not enough lines"

import System.IO
import Control.Applicative
import Data.Array.ST
import Data.Array
import Control.Monad
import Control.Monad.ST

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

solve :: [Int] -> [[Int]] -> [Int]
solve a q = [ans ! i | i <- [1..n]] where
    n = length a
    process arr ([i,pos]) = do
        when (i > 1) $ do
            was <- readArray arr (i - 1)
            writeArray arr (i - 1) $ was + pos - 1
        when (i < n) $ do
            me <- readArray arr i
            was <- readArray arr (i + 1)
            writeArray arr (i + 1) $ was + me - pos
        writeArray arr i 0
    ans = runSTArray ans'
    ans' = do
        arr <- newListArray (1, n) a :: ST s (STArray s Int Int)
        forM q $ \x -> process arr x
        return arr

main = do
    n <- getLine
    a <- readLine :: IO [Int]
    m <- read <$> getLine
    q <- sequence [readLine | i <- [1..m]] :: IO [[Int]]
    forM (solve a q) $ \x ->
        print x

import Control.Applicative ((*>), (<$>), (<*>))

main :: IO ()
main = getLine >> solve <$> (map read . words <$> getLine) <*> (getLine *> (map (map read . words) . lines <$> getContents)) >>= mapM_ print

solve :: [Int] -> [[Int]] -> [Int]
solve = foldl (\as [x, y] -> [ sum $ [ a | i /= x ] ++ [ y - 1 | i == x - 1 ] ++ [ as !! (x - 1) - y | i == x + 1 ] | (i, a) <- zip [1..] as ])

module Main where

import Control.Monad

shoot :: [Int] -> [Int] -> [Int]
shoot birds shot = let [wire, bird] = shot
                       birdsOnShotWire = birds!!(wire - 1)
                       birdsToMin = bird - 1
                       birdsToMax = birdsOnShotWire - birdsToMin - 1
                       totalWires = length birds
                       birdsDiff = (replicate (wire - 2) 0)
                                ++ (if wire == 1
                                   then [-birdsOnShotWire, birdsToMax]
                                   else
                                     if wire == totalWires
                                     then [birdsToMin, -birdsOnShotWire]
                                     else [birdsToMin, -birdsOnShotWire, birdsToMax])
                                ++ (replicate (totalWires - wire - 1) 0)
                       in
                    zipWith (+) birds birdsDiff

main = do
       birds <- liftM (map read . words) (getLine >> getLine)
       shots <- liftM (map (map read . words) . lines) (getLine >> getContents)
       mapM_ print $ foldl shoot birds shots

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

process 1 a [] = a
process 1 a ([x,y]:s) = [0]
process n a [] = a
process n a ([x,y]:s)   |x==1 = process n  ( [0] ++ [(a!!1)+  (a!!0)-y] ++ (drop 2 a)) s
			|x==n = process n ((take (x-2) a)++ [(a!!(x-2)) + y-1] ++ [0]) s
			|otherwise = process n ((take (x-2) a)++ [(a!!(x-2)) + y-1] ++ [0] ++ [(a!!x) +(a!!(x-1)) -y] ++ drop (x+1) a) s

main = do
		n<-read <$> getLine ::IO Int
		a<-  map read <$> words <$> getLine ::IO [Int]
		m<-read <$> getLine ::IO Int
		s<- map (map read.words) <$> replicateM m getLine ::IO [[Int]]
		mapM_ print $ process n a s

import Control.Monad

main :: IO ()
main = do
  n <- fmap read getLine
  op <- replicateM n getLine
  let add = length $ filter (elem '+') op
      sub = length op - add
  print $ add - sub


Tanya wants to go on a journey across the cities of Berland. There are $$$n$$$ cities situated along the main railroad line of Berland, and these cities are numbered from $$$1$$$ to $$$n$$$. Tanya plans her journey as follows. First of all, she will choose some city $$$c_1$$$ to start her journey. She will visit it, and after that go to some other city $$$c_2 > c_1$$$, then to some other city $$$c_3 > c_2$$$, and so on, until she chooses to end her journey in some city $$$c_k > c_{k - 1}$$$. So, the sequence of visited cities $$$[c_1, c_2, \dots, c_k]$$$ should be strictly increasing.There are some additional constraints on the sequence of cities Tanya visits. Each city $$$i$$$ has a beauty value $$$b_i$$$ associated with it. If there is only one city in Tanya's journey, these beauty values imply no additional constraints. But if there are multiple cities in the sequence, then for any pair of adjacent cities $$$c_i$$$ and $$$c_{i + 1}$$$, the condition $$$c_{i + 1} - c_i = b_{c_{i + 1}} - b_{c_i}$$$ must hold.For example, if $$$n = 8$$$ and $$$b = [3, 4, 4, 6, 6, 7, 8, 9]$$$, there are several three possible ways to plan a journey:  $$$c = [1, 2, 4]$$$;  $$$c = [3, 5, 6, 8]$$$;  $$$c = [7]$$$ (a journey consisting of one city is also valid). There are some additional ways to plan a journey that are not listed above.Tanya wants her journey to be as beautiful as possible. The beauty value of the whole journey is the sum of beauty values over all visited cities. Can you help her to choose the optimal plan, that is, to maximize the beauty value of the journey?

The first line contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of cities in Berland. The second line contains $$$n$$$ integers $$$b_1$$$, $$$b_2$$$, ..., $$$b_n$$$ ($$$1 \le b_i \le 4 \cdot 10^5$$$), where $$$b_i$$$ is the beauty value of the $$$i$$$-th city.

Print one integer — the maximum beauty of a journey Tanya can choose.

NoteThe optimal journey plan in the first example is $$$c = [2, 4, 5]$$$.The optimal journey plan in the second example is $$$c = [1]$$$.The optimal journey plan in the third example is $$$c = [3, 6]$$$.

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    n <- get
    b <- replicateM n get
    putln $ f1 n b

f1 :: Int -> [Int] -> Int64
f1 n b = let a = runSTUArray $ do
                ba <- newArray (-300000, 500000) 0 :: ST s (STUArray s Int Int64)
                foldM (\i c -> do
                    r <- readArray ba (c - i)
                    writeArray ba (c - i) (r + (fromIntegral c))
                    return $ i + 1
                    ) 0 b
                return ba
         in
         maximum $ elems a


You are given a description of a depot. It is a rectangular checkered field of n × m size. Each cell in a field can be empty (".") or it can be occupied by a wall ("*"). You have one bomb. If you lay the bomb at the cell (x, y), then after triggering it will wipe out all walls in the row x and all walls in the column y.You are to determine if it is possible to wipe out all walls in the depot by placing and triggering exactly one bomb. The bomb can be laid both in an empty cell or in a cell occupied by a wall.

The first line contains two positive integers n and m (1 ≤ n, m ≤ 1000) — the number of rows and columns in the depot field.  The next n lines contain m symbols "." and "*" each — the description of the field. j-th symbol in i-th of them stands for cell (i, j). If the symbol is equal to ".", then the corresponding cell is empty, otherwise it equals "*" and the corresponding cell is occupied by a wall.

If it is impossible to wipe out all walls by placing and triggering exactly one bomb, then print "NO" in the first line (without quotes). Otherwise print "YES" (without quotes) in the first line and two integers in the second line — the coordinates of the cell at which the bomb should be laid. If there are multiple answers, print any of them.

import Control.Monad

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    tbl <- (concat . lines) `fmap` getContents
    let ps = [(i,j) | i <- [1..n], j <- [1..m]]
    let walls = fst $ unzip $ filter (\(_,v) -> v == '*') (zip ps tbl)
    if walls == []
    then putStrLn "YES" >> putStrLn "1 1"   -- no wall. place the bomb anywhere
    else case search walls n m of           -- possible bomb installations
        [] -> putStrLn "NO"                 -- no solution
        ((y,x):xs) -> do
            putStrLn "YES"                  -- print first solution
            putStrLn $ show y ++ " " ++ show x

search (w:walls) n m = f walls (bombs0 w) where
    -- f :: [wall] -> [bomb] -> [bomb]
    f [] ps = ps
    f _ [] = []
    f (w:ws) ps = f ws (cross w ps)
    cross (wy,wx) ps = filter (\(py,px) -> py == wy || px == wx) ps
    bombs0 (wy,wx) = [(y,wx) | y <- [1..n]] ++ [(wy,x) | x <- [1..m], x /= wx]

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

count :: String -> Int
count "" = 0
count (x:xs) = a + (count xs)
                where a | x == '*' = 1
                        | otherwise = 0

count2 :: [String] -> [Int]
count2 [] = []
count2 (x:xs) = (count x) : (count2 xs)

printRes :: Maybe (Int, Int) -> IO ()
printRes Nothing = putStrLn "NO"
printRes (Just (x, y)) = do
                        putStrLn "YES"
                        putStrLn $ (show x) ++ " " ++ (show y)

solve1 :: [Int] -> Int -> String -> Int -> Int -> Int -> Maybe (Int, Int)
solve1 _ _ [] _ _ _ = Nothing
solve1 (c:cs) r (cell:row) tc n m | c + r - tc - p == 0 = Just (n, m)
                                  | otherwise = solve1 cs r row tc n (m + 1)
                                    where p | cell == '*' = 1
                                            | otherwise = 0

solve :: [Int] -> [Int] -> [String] -> Int -> Int -> Maybe (Int, Int)
solve _ _ [] _ _ = Nothing
solve cs (r:rs) (x:xs) tc n =  (solve1 cs r x tc n 1) `mplus` (solve cs rs xs tc (n + 1))

main :: IO ()
main = do
        [n, m] <- map read . words <$> getLine
        rows <- mapM (\_ -> getLine) [1..n]
        let rowCount = count2 rows
            totalCount = sum rowCount
            cols = transpose rows
            colCount = count2 cols
        printRes $ solve colCount rowCount rows totalCount 1

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

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

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}

main :: IO ()
main = do
    [_, m] <- map readInt.B.words <$> B.getLine
    cs <- concat.lines <$> getContents
    case solve m cs of
        Just (x, y) -> do
            putStrLn "YES"
            putStrLn.unwords.map show $ [x+1, y+1]
        Nothing -> putStrLn "NO"

solve :: Int -> String -> Maybe (Int, Int)
solve _ cs | all (=='.') cs = Just (0, 0)
solve m cs = goXY (x0, y0) $ zip [i0+1..] $ drop (i0+1) cs
  where
    i0 :: Int
    !i0 = fst . head . dropWhile ((=='.').snd) $ zip [0..] cs
    (!x0, !y0) = divMod i0 m
    goXY (x, y) ((i, '*'):rest)
        | x == x' = goY (x, y) rest
        | y == y' = goX (x, y) rest
        | otherwise = go (x, y') rest <|> go (x', y) rest
      where
        (x', y') = divMod i m
    goXY (x, y) (_:rest) = goXY (x, y) rest
    goXY (x, y) [] = Just (x, y)

    goX (x, y) ((i, '*'):rest)
        | y == y' = goX (x, y) rest
        | otherwise = go (x', y) rest
      where
        (x', y') = divMod i m
    goX (x, y) (_:rest) = goX (x, y) rest
    goX (x, y) [] = Just (x, y)

    goY (x, y) ((i, '*'):rest)
        | x == x' = goY (x, y) rest
        | otherwise = go (x, y') rest
      where
        (x', y') = divMod i m
    goY (x, y) (_:rest) = goY (x, y) rest
    goY (x, y) [] = Just (x, y)

    go (x, y) rest
        | all (check.fst)$filter((=='*').snd)rest = Just (x, y)
        | otherwise = Nothing
      where
        check i  = x == x' || y == y'
          where
            (x',y') = divMod i m

accumulate :: Char -> Integer -> Integer
accumulate '*' = succ
accumulate _   = id

locations :: [[Integer]] -> [[Integer]] -> [[Integer]] -> [[Integer]] -> [String] -> Integer -> Integer -> [(Integer, Integer)]
locations [] [] [] [] [] _ _ = []
locations (l:gl) (r:gr) (u:gu) (d:gd) (m:mt) x amnt = (locations' l r u d m 0 amnt) ++ locations gl gr gu gd mt (x + 1) amnt
  where
    locations' :: [Integer] -> [Integer] -> [Integer] -> [Integer] -> String -> Integer -> Integer -> [(Integer, Integer)]
    locations' [] [] [] [] [] _ _ = []
    locations' (l:left') (r:right') (u:up') (d:down') (m:mat') y amnt
      | amnt == l + r + u + d - (if m == '*' then 3 else 0) = (x, y) : locations' left' right' up' down' mat' (y + 1) amnt
      | otherwise                                           = locations' left' right' up' down' mat' (y + 1) amnt

process :: String -> String
process str =
  let (h:mat)   = lines str
      [n, m]    = map read . words $ h
      amnt      = fromIntegral . length . filter (=='*') . concat $ mat
      left      = map (tail . scanl (flip accumulate) 0) mat
      right     = map (reverse . tail . scanl (flip accumulate) 0 . reverse) mat
      up        = tail . scanl (zipWith (flip accumulate)) (replicate m 0) $ mat
      down      = reverse . tail . scanl (zipWith (flip accumulate)) (replicate m 0) . reverse $ mat
      locs      = locations left right up down mat 0 amnt
  in
    if null locs
    then "NO"
    else "YES\n" ++ ((\(x, y) -> show (x + 1) ++ " " ++ show (y + 1)) . head $ locs)

main :: IO ()
main = interact process

import Control.Monad
import Data.Array

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    tbl <- (concat . lines) `fmap` getContents
    let ps = [(i,j) | i <- [1..n], j <- [1..m]]
    let ary = array ((1,1),(n,m)) (zip ps tbl)
    let rows = testRow ary n m
    let cols = testCol ary n m
    let only = [(i,j) | i <- [1..n], j <- [1..m], ary ! (i,j) == '*']
    if length only == 1
    then putStrLn $ ((show . fst . head) only) ++ " " ++ ((show . snd . head) only)
    else if (length rows >= 2) || (length cols >= 2)
    then putStrLn "NO"
    else do
        let x = if cols == [] then 0 else head cols
        let y = if rows == [] then 0 else head rows
        putStrLn "YES"
        putStrLn $ (show y) ++ " " ++ (show x)

testRow ary n m = [i | i <- [1..n], test i] where
    test i = length (filter (== '*') [ary ! (i,j) | j <- [1..m]]) >= 2

testCol ary n m = [j | j <- [1..m], test j] where
    test j = length (filter (== '*') [ary ! (i,j) | i <- [1..n]]) >= 2

import Control.Monad
import Data.Array

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    tbl <- (concat . lines) `fmap` getContents
    let ps = [(i,j) | i <- [1..n], j <- [1..m]]
    let ary = array ((1,1),(n,m)) (zip ps tbl)
    let rows = testRow ary n m
    let cols = testCol ary n m
    let only = [(i,j) | i <- [1..n], j <- [1..m], ary ! (i,j) == '*']
    if length only == 1
    then do
        putStrLn "YES"
        putStrLn $ ((show . fst . head) only) ++ " " ++ ((show . snd . head) only)
    else if (length rows >= 2) || (length cols >= 2)
    then putStrLn "NO"
    else do
        let x = if cols == [] then 1 else head cols
        let y = if rows == [] then 1 else head rows
        putStrLn "YES"
        putStrLn $ (show y) ++ " " ++ (show x)

testRow ary n m = [i | i <- [1..n], test i] where
    test i = length (filter (== '*') [ary ! (i,j) | j <- [1..m]]) >= 2

testCol ary n m = [j | j <- [1..m], test j] where
    test j = length (filter (== '*') [ary ! (i,j) | i <- [1..n]]) >= 2

import Control.Monad
import Data.Array

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    tbl <- (concat . lines) `fmap` getContents
    let ps = [(i,j) | i <- [1..n], j <- [1..m]]
    let ary = array ((1,1),(n,m)) (zip ps tbl)
    let rows = testRow ary n m
    let cols = testCol ary n m
    if (length rows >= 2) || (length cols >= 2)
    then putStrLn "NO"
    else if rows == [] && cols == []
    then putStrLn "NO"
    else do
        let x = if cols == [] then 0 else head cols
        let y = if rows == [] then 0 else head rows
        putStrLn "YES"
        putStrLn $ (show y) ++ " " ++ (show x)

testRow ary n m = [i | i <- [1..n], test i] where
    test i = length (filter (== '*') [ary ! (i,j) | j <- [1..m]]) > 1

testCol ary n m = [j | j <- [1..m], test j] where
    test j = length (filter (== '*') [ary ! (i,j) | i <- [1..n]]) > 1

import Control.Monad

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    tbl <- (concat . lines) `fmap` getContents
    let ps = [(i,j) | i <- [1..n], j <- [1..m]]
    let walls = fst $ unzip $ filter (\(_,v) -> v == '*') (zip ps tbl)
    if walls == []
    then putStrLn "YES" >> putStrLn "1 1"   -- no wall. place the bomb anywhere
    else case search walls n m of           -- possible bomb installations
        [] -> putStrLn "NO"                 -- no solution
        ((y,x):xs) -> do
            putStrLn "YES"                  -- print first solution
            putStrLn $ show y ++ " " ++ show x

search (w:walls) n m = bombs0 w where
--search (w:walls) n m = f walls (bombs0 w) where
    -- f :: [wall] -> [bomb] -> [bomb]
    f [] ps = ps
    f _ [] = []
    f (w:ws) ps = f ws (cross w ps)
    cross (wy,wx) ps = filter (\(py,px) -> py == wy || px == wx) ps
    bombs0 (wy,wx) = [(y,wx) | y <- [1..n]] ++ [(wy,x) | x <- [1..m], x /= wx]

import Control.Monad
import Data.Array

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    tbl <- (concat . lines) `fmap` getContents
    let ps = [(i,j) | i <- [1..n], j <- [1..m]]
    let ary = array ((1,1),(n,m)) (zip ps tbl)
    let walls = filter (\(y,x) -> ary ! (y,x) == '*') ps
    if walls == []
    then putStrLn "YES" >> putStrLn "1 1"   -- no wall. place the bomb anywhere
    else case search walls m n of           -- possible bomb installations
        [] -> putStrLn "NO"                 -- no solution
        ((y,x):xs) -> do
            putStrLn "YES"                  -- print first solution
            putStrLn $ show y ++ " " ++ show x

search (w:walls) n m = f walls (bombs0 w) where
    -- f :: [wall] -> [bomb] -> [bomb]
    f [] ps = ps
    f _ [] = []
    f (w:ws) ps = f ws (cross w ps)
    cross (wy,wx) ps = filter (\(py,px) -> py == wy || px == wx) ps
    bombs0 (wy,wx) = [(y,wx) | y <- [1..n]] ++ [(wy,x) | x <- [1..m], x /= wx]

import Control.Monad
import Data.Array

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    tbl <- (concat . lines) `fmap` getContents
    let ps = [(i,j) | i <- [1..n], j <- [1..m]]
    let ary = array ((1,1),(n,m)) (zip ps tbl)
    let rows = testRow ary n m
    let cols = testCol ary n m
    if (length rows >= 2) || (length cols >= 2)
    then putStrLn "NO"
    else do
        let x = if cols == [] then 0 else head cols
        let y = if rows == [] then 0 else head rows
        putStrLn "YES"
        putStrLn $ (show y) ++ " " ++ (show x)

testRow ary n m = [i | i <- [1..n], test i] where
    test i = length (filter (== '*') [ary ! (i,j) | j <- [1..m]]) > 1

testCol ary n m = [j | j <- [1..m], test j] where
    test j = length (filter (== '*') [ary ! (i,j) | i <- [1..n]]) > 1