You are given a picture consisting of $$$n$$$ rows and $$$m$$$ columns. Rows are numbered from $$$1$$$ to $$$n$$$ from the top to the bottom, columns are numbered from $$$1$$$ to $$$m$$$ from the left to the right. Each cell is painted either black or white. You think that this picture is not interesting enough. You consider a picture to be interesting if there is at least one cross in it. A cross is represented by a pair of numbers $$$x$$$ and $$$y$$$, where $$$1 \le x \le n$$$ and $$$1 \le y \le m$$$, such that all cells in row $$$x$$$ and all cells in column $$$y$$$ are painted black.For examples, each of these pictures contain crosses:  The fourth picture contains 4 crosses: at $$$(1, 3)$$$, $$$(1, 5)$$$, $$$(3, 3)$$$ and $$$(3, 5)$$$.Following images don't contain crosses:  You have a brush and a can of black paint, so you can make this picture interesting. Each minute you may choose a white cell and paint it black.What is the minimum number of minutes you have to spend so the resulting picture contains at least one cross?You are also asked to answer multiple independent queries.

The first line contains an integer $$$q$$$ ($$$1 \le q \le 5 \cdot 10^4$$$) — the number of queries. The first line of each query contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 5 \cdot 10^4$$$, $$$n \cdot m \le 4 \cdot 10^5$$$) — the number of rows and the number of columns in the picture. Each of the next $$$n$$$ lines contains $$$m$$$ characters — '.' if the cell is painted white and '*' if the cell is painted black. It is guaranteed that $$$\sum n \le 5 \cdot 10^4$$$ and $$$\sum n \cdot m \le 4 \cdot 10^5$$$.

Print $$$q$$$ lines, the $$$i$$$-th line should contain a single integer — the answer to the $$$i$$$-th query, which is the minimum number of minutes you have to spend so the resulting picture contains at least one cross.

NoteThe example contains all the pictures from above in the same order.The first 5 pictures already contain a cross, thus you don't have to paint anything.You can paint $$$(1, 3)$$$, $$$(3, 1)$$$, $$$(5, 3)$$$ and $$$(3, 5)$$$ on the $$$6$$$-th picture to get a cross in $$$(3, 3)$$$. That'll take you $$$4$$$ minutes.You can paint $$$(1, 2)$$$ on the $$$7$$$-th picture to get a cross in $$$(4, 2)$$$.You can paint $$$(2, 2)$$$ on the $$$8$$$-th picture to get a cross in $$$(2, 2)$$$. You can, for example, paint $$$(1, 3)$$$, $$$(3, 1)$$$ and $$$(3, 3)$$$ to get a cross in $$$(3, 3)$$$ but that will take you $$$3$$$ minutes instead of $$$1$$$.There are 9 possible crosses you can get in minimum time on the $$$9$$$-th picture. One of them is in $$$(1, 1)$$$: paint $$$(1, 2)$$$ and $$$(2, 1)$$$.

import Data.Char (ord)
import Control.Monad (replicateM, replicateM_, join)

parseInt :: String -> Int
parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

solve :: IO ()
solve = do
  [n, m] <- fmap (fmap parseInt . words) getLine
  mat <- map (map (\c -> if c == '*' then 1 else 0)) <$> replicateM n getLine
  let rows = fmap sum mat
      cols = foldl (zipWith (+)) (replicate m 0) mat
      cross = [n + m - 1 - x - y | x <- rows, y <- cols]
  print (minimum (zipWith (+) cross (join mat)))

main :: IO ()
main = do
  testNum <- fmap parseInt getLine
  replicateM_ testNum solve


Students love to celebrate their holidays. Especially if the holiday is the day of the end of exams!Despite the fact that Igor K., unlike his groupmates, failed to pass a programming test, he decided to invite them to go to a cafe so that each of them could drink a bottle of... fresh cow milk. Having entered the cafe, the m friends found n different kinds of milk on the menu, that's why they ordered n bottles — one bottle of each kind. We know that the volume of milk in each bottle equals w.When the bottles were brought in, they decided to pour all the milk evenly among the m cups, so that each got a cup. As a punishment for not passing the test Igor was appointed the person to pour the milk. He protested that he was afraid to mix something up and suggested to distribute the drink so that the milk from each bottle was in no more than two different cups. His friends agreed but they suddenly faced the following problem — and what is actually the way to do it?Help them and write the program that will help to distribute the milk among the cups and drink it as quickly as possible!Note that due to Igor K.'s perfectly accurate eye and unswerving hands, he can pour any fractional amount of milk from any bottle to any cup.

The only input data file contains three integers n, w and m (1 ≤ n ≤ 50, 100 ≤ w ≤ 1000, 2 ≤ m ≤ 50), where n stands for the number of ordered bottles, w stands for the volume of each of them and m stands for the number of friends in the company.

Print on the first line "YES" if it is possible to pour the milk so that the milk from each bottle was in no more than two different cups. If there's no solution, print "NO". If there is a solution, then print m more lines, where the i-th of them describes the content of the i-th student's cup. The line should consist of one or more pairs that would look like "b v". Each such pair means that v (v > 0) units of milk were poured into the i-th cup from bottle b (1 ≤ b ≤ n). All numbers b on each line should be different. If there are several variants to solve the problem, print any of them. Print the real numbers with no less than 6 digits after the decimal point.

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph
import Text.Printf

parseInput = do
    n <- readInt
    w <- readInteger
    m <- readInt
    return (n, w, m)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

solve :: (Int, Integer, Int) -> ByteString
solve (n, w, m)
    | not checkAnswer = BS.pack "NO\n"
    | otherwise       = BS.unlines $ BS.pack "YES" : [BS.unwords [ BS.pack $ printMove (head y) (length y) | y <- group ys] | ys <- bottlesSp]
  where
    bottles = concatMap (replicate m) [1..n]
    bottlesSp = goSplit bottles
      where
        goSplit [] = []
        goSplit xs = lo : goSplit hi
          where
            (lo, hi) = splitAt n xs

    checkAnswer = and [length [undefined | ys <- bottlesSp, elem x ys] <= 2 | x <- [1..n]]

    printMove x num = show x ++ " " ++ printf "%.10f" (fromRational ratio :: Double)
      where
        ratio = (fromIntegral num * w) % fromIntegral m

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph
import Text.Printf

parseInput = do
    n <- readInt
    w <- readInteger
    m <- readInt
    return (n, w, m)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

solve :: (Int, Integer, Int) -> ByteString
solve (n, w, m)
    | not checkAnswer = BS.pack "NO\n"
    | otherwise       = BS.unlines $ BS.pack "Yes" : [BS.unwords [ BS.pack $ printMove (head y) (length y) | y <- group ys] | ys <- bottlesSp]
  where
    bottles = concatMap (replicate m) [1..n]
    bottlesSp = goSplit bottles
      where
        goSplit [] = []
        goSplit xs = lo : goSplit hi
          where
            (lo, hi) = splitAt n xs

    checkAnswer = and [length [undefined | ys <- bottlesSp, elem x ys] <= 2 | x <- [1..n]]

    printMove x num = show x ++ " " ++ printf "%.10f" (fromRational ratio :: Double)
      where
        ratio = (fromIntegral num * w) % fromIntegral m

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State


Pak Chanek, a renowned scholar, invented a card puzzle using his knowledge. In the puzzle, you are given a board with $$$n$$$ rows and $$$m$$$ columns. Let $$$(r, c)$$$ represent the cell in the $$$r$$$-th row and the $$$c$$$-th column.Initially, there are $$$k$$$ cards stacked in cell $$$(1, 1)$$$. Each card has an integer from $$$1$$$ to $$$k$$$ written on it. More specifically, the $$$i$$$-th card from the top of the stack in cell $$$(1, 1)$$$ has the number $$$a_i$$$ written on it. It is known that no two cards have the same number written on them. In other words, the numbers written on the cards are a permutation of integers from $$$1$$$ to $$$k$$$. All other cells are empty.You need to move the $$$k$$$ cards to cell $$$(n, m)$$$ to create another stack of cards. Let $$$b_i$$$ be the number written on the $$$i$$$-th card from the top of the stack in cell $$$(n, m)$$$. You should create the stack in cell $$$(n, m)$$$ in such a way so that $$$b_i = i$$$ for all $$$1 \leq i \leq k$$$.In one move, you can remove the top card from a cell and place it onto an adjacent cell (a cell that shares a common side). If the target cell already contains one or more cards, you place your card on the top of the stack. You must do each operation while satisfying the following restrictions:   Each cell other than $$$(1,1)$$$ and $$$(n,m)$$$ must not have more than one card on it.  You cannot move a card onto cell $$$(1,1)$$$.  You cannot move a card from cell $$$(n,m)$$$. Given the values of $$$n$$$, $$$m$$$, $$$k$$$ and the array $$$a$$$, determine if the puzzle is solvable.

Each test contains multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 2 \cdot 10^4$$$) — the number of test cases. The following lines contain the description of each test case. The first line of each test case contains three integers $$$n$$$, $$$m$$$, and $$$k$$$ ($$$3 \leq n, m \leq 10^6$$$, $$$nm \leq 10^6$$$, $$$1 \leq k \leq 10^5$$$) — the size of the board and the number of cards. The second line of the test case contains $$$k$$$ integers $$$a_1, a_2, \ldots, a_k$$$ — the array $$$a$$$, representing the numbers written on the cards. The values of $$$a$$$ are a permutation of integers from $$$1$$$ to $$$k$$$. It is guaranteed that the sum of $$$nm$$$ and $$$k$$$ over all test cases do not exceed $$$10^6$$$ and $$$10^5$$$ respectively.

For each test case, output "YA" (without quotes) if it is possible and "TIDAK" (without quotes) otherwise, which mean yes and no in Indonesian respectively. You can output "YA" and "TIDAK" in any case (for example, strings "tiDAk", "tidak", and "Tidak" will be recognised as a negative response).

