A superhero fights with a monster. The battle consists of rounds, each of which lasts exactly $$$n$$$ minutes. After a round ends, the next round starts immediately. This is repeated over and over again.Each round has the same scenario. It is described by a sequence of $$$n$$$ numbers: $$$d_1, d_2, \dots, d_n$$$ ($$$-10^6 \le d_i \le 10^6$$$). The $$$i$$$-th element means that monster's hp (hit points) changes by the value $$$d_i$$$ during the $$$i$$$-th minute of each round. Formally, if before the $$$i$$$-th minute of a round the monster's hp is $$$h$$$, then after the $$$i$$$-th minute it changes to $$$h := h + d_i$$$.The monster's initial hp is $$$H$$$. It means that before the battle the monster has $$$H$$$ hit points. Print the first minute after which the monster dies. The monster dies if its hp is less than or equal to $$$0$$$. Print -1 if the battle continues infinitely.

The first line contains two integers $$$H$$$ and $$$n$$$ ($$$1 \le H \le 10^{12}$$$, $$$1 \le n \le 2\cdot10^5$$$). The second line contains the sequence of integers $$$d_1, d_2, \dots, d_n$$$ ($$$-10^6 \le d_i \le 10^6$$$), where $$$d_i$$$ is the value to change monster's hp in the $$$i$$$-th minute of a round.

Print -1 if the superhero can't kill the monster and the battle will last infinitely. Otherwise, print the positive integer $$$k$$$ such that $$$k$$$ is the first minute after which the monster is dead.

{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.Int
import Data.List

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

rl :: C.ByteString -> Int64
rl s = fromInteger r
  where Just (r, _) = C.readInteger s

ceil u v = let (a, b) = divMod u v in a + (if b > 0 then 1 else 0)

test :: Int64 -> Int -> [Int] -> Int64
test !h !n !d
  | h' > 0 && v >= 0 = -1
  | h' <= 0 = succ $ fromIntegral $ length $ takeWhile (\x -> h + x > 0) s
  | otherwise = (o * (fromIntegral n)) + (fromIntegral $ succ $ length $ takeWhile (\x -> h'' + x > 0) s)
  where
    s :: [Int64]
    s = scanl1 (+) $ map fromIntegral d
    u = minimum s
    v = last s
    h' = h + u
    v' = negate v
    o = ceil h' v'
    h'' = h + v * o

solve :: [C.ByteString] -> Int64
solve (sh:sn:a) = test h n d
  where
    h = rl sh
    n = ri sn
    d = take n $ map ri a

main :: IO ()
main = print . solve . C.words =<< C.getContents

import Data.List (foldl1', find)
import Data.Maybe (fromJust)
diffs d = scanl1 (+) d

solve :: [Integer] -> Integer -> Integer -> Integer
solve diff hp n =
  let
    dt = zip diff [1..]
    cmpp p1@(d1, i1) p2@(d2, i2)
      | d1 < d2 = p1
      | d1 > d2 = p2
      | otherwise = if i1 < i2 then p1 else p2
    (mind, mini) = foldl1' cmpp dt
    cycled = last diff
  in
    if hp + mind <= 0 then snd . fromJust . (find (\(d, _) -> hp + d <= 0)) $ dt
    else if cycled >= 0 then -1
    else
      let
        cycles1 = (hp + mind) `div` (abs cycled)
        findTime cycles rhp
          | rhp + mind > 0 = findTime (cycles + 1) (rhp + cycled)
          | otherwise  =
              let
                ind = snd . fromJust . (find (\(d, _) -> rhp + d <= 0)) $ dt
              in
                cycles * n + ind
      in
        findTime cycles1 (hp + cycles1 * cycled)

main = do
  [hp, n] <- (map read) . words <$> getLine
  diff <- diffs . (map read) . words <$> getLine
  putStrLn . show $ solve diff hp n

import Data.List (foldl1', find)
import Data.Maybe (fromJust)
diffs d = scanl1 (+) d

solve :: [Integer] -> Integer -> Integer -> Integer
solve diff hp n =
  let
    dt = zip diff [1..]
    cmpp p1@(d1, i1) p2@(d2, i2)
      | d1 < d2 = p1
      | d1 > d2 = p2
      | otherwise = if i1 < i2 then p1 else p2
    (mind, mini) = foldl1' cmpp dt
    cycled = last diff
  in
    if hp + mind <= 0 then snd . fromJust . (find (\(d, _) -> hp + d <= 0)) $ dt
    else if cycled >= 0 then -1
    else
      let
        cycles1 = (hp + mind) `div` (abs cycled)
        findTime cycles rhp
          | rhp + mind > 0 = findTime (cycles + 1) (rhp + cycled)
          | otherwise  =
              let
                ind = snd . fromJust . (find (\(d, _) -> rhp + d <= 0)) $ dt
              in
                cycles * n + ind
      in
        findTime cycles1 (hp + cycles1 * mind)

main = do
  [hp, n] <- (map read) . words <$> getLine
  diff <- diffs . (map read) . words <$> getLine
  putStrLn . show $ solve diff hp n

import Data.List (foldl1', find)
import Data.Maybe (fromJust)
diffs d = scanl1 (+) d

solve :: [Integer] -> Integer -> Integer -> Integer
solve diff hp n =
  let
    dt = zip diff [1..]
    cmpp p1@(d1, i1) p2@(d2, i2)
      | d1 < d2 = p1
      | d1 > d2 = p2
      | otherwise = if i1 < i2 then p1 else p2
    (mind, mini) = foldl1' cmpp dt
    cycled = last diff
  in
    if hp + mind <= 0 then mini
    else if cycled >= 0 then -1
    else
      let
        cycles1 = (hp + mind) `div` (abs cycled)
        findTime cycles rhp
          | rhp + mind > 0 = findTime (cycles + 1) (rhp + cycled)
          | otherwise  =
              let
                ind = snd . fromJust . (find (\(d, _) -> rhp + d <= 0)) $ dt
              in
                cycles * n + ind
      in
        findTime cycles1 (hp + cycles1 * mind)

main = do
  [hp, n] <- (map read) . words <$> getLine
  diff <- diffs . (map read) . words <$> getLine
  putStrLn . show $ solve diff hp n


Sereja has two sequences a and b and number p. Sequence a consists of n integers a1, a2, ..., an. Similarly, sequence b consists of m integers b1, b2, ..., bm. As usual, Sereja studies the sequences he has. Today he wants to find the number of positions q (q + (m - 1)·p ≤ n; q ≥ 1), such that sequence b can be obtained from sequence aq, aq + p, aq + 2p, ..., aq + (m - 1)p by rearranging elements.Sereja needs to rush to the gym, so he asked to find all the described positions of q.

The first line contains three integers n, m and p (1 ≤ n, m ≤ 2·105, 1 ≤ p ≤ 2·105). The next line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 109). The next line contains m integers b1, b2, ..., bm (1 ≤ bi ≤ 109).

In the first line print the number of valid qs. In the second line, print the valid values in the increasing order.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List(transpose,sort)
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m,p] <- readInts
    as <- readInts
    bs <- readInts
    let qs = solve n m p as bs
    print (length qs)
    putStrLn $ unwords $ map show qs

takeBy :: Int -> [Int] -> [[Int]]
takeBy p l = transpose $ go l
    where
    go [] = []
    go l = c:go cs
        where
        (c,cs) = splitAt p l

solve :: Int -> Int -> Int -> [Int] -> [Int] -> [Int]
solve n m p as bs = sort $ do
    (l,i) <- zip (takeBy p as) [1..]
    q <- matchIndices m bs l
    return (q*p + i)

insert :: M.Map Int Int -> Int -> M.Map Int Int
insert s v | not (M.member v s) = M.insert v 1 s
           | s M.! v == -1 = M.delete v s
           | otherwise = M.insertWith (+) v 1 s

delete :: M.Map Int Int -> Int -> M.Map Int Int
delete s v | not (M.member v s) = M.insert v (-1) s
           | s M.! v == 1 = M.delete v s
           | otherwise = M.insertWith (+) v (-1) s

matchIndices :: Int -> [Int] -> [Int] -> [Int]
matchIndices m bs l = go ds l (drop m l) 0
    where
    ds = foldl delete (foldl insert M.empty bs) (take m l)
    go ds _ [] i = if M.null ds then [i] else []
    go ds (b:bs) (c:cs) i | M.null ds = i:go ds' bs cs (i+1)
                          | otherwise = go ds' bs cs (i+1)
        where ds' = delete (insert ds b) c

import Data.List(transpose,sort)
import Data.Maybe
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst .B.readInt
readInts = fmap (map readInt . B.words) B.getLine

main = do
    [n,m,p] <- readInts
    as <- readInts
    bs <- readInts
    let qs = solve n m p as bs
    print (length qs)
    putStrLn $ unwords $ map show qs

takeBy :: Int -> [Int] -> [[Int]]
takeBy p l = transpose $ go l
    where
    go [] = []
    go l = c:go cs
        where (c,cs) = splitAt p l

solve :: Int -> Int -> Int -> [Int] -> [Int] -> [Int]
solve n m p as bs = sort $ do
    (l,i) <- zip (takeBy p as) [1..]
    q <- matchIndices m bs l
    return (q*p + i)

reduce :: M.Map Int Int -> Int -> M.Map Int Int
reduce s v = if s M.! v == 0 then M.delete v s else s

insert :: M.Map Int Int -> Int -> M.Map Int Int
insert s v = reduce (M.insertWith (+) v 1 s) v

delete :: M.Map Int Int -> Int -> M.Map Int Int
delete s v = reduce (M.insertWith (+) v (-1) s) v

matchIndices :: Int -> [Int] -> [Int] -> [Int]
matchIndices m bs l = go ds l (drop m l) 0
    where
    ds = foldl insert (foldl delete M.empty bs) (take m l)
    go ds _ [] i = if M.null ds then [i] else []
    go ds (b:bs) (c:cs) i | M.null ds = i:go ds' bs cs (i+1)
                          | otherwise = go ds' bs cs (i+1)
        where ds' = insert (delete ds b) c

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List(transpose,sort)
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m,p] <- readInts
    as <- readInts
    bs <- readInts
    let qs = solve n m p as bs
    print (length qs)
    putStrLn $ unwords $ map show qs

takeBy :: Int -> [Int] -> [[Int]]
takeBy p l = transpose $ go l
    where
    go [] = []
    go l = c:go cs
        where
        (c,cs) = splitAt p l

solve :: Int -> Int -> Int -> [Int] -> [Int] -> [Int]
solve n m p as bs = sort $ do
    (l,i) <- zip (takeBy p as) [1..]
    q <- matchIndices m bs l
    return (q*p + i)

insert :: M.Map Int Int -> Int -> M.Map Int Int
insert s v | not (M.member v s) = M.insert v 1 s
           | s M.! v == -1 = M.delete v s
           | otherwise = M.insertWith (+) v 1 s

delete :: M.Map Int Int -> Int -> M.Map Int Int
delete s v | not (M.member v s) = M.insert v (-1) s
           | s M.! v == 1 = M.delete v s
           | otherwise = M.insertWith (+) v (-1) s

matchIndices :: Int -> [Int] -> [Int] -> [Int]
matchIndices m bs l = go ds l (drop m l) 0
    where
    ds = foldl delete (foldl insert M.empty bs) (take m l)
    go ds _ [] i = if M.null ds then [i] else []
    go ds (b:bs) (c:cs) i | M.null ds = i:go ds' bs cs (i+1)
                          | otherwise = go ds' bs cs (i+1)
        where ds' = insert (delete ds b) c


Let's call the string beautiful if it does not contain a substring of length at least $$$2$$$, which is a palindrome. Recall that a palindrome is a string that reads the same way from the first character to the last and from the last character to the first. For example, the strings a, bab, acca, bcabcbacb are palindromes, but the strings ab, abbbaa, cccb are not.Let's define cost of a string as the minimum number of operations so that the string becomes beautiful, if in one operation it is allowed to change any character of the string to one of the first $$$3$$$ letters of the Latin alphabet (in lowercase).You are given a string $$$s$$$ of length $$$n$$$, each character of the string is one of the first $$$3$$$ letters of the Latin alphabet (in lowercase).You have to answer $$$m$$$ queries — calculate the cost of the substring of the string $$$s$$$ from $$$l_i$$$-th to $$$r_i$$$-th position, inclusive.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 2 \cdot 10^5$$$) — the length of the string $$$s$$$ and the number of queries. The second line contains the string $$$s$$$, it consists of $$$n$$$ characters, each character one of the first $$$3$$$ Latin letters. The following $$$m$$$ lines contain two integers $$$l_i$$$ and $$$r_i$$$ ($$$1 \le l_i \le r_i \le n$$$) — parameters of the $$$i$$$-th query.

