Pavel loves grid mazes. A grid maze is an n × m rectangle maze where each cell is either empty, or is a wall. You can go from one cell to another only if both cells are empty and have a common side.Pavel drew a grid maze with all empty cells forming a connected area. That is, you can go from any empty cell to any other one. Pavel doesn't like it when his maze has too little walls. He wants to turn exactly k empty cells into walls so that all the remaining cells still formed a connected area. Help him.

The first line contains three integers n, m, k (1 ≤ n, m ≤ 500, 0 ≤ k < s), where n and m are the maze's height and width, correspondingly, k is the number of walls Pavel wants to add and letter s represents the number of empty cells in the original maze. Each of the next n lines contains m characters. They describe the original maze. If a character on a line equals ".", then the corresponding cell is empty and if the character equals "#", then the cell is a wall.

Print n lines containing m characters each: the new maze that fits Pavel's requirements. Mark the empty cells that you transformed into walls as "X", the other cells must be left without changes (that is, "." and "#"). It is guaranteed that a solution exists. If there are multiple solutions you can output any of them.

{-# LANGUAGE TupleSections #-}
import           Data.Array
import qualified Data.Set

-- https://hackage.haskell.org/package/split-0.2.3.4/docs/src/Data.List.Split.Internals.html#chunksOf
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g = g (:) []

chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls))  where
    splitter :: [e] -> ([e] -> a -> a) -> a -> a
    splitter [] _ n = n
    splitter l  c n = l `c` splitter (drop i l) c n

parseMaze :: Int -> Int -> String -> Array (Int, Int) Char
parseMaze h w s = listArray ((1, 1), (h, w)) (filter (/= '\n') s)

printMaze :: Int -> Int -> Array (Int, Int) Char -> String
printMaze h w m = unlines $ chunksOf w $ elems m

findStart m = fst $ head $ filter (\x -> snd x == '.') $ assocs m

dfs :: Int -> Int -> Array (Int, Int) Char -> [(Int, Int)]
dfs h w maze =
    let (starty, startx) = findStart maze :: (Int, Int)
    in  dfs' [(starty, startx)] [] Data.Set.empty
  where
    dfs' [] traversal _ = traversal
    dfs' ((y, x) : toVisit) traversal visited =
        let traversal' = (y, x):traversal
            neighbors =
                    [ (yy, xx)
                    | (dy, dx) <- [(-1, 0), (1, 0), (0, -1), (0, 1)]
                    , let (yy, xx) = (y + dy, x + dx)
                    , 1 <= yy && yy <= h
                    , 1 <= xx && xx <= w
                    , maze ! (yy, xx) == '.'
                    , (yy, xx) `Data.Set.notMember` visited
                    ]
            toVisit' = neighbors ++ toVisit
            visited' = Data.Set.union visited (Data.Set.fromList neighbors)
        in  dfs' toVisit' traversal' visited'

main = do
    --let first = "500 500 249999" -- XXX
    --let rest = unlines $ replicate 500 (replicate 500 '.')
    first <- getLine
    rest <- getContents

    let [h, w, k] = (map read . words) first
    let maze  = parseMaze h w rest
    let topo  = dfs h w maze
    let maze' = maze // map (, 'X') (take k topo)
    putStrLn (printMaze h w maze')

import Data.Graph
import Data.Set
main = interact $ f . Prelude.map words . lines

g x r c s1 = zip (repeat x) $ Prelude.filter (\i-> member i s1) $ concat [c1, c2, c3, c4]
  where c1 = if (quot x c) == quot (x-1) c then [x-1] else []
        c2 = if (quot x c) == quot (x+1) c then [x+1] else []
        c3 = if x-c >= 0 then [x-c] else []
        c4 = if x+c <= (r*c-1) then [x+c] else []

splitEvery _ [] = []
splitEvery n xs = as : splitEvery n bs
  where (as,bs) = Prelude.splitAt n xs

f (x:xs) = ans
  where (r:c:conn:_) = Prelude.map read x
        ccxs = concat (concat xs)
        mat = [i | (i, v) <- zip ([0..(r*c-1)]) ccxs, v=='.']
        s1 = fromList mat
        e = concat $ Prelude.map (\i -> g i r c s1) mat
        tvl = Prelude.filter (\i -> member i s1) $ topSort (buildG (0, r*c-1) e)
        doors = fromList $ Prelude.drop ((length mat)-conn) tvl
        insertdoor (i,k) = if (member i doors) && k=='.' then 'X' else k
        ans = unlines $ splitEvery c $ Prelude.map insertdoor $ zip [0..] ccxs

import Data.Array
import Control.Monad
import Data.Graph
import Data.Tree
main = do
  [n,m,k] <- map read . words <$> getLine
  g0 <- listArray ((1,1),(n,m)) . concat . lines <$> getContents
  let neighbors (i,j) = filter ((== '.') . (g0!)) $
                        filter (inRange (bounds g0))
                        [(i-1,j),(i+1,j),(i,j-1),(i,j+1)]
      (g,v2n,k2v) = graphFromEdges $ map (\p -> (p,p,neighbors p)) $
                                     filter ((== '.') . (g0!)) (indices g0)
      [f] = dff g
      g' = g0 // take k (foldTree h f [])
      h a bs = foldr (.) ((p,'X') :) bs where (p,_,_) = v2n a
  forM_ [1..n] $ \i -> do
    forM_ [1..m] $ \j -> putChar $ g' ! (i,j)
    putChar '\n'

import Control.Applicative
import Data.List as L
import Data.Tuple
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S

data Cell = Cell {row::Int,col::Int} deriving (Show,Eq,Ord)

main = do
    [n,m,k] <- map read <$> words <$> getLine :: IO[Int]
    lab <- M.fromList <$> foldl1' (++) <$>
          map (\(row,list) -> map (\(col,e) -> (Cell row col,e)) $ zip [0..] list  ) <$>
          zip [0..] <$> lines <$> getContents
    let solution n m k lab = let
            walk::[(Int,Cell)] -> S.Set Cell -> S.Set Cell -> [Cell]-> Int -> [(Int,Cell)]
            walk levels prev cur strip level = let
                visited = S.union prev cur
                neighbours = do
                    original <- strip
                    t        <- [(-1,0),(1,0)]
                    (i,j)    <- [t,swap t]
                    let x = row original + i
                        y = col original + j
                        cell = Cell x y
                    if   x >= 0 && x < n  && y >= 0  && y < m  &&  lab M.! cell == '.' && S.notMember cell visited
                        then return cell
                        else []
                nextSet = S.fromList neighbours
                next = S.toList nextSet
                in if null next
                    then levels
                    else walk (zip (repeat level) next ++ levels) cur nextSet next (level + 1)
            start = fst $ fromJust $ find ((== '.') . snd) $ M.assocs lab
            walkList = walk [(0,start)] S.empty (S.singleton start) [start] 1
            wall = S.fromList $ map snd $ take k $ reverse $ sort walkList
            result = [[ if lab M.! cell == '#'
                    then '#'
                    else if S.member cell wall
                        then 'X'
                        else '.'
                | j <- [0..m-1], let cell = Cell i j] | i <- [0..n-1] ]
            countX = length $ filter (== 'X' ) $ foldl1' (++) result
            in result{- ++[show countX]-}
    mapM putStrLn $ solution n m k lab

import Control.Applicative
import Data.List as L
import Data.Tuple
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S

data Cell = Cell {row::Int,col::Int} deriving (Show,Eq,Ord)

main = do
    [n,m,k] <- map read <$> words <$> getLine :: IO[Int]
    lab <- M.fromList <$> foldl1' (++) <$>
          map (\(row,list) -> map (\(col,e) -> (Cell row col,e)) $ zip [0..] list  ) <$>
          zip [0..] <$> lines <$> getContents
    let solution n m k lab = let
            neighbours cells visited= do
                original <- cells
                t        <- [(-1,0),(1,0)]
                (i,j)    <- [t,swap t]
                let x = row original + i
                    y = col original + j
                    cell = Cell x y
                if   x >= 0 && x < n  && y >= 0  && y < m  &&  lab M.! cell == '.' && S.notMember cell visited
                    then return cell
                    else []
            walk::[(Int,Cell)] -> S.Set Cell -> S.Set Cell -> [Cell]-> Int -> [(Int,Cell)]
            walk levels prev cur strip level = let
                nextSet = S.fromList $ (neighbours strip $ S.union prev cur )
                next = S.toList nextSet
                in if null next
                    then levels
                    else walk (zip (repeat level) next ++ levels) cur nextSet next (level + 1)
            start = fst $ fromJust $ find ((== '.') . snd) $ M.assocs lab
            walkList = walk [(0,start)] S.empty (S.singleton start) [start] 1
            wall = S.fromList $ map snd $ take k $ reverse $ sort walkList
            result = [[ if lab M.! cell == '#'
                    then '#'
                    else if S.member cell wall
                        then 'X'
                        else '.'
                | j <- [0..m-1], let cell = Cell i j] | i <- [0..n-1] ]
            countX = length $ filter (== 'X' ) $ foldl1' (++) result
            in result{- ++[show countX]-}
    mapM putStrLn $ solution n m k lab

{-# LANGUAGE TupleSections #-}
import           Data.Array
import qualified Data.Set

-- https://hackage.haskell.org/package/split-0.2.3.4/docs/src/Data.List.Split.Internals.html#chunksOf
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g = g (:) []

chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls))  where
    splitter :: [e] -> ([e] -> a -> a) -> a -> a
    splitter [] _ n = n
    splitter l  c n = l `c` splitter (drop i l) c n

parseMaze :: Int -> Int -> String -> Array (Int, Int) Char
parseMaze h w s = listArray ((1, 1), (h, w)) (filter (/= '\n') s)

printMaze :: Int -> Int -> Array (Int, Int) Char -> String
printMaze h w m = unlines $ chunksOf w $ elems m

findStart m = fst $ head $ filter (\x -> snd x == '.') $ assocs m

dfs :: Int -> Int -> Array (Int, Int) Char -> [(Int, Int)]
dfs h w maze =
    let (starty, startx) = findStart maze :: (Int, Int)
    in  dfs' [(starty, startx)] [] Data.Set.empty
  where
    dfs' [] traversal _ = traversal
    dfs' ((y, x) : toVisit) traversal visited =
        let traversal' = (y, x):traversal
            neighbors =
                    [ (yy, xx)
                    | (dy, dx) <- [(-1, 0), (1, 0), (0, -1), (0, 1)]
                    , let (yy, xx) = (y + dy, x + dx)
                    , 1 <= yy && yy <= h
                    , 1 <= xx && xx <= w
                    , maze ! (yy, xx) == '.'
                    , (yy, xx) `Data.Set.notMember` visited
                    ]
            toVisit' = neighbors ++ toVisit
            visited' = Data.Set.union visited (Data.Set.fromList neighbors)
        in  dfs' toVisit' traversal' visited'