NoteIn the first test case, the following is one way the puzzle can be done:   Move the card with $$$3$$$ written on it from cell $$$(1, 1)$$$ to cell $$$(1, 2)$$$, then cell $$$(1, 3)$$$.  Move the card with $$$6$$$ written on it from cell $$$(1, 1)$$$ to cell $$$(2, 1)$$$, then cell $$$(3, 1)$$$, then cell $$$(3, 2)$$$, then cell $$$(3, 3)$$$.  Move the card with $$$4$$$ written on it from cell $$$(1, 1)$$$ to cell $$$(1, 2)$$$.  Move the card with $$$1$$$ written on it from cell $$$(1, 1)$$$ to cell $$$(2, 1)$$$, then cell $$$(2, 2)$$$, then cell $$$(2, 3)$$$.  Move the card with $$$2$$$ written on it from cell $$$(1, 1)$$$ to cell $$$(2, 1)$$$, then cell $$$(2, 2)$$$.  Move the card with $$$5$$$ written on it from cell $$$(1, 1)$$$ to cell $$$(2, 1)$$$, then cell $$$(3, 1)$$$, then cell $$$(3, 2)$$$, then cell $$$(3, 3)$$$.  Move the card with $$$2$$$ written on it from cell $$$(2, 2)$$$ to cell $$$(2, 1)$$$.  Move the card with $$$4$$$ written on it from cell $$$(1, 2)$$$ to cell $$$(2, 2)$$$, then cell $$$(3, 2)$$$, then cell $$$(3, 3)$$$.  Move the card with $$$3$$$ written on it from cell $$$(1, 3)$$$ to cell $$$(1, 2)$$$, then cell $$$(2, 2)$$$, then cell $$$(3, 2)$$$, then cell $$$(3, 3)$$$.  Move the card with $$$2$$$ written on it from cell $$$(2, 1)$$$ to cell $$$(3, 1)$$$, then cell $$$(3, 2)$$$, then cell $$$(3, 3)$$$.  Move the card with $$$1$$$ written on it from cell $$$(2, 3)$$$ to cell $$$(3, 3)$$$. An animated illustration regarding the process mentioned above is as follows:

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n m xs = check (n*m-3) xs (length xs) Set.empty

check k [] target st
  | Set.size st >= k = False
  | otherwise = True

check k (x:xs) target st
  | Set.size st >= k = False
  | Set.member target st = check k (x:xs) (target-1) $ Set.delete target st
  | x == target = check k xs (target - 1) st
  | otherwise = check k xs target $ Set.insert x st

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n, m, _] <- getInts
    xs <- getInts
    putStrLn $ if solve n m xs then "YA" else "TIDAK"

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n m xs = check (n*m-3) xs (length xs) Set.empty

check k [] target st
  | Set.size st > k = False
  | otherwise = True

check k (x:xs) target st
  | Set.size st > k = False
  | Set.member target st = check k (x:xs) (target-1) $ Set.delete target st
  | x == target = check k xs (target - 1) st
  | otherwise = check k xs target $ Set.insert x st

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n, m, _] <- getInts
    xs <- getInts
    putStrLn $ if solve n m xs then "YA" else "TIDAK"

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n m xs = check (n*m-3) xs (length xs) Set.empty

check _ [] _ _ = True

check k (x:xs) target st
  | Set.size st > k = False
  | Set.member target st = check k (x:xs) (target-1) $ Set.delete target st
  | x == target = check k xs (target - 1) st
  | otherwise = check k xs target $ Set.insert x st

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n, m, _] <- getInts
    xs <- getInts
    putStrLn $ if solve n m xs then "YA" else "TIDAK"

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n m xs = check (n*m-3) xs (length xs) Set.empty

check _ [] _ _ = True

check k (x:xs) target st
  | Set.member target st = check k (x:xs) (target-1) $ Set.delete target st
  | Set.size st > k = False
  | x == target = check k xs (target - 1) st
  | otherwise = check k xs target $ Set.insert x st

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n, m, _] <- getInts
    xs <- getInts
    putStrLn $ if solve n m xs then "YA" else "TIDAK"

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n m xs = check (n*m-3) xs (length xs) Set.empty

check _ [] _ _ = True

check k (x:xs) target st
  | Set.member target st = check k (x:xs) (target-1) $ Set.delete target st
  | x == target = check k xs (target - 1) st
  | Set.size st > k = False
  | otherwise = check k xs target $ Set.insert x st

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n, m, _] <- getInts
    xs <- getInts
    putStrLn $ if solve n m xs then "YA" else "TIDAK"

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n m xs = check (n*m-3) xs (length xs) Set.empty

check _ [] _ _ = True

check k (x:xs) target st
  | Set.member target st = check k xs (target-1) $ Set.delete target st
  | x == target = check k xs (target - 1) st
  | Set.size st > k = False
  | otherwise = check k xs target $ Set.insert x st

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n, m, _] <- getInts
    xs <- getInts
    putStrLn $ if solve n m xs then "YA" else "TIDAK"

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n m xs = check (n*m-3) xs (length xs) Set.empty

check _ [] _ _ = True

check k (x:xs) target st
  | Set.member target st = check k xs (target-1) $ Set.delete target st
  | Set.size st > k = False
  | x == target = check k xs (target - 1) st
  | otherwise = check k xs target $ Set.insert x st

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n, m, _] <- getInts
    xs <- getInts
    putStrLn $ if solve n m xs then "YA" else "TIDAK"

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n m xs = check (n*m-3) xs (length xs) Set.empty

check _ [] _ _ = True
check k (x:xs) target st
  | Set.size st > k = False
  | x == target = check k xs (target - 1) st
  | Set.member target st = check k xs (target-1) $ Set.delete target st
  | otherwise = check k xs target $ Set.insert x st

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n, m, _] <- getInts
    xs <- getInts
    putStrLn $ if solve n m xs then "YA" else "TIDAK"

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n m xs = check (n*m-3) xs (length xs) [] 0

check _ [] _ _ _ = True
check k (x:xs) target [] 0
  | x == target = check k xs (target - 1) [] 0
  | otherwise = check k xs target [x] 1
check k (x:xs) target (s:st) stlen
  | stlen > k = False
  | target == s = check k (x:xs) (target-1) st (stlen-1)
  | target == x = check k xs (target-1) (s:st) stlen
  | otherwise = check k xs target (x:s:st) (stlen+1)

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n, m, _] <- getInts
    xs <- getInts
    putStrLn $ if solve n m xs then "YA" else "TIDAK"


Little Vova studies programming in an elite school. Vova and his classmates are supposed to write n progress tests, for each test they will get a mark from 1 to p. Vova is very smart and he can write every test for any mark, but he doesn't want to stand out from the crowd too much. If the sum of his marks for all tests exceeds value x, then his classmates notice how smart he is and start distracting him asking to let them copy his homework. And if the median of his marks will be lower than y points (the definition of a median is given in the notes), then his mom will decide that he gets too many bad marks and forbid him to play computer games.Vova has already wrote k tests and got marks a1, ..., ak. He doesn't want to get into the first or the second situation described above and now he needs to determine which marks he needs to get for the remaining tests. Help him do that.

The first line contains 5 space-separated integers: n, k, p, x and y (1 ≤ n ≤ 999, n is odd, 0 ≤ k < n, 1 ≤ p ≤ 1000, n ≤ x ≤ n·p, 1 ≤ y ≤ p). Here n is the number of tests that Vova is planned to write, k is the number of tests he has already written, p is the maximum possible mark for a test, x is the maximum total number of points so that the classmates don't yet disturb Vova, y is the minimum median point so that mom still lets him play computer games. The second line contains k space-separated integers: a1, ..., ak (1 ≤ ai ≤ p) — the marks that Vova got for the tests he has already written.

If Vova cannot achieve the desired result, print "-1". Otherwise, print n - k space-separated integers — the marks that Vova should get for the remaining tests. If there are multiple possible solutions, print any of them.

NoteThe median of sequence a1, ..., an where n is odd (in this problem n is always odd) is the element staying on (n + 1) / 2 position in the sorted list of ai.In the first sample the sum of marks equals 3 + 5 + 4 + 4 + 1 = 17, what doesn't exceed 18, that means that Vova won't be disturbed by his classmates. And the median point of the sequence {1, 3, 4, 4, 5} equals to 4, that isn't less than 4, so his mom lets him play computer games.Please note that you do not have to maximize the sum of marks or the median mark. Any of the answers: "4 2", "2 4", "5 1", "1 5", "4 1", "1 4" for the first test is correct.In the second sample Vova got three '5' marks, so even if he gets two '1' marks, the sum of marks will be 17, that is more than the required value of 16. So, the answer to this test is "-1".

import Data.List
answer::Int -> Int -> Int -> Int -> Int -> [Int] -> [Int]
answer n k p x y a | ll0 > med = [(-1)]
                   | ll1 >= med+1 = if (sum a) + n2 <= x then take n2 (repeat 1) else [(-1)]
                   | sum a + n0 + y*n1 <=x = (take n0 (repeat 1)) ++ (take n1 (repeat y))
                   | otherwise = [(-1)]
  where (l0,l1) = partition (<y) a
        med = n `div` 2
        ll0 = length l0
        ll1 = length l1
        n0 = med - ll0
        n1 = med -ll1 +1
        n2 = n - (length a)
main = do
  w <- getLine
  let aa = [read n::Int|n <- (words w)]
  let n = aa !! 0
  let k = aa !! 1
  let p = aa !! 2
  let x = aa !! 3
  let y = aa !! 4
  ww <- getLine
  let a = [read n::Int|n <- (words ww)]
  putStrLn $ intercalate " " $ map show $ answer n k p x y a

import Data.List
import Control.Applicative
import Debug.Trace

solve :: [Int] -> [Int] -> String
solve [n, _, maxMark, maxPoints, minMedian] scores =
  if median full >= minMedian && maximum full <= maxMark && sum full <= maxPoints then
    unwords $ map show $ res
  else
    "-1"
  where
    track q = trace (show q) q
    maxOnes = (n `div` 2) - (length $ filter (<minMedian) scores)
    ones = replicate (min maxOnes (n - length scores)) 1
    medians = replicate (n - length ones - length scores) minMedian
    res = ones ++ medians
    full = res ++ scores
    median x = head $ drop (length x `div` 2) $ sort x

main = do
  x <- map read . words <$> getLine
  scores <- map read . words <$> getLine
  putStrLn $ solve x scores

import Data.List