For each query, print a single integer — the cost of the substring of the string $$$s$$$ from $$$l_i$$$-th to $$$r_i$$$-th position, inclusive.

NoteConsider the queries of the example test.  in the first query, the substring is baa, which can be changed to bac in one operation;  in the second query, the substring is baacb, which can be changed to cbacb in two operations;  in the third query, the substring is cb, which can be left unchanged;  in the fourth query, the substring is aa, which can be changed to ba in one operation.

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

import Control.Applicative (liftA2)
import Control.Monad (guard, replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)

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

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

solve :: String -> [(Int, Int)] -> [Int]
solve s = map compute
  where
    compute (l, r) = minimum $ do
      a <- [0 .. 2]
      b <- [0 .. 2]
      guard $ a /= b
      c <- [0 .. 2]
      guard $ c /= a && c /= b
      let matches =
            [ psum (freq !! ai !! mi) l r
              | ai <- [a, b, c]
              | mi <- map (`mod` 3) [l, l + 1, l + 2]
            ]
      return $ r - l + 1 - sum matches

    n = length s

    c2i 'a' = 0
    c2i 'b' = 1
    c2i 'c' = 2

    getFreq :: Int -> Int -> UArray Int Int
    getFreq c m =
      listArray (0, n) . scanl (+) 0 $
        [if c2i c' == c && i `mod` 3 == m then 1 else 0 | (c', i) <- zip s [1 .. n]]

    psum :: UArray Int Int -> Int -> Int -> Int
    psum arr l r
      | l > r = 0
      | otherwise = arr ! r - arr ! (l - 1)

    freq = [[getFreq c m | m <- [0 .. 2]] | c <- [0 .. 2]]

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    [n, m] <- readInts
    s <- C.unpack <$> C.getLine
    qs <- replicateM m readInts
    let pats = map cycle ["abc", "acb", "bac", "bca", "cab", "cba"]
        difs = map (listArray (0, n) . scanl (+) 0 . map fromEnum . zipWith (/=) s) pats
        qry [l, r] = minimum $ map (\d -> d!r - d!(l - 1)) difs
    putStr $ unlines $ map (show . qry) qs

parseInt = f . C.readInt where f (Just (i, _)) = i
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = solve


Companies always have a lot of equipment, furniture and other things. All of them should be tracked. To do this, there is an inventory number assigned with each item. It is much easier to create a database by using those numbers and keep the track of everything.During an audit, you were surprised to find out that the items are not numbered sequentially, and some items even share the same inventory number! There is an urgent need to fix it. You have chosen to make the numbers of the items sequential, starting with 1. Changing a number is quite a time-consuming process, and you would like to make maximum use of the current numbering.You have been given information on current inventory numbers for n items in the company. Renumber items so that their inventory numbers form a permutation of numbers from 1 to n by changing the number of as few items as possible. Let us remind you that a set of n numbers forms a permutation if all the numbers are in the range from 1 to n, and no two numbers are equal.

The first line contains a single integer n — the number of items (1 ≤ n ≤ 105). The second line contains n numbers a1, a2, ..., an (1 ≤ ai ≤ 105) — the initial inventory numbers of the items.

Print n numbers — the final inventory numbers of the items in the order they occur in the input. If there are multiple possible answers, you may print any of them.

NoteIn the first test the numeration is already a permutation, so there is no need to change anything.In the second test there are two pairs of equal numbers, in each pair you need to replace one number.In the third test you need to replace 2 by 1, as the numbering should start from one.

import qualified Data.List as L
import qualified Data.IntSet as S
import qualified Data.IntMap as M

main=interact$ solve. map read. words
solve (n:l) =  L.intercalate " " $ map show $ f 1 d
	where (m,s) = foldl (\(m,s) (x,i)->if S.member x s || x>n then (m,s) else (M.insert i x m, S.insert x s)) (M.empty,S.empty) $ zip l [1..n]
	      d = filter (flip S.notMember s) [1..n]
	      f c l
		|c>n   = []
		|otherwise = let v=M.lookup c m in if v==Nothing then head l : (f (c+1) $ tail l) else let Just v'=v in v': f(c+1) l

import Data.List

main=interact$solve.map read.words

solve (n:l) = (intercalate " " $ map show $  f l'' no 1)
        where l'=map head $ groupBy (\a b->fst a==fst b) $ sort $ filter (\x->fst x <= n) $ zip l [1..n]

              diff a [] = a
              diff [] b = []
              diff (a:as) bss@(b:bs)
                  | a==b = diff as bs
                  | a<b  = a : diff as bss

              no=diff [1..n] $ map fst l'
              l''=sortBy (\a b-> snd a `compare` snd b) l'

              f [] [] _ = []
              f a [] _ =  map fst a
              f [] b _ = b
              f ass@(a:as) bss@(b:bs) c
                  | c==snd a  = fst a: f as bss (c+1)
                  | otherwise = b : f ass bs (c+1)

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

solve :: [Int] -> Int -> [Int]
solve nums maxIdx =
  solve' unused nums (Set.fromList [])
  where
    unused = Set.toList $ Set.fromList [1..maxIdx] `Set.difference` Set.fromList nums
    solve' :: [Int] -> [Int] -> Set.Set Int -> [Int]
    solve' (u:rstUnused) (a:rstGroups) set | a `Set.member` set || a < 1 || a > maxIdx =
                                             u:solve' rstUnused rstGroups set
    solve' unused (a:rstGroups) set = a:solve' unused rstGroups (Set.insert a set)
    solve' _ [] _ = []

main = do
  maxIdx <- read <$> getLine
  nums <- map read . words <$> getLine
  putStrLn $ unwords $ map show $ solve nums maxIdx

import System.IO
import qualified Data.Set as S

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

solve :: [Int] -> S.Set Int -> Int -> [Int]
solve [] _ _ = []
solve (x:xs) st len = if S.member x st || x > len then 0 : solve xs st len else x : solve xs ( S.insert x st ) len

complete :: [Int] -> S.Set Int -> Int -> [Int]
complete [] _ _ = []
complete (x:xs) st y =
	if x == 0 then
		if S.member y st then
			complete (x:xs) st (y+1)
		else
			y : complete xs ( S.insert y st ) (y+1)
	else
		 x : complete xs st y