main = do
    --first <- getLine
    let first = "500 500 249999" -- XXX
    let [h, w, k] = (map read . words) first
    --rest <- getContents
    let rest = unlines $ replicate 500 (replicate 500 '.')

    let maze  = parseMaze h w rest
    let topo  = dfs h w maze
    let maze' = maze // map (, 'X') (take k topo)
    putStrLn (printMaze h w maze')

import Data.Set
import Data.Array
main = interact $ f . Prelude.map words . lines

-- visited empty set
dfs mat start@(i,j) visited = start:(concat l)
  where cvisited = insert start visited
        dir x = if (member x mat) && (not (member x cvisited)) then dfs mat x cvisited else []
        l = Prelude.map dir [(i, j+1),
                             (i+1, j),
                             (i-1, j),
                             (i, j-1)]

f (x:xs) = ans
  where (r:c:conn:_) = Prelude.map read x
        xsarr = array ((1, 1), (r, c)) $ zip [(i, j) | i <- [1..r], j <- [1..c]] (concat (concat xs))
        mat = fromList [(i, j) | i <- [1..r], j <- [1..c], (xsarr ! (i, j)) == '.']
        tvl = dfs mat (minimum mat) empty
        doors = fromList $ Prelude.drop ((length mat)-conn) tvl
        insertdoor i j k = if member (i, j) doors then 'X' else k
        ans = unlines [[ insertdoor row col v | (col, v) <- zip [1..c] val] | (val, row) <- zip (concat xs) [1..r]]

import Data.Set
import Data.Array
main = interact $ f . Prelude.map words . lines

dfs mat start@(i,j) visited = start:(concat [v1, v2, v3, v4])
  where vp = insert start visited
        dir x v = if (member x mat) && (not (member x v)) then dfs mat x v else []
        v1 = dir (i, j+1) vp
        v2 = dir (i+1, j) $ union vp $ fromList v1
        v3 = dir (i-1, j) $ union vp $ fromList v2
        v4 = dir (i, j-1) $ union vp $ fromList v3

f (x:xs) = ans
  where (r:c:conn:_) = Prelude.map read x
        mat = fromList [(i, j) | ((i, j), v) <- zip (range ((1, 1), (r,c))) (concat (concat xs)), v=='.']
        tvl = dfs mat (minimum mat) empty
        doors = fromList $ Prelude.drop ((length mat)-conn) tvl
        insertdoor i j k = if member (i, j) doors then 'X' else k
        ans = unlines [[ insertdoor row col v | (col, v) <- zip [1..c] val] | (val, row) <- zip (concat xs) [1..r]]

{-# LANGUAGE FlexibleContexts #-}
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad
import Control.Monad.ST
main = do
  [n,m,k] <- map read . words <$> getLine
  gc0 <- concat . lines <$> getContents
  forM_ [1..n] $ \i -> do
    forM_ [1..m] $ \j -> putChar $ solve n m k gc0 ! (i,j)
    putChar '\n'
solve n m k gc0 = runSTUArray $ do
  let bs = ((1,1),(n,m))
  g <- newListArray bs gc0 :: ST s (STUArray s (Int,Int) Char)
  let neighbors (i,j) = filterM (fmap (== '.') . readArray g) $ filter (inRange bs) [(i-1,j),(i+1,j),(i,j-1),(i,j+1)]
      go 0 _ = return ()
      go k (s:ss) = do
        [n] <- neighbors s
        writeArray g s 'X'
        ns' <- neighbors n
        case ns' of [n'] -> go (k-1) (n:ss)
                    _    -> go (k-1) ss
  go k =<< filterM (fmap ((== 1) . length) . neighbors) (range bs)
  return g

{-# LANGUAGE FlexibleContexts #-}
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad
import Control.Monad.ST
import Data.List
import Control.Arrow
main = do
  [n,m,k] <- map read . words <$> getLine
  gc0 <- concat . lines <$> getContents
  forM_ [1..n] $ \i -> do
    forM_ [1..m] $ \j -> putChar $ solve n m k gc0 ! (i,j)
    putChar '\n'
solve n m k gc0 = runSTUArray $ do
  let bs = ((1,1),(n,m))
  g <- newListArray bs gc0 :: ST s (STUArray s (Int,Int) Char)
  let neighbors (i,j) = filterM (fmap (== '.') . readArray g) $ filter (inRange bs) [(i-1,j),(i+1,j),(i,j-1),(i,j+1)]
      go 0 _ = return ()
      go k (s:ss) = do
        v <- readArray g s
        if v /= '.' then go k ss else do
          ns <- neighbors s
          writeArray g s 'X'
          ns' <- filterM (fmap ((== 1) . length) . neighbors) ns
          go (k-1) (ns' ++ ss)
  go k =<< fmap (map snd . sort) . mapM (runKleisli $ Kleisli (fmap length . neighbors) &&& arr id) =<< filterM (fmap (== '.') . readArray g) (range bs)
  return g

{-# LANGUAGE FlexibleContexts #-}
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad
import Control.Monad.ST
import Data.List
import Control.Arrow
main = do
  [n,m,k] <- map read . words <$> getLine
  gc0 <- concat . lines <$> getContents
  forM_ [1..n] $ \i -> do
    forM_ [1..m] $ \j -> putChar $ solve n m k gc0 ! (i,j)
    putChar '\n'
solve n m k gc0 = runSTUArray $ do
  let bs = ((1,1),(n,m))
  g <- newListArray bs gc0 :: ST s (STUArray s (Int,Int) Char)
  let neighbors (i,j) = filterM (fmap (== '.') . readArray g) $ filter (inRange bs) [(i-1,j),(i+1,j),(i,j-1),(i,j+1)]
      go 0 _ = return ()
      go k (s:ss) = do
        ns <- neighbors s
        writeArray g s 'X'
        ns' <- filterM (fmap ((== 1) . length) . neighbors) ns
        go (k-1) (ns' ++ ss)
  go k =<< fmap (map snd . sort) . mapM (runKleisli $ Kleisli (fmap length . neighbors) &&& arr id) =<< filterM (fmap (== '.') . readArray g) (range bs)
  return g

import Control.Applicative
import Data.List as L
import Data.Tuple
import Data.Maybe
import Data.Map (fromList,(!),assocs,showTree)
import qualified Data.Set as S

data Cell = Cell {row::Int,col::Int} deriving Show
instance Eq Cell where
	x == y = row x == row y && col x == col y
instance Ord Cell where	x `compare` y = (row x, col x) `compare` (row y,col y)
data Walk = Walk { remains:: Int, visited::S.Set Cell, collected::S.Set Cell } deriving Show

main = do
	[n,m,k] <- map read <$> words <$> getLine :: IO[Int]
	lab <- fromList <$> foldl1' (++) <$>
		  map (\(row,list) -> map (\(col,e) -> (Cell row col,e)) $ zip [0..] list  ) <$>
		  zip [0..] <$> lines <$> getContents
	let solution n m k lab = let
		neighbours visited cell = filter valid [Cell (row cell+i) (col cell+j)| t <- [(-1,0),(1,0)], (i,j)<- [t,swap t]] where
			valid cell = row cell >= 0 && row cell< n && col cell>= 0 && col cell< m && S.notMember cell visited && lab ! cell == '.'
		walkLab::Cell -> Walk -> Walk
		walkLab cell walk = let
			visitMe walk = Walk (remains walk) (S.insert cell $ visited walk) (collected walk)
			collectMe walk = if (remains walk ) == 0 then visitMe walk
				else Walk (remains walk - 1) (S.insert cell $ visited walk ) (S.insert cell $ collected walk)
			in collectMe $ foldr walkLab (visitMe  walk) (neighbours (visited walk ) cell)
		found = collected $ walkLab (fst $ fromJust $ find ((== '.') . snd) $ assocs lab) (Walk k S.empty S.empty )
		in [[ if lab ! cell == '#' then '#' else if S.member cell found then 'X' else '.' | j <- [0..m-1], let cell = Cell i j] | i <- [0..n-1] ]

		--neighbours S.empty $ Cell 0 1
	mapM putStrLn $ solution n m k lab

import Control.Applicative
import Data.List as L
import Data.Tuple
import Data.Maybe
import Data.Map (fromList,(!),assocs,showTree)
import qualified Data.Set as S

data Cell = Cell {row::Int,col::Int} deriving Show
instance Eq Cell where
	x == y = row x == row y && col x == col y
instance Ord Cell where	x `compare` y = (row x, col x) `compare` (row y,col y)
data Walk = Walk { remains:: Int, visited::S.Set Cell, collected::S.Set Cell } deriving Show

main = do
	[n,m,k] <- map read <$> words <$> getLine :: IO[Int]
	lab <- fromList <$> foldl1' (++) <$>
		  map (\(row,list) -> map (\(col,e) -> (Cell row col,e)) $ zip [0..] list  ) <$>
		  zip [0..] <$> lines <$> getContents
	let solution n m k lab = let
		neighbours visited cell = filter valid [Cell (row cell+i) (col cell+j)| t <- [(-1,0),(1,0)], (i,j)<- [t,swap t]] where
			valid cell = row cell >= 0 && row cell< n && col cell>= 0 && col cell< m && S.notMember cell visited && lab ! cell == '.'
		walkLab::Cell -> Walk -> Walk
		walkLab cell walk = let
			visitMe walk = Walk (remains walk) (S.insert cell $ visited walk) (collected walk)
			collectMe walk = if (remains walk ) == 0 then visitMe walk
				else Walk (remains walk - 1) (S.insert cell $ visited walk ) (S.insert cell $ collected walk)
			in collectMe $ foldr walkLab (visitMe  walk) (neighbours (visited walk ) cell)
		found = collected $ walkLab (fst $ fromJust $ find ((== '.') . snd) $ assocs lab) (Walk k S.empty S.empty )
		in [[ if lab ! cell == '#' || S.member cell found then '#' else '.' | j <- [0..m-1], let cell = Cell i j] | i <- [0..n-1] ]

		--neighbours S.empty $ Cell 0 1
	mapM putStrLn $ solution n m k lab


William arrived at a conference dedicated to cryptocurrencies. Networking, meeting new people, and using friends' connections are essential to stay up to date with the latest news from the world of cryptocurrencies.The conference has $$$n$$$ participants, who are initially unfamiliar with each other. William can introduce any two people, $$$a$$$ and $$$b$$$, who were not familiar before, to each other. William has $$$d$$$ conditions, $$$i$$$'th of which requires person $$$x_i$$$ to have a connection to person $$$y_i$$$. Formally, two people $$$x$$$ and $$$y$$$ have a connection if there is such a chain $$$p_1=x, p_2, p_3, \dots, p_k=y$$$ for which for all $$$i$$$ from $$$1$$$ to $$$k - 1$$$ it's true that two people with numbers $$$p_i$$$ and $$$p_{i + 1}$$$ know each other.For every $$$i$$$ ($$$1 \le i \le d$$$) William wants you to calculate the maximal number of acquaintances one person can have, assuming that William satisfied all conditions from $$$1$$$ and up to and including $$$i$$$ and performed exactly $$$i$$$ introductions. The conditions are being checked after William performed $$$i$$$ introductions. The answer for each $$$i$$$ must be calculated independently. It means that when you compute an answer for $$$i$$$, you should assume that no two people have been introduced to each other yet.

The first line contains two integers $$$n$$$ and $$$d$$$ ($$$2 \le n \le 10^3, 1 \le d \le n - 1$$$), the number of people, and number of conditions, respectively. Each of the next $$$d$$$ lines each contain two integers $$$x_i$$$ and $$$y_i$$$ ($$$1 \le x_i, y_i \le n, x_i \neq y_i$$$), the numbers of people which must have a connection according to condition $$$i$$$.

Output $$$d$$$ integers. $$$i$$$th number must equal the number of acquaintances the person with the maximal possible acquaintances will have, if William performed $$$i$$$ introductions and satisfied the first $$$i$$$ conditions.

NoteThe explanation for the first test case:In this explanation, the circles and the numbers in them denote a person with the corresponding number. The line denotes that William introduced two connected people. The person marked with red has the most acquaintances. These are not the only correct ways to introduce people.

-- maybe TLE? but it's so ugly already

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

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List hiding (find)
import Data.Array.ST.Safe
import Control.Monad.ST
import qualified Control.Monad.ST.Lazy as L
import Control.Monad.Trans.Class

data DSU s = DSU
  { pars  :: STUArray s Int Int
  , sizes :: STUArray s Int Int
  }

find :: DSU s -> Int -> ST s Int
find s x = do
  currPar <- readArray (pars s) x
  root <- if  x == currPar
    then  pure x
    else  find s currPar
  writeArray (pars s) x root
  pure root

unite :: forall thread. DSU thread -> Int -> Int -> ST thread Bool
unite s x y = do
  xr <- find s x
  yr <- find s y
  if  xr == yr
    then  pure False
    else  True <$ do
    xs <- readArray (sizes s) xr
    ys <- readArray (sizes s) yr
    let  go :: Int -> Int -> ST thread ()
         go p q = writeArray (sizes s) p (xs + ys) >> writeArray (pars s) q p
    if  xs >= ys
      then  go xr yr
      else  go yr xr

solve :: Int -> [(Int, Int)] -> [Int]
solve n qs = L.runST $ do
  s <- L.strictToLazyST $ liftM2 DSU (newArray_ (1, n)) (newArray (1, n) 1)
  L.strictToLazyST $ forM_ [1..n] $ \ix -> writeArray (pars s) ix ix
  (\act -> evalStateT act 0) $ forM qs $ \(x, y) -> do
    -- state holds number of free actions
    newConstraint <- lift $ L.strictToLazyST $ unite s x y
    when (not newConstraint) $ modify' (+ 1)
    freeActions <- get
    lift $ L.strictToLazyST $ do
      roots <- flip filterM [1..n] $ \ix -> (== ix) <$> find s ix
      relSizes <- mapM (readArray $ sizes s) roots
      let  relevant = take (freeActions + 1) $ sortOn negate relSizes
      pure $ foldl' (+) (0-1) relevant

mainFun :: SP Builder
mainFun = do
  ~[n, d] <- getInts 2
  qs <- replicateM d $ do
    ~[xi, yi] <- getInts 2
    pure (xi, yi)
  pure $ foldMap (putInts . pure) $ solve n qs

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

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


Andrew has $$$n$$$ piles with stones. The $$$i$$$-th pile contains $$$a_i$$$ stones. He wants to make his table clean so he decided to put every stone either to the $$$1$$$-st or the $$$n$$$-th pile.Andrew can perform the following operation any number of times: choose $$$3$$$ indices $$$1 \le i < j < k \le n$$$, such that the $$$j$$$-th pile contains at least $$$2$$$ stones, then he takes $$$2$$$ stones from the pile $$$j$$$ and puts one stone into pile $$$i$$$ and one stone into pile $$$k$$$. Tell Andrew what is the minimum number of operations needed to move all the stones to piles $$$1$$$ and $$$n$$$, or determine if it's impossible.

The input contains several test cases. The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 10\,000$$$) — the number of test cases. The first line for each test case contains one integer $$$n$$$ ($$$3 \leq n \leq 10^5$$$) — the length of the array. The second line contains a sequence of integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — the array elements. It is guaranteed that the sum of the values $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print the minimum number of operations needed to move stones to piles $$$1$$$ and $$$n$$$, or print $$$-1$$$ if it's impossible.

NoteIn the first test case, it is optimal to do the following:   Select $$$(i, j, k) = (1, 2, 5)$$$. The array becomes equal to $$$[2, 0, 2, 3, 7]$$$.  Select $$$(i, j, k) = (1, 3, 4)$$$. The array becomes equal to $$$[3, 0, 0, 4, 7]$$$.  Twice select $$$(i, j, k) = (1, 4, 5)$$$. The array becomes equal to $$$[5, 0, 0, 0, 9]$$$. This array satisfy the statement, because every stone is moved to piles $$$1$$$ and $$$5$$$.  There are $$$4$$$ operations in total.In the second test case, it's impossible to put all stones into piles with numbers $$$1$$$ and $$$3$$$:   At the beginning there's only one possible operation with $$$(i, j, k) = (1, 2, 3)$$$. The array becomes equal to $$$[2, 1, 2]$$$.  Now there is no possible operation and the array doesn't satisfy the statement, so the answer is $$$-1$$$. In the third test case, it's optimal to do the following:   Select $$$(i, j, k) = (1, 2, 3)$$$. The array becomes equal to $$$[2, 0, 2]$$$. This array satisfies the statement, because every stone is moved to piles $$$1$$$ and $$$3$$$.  The is $$$1$$$ operation in total.In the fourth test case, it's impossible to do any operation, and the array doesn't satisfy the statement, so the answer is $$$-1$$$.

import Control.Monad (forM_)

import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Read as Text

solve :: Int -> [Int] -> Int
solve 3 [x, y, z]
   | odd y      = -1
   | otherwise  = y `div` 2
solve n lst
   | all ((==) 1) innerList  = -1
   | otherwise               = (totalSum + oddCount) `div` 2
   where innerList = init $ tail lst
         totalSum  = sum innerList
         oddCount  = length $ filter odd innerList

textToInt :: Text -> Int
textToInt text =
   case Text.decimal text of
      Right (n, _) -> n

readInts :: Text -> [Int]
readInts = map textToInt . Text.words

handleCases:: Int -> [Text] -> [Int]
handleCases 0 _                   = []
handleCases t (line1:line2:rest)  = solve n a : handleCases (t-1) rest
   where n = textToInt line1
         a = readInts line2

main :: IO ()
main = do
   line1:rest <- Text.lines <$> Text.getContents
   let t     = textToInt line1
       res   = handleCases t rest
   Text.putStr $ Text.unlines $ map (Text.pack . show) res

parseInt :: String -> Int
parseInt number = (read number) :: Int

readInt :: IO Int
readInt = do
    number <- getLine
    pure $ parseInt number

readIntArr :: IO [Int]
readIntArr = do
    numbers <- getLine
    pure $ map parseInt $ words numbers

plus :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int)
plus (a, b, c) (d, e, f) = (a + d, b + e, c + f)

checkHelper :: [Int] -> (Int, Int, Int)
checkHelper []       = (0, 0, 0)
checkHelper (_ : []) = (0, 0, 0)
checkHelper (1 : xs) = (0, 0, 1) `plus` checkHelper xs
checkHelper (x : xs) = checkHelper xs `plus` if (x `mod` 2 == 0)
    then (1, 0, 0)
    else (0, 1, 0)

checkArr :: [Int] -> Bool
checkArr (x : xs) = od > 0 || (ev > 0 && ev + on > 1)
    where (od, ev, on) = checkHelper xs

countHelper :: [Int] -> Int
countHelper []       = 0
countHelper (x : []) = 0
countHelper (x : xs) = countHelper xs + (x + 1) `div` 2

countArr :: [Int] -> Int
countArr (x : xs) = countHelper xs

solve :: IO ()
solve = do
    n   <- readInt
    arr <- readIntArr
    if (checkArr arr)
        then print $ countArr arr
        else print $ -1

readLoop :: Int -> IO ()
readLoop i =
    if (i == 0)
        then pure ()
        else do
            solve
            readLoop (i - 1)

main :: IO ()
main = do
    n <- readInt
    readLoop n

parseInt :: String -> Int
parseInt number = (read number) :: Int

readInt :: IO Int
readInt = do
    number <- getLine
    pure $ parseInt number

readIntArr :: IO [Int]
readIntArr = do
    numbers <- getLine
    pure $ map parseInt $ words numbers

dropTail :: [Int] -> [Int]
dropTail []       = []
dropTail (_ : []) = []
dropTail (x : xs) = (x : dropTail xs)

plus :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int)
plus (a, b, c) (d, e, f) = (a + d, b + e, c + f)

checkHelper :: [Int] -> (Int, Int, Int)
checkHelper []       = (0, 0, 0)
checkHelper (1 : xs) = (0, 0, 1) `plus` checkHelper xs
checkHelper (x : xs) = checkHelper xs `plus` if (x `mod` 2 == 0)
    then (1, 0, 0)
    else (0, 1, 0)

checkArr :: [Int] -> Bool
checkArr (x : xs) = od > 0 || (ev > 0 && ev + on > 1)
    where (od, ev, on) = checkHelper $ dropTail xs

countHelper :: [Int] -> Int
countHelper []       = 0
countHelper (x : xs) = countHelper xs + (x + 1) `div` 2

countArr :: [Int] -> Int
countArr (x : xs) = countHelper $ dropTail xs

solve :: IO ()
solve = do
    n   <- readInt
    arr <- readIntArr
    if (checkArr arr)
        then print $ countArr arr
        else print $ -1

readLoop :: Int -> IO ()
readLoop i =
    if (i == 0)
        then pure ()
        else do
            solve
            readLoop (i - 1)

main :: IO ()
main = do
    n <- readInt
    readLoop n

import Control.Monad (forM)

solve t = do
  n <- readLn::IO Int
  arr <- getLine >>= \s -> return $ drop 1 $ take (n - 1) $ map (read::String -> Int) (words s)
  let ans | (maximum arr == 1) || (n == 3 && odd (head arr)) = print (-1)
          | otherwise = print $ foldl (\x a -> x + (a + 1) `div` 2) 0 arr
  ans

main = do
tlen <- readLn :: IO Int
forM [0..(tlen - 1)] (\t -> do solve t)

main = interact $ unlines . map p . chunk 2 . drop 1 . lines

chunk n [] = []
chunk n xs = take n xs : chunk n (drop n xs)

folff t x = let (s, o, e, c1) = t in add s o e c1 x
        where add s o e c1 x
                | x == 1 = (s + 1, o + 1, e, c1 + 1)
                | even x = (s + x, o, e + 1, c1)
                | otherwise = (s + x, o + 1, e, c1)

calc :: (Int, Int, Int, Int) -> Int
calc t
    | o == 0 = s `div` 2
    | e == 0 && o == 1 = -1
    | e == 0 && o == c1 = -1
    | e == 0 = calc(s-1, o-1, e+1, 0) + 1
    | o == 1 = calc(s-1, 0, 0, 0) + 1
    | otherwise = calc(s, o - k * 2, 1, 0) + k
    where (s, o, e, c1) = t
          k = o `div` 2

p xs = let ((n:_):s:_) = fmap (fmap read . words) xs :: [[Int]]
        in show $ calc $ foldl folff (0,0,0,0) $ init $ tail s

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    _ <- getInt
    a <- replicateM (n - 2) getInt
    _ <- getInt
    let
      stuck = negate 1
      totMoves = foldl' (+) 0 [quot (v + 1) 2 | v <- a]
      ans = case  a  of
        [v] | odd v  -> stuck
        _   | any (> 0) a && all (< 2) a  -> stuck
            | otherwise -> case  filter (> 0) a  of
                [3] -> stuck
                [v] | odd v  -> totMoves + 1 -- very nasty edge case
                -- hopefully I didn't miss more
                _ -> totMoves
    pure $ putInts [ans]

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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

import Control.Monad (forM_)

import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Read as Text

solve :: Int -> [Int] -> Int
solve n a
   | oddCount > evenSum `div` 2 = -1
   | otherwise                  = (evenSum + oddCount + oddSum) `div` 2
   where innerList = init $ tail a

         evenList  = filter even innerList
         oddList   = filter (not . even) innerList

         oddCount  = length oddList

         evenSum   = sum evenList
         oddSum    = sum oddList

textToInt :: Text -> Int
textToInt text =
   case Text.decimal text of
      Right (n, _) -> n

readInts :: Text -> [Int]
readInts = map textToInt . Text.words

handleCases:: Int -> [Text] -> [Int]
handleCases 0 _                   = []
handleCases t (line1:line2:rest)  = solve n a : handleCases (t-1) rest
   where n = textToInt line1
         a = readInts line2

main :: IO ()
main = do
   line1:rest <- Text.lines <$> Text.getContents
   let t     = textToInt line1
       res   = handleCases t rest
   Text.putStr $ Text.unlines $ map (Text.pack . show) res


Sherlock Holmes found a mysterious correspondence of two VIPs and made up his mind to read it. But there is a problem! The correspondence turned out to be encrypted. The detective tried really hard to decipher the correspondence, but he couldn't understand anything. At last, after some thought, he thought of something. Let's say there is a word s, consisting of |s| lowercase Latin letters. Then for one operation you can choose a certain position p (1 ≤ p < |s|) and perform one of the following actions:   either replace letter sp with the one that alphabetically follows it and replace letter sp + 1 with the one that alphabetically precedes it;  or replace letter sp with the one that alphabetically precedes it and replace letter sp + 1 with the one that alphabetically follows it. Let us note that letter "z" doesn't have a defined following letter and letter "a" doesn't have a defined preceding letter. That's why the corresponding changes are not acceptable. If the operation requires performing at least one unacceptable change, then such operation cannot be performed.Two words coincide in their meaning iff one of them can be transformed into the other one as a result of zero or more operations.Sherlock Holmes needs to learn to quickly determine the following for each word: how many words can exist that coincide in their meaning with the given word, but differs from the given word in at least one character? Count this number for him modulo 1000000007 (109 + 7).

The input data contains several tests. The first line contains the only integer t (1 ≤ t ≤ 104) — the number of tests. Next t lines contain the words, one per line. Each word consists of lowercase Latin letters and has length from 1 to 100, inclusive. Lengths of words can differ.

For each word you should print the number of different other words that coincide with it in their meaning — not from the words listed in the input data, but from all possible words. As the sought number can be very large, print its value modulo 1000000007 (109 + 7).

NoteSome explanations about the operation:  Note that for each letter, we can clearly define the letter that follows it. Letter "b" alphabetically follows letter "a", letter "c" follows letter "b", ..., "z" follows letter "y".  Preceding letters are defined in the similar manner: letter "y" precedes letter "z", ..., "a" precedes letter "b".  Note that the operation never changes a word's length. In the first sample you can obtain the only other word "ba". In the second sample you cannot obtain any other word, so the correct answer is 0.Consider the third sample. One operation can transform word "klmbfxzb" into word "klmcexzb": we should choose p = 4, and replace the fourth letter with the following one ("b"  →  "c"), and the fifth one — with the preceding one ("f"  →  "e"). Also, we can obtain many other words from this one. An operation can transform word "ya" only into one other word "xb". Word "ya" coincides in its meaning with words "xb", "wc", "vd", ..., "ay" (overall there are 24 other words). The word "klmbfxzb has many more variants — there are 3320092814 other words that coincide with in the meaning. So the answer for the first word equals 24 and for the second one equals 320092793 — the number 3320092814 modulo 109 + 7

import Data.Array
s(l,s)|s<1=1|l<1=0|1>0=foldl(\y x->mod(p!(l-1,x)+y)1000000007)0[max 0$s-25..s]
b=((0,0),(100,2500))
p=listArray b$map s$range b
f=fromEnum
y l=p!(length l,sum l)
main=interact$unlines.map(show.pred.y.map((+(-f 'a')).f)).tail.lines

import Data.Array
import Data.Char (ord)
import Data.Function (fix)

main = do
    tests <- fmap (tail . words) getContents
    mapM_ (print . solve) tests
        where
            dp = count 100 2500
            solve test = (dp ! (length test, sum $ map (\ch -> (ord ch) - (ord 'a')) test)) - 1

count :: Int -> Int -> Array (Int, Int) Int
count maxLen maxSum = fix f
    where
        bs = ((0, 0), (maxLen, maxSum))
        f dp = listArray bs
                         [if i == 1 then 1
                                    else sumMod 1000000007 $ map (\s -> dp ! (i - 1, s)) [max 0 (j - 25)..min j (25 * (i - 1))]
                             | (i, j) <- range bs]

sumMod :: (Ord a, Num a) => a -> [a] -> a
sumMod m = foldl (\s x -> if s + x >= m then s + x - m else s + x) 0

{-# LANGUAGE BangPatterns #-}
import Data.List
import Data.Array

addM !x !y = (x + y) `mod` 1000000007

smm = foldl' addM 0

solve rec len 0 = 1
solve rec 0 sum = 0
solve rec len sum
  | sum < 0 = 0
  | otherwise = smm $ map (rec (len-1)) . filter (>=0) . map (sum-) $ [0..25]

bnd = ((0,0), (100, 2500))

pref l s = precalc!(l,s)
precalc = listArray bnd [solve pref l s|(l,s)<-range bnd]

c2n c = fromEnum c - fromEnum 'a'

s l=pref(length l)(sum l)

main=interact$unlines.map(show.pred).map(s.map c2n).tail.lines

import Array
s r _ 0=1
s r 0 _=0
s r l s|s<0=0|1>0=foldl(\x y->mod(x+y)1000000007)0$map(r$l-1)$[max 0$s-25..s]
b=((0,0),(100,2500))
p=listArray b[s q l m|(l,m)<-range b]
q l s=p!(l,s)
z c=f c-f 'a';f=fromEnum
y l=p!(length l,sum l)
main=interact$unlines.map(show.pred).map(y.map z).tail.lines

import Data.Array
import Data.Char (ord)
import Data.Function (fix)

main = do
    tests <- fmap (tail . words) getContents
    mapM_ (print . solve) tests
        where
            dp = count 100 2500
            solve test = (dp ! (length test, sum $ map (\ch -> (ord ch) - (ord 'a')) test)) - 1

count :: Int -> Int -> Array (Int, Int) Int
count maxLen maxSum = fix f
    where
        bs = ((0, 0), (maxLen, maxSum))
        f dp = listArray bs
                         [if i == 1 then 1
                                    else (sum $ map (\s -> dp ! (i - 1, s)) [max 0 (j - 25)..min j (25 * (i - 1))]) `mod` 1000000007
                             | (i, j) <- range bs]

import Array
s(l,s)|s<1=1|l<1=0|1>0=foldl(\x y->mod(p!(x,l-1)+y)1000000007)0[max 0$s-25..s]
b=((0,0),(100,2500))
p=listArray b$map s$range b
f=fromEnum
y l=p!(length l,sum l)
main=interact$unlines.map(show.pred.y.map((+(-f 'a')).f)).tail.lines


Vasya has the square chessboard of size n × n and m rooks. Initially the chessboard is empty. Vasya will consequently put the rooks on the board one after another.The cell of the field is under rook's attack, if there is at least one rook located in the same row or in the same column with this cell. If there is a rook located in the cell, this cell is also under attack.You are given the positions of the board where Vasya will put rooks. For each rook you have to determine the number of cells which are not under attack after Vasya puts it on the board.

The first line of the input contains two integers n and m (1 ≤ n ≤ 100 000, 1 ≤ m ≤ min(100 000, n2)) — the size of the board and the number of rooks.  Each of the next m lines contains integers xi and yi (1 ≤ xi, yi ≤ n) — the number of the row and the number of the column where Vasya will put the i-th rook. Vasya puts rooks on the board in the order they appear in the input. It is guaranteed that any cell will contain no more than one rook.

Print m integer, the i-th of them should be equal to the number of cells that are not under attack after first i rooks are put.

NoteOn the picture below show the state of the board after put each of the three rooks. The cells which painted with grey color is not under the attack.

import Data.List hiding (insert)
import Data.Int
import Data.IntSet hiding (map)

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    rocks <- (map (map read . words) . take m . lines) `fmap` getContents :: IO [[Int]]
    let n64 = fromIntegral n :: Int64
    solve rocks empty empty n64 n64

solve [] cols rows emptyCols emptyRows = return ()
solve ([x,y]:rocks) cols rows emptyCols emptyRows = do
    let col_already = member x cols
    let row_already = member y rows
    let emptyCols' = if col_already then emptyCols else emptyCols - 1
    let emptyRows' = if row_already then emptyRows else emptyRows - 1
    putStr $ show $ emptyCols' * emptyRows'
    putChar ' '
    let cols' = insert x cols
    let rows' = insert y rows
    solve rocks cols' rows' emptyCols' emptyRows'

import Data.IntSet hiding (map)
main = interact $  solve . map (map (read::String->Int) . words) . lines
solve  ([n',_]:xs) = let n = toInteger n'
                         go [] _ _  = []
                         go ([a,b]:xs) (r,rs) (c,cs) = let (r',rs') = if member a rs then (r, rs) else (r+1, insert a rs)
                                                           (c',cs') = if member b cs then (c, cs) else (c+1, insert b cs)

                                                       in (n*n-r'*n-c'*n+r'*c') : go xs (r',rs') (c',cs')
                 in unwords . map show $ go xs (0,empty) (0,empty)

import Control.Applicative
import qualified Data.Map as Map
import Data.Int

solve :: [Int64] -> Int64 -> Int64 -> Map.Map Int64 Int64 -> Map.Map Int64 Int64 -> (Int64, Map.Map Int64 Int64, Map.Map Int64 Int64)
solve [rPos,cPos] n curAtt rAtt cAtt = (curAtt + newRowAtt + newColAtt - p, Map.insert rPos 0 rAtt, Map.insert cPos 0 cAtt)
    where newRowAtt = case Map.member rPos rAtt of
                        True -> 0
                        False -> n - (fromIntegral $ Map.size cAtt)
          newColAtt = case Map.member cPos cAtt of
                        True -> 0
                        False -> n - (fromIntegral $ Map.size rAtt)
          p | not (Map.member cPos cAtt) && not (Map.member rPos rAtt) = 1
            | otherwise = 0

solve1 :: [[Int64]] -> Int64 -> Int64 -> Map.Map Int64 Int64 -> Map.Map Int64 Int64 -> IO ()
solve1 [] _ _ _ _ = return ()
solve1 (x:xs) n curAtt rAtt cAtt = do
                                let (res, newRAtt, newCAtt) = solve x n curAtt rAtt cAtt
                                putStr . show $ n * n - res
                                putStr " "
                                solve1 xs n res newRAtt newCAtt

main :: IO ()
main = do
        [n,m] <- map read . words <$> getLine
        lines <- mapM (\_ -> map (read :: String -> Int64) . words <$> getLine) [1..m]
        solve1 lines n 0 Map.empty Map.empty
        putStrLn ""

import Control.Applicative
import qualified Data.Map as Map
import Data.Int

solve :: [Int64] -> Int64 -> Int64 -> Map.Map Int64 Int64 -> Map.Map Int64 Int64 -> (Int64, Map.Map Int64 Int64, Map.Map Int64 Int64)
solve [rPos,cPos] n curAtt rAtt cAtt = (curAtt + newRowAtt + newColAtt - p, Map.insert rPos 0 rAtt, Map.insert cPos 0 cAtt)
    where newRowAtt = case Map.member rPos rAtt of
                        True -> 0
                        False -> n - ((fromIntegral :: Int -> Int64) (Map.size cAtt))
          newColAtt = case Map.member cPos cAtt of
                        True -> 0
                        False -> n - ((fromIntegral :: Int -> Int64) (Map.size rAtt))
          p | not (Map.member cPos cAtt) && not (Map.member rPos rAtt) = 1
            | otherwise = 0

solve1 :: [[Int64]] -> Int64 -> Int64 -> Map.Map Int64 Int64 -> Map.Map Int64 Int64 -> IO ()
solve1 [] _ _ _ _ = return ()
solve1 (x:xs) n curAtt rAtt cAtt = do
                                let (res, newRAtt, newCAtt) = solve x n curAtt rAtt cAtt
                                putStr . show $ n * n - res
                                putStr " "
                                solve1 xs n res newRAtt newCAtt

main :: IO ()
main = do
        [n,m] <- map read . words <$> getLine
        lines <- mapM (\_ -> map (read :: String -> Int64) . words <$> getLine) [1..m]
        solve1 lines n 0 Map.empty Map.empty
        putStrLn ""

import Control.Arrow
import Control.Applicative
import Data.Int
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Data.List

data Tower = Tower Int Int

readTower s = Tower x y
    where
        [x, y] = map read . words $ s

sol :: Int -> [Tower] -> [Int64]
sol n t = sol' t IS.empty IS.empty (fromIntegral n) (fromIntegral n)
    where
        sol' [] _ _ _ _ = []
        sol' (t:ts) bx by kx ky = (nkx * nky) : (sol' ts nbx nby nkx nky)
            where
                (Tower x y) = t
                nx = x `IS.member` bx
                ny = y `IS.member` by
                nkx = if nx then kx else kx - 1
                nky = if ny then ky else ky - 1
                nbx = if nx then bx else x `IS.insert` bx
                nby = if ny then by else y `IS.insert` by

main :: IO()
main = do
    [n, _] <- (map read . words) <$> getLine
    towers <- (map readTower . lines) <$> getContents
    putStrLn $ intercalate " " $ map show $ sol n towers

import Control.Monad
import System.IO
import qualified Data.Set as Set

type Result = (Set.Set Integer, Set.Set Integer)

readInput :: IO [Integer]
readInput = fmap ((map read) . words) getLine

freeCells :: Integer -> Integer -> Integer -> Integer
freeCells n nx ny = n * n - (n * nx) - ((n - nx) * ny)

answer :: Result -> Integer -> Integer
answer r n  = freeCells n (toInteger (Set.size (fst r))) (toInteger (Set.size (snd r)))

processLine :: Integer -> Integer -> Result -> IO [()]
processLine n k r
    | k == 0 = return [()]
    | otherwise = process
    where process = do
            l <- readInput
            let nsx = Set.insert (l !! 0) (fst r)
            let nsy = Set.insert (l !! 1) (snd r)
            let newN = answer (nsx, nsy) n
            putStr (show $ answer (nsx, nsy) n)
            putStr " "
            processLine n (k-1) (nsx, nsy)

main :: IO [()]
main = do
    nm <- readInput
    let sx = Set.empty
    let sy = Set.empty
    let n = (nm !! 0)

    processLine n (nm !! 1) (sx, sy)

import Data.List

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    rocks <- (map (map read . words) . take m . lines) `fmap` getContents :: IO [[Int]]
    let rows = [y | [x,y] <- rocks]
    let cols = [x | [x,y] <- rocks]
    solve rows cols n [] []

solve [] [] _ _ _ = return ()
solve (r:rs) (c:cs) n prevRs prevCs = do
    let r_already = r `elem` prevRs
    let c_already = c `elem` prevCs
    let prevRs' = if r_already then prevRs else r:prevRs
    let prevCs' = if c_already then prevCs else c:prevCs
    putStrLn $ show $ (n - (length prevRs')) * (n - (length prevCs'))
    putChar ' '
    solve rs cs n prevRs' prevCs'

import Data.List
import System.IO

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    rocks <- (map (map read . words) . take m . lines) `fmap` getContents :: IO [[Int]]
    let rows = [y | [x,y] <- rocks]
    let cols = [x | [x,y] <- rocks]
    solve rows cols n [] []

solve [] [] _ _ _ = hFlush stdout
solve (r:rs) (c:cs) n prevRs prevCs = do
    let r_already = r `elem` prevRs
    let c_already = c `elem` prevCs
    let prevRs' = if r_already then prevRs else r:prevRs
    let prevCs' = if c_already then prevCs else c:prevCs
    putStr $ show $ (n - (length prevRs')) * (n - (length prevCs'))
    putChar ' '
    solve rs cs n prevRs' prevCs'

import Data.List

main = do
    [n,m] <- (map read . words) `fmap` getLine :: IO [Int]
    rocks <- (map (map read . words) . take m . lines) `fmap` getContents :: IO [[Int]]
    let rows = [y | [x,y] <- rocks]
    let cols = [x | [x,y] <- rocks]
    solve rows cols n [] []

solve [] [] _ _ _ = return ()
solve (r:rs) (c:cs) n prevRs prevCs = do
    let r_already = r `elem` prevRs
    let c_already = c `elem` prevCs
    let prevRs' = if r_already then prevRs else r:prevRs
    let prevCs' = if c_already then prevCs else c:prevCs
    putStr $ show $ (n - (length prevRs')) * (n - (length prevCs'))
    putChar ' '
    solve rs cs n prevRs' prevCs'

import Data.IntSet hiding (map)
main = interact $  solve . map (map (read::String->Int) . words) . lines
solve  ([n,_]:xs) = let go [] _ _ _ = []
                        go ([a,b]:xs) (r,rs) (c,cs) k = let k' = k - 2 * n + 1 + r + c
                                                            (r',rs',k'') = if member a rs then (r, rs, k'+1) else (r+1, insert a rs, k')
                                                            (c',cs',k''') = if member b cs then (c, cs,k''+1) else (c+1, insert b cs, k'')
                                                        in k''' : go xs (r',rs') (c',cs') k'''
                 in unwords . map show $ go xs (0,empty) (0,empty) (n*n)

import Data.IntSet hiding (map)
main = interact $  solve . map (map (read::String->Int) . words) . lines
solve  ([n',_]:xs) = let n = toInteger n'
                         go [] _ _ _ = []
                         go ([a,b]:xs) (r,rs) (c,cs) k = let k' = k - 2 * n + 1
                                                             (r',rs',k'') = if member a rs then (r, rs, k'+n-1) else (r+1, insert a rs, k'+c)
                                                             (c',cs',k''') = if member b cs then (c, cs,k''+n-1) else (c+1, insert b cs, k''+r)
                                                        in k''' : go xs (r',rs') (c',cs') k'''
                 in unwords . map show $ go xs (0,empty) (0,empty) (n*n)

import Data.IntSet hiding (map)
main = interact $  solve . map (map (read::String->Int) . words) . lines
solve  ([n',_]:xs) = let n = toInteger n'
                         go [] _ _ _ = []
                         go ([a,b]:xs) (r,rs) (c,cs) k = let k' = k - 2 * n + 1 + r + c
                                                             (r',rs',k'') = if member a rs then (r, rs, k'+1) else (r+1, insert a rs, k')
                                                             (c',cs',k''') = if member b cs then (c, cs,k''+1) else (c+1, insert b cs, k'')
                                                        in k''' : go xs (r',rs') (c',cs') k'''
                 in unwords . map show $ go xs (0,empty) (0,empty) (n*n)

import Control.Applicative
import qualified Data.Map as Map

solve :: [Int] -> Int -> Int -> Map.Map Int Int -> Map.Map Int Int -> (Int, Map.Map Int Int, Map.Map Int Int)
solve [rPos,cPos] n curAtt rAtt cAtt = (curAtt + newRowAtt + newColAtt - p, Map.insert rPos 0 rAtt, Map.insert cPos 0 cAtt)
    where newRowAtt = case Map.member rPos rAtt of
                        True -> 0
                        False -> n - (Map.size cAtt)
          newColAtt = case Map.member cPos cAtt of
                        True -> 0
                        False -> n - (Map.size rAtt)
          p | not (Map.member cPos cAtt) && not (Map.member rPos rAtt) = 1
            | otherwise = 0

solve1 :: [[Int]] -> Int -> Int -> Map.Map Int Int -> Map.Map Int Int -> IO ()
solve1 [] _ _ _ _ = return ()
solve1 (x:xs) n curAtt rAtt cAtt = do
                                let (res, newRAtt, newCAtt) = solve x n curAtt rAtt cAtt
                                putStr . show $ n * n - res
                                putStr " "
                                solve1 xs n res newRAtt newCAtt

main :: IO ()
main = do
        [n,m] <- map read . words <$> getLine
        lines <- mapM (\_ -> map (read :: String -> Int) . words <$> getLine) [1..m]
        solve1 lines n 0 Map.empty Map.empty
        putStrLn ""

import Control.Monad
import System.IO
import qualified Data.Set as Set

type Result = (Set.Set Int, Set.Set Int)

readInput :: IO [Int]
readInput = fmap ((map read) . words) getLine

freeCells :: Int -> Int -> Int -> Int
freeCells n nx ny = n * n - (n * nx) - ((n - nx) * ny)

answer :: Result -> Int -> Int
answer r n  = freeCells n (Set.size (fst r)) (Set.size (snd r))

processLine :: Int -> Int -> Result -> IO [()]
processLine n k r
    | k == 0 = return [()]
    | otherwise = process
    where process = do
            l <- readInput
            let nsx = Set.insert (l !! 0) (fst r)
            let nsy = Set.insert (l !! 1) (snd r)
            let newN = answer (nsx, nsy) n
            putStr (show $ answer (nsx, nsy) n)
            putStr " "
            processLine n (k-1) (nsx, nsy)

main :: IO [()]
main = do
    nm <- readInput
    let sx = Set.empty
    let sy = Set.empty
    let n = (nm !! 0)

    processLine n (nm !! 1) (sx, sy)


Tomorrow is a difficult day for Polycarp: he has to attend $$$a$$$ lectures and $$$b$$$ practical classes at the university! Since Polycarp is a diligent student, he is going to attend all of them.While preparing for the university, Polycarp wonders whether he can take enough writing implements to write all of the lectures and draw everything he has to during all of the practical classes. Polycarp writes lectures using a pen (he can't use a pencil to write lectures!); he can write down $$$c$$$ lectures using one pen, and after that it runs out of ink. During practical classes Polycarp draws blueprints with a pencil (he can't use a pen to draw blueprints!); one pencil is enough to draw all blueprints during $$$d$$$ practical classes, after which it is unusable.Polycarp's pencilcase can hold no more than $$$k$$$ writing implements, so if Polycarp wants to take $$$x$$$ pens and $$$y$$$ pencils, they will fit in the pencilcase if and only if $$$x + y \le k$$$.Now Polycarp wants to know how many pens and pencils should he take. Help him to determine it, or tell that his pencilcase doesn't have enough room for all the implements he needs tomorrow!Note that you don't have to minimize the number of writing implements (though their total number must not exceed $$$k$$$).

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases in the input. Then the test cases follow. Each test case is described by one line containing five integers $$$a$$$, $$$b$$$, $$$c$$$, $$$d$$$ and $$$k$$$, separated by spaces ($$$1 \le a, b, c, d, k \le 100$$$) — the number of lectures Polycarp has to attend, the number of practical classes Polycarp has to attend, the number of lectures which can be written down using one pen, the number of practical classes for which one pencil is enough, and the number of writing implements that can fit into Polycarp's pencilcase, respectively. In hacks it is allowed to use only one test case in the input, so $$$t = 1$$$ should be satisfied.

For each test case, print the answer as follows: If the pencilcase can't hold enough writing implements to use them during all lectures and practical classes, print one integer $$$-1$$$. Otherwise, print two non-negative integers $$$x$$$ and $$$y$$$ — the number of pens and pencils Polycarp should put in his pencilcase. If there are multiple answers, print any of them. Note that you don't have to minimize the number of writing implements (though their total number must not exceed $$$k$$$).

NoteThere are many different answers for the first test case; $$$x = 7$$$, $$$y = 1$$$ is only one of them. For example, $$$x = 3$$$, $$$y = 1$$$ is also correct.$$$x = 1$$$, $$$y = 3$$$ is the only correct answer for the third test case.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = readInt >>= flip replicateM solve >>= mapM_ putStrLn

solve = do
	[ a, b, c, d, k ] <- readInts
	let
		pen = ( a + c - 1 ) `div` c
		pencil = ( b + d - 1 ) `div` d
	return $ if pen + pencil <= k
		then unwords $ map show [ pen, pencil ]
		else "-1"

import Data.Function
solve [a,b,c,d,k] =
    let e = ceiling $ fromIntegral a / fromIntegral c
        f = ceiling $ fromIntegral b / fromIntegral d
    in if e + f <= k then show e ++ " " ++ show f else "-1"

main = interact $  unlines . map (solve . map (read :: String -> Int) . words ) . tail .lines

import Data.List
import Control.Monad

main = do
  line <- words <$> getLine
  let t = read $ head line :: Int
  replicateM_ t $ do
    line <- words <$> getLine
    let [a,b,c,d,k] = read <$> line :: [Double]
        a' = ceiling $ a / c :: Int
        b' = ceiling $ b / d :: Int
        s = a' + b'
    putStrLn $ if s > round k then "-1"
                              else show a' ++ " " ++ show b'

import Control.Monad

data Ans = None | Ans Int Int

instance Show Ans where
  show None = "-1"
  show (Ans n m) = unwords $ fmap show [n, m]

solve :: Int -> Int -> Int -> Int -> Int -> Ans
solve lectures blueprints penUse pencilUse k =
  let (pen, pen') = lectures `quotRem` penUse
      (pencil, pencil') = blueprints `quotRem` pencilUse
      numPens = pen + (fromEnum $ (pen' /= 0))
      numPencils = pencil + (fromEnum $ (pencil' /= 0))
      tot = numPens + numPencils
  in
    if tot > k then None else Ans numPens numPencils

main = do
  numCases <- read <$> getLine
  replicateM numCases $ do
    [lectures, blueprints, penUse, pencilUse, k] <- fmap read <$> words <$> getLine
    print $ solve lectures blueprints penUse pencilUse k

module Main where

count :: [Int] -> Int -> Int -> Int
count ar x y =
  if (rem (ar !! x) (ar !! y)) == 0
    then div (ar !! x) (ar !! y)
    else (+1) $ div (ar !! x) (ar !! y)

evaluate :: Int -> [Int] -> [[String]] -> [[String]]
evaluate 0 x r = r
evaluate n x r = do
  let y = take 5 x
  let r1 = count y 0 2
  let r2 = count y 1 3
  let rm = r ++ ( if (r1 + r2) > (y !! 4)
          then [[show (-1)]]
          else [[show r1, show r2]])
  evaluate (n - 1) (drop 5 x) rm

solve x = evaluate (head x) (tail x) []

main :: IO ()
main =  interact $ unlines . map unwords . solve . map read . words

-- main = do
--   input <- getLine
--   print $ unlines $ map unwords $ solve $ map read $ words input

-- main = do
--   input <- getLine
--   let arr = ((map read $ words input) :: [Int])
--   print $ unlines $ map unwords $ evaluate (head arr) (tail arr) []

-- main = interact $
--   lines >>> map (words >>> map read >>> solve >>> show) >>> unlines
--
-- solve :: [Integer] -> Integer
-- solve [a,b] = abs (a-b)

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

ans a b c d k  | z >k = "-1"
               | otherwise = show z1 ++ " " ++ show z2

	where 	z1= (div (a-1) c )+1
		z2 = (div (b-1) d) +1
		z= z1+z2

onecase= do
	   [a,b,c,d,k]<-map read <$> words <$> getLine::IO [Int]
           putStrLn $ ans a b c d k

main::IO ()
main=do
  t<- read <$> getLine ::IO Int
  replicateM_ t onecase

--ghc 7.10

organizeBox c1 c2 l1 l2 k
    | x + y > k = Nothing
    | otherwise = Just (x,y)
    where
        x = (c1 + l1 - 1) `div` l1
        y = (c2 + l2 - 1) `div` l2

showResult :: Maybe (Int,Int) -> String
showResult r = case r of
                Just (x,y) -> unwords [show x, show y]
                Nothing -> show (-1)

main = do
    tStr <- getLine
    contents <- getContents
    let qs = map (map read . words) . lines $ contents
    let rs = map (\[c1,c2,l1,l2,k] -> organizeBox c1 c2 l1 l2 k) qs
    sequence . map putStrLn . map showResult $ rs


Madoka is a very strange girl, and therefore she suddenly wondered how many pairs of integers $$$(a, b)$$$ exist, where $$$1 \leq a, b \leq n$$$, for which $$$\frac{\operatorname{lcm}(a, b)}{\operatorname{gcd}(a, b)} \leq 3$$$.In this problem, $$$\operatorname{gcd}(a, b)$$$ denotes the greatest common divisor of the numbers $$$a$$$ and $$$b$$$, and $$$\operatorname{lcm}(a, b)$$$ denotes the smallest common multiple of the numbers $$$a$$$ and $$$b$$$.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Description of the test cases follows. The first and the only line of each test case contains the integer $$$n$$$ ($$$1 \le n \le 10^8$$$).

For each test case output a single integer — the number of pairs of integers satisfying the condition.

NoteFor $$$n = 1$$$ there is exactly one pair of numbers — $$$(1, 1)$$$ and it fits.For $$$n = 2$$$, there are only $$$4$$$ pairs — $$$(1, 1)$$$, $$$(1, 2)$$$, $$$(2, 1)$$$, $$$(2, 2)$$$ and they all fit.For $$$n = 3$$$, all $$$9$$$ pair are suitable, except $$$(2, 3)$$$ and $$$(3, 2)$$$, since their $$$\operatorname{lcm}$$$ is $$$6$$$, and $$$\operatorname{gcd}$$$ is $$$1$$$, which doesn't fit the condition.

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  printf '%s\n' 1 100 | ./a.out | nl  &&  cat -- lcmgcd.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

import System.IO
import Control.Monad

ri = readLn :: IO Int

main = do
    t   <- ri
    tcs <- replicateM t ri
    mapM_ (putStrLn.show.solve) tcs

solve n = n + 2*(n`div`2 + n`div`3)


You are given a string $$$s$$$. Each character is either 0 or 1.You want all 1's in the string to form a contiguous subsegment. For example, if the string is 0, 1, 00111 or 01111100, then all 1's form a contiguous subsegment, and if the string is 0101, 100001 or 11111111111101, then this condition is not met.You may erase some (possibly none) 0's from the string. What is the minimum number of 0's that you have to erase?

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ lines follow, each representing a test case. Each line contains one string $$$s$$$ ($$$1 \le |s| \le 100$$$); each character of $$$s$$$ is either 0 or 1.

Print $$$t$$$ integers, where the $$$i$$$-th integer is the answer to the $$$i$$$-th testcase (the minimum number of 0's that you have to erase from $$$s$$$).

NoteIn the first test case you have to delete the third and forth symbols from string 010011 (it turns into 0111).

import Control.Arrow

main = interact $
  lines >>> drop 1 >>> map (solve >>> show) >>> unlines

solve :: String -> Int
solve s = (length . trim . reverse . trim) s - ones s
  where
    trim :: String -> String
    trim ('0':xs) = trim xs
    trim xs = xs
    ones :: String -> Int
    ones [] = 0
    ones ('0':xs) = ones xs
    ones ('1':xs) = 1 + ones xs

import Control.Monad

countZeros :: [Char] -> Integer
countZeros = toInteger . length . filter (=='0')

removeZeros :: [Char] -> [Char]
removeZeros = dropWhile (=='0')

countInternalZeros :: [Char] -> Integer
countInternalZeros = countZeros . removeZeros . reverse . removeZeros

main = do
    x <- getLine
    stringInputs <- replicateM (read x) getLine
    mapM_ putStrLn (map (show . countInternalZeros) stringInputs)

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

main = getLine >> getContents >>= putStrLn.unlines.map (show.length.filter (== '0').dropWhile (== '0').reverse.dropWhile (== '0')).words

--Bonus points for one-liner!

import Control.Monad

import Prelude
main = do
    x <- getLine
    strNums <- replicateM (read x) getLine
    mapM_ putStrLn (mf strNums)
mf = map f

removePref [] = []
removePref ('1':t) = ('1':t)
removePref ('0':t) = removePref t

trim = reverse . removePref . reverse . removePref
countZeros = length . (filter (=='0'))

f = show . countZeros . trim

import Control.Monad
import Data.List

getInt :: IO Int
getInt = fmap read getLine

main = do
    t <- getInt
    replicateM_ t $ do
        s <- getLine
        print $ solve s

solve s = foldl' count0 0 midPart
  where count0 acc ch | ch == '0' = acc + 1
                      | ch == '1' = acc
        midPart = dropWhileEnd (=='0') $ dropWhile (=='0') s

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

process x = length $ filter (=='0') x2
	where x1=dropWhile (=='0') x
              x2= dropWhile (=='0') $ reverse x1

main = do
		n<- read <$>  getLine::IO Int
		x<- replicateM n getLine
		mapM_ print $ map process x

--ghc 7.10

import Data.List(dropWhileEnd)

eraseInZeros :: String -> Int
eraseInZeros = length . filter (=='0') . dropWhile (=='0') . dropWhileEnd (=='0')

main = do
    nStr <- getLine
    contents <- getContents
    let ss = lines contents
    sequence . map print . map eraseInZeros $ ss

import Control.Monad
import Text.Printf

trim :: String -> String
trim = f . f
  where f = reverse . dropWhile (=='0')

main = do
  i <- getLine
  let t = read i :: Integer
  forM_ [1..t] $ \ _ -> do
    ii <- getLine
    let c = length $ filter (=='0') $ trim ii
    printf "%v\n" c

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

process x = length $ filter (=='0') x2
	where x1=dropWhile (=='0') x
              x2= dropWhile (=='0') $ reverse x

main = do
		n<- read <$>  getLine::IO Int
		x<- replicateM n getLine
		mapM_ print $ map process x


Nastia has $$$2$$$ positive integers $$$A$$$ and $$$B$$$. She defines that:  The integer is good if it is divisible by $$$A \cdot B$$$;  Otherwise, the integer is nearly good, if it is divisible by $$$A$$$. For example, if $$$A = 6$$$ and $$$B = 4$$$, the integers $$$24$$$ and $$$72$$$ are good, the integers $$$6$$$, $$$660$$$ and $$$12$$$ are nearly good, the integers $$$16$$$, $$$7$$$ are neither good nor nearly good.Find $$$3$$$ different positive integers $$$x$$$, $$$y$$$, and $$$z$$$ such that exactly one of them is good and the other $$$2$$$ are nearly good, and $$$x + y = z$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10\,000$$$) — the number of test cases. The first line of each test case contains two integers $$$A$$$ and $$$B$$$ ($$$1 \le A \le 10^6$$$, $$$1 \le B \le 10^6$$$) — numbers that Nastia has.

For each test case print:    "YES" and $$$3$$$ different positive integers $$$x$$$, $$$y$$$, and $$$z$$$ ($$$1 \le x, y, z \le 10^{18}$$$) such that exactly one of them is good and the other $$$2$$$ are nearly good, and $$$x + y = z$$$.  "NO" if no answer exists.  YES NO If there are multiple answers, print any.

NoteIn the first test case: $$$60$$$ — good number; $$$10$$$ and $$$50$$$ — nearly good numbers.In the second test case: $$$208$$$ — good number; $$$169$$$ and $$$39$$$ — nearly good numbers.In the third test case: $$$154$$$ — good number; $$$28$$$ and $$$182$$$ — nearly good numbers.

-- user: nel_tu_
-- path: https://codeforces.com/problemset/problem/1521/A
-- tags: math

solve [_, 1] = Nothing
solve [a, b] = Just [a, 2*a*b - a, 2*a*b]

input = map (map read . words) . tail . lines
output = maybe "NO" $ ("YES\n" ++) . unwords . map show

main = interact $ unlines . map (output . solve) . input

-- user: nel_tu_
-- path: https://codeforces.com/problemset/problem/1521/A
-- tags: math

import Control.Monad ( replicateM )

solve :: [Integer] -> Maybe [Integer]
solve [_, 1] = Nothing
solve [a, b] = Just [a, 2*a*b - a, 2*a*b]

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
    n <- getInt
    replicateM n (solve <$> getInts) >>= putStrLn . unlines
          . concatMap (maybe ["NO"] $ ("YES":) . pure . unwords . map show)

-- user: nel_tu_
-- path: https://codeforces.com/problemset/problem/1521/A
-- tags: math

import Control.Monad ( replicateM )

solve :: [Integer] -> Maybe [Integer]
solve [_, 1] = Nothing
solve [a, 2] = Just [a, 3*a, 4*a]
solve [a, b] = Just [a, a*b - a, a*b]

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
    n <- getInt
    replicateM n (solve <$> getInts) >>= putStrLn . unlines
          . concatMap (maybe ["NO"] $ ("YES":) . pure . unwords . map show)

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

readInts = fmap (map read.words) getLine :: IO [Integer]
printArray [] = ""
printArray (x:xs) = show(x) ++" " ++ printArray xs

printS = do
    [a,b]<-readInts
    if b == 1 then putStrLn"NO"
    else do
        putStrLn"YES"
        if b == 2 then
            putStrLn $ show(a) ++" " ++ show(3*a) ++ " "++show(4*a)
        else
            putStrLn $ show(a) ++ " " ++ show((b-1)*a) ++ " " ++ show(b*a)

main = do
    t<-readLn
    replicateM_ t printS

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

printResult = do
    [a,b] <- readInts
    if b == 1 then putStrLn "NO"
    else do
        let r = [a,a*b,(b+1)*a]
        putStrLn "YES"
        putStrLn . unwords . map show $ r

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

module Main where

    solve :: IO ()
    solve = do
        s <- getLine
        let [a, b] = map (\x -> read x :: Integer) $ words s
        putStrLn $
            if b == 1 then
                "NO"
            else
                concat $ ["YES\n"] ++ (map (\x -> show x ++ " ") $ [a, a * b, a * (b + 1)])

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Integer)

import Control.Monad

main = do
    t <- read <$> getLine
    replicateM_ t (getLine >>= putStrLn . solve . map read . words)

solve :: [Integer] -> String
solve [_, 1] = "NO"
solve [x, y] = "YES\n" ++ unwords (map show [x, x * y, x * y + x])
solve _ = error "Expected two element list."

-- user: nel_tu_
-- path: https://codeforces.com/problemset/problem/1521/A
-- tags: math

import Control.Monad ( replicateM )

solve :: [Int] -> Maybe [Int]
solve [_, 1] = Nothing
solve [a, 2] = Just [a, 3*a, 4*a]
solve [a, b] = Just [a, a*b - a, a*b]

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
    n <- getInt
    replicateM n (solve <$> getInts) >>= putStrLn . unlines
          . concatMap (maybe ["NO"] $ ("YES":) . pure . unwords . map show)

-- user: nel_tu_
-- path: https://codeforces.com/problemset/problem/1521/A
-- tags: math

import Control.Monad ( replicateM )

solve :: [Int] -> Maybe [Int]
solve [_, 1] = Nothing
solve [a, b] = Just [a, 2*a*b - a, 2*a*b]

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
    n <- getInt
    replicateM n (solve <$> getInts) >>= putStrLn . unlines
          . concatMap (maybe ["NO"] $ ("YES":) . pure . unwords . map show)

-- user: nel_tu_
-- path: https://codeforces.com/problemset/problem/1521/A
-- tags: math

import Control.Monad ( replicateM )

solve :: [Int] -> Maybe [Int]
solve [_, 1] = Nothing
solve [a, b] = Just [a, a*b - a, a*b]

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
    n <- getInt
    replicateM n (solve <$> getInts) >>= putStrLn . unlines
          . concatMap (maybe ["NO"] $ ("YES":) . pure . unwords . map show)

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

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

printS = do
    [a,b]<-readInts
    if mod a b == 0 then putStrLn"NO"
    else do
        putStrLn"YES"
        if b <= 2 then
            putStrLn $ show(a) ++" " ++ show(3*a) ++ " "++show(4*a)
        else
            putStrLn $ show(a) ++ " " ++ show((b-1)*a) ++ " " ++ show(b*a)

main = do
    t<-readLn
    replicateM_ t printS

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

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

printS = do
    [a,b]<-readInts
    putStrLn"YES"
    if b <= 2 then
        putStrLn $ show(a) ++" " ++ show(3*a) ++ " "++show(4*a)
    else
        putStrLn $ show(a) ++ " " ++ show((b-1)*a) ++ " " ++ show(b*a)

main = do
    t<-readLn
    replicateM_ t printS

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

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

printS = do
    [a,b]<-readInts
    putStrLn"YES"
    if b <= 2 then
        putStrLn $ show(a) ++" " ++ show(a) ++ " "++show(2*a)
    else
        putStrLn $ show(a) ++ " " ++ show((b-1)*a) ++ " " ++ show(b*a)

main = do
    t<-readLn
    replicateM_ t printS

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

printResult = do
    [a,b] <- readInts
    if b == 1 then putStrLn "NO"
    else do
        let r = [a,a*b,(b+1)*a]
        putStrLn "YES"
        putStrLn . unwords . map show $ r

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

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

printResult = do
    [a,b] <- readInts
    if b == 1 || mod a b == 0 then putStrLn "NO"
    else do
        let r = [a,a*b,(b+1)*a]
        putStrLn "YES"
        putStrLn . unwords . map show $ r

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

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

printResult = do
    [a,b] <- readInts
    if b == 1 || mod b a == 0 then putStrLn "NO"
    else do
        let r = [a,a*b,(b+1)*a]
        putStrLn "YES"
        putStrLn . unwords . map show $ r

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

module Main where

    solve :: IO ()
    solve = do
        s <- getLine
        let [a, b] = map (\x -> read x :: Integer) $ words s
        putStrLn $ concat $ map (\x -> show x ++ " ") $ [a, a * b, a * (b + 1)]

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Integer)

import Control.Monad

main = do
    t <- read <$> getLine
    replicateM_ t (getLine >>= putStrLn . solve . map read . words)

solve :: [Int] -> String
solve [_, 1] = "NO"
solve [x, y] = "YES\n" ++ unwords (map show [x, x * y, x * y + x])
solve _ = error "Expected two element list."


You are given an array of integers $$$a$$$ of length $$$n$$$. The elements of the array can be either different or the same. Each element of the array is colored either blue or red. There are no unpainted elements in the array. One of the two operations described below can be applied to an array in a single step:  either you can select any blue element and decrease its value by $$$1$$$;  or you can select any red element and increase its value by $$$1$$$. Situations in which there are no elements of some color at all are also possible. For example, if the whole array is colored blue or red, one of the operations becomes unavailable.Determine whether it is possible to make $$$0$$$ or more steps such that the resulting array is a permutation of numbers from $$$1$$$ to $$$n$$$?In other words, check whether there exists a sequence of steps (possibly empty) such that after applying it, the array $$$a$$$ contains in some order all numbers from $$$1$$$ to $$$n$$$ (inclusive), each exactly once.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of input data sets in the test. The description of each set of input data consists of three lines. The first line contains an integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the length of the original array $$$a$$$. The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$-10^9 \leq a_i \leq 10^9$$$) — the array elements themselves. The third line has length $$$n$$$ and consists exclusively of the letters 'B' and/or 'R': $$$i$$$th character is 'B' if $$$a_i$$$ is colored blue, and is 'R' if colored red. It is guaranteed that the sum of $$$n$$$ over all input sets does not exceed $$$2 \cdot 10^5$$$.

Print $$$t$$$ lines, each of which contains the answer to the corresponding test case of the input. Print YES as an answer if the corresponding array can be transformed into a permutation, and NO otherwise. You can print the answer in any case (for example, the strings yEs, yes, Yes, and YES will be recognized as a positive answer).

NoteIn the first test case of the example, the following sequence of moves can be performed:  choose $$$i=3$$$, element $$$a_3=5$$$ is blue, so we decrease it, we get $$$a=[1,2,4,2]$$$;  choose $$$i=2$$$, element $$$a_2=2$$$ is red, so we increase it, we get $$$a=[1,3,4,2]$$$;  choose $$$i=3$$$, element $$$a_3=4$$$ is blue, so we decrease it, we get $$$a=[1,3,3,2]$$$;  choose $$$i=2$$$, element $$$a_2=2$$$ is red, so we increase it, we get $$$a=[1,4,3,2]$$$. We got that $$$a$$$ is a permutation. Hence the answer is YES.

import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as B
import Data.List (sort)
import Data.Maybe (fromJust)

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

main :: IO ()
main = do
  t <- fst . fromJust . B.readInt <$> B.getLine
  replicateM_ t $ do
    n <- fst . fromJust . B.readInt <$> B.getLine
    a <- readInts
    s <- B.unpack <$> B.getLine
    let xs = sort $ zip s a
    B.putStrLn $ if all (== True) $ zipWith check [1 .. n] xs then B.pack "YES" else B.pack "NO"
  where
    check i (c, x) = (c == 'R' && i >= x) || (c == 'B' && i <= x)

{-
    greedy algorithms:
    - group and sort ai with its color => two lists r, b
    - consider each number i in the permutation 1..n in increased order
      if the list b is not empty
          if the minimum element of b is less than i, then no transformed solution, because we cannot increase the value of any element in b
          otherwise we use and delete it from b and consider (i+1)
              Why we don't use other elements in b? Because we consider i in increased order, the minimum element of b is the worst case in the future.
              Why we don't use elements in r? Because for each element r' in r, if r' < i which means r'will always be valid in the future, otherwise we cannot use r' currently.
      else if the list r is not empty
          if the minimum element of r is greater than i, then no solution of course
          otherwise we use and delete it from r and consider (i+1)
      otherwise it means we find a solution.
-}

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

mysplit :: [Int] -> String -> Char -> [Int]
mysplit [] _ _ = []
mysplit (x:x1) (s:s1) key
    | s == key = x: (mysplit x1 s1 key)
    | otherwise = mysplit x1 s1 key

checker :: Int -> [Int] -> [Int] -> Bool
checker _ [] [] = True
checker n r (b:b1)
    | b < n = False
    | otherwise = checker (n+1) r b1
checker n (r:r1) []
    | r > n = False
    | otherwise = checker (n+1) r1 []

process 0 = return ()
process t = do
    n <- getInt
    vals <- getIntList
    keys <- getLine
    let r = sort $ mysplit vals keys 'R'
    let b = sort $ mysplit vals keys 'B'
    putStrLn $ if (checker 1 r b) then "YES" else "NO"
    process (t-1)

main = do
    t <- getInt
    process t

{-
    (pos, delta)
    (0,1) -> (1,0) -> (1,1) -> (0,0) -> (0,1) ...
    (1,1) -> (0,0) -> (0,1) -> (1,0) -> (1,1) ...
    which mean if the init position is even, and the action list is (-1 +2 +3 -4), (-5 +6 +7 -8), ...
    and if the init position is odd, then the action list is (+1 -2 -3 +4), (+5 -6 -7 +8), ...
-}

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

mysplit :: [Int] -> String -> Char -> [Int]
mysplit [] _ _ = []
mysplit (x:x1) (s:s1) key
    | s == key = x: (mysplit x1 s1 key)
    | otherwise = mysplit x1 s1 key

checker :: Int -> [Int] -> [Int] -> Bool
checker _ [] [] = True
checker n r (b:b1)
    | b < n = False
    | otherwise = checker (n+1) r b1
checker n (r:r1) []
    | r > n = False
    | otherwise = checker (n+1) r1 []

process 0 = return ()
process t = do
    n <- getInt
    vals <- getIntList
    keys <- getLine
    let r = sort $ reverse $ mysplit vals keys 'R'
    let b = sort $ reverse $ mysplit vals keys 'B'
    putStrLn $ if (checker 1 r b) then "YES" else "NO"
    process (t-1)

main = do
    t <- getInt
    process t

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

solve :: IO ()
solve = do
    ~[n] <- readInts
    xs <- readInts
    cs <- map (=='B') . C.unpack <$> C.getLine
    let (blues, reds) = partition fst $ sort $ zip cs xs
        ok = all (uncurry (<=)) (zip [1..] (map snd blues)) &&
             all (uncurry (>=)) (zip [length blues+1 ..] (map snd reds))
    putStrLn $ if ok then "YES" else "NO"

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

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


Cengiz recently learned Fibonacci numbers and now he is studying different algorithms to find them. After getting bored of reading them, he came with his own new type of numbers that he named XORinacci numbers. He defined them as follows:   $$$f(0) = a$$$;  $$$f(1) = b$$$;  $$$f(n) = f(n-1) \oplus f(n-2)$$$ when $$$n > 1$$$, where $$$\oplus$$$ denotes the bitwise XOR operation. You are given three integers $$$a$$$, $$$b$$$, and $$$n$$$, calculate $$$f(n)$$$.You have to answer for $$$T$$$ independent test cases.

The input contains one or more independent test cases. The first line of input contains a single integer $$$T$$$ ($$$1 \le T \le 10^3$$$), the number of test cases. Each of the $$$T$$$ following lines contains three space-separated integers $$$a$$$, $$$b$$$, and $$$n$$$ ($$$0 \le a, b, n \le 10^9$$$) respectively.

NoteIn the first example, $$$f(2) = f(0) \oplus f(1) = 3 \oplus 4 = 7$$$.

import Data.Bits

f -. g = g . f

main = do
	getLine
	interact $ lines -. map words -. map (map read) -. map foo -. map show -. unlines

foo :: [Int] -> Int
foo (a:b:n:[]) =
	case (mod n 3) of
		0 -> a
		1 -> b
		2 -> xor a b

import Data.List
import System.IO
import Text.Read
import Data.Bits

f :: Integer -> Integer -> Integer -> Integer
f a b 0 = a
f a b 1 = b
f a b 2 = xor a b

solve s =
    do
      let (a:b:n:_) = (map read.words) s :: [Integer]
      print $ (f a b (mod n 3))

work 0 = return ()
work m =
    do
        input <- getLine
        solve input
        work $ m-1

main =
    do
        input <- getLine
        let m = read input :: Int
        work m

import           Data.Bits

main :: IO ()
main =
  interact
    $ unlines
    . map processLine
    . filter ((== 3) . length)
    . map words
    . tail
    . lines

processLine :: [String] -> String
processLine = show . bindListToCurry3 xorinacci . map read

bindListToCurry3 :: (a -> a -> a -> b) -> [a] -> b
bindListToCurry3 f [a, b, c] = f a b c

xorinacci :: Int -> Int -> Int -> Int
xorinacci a _ 0 = a
xorinacci _ b 1 = b
xorinacci a b 2 = a `xor` b
xorinacci a b n = xorinacci a b (n `mod` 3)

import Data.List
import System.IO
import Text.Read
import Data.Bits

f :: Integer -> Integer -> Integer -> Integer
f a b n
        | n == 0 = a
        | n == 1 = b
        | otherwise = xor a b

doTimes 0 = return ()
doTimes n =
    do
      input  <- getLine
      solve input
      doTimes (n - 1)

solve s =
    do
      let (a:b:n:_) = (map read.words) s :: [Integer]
      -- print $ (f a b (mod n 3))
      print $ (f a b (mod n 3))

main =
    do
      input  <- getLine
      let m = read input :: Int
      doTimes m