main :: IO ()

main = do
    l1 <- getLine
    l2 <- getLine
    putStrLn $ solundra
        (map (read :: String -> Int) (words l1))
        (sort (map (read :: String -> Int) (words l2)))

solundra :: [Int] -> [Int] -> String

solundra (n:k:_:x:y:[]) l = let
    wen = length [x | x <- l, x < y]
    gro = length [x | x <- l, x >= y]
    zol = bober wen gro (n-k) y
    in if wen >= gro && wen - gro > n-k || sum zol + sum l > x
    then "-1"
    else unwords $ map show zol

bober :: Int -> Int -> Int -> Int -> [Int]

bober _ _ 0 _ = []
bober w g a y = if w < g - 1
    then 1 : bober (w+1) g (a-1) y
    else y : bober w (g+1) (a-1) y

import Data.List
import Control.Applicative

solve :: [Int] -> [Int] -> String
solve [n, _, maxMark, maxPoints, minMedian] scores =
  if median full >= minMedian && maximum full <= maxMark && sum full <= maxPoints then
    unwords $ map show $ res
  else
    "-1"
  where
    maxOnes = (n `div` 2) - (length $ filter (<minMedian) scores)
    ones = replicate maxOnes 1
    medians = replicate (n - length ones - length scores) minMedian
    res = ones ++ medians
    full = res ++ scores
    median x = head $ drop (length x `div` 2) $ sort x

main = do
  x <- map read . words <$> getLine
  scores <- map read . words <$> getLine
  putStrLn $ solve x scores


Gathering darkness shrouds the woods and the world. The moon sheds its light on the boat and the river."To curtain off the moonlight should be hardly possible; the shades present its mellow beauty and restful nature." Intonates Mino."See? The clouds are coming." Kanno gazes into the distance."That can't be better," Mino turns to Kanno. The sky can be seen as a one-dimensional axis. The moon is at the origin whose coordinate is $$$0$$$.There are $$$n$$$ clouds floating in the sky. Each cloud has the same length $$$l$$$. The $$$i$$$-th initially covers the range of $$$(x_i, x_i + l)$$$ (endpoints excluded). Initially, it moves at a velocity of $$$v_i$$$, which equals either $$$1$$$ or $$$-1$$$.Furthermore, no pair of clouds intersect initially, that is, for all $$$1 \leq i \lt j \leq n$$$, $$$\lvert x_i - x_j \rvert \geq l$$$.With a wind velocity of $$$w$$$, the velocity of the $$$i$$$-th cloud becomes $$$v_i + w$$$. That is, its coordinate increases by $$$v_i + w$$$ during each unit of time. Note that the wind can be strong and clouds can change their direction.You are to help Mino count the number of pairs $$$(i, j)$$$ ($$$i < j$$$), such that with a proper choice of wind velocity $$$w$$$ not exceeding $$$w_\mathrm{max}$$$ in absolute value (possibly negative and/or fractional), the $$$i$$$-th and $$$j$$$-th clouds both cover the moon at the same future moment. This $$$w$$$ doesn't need to be the same across different pairs.

The first line contains three space-separated integers $$$n$$$, $$$l$$$, and $$$w_\mathrm{max}$$$ ($$$1 \leq n \leq 10^5$$$, $$$1 \leq l, w_\mathrm{max} \leq 10^8$$$) — the number of clouds, the length of each cloud and the maximum wind speed, respectively. The $$$i$$$-th of the following $$$n$$$ lines contains two space-separated integers $$$x_i$$$ and $$$v_i$$$ ($$$-10^8 \leq x_i \leq 10^8$$$, $$$v_i \in \{-1, 1\}$$$) — the initial position and the velocity of the $$$i$$$-th cloud, respectively. The input guarantees that for all $$$1 \leq i \lt j \leq n$$$, $$$\lvert x_i - x_j \rvert \geq l$$$.

Output one integer — the number of unordered pairs of clouds such that it's possible that clouds from each pair cover the moon at the same future moment with a proper choice of wind velocity $$$w$$$.

NoteIn the first example, the initial positions and velocities of clouds are illustrated below.  The pairs are:   $$$(1, 3)$$$, covering the moon at time $$$2.5$$$ with $$$w = -0.4$$$;  $$$(1, 4)$$$, covering the moon at time $$$3.5$$$ with $$$w = -0.6$$$;  $$$(1, 5)$$$, covering the moon at time $$$4.5$$$ with $$$w = -0.7$$$;  $$$(2, 5)$$$, covering the moon at time $$$2.5$$$ with $$$w = -2$$$. Below is the positions of clouds at time $$$2.5$$$ with $$$w = -0.4$$$. At this moment, the $$$1$$$-st and $$$3$$$-rd clouds both cover the moon.  In the second example, the only pair is $$$(1, 4)$$$, covering the moon at time $$$15$$$ with $$$w = 0$$$.Note that all the times and wind velocities given above are just examples among infinitely many choices.

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine, getContents)
import qualified Data.ByteString.Char8 as C (readInt, words, lines)
import qualified Data.Maybe as M (fromJust)
import qualified Data.Array.IArray as A (bounds, listArray, (!))
import qualified Data.Array.Unboxed as A (UArray)
import qualified Data.Int as I (Int64)
import qualified Data.List as L (sort)

readInt = fst . M.fromJust . C.readInt

main = do
    (map (fromIntegral . readInt) . C.words -> [_, l, w] :: [I.Int64]) <- B.getLine
    (map ((\[a, b] -> (a, b)) . map readInt . C.words) . C.lines -> xs) <- B.getContents
    let [ps, qs] = map (\q -> array [ fromIntegral a | (a, b) <- xs, b == q]) [1, -1]
        array xs = A.listArray (0, length xs - 1) (L.sort xs) :: A.UArray Int I.Int64
        test i j | j == -1 || xj + l <= xi = False
                 | xj <= xi = (xj + l > 0 && xi < 0) || abs (xj + l + xi) < (xj + l - xi) * w
                 | otherwise = (xi + xj < 0 && xi + xj + l + l > 0) || (xi + xj >= 0 && (xj + xi < (xj - xi) * w || xj + l + xi < (xj + l - xi) * w)) ||
                    (xi + xj + l + l <= 0 && (abs (xj + xi + l + l) < (xj - xi) * w || abs (xj + l + xi) < (xj + l - xi) * w)) where
            (xi, xj) = (ps A.! i, qs A.! j)
        bin i a b | b - a <= 1 = b | test i m = bin i a m | otherwise = bin i m b where m = (a + b) `div` 2
    print $ let n = snd (A.bounds qs) + 1 in sum [ fromIntegral (n - bin i (-1) n) | i <- [0..snd (A.bounds ps)] ] :: I.Int64

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine, getContents)
import qualified Data.ByteString.Char8 as C (readInt, words, lines)
import qualified Data.Maybe as M (fromJust)
import qualified Data.Array.IArray as A (bounds, listArray, (!))
import qualified Data.Array.Unboxed as A (UArray)
import qualified Data.Int as I (Int64)
import qualified Data.List as L (sort)

readInt = fst . M.fromJust . C.readInt

main = do
    (map (fromIntegral . readInt) . C.words -> [_, l, w] :: [I.Int64]) <- B.getLine
    (map ((\[a, b] -> (a, b)) . map readInt . C.words) . C.lines -> xs) <- B.getContents
    let [ps, qs] = map (\q -> array [ fromIntegral a | (a, b) <- xs, b == q]) [1, -1]
        array xs = A.listArray (0, length xs - 1) (L.sort xs) :: A.UArray Int I.Int64
        test i j | j == -1 || xj + l <= xi = False
                 | xj <= xi = (xj + l > 0 && xi < 0) || abs (xj + l + xi) < (xj + l - xi) * w
                 | otherwise = (xi + xj < 0 && xi + xj + l + l > 0) || (xi + xj >= 0 && (xj + xi < (xj - xi) * w || xj + l + xi < (xj + l - xi) * w)) ||
                    (xi + xj + l + l <= 0 && (abs (xj + xi + l + l) < (xj - xi) * w || abs (xj + l + xi) < (xj + l - xi) * w)) where
            (xi, xj) = (ps A.! i, qs A.! j)
        bin i a b | b - a <= 1 = b | test i m = bin i a m | otherwise = bin i m b where m = (a + b) `div` 2
    print $ let n = snd (A.bounds qs) + 1 in sum [ n - bin i (-1) n | i <- [0..snd (A.bounds ps)] ]


You are given a rectangular field of n × m cells. Each cell is either empty or impassable (contains an obstacle). Empty cells are marked with '.', impassable cells are marked with '*'. Let's call two empty cells adjacent if they share a side.Let's call a connected component any non-extendible set of cells such that any two of them are connected by the path of adjacent cells. It is a typical well-known definition of a connected component.For each impassable cell (x, y) imagine that it is an empty cell (all other cells remain unchanged) and find the size (the number of cells) of the connected component which contains (x, y). You should do it for each impassable cell independently.The answer should be printed as a matrix with n rows and m columns. The j-th symbol of the i-th row should be "." if the cell is empty at the start. Otherwise the j-th symbol of the i-th row should contain the only digit —- the answer modulo 10. The matrix should be printed without any spaces.To make your output faster it is recommended to build the output as an array of n strings having length m and print it as a sequence of lines. It will be much faster than writing character-by-character.As input/output can reach huge size it is recommended to use fast input/output methods: for example, prefer to use scanf/printf instead of cin/cout in C++, prefer to use BufferedReader/PrintWriter instead of Scanner/System.out in Java.

The first line contains two integers n, m (1 ≤ n, m ≤ 1000) — the number of rows and columns in the field. Each of the next n lines contains m symbols: "." for empty cells, "*" for impassable cells.

Print the answer as a matrix as described above. See the examples to precise the format of the output.

NoteIn first example, if we imagine that the central cell is empty then it will be included to component of size 5 (cross). If any of the corner cell will be empty then it will be included to component of size 3 (corner).

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Data.ByteString.Char8 (readInt, words, unpack, getLine, getContents, lines)
import Data.Array.IArray (accumArray, listArray, (!), elems)
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Control.Monad.ST.Safe (ST, runST)
import Data.List (nub)
import Data.Char (chr)
import Data.Maybe (fromJust)
import Prelude hiding (words, getLine, getContents, lines)