main = do
	ln <- getLine
	let [n] = read_ints ln
	ln <- getLine
	let arr = read_ints ln
	let len = length arr
	let ans = solve arr S.empty len
	putStr $ unwords $ map show $ complete ans (S.fromList arr) 1

import Data.List (intercalate)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString (ByteString)
import Data.Set (Set, delete, member, notMember, fromList)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8

loop :: [Int] -> Set Int -> [Int] -> [Int]
loop [] _ _ = []
loop (a:rest) obs out
    | a `member` obs = a:loop rest (a `delete` obs) out
    | otherwise = (head out):loop rest obs (tail out)

solve :: Int -> [Int] -> [Int]
solve n a = loop a obs out
    where
    obs = fromList . filter (< n + 1) $ a :: Set Int
    out = filter (`notMember` obs) [1..n] :: [Int]

parse :: ByteString -> Maybe [Int]
parse = sequence . fmap (fmap fst . B8.readInt) . B8.words

main = read <$> getLine >>= \n ->
    parse <$> B.getLine >>= \(Just a) ->
        putStrLn . intercalate " " . fmap show $ solve n a

import System.IO
import qualified Data.Set as S

read_ints :: String -> [Int]
read_ints ln = map read (words ln) :: [Int]

solve :: [Int] -> S.Set Int -> Int -> [Int]
solve [] _ _ = []
solve (x:xs) st len =
    if S.member x st || x > len then
        0 : solve xs st len
    else
        x : solve xs (S.insert x st) len

complete :: [Int] -> S.Set Int -> Int -> [Int]
complete [] _ _ = []
complete (x:xs) st y =
    if x == 0 then
        if S.member y st then
            complete (x:xs) st (y+1)
        else
            y : complete xs (S.insert y st) (y+1)
    else
        x : complete xs st y

main = do
    ln <- getLine
    let [n] = read_ints ln
    ln <- getLine
    let arr = read_ints ln
    let len = length arr
    let ans = solve arr S.empty len

    putStr $ unwords $ map show $ complete ans (S.fromList arr) 1

import Data.List (intersperse, groupBy, sortBy, sort)

parseInts :: String -> [Int]
parseInts = map read . words

showList' :: Show a => [a] -> String
showList' = concat . intersperse " " . map show

minus :: Ord a => [a] -> [a] -> [a]
minus a [] = a
minus [] _ = []
minus (a : as) (b : bs)
    | a == b = minus as bs
    | a < b = a : minus as (b : bs)
    | a > b = minus (a : as) bs

merge :: Int -> [(Int, Int)] -> [Int] -> [Int]
merge _ [] b = b
merge _ a [] = map snd a
merge p a@((k, v) : as) (b : bs)
    | p == k = v : merge (p + 1) as (b : bs)
    | p < k = b : merge (p + 1) a bs

solve :: [Int] -> [Int]
solve a = let n = length a
              id = filter (\(x, y) -> 1 <= y && y <= n) . zip [1 .. ] $ a
              s = let cmp (_, a) (_, b) = compare a b
                  in sortBy cmp id
              uni = let same (_, a) (_, b) = a == b
                    in map head . groupBy same $ s
              rem = [1 .. n] `minus` (sort . map snd $ uni)
              pos = let cmp (a, _) (b, _) = compare a b
                    in sortBy cmp uni
          in merge 1 pos rem

main :: IO ()
main = do
    getLine
    putStrLn . showList' . solve . parseInts =<< getLine

import qualified Data.List as L
import qualified Data.IntSet as S
import qualified Data.IntMap as M

main=interact$ solve. map read. words
solve (n:l) =  L.intercalate " " $ map show $ f 1 d
	where (m,s) = foldl (\(m,s) (x,i)->if S.member x s then (m,s) else (M.insert i x m, S.insert x s)) (M.empty,S.empty) $ zip l [1..n]
	      d = filter (flip S.notMember s) [1..n]
	      f c l
		|c>n   = []
		|otherwise = let v=M.lookup c m in if v==Nothing then head l : (f (c+1) $ tail l) else let Just v'=v in v': f(c+1) l

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

solve :: [Int] -> Int -> [Int]
solve nums maxIdx =
  solve' unused nums (Set.fromList [])
  where
    unused = Set.toList $ Set.fromList [1..maxIdx] `Set.difference` Set.fromList nums
    solve' :: [Int] -> [Int] -> Set.Set Int -> [Int]
    solve' (u:rstUnused) (a:rstGroups) set =
      if a `Set.member` set || a < 1 || a > maxIdx then
        u:solve' rstUnused rstGroups set
      else a:solve' (u:rstUnused) rstGroups (Set.insert a set)
    solve' (u:rstUnused) [] set = u:solve' rstUnused [] set
    solve' [] _ _ = []

main = do
  maxIdx <- read <$> getLine
  nums <- map read . words <$> getLine
  putStrLn $ unwords $ map show $ solve nums maxIdx

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

solve :: [Int] -> Int -> [Int]
solve nums maxIdx =
  solve' unused $ group $ filter (\x -> x >= 1 && x <= maxIdx) nums
  where
    unused = Set.toList $ Set.fromList [1..maxIdx] `Set.difference` Set.fromList nums
    solve' :: [Int] -> [[Int]] -> [Int]
    solve' unused ([a]:rst) =
      a:solve' unused rst
    solve' (u:rstUnused) ((a:rstGroup):rstGroups) =
      u:solve' rstUnused (rstGroup:rstGroups)
    solve' (u:rstUnused) [] = u:solve' rstUnused []
    solve' [] _ = []

main = do
  maxIdx <- read <$> getLine
  nums <- map read . words <$> getLine
  putStrLn $ unwords $ map show $ solve nums maxIdx

import System.IO
import qualified Data.Set as S

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

modify :: Int -> S.Set Int -> Int
modify x st = if S.member x st then modify (x+1) st else x

solve :: [Int] -> S.Set Int -> [Int]
solve [] _ = []
solve (x:xs) st = if S.notMember x st then x : solve xs (S.insert x st) else y : solve xs (S.insert y st)
	where y = modify 1 st

main = do
	ln <- getLine
	let [n] = read_ints ln
	ln <- getLine
	let arr = read_ints ln
	putStr $ unwords $ map show $ solve arr S.empty


Anton likes to play chess. Also, he likes to do programming. That is why he decided to write the program that plays chess. However, he finds the game on 8 to 8 board to too simple, he uses an infinite one instead.The first task he faced is to check whether the king is in check. Anton doesn't know how to implement this so he asks you to help.Consider that an infinite chess board contains one white king and the number of black pieces. There are only rooks, bishops and queens, as the other pieces are not supported yet. The white king is said to be in check if at least one black piece can reach the cell with the king in one move. Help Anton and write the program that for the given position determines whether the white king is in check.Remainder, on how do chess pieces move:   Bishop moves any number of cells diagonally, but it can't "leap" over the occupied cells.  Rook moves any number of cells horizontally or vertically, but it also can't "leap" over the occupied cells.  Queen is able to move any number of cells horizontally, vertically or diagonally, but it also can't "leap".

The first line of the input contains a single integer n (1 ≤ n ≤ 500 000) — the number of black pieces. The second line contains two integers x0 and y0 ( - 109 ≤ x0, y0 ≤ 109) — coordinates of the white king. Then follow n lines, each of them contains a character and two integers xi and yi ( - 109 ≤ xi, yi ≤ 109) — type of the i-th piece and its position. Character 'B' stands for the bishop, 'R' for the rook and 'Q' for the queen. It's guaranteed that no two pieces occupy the same position.

The only line of the output should contains "YES" (without quotes) if the white king is in check and "NO" (without quotes) otherwise.

NotePicture for the first sample:    White king is in check, because the black bishop can reach the cell with the white king in one move. The answer is "YES".Picture for the second sample:    Here bishop can't reach the cell with the white king, because his path is blocked by the rook, and the bishop cant "leap" over it. Rook can't reach the white king, because it can't move diagonally. Hence, the king is not in check and the answer is "NO".

-- Codeforces Round #379 (Div. 2)
-- http://codeforces.com/contest/734

-- ID: 734D (Anton and Chess)
import Control.Monad
import Data.List
import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

type Piece = (String, Int, Int)

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

lessX (_,x1,_) (_,x2,_) = compare x1 x2
lessY (_,_,y1) (_,_,y2) = compare y1 y2

main = do
    n <- read `fmap` getLine :: IO Int
    [kingX, kingY] <- (map read . words) `fmap` getLine :: IO [Int]
    blacks <- replicateM n $ do
        [post, x, y] <- BS8.words `fmap` BS.getLine
        return (BS8.unpack post, parseInt x, parseInt y)
    let king = ("K", kingX, kingY)
    let dirs = [(-1,-1,flip lessX), (0,-1,flip lessY), (1,-1,lessX),
                (-1,0,flip lessX), (1,0,lessX),
                (-1,1,flip lessX), (0,1,lessY), (1,1,lessX)]
    let attackers = map fromJust $ filter isJust $ map (choose king blacks) dirs
    if any (checkmate king) attackers
    then putStrLn "YES"
    else putStrLn "NO"

choose king blacks (dx, dy, sorter) = case (sortBy sorter . filter (attack dx dy king)) blacks of
    [] -> Nothing
    xs -> Just (head xs)
attack dx dy (_, kx, ky) (_, x, y)
    | dx == 0 = diffX == 0 && ry >= 1
    | dy == 0 = diffY == 0 && rx >= 1
    | otherwise = rx >= 1 && rx >= 1 && ry == rx
    where
        diffX = x - kx
        diffY = y - ky
        rx = diffX `div` dx
        ry = diffY `div` dy

checkmate (_, kx, ky) (post, x, y)
    | post == "R" = dx == 0 || dy == 0
    | post == "B" = dy /= 0 && (abs (dx `div` dy) == 1)
    | post == "Q" = True
    where
        dx = x - kx
        dy = y - ky

#!/usr/bin/env stack
{- stack
  --resolver lts-2.22
  runghc
  --package array
  --package base
  --package bytestring
  --package containers
  --package mtl
  --package parsec
  --package vector
  --
  -hide-all-packages
-}
{-# LANGUAGE BangPatterns, TupleSections, RankNTypes, ScopedTypeVariables #-}
module Main
( main
) where

import           Prelude hiding (interact, lines, unlines, words, unwords,
                                 sequence, foldr)
import           Data.ByteString.Char8 (pack, unpack, ByteString, lines, words,
                                        unlines, unwords, interact, readInt,
                                        readInteger)
import qualified Data.ByteString.Char8 as BS
import           Data.List (foldl', sort, sortBy, group, groupBy, inits, tails)
import qualified Data.List as L
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import qualified Data.IntMap.Strict as IM
import           Data.IntMap.Strict (IntMap)
import qualified Data.Map.Strict as M
import           Data.Map.Strict (Map)
import qualified Data.Set as S
import           Data.Set (Set)
import qualified Data.Array.IArray as A
import           Data.Array.IArray ((!), Array, listArray, array)
import           Data.Maybe (fromJust, isJust, fromMaybe, maybe, mapMaybe,
                             catMaybes)
import           Data.Either (either)
import           Control.Applicative (Applicative, pure,
                                      (<$>), (<*>), liftA2, liftA3)
import           Control.Monad (unless, when, void, filterM, ap)
import           Control.Arrow ((***), (&&&), first, second)
import           Data.Traversable (sequence, sequenceA, traverse,
                                   Traversable)
import           Data.Ord (comparing, Down(..))
import           Data.Function (on)
import           Data.Bits (complement, xor, (.|.), (.&.), testBit, zeroBits,
                            bit, shiftR, shiftL, Bits)
import qualified Data.Bits as B
import           Data.Word (Word32)
import           Control.Monad.State (State, get, put, gets, modify,
                                      evalState, execState, runState)
import           Text.Parsec (char, space, parse, Parsec)
import qualified Text.Parsec as P
import           Data.Tuple (swap)
import           Data.Foldable (Foldable, foldr)
import           Data.Monoid ((<>), Monoid, mappend, mempty)

type N = Int
toNum = toInt

data Piece = Queen | Rook | Bishop
data Dir = U | D | L | R | UL | UR | DL | DR
    deriving (Eq, Ord, Show, Read, Enum, Bounded)

toDir (i, j)
  | i > 0 = case compare j 0 of
              GT -> UR
              EQ -> R
              LT -> DR
  | i < 0 = case compare j 0 of
              GT -> UL
              EQ -> L
              LT -> DL
  | otherwise = case compare j 0 of
              GT -> U
              EQ -> error "invalid input"
              LT -> D

answer :: (N, N) -> [(Piece, (N, N))] -> String
answer loc@(x,y) zs = if go (map fixCoord zs) then "YES" else "NO"
  where fixCoord (p, (x', y')) = (p, (x' - x, y' - y))
        go = go' . sortBy (comparing distance) . filter possible
        possible (_, (i, j)) = i == 0 || j == 0 || abs i == abs j
        distance (_, (i, j)) = max (abs i) (abs j)
        go' = go'' S.empty
        go'' _ [] = False
        go'' s ((p, coord):ps) = let d = toDir coord
                                     s' = S.insert d s
                                  in (isAttack p d && d `S.notMember` s)
                                  || go'' s' ps
        isAttack Queen _ = True
        isAttack Rook d = d `elem` [U, D, L, R]
        isAttack Bishop d = d `elem` [UL, UR, DL, DR]

handleInput :: ByteString -> ByteString
handleInput = lines
            & coerceInput answer
            & pack

toInt = readInt & fromJust & fst
toInte = readInteger & fromJust & fst
toX :: Read a => ByteString -> a
toX = unpack & read

coerceInput f (a:b:xs) = f (toTuple b) (map toPiece (take (toInt a) xs))
coerceInput _ _ = error "invalid input"

toTuple = words & map toNum & (\(a:b:xs) -> (a, b))

toPiece xs = case words xs of
               (p:x:y:_) -> (toType (unpack p), (toNum x, toNum y))

toType "B" = Bishop
toType "R" = Rook
toType "Q" = Queen

main :: IO ()
main = interact handleInput

-- Util stuff --
(&) :: (a -> b) -> (b -> c) -> a -> c
(&) = flip (.)
infixl 9 &

module Main where

import Control.Monad
import Control.Monad.State
import Data.Array
import Data.Int
import Prelude
import qualified Data.ByteString.Lazy.Char8 as L

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Int:" ++ (show s)

nextInteger :: Tokenizer Integer
nextInteger = state $ \(s:ss) -> case L.readInteger s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Integer:" ++ (show s)

nextChar :: Tokenizer Char
nextChar = state $ \(s:ss) -> (L.index s 0, ss)

data Piece = Piece { getType :: Char
                   , getX :: Integer
                   , getY :: Integer
                   }

cross :: Integer -> Integer -> Integer -> Integer -> Int64
cross x1 y1 x2 y2 = (fromIntegral x1 :: Int64) * (fromIntegral y2 :: Int64) - (fromIntegral x2 :: Int64) * (fromIntegral y1 :: Int64)

dot :: Integer -> Integer -> Integer -> Integer -> Int64
dot x1 y1 x2 y2 = (fromIntegral x1 :: Int64) * (fromIntegral x2 :: Int64) + (fromIntegral y1 :: Int64) * (fromIntegral y2 :: Int64)

sameDirection :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Bool
sameDirection x1 y1 x2 y2 dx dy = cross vx vy dx dy == 0 && dot vx vy dx dy >= 0
    where vx = x2 - x1
          vy = y2 - y1

check :: Integer -> Integer -> [Piece] -> Bool
check x0 y0 ps = getType best /= 'K'
    where best = foldl (closerPiece x0 y0) (Piece 'K' x0 y0) (map canMove cands)
          cands = [(closest x0 y0 dx dy ps, dx, dy) | dx <- [-1..1], dy <- [-1..1], not (dx == 0 && dy == 0)]

canMove :: (Piece, Integer, Integer) -> Piece
canMove (p, dx, dy) | t == 'B' && dx /= 0 && dy /= 0   = p
                    | t == 'R' && (dx == 0 || dy == 0) = p
                    | t == 'Q'                         = p
                    | otherwise = Piece 'K' 0 0
                    where t = getType p

closer :: Integer -> Integer -> Piece -> Piece -> Bool
closer x0 y0 p1 p2 = t2 == 'K' || (t1 /= 'K' && t2 /= 'K' && dist1 < dist2)
                     where dist1 = abs (x1 - x0) + abs (y1 - y0)
                           dist2 = abs (x2 - x0) + abs (y2 - y0)
                           Piece t1 x1 y1 = p1
                           Piece t2 x2 y2 = p2

closerPiece :: Integer -> Integer -> Piece -> Piece -> Piece
closerPiece x0 y0 p1 p2 | closer x0 y0 p1 p2 = p1
                        | otherwise          = p2

closest :: Integer -> Integer -> Integer -> Integer -> [Piece] -> Piece
closest x0 y0 dx dy [] = Piece 'K' x0 y0
closest x0 y0 dx dy (p:ps) | sameDirection x0 y0 x1 y1 dx dy && closer x0 y0 p best = p
                           | otherwise                                              = best
                           where best = closest x0 y0 dx dy ps
                                 Piece _ x1 y1 = p

solve :: Tokenizer String
solve = do
    n <- nextInt
    x0 <- nextInteger
    y0 <- nextInteger
    p <- replicateM n $ do
        t <- nextChar
        x <- nextInteger
        y <- nextInteger
        return $ Piece t x y
    if (check x0 y0 p) then return "YES"
    else return "NO"

main = do
    contents <- L.getContents
    putStrLn $ evalState solve (L.words contents)

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

type Pos = (Int, Int)
type ChessPiece = (Pos, Piece)
data Piece = Rook | Bishop | Queen | King | None deriving (Eq, Show, Generic)
data Dir = Hori | Vert | DownRight | UpRight deriving (Eq, Show, Enum)
instance NFData Piece
pos = fst
piece = snd

inf = 2*(10^9) :: Int

compDir Hori (x1, y1) (x2, y2) = compare y1 y2 `mappend` compare x1 x2
compDir Vert (x1, y1) (x2, y2) = compare x1 x2 `mappend` compare y1 y2
compDir DownRight p1 p2 = (compare `on` downRight) p1 p2 `mappend` (compare `on` upRight) p1 p2
compDir UpRight   p1 p2 = (compare `on` upRight) p1 p2 `mappend` (compare `on` downRight) p1 p2

checkPos Hori (x1, y1) (x2, y2) = y1 == y2
checkPos Vert (x1, y1) (x2, y2) = x1 == x2
checkPos DownRight p1 p2 = downRight p1 == downRight p2
checkPos UpRight   p1 p2 = upRight p1   == upRight p2

checkPiece Hori p = p == Rook || p == Queen
checkPiece Vert p = p == Rook || p == Queen
checkPiece DownRight p = p == Bishop || p == Queen
checkPiece UpRight   p = p == Bishop || p == Queen

downRight (x, y) = x + y
upRight (x, y) = x - y

findCheck :: ChessPiece -> [ChessPiece] -> (Pos -> Pos -> Ordering) -> (Pos -> Pos -> Bool) -> (Piece -> Bool) -> Bool
findCheck king chessPieces compFn checkPosFn checkPieceFn = isCheck sortedPieces where
    dummyPieces = map (\p -> (p, None)) [(-inf, 0), (inf, 0), (0, -inf), (0, inf)]
    sortedPieces = sortBy (compFn `on` pos) (filter ((checkPosFn `on` pos) king) chessPieces ++ dummyPieces ++ [king])
    check king p = (checkPosFn `on` pos) king p && checkPieceFn (piece p)
    isCheck (prev:curr:next:xs) = if piece curr == King && (check curr prev || check curr next) then True else isCheck (curr:next:xs)
    isCheck _ = False

process :: ChessPiece -> [ChessPiece] -> Bool
process king chessPieces = any (\dir -> findCheck king chessPieces (compDir dir) (checkPos dir) (checkPiece dir)) [Hori .. UpRight]

main = do
    n <- getInt
    kingPos <- readPoint <$> BS.getLine
    chessPieces <- replicateM n (readPiece <$> BS.getLine)
    if process (kingPos, King) chessPieces
    then putStrLn "YES"
    else putStrLn "NO"

readPoint str = (x,y) where x:y:[] = (map (fst . fromJust . BS8.readInt) . BS8.words) str
readPiece str = case BS8.uncons str of
    Just ('R', xs) -> (readPoint $ BS8.tail xs, Rook)
    Just ('B', xs) -> (readPoint $ BS8.tail xs, Bishop)
    Just ('Q', xs) -> (readPoint $ BS8.tail xs, Queen)

#!/usr/bin/env stack
{- stack
  --resolver lts-2.22
  runghc
  --package array
  --package base
  --package bytestring
  --package containers
  --package mtl
  --package parsec
  --package vector
  --
  -hide-all-packages
-}
{-# LANGUAGE BangPatterns, TupleSections, RankNTypes, ScopedTypeVariables #-}
module Main
( main
) where

import           Prelude hiding (interact, lines, unlines, words, unwords,
                                 sequence, foldr)
import           Data.ByteString.Char8 (pack, unpack, ByteString, lines, words,
                                        unlines, unwords, interact, readInt,
                                        readInteger)
import qualified Data.ByteString.Char8 as BS
import           Data.List (foldl', sort, sortBy, group, groupBy, inits, tails)
import qualified Data.List as L
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import qualified Data.IntMap.Strict as IM
import           Data.IntMap.Strict (IntMap)
import qualified Data.Map.Strict as M
import           Data.Map.Strict (Map)
import qualified Data.Set as S
import           Data.Set (Set)
import qualified Data.Array.IArray as A
import           Data.Array.IArray ((!), Array, listArray, array)
import           Data.Maybe (fromJust, isJust, fromMaybe, maybe, mapMaybe,
                             catMaybes)
import           Data.Either (either)
import           Control.Applicative (Applicative, pure,
                                      (<$>), (<*>), liftA2, liftA3)
import           Control.Monad (unless, when, void, filterM, ap)
import           Control.Arrow ((***), (&&&), first, second)
import           Data.Traversable (sequence, sequenceA, traverse,
                                   Traversable)
import           Data.Ord (comparing, Down(..))
import           Data.Function (on)
import           Data.Bits (complement, xor, (.|.), (.&.), testBit, zeroBits,
                            bit, shiftR, shiftL, Bits)
import qualified Data.Bits as B
import           Data.Word (Word32)
import           Control.Monad.State (State, get, put, gets, modify,
                                      evalState, execState, runState)
import           Text.Parsec (char, space, parse, Parsec)
import qualified Text.Parsec as P
import           Data.Tuple (swap)
import           Data.Foldable (Foldable, foldr)
import           Data.Monoid ((<>), Monoid, mappend, mempty)

type N = Int
toNum = toInt

data Piece = Queen | Rook | Bishop
data Dir = U | D | L | R | UL | UR | DL | DR
    deriving (Eq, Ord, Show, Read, Enum, Bounded)

toDir (i, j)
  | i > 0 = case compare j 0 of
              GT -> UR
              EQ -> R
              LT -> DR
  | i < 0 = case compare j 0 of
              GT -> UL
              EQ -> L
              LT -> DL
  | otherwise = case compare j 0 of
              GT -> U
              EQ -> error "invalid input"
              LT -> D

answer :: (N, N) -> [(Piece, (N, N))] -> String
answer loc@(x,y) zs = if go (map fixCoord zs) then "YES" else "NO"
  where fixCoord (p, (x', y')) = (p, (x' - x, y' - y))
        go = go' . sortBy (comparing distance) . filter possible
        possible (_, (i, j)) = i == 0 || j == 0 || abs i == abs j
        distance (_, (i, j)) = abs i + abs j
        go' = go'' S.empty
        go'' _ [] = False
        go'' s ((p, coord):ps) = let d = toDir coord
                                     s' = S.insert d s
                                  in (isAttack p d && d `S.notMember` s)
                                  || go'' s' ps
        isAttack Queen _ = True
        isAttack Rook d = d `elem` [U, D, L, R]
        isAttack Bishop d = d `elem` [UL, UR, DL, DR]

handleInput :: ByteString -> ByteString
handleInput = lines
            & coerceInput answer
            & pack

toInt = readInt & fromJust & fst
toInte = readInteger & fromJust & fst
toX :: Read a => ByteString -> a
toX = unpack & read

coerceInput f (a:b:xs) = f (toTuple b) (map toPiece (take (toNum a) xs))
coerceInput _ _ = error "invalid input"

toTuple = words & map toNum & (\(a:b:xs) -> (a, b))

toPiece xs = case words xs of
               (p:x:y:_) -> (toType (unpack p), (toNum x, toNum y))

toType "B" = Bishop
toType "R" = Rook
toType "Q" = Queen

main :: IO ()
main = interact handleInput

-- Util stuff --
(&) :: (a -> b) -> (b -> c) -> a -> c
(&) = flip (.)
infixl 9 &

module Main where

import Control.Monad
import Control.Monad.State
import Data.Array
import Data.Int
import Prelude
import qualified Data.ByteString.Lazy.Char8 as L

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Int:" ++ (show s)

nextChar :: Tokenizer Char
nextChar = state $ \(s:ss) -> (L.index s 0, ss)

data Piece = Piece { getType :: Char
                   , getX :: Int
                   , getY :: Int
                   }

cross :: Int -> Int -> Int -> Int -> Int64
cross x1 y1 x2 y2 = (fromIntegral x1 :: Int64) * (fromIntegral y2 :: Int64) - (fromIntegral x2 :: Int64) * (fromIntegral y1 :: Int64)

dot :: Int -> Int -> Int -> Int -> Int64
dot x1 y1 x2 y2 = (fromIntegral x1 :: Int64) * (fromIntegral x2 :: Int64) + (fromIntegral y1 :: Int64) * (fromIntegral y2 :: Int64)

sameDirection :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
sameDirection x1 y1 x2 y2 dx dy = cross vx vy dx dy == 0 && dot vx vy dx dy >= 0
    where vx = x2 - x1
          vy = y2 - y1

check :: Int -> Int -> [Piece] -> Bool
check x0 y0 ps = getType best /= 'K'
    where best = foldl (closerPiece x0 y0) (Piece 'K' x0 y0) (map canMove cands)
          cands = [(closest x0 y0 dx dy ps, dx, dy) | dx <- [-1..1], dy <- [-1..1], not (dx == 0 && dy == 0)]

canMove :: (Piece, Int, Int) -> Piece
canMove (p, dx, dy) | t == 'B' && dx /= 0 && dy /= 0   = p
                    | t == 'R' && (dx == 0 || dy == 0) = p
                    | t == 'Q'                         = p
                    | otherwise = Piece 'K' 0 0
                    where t = getType p

closer :: Int -> Int -> Piece -> Piece -> Bool
closer x0 y0 p1 p2 = t2 == 'K' || (t1 /= 'K' && t2 /= 'K' && dist1 < dist2)
                     where dist1 = abs (x1 - x0) + abs (y1 - y0)
                           dist2 = abs (x2 - x0) + abs (y2 - y0)
                           Piece t1 x1 y1 = p1
                           Piece t2 x2 y2 = p2

closerPiece :: Int -> Int -> Piece -> Piece -> Piece
closerPiece x0 y0 p1 p2 | closer x0 y0 p1 p2 = p1
                        | otherwise          = p2

closest :: Int -> Int -> Int -> Int -> [Piece] -> Piece
closest x0 y0 dx dy [] = Piece 'K' x0 y0
closest x0 y0 dx dy (p:ps) | sameDirection x0 y0 x1 y1 dx dy && closer x0 y0 p best = p
                           | otherwise                                              = best
                           where best = closest x0 y0 dx dy ps
                                 Piece _ x1 y1 = p

solve :: Tokenizer String
solve = do
    n <- nextInt
    x0 <- nextInt
    y0 <- nextInt
    p <- replicateM n $ do
        t <- nextChar
        x <- nextInt
        y <- nextInt
        return $ Piece t x y
    if (check x0 y0 p) then return "YES"
    else return "NO"

main = do
    contents <- L.getContents
    putStrLn $ evalState solve (L.words contents)

module Main where

import Control.Monad
import Control.Monad.State
import Data.Array
import Data.Int
import Prelude
import qualified Data.ByteString.Lazy.Char8 as L

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Int:" ++ (show s)

nextChar :: Tokenizer Char
nextChar = state $ \(s:ss) -> (L.index s 0, ss)

data Piece = Piece { getType :: Char
                   , getX :: Int
                   , getY :: Int
                   }

cross :: Int -> Int -> Int -> Int -> Int64
cross x1 y1 x2 y2 = (fromIntegral x1) * (fromIntegral y2) - (fromIntegral x2) * (fromIntegral y1)

dot :: Int -> Int -> Int -> Int -> Int64
dot x1 y1 x2 y2 = (fromIntegral x1) * (fromIntegral x2) + (fromIntegral y1) * (fromIntegral y2)

sameDirection :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
sameDirection x1 y1 x2 y2 dx dy = cross vx vy dx dy == 0 && dot vx vy dx dy >= 0
    where vx = x2 - x1
          vy = y2 - y1

check :: Int -> Int -> [Piece] -> Bool
check x0 y0 ps = getType best /= 'K'
    where best = foldl (closerPiece x0 y0) (Piece 'K' x0 y0) (map canMove cands)
          cands = [(closest x0 y0 dx dy ps, dx, dy) | dx <- [-1..1], dy <- [-1..1], not (dx == 0 && dy == 0)]

canMove :: (Piece, Int, Int) -> Piece
canMove (p, dx, dy) | t == 'B' && dx /= 0 && dy /= 0   = p
                    | t == 'R' && (dx == 0 || dy == 0) = p
                    | t == 'Q'                         = p
                    | otherwise = Piece 'K' 0 0
                    where t = getType p

closer :: Int -> Int -> Piece -> Piece -> Bool
closer x0 y0 p1 p2 = t2 == 'K' || (t1 /= 'K' && t2 /= 'K' && dist1 < dist2)
                     where dist1 = abs (x1 - x0) + abs (y1 - y0)
                           dist2 = abs (x2 - x0) + abs (y2 - y0)
                           Piece t1 x1 y1 = p1
                           Piece t2 x2 y2 = p2

closerPiece :: Int -> Int -> Piece -> Piece -> Piece
closerPiece x0 y0 p1 p2 | closer x0 y0 p1 p2 = p1
                        | otherwise          = p2

closest :: Int -> Int -> Int -> Int -> [Piece] -> Piece
closest x0 y0 dx dy [] = Piece 'K' x0 y0
closest x0 y0 dx dy (p:ps) | sameDirection x0 y0 x1 y1 dx dy && closer x0 y0 p best = p
                           | otherwise                                              = best
                           where best = closest x0 y0 dx dy ps
                                 Piece _ x1 y1 = p

solve :: Tokenizer String
solve = do
    n <- nextInt
    x0 <- nextInt
    y0 <- nextInt
    p <- replicateM n $ do
        t <- nextChar
        x <- nextInt
        y <- nextInt
        return $ Piece t x y
    if (check x0 y0 p) then return "YES"
    else return "NO"

main = do
    contents <- L.getContents
    putStrLn $ evalState solve (L.words contents)


You are given a permutation $$$a$$$ of length $$$n$$$. Recall that permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order.You have a strength of $$$s$$$ and perform $$$n$$$ moves on the permutation $$$a$$$. The $$$i$$$-th move consists of the following:   Pick two integers $$$x$$$ and $$$y$$$ such that $$$i \leq x \leq y \leq \min(i+s,n)$$$, and swap the positions of the integers $$$x$$$ and $$$y$$$ in the permutation $$$a$$$. Note that you can select $$$x=y$$$ in the operation, in which case no swap will occur. You want to turn $$$a$$$ into another permutation $$$b$$$ after $$$n$$$ moves. However, some elements of $$$b$$$ are missing and are replaced with $$$-1$$$ instead. Count the number of ways to replace each $$$-1$$$ in $$$b$$$ with some integer from $$$1$$$ to $$$n$$$ so that $$$b$$$ is a permutation and it is possible to turn $$$a$$$ into $$$b$$$ with a strength of $$$s$$$. Since the answer can be large, output it modulo $$$998\,244\,353$$$.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$s$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$; $$$1 \leq s \leq n$$$) — the size of the permutation and your strength, respectively. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$) — the elements of $$$a$$$. All elements of $$$a$$$ are distinct. The third line of each test case contains $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$1 \le b_i \le n$$$ or $$$b_i = -1$$$) — the elements of $$$b$$$. All elements of $$$b$$$ that are not equal to $$$-1$$$ are distinct. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a single integer — the number of ways to fill up the permutation $$$b$$$ so that it is possible to turn $$$a$$$ into $$$b$$$ using a strength of $$$s$$$, modulo $$$998\,244\,353$$$.

NoteIn the first test case, $$$a=[2,1,3]$$$. There are two possible ways to fill out the $$$-1$$$s in $$$b$$$ to make it a permutation: $$$[3,1,2]$$$ or $$$[3,2,1]$$$. We can make $$$a$$$ into $$$[3,1,2]$$$ with a strength of $$$1$$$ as follows: $$$$$$[2,1,3] \xrightarrow[x=1,\,y=1]{} [2,1,3] \xrightarrow[x=2,\,y=3]{} [3,1,2] \xrightarrow[x=3,\,y=3]{} [3,1,2].$$$$$$ It can be proven that it is impossible to make $$$[2,1,3]$$$ into $$$[3,2,1]$$$ with a strength of $$$1$$$. Thus only one permutation $$$b$$$ satisfies the constraints, so the answer is $$$1$$$.In the second test case, $$$a$$$ and $$$b$$$ the same as the previous test case, but we now have a strength of $$$2$$$. We can make $$$a$$$ into $$$[3,2,1]$$$ with a strength of $$$2$$$ as follows: $$$$$$[2,1,3] \xrightarrow[x=1,\,y=3]{} [2,3,1] \xrightarrow[x=2,\,y=3]{} [3,2,1] \xrightarrow[x=3,\,y=3]{} [3,2,1].$$$$$$ We can still make $$$a$$$ into $$$[3,1,2]$$$ using a strength of $$$1$$$ as shown in the previous test case, so the answer is $$$2$$$. In the third test case, there is only one permutation $$$b$$$. It can be shown that it is impossible to turn $$$a$$$ into $$$b$$$, so the answer is $$$0$$$.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

m :: Int64
m = 998_244_353

newtype M = M { unM :: Int64 }
  deriving (Eq, Ord)

mI :: Int -> M
mI = M . fromIntegral

instance Show M where
    show (M v) = "M" ++ show v

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)

    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

    (M a) - (M b) | a - b < 0 = M $ m + a - b
    (M a) - (M b) = M $ a - b

    (M a) * (M b) = let c = a * b in
        if c >= m
            then M $ c `mod` m
            else M c

    abs    = id
    signum = undefined