main = do
  [n, m] <- map (fst . fromJust . readInt) . words <$> getLine
  a' <- replicateM n (take m . unpack <$> getLine)

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

    cs = runSTUArray $ do
      cs <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)

      cr <- newSTRef 0

      forM_ ((,) <$> [1..n] <*> [1..m]) $ \p -> do
        c <- readArray cs p
        if c == 0
           then do
              modifySTRef cr (+1)
              c' <- readSTRef cr

              let
                fill p@(x, y)
                  | inside p && a ! p == '.' = do
                    c <- readArray cs p
                    if c == 0
                       then do
                        writeArray cs p c'
                        fill (x+1, y)
                        fill (x-1, y)
                        fill (x, y+1)
                        fill (x, y-1)
                      else return ()
                  | otherwise = return ()

              fill p
            else return ()

      return cs

    cnts = accumArray (+) 0 (0, n*m) $ map (\c -> (c, 1)) $ elems cs :: UArray Int Int

    ds = [(1, 0), (-1, 0), (0, 1), (0, -1)]
    inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m
    (x1, y1) +. (x2, y2) = (x1 + x2, y1 + y2)

    r :: [[Char]]
    r = [[f p | y <- [1..m], let p = (x, y)] | x <- [1..n]]
      where
        f p
          | a ! p == '.' = '.'
          | otherwise = chr (s + 48)
          where
            cs' :: [Int]
            cs' = map (cnts ! ) $ nub [cs ! p' | d <- ds, let p' = p +. d, inside p', a ! p' == '.']
            s :: Int
            s = foldr (\a b -> (a + b) `rem` 10) 1 cs'

  putStr $ unlines r

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Data.ByteString.Char8 (readInt, words, unpack, getLine)
import Data.Array.IArray (accumArray, listArray, (!), elems)
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Control.Monad.ST.Safe (ST, runST)
import Data.List (nub)
import Data.Char (chr)
import Data.Maybe (fromJust)
import Prelude hiding (words, getLine)

main = do
  [n, m] <- map (fst . fromJust . readInt) . words <$> getLine
  a' <- replicateM n getLine

  let
    a = listArray ((1, 1), (n, m)) $ concat $ map unpack a' :: UArray (Int, Int) Char

    cs = runSTUArray $ do
      cs <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)

      cr <- newSTRef 0

      forM_ ((,) <$> [1..n] <*> [1..m]) $ \p -> do
        c <- readArray cs p
        if c == 0
           then do
              modifySTRef cr (+1)
              c' <- readSTRef cr

              let
                fill p@(x, y)
                  | inside p && a ! p == '.' = do
                    c <- readArray cs p
                    if c == 0
                       then do
                        writeArray cs p c'
                        fill (x+1, y)
                        fill (x-1, y)
                        fill (x, y+1)
                        fill (x, y-1)
                      else return ()
                  | otherwise = return ()

              fill p
            else return ()

      return cs

    cnts = accumArray (+) 0 (0, n*m) $ map (\c -> (c, 1)) $ elems cs :: UArray Int Int

    ds = [(1, 0), (-1, 0), (0, 1), (0, -1)]
    inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m
    (x1, y1) +. (x2, y2) = (x1 + x2, y1 + y2)

    r :: [[Char]]
    r = [[f p | y <- [1..m], let p = (x, y)] | x <- [1..n]]
      where
        f p
          | a ! p == '.' = '.'
          | otherwise = chr (s + 48)
          where
            cs' :: [Int]
            cs' = map (cnts ! ) $ nub [cs ! p' | d <- ds, let p' = p +. d, inside p', a ! p' == '.']
            s :: Int
            s = foldr (\a b -> (a + b) `rem` 10) 1 cs'

  putStr $ unlines r


A robber has attempted to rob a bank but failed to complete his task. However, he had managed to open all the safes.Oleg the bank client loves money (who doesn't), and decides to take advantage of this failed robbery and steal some money from the safes. There are many safes arranged in a line, where the i-th safe from the left is called safe i. There are n banknotes left in all the safes in total. The i-th banknote is in safe xi. Oleg is now at safe a. There are two security guards, one of which guards the safe b such that b < a, i.e. the first guard is to the left of Oleg. The other guard guards the safe c so that c > a, i.e. he is to the right of Oleg.The two guards are very lazy, so they do not move. In every second, Oleg can either take all the banknotes from the current safe or move to any of the neighboring safes. However, he cannot visit any safe that is guarded by security guards at any time, becaues he might be charged for stealing. Determine the maximum amount of banknotes Oleg can gather.

The first line of input contains three space-separated integers, a, b and c (1 ≤ b < a < c ≤ 109), denoting the positions of Oleg, the first security guard and the second security guard, respectively. The next line of input contains a single integer n (1 ≤ n ≤ 105), denoting the number of banknotes. The next line of input contains n space-separated integers x1, x2, ..., xn (1 ≤ xi ≤ 109), denoting that the i-th banknote is located in the xi-th safe. Note that xi are not guaranteed to be distinct.

Output a single integer: the maximum number of banknotes Oleg can take.

NoteIn the first example Oleg can take the banknotes in positions 4, 5, 6 (note that there are 2 banknotes at position 5). Oleg can't take the banknotes in safes 7 and 8 because he can't run into the second security guard. Similarly, Oleg cannot take the banknotes at positions 3 and 2 because he can't run into the first security guard. Thus, he can take a maximum of 4 banknotes.For the second sample, Oleg can't take any banknotes without bumping into any of the security guards.

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

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

main = getInts >>= \[_, l, r] -> getLine >> getInts >>= print . length . filter (liftA2 (&&) (>l) (<r))

import Data.List

solve x b e = length ( filter (\y->(y>b) && (y<e)) x)

main=do
	d<-getLine
	let [_,b,e]=map (\x->read x::Integer) (words d)
	_<-getLine
	x<-getLine
	let dat = map (\x->read x::Integer) (words x)
	print (solve dat b e)

import Control.Applicative

solve :: [Int] -> Int -> Int -> Int
solve [] _ _ = 0
solve (x : xs) b c = r + (solve xs b c)
    where r = case x > b &&  x < c of
                True -> 1
                False -> 0

main :: IO ()
main = do
    [a, b, c] <- map (read :: String -> Int) . words <$> getLine
    n <- (read :: String -> Int) <$> getLine
    xis <- map (read :: String -> Int) . words <$> getLine
    putStrLn . show $ solve xis b c

import Control.Applicative( (<$>))
main = do
    [a_, b_, c_] <- map read . words <$> getLine
    n_ <- readLn::IO Int
    xs_ <- map (read::String->Int) . words <$> getLine
    print . length $ filter (\i->b_<i&&i<c_) xs_

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve a b c n xs = length $ filter (\x -> b < x && x < c) xs

main = do
  a:b:c:_ <- readInts <$> B.getLine
  n <- readInt <$> B.getLine
  xs <- readInts <$> B.getLine
  print $ solve a b c n xs

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

main = do
		[a,b,c]<- map read <$> words <$> getLine ::IO [Int]
		getLine
		d<- filter (<c) <$> filter (>b) <$> map read <$> words <$> getLine ::IO [Int]
		print $ length d


Welcome to Rockport City!It is time for your first ever race in the game against Ronnie. To make the race interesting, you have bet $$$a$$$ dollars and Ronnie has bet $$$b$$$ dollars. But the fans seem to be disappointed. The excitement of the fans is given by $$$gcd(a,b)$$$, where $$$gcd(x, y)$$$ denotes the greatest common divisor (GCD) of integers $$$x$$$ and $$$y$$$. To make the race more exciting, you can perform two types of operations:  Increase both $$$a$$$ and $$$b$$$ by $$$1$$$.  Decrease both $$$a$$$ and $$$b$$$ by $$$1$$$. This operation can only be performed if both $$$a$$$ and $$$b$$$ are greater than $$$0$$$. In one move, you can perform any one of these operations. You can perform arbitrary (possibly zero) number of moves. Determine the maximum excitement the fans can get and the minimum number of moves required to achieve it.Note that $$$gcd(x,0)=x$$$ for any $$$x \ge 0$$$.

The first line of input contains a single integer $$$t$$$ ($$$1\leq t\leq 5\cdot 10^3$$$) — the number of test cases. The first and the only line of each test case contains two integers $$$a$$$ and $$$b$$$ ($$$0\leq a, b\leq 10^{18}$$$).

For each test case, print a single line containing two integers.  If the fans can get infinite excitement, print 0 0. Otherwise, the first integer must be the maximum excitement the fans can get, and the second integer must be the minimum number of moves required to achieve that excitement.

NoteFor the first test case, you can apply the first operation $$$1$$$ time to get $$$a=9$$$ and $$$b=6$$$. It can be shown that $$$3$$$ is the maximum excitement possible.For the second test case, no matter how many operations you apply, the fans will always have an excitement equal to $$$1$$$. Since the initial excitement is also $$$1$$$, you don't need to apply any operation.For the third case, the fans can get infinite excitement by applying the first operation an infinite amount of times.For the fourth test case, you can apply the second operation $$$3$$$ times to get $$$a=0$$$ and $$$b=6$$$. Since, $$$gcd(0,6)=6$$$, the fans will get an excitement of $$$6$$$.

import Control.Monad
import Data.Int (Int64)

getInt :: IO Int
getInt = readLn

solve :: Int -> Int -> (Int, Int)
solve a b = (a - b, min p t)
    where k = a - b
          p = b `mod` k
          t = k - p

main :: IO ()
main = do
    test <- readLn :: IO Int
    replicateM_ test $ do
        [a, b] <- map read.words <$> getLine :: IO[Int]
        if a == b then putStrLn "0 0"
                  else do
                      let (res1, res2) = solve (max a b) (min a b)
                      putStrLn $ show res1 ++ " " ++ show res2

import Control.Monad
import Data.Int

getInt :: IO Int
getInt = readLn

solve :: Int -> Int -> (Int, Int)
solve a b = (a - b, min p t)
    where k = a - b
          p = b `mod` k
          t = k - p

main :: IO ()
main = do
    test <- getInt
    replicateM_ test $ do
        [a, b] <- map read.words <$> getLine :: IO[Int]
        if a == b then putStrLn "0 0"
                  else do
                      let (res1, res2) = solve (max a b) (min a b)
                      putStrLn $ show res1 ++ " " ++ show res2

import Control.Monad
import Data.Int

getInt :: IO Int
getInt = readLn

solve :: Int64 -> Int64 -> (Int64, Int64)
solve a b = (a - b, min p t)
    where k = a - b
          p = b `mod` k
          t = k - p

main :: IO ()
main = do
    test <- getInt
    replicateM_ test $ do
        [a, b] <- map read.words <$> getLine :: IO[Int64]
        if a == b then putStrLn "0 0"
                  else do
                      let (res1, res2) = solve (max a b) (min a b)
                      putStrLn $ show res1 ++ " " ++ show res2

module Main where
import Control.Monad ( replicateM )
main :: IO ()
main = do
    t <- read <$> getLine :: IO Int
    inp <- replicateM t $ do
        inpline <- getLine
        let spl = map read $ words inpline :: [Integer]
        return spl
    let solved = map ((\[a, b] -> show a ++ " " ++ show b) . solve) inp
    -- print inp
    traverse putStrLn solved
    return ()

solve :: [Integer] -> [Integer]
solve [a, b] =
    let
        ans1 = abs(a - b)
        frnt = (div a ans1 + 1) * ans1 - a
        back = (div a ans1) * ans1 - a
        ans2 = if ans1 == 0 then 0 else min (abs frnt) (abs back)
    in
        [ans1, ans2]

import Control.Monad (replicateM_)

readInts :: IO [Integer]
readInts = map read . words <$> getLine

solve :: Integer -> Integer -> (Integer, Integer)
solve x y = if x == y then (0, 0) else (d, min left right) where
  (a, b) = (max x y, min x y)
  d = a - b
  left = b `rem` d
  right = d - b `rem` d

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    [a, b] <- readInts
    let (exc, steps) = solve a b
    putStrLn $ show exc ++ " " ++ show steps

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
--import Data.Char as C
--import Data.IntSet as S

solve :: IO ()
solve = do
  s <- getLine
  let [x, y] = map read $ words s :: [Int64]
      (a, b) = (max x y, min x y)
      best = if a == b then 0 else a - b
      re = rem b (a-b)
      steps = if best == 0 then 0 else min re ((a-b) - re)
    in putStrLn $ show best ++ " " ++ show steps

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

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Integer]