powM :: M -> Int64 -> M
powM a@(M ma) x
    | x == 0 = M 1
    | x == 1 = a
    | even x = let t = powM a (x `div` 2) in t * t
    | odd x = a * powM a (x - 1)

instance Fractional M where
    recip a = powM a $ m - 2
    fromRational d = (M . fromInteger . R.numerator $ d) * (recip . M . fromInteger . R.denominator $ d)

type GraphA = A.Array Int [Int]

graphFromEdges :: Int -> [(Int, Int)] -> GraphA
graphFromEdges n edges = graph
    where
        graph = STA.runSTArray $ do
            graphA <- MA.newArray (1, n) ([] :: [Int])
            forM_ edges $ \(u, v) -> do
                modifyArray graphA u (v:)
                modifyArray graphA v (u:)
            return graphA

{- END OF GENERAL -}

solve :: Int -> Int -> [Int] -> [Int] -> Int64
solve n s as bs = unM $ solve' (M 0) (reverse abs) (reverse ms)
    where
        abs = sort $ zip as bs
        diffSL :: [Int] -> [Int] -> [Int]
        diffSL [] _ = []
        diffSL as [] = as
        diffSL as@(a:otherAs) bs@(b:otherBs)
            | a < b = a : diffSL otherAs bs
            | a == b = diffSL otherAs otherBs
            | a > b = diffSL as otherBs

        ms = diffSL [1 .. n] (sort bs)

        solve' :: M -> [(Int, Int)] -> [Int] -> M
        solve' k  [] _ = M 1
        solve' k abs@((a, b):otherABs) ms
            | b == -1 && L.null ms          = k * solve' (k - M 1) otherABs ms
            | b == -1 && head ms >= a - s   = solve' (k + M 1) abs (tail ms)
            | b == -1                       = k * solve' (k - M 1) otherABs ms
            | a - s > b                     = M 0
            | otherwise                     = solve' k otherABs ms

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, s] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        bs <- B8.getLine <&> readIntB8s
        let answer = solve n s as bs
        printf "%lld\n" answer

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

m :: Int64
m = 998_244_353

newtype M = M { unM :: Int64 }
  deriving (Eq, Ord)

mI :: Int -> M
mI = M . fromIntegral

instance Show M where
    show (M v) = "M" ++ show v

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)

    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

    (M a) - (M b) | a - b < 0 = M $ m + a - b
    (M a) - (M b) = M $ a - b

    (M a) * (M b) = M $ (a * b) `mod` m

    abs    = id
    signum = undefined

powM :: M -> Int64 -> M
powM a@(M ma) x
    | x == 0 = M 1
    | x == 1 = a
    | even x = let t = powM a (x `div` 2) in t * t
    | odd x = a * powM a (x - 1)

instance Fractional M where
    recip a = powM a $ m - 2
    fromRational d = (M . fromInteger . R.numerator $ d) * (recip . M . fromInteger . R.denominator $ d)

type GraphA = A.Array Int [Int]

graphFromEdges :: Int -> [(Int, Int)] -> GraphA
graphFromEdges n edges = graph
    where
        graph = STA.runSTArray $ do
            graphA <- MA.newArray (1, n) ([] :: [Int])
            forM_ edges $ \(u, v) -> do
                modifyArray graphA u (v:)
                modifyArray graphA v (u:)
            return graphA

{- END OF GENERAL -}