printResult = do
    [a,b] <- readInts
    if a == b then putStrLn "0 0"
    else do
        let m = max a b
            n = min a b
            s = m - n
            d = div m s
            g = min (m-d*s) (d*s+s-m)
        putStrLn $ show s ++ " " ++ show g

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

import Control.Monad ( replicateM_ )
import Data.Int ( Int64 )

solve :: IO ()
solve = do
    [a, b] <- readMany :: IO [Int64]
    let d = abs (a - b)
        m = a `mod` d
    putStrLn $ if a == b then "0 0" else show d ++ " " ++ show (min m (d - m))

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

main :: IO ()
main = do
    t <- readLn :: IO Int
    replicateM_ t solve

module Main where
import Control.Monad ( replicateM )
main :: IO ()
main = do
    t <- read <$> getLine :: IO Int
    inp <- replicateM t $ do
        inpline <- getLine
        let spl = map read $ words inpline :: [Integer]
        return spl
    let solved = map ((\[a, b] -> show a ++ " " ++ show b) . solve) inp
    print inp
    print solved
    return ()

solve :: [Integer] -> [Integer]
solve [a, b] =
    let
        ans1 = abs(a - b)
        frnt = (div a ans1 + 1) * ans1 - a
        back = (div a ans1) * ans1 - a
        ans2 = if ans1 == 0 then 0 else min (abs frnt) (abs back)
    in
        [ans1, ans2]


At the children's day, the child came to Picks's house, and messed his house up. Picks was angry at him. A lot of important things were lost, in particular the favorite sequence of Picks.Fortunately, Picks remembers how to repair the sequence. Initially he should create an integer array a[1], a[2], ..., a[n]. Then he should perform a sequence of m operations. An operation can be one of the following:  Print operation l, r. Picks should write down the value of .  Modulo operation l, r, x. Picks should perform assignment a[i] = a[i] mod x for each i (l ≤ i ≤ r).  Set operation k, x. Picks should set the value of a[k] to x (in other words perform an assignment a[k] = x). Can you help Picks to perform the whole sequence of operations?

The first line of input contains two integer: n, m (1 ≤ n, m ≤ 105). The second line contains n integers, separated by space: a[1], a[2], ..., a[n] (1 ≤ a[i] ≤ 109) — initial value of array elements. Each of the next m lines begins with a number type .    If type = 1, there will be two integers more in the line: l, r (1 ≤ l ≤ r ≤ n), which correspond the operation 1.  If type = 2, there will be three integers more in the line: l, r, x (1 ≤ l ≤ r ≤ n; 1 ≤ x ≤ 109), which correspond the operation 2.  If type = 3, there will be two integers more in the line: k, x (1 ≤ k ≤ n; 1 ≤ x ≤ 109), which correspond the operation 3.

For each operation 1, please print a line containing the answer. Notice that the answer may exceed the 32-bit integer.

NoteConsider the first testcase:  At first, a = {1, 2, 3, 4, 5}.  After operation 1, a = {1, 2, 3, 0, 1}.  After operation 2, a = {1, 2, 5, 0, 1}.  At operation 3, 2 + 5 + 0 + 1 = 8.  After operation 4, a = {1, 2, 2, 0, 1}.  At operation 5, 1 + 2 + 2 = 5.

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as C
import           Data.IORef
import           Data.List
import           Data.Maybe            (mapMaybe)
import Data.Int

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

----

data SegTree a
  = Node !(SegTree a) !(SegTree a) !a
  | Leaf
  deriving (Show)