solve :: Int -> Int -> [Int] -> [Int] -> Int64
solve n s as bs = unM $ solve' (M 0) (reverse abs) (reverse ms)
    where
        abs = sort $ zip as bs
        diffSL :: [Int] -> [Int] -> [Int]
        diffSL [] _ = []
        diffSL as [] = as
        diffSL as@(a:otherAs) bs@(b:otherBs)
            | a < b = a : diffSL otherAs bs
            | a == b = diffSL otherAs otherBs
            | a > b = diffSL as otherBs

        ms = diffSL [1 .. n] (sort bs)

        solve' :: M -> [(Int, Int)] -> [Int] -> M
        solve' k  [] _ = M 1
        solve' k abs@((a, b):otherABs) ms
            | b == -1 && L.null ms          = k * solve' (k - M 1) otherABs ms
            | b == -1 && head ms >= a - s   = solve' (k + M 1) abs (tail ms)
            | b == -1                       = k * solve' (k - M 1) otherABs ms
            | a - s > b                     = M 0
            | otherwise                     = solve' k otherABs ms

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, s] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        bs <- B8.getLine <&> readIntB8s
        let answer = solve n s as bs
        printf "%lld\n" answer

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

m :: Int64
m = 998_244_353

newtype M = M { unM :: Int64 }
  deriving (Eq, Ord)

mI :: Int -> M
mI = M . fromIntegral

instance Show M where
    show (M v) = "M" ++ show v

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)

    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

    (M a) - (M b) | a - b < 0 = M $ m + a - b
    (M a) - (M b) = M $ a - b

    (M a) * (M b) = M $ (a * b) `mod` m

    abs    = id
    signum = undefined

powM :: M -> Int64 -> M
powM a@(M ma) x
    | x == 0 = M 1
    | x == 1 = a
    | even x = let t = powM a (x `div` 2) in t * t
    | odd x = a * powM a (x - 1)

instance Fractional M where
    recip a = powM a $ m - 2
    fromRational d = (M . fromInteger . R.numerator $ d) * (recip . M . fromInteger . R.denominator $ d)

type GraphA = A.Array Int [Int]

graphFromEdges :: Int -> [(Int, Int)] -> GraphA
graphFromEdges n edges = graph
    where
        graph = STA.runSTArray $ do
            graphA <- MA.newArray (1, n) ([] :: [Int])
            forM_ edges $ \(u, v) -> do
                modifyArray graphA u (v:)
                modifyArray graphA v (u:)
            return graphA

{- END OF GENERAL -}

solve :: Int -> Int -> [Int] -> [Int] -> Int64
solve n s as bs = unM $ solve' 0 (reverse abs) (reverse ms)
    where
        abs = sort $ zip as bs
        diffSL :: [Int] -> [Int] -> [Int]
        diffSL [] _ = []
        diffSL as [] = as
        diffSL as@(a:otherAs) bs@(b:otherBs)
            | a < b = a : diffSL otherAs bs
            | a == b = diffSL otherAs otherBs
            | a > b = diffSL as otherBs

        ms = diffSL (sort as) (sort bs)

        solve' :: Int -> [(Int, Int)] -> [Int] -> M
        solve' k  [] _ = M 1
        solve' k (_:otherABs) [] = mI k * solve' (k - 1) otherABs []
        solve' k abs@((a, -1):otherABs) ms@(m:otherMs)
            | m >= a - s = solve' (k + 1) abs otherMs
            | otherwise  = mI k * solve' (k - 1) otherABs ms

        solve' k abs@((a, b):otherABs) ms
            | a - s > b = M 0
            | otherwise = solve' k otherABs ms

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, s] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        bs <- B8.getLine <&> readIntB8s
        let answer = solve n s as bs
        printf "%lld\n" answer


Alice lives on a flat planet that can be modeled as a square grid of size $$$n \times n$$$, with rows and columns enumerated from $$$1$$$ to $$$n$$$. We represent the cell at the intersection of row $$$r$$$ and column $$$c$$$ with ordered pair $$$(r, c)$$$. Each cell in the grid is either land or water.  An example planet with $$$n = 5$$$. It also appears in the first sample test. Alice resides in land cell $$$(r_1, c_1)$$$. She wishes to travel to land cell $$$(r_2, c_2)$$$. At any moment, she may move to one of the cells adjacent to where she is—in one of the four directions (i.e., up, down, left, or right).Unfortunately, Alice cannot swim, and there is no viable transportation means other than by foot (i.e., she can walk only on land). As a result, Alice's trip may be impossible.To help Alice, you plan to create at most one tunnel between some two land cells. The tunnel will allow Alice to freely travel between the two endpoints. Indeed, creating a tunnel is a lot of effort: the cost of creating a tunnel between cells $$$(r_s, c_s)$$$ and $$$(r_t, c_t)$$$ is $$$(r_s-r_t)^2 + (c_s-c_t)^2$$$.For now, your task is to find the minimum possible cost of creating at most one tunnel so that Alice could travel from $$$(r_1, c_1)$$$ to $$$(r_2, c_2)$$$. If no tunnel needs to be created, the cost is $$$0$$$.

The first line contains one integer $$$n$$$ ($$$1 \leq n \leq 50$$$) — the width of the square grid. The second line contains two space-separated integers $$$r_1$$$ and $$$c_1$$$ ($$$1 \leq r_1, c_1 \leq n$$$) — denoting the cell where Alice resides. The third line contains two space-separated integers $$$r_2$$$ and $$$c_2$$$ ($$$1 \leq r_2, c_2 \leq n$$$) — denoting the cell to which Alice wishes to travel. Each of the following $$$n$$$ lines contains a string of $$$n$$$ characters. The $$$j$$$-th character of the $$$i$$$-th such line ($$$1 \leq i, j \leq n$$$) is 0 if $$$(i, j)$$$ is land or 1 if $$$(i, j)$$$ is water. It is guaranteed that $$$(r_1, c_1)$$$ and $$$(r_2, c_2)$$$ are land.

Print an integer that is the minimum possible cost of creating at most one tunnel so that Alice could travel from $$$(r_1, c_1)$$$ to $$$(r_2, c_2)$$$.

NoteIn the first sample, a tunnel between cells $$$(1, 4)$$$ and $$$(4, 5)$$$ should be created. The cost of doing so is $$$(1-4)^2 + (4-5)^2 = 10$$$, which is optimal. This way, Alice could walk from $$$(1, 1)$$$ to $$$(1, 4)$$$, use the tunnel from $$$(1, 4)$$$ to $$$(4, 5)$$$, and lastly walk from $$$(4, 5)$$$ to $$$(5, 5)$$$.In the second sample, clearly a tunnel between cells $$$(1, 3)$$$ and $$$(3, 1)$$$ needs to be created. The cost of doing so is $$$(1-3)^2 + (3-1)^2 = 8$$$.

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

type Land = Bool
type Planet = [[Land]]
type Pos = (Int, Int)

inf = 10^8

isLand planet (a, b) = planet !! (a-1) !! (b-1)

adjs (a, b) = [(a-1, b), (a+1, b), (a, b-1), (a, b+1)]

reachable planet []  _       = []
reachable planet pos visited = pos ++ reachable planet newPos' visited' where
    n = length planet
    inRange (a, b) = 1 <= a && a <= n && 1 <= b && b <= n
    newPos = nub $ concatMap adjs pos
    newPos' = filter (\p -> inRange p && isLand planet p && Set.notMember p visited) newPos
    visited' = foldl (flip Set.insert) visited newPos'

tunnelCost (a1, b1) (a2, b2) = (a1 - a2) ^ 2 + (b1 - b2) ^ 2

process :: Planet -> Pos -> Pos -> Int
process planet p1 p2 = minimum tunnelCosts where
    p1Reach = reachable planet [p1] Set.empty
    p2Reach = reachable planet [p2] Set.empty
    tunnelCosts = [ tunnelCost r1 r2 | r1 <- p1Reach, r2 <- p2Reach ]

main = do
    n <- getInt
    a1:b1:[] <- getInts
    a2:b2:[] <- getInts
    planet <- replicateM n (readLand <$> getLine) :: IO Planet
    print $ process planet (a1, b1) (a2, b2)

readLand = map (\c -> if c == '0' then True else False)


New Year is coming! Vasya has prepared a New Year's verse and wants to recite it in front of Santa Claus.Vasya's verse contains $$$n$$$ parts. It takes $$$a_i$$$ seconds to recite the $$$i$$$-th part. Vasya can't change the order of parts in the verse: firstly he recites the part which takes $$$a_1$$$ seconds, secondly — the part which takes $$$a_2$$$ seconds, and so on. After reciting the verse, Vasya will get the number of presents equal to the number of parts he fully recited.Vasya can skip at most one part of the verse while reciting it (if he skips more than one part, then Santa will definitely notice it).Santa will listen to Vasya's verse for no more than $$$s$$$ seconds. For example, if $$$s = 10$$$, $$$a = [100, 9, 1, 1]$$$, and Vasya skips the first part of verse, then he gets two presents.Note that it is possible to recite the whole verse (if there is enough time). Determine which part Vasya needs to skip to obtain the maximum possible number of gifts. If Vasya shouldn't skip anything, print 0. If there are multiple answers, print any of them.You have to process $$$t$$$ test cases.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$s$$$ ($$$1 \le n \le 10^5, 1 \le s \le 10^9$$$) — the number of parts in the verse and the maximum number of seconds Santa will listen to Vasya, respectively. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the time it takes to recite each part of the verse. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print one integer — the number of the part that Vasya needs to skip to obtain the maximum number of gifts. If Vasya shouldn't skip any parts, print 0.

NoteIn the first test case if Vasya skips the second part then he gets three gifts.In the second test case no matter what part of the verse Vasya skips.In the third test case Vasya can recite the whole verse.

import Control.Monad
import Data.Foldable

foldUntill :: Foldable t => (b -> Bool)-> (b -> a -> b) -> b -> t a -> Either (b,Maybe b,Maybe a) b
foldUntill predicate binary accumulator foldable =
  if predicate accumulator
    then Left (accumulator,Nothing,Nothing)
    else foldlM f accumulator foldable
  where
    f acc val =
      let
        newValue = binary acc val
        bool = predicate newValue
      in
        if bool
          then Left (newValue,Just acc,Just val)
          else Right newValue

type State = (Int , Indexed Int) -- (value , indexed maxval)
type Index = Int
type Indexed a = (Index, a)

solve :: Int -> [Int] -> Either (State, Maybe State, Maybe (Indexed Int)) State
solve p l = foldUntill predicate binary acc indexed
  where
    indexed = zip [1..] l
    acc = (0, (0,0))
    predicate (val,_)= val>p
    binary (summe,(ind,maks)) (ival,val) =let bigger = if val>maks then (ival,val) else (ind,maks) in  (summe + val, bigger )

analysis :: Either (State, Maybe State, Maybe (Indexed Int)) State -> Int
analysis (Right _) = 0
analysis (Left ((_,(index,_)),_,_)) = index

loesen :: Int -> [Int] -> Int
loesen p l = analysis $ solve p l

routine :: IO ()
routine = do
  [_,s] <- (map read . words) <$> getLine
  l <- (map read . words) <$> getLine
  print $ loesen s l

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

import Control.Monad
import Prelude
import Data.List
import Data.Int

testCase = do
    nsStr <- getLine
    aStr <- getLine
    let
        ns = map (read :: String -> Int64) (words nsStr)
        n = head ns
        s = head $ tail ns
        as = map (read :: String -> Int64) (words aStr) in do
        print $ solution s as

main = do
    testCases <- getLine
    strNums <- replicateM (read testCases) testCase
    return ()

prefixSumLessEq s [] = []
prefixSumLessEq s (h:t) = case s >= h of
    True -> h:(prefixSumLessEq (s - h) t)
    False -> []

solution s as = case sum as <= s of
    True -> 0
    False -> case elemIndex (sol s 0 0 as) as of
        Just x -> x + 1

sol s sm mx [] = 0
sol s sm mx (h:t) = result where
    mx2 = max mx h
    sm2 = sm + h
    result = case (sm2 - mx2) <= s of
        True -> max mx2 (sol s sm2 mx2 t)
        False -> mx

import Control.Monad
import Prelude
import Data.List

testCase = do
    nsStr <- getLine
    aStr <- getLine
    let
        ns = map (read :: String -> Int) (words nsStr)
        n = head ns
        s = head $ tail ns
        as = map (read :: String -> Int) (words aStr) in do
        print $ solution s as

main = do
    testCases <- getLine
    strNums <- replicateM (read testCases) testCase
    return ()

prefixSumLessEq s [] = []
prefixSumLessEq s (h:t) = case s >= h of
    True -> h:(prefixSumLessEq (s - h) t)
    False -> []

solution s as = case sum as <= s of
    True -> 0
    False -> case elemIndex (sol s 0 0 as) as of
        Just x -> x + 1

sol s sm mx [] = 0
sol s sm mx (h:t) = result where
    mx2 = max mx h
    sm2 = sm + h
    result = case (sm2 - mx2) <= s of
        True -> max mx2 (sol s sm2 mx2 t)
        False -> mx


It is the easy version of the problem. The only difference is that in this version $$$k = 3$$$.You are given a positive integer $$$n$$$. Find $$$k$$$ positive integers $$$a_1, a_2, \ldots, a_k$$$, such that:  $$$a_1 + a_2 + \ldots + a_k = n$$$  $$$LCM(a_1, a_2, \ldots, a_k) \le \frac{n}{2}$$$ Here $$$LCM$$$ is the least common multiple of numbers $$$a_1, a_2, \ldots, a_k$$$.We can show that for given constraints the answer always exists.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 10^4)$$$  — the number of test cases. The only line of each test case contains two integers $$$n$$$, $$$k$$$ ($$$3 \le n \le 10^9$$$, $$$k = 3$$$).

For each test case print $$$k$$$ positive integers $$$a_1, a_2, \ldots, a_k$$$, for which all conditions are satisfied.

import Control.Monad
import Data.List
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapS

main = do
    t <- readLn
    replicateM_ t testcase

testcase :: IO ()
testcase = do
    firstLine <- getLine
    let [n,k] = map read . words $ firstLine
    putStrLn $ solve n k

solve :: Int -> Int -> String
solve n k
    | odd n = unwords . map show $ [1, (n-1) `div` 2, (n-1) `div` 2]
    | n `mod` 4 == 0 = unwords. map show $ [n `div` 2 , n `div` 4, n `div` 4]
    | otherwise = unwords. map show $ [2, (n-2) `div` 2, (n-2) `div` 2]

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List (group, sort)
import Data.Map ((!))
import qualified Data.Map as M
-- import Debug.Trace

import Data.Maybe (fromJust)
import System.IO
import Text.Read

getNums :: IO [Int]
getNums = do
  line <- B.getLine
  return $ map ((fst . fromJust) . B.readInt) . B.split ' ' $ line

main :: IO ()
main = do
  t <- readLn :: IO Integer
  forM_ [1 .. t] handleCase

handleCase :: Integer -> IO ()
handleCase c = do
  [n, k] <- getNums
  putStrLn $ unwords $ map show $ solve n k

solveEasy :: Int -> [Int]
solveEasy n
  | n `mod` 2 == 1 = [1, (n - 1) `div` 2, (n -1) `div` 2]
  | n `mod` 4 == 0 = [n `div` 2, n `div` 4, n `div` 4]
  | n `mod` 4 == 2 = [2, (n - 1) `div` 2, (n -1) `div` 2]

solve n k = replicate (k - 3) 1 ++ solveEasy (n - (k - 3))

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

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

solve :: Int -> [Int]
solve n
  | odd n = 1 : replicate 2 (div n 2)
  | mod n 4 == 0 = div n 2 : replicate 2 (div n 4)
  | otherwise = 2 : replicate 2 (div n 2 - 1)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    putInts $ solve (n - (k - 3)) ++ replicate (k - 3) 1

type SIO = StateT P.ByteString IO

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

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

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


You are playing a very popular game called Cubecraft. Initially, you have one stick and want to craft $$$k$$$ torches. One torch can be crafted using one stick and one coal.Hopefully, you've met a very handsome wandering trader who has two trade offers:  exchange $$$1$$$ stick for $$$x$$$ sticks (you lose $$$1$$$ stick and gain $$$x$$$ sticks).  exchange $$$y$$$ sticks for $$$1$$$ coal (you lose $$$y$$$ sticks and gain $$$1$$$ coal). During one trade, you can use only one of these two trade offers. You can use each trade offer any number of times you want to, in any order.Your task is to find the minimum number of trades you need to craft at least $$$k$$$ torches. The answer always exists under the given constraints.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of the test case contains three integers $$$x$$$, $$$y$$$ and $$$k$$$ ($$$2 \le x \le 10^9$$$; $$$1 \le y, k \le 10^9$$$) — the number of sticks you can buy with one stick, the number of sticks required to buy one coal and the number of torches you need, respectively.

For each test case, print the answer: the minimum number of trades you need to craft at least $$$k$$$ torches. The answer always exists under the given constraints.

module Main where

solve [x,y,k] =  (((y + 1) * k - 1 + x - 2) `div` (x - 1)) + k

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

import Control.Monad
import Data.Array
import Data.Foldable
import Data.Graph
import Data.List

solve [a, b, c] = (b * c + c - 1 + a - 2) `div` (a - 1) + c

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    i <- map read . words <$> getLine
    print $ solve i

import Control.Monad

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [x, y, k] <- map read . words <$> getLine :: IO [Integer]
    let
      sticksReq = k * (1 + y)
      ceilDiv p q = div (p + q - 1) q
      type1 = ceilDiv (sticksReq - 1) (x - 1)
      type2 = k
    print (type1 + type2)