data Value
  = Value
    { valSum ::  {-# UNPACK #-} !Int64
    , valMax ::  {-# UNPACK #-} !Int64
    }
  deriving (Show)

build :: Int -> SegTree Value
build = go 0 where
  go l r
    | r - l == 1 = Node Leaf Leaf (Value 0 0)
    | otherwise = Node (go l ((l+r)`div`2) )(go ((l+r)`div`2) r) (Value 0 0)

query :: Int -> Int -> Int -> SegTree Value -> Int64
query from to = go 0 where
  go l r (Node cl cr v)
    | from <= l && r <= to = valSum v
    | r <= from || to <= l = 0
    | otherwise =
      go l ((l+r)`div`2) cl + go ((l+r)`div`2) r cr

update :: Int -> Int -> Int64 -> Int -> SegTree Value -> SegTree Value
update from to m = go 0 where
  go l r n@(Node cl cr v)
    | r <= from || to <= l = n
    | valMax v < m = n
    | r - l == 1 =
      Node Leaf Leaf (Value (valSum v `mod` m) (valSum v `mod` m))
    | otherwise =
      merge (go l ((l+r)`div`2) cl) (go ((l+r)`div`2) r cr)

set :: Int -> Int64 -> Int -> SegTree Value -> SegTree Value
set i k = go 0 where
  go l r n@(Node cl cr v)
    | l == i && r == i+1 =
      Node Leaf Leaf (Value k k)
    | l <= i && i < r =
      merge (go l ((l+r)`div`2) cl) (go ((l+r)`div`2) r cr)
    | otherwise = n

merge :: SegTree Value -> SegTree Value -> SegTree Value
merge cl@(Node _ _ v1) cr@(Node _ _ v2) =
  Node cl cr (Value (valSum v1 + valSum v2) (max (valMax v1) (valMax v2)))

main :: IO ()
main = do
  [n, m] <- getInts
  as <- getInts
  st <- newIORef $ foldl' (\st (ix, x) -> set ix x n st) (build n) $ zip [0..] $ map fromIntegral as
  replicateM_ m $ do
    qs <- getInts
    -- print =<< readIORef st
    case qs of
      [1, l, r] ->
        print . query (l-1) r n =<< readIORef st
      [2, l, r, x] ->
        modifyIORef' st $ update (l-1) r (fromIntegral x) n
      [3, i, k] ->
        modifyIORef' st $ set (i-1) (fromIntegral k) n

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as C
import           Data.IORef
import           Data.List
import           Data.Maybe            (mapMaybe)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

----

data SegTree a
  = Node (SegTree a) (SegTree a) a
  | Leaf
  deriving (Show)

data Value
  = Value
    { valSum :: Int
    , valMax :: Int
    }
  deriving (Show)

build :: Int -> SegTree Value
build = go 0 where
  go l r
    | r - l == 1 = Node Leaf Leaf (Value 0 0)
    | otherwise = Node (go l ((l+r)`div`2) )(go ((l+r)`div`2) r) (Value 0 0)

query :: Int -> Int -> Int -> SegTree Value -> Int
query from to = go 0 where
  go l r (Node cl cr v)
    | from <= l && r <= to = valSum v
    | r <= from || to <= l = 0
    | otherwise =
      go l ((l+r)`div`2) cl + go ((l+r)`div`2) r cr

update :: Int -> Int -> Int -> Int -> SegTree Value -> SegTree Value
update from to m = go 0 where
  go l r n@(Node cl cr v)
    | r <= from || to <= l = n
    | valMax v < m = n
    | r - l == 1 =
      Node Leaf Leaf (Value (valSum v `mod` m) (valSum v `mod` m))
    | otherwise =
      merge (go l ((l+r)`div`2) cl) (go ((l+r)`div`2) r cr)

set :: Int -> Int -> Int -> SegTree Value -> SegTree Value
set i k = go 0 where
  go l r n@(Node cl cr v)
    | l == i && r == i+1 =
      Node Leaf Leaf (Value k k)
    | l <= i && i < r =
      merge (go l ((l+r)`div`2) cl) (go ((l+r)`div`2) r cr)
    | otherwise = n

merge :: SegTree Value -> SegTree Value -> SegTree Value
merge cl@(Node _ _ v1) cr@(Node _ _ v2) =
  Node cl cr (Value (valSum v1 + valSum v2) (max (valMax v1) (valMax v2)))

main :: IO ()
main = do
  [n, m] <- getInts
  as <- getInts
  st <- newIORef $ foldl' (\st (ix, x) -> set ix x n st) (build n) $ zip [0..] as
  replicateM_ m $ do
    qs <- getInts
    -- print =<< readIORef st
    case qs of
      [1, l, r] ->
        print . query (l-1) r n =<< readIORef st
      [2, l, r, x] ->
        modifyIORef' st $ update (l-1) r x n
      [3, i, k] ->
        modifyIORef' st $ set (i-1) k n


$$$2^k$$$ teams participate in a playoff tournament. The tournament consists of $$$2^k - 1$$$ games. They are held as follows: first of all, the teams are split into pairs: team $$$1$$$ plays against team $$$2$$$, team $$$3$$$ plays against team $$$4$$$ (exactly in this order), and so on (so, $$$2^{k-1}$$$ games are played in that phase). When a team loses a game, it is eliminated, and each game results in elimination of one team (there are no ties). After that, only $$$2^{k-1}$$$ teams remain. If only one team remains, it is declared the champion; otherwise, $$$2^{k-2}$$$ games are played: in the first one of them, the winner of the game "$$$1$$$ vs $$$2$$$" plays against the winner of the game "$$$3$$$ vs $$$4$$$", then the winner of the game "$$$5$$$ vs $$$6$$$" plays against the winner of the game "$$$7$$$ vs $$$8$$$", and so on. This process repeats until only one team remains.After the tournament ends, the teams are assigned places according to the tournament phase when they were eliminated. In particular:  the winner of the tournament gets place $$$1$$$;  the team eliminated in the finals gets place $$$2$$$;  both teams eliminated in the semifinals get place $$$3$$$;  all teams eliminated in the quarterfinals get place $$$5$$$;  all teams eliminated in the 1/8 finals get place $$$9$$$, and so on. For example, this picture describes one of the possible ways the tournament can go with $$$k = 3$$$, and the resulting places of the teams:  After a tournament which was conducted by the aforementioned rules ended, its results were encoded in the following way. Let $$$p_i$$$ be the place of the $$$i$$$-th team in the tournament. The hash value of the tournament $$$h$$$ is calculated as $$$h = (\sum \limits_{i=1}^{2^k} i \cdot A^{p_i}) \bmod 998244353$$$, where $$$A$$$ is some given integer.Unfortunately, due to a system crash, almost all tournament-related data was lost. The only pieces of data that remain are the values of $$$k$$$, $$$A$$$ and $$$h$$$. You are asked to restore the resulting placing of the teams in the tournament, if it is possible at all.

If it is impossible to find any placing of the teams that is consistent with the data you have, print one integer $$$-1$$$. Otherwise, print $$$2^k$$$ integers, where $$$i$$$-th integer should be equal to $$$p_i$$$ (the place of the $$$i$$$-th team). Note that your answer should be consistent with one of the possible ways the tournament could go, and note that the initial structure of the tournament is fixed (for example, teams $$$1$$$ and $$$2$$$ always play in the first phase of the tournament against each other). If there are multiple ways to restore the places of the teams which are consistent with the data you have, print any of them.

NoteThe tournament for the first example is described in the statement.For the third example, the placing $$$[1, 2, 3, 3]$$$ (team $$$1$$$ gets place $$$1$$$, team $$$2$$$ gets place $$$2$$$, teams $$$3$$$ and $$$4$$$ get place $$$3$$$) could result in a hash value of $$$7020100$$$ with $$$A = 100$$$, but no tournament can result in such placing since teams $$$1$$$ and $$$2$$$ play against each other in the semifinals, so they cannot get two first places.

import Data.Array
import Data.Bits
import Data.Foldable
import Data.Int
import Data.List
import qualified Data.Map as M

m :: Int64
m = 998244353

mulmod :: Int64 -> Int64 -> Int64
mulmod a b = a * b `mod` m
infixl 7 `mulmod`

solve :: IO ()
solve = do
    [k, a', h] <- readMany
    let a = fromIntegral a' :: Int64
        n = 2^k
        n' = n `div` 2
        apw = listArray (0, n + 1) $ iterate (mulmod a) 1
        hash ips = sum [fromIntegral i `mulmod` apw!p | (i, p) <- ips] `mod` m
        winlose b x y = if b then (x, y) else (y, x)
        pairs = flip go 0 where
            go [] _ = []
            go ~(x0:x1:xs) i = (i, x0, x1) : go xs (i + 1)

        genhashes :: Int -> Int -> (Int64, [(Int, Int)])
        genhashes l msk = (hash ips, reverse ips) where
            ips = go msk [l .. l + n' - 1]
            go _ [x] = [(x, 2)]
            go msk xs = ips ++ go (msk `shiftR` len) xs' where
                rs = [winlose (msk `testBit` i) x y | (i, x, y) <- pairs xs]
                len = length rs
                xs' = map fst rs
                ips = zip (map snd rs) $ repeat $ 2 * len + 1

        test mp0 mp1 =
            [ (ips'++) <$> mp1 M.!? h1
            | (h0, (w, 2):ips) <- M.assocs mp0
            , let h1 = (h - h0 - fromIntegral w * (apw!1 - apw!2)) `mod` m
                  ips' = (w, 1):ips
            ]

        [mp0, mp1] = M.fromList . (<$> [0 .. 2^(n'-1)-1]) . genhashes <$> [1, n' + 1]

    putStrLn $ maybe "-1" (unwords . map (show . snd) . sort) $ asum (test mp0 mp1 ++ test mp1 mp0)

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

main :: IO ()
main = solve


ВКонтакте открыла второй штаб в Санкт-Петербурге! Вы не преминули возможностью сменить обстановку и решили переехать из офиса в Доме Зингера в офис на Красном мосту.Для комфортной работы вам потребуются два монитора с одинаковой высотой, чтобы изображение на них выглядело единым целым. На складе офиса на Красном мосту есть $$$n$$$ мониторов, $$$i$$$-й из них имеет ширину $$$w_i$$$ и высоту $$$h_i$$$. Любой монитор можно повернуть на 90 градусов, и тогда он будет иметь ширину $$$h_i$$$ и высоту $$$w_i$$$.Назовём неупорядоченную пару из двух различных мониторов подходящей, если можно их повернуть так, чтобы они имели одинаковую высоту. Любой из мониторов в паре можно как повернуть относительно исходной ориентации, так и не поворачивать.Подсчитайте подходящие пары мониторов.

В первой строке задано одно целое число $$$n$$$ — число мониторов на складе. В каждой из следующих $$$n$$$ строк заданы два целых числа $$$w_i$$$ и $$$h_i$$$ ($$$1 \le w_i, h_i \le 10^9$$$) — ширина и высота $$$i$$$-го монитора. Обратите внимание, что мониторы могут быть квадратными ($$$w_i = h_i$$$), а размеры разных мониторов могут совпадать. В этой версии задачи $$$2 \le n \le 10^3$$$.

Выведите число подходящих пар мониторов.

ПримечаниеВ первом примере подходящими являются пары мониторов с номерами $$$(1, 2)$$$, $$$(1, 4)$$$, $$$(1, 5)$$$, $$$(3, 4)$$$, $$$(4, 5)$$$.Во втором примере все пары мониторов — подходящие.

import Data.Map (Map, insertWith, empty, toList)

first2 l = (head l, head $ tail l)

getPair :: IO (Int, Int)
getPair = do
    s <- getLine
    let res = map read $ words s
    return $ first2 res

count l (a, b) = foldl check (-1) l
    where check i (x, y) = if x == a || x == b || y == a || y == b
                            then i + 1
                            else i

combination n = n * (n - 1) `div` 2

allPairs m (a, b) | a == b    = insertWith (+) a 1 m
                  | otherwise = insertWith (+) a 1 $ insertWith (+) b 1 m

extraPairs m (a, b) | a < b     = insertWith (+) (a, b) 1 m
                    | a > b     = insertWith (+) (b, a) 1 m
                    | otherwise = m

solution l = (sum $ map (combination . snd) $ toList $ foldl allPairs empty l) -
             (sum $ map (combination . snd) $ toList $ foldl extraPairs empty l)

main = do
    n <- fmap read getLine
    mon <- sequence (replicate n getPair)
    putStr $ show $ solution mon

first2 l = (head l, head $ tail l)

getPair :: IO (Int, Int)
getPair = do
    s <- getLine
    let res = map read $ words s
    return $ first2 res

count :: [(Int, Int)] -> (Int, Int) -> Int
count l (a, b) = foldl check (-1) l
    where check i (x, y) = if x == a || x == b || y == a || y == b
                            then i + 1
                            else i
main = do
    n <- fmap read getLine
    mon <- sequence (replicate n getPair)
    putStr $ show $ (sum $ map (count mon) mon) `div` 2

import Data.Map (Map, insertWith, empty, toList)

first2 l = (head l, head $ tail l)

getPair :: IO (Int, Int)
getPair = do
    s <- getLine
    let res = map read $ words s
    return $ first2 res

count :: [(Int, Int)] -> (Int, Int) -> Int
count l (a, b) = foldl check (-1) l
    where check i (x, y) = if x == a || x == b || y == a || y == b
                            then i + 1
                            else i

combination n = n * (n - 1) `div` 2

allPairs m (a, b) | a == b    = insertWith (+) a 1 m
                  | otherwise = insertWith (+) a 1 $ insertWith (+) b 1 m

extraPairs m (a, b) | a < b     = insertWith (+) (a, b) 1 m
                    | a > b     = insertWith (+) (b, a) 1 m
                    | otherwise = m

solution :: [(Int, Int)] -> Int
solution l = (sum $ map (combination . snd) $ toList $ foldl allPairs empty l) -
             (sum $ map (combination . snd) $ toList $ foldl extraPairs empty l)

main = do
    n <- fmap read getLine
    mon <- sequence (replicate n getPair)
    putStr $ show $ solution mon


One day Prof. Slim decided to leave the kingdom of the GUC to join the kingdom of the GIU. He was given an easy online assessment to solve before joining the GIU. Citizens of the GUC were happy sad to see the prof leaving, so they decided to hack into the system and change the online assessment into a harder one so that he stays at the GUC. After a long argument, they decided to change it into the following problem.Given an array of $$$n$$$ integers $$$a_1,a_2,\ldots,a_n$$$, where $$$a_{i} \neq 0$$$, check if you can make this array sorted by using the following operation any number of times (possibly zero). An array is sorted if its elements are arranged in a non-decreasing order.  select two indices $$$i$$$ and $$$j$$$ ($$$1 \le i,j \le n$$$) such that $$$a_i$$$ and $$$a_j$$$ have different signs. In other words, one must be positive and one must be negative.  swap the signs of $$$a_{i}$$$ and $$$a_{j}$$$. For example if you select $$$a_i=3$$$ and $$$a_j=-2$$$, then they will change to $$$a_i=-3$$$ and $$$a_j=2$$$. Prof. Slim saw that the problem is still too easy and isn't worth his time, so he decided to give it to you to solve.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^{5}$$$) — the length of the array $$$a$$$. The next line contain $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$-10^9 \le a_{i} \le 10^9$$$, $$$a_{i} \neq 0$$$) separated by spaces describing elements of the array $$$a$$$.  It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$10^5$$$.

For each test case, print "YES" if the array can be sorted in the non-decreasing order, otherwise print "NO". You can print each letter in any case (upper or lower).

NoteIn the first test case, there is no way to make the array sorted using the operation any number of times.In the second test case, the array is already sorted.In the third test case, we can swap the sign of the $$$1$$$-st element with the sign of the $$$5$$$-th element, and the sign of the $$$3$$$-rd element with the sign of the $$$6$$$-th element, this way the array will be sorted.In the fourth test case, there is no way to make the array sorted using the operation any number of times.

import Control.Monad

isSorted :: Ord a => [a] -> Bool
isSorted (h1:h2:t) = (h1 <= h2) && isSorted (h2:t)
isSorted _ = True

solve :: [Int] -> Bool
solve ints = isSorted (negativeInts ++ positiveInts)
    where negativeCount = length $ filter (<0) ints
          negativeInts = map (\x -> - (abs x)) $ take negativeCount $ ints
          positiveInts = map abs $ drop negativeCount $ ints

readInt :: String -> Int
readInt = read

showBool :: Bool -> String
showBool True = "YES"
showBool False = "NO"

testCaseMain :: IO ()
testCaseMain = do _ <- getLine
                  line <- getLine
                  putStrLn . showBool . solve . map readInt . words $ line

main :: IO ()
main = do t <- (readLn :: IO Int)
          forM_ [1..t] (\_ -> testCaseMain)

check :: Int -> [Int] -> Bool
check _ [] = True
check _ (_: []) = True
check i (x: y: xs)
  | i == 1 = check 0 (y: xs)
  | i > 1  = if x < y
    then False
    else check (i - 1) (y: xs)
  | i == 0 = if x > y
    then False
    else check 0 (y: xs)

absA :: [Int] -> (Int, [Int])
absA [] = (0, [])
absA (x: xs) = let (c, ys) = absA xs in if x > 0
  then (c, (x: ys))
  else (c + 1, (-x: ys))

for :: Int -> IO ()
for 0 = pure ()
for i = do
  _ <- readLn :: IO Int
  arr <- (map (\s -> read s :: Int)) <$> (words <$> getLine)
  let (c, x) = absA arr
  if check c x
    then putStrLn "YES"
    else putStrLn "NO"
  for $ i - 1

main :: IO ()
main = do
  t <- readLn :: IO Int
  for t


The bear has a string s = s1s2... s|s| (record |s| is the string's length), consisting of lowercase English letters. The bear wants to count the number of such pairs of indices i, j (1 ≤ i ≤ j ≤ |s|), that string x(i, j) = sisi + 1... sj contains at least one string "bear" as a substring.String x(i, j) contains string "bear", if there is such index k (i ≤ k ≤ j - 3), that sk = b, sk + 1 = e, sk + 2 = a, sk + 3 = r.Help the bear cope with the given problem.

The first line contains a non-empty string s (1 ≤ |s| ≤ 5000). It is guaranteed that the string only consists of lowercase English letters.

Print a single number — the answer to the problem.

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
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 System.IO
-- import Debug.Trace

-- getInts = fmap (map read . words) getLine
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  s <- getLine

  let
    f s = case findIndex (isPrefixOf "bear") (tails s) of
            Just i -> length s - (i+4) + 1
            Nothing -> 0

      where
  print $ sum $ map f $ tails s

import Data.Sequence as S
import Data.Foldable as F
main = getLine >>= print . fst . F.foldl f (0, 1) .
  S.tails . S.fromList
g :: Seq Char -> Int -> Seq Char -> Bool
g c n d
  | n >= 4 = True
  | n >= S.length c = False
  | otherwise = index c n == index d n && g c (n + 1) d
f :: (Int, Int) -> Seq Char -> (Int, Int)
f (a, b) c
  | g c 0 (fromList "bear") = (a + b * (S.length c - 3), 1)
  | otherwise = (a, b + 1)

main = getLine >>= print . (\x -> f 1 (length x) x)
f _ l _ | l < 4 = 0
f n l (a:b:c:d:s)
  | [a,b,c,d] == "bear" = n * (l - 3) + f 1 (l - 1) (b:c:d:s)
  | otherwise = f (n + 1) (l - 1) (b:c:d:s)

import Data.Sequence as S
import Data.Foldable as F
main = getLine >>= print . fst . F.foldl f (0, 1) . tails . fromList
g c n d
  | n >= 4 = True
  | n >= S.length c = False
  | otherwise = index c n == index d n && g c (n + 1) d
f (a, b) c
  | g c 0 (fromList "bear") = (a + b * (S.length c - 3), 1)
  | otherwise = (a, b + 1)

main = do
    str <- getLine
    let l = length str
    let n = countBear str
    print $ res n l

    where
        countBear s = countBear' s 1
        countBear' p@(_:xs) acc = if isBear p then acc:(countBear' xs $ acc + 1) else countBear' xs $ acc + 1
        countBear' _ _ = []
        isBear (x1:x2:x3:x4:_) = x1 == 'b' && x2 == 'e' && x3 == 'a' && x4 == 'r'
        isBear _ = False
        res (x:xs@(y:_)) ls = (res xs ls) + (x * (y - x))
        res (x:[]) ls = x * (ls - x - 2)
        res _ _ = 0

import Data.Functor ((<$>))
import Data.List (tails)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = print =<< solve <$> getLine

solve :: String -> Int
solve xs = sum [ fromMaybe 0 $ ((length xs - 3)-) <$> listToMaybe (filter (>=i) bearIndices) | (i, _) <- zip [0..] xs ]
  where bearIndices = [ i | (i, ys) <- zip [0..] (tails xs), take 4 ys == "bear" ]

import Data.Functor ((<$>))
import Data.List (inits, tails)

main :: IO ()
main = print =<< solve <$> getLine

solve :: String -> Int
solve xs = length [ ys | ys <- concatMap inits $ tails xs, ys `contains` "bear" ]

contains :: Eq a => [a] -> [a] -> Bool
contains (x:xs) yys@(y:ys) = x == y && xs `contains` ys || xs `contains` yys
contains [] (_:_) = False
contains _ [] = True


You are given a sorted array $$$a_1, a_2, \dots, a_n$$$ (for each index $$$i > 1$$$ condition $$$a_i \ge a_{i-1}$$$ holds) and an integer $$$k$$$.You are asked to divide this array into $$$k$$$ non-empty consecutive subarrays. Every element in the array should be included in exactly one subarray. Let $$$max(i)$$$ be equal to the maximum in the $$$i$$$-th subarray, and $$$min(i)$$$ be equal to the minimum in the $$$i$$$-th subarray. The cost of division is equal to $$$\sum\limits_{i=1}^{k} (max(i) - min(i))$$$. For example, if $$$a = [2, 4, 5, 5, 8, 11, 19]$$$ and we divide it into $$$3$$$ subarrays in the following way: $$$[2, 4], [5, 5], [8, 11, 19]$$$, then the cost of division is equal to $$$(4 - 2) + (5 - 5) + (19 - 8) = 13$$$.Calculate the minimum cost you can obtain by dividing the array $$$a$$$ into $$$k$$$ non-empty consecutive subarrays.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 3 \cdot 10^5$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$ 1 \le a_i \le 10^9$$$, $$$a_i \ge a_{i-1}$$$).

Print the minimum cost you can obtain by dividing the array $$$a$$$ into $$$k$$$ nonempty consecutive subarrays.

NoteIn the first test we can divide array $$$a$$$ in the following way: $$$[4, 8, 15, 16], [23], [42]$$$.

import Data.Char
import System.IO
import Data.List
import Data.Maybe

-- reading functions

strToIntList :: String -> [Int]
strToIntList xs = map toInt (split xs ' ')

toInt :: String -> Int
toInt [] = 0
toInt (x:xs) = (digitToInt x) * 10^(length xs)  + toInt xs

-- first :: String -> Char -> String

split :: String -> Char -> [String]
split [] _ = []
split xs c = (first xs c) : split (rest xs c) c where
                            first [] c = []
                            first (x:xs) c| x==c = []
                                            | otherwise = x : first xs c
                            rest [] c = []
                            rest (x:xs) c| x==c = xs
                                         | otherwise = rest xs c

-- solving functions

subtract_list :: Num a => [a] -> [a] -> [a]
subtract_list xs [] = xs
subtract_list [] (y:ys) = -y: subtract_list [] ys
subtract_list (x:xs) (y:ys) = (x-y): subtract_list xs ys

diffs :: Num a=> [a] -> [a]
diffs xs = init (subtract_list (tail xs) xs)

-- todo for each problem
solve :: Int -> [Int] -> Int
solve 1 xs = last xs - head xs
solve n xs = solve 1 xs - (sum . (take (n-1)) . reverse . sort . diffs) xs

-- reads a 2 lines: 1st: n, 2nd: list of Ints
-- applies solve on the list and outputs the result
solveNf :: Int -> Handle -> IO ()
solveNf 0 h = return ()
solveNf n h =  do
                nk <- hGetLine h
                t  <- hGetLine h
                (putStrLn . show) (solve ((strToIntList nk)!!1) (strToIntList t))
                solveNf (n-1) h

main :: IO ()
main = do
            -- h <- openFile "C.in" ReadMode
            solveNf 1 stdin
            -- hClose h
            return ()

import Data.List

jumpListOf :: [Int] -> [Int]
jumpListOf xs = zipWith (-) (tail xs) xs

solve :: [Int] -> Int -> Int
solve xs k = (sum . drop (k-1) . reverse . sort . jumpListOf) xs

main = do
 n_k <- map (read :: String -> Int) . words <$> getLine
 array_values <- map (read :: String -> Int) . words <$> getLine
 print $ solve array_values (n_k !! 1)

{-# OPTIONS_GHC -O2 #-}

import Data.Char (ord)
import Data.List (sortOn)
import Data.Ord (Down (Down))

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0
parseInts = fmap parseInt . words

main = do
  [n, k] <- fmap parseInts getLine
  a <- fmap parseInts getLine
  let b = sortOn Down (zipWith (-) (tail a) a)
      m = last a - head a
  print (m - sum (take (k - 1) b))


There is a pyramid which consists of $$$n$$$ floors. The floors are numbered from top to bottom in increasing order. In the pyramid, the $$$i$$$-th floor consists of $$$i$$$ rooms.Denote the $$$j$$$-th room on the $$$i$$$-th floor as $$$(i,j)$$$. For all positive integers $$$i$$$ and $$$j$$$ such that $$$1 \le j \le i < n$$$, there are $$$2$$$ one-way staircases which lead from $$$(i,j)$$$ to $$$(i+1,j)$$$ and from $$$(i,j)$$$ to $$$(i+1,j+1)$$$ respectively.In each room you can either put a torch or leave it empty. Define the brightness of a room $$$(i, j)$$$ to be the number of rooms with a torch from which you can reach the room $$$(i, j)$$$ through a non-negative number of staircases.For example, when $$$n=5$$$ and torches are placed in the rooms $$$(1,1)$$$, $$$(2,1)$$$, $$$(3,2)$$$, $$$(4,1)$$$, $$$(4,3)$$$, and $$$(5,3)$$$, the pyramid can be illustrated as follows:  In the above picture, rooms with torches are colored in yellow, and empty rooms are white. The blue numbers in the bottom-right corner indicate the brightness of the rooms.The room $$$(4,2)$$$ (the room with a star) has brightness $$$3$$$. In the picture below, the rooms from where you can reach $$$(4,2)$$$ have red border. The brightness is $$$3$$$ since there are three torches among these rooms.  The pyramid is called nice if and only if for all floors, all rooms in the floor have the same brightness.Define the brilliance of a nice pyramid to be the sum of brightness over the rooms $$$(1,1)$$$, $$$(2,1)$$$, $$$(3,1)$$$, ..., $$$(n,1)$$$.Find an arrangement of torches in the pyramid, such that the resulting pyramid is nice and its brilliance is maximized.We can show that an answer always exists. If there are multiple answers, output any one of them.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The description of the test cases follows. The only line of each test case contains a single positive integer $$$n$$$ ($$$1 \le n \le 500$$$) — the number of floors in the pyramid. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$500$$$.

For each test case, output $$$n$$$ lines, the arrangement of torches in the pyramid. The $$$i$$$-th line should contain $$$i$$$ integers, each separated with a space. The $$$j$$$-th integer on the $$$i$$$-th line should be $$$1$$$ if room $$$(i,j)$$$ has a torch, and $$$0$$$ otherwise. We can show that an answer always exists. If there are multiple answers, output any one of them.

NoteIn the third test case, torches are placed in $$$(1,1)$$$, $$$(2,1)$$$, $$$(2,2)$$$, $$$(3,1)$$$, and $$$(3,3)$$$.  The pyramid is nice as rooms on each floor have the same brightness. For example, all rooms on the third floor have brightness $$$3$$$.The brilliance of the pyramid is $$$1+2+3 = 6$$$. It can be shown that no arrangements with $$$n=3$$$ will have a greater brilliance.

--
-- 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-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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
        [n] <- ri
        return n
    mapM_ (putStr.showAns.solve) tcs

showAns = unlines . map (unwords . map show)

solve n = map genRow [1..n]

genRow 1 = [1::Int]
genRow i = 1 : replicate (i-2) 0 ++ [1]

import qualified Data.List as List
import qualified Data.Map as Map

readInt x = read x :: Int
readInteger x = read x :: Integer
readDouble x = read x :: Double

lightRooms n = [ if x == 1 || x == n then 1 else 0 | x <- [1..n] ]
makeRooms lvl = [ lightRooms x | x <- [1..lvl] ]

showRooms (x:xlst) = show x ++ " " ++ showRooms xlst
showRooms [] = ""

showLevels (x:xlst) = showRooms x ++ "\n" ++ showLevels xlst
showLevels [] = ""

solve 0 = return ()
solve tc = do
    solve (tc-1)
    in1 <- getLine
    let n = readInt in1
    putStr (showLevels $ makeRooms n)

main = do
    in1 <- getLine
    let tc = readInt in1
    solve tc

import Control.Monad (replicateM_)

bnb :: Int -> [[Int]]
bnb 1         = [[1]]
bnb level_num = (new_level :) $ bnb $ level_num - 1
  where
    new_level = 1 : replicate (level_num - 2) 0 ++ [1]

solveCase :: IO ()
solveCase = do
    level_num <- readLn :: IO Int
    mapM_ (putStrLn . unwords . map show) $
      reverse $
        bnb level_num

main :: IO ()
main = do
    test_case_num <- readLn :: IO Int
    replicateM_ test_case_num solveCase

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= printTorches

printTorches :: Int -> IO ()
printTorches 1 = print 1
printTorches 2 = printTorches 1 >> putStrLn "1 1"
printTorches n = printTorches (n-1) >>
                 putStr "1 " >> replicateM_ (n-2) (putStr "0 ") >> putStrLn "1"

--
-- 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-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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
        [n] <- ri
        return n
    mapM_ (putStrLn.show.solve) tcs

solve n = map (splitFor n) finiteBS
  where
    bitSeq = map (toBin numBits) $ nums
    numBits = (1 + n) * n `div` 2
    finiteBS = head bitSeq : takeWhile (/= head bitSeq) (tail bitSeq)

nums = [0..] :: [Integer]

toBin w x = map (b2c . testBit x) $ [w-1,w-2..0]

b2c False = '0'
b2c True  = '1'

splitFor = f 1
  where
    f _ 0 [] = []
    f _ 0 bs = error $ "Logic 1 splitFor : bs=" ++ show bs
    f _ _ [] = error "Logic 2 splitFor"
    f w n bs = xs : f (w+1) (n-1) ys
      where
        (xs,ys) = splitAt w bs

--
-- 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-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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
        [n] <- ri
        return n
    mapM_ (putStr.showAns.solve) tcs

showAns = unlines . map (unwords . map show)

solve n = map (genRow n) [1..n]

genRow n i | (i == 1 || i == n-1)  = fillWith 1
           | (i >  2 && i == n  )  = mixed
           | (          i == n  )  = fillWith 1
           | otherwise             = fillWith 0
  where
    fillWith x = replicate i (x::Int)
    mixed = 1 : replicate (i-2) 0 ++ [1]

--
-- 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-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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
        [n] <- ri
        return n
    mapM_ (putStr.showAns.solve) tcs

showAns = unlines . map (unwords . map show)

solve n = map (genRow n) [1..n]

genRow n i | (i == 1 || i == n-1)  = fillWith 1
           | (i >  2 && i == n  )  = mixed
           | (          i == n  )  = fillWith 1
           | otherwise             = fillWith 0
  where
    fillWith x = replicate i (x::Int)
    mixed = take i . cycle $ [1,0]


Vasya has got three integers $$$n$$$, $$$m$$$ and $$$k$$$. He'd like to find three integer points $$$(x_1, y_1)$$$, $$$(x_2, y_2)$$$, $$$(x_3, y_3)$$$, such that $$$0 \le x_1, x_2, x_3 \le n$$$, $$$0 \le y_1, y_2, y_3 \le m$$$ and the area of the triangle formed by these points is equal to $$$\frac{nm}{k}$$$.Help Vasya! Find such points (if it's possible). If there are multiple solutions, print any of them.

If there are no such points, print "NO". Otherwise print "YES" in the first line. The next three lines should contain integers $$$x_i, y_i$$$ — coordinates of the points, one point per line. If there are multiple solutions, print any of them. You can print each letter in any case (upper or lower).

NoteIn the first example area of the triangle should be equal to $$$\frac{nm}{k} = 4$$$. The triangle mentioned in the output is pictured below:   In the second example there is no triangle with area $$$\frac{nm}{k} = \frac{16}{7}$$$.

{-# LANGUAGE MultiWayIf #-}

import Control.Applicative
import Data.Ratio
import Text.Printf

main = do
  [n,m,k] <- map read . words <$> getLine :: IO [Integer]

  let
    area = (n*m) % k
    d = denominator area

  if
    | d<=2 -> do
        let
          m' = m `div` (gcd m k)
          k' = k `div` (gcd m k)
          n' = n `div` (gcd n k')
        printf "YES\n"
        mapM_ (\(x,y) -> printf "%d %d\n" x y) $
          case d of
            1 -> if m' < m then [(0,0),(n',0),(0,2*m')] else [(0,0),(2*n',0),(0,m')]
            2 -> if m' < m then [(0,0),(n',0),(0,m')] else [(0,0),(n',0),(0,m')]
    | otherwise -> printf "NO\n"

doit :: [Integer] -> Maybe [[Integer]]
doit [n, m, k]
  | (2*n*m) `mod` k /= 0 = Nothing
  | otherwise = let g = gcd n k
                    a = n `div` g
                    b = (2*g*m) `div` k
                in if b <= m then Just [[0, 0], [a, 0], [0, b]]
                   else Just [[0, 0], [2*a, 0], [0, b `div` 2]]

doit' :: [Integer] -> String
doit' x = case doit x of
  Nothing -> "NO\n"
  Just s -> unlines $ "YES" : map (unwords . map show) s

main :: IO ()
main = fmap (map read . words) getLine >>= putStr . doit'