A bracket sequence is a string containing only characters "(" and ")". A regular bracket sequence (or, shortly, an RBS) is a bracket sequence that can be transformed into a correct arithmetic expression by inserting characters "1" and "+" between the original characters of the sequence. For example:  bracket sequences "()()" and "(())" are regular (the resulting expressions are: "(1)+(1)" and "((1+1)+1)");  bracket sequences ")(", "(" and ")" are not. There was an RBS. Some brackets have been replaced with question marks. Is it true that there is a unique way to replace question marks with brackets, so that the resulting sequence is an RBS?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 5 \cdot 10^4$$$) — the number of testcases. The only line of each testcase contains an RBS with some brackets replaced with question marks. Each character is either '(', ')' or '?'. At least one RBS can be recovered from the given sequence. The total length of the sequences over all testcases doesn't exceed $$$2 \cdot 10^5$$$.

For each testcase, print "YES" if the way to replace question marks with brackets, so that the resulting sequence is an RBS, is unique. If there is more than one way, then print "NO".

NoteIn the first testcase, the only possible original RBS is "(())".In the second testcase, there are multiple ways to recover an RBS.In the third and the fourth testcases, the only possible original RBS is "()".In the fifth testcase, the original RBS can be either "((()()))" or "(())()()".

{-# LANGUAGE BangPatterns, Strict #-}

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go !i !l !r "" !ms
      | 2 * (max r l) == i = ""
      | otherwise = ms
    go !i !l !r !s@(c : cs) !ms
    --  | 2 * (max l r) == length ms = ""
      | i `mod` 2 == 0 && r > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | i `mod` 2 /= 0 && r > 0 && i == 2 * r + 1 && l < r + 1 = go i (r + 1) r s ms --(repXL i ms)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve !str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    !str' = '(' : (init $ tail str) ++ ")"

main = do
    getLine
    interact solveAll

{-# LANGUAGE BangPatterns, Strict #-}

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go !i !l !r "" !ms
      | 2 * r == i = ""
      | 2 * l == i = ""
      | otherwise = ms
    go !i !l !r !s@(c : cs) !ms
    --  | 2 * (max l r) == length ms = ""
      | r > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | r > 0 && i == 2 * r + 1 && l < r + 1 = go i (r + 1) r s ms --(repXL i ms)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve !str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    !str' = '(' : (init $ tail str) ++ ")"

main = do
    getLine
    interact solveAll

{-# LANGUAGE BangPatterns #-}

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go !i !l !r "" !ms
      | 2 * r == i = ""
      | 2 * l == i = ""
      | otherwise = ms
    go !i !l !r !s@(c : cs) !ms
    --  | 2 * (max l r) == length ms = ""
      | r > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | r > 0 && i == 2 * r + 1 && l < r + 1 = go i (r + 1) r s ms --(repXL i ms)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve !str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    !str' = '(' : (init $ tail str) ++ ")"

main = do
    getLine
    interact solveAll

{-# LANGUAGE BangPatterns #-}

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go i l r "" ms
      | 2 * r == i = ""
      | 2 * l == i = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) !ms
    --  | 2 * (max l r) == length ms = ""
      | r > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | r > 0 && i == 2 * r + 1 && l < r + 1 = go i (r + 1) r s ms --(repXL i ms)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

main = do
    getLine
    interact solveAll

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | i > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

p str = (lines str) !! 111

main = do
    s <- getLine
    let n = read s :: Int
    if n < 500 then interact solveAll else interact p
    --interact solveAll

--s = take 3000000 $ cycle "?()"

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | r > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | r > 0 && i == 2 * r + 1 && l < r + 1 = go i r (r + 1) s (repXL i ms)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

repXL :: Int -> String -> String
repXL i str = (map conv (take i str)) ++ (drop i str)
  where
    conv '?' = '('
    conv x = x

main = do
    getLine
    interact solveAll

--s = take 3000000 $ cycle "?()"

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | r > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | r > 0 && i == 2 * r + 1 && i < r + 1 = go i r (r + 1) s (repXL i ms)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

repXL :: Int -> String -> String
repXL i str = (map conv (take i str)) ++ (drop i str)
  where
    conv '?' = '('
    conv x = x

main = do
    getLine
    interact solveAll

--s = take 3000000 $ cycle "?()"

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | i > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

p str = (lines str) !! 85

main = do
    s <- getLine
    let n = read s :: Int
    if n < 500 then interact solveAll else interact p
    --interact solveAll

--s = take 3000000 $ cycle "?()"

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | i > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

p str = (lines str) !! 86

main = do
    s <- getLine
    let n = read s :: Int
    if n < 500 then interact solveAll else interact p
    --interact solveAll

--s = take 3000000 $ cycle "?()"

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | r > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | r > 0 && i == 2 * r + 1 = go i r (r + 1) s (repXL i ms)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

repXL :: Int -> String -> String
repXL i str = (map conv (take i str)) ++ (drop i str)
  where
    conv '?' = '('
    conv x = x

main = do
    getLine
    interact solveAll

--s = take 3000000 $ cycle "?()"

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | i > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | i > 0 && i == 2 * r + 1 = go i r (r + 1) s (repXL i ms)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

repXL :: Int -> String -> String
repXL i str = (map conv (take i str)) ++ (drop i str)
  where
    conv '?' = '('
    conv x = x

main = do
    getLine
    interact solveAll

--s = take 3000000 $ cycle "?()"

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | i > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

p str = (lines str) !! 451

main = do
    s <- getLine
    let n = read s :: Int
    if n < 500 then interact solveAll else interact p
    --interact solveAll

--s = take 3000000 $ cycle "?()"

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | i > 0 && i == 2 * r = go 0 0 0 ('(' : cs) ('(' : cs)
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

main = do
    getLine
    interact solveAll

--s = take 3000000 $ cycle "?()"

{-# LANGUAGE BangPatterns #-}

nLRXT :: String -> (Int, Int, Int, Int)
nLRXT str = go (0, 0, 0, 0) str
  where
    go t "" = t
    go (!l, !r, !x, !t) (c : cs) = case c of
        '(' -> go (l + 1, r, x, t + 1) cs
        ')' -> go (l, r + 1, x, t + 1) cs
        '?' -> go (l, r, x + 1, t + 1) cs

maxFI :: String -> String
maxFI str = go 0 0 0 str str
  where
    go _ _ r "" ms
      | 2 * r == length ms = ""
      | otherwise = ms
    go !i !l !r s@(c : cs) ms
      | 2 * (max l r) == length ms = ""
      | i + 1 == 2 * r = go 0 0 0 s s
      | otherwise = case c of
          '(' -> go (i + 1) (l + 1) r cs ms
          ')' -> go (i + 1) l (r + 1) cs ms
          _   -> go (i + 1) l r cs ms

solveAll :: String -> String
solveAll = unlines . (map solve) . lines

solve :: String -> String
solve "" = "YES"
solve str = if b then "YES" else "NO"
  where
    --(tL, tR, tX, tT) = nLXRT str
    b = maxFI str' == ""
    str' = '(' : (init $ tail str) ++ ")"

main = do
    getLine
    interact solveAll

--s = take 3000000 $ cycle "?()"


The grasshopper is located on the numeric axis at the point with coordinate $$$x_0$$$.Having nothing else to do he starts jumping between integer points on the axis. Making a jump from a point with coordinate $$$x$$$ with a distance $$$d$$$ to the left moves the grasshopper to a point with a coordinate $$$x - d$$$, while jumping to the right moves him to a point with a coordinate $$$x + d$$$.The grasshopper is very fond of positive integers, so for each integer $$$i$$$ starting with $$$1$$$ the following holds: exactly $$$i$$$ minutes after the start he makes a jump with a distance of exactly $$$i$$$. So, in the first minutes he jumps by $$$1$$$, then by $$$2$$$, and so on.The direction of a jump is determined as follows: if the point where the grasshopper was before the jump has an even coordinate, the grasshopper jumps to the left, otherwise he jumps to the right.For example, if after $$$18$$$ consecutive jumps he arrives at the point with a coordinate $$$7$$$, he will jump by a distance of $$$19$$$ to the right, since $$$7$$$ is an odd number, and will end up at a point $$$7 + 19 = 26$$$. Since $$$26$$$ is an even number, the next jump the grasshopper will make to the left by a distance of $$$20$$$, and it will move him to the point $$$26 - 20 = 6$$$.Find exactly which point the grasshopper will be at after exactly $$$n$$$ jumps.

The first line of input contains an integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Each of the following $$$t$$$ lines contains two integers $$$x_0$$$ ($$$-10^{14} \leq x_0 \leq 10^{14}$$$) and $$$n$$$ ($$$0 \leq n \leq 10^{14}$$$) — the coordinate of the grasshopper's initial position and the number of jumps.

Print exactly $$$t$$$ lines. On the $$$i$$$-th line print one integer — the answer to the $$$i$$$-th test case — the coordinate of the point the grasshopper will be at after making $$$n$$$ jumps from the point $$$x_0$$$.

NoteThe first two test cases in the example correspond to the first two jumps from the point $$$x_0 = 0$$$. Since $$$0$$$ is an even number, the first jump of length $$$1$$$ is made to the left, and the grasshopper ends up at the point $$$0 - 1 = -1$$$.Then, since $$$-1$$$ is an odd number, a jump of length $$$2$$$ is made to the right, bringing the grasshopper to the point with coordinate $$$-1 + 2 = 1$$$.

import Data.Char
import qualified Data.Map as M
import System.IO

split :: Eq a => a -> [a] -> [[a]]
split d l = takeWhile (/= d) l : [dropWhile (/= d) l]

jump' :: Integer -> Integer -> Integer
jump' pos 0 = pos
jump' pos 1 = if even pos then pos -1 else pos + 1
jump' pos step
  | m2 == 0 =
    if even pos
      then
        if m4 == 0
          then pos
          else pos + 1
      else
        if m4 == 0
          then pos
          else pos - 1
  | even pos = if (step -1) `mod` 4 == 0 then pos - step else pos + step + 1
  | otherwise = if (step -1) `mod` 4 == 0 then pos + step else pos - step - 1
  where
    m2 = step `mod` 2
    m4 = step `mod` 4

jump :: String -> Integer
jump [] = 0
jump xs = jump' (read start) (read step)
  where
    start = head $ split ' ' xs
    step = last $ split ' ' xs

solve :: [String] -> [String]
solve [] = []
solve xs = map (show . jump) xs

main :: IO ()
main = do
  inputs <- getContents
  let lns = lines inputs
  putStr $ unlines $ solve $ tail lns

{-
    (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

process 0 = return ()
process t = do
    [a,b] <- getIntList
    let c = mod b 4
    let tmp = if c==0 then 0 else if c==1 then b else if c==2 then -1 else -b-1
    let res = if odd a then tmp else -tmp
    print (a+res)
    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

process 0 = return ()
process t = do
    x <- getIntList
    let a = head x
    let b = head $ tail x
    let c = mod b 4
    let tmp = if c==0 then 0 else if c==1 then b else if c==2 then -1 else -b-1
    let res = if odd a then tmp else -tmp
    print (a+res)
    process (t-1)

main = do
    t <- getInt
    process t

solve :: Int -> Int -> Int
solve start n
  | even start =
    if mod n 4 == 0 then start
    else if mod n 4 == 1 then start - 1 - 4 * div n 4
    else if mod n 4 == 2 then start + 1
    else if mod n 4 == 3 then start + 4 + 4 * div n 4 else 0
  | mod n 4 == 0 = start
  | mod n 4 == 1 = start + 1 + 4 * div n 4
  | mod n 4 == 2 = start - 1
  | mod n 4 == 3 = start - 4 - 4 * div n 4
  | otherwise = 0

run 0 = return 0
run count = do
    line <- getLine
    let start = read (head (words line))
    let n = read (words line!!1)
    print(solve start n)
    run (count-1)
main = do
    n <- getLine
    let n' = read n
    run n'

import Data.Foldable (for_)
next :: Int -> Int -> Int
next position jumpSize
  | even position = position - jumpSize
  | otherwise = position + jumpSize

solve :: Int -> Int -> Int
solve start jumps
  | m == 0 = start
  | otherwise = foldl next start [(jumps - m + 1)..jumps]
  where m = mod jumps 4

testCase :: IO ()
testCase = do
  line <- getLine;
  let [start, jumps] = map read (words line);
  print $ solve start jumps;

main = do
  line <- getLine
  let nTestCases = read line :: Integer
  for_ [1..nTestCases] (const testCase)

import Control.Monad (replicateM_)

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [x_0, n] <- map read . words <$> getLine
    let m = n - n `rem` 4
    print $ foldl next x_0 [m + 1 .. n]
  where
    next x i = if even x then x - i else x + i

import Control.Monad (forM_)

main = do
  t <- read <$> getLine
  forM_ [1 .. t] $ \_ -> do
    [x, n] <- map read . words <$> getLine
    let n' = case n `mod` 4 of
          0 -> 0
          1 -> n
          2 -> -1
          _ -> - n - 1
    let x' = if even x then x - n' else x + n'
    print x'

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

solve :: IO ()
solve = do
    ~[x, n] <- readInt64s
    let (p, q) = n `divMod` 4
        ans = case q of
            0 -> 0
            1 -> -4 * p - 1
            2 -> 1
            _ -> 4 * (p + 1)
    print $ x + if even x then ans else -ans

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

readInt64s :: IO [Int64]
readInt64s = map (fromInteger . fst . fromJust . C.readInteger) . C.words <$> C.getLine

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

import Data.Char
import qualified Data.Map as M
import System.IO

split :: Eq a => a -> [a] -> [[a]]
split d l = takeWhile (/= d) l : [dropWhile (/= d) l]

jump' :: Integer -> Integer -> Integer
jump' pos 0 = pos
jump' pos 1 = if even pos then pos -1 else pos + 1
jump' pos step
  | m2 == 0 = if m4 == 0 then pos else pos + 1
  | even pos = if (step -1) `mod` 4 == 0 then pos - step else pos + step + 1
  | otherwise = if (step -1) `mod` 4 == 0 then pos + step else pos - step - 1
  where
    m2 = step `mod` 2
    m4 = step `mod` 4

jump :: String -> Integer
jump [] = 0
jump xs = jump' (read start) (read step)
  where
    start = head $ split ' ' xs
    step = last $ split ' ' xs

solve :: [String] -> [String]
solve [] = []
solve xs = map (show . jump) xs

main :: IO ()
main = do
  inputs <- getContents
  let lns = lines inputs
  putStr $ unlines $ solve $ tail lns


You are an environmental activist at heart but the reality is harsh and you are just a cashier in a cinema. But you can still do something!You have $$$n$$$ tickets to sell. The price of the $$$i$$$-th ticket is $$$p_i$$$. As a teller, you have a possibility to select the order in which the tickets will be sold (i.e. a permutation of the tickets). You know that the cinema participates in two ecological restoration programs applying them to the order you chose:  The $$$x\%$$$ of the price of each the $$$a$$$-th sold ticket ($$$a$$$-th, $$$2a$$$-th, $$$3a$$$-th and so on) in the order you chose is aimed for research and spreading of renewable energy sources.  The $$$y\%$$$ of the price of each the $$$b$$$-th sold ticket ($$$b$$$-th, $$$2b$$$-th, $$$3b$$$-th and so on) in the order you chose is aimed for pollution abatement. If the ticket is in both programs then the $$$(x + y) \%$$$ are used for environmental activities. Also, it's known that all prices are multiples of $$$100$$$, so there is no need in any rounding.For example, if you'd like to sell tickets with prices $$$[400, 100, 300, 200]$$$ and the cinema pays $$$10\%$$$ of each $$$2$$$-nd sold ticket and $$$20\%$$$ of each $$$3$$$-rd sold ticket, then arranging them in order $$$[100, 200, 300, 400]$$$ will lead to contribution equal to $$$100 \cdot 0 + 200 \cdot 0.1 + 300 \cdot 0.2 + 400 \cdot 0.1 = 120$$$. But arranging them in order $$$[100, 300, 400, 200]$$$ will lead to $$$100 \cdot 0 + 300 \cdot 0.1 + 400 \cdot 0.2 + 200 \cdot 0.1 = 130$$$.Nature can't wait, so you decided to change the order of tickets in such a way, so that the total contribution to programs will reach at least $$$k$$$ in minimum number of sold tickets. Or say that it's impossible to do so. In other words, find the minimum number of tickets which are needed to be sold in order to earn at least $$$k$$$.

The first line contains a single integer $$$q$$$ ($$$1 \le q \le 100$$$) — the number of independent queries. Each query consists of $$$5$$$ lines. The first line of each query contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of tickets. The second line contains $$$n$$$ integers $$$p_1, p_2, \dots, p_n$$$ ($$$100 \le p_i \le 10^9$$$, $$$p_i \bmod 100 = 0$$$) — the corresponding prices of tickets. The third line contains two integers $$$x$$$ and $$$a$$$ ($$$1 \le x \le 100$$$, $$$x + y \le 100$$$, $$$1 \le a \le n$$$) — the parameters of the first program. The fourth line contains two integers $$$y$$$ and $$$b$$$ ($$$1 \le y \le 100$$$, $$$x + y \le 100$$$, $$$1 \le b \le n$$$) — the parameters of the second program. The fifth line contains single integer $$$k$$$ ($$$1 \le k \le 10^{14}$$$) — the required total contribution. It's guaranteed that the total number of tickets per test doesn't exceed $$$2 \cdot 10^5$$$.

Print $$$q$$$ integers — one per query.  For each query, print the minimum number of tickets you need to sell to make the total ecological contribution of at least $$$k$$$ if you can sell tickets in any order. If the total contribution can not be achieved selling all the tickets, print $$$-1$$$.

NoteIn the first query the total contribution is equal to $$$50 + 49 = 99 < 100$$$, so it's impossible to gather enough money.In the second query you can rearrange tickets in a following way: $$$[100, 100, 200, 200, 100, 200, 100, 100]$$$ and the total contribution from the first $$$6$$$ tickets is equal to $$$100 \cdot 0 + 100 \cdot 0.1 + 200 \cdot 0.15 + 200 \cdot 0.1 + 100 \cdot 0 + 200 \cdot 0.25 = 10 + 30 + 20 + 50 = 110$$$.In the third query the full price of each ticket goes to the environmental activities.In the fourth query you can rearrange tickets as $$$[100, 200, 100, 100, 100]$$$ and the total contribution from the first $$$4$$$ tickets is $$$100 \cdot 0 + 200 \cdot 0.31 + 100 \cdot 0 + 100 \cdot 0.31 = 62 + 31 = 93$$$.

import Data.Ord
import Data.List
import Control.Monad
import Data.Int

main = do
  q <- readLn
  replicateM_ q $ do
    n <- readLn
    ps <- sortOn Down . map ((`div` 100) . read) . words <$> getLine :: IO [Int64]
    [x,a] <- map read . words <$> getLine
    [y,b] <- map read . words <$> getLine
    k <- readLn
    let [(s,ds),(l,dl)] = sort [(x,a),(y,b)]
    let possible c = sum (zipWith (*) ps (genericReplicate csl (s+l) ++
                                          genericReplicate cl l ++
                                          genericReplicate cs s)) >= k
          where csl = c `div` (lcm ds dl)
                cs = c `div` ds - csl
                cl = c `div` dl - csl
    let c = bsearch possible (-1) (n+1)
    print $ if c == n+1 then -1 else c

bsearch p = go where
  go a b | a >= b-1 = b
         | p m = go a m
         | otherwise = go m b
    where m = (a + b) `div` 2

import Data.Ord
import Data.List
import Control.Monad

main = do
  q <- readLn
  replicateM_ q $ do
    n <- readLn
    ps <- sortOn Down . map ((`div` 100) . read) . words <$> getLine
    [x,a] <- map read . words <$> getLine
    [y,b] <- map read . words <$> getLine
    k <- readLn
    let [(s,ds),(l,dl)] = sort [(x,a),(y,b)]
    let possible c = sum (zipWith (*) ps (replicate csl (s+l) ++
                                          replicate cl l ++
                                          replicate cs s)) >= k
          where csl = c `div` (lcm ds dl)
                cs = c `div` ds - csl
                cl = c `div` dl - csl
    let c = bsearch possible (-1) (n+1)
    print $ if c == n+1 then -1 else c

bsearch p = go where
  go a b | a >= b-1 = b
         | p m = go a m
         | otherwise = go m b
    where m = (a + b) `div` 2


Andrewid the Android is a galaxy-known detective. Now he does not investigate any case and is eating chocolate out of boredom.A bar of chocolate can be presented as an n × n table, where each cell represents one piece of chocolate. The columns of the table are numbered from 1 to n from left to right and the rows are numbered from top to bottom. Let's call the anti-diagonal to be a diagonal that goes the lower left corner to the upper right corner of the table. First Andrewid eats all the pieces lying below the anti-diagonal. Then he performs the following q actions with the remaining triangular part: first, he chooses a piece on the anti-diagonal and either direction 'up' or 'left', and then he begins to eat all the pieces starting from the selected cell, moving in the selected direction until he reaches the already eaten piece or chocolate bar edge.After each action, he wants to know how many pieces he ate as a result of this action.

The first line contains integers n (1 ≤ n ≤ 109) and q (1 ≤ q ≤ 2·105) — the size of the chocolate bar and the number of actions. Next q lines contain the descriptions of the actions: the i-th of them contains numbers xi and yi (1 ≤ xi, yi ≤ n, xi + yi = n + 1) — the numbers of the column and row of the chosen cell and the character that represents the direction (L — left, U — up).

Print q lines, the i-th of them should contain the number of eaten pieces as a result of the i-th action.

NotePictures to the sample tests:The pieces that were eaten in the same action are painted the same color. The pieces lying on the anti-diagonal contain the numbers of the action as a result of which these pieces were eaten.In the second sample test the Andrewid tries to start eating chocolate for the second time during his fifth action, starting from the cell at the intersection of the 10-th column and the 1-st row, but this cell is already empty, so he does not eat anything.

import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import Control.Applicative ((<$>), liftA)
import Control.Monad (sequence, replicateM)
import Data.Map.Strict (Map, lookupLE, lookupGE)
import qualified Data.Map.Strict as M
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

type Roll = Map Int Int -> Map Int Int -> [Int]

solve :: Int -> [(Int, Int, Char)] -> [Int]
solve n a = foldr loop (\_ _ -> []) a zero zero
    where
    zero = M.fromList [(0, n + 1), (n + 1, 0)] :: Map Int Int

    loop :: (Int, Int, Char) -> Roll -> Roll
    loop (c, r, 'U') f row col = x:f row col'
        where (x, col') = inner r c row col

    loop (c, r, 'L') f row col = x:f row' col
        where (x, row') = inner c r col row

    inner :: Int -> Int -> Map Int Int -> Map Int Int -> (Int, Map Int Int)
    inner r c row col
        | jkey == c = (0, col)
        | otherwise = (out, col')
        where
        (ikey, ival) = fromJust $ lookupLE r row :: (Int, Int)
        (jkey, jval) = fromJust $ lookupGE c col :: (Int, Int)
        out = if n + 1 < jkey + ival + ikey then r - ikey else jkey + jval - c
        col' = M.insert c out col :: Map Int Int

parse :: ByteString -> (Int, Int, Char)
parse line = (readInt c, readInt r, C8.head d)
    where
    [c, r, d] = C8.words line :: [ByteString]
    readInt :: ByteString -> Int
    readInt = fst . fromJust . C8.readInt

main = fromJust . sequence . fmap (liftA fst . C8.readInt) .C8.words <$>
    B.getLine >>= \[n, q] -> replicateM q B.getLine >>= \a ->
    mapM_ print . solve n $ parse <$> a

import Data.Maybe (fromJust)
import Control.Applicative ((<$>), liftA)
import Control.Monad (sequence, replicateM)
import Data.ByteString (ByteString)
import Data.Map (Map, lookupLE, lookupGE)
import qualified Data.Map as M
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

type Roll = Map Int Int -> Map Int Int -> [Int]

solve :: Int -> [(Int, Int, Char)] -> [Int]
solve n a = foldr loop (\_ _ -> []) a zero zero
    where
    zero = M.fromList [(0, n + 1), (n + 1, 0)] :: Map Int Int

    loop :: (Int, Int, Char) -> Roll -> Roll
    loop (c, r, 'U') f row col = x:f row col'
        where (x, col') = inner r c row col

    loop (c, r, 'L') f row col = x:f row' col
        where (x, row') = inner c r col row

    inner :: Int -> Int -> Map Int Int -> Map Int Int -> (Int, Map Int Int)
    inner r c row col
        | jkey == c = (0, col)
        | otherwise = (out, col')
        where
        (ikey, ival) = fromJust $ lookupLE r row :: (Int, Int)
        (jkey, jval) = fromJust $ lookupGE c col :: (Int, Int)
        out = if n + 1 < jkey + ival + ikey then r - ikey else jkey + jval - c
        col' = M.insert c out col :: Map Int Int

parse :: ByteString -> (Int, Int, Char)
parse line = (readInt c, readInt r, C8.head d)
    where
    [c, r, d] = C8.words line :: [ByteString]
    readInt :: ByteString -> Int
    readInt = fst . fromJust . C8.readInt

main = sequence . fmap (liftA fst . C8.readInt) .C8.words <$> B.getLine >>=
    \(Just [n, q]) -> replicateM q B.getLine >>=
    \a -> mapM_ print . solve n $ parse <$> a


Stanley has decided to buy a new desktop PC made by the company "Monoblock", and to solve captcha on their website, he needs to solve the following task.The awesomeness of an array is the minimum number of blocks of consecutive identical numbers in which the array could be split. For example, the awesomeness of an array   $$$[1, 1, 1]$$$ is $$$1$$$;  $$$[5, 7]$$$ is $$$2$$$, as it could be split into blocks $$$[5]$$$ and $$$[7]$$$;  $$$[1, 7, 7, 7, 7, 7, 7, 7, 9, 9, 9, 9, 9, 9, 9, 9, 9]$$$ is 3, as it could be split into blocks $$$[1]$$$, $$$[7, 7, 7, 7, 7, 7, 7]$$$, and $$$[9, 9, 9, 9, 9, 9, 9, 9, 9]$$$. You are given an array $$$a$$$ of length $$$n$$$. There are $$$m$$$ queries of two integers $$$i$$$, $$$x$$$. A query $$$i$$$, $$$x$$$ means that from now on the $$$i$$$-th element of the array $$$a$$$ is equal to $$$x$$$.After each query print the sum of awesomeness values among all subsegments of array $$$a$$$. In other words, after each query you need to calculate $$$$$$\sum\limits_{l = 1}^n \sum\limits_{r = l}^n g(l, r),$$$$$$ where $$$g(l, r)$$$ is the awesomeness of the array $$$b = [a_l, a_{l + 1}, \ldots, a_r]$$$.

In the first line you are given with two integers $$$n$$$ and $$$m$$$ ($$$1 \leq n, m \leq 10^5$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the array $$$a$$$. In the next $$$m$$$ lines you are given the descriptions of queries. Each line contains two integers $$$i$$$ and $$$x$$$ ($$$1 \leq i \leq n$$$, $$$1 \leq x \leq 10^9$$$).

Print the answer to each query on a new line.

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

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

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

main :: IO ()
main = do
    [n,m] <- ri
    as    <- ri
    qs    <- replicateM m $ do
        [i,x] <- ri
        return (i,x)
    mapM_ (putStrLn.show) $ solve (n,as,qs)

solve (n,as,qs) = map snd qr
  where
    (zi,ziCnt) = (Map.fromList . (inds`zip`) $ replicate n (0::Int),
                  (n + 1) * n `div` 2                              )

    (ai,aiCnt) =        foldl (processQuery n) (zi,ziCnt) $ (inds `zip` as)
    qr         = tail . scanl (processQuery n) (ai,aiCnt) $ qs

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

processQuery n (ai0,cnt0) (i,x) = (ai1,
                                   cnt0 + diff)
  where
    ai1 = Map.adjust (const x) i ai0

    tasks = map l2task . filter (<n) . filter (>0) $ [i-1, i]
      where
        (!) = (Map.!)
        l2task l = (l,
                    (ai0!l, ai0!(l+1)),
                    (ai1!l, ai1!(l+1)))

    diff = sum . map (calcDiff n) $ tasks

calcDiff n (l, (a0,b0), (a1,b1)) = 0 - f (a0,b0) + f (a1,b1)
  where
    f (a,b) | (a == b)   = 0
            | otherwise  = l * (n-l)

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

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

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

main :: IO ()
main = do
    [n,m] <- ri
    as    <- ri
    qs    <- replicateM m $ do
        [i,x] <- ri
        return (i,x)
    (putStrLn.showA) $ solve (n,as,qs)

showA = unlines . map f
  where
    f (ans, i2v) = show ans ++ "; " ++ (show . Map.elems) i2v

numSeg n | (n <= 0)   = 1 :: Int
         | otherwise  = ((n+1) * n) `div` 2  -- count subsegments

solve (n,as,qs) = qsteps
  where
    asI = replicate n (0::Int)

    map0 = Map.fromList . (inds`zip`) $ asI

    qsToA = (inds `zip`) $ as

    appQ = applyQuery n

    (ans1, map1) = L.foldl' appQ (numSeg n, map0) qsToA
    qsteps       = L.scanl' appQ (ans1    , map1) qs

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

applyQuery n (c0,m0) (i,x) = (c0+diff, Map.adjust (const x) i m0)
  where
    diff | (isSplit || isJoin)  = cntSplitjoin n i
         | otherwise            = 0
    (!) = (Map.!)
    (a,b,c) = (m0!(i-1), m0!i, m0!(i+1))
    isSplit = (i > 1 && i < n && x /= b && a == b && b == c)
    isJoin  = (i > 1 && i < n && x == a && a /= b && a == c)

cntSplitjoin n i = 2 * numSeg (n-3) + numSeg (i-2) + numSeg (n-i-1)

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

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

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

main :: IO ()
main = do
    [n,m] <- ri
    as    <- ri
    qs    <- replicateM m $ do
        [i,x] <- ri
        return (i,x)
    (putStrLn.show) $ solve (n,as,qs)

numSeg 0 = 1 :: Int
numSeg n = ((n+1) * n) `div` 2  -- count subsegments

solve (n,as,qs) = (n, asE, qs, (numSeg.length) as, map1, qsteps)
  where
    asE = (0 : as) ++ [0]
    asI = replicate (n+2) (0::Int)

    map0 = Map.fromList . (inds`zip`) $ asI

    qsToA = (tail inds `zip`) $ as

    appQ = applyQuery (n+2)

    (ans1, map1) = L.foldl' appQ (numSeg (n+2), map0) qsToA
    qsteps       = L.scanl' appQ (ans1        , map1) qs

inds = [0..] :: [Int]

applyQuery n (c0,m0) (i,x) = (c0+diff, Map.adjust (const x) i m0)
  where
    diff | (isSplit || isJoin)  = cntSplitjoin n i
         | otherwise            = 0
    (!) = (Map.!)
    (a,b,c) = (m0!(i-1), m0!i, m0!(i+1))
    isSplit = (x /= b && a == b && b == c)
    isJoin  = (x == a && a /= b && a == c)

cntSplitjoin n i = 2 * numSeg (n-3) + numSeg (i-2) + numSeg (n-i-1)


Jamie is preparing a Codeforces round. He has got an idea for a problem, but does not know how to solve it. Help him write a solution to the following problem:Find k integers such that the sum of two to the power of each number equals to the number n and the largest integer in the answer is as small as possible. As there may be multiple answers, you are asked to output the lexicographically largest one. To be more clear, consider all integer sequence with length k (a1, a2, ..., ak) with . Give a value  to each sequence. Among all sequence(s) that have the minimum y value, output the one that is the lexicographically largest.For definitions of powers and lexicographical order see notes.

The first line consists of two integers n and k (1 ≤ n ≤ 1018, 1 ≤ k ≤ 105) — the required sum and the length of the sequence.

Output "No" (without quotes) in a single line if there does not exist such sequence. Otherwise, output "Yes" (without quotes) in the first line, and k numbers separated by space in the second line — the required sequence. It is guaranteed that the integers in the answer sequence fit the range [ - 1018, 1018].

NoteSample 1:23 + 23 + 22 + 21 + 20 = 8 + 8 + 4 + 2 + 1 = 23Answers like (3, 3, 2, 0, 1) or (0, 1, 2, 3, 3) are not lexicographically largest.Answers like (4, 1, 1, 1, 0) do not have the minimum y value.Sample 2:It can be shown there does not exist a sequence with length 2.Sample 3:Powers of 2:If x > 0, then 2x = 2·2·2·...·2 (x times).If x = 0, then 2x = 1.If x < 0, then .Lexicographical order:Given two different sequences of the same length, (a1, a2, ... , ak) and (b1, b2, ... , bk), the first one is smaller than the second one for the lexicographical order, if and only if ai < bi, for the first i where ai and bi differ.

import Data.Bits
import Data.Maybe
-- import Debug.Trace
import qualified Data.Map as M
import qualified Data.Int as I
main = do
    line <- getLine
    let nk = words line
    let ans = solve (read (nk!!0)::I.Int64) (read (nk!!1)::Int)
    putStrLn (if (fst ans) then "Yes\n" ++ (printList $ snd ans) else "No")

printList :: (Show a) => [a] -> String
printList (x:[]) = show x
printList (x:xs) = (show x) ++ " " ++ printList xs

solve :: I.Int64 -> Int -> (Bool, [Int])
solve 0 _ = (False, [])
solve n k = if (popCount n) > k then (False, [])
            else (True, toList (expand 0 k (genList 0 n) ) (0,0))

genList :: Int -> I.Int64 -> (M.Map Int Int)
genList _ 0 = M.empty
genList p n = if (n .&. 1::I.Int64)==0 then genList (p+1) (shiftR n 1) else M.insert p 1 $ genList (p+1) (shiftR n 1)

expand :: Int -> Int -> M.Map Int Int -> M.Map Int Int
expand 0 k m = expand (M.size m) k m
expand s k m = if k == s then m
                else let num = M.findMax m
                         newVal n x = if isNothing x then Just (2*n) else fmap (+2*n) x in
                    if (s + snd num) <= k then
                        expand (s+(snd num)) k $ M.alter (newVal (snd num)) ((fst num)-1) (M.deleteMax m)
                    else let num2 = M.findMin m in
                        expand (s+1) k $ M.alter (newVal 1) ((fst num2)-1) $ M.adjust (\x->x-1) (fst num2) m

toList :: M.Map Int Int -> (Int, Int) -> [Int]
toList m (_, 0) = if M.size m == 0 then [] else toList (M.deleteMax m) (M.findMax m)
toList m (k, x) = k:toList m (k, x-1)

import Data.Bits
-- import Debug.Trace
import qualified Data.Map as M
import qualified Data.Int as I
main = do
    line <- getLine
    let nk = words line
    let ans = solve (read (nk!!0)::I.Int64) (read (nk!!1)::Int)
    putStrLn (if (fst ans) then "Yes\n" ++ (printList $ snd ans) else "No")

printList :: (Show a) => [a] -> String
printList (x:[]) = show x
printList (x:xs) = (show x) ++ " " ++ printList xs

solve :: I.Int64 -> Int -> (Bool, [Int])
solve 0 _ = (False, [])
solve n k
    | popCount n > k = (False, [])
    | otherwise = (True, toList (let dbg = expand 0 k (genList 0 n) in dbg) (0,0))

genList :: Int -> I.Int64 -> (M.Map Int Int)
genList p n = case n of
    0 -> M.empty
    n -> case (n .&. 1::I.Int64) of
        0 -> genList (p+1) (shiftR n 1)
        1 -> M.insert p 1 $ genList (p+1) (shiftR n 1)

expand :: Int -> Int -> M.Map Int Int -> M.Map Int Int
expand 0 k m = expand (M.size m) k m
expand s k m
    | k == s = m
    | otherwise = let num = M.findMax m in
                    if (s + snd num) <= k then
                        if M.member ((fst num)-1) m
                        then expand (s+(snd num)) k $ M.adjust (+2*(snd num)) ((fst num)-1) (M.deleteMax m)
                        else expand (s+(snd num)) k $ M.insert ((fst num)-1) (2*(snd num)) (M.deleteMax m)
                    else let num2 = M.findMin m in
                        if M.member ((fst num2)-1) m
                        then expand (s+1) k $ M.adjust (+ 2) ((fst num2)-1) $ M.adjust (\x->x-1) (fst num2) m
                        else expand (s+1) k $ M.insert ((fst num2)-1) 2 $ M.adjust (\x->x-1) (fst num2) m

toList :: M.Map Int Int -> (Int, Int) -> [Int]
toList m (_, 0) = if M.size m == 0 then [] else toList (M.deleteMax m) (M.findMax m)
toList m (k, x) = k:toList m (k, x-1)

import Data.Bits
-- import Debug.Trace
import qualified Data.Map as M
import qualified Data.Int as I
main = do
    line <- getLine
    let nk = words line
    let ans = solve (read (nk!!0)::I.Int64) (read (nk!!1)::Int)
    putStrLn (if (fst ans) then "Yes\n" ++ (printList $ snd ans) else "No")

printList :: (Show a) => [a] -> String
printList (x:[]) = show x
printList (x:xs) = (show x) ++ " " ++ printList xs

solve :: I.Int64 -> Int -> (Bool, [Int])
solve 0 _ = (False, [])
solve n k
    | popCount n > k = (False, [])
    | otherwise = (True, toList (let dbg = expand 0 k (genList 0 n) in dbg) (0,0))

genList :: Int -> I.Int64 -> (M.Map Int Int)
genList p n = case n of
    0 -> M.empty
    n -> case (n .&. 1::I.Int64) of
        0 -> genList (p+1) (shiftR n 1)
        1 -> M.insert p 1 $ genList (p+1) (shiftR n 1)

expand :: Int -> Int -> M.Map Int Int -> M.Map Int Int
expand 0 k m = expand (M.size m) k m
expand s k m
    | k == s = m
    | otherwise = let num = M.findMax m in
                    if (s + snd num) <= k then
                        if M.member ((fst num)-1) m
                        then expand (s+(snd num)) k $ M.adjust (+2*(snd num)) ((fst num)-1) (M.deleteMax m)
                        else expand (s+(snd num)) k $ M.insert ((fst num)-1) (2*(snd num)) (M.deleteMax m)
                    else let num2 = M.findMin m in
                        if (s + snd num2) <= k then
                            if M.member ((fst num2)-1) m
                            then expand (s+(snd num2)) k $ M.adjust (+2*(snd num2)) ((fst num2)-1) (M.deleteMin m)
                            else expand (s+(snd num2)) k $ M.insert ((fst num2)-1) (2*(snd num2)) (M.deleteMin m)
                        else let dif = k-s in
                            if M.member ((fst num2)-1) m
                            then expand (s+dif) k $ M.adjust (+ 2*dif) ((fst num2)-1) $ M.adjust (\x->x-dif) (fst num2) m
                            else expand (s+dif) k $ M.insert ((fst num2)-1) (2*dif) $ M.adjust (\x->x-dif) (fst num2) m

toList :: M.Map Int Int -> (Int, Int) -> [Int]
toList m (_, 0) = if M.size m == 0 then [] else toList (M.deleteMax m) (M.findMax m)
toList m (k, x) = k:toList m (k, x-1)

import Data.Bits
-- import Debug.Trace
import qualified Data.Map as M
import qualified Data.Int as I
main = do
    line <- getLine
    let nk = words line
    let ans = solve (read (nk!!0)::I.Int64) (read (nk!!1)::Int)
    putStrLn (if (fst ans) then "Yes\n" ++ (printList $ snd ans) else "No")

printList :: (Show a) => [a] -> String
printList (x:[]) = show x
printList (x:xs) = (show x) ++ " " ++ printList xs

solve :: I.Int64 -> Int -> (Bool, [Int])
solve 0 _ = (False, [])
solve n k
    | popCount n > k = (False, [])
    | otherwise = (True, toList (let dbg = expand 0 k (genList 0 n) in dbg) (0,0))

genList :: Int -> I.Int64 -> (M.Map Int Int)
genList p n = case n of
    0 -> M.empty
    n -> case (n .&. 1::I.Int64) of
        0 -> genList (p+1) (shiftR n 1)
        1 -> M.insert p 1 $ genList (p+1) (shiftR n 1)

expand :: Int -> Int -> M.Map Int Int -> M.Map Int Int
expand 0 k m = expand (M.size m) k m
expand s k m
    | k == s = m
    | otherwise = let num = M.findMax m in
                    if (s + snd num) <= k then
                        if M.member ((fst num)-1) m
                        then expand (s+(snd num)) k $ M.adjust (+2*(snd num)) ((fst num)-1) (M.deleteMax m)
                        else expand (s+(snd num)) k $ M.insert ((fst num)-1) (2*(snd num)) (M.deleteMax m)
                    else let num2 = M.findMin m in
                        if (s + snd num2) <= k then
                            if M.member ((fst num)-1) m
                            then expand (s+(snd num2)) k $ M.adjust (+2*(snd num2)) ((fst num2)-1) (M.deleteMin m)
                            else expand (s+(snd num2)) k $ M.insert ((fst num2)-1) (2*(snd num2)) (M.deleteMin m)
                        else let dif = k-s in
                            if M.member ((fst num2)-1) m
                            then expand (s+dif) k $ M.adjust (+ 2*dif) ((fst num2)-1) $ M.adjust (\x->x-dif) (fst num2) m
                            else expand (s+dif) k $ M.insert ((fst num2)-1) (2*dif) $ M.adjust (\x->x-dif) (fst num2) m

toList :: M.Map Int Int -> (Int, Int) -> [Int]
toList m (_, 0) = if M.size m == 0 then [] else toList (M.deleteMax m) (M.findMax m)
toList m (k, x) = k:toList m (k, x-1)

import Data.Bits
-- import Debug.Trace
import qualified Data.Map as M
import qualified Data.Int as I
main = do
    line <- getLine
    let nk = words line
    let ans = solve (read (nk!!0)::I.Int64) (read (nk!!1)::Int)
    putStrLn (if (fst ans) then "Yes\n" ++ (printList $ snd ans) else "No")

printList :: (Show a) => [a] -> String
printList (x:[]) = show x
printList (x:xs) = (show x) ++ " " ++ printList xs

solve :: I.Int64 -> Int -> (Bool, [Int])
solve 0 _ = (False, [])
solve n k
    | popCount n > k = (False, [])
    | otherwise = (True, toList (expand 0 k (let dbg=genList 0 n in dbg)) (0,0))

genList :: Int -> I.Int64 -> (M.Map Int Int)
genList p n = case n of
    0 -> M.empty
    n -> case (n .&. 1::I.Int64) of
        0 -> genList (p+1) (shiftR n 1)
        1 -> M.insert p 1 $ genList (p+1) (shiftR n 1)

expand :: Int -> Int -> M.Map Int Int -> M.Map Int Int
expand 0 k m = expand (M.size m) k m
expand s k m
    | k == s = m
    | otherwise = let num = M.findMax m in
                    if (s + snd num) <= k then
                        if M.member ((fst num)-1) m
                        then expand (s+(snd num)) k $ M.adjust (+2*(snd num)) ((fst num)-1) (M.deleteMax m)
                        else expand (s+(snd num)) k $ M.insert ((fst num)-1) (2*(snd num)) (M.deleteMax m)
                    else let dif = k-s in
                        if M.member ((fst num)-1) m
                        then expand (s+dif) k $ M.adjust (+ 2*dif) ((fst num)-1) $ M.adjust (\x->x-dif) (fst num) m
                        else expand (s+dif) k $ M.insert ((fst num)-1) (2*dif) $ M.adjust (\x->x-dif) (fst num) m

toList :: M.Map Int Int -> (Int, Int) -> [Int]
toList m (_, 0) = if M.size m == 0 then [] else toList (M.deleteMax m) (M.findMax m)
toList m (k, x) = k:toList m (k, x-1)


Cirno gave AquaMoon a chessboard of size $$$1 \times n$$$. Its cells are numbered with integers from $$$1$$$ to $$$n$$$ from left to right. In the beginning, some of the cells are occupied with at most one pawn, and other cells are unoccupied.In each operation, AquaMoon can choose a cell $$$i$$$ with a pawn, and do either of the following (if possible):   Move pawn from it to the $$$(i+2)$$$-th cell, if $$$i+2 \leq n$$$ and the $$$(i+1)$$$-th cell is occupied and the $$$(i+2)$$$-th cell is unoccupied.  Move pawn from it to the $$$(i-2)$$$-th cell, if $$$i-2 \geq 1$$$ and the $$$(i-1)$$$-th cell is occupied and the $$$(i-2)$$$-th cell is unoccupied. You are given an initial state of the chessboard. AquaMoon wants to count the number of states reachable from the initial state with some sequence of operations. But she is not good at programming. Can you help her? As the answer can be large find it modulo $$$998\,244\,353$$$.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10\,000$$$) — the number of test cases. The first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the size of the chessboard. The second line contains a string of $$$n$$$ characters, consists of characters "0" and "1". If the $$$i$$$-th character is "1", the $$$i$$$-th cell is initially occupied; otherwise, the $$$i$$$-th cell is initially unoccupied. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, print the number of states that reachable from the initial state with some sequence of operations modulo $$$998\,244\,353$$$.

NoteIn the first test case the strings "1100", "0110" and "0011" are reachable from the initial state with some sequence of operations.

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE BangPatterns #-}

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.IO.Safe         as IOA
import qualified Data.Array.MArray.Safe     as MA
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.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn, foldl')
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM, for)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import           Debug.Trace                (trace, traceM, traceShowM)
import           GHC.IO.Handle              (hDuplicateTo)

debug :: c -> String -> c
debug = flip trace
traced x = trace (show x) x
withTrace s x = trace (s ++ " -> " ++ show x) x

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

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

powerMd :: Int64 -> Int64 -> Int64 -> Int64
powerMd md _ 0 = 1 `mod` md
powerMd md a 1 = a `mod` md
powerMd md a k
    | even k =
        let
            half :: Int64
            !half = powerMd md a (k `div` 2)

            sqrMd :: Int64 -> Int64 -> Int64
            sqrMd md x = (x ^ 2) `mod` md
        in
            sqrMd md half
    | odd k =
        let
            rest :: Int64
            !rest = powerMd md a (k - 1)
        in
            (a * rest) `mod` md

factorialMd :: Int64 -> Int64 -> Int64
factorialMd md 0 = 1 `mod` md
factorialMd md n = (`mod` md) . foldl' (\a b -> (a * b) `mod` md) 1 $ [1 .. n]

calcCombinationsMd :: Int64 -> Int64 -> Int64 -> Int64
calcCombinationsMd md n k =
        (nFactorial * denominatorMdInv) `mod` md
    where
        nFactorial :: Int64
        nFactorial = factorialMd md n

        kFactorial :: Int64
        kFactorial = factorialMd md k

        n_kFactorial :: Int64
        n_kFactorial = factorialMd md (n - k)

        denominatorMdInv :: Int64
        denominatorMdInv = powerMd md ((kFactorial * n_kFactorial) `mod` md) (md - 2)

solve :: Int -> String -> Int64
solve n s =
        calcCombinationsMd md (zeroGroupsCnt + oneGroupsCnt) zeroGroupsCnt
    where
        md :: Int64
        md = 998_244_353

        oneGroupsCnt :: Int64
        oneGroupsCnt = fromIntegral . length . filter (== "11") $ sGroups

        zeroGroupsCnt :: Int64
        zeroGroupsCnt = fromIntegral . length . filter (== "0") $ sGroups

        sGroups :: [String]
        sGroups = calcGroups s

        calcGroups :: String -> [String]
        calcGroups ('1':'1':rest) = "11" : calcGroups rest
        calcGroups (x:rest) = [x] : calcGroups rest
        calcGroups [] = []

main :: IO ()
main = do
    tests <- B8.getLine <&> readIntB8
    replicateM_ tests $ do
        n <- B8.getLine <&> readIntB8
        s <- B8.getLine <&> B8.unpack . head . B8.words

        let answer = solve n s

        printf "%lld\n" answer

{-# LANGUAGE TypeInType #-}
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

import GHC.TypeLits

newtype ModVal a (n :: Nat)= ModVal { unMod :: a} deriving (Show, Eq)

modBase :: KnownNat n => ModVal a n -> Integer
{-# INLINE modBase #-}
modBase v = natVal v

instance (Integral a, KnownNat n) => Num (ModVal a n) where
  ma@(ModVal a) + (ModVal b) =
    let
      m = fromIntegral $ modBase ma
      c = a + b
    in ModVal $ if c >= m then c - m else c
  ma@(ModVal a) - (ModVal b) =
    let
      m = fromIntegral $ modBase ma
      c = a - b
    in ModVal $ if c < 0 then c + m else c
  ma@(ModVal a) * (ModVal b) =
    let m = fromIntegral $ modBase ma in ModVal$ (a * b) `mod` m
  negate ma@(ModVal a) = let m = fromIntegral $ modBase ma in ModVal (m - a)
  abs = id
  signum _ = ModVal 1
  fromInteger x = toMod (ModVal 0) $ fromIntegral x
    where
      toMod :: (Integral a, KnownNat n) => ModVal a n -> a -> ModVal a n
      toMod m x = ModVal $ mod x $ fromIntegral $ modBase m
  {-# INLINE (+) #-}
  {-# INLINE (-) #-}
  {-# INLINE (*) #-}
  {-# INLINE abs #-}
  {-# INLINE signum #-}
  {-# INLINE fromInteger #-}

type MI = ModVal Int 998244353

pmod = 998244353
tableSize :: Int
tableSize = 10^5
fac :: Array Int MI
fac = listArray (0, tableSize) $ scanl' (*) (fromIntegral 1) $ map fromIntegral $ [1..tableSize]
invMod = (^(pmod-2))

data CountChess = CC !Int !Int deriving (Show, Eq, Ord)

countChess s c@(CC x y) = case s of
  [] -> c
  ('1':'1':xs) -> countChess xs $ CC x (y + 1)
  (k:xs) -> countChess xs $ CC (if k == '0' then x + 1 else x)  y

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    n <- getInts 1
    ~[s] <- getNext 1
    let (CC n m) = countChess (P.unpack s) (CC 0 0)
    pure $! putInts . (:[]) $! unMod $ (fac!(n+m)) * (invMod $ fac!m) * (invMod $ fac!(n))

type SP = State [P.ByteString]

readInt :: P.ByteString -> Int
readInt = fst . fromJust . P.readInt

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

getInts :: Int -> SP [Int]
getInts k = map 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

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

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

import Data.Int

data ZPos = ZPos !Int ![Int]

step :: ZPos -> Char -> ZPos
step (ZPos ix li) '0' = ZPos (ix + 1) (ix : li)
step (ZPos ix li) '1' = ZPos (ix + 1) li
step _ _ = error "invalid input"

compress :: Int -> Int -> Int
compress x y = if  even (fromIntegral y - x)
  then  x + 2
  else  x + 1

p :: Int
p = 998244353

p64 :: Int64
p64 = fromIntegral p

newtype ModP = ModP Int

instance Num ModP where
  (ModP x) * (ModP y) = ModP $ fromIntegral
    $ rem (fromIntegral x * fromIntegral y) p64

inv :: ModP -> ModP
inv = (^ (p-2))

choose :: Int -> Int -> ModP
choose n k = let
  cstep w x = w * ModP (n + 1 - x) * inv (ModP x)
  in  foldl' cstep (ModP 1) [1..k]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    s <- readLine
    let
      ZPos _n zpos = P.foldl' step (ZPos 1 []) s
      nzeros = length zpos
      cstop = foldl' compress 0 $ reverse zpos
      wiggle = div (n - cstop) 2
      ModP ans = choose (nzeros + wiggle) wiggle
    putInts [ans]

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


And now the numerous qualifying tournaments for one of the most prestigious Russian contests Russian Codec Cup are over. All n participants who have made it to the finals found themselves in a huge m-floored 108-star hotel. Of course the first thought to come in a place like this is "How about checking out the elevator?".The hotel's elevator moves between floors according to one never changing scheme. Initially (at the moment of time 0) the elevator is located on the 1-st floor, then it moves to the 2-nd floor, then — to the 3-rd floor and so on until it reaches the m-th floor. After that the elevator moves to floor m - 1, then to floor m - 2, and so on until it reaches the first floor. This process is repeated infinitely. We know that the elevator has infinite capacity; we also know that on every floor people get on the elevator immediately. Moving between the floors takes a unit of time.For each of the n participant you are given si, which represents the floor where the i-th participant starts, fi, which represents the floor the i-th participant wants to reach, and ti, which represents the time when the i-th participant starts on the floor si.For each participant print the minimum time of his/her arrival to the floor fi. If the elevator stops on the floor si at the time ti, then the i-th participant can enter the elevator immediately. If the participant starts on the floor si and that's the floor he wanted to reach initially (si = fi), then the time of arrival to the floor fi for this participant is considered equal to ti.

The first line contains two space-separated integers n and m (1 ≤ n ≤ 105, 2 ≤ m ≤ 108).  Next n lines contain information about the participants in the form of three space-separated integers si fi ti (1 ≤ si, fi ≤ m, 0 ≤ ti ≤ 108), described in the problem statement.

Print n lines each containing one integer — the time of the arrival for each participant to the required floor.

NoteLet's consider the first sample. The first participant starts at floor s = 2 by the time equal to t = 3. To get to the floor f = 4, he has to wait until the time equals 7, that's the time when the elevator will go upwards for the second time. Then the first participant should get on the elevator and go two floors up. In this case the first participant gets to the floor f at time equal to 9. The second participant starts at the time t = 0 on the floor s = 1, enters the elevator immediately, and arrives to the floor f = 2. The third participant doesn't wait for the elevator, because he needs to arrive to the same floor where he starts.

module Main where

import Control.Monad

main = do
    [n, m] <- liftM ( map read . words ) getLine :: IO [Int]
    replicateM_ n $ do
        [s, f, t] <- liftM ( map read . words ) getLine :: IO [Int]
        let k1 = ( t + (s-1) + 2 * (m-1) - 1 ) `div` ( 2 * (m-1) )
            k2 = ( t - (s-1) + 2 * (m-1) - 1 ) `div` ( 2 * (m-1) )
            t' = if s == f
                then t
                else if s < f
                then 2 * k2 * (m-1) + (s-1)
                else 2 * k1 * (m-1) - (s-1)
        putStrLn $ show $ t' + abs (f - s)

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.List

prints [] = return ()
prints (x:xs) = do print x; prints xs

elevTimes m pos = [pos - 1, 2 * m - pos - 1] ++ [ 2 * (m-1) + x | x <- elevTimes m pos ]

firstElevTime m pos under = numCycle * elevCycle + (fromJust $ find ((<=) modCycle) (elevTimes m pos))
	where
		elevCycle = 2 * (m-1)
		numCycle = under `div` elevCycle
		modCycle = under `mod` elevCycle

solve m [s,f,t]
	| s == f = t
	| otherwise = firstElevTime m f (firstElevTime m s t)

main = do
	input <- fmap (map (C.takeWhile (/='\r')) . C.lines) $ C.hGetContents stdin
	let [n,m] = map (fst . fromJust . C.readInt) . C.words $ input !! 0
	let info = map (map (fst . fromJust . C.readInt) . C.words) $ take n $ tail input
	prints $ map (solve m) info

import IO

--------------------------------------------------------------------------------
{-
import HUnit

testEmpty :: Test
testEmpty  =  Test "TestEmpty" $
    assertEq [] (solve' 2 [])

testOnePeople :: Test
testOnePeople  =  TestList "TestOnePeople"
  [
    Test "TestOneFloor (1)" $ assertEq 0 (solve 2 (1,1,0)),
    Test "TestOneFloor (2)" $ assertEq 1 (solve 2 (1,1,1)),
    Test "TestOneFloor (3)" $ assertEq 999 (solve 2 (1,1,999)),
    Test "TestOneFloor (4)" $ assertEq 0 (solve 2 (2,2,0)),
    Test "TestUpFloor (1)" $ assertEq 1 (solve 2 (1,2,0)),
    Test "TestUpFloor (2)" $ assertEq 2 (solve 3 (2,3,0)),
    Test "TestUpFloor (3)" $ assertEq 3 (solve 2 (1,2,2)),
    Test "TestUpUpFloor" $ assertEq 2 (solve 3 (1,3,0)),
    Test "TestDownFloor (1)" $ assertEq 2 (solve 2 (2,1,0)),
    Test "TestDownFloor (2)" $ assertEq 10 (solve 10 (10,9,0)),
    Test "TestDownFloor (3)" $ assertEq 4 (solve 3 (2,1,0)),
    Test "TestDownDownFloor" $ assertEq 11 (solve 10 (10,8,0)),
    Test "TestToLastFloor" $ assertEq (10^8 - 1) (solve (10^8) (1,10^8,0)),
    Test "TestToFirstFloor (1)" $ assertEq (2 * 10^8 - 2) (solve (10^8) (10^8,1,0)),
    Test "TestToFirstFloor (2)" $ assertEq (2 * 10^8 - 2) (solve (10^8) (10^8,1,10^8-1)),
    Test "TestLatecomerUp" $ assertEq 3 (solve 2 (1,2,1)),
    Test "TestLatercomerDown" $ assertEq 4 (solve 2 (2,1,2)),
    Test "TestNotLatercomerDown" $ assertEq 4 (solve 3 (2,1,3)),
    Test "TestLongExpectationUp" $ assertEq (10^8 - 1 + 2 * 10^8 - 2) (solve (10^8) (1,10^8,1)),
    Test "TestDeepRecursiveUp" $ assertEq 100000001 (solve 2 (1,2,10^8)),
    Test "TestDeepRecursiveDown" $ assertEq 100000002 (solve 2 (2,1,10^8)),
    Test "TestLongExpectationDown" $ assertEq (2 * (2 * 10^8 - 2)) (solve (10^8) (10^8,1,10^8))
  ]

testInput :: Test
testInput  =  TestList "TestInput"
  [
    Test "1" $ assertEq [9, 1, 0, 7, 10, 7, 5]
        (solve' 4 [(2,4,3), (1,2,0), (2,2,0), (1,2,1), (4,3,5), (1,2,2), (4,2,0)]),
    Test "2" $ assertEq [12, 10, 10, 8, 7]
        (solve' 5 [(1,5,4), (1,3,1), (1,3,4), (3,1,5), (4,2,5)])
  ]

testBig :: Test
testBig  =  TestList "TestBig"
  [
    Test "1" $ assertEq (replicate n (m+1)) (solve' 2 (replicate n (1,2,m))),
    Test "2" $ assertEq (replicate n (2 * (2 * m - 2))) (solve' m (replicate n (m,1,m)))
  ]
  where
    n  =  10^5
    m  =  10^8

test :: IO ()
test  =  mapM_ run
  [
    testEmpty,
    testOnePeople,
    testInput,
    testBig
  ]
-}
--------------------------------------------------------------------------------

solve' :: Int -> [(Int, Int, Int)] -> [Int]
solve' n  =  map (solve n)

solve :: Int -> (Int, Int, Int) -> Int
solve n (s, f, time)
  | s < f && time < s  =  f - 1
  | s < f  =  period * (div time' period) + solve n (s, f, (mod time' period) - period')
  | s > f && time'' < period  =  period - f + 1
  | s > f  =  period * (div time'' period) + solve n (s, f, mod time'' period - period'')
  | otherwise  =  time
  where
    period  =  2 * (n - 1)
    time'  =  time + period'
    period'  =  period - s
    time''  =  time + period''
    period''  =  s - 2

reads :: IO [Int]
reads  =  getLine >>= return . map read . words

readPeople :: IO (Int, Int, Int)
readPeople  =  do
    [a, b, c]  <-  Main.reads
    return (a, b, c)

main :: IO ()
main  =  do
    [n, m]  <-  Main.reads
    mapM_ (const (readPeople >>= print . (solve m))) [1..n]

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

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

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

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

solve (m, peoples) = BS.unlines [ BS.pack $ show (solveCase m p) | p <- peoples]

solveCase m (s, f, t)
    | s < f     = solveCase' firstUp period t + (f - s)
    | s > f     = solveCase' firstDown period t + (s - f)
    | otherwise = t
  where
    firstUp = s - 1
    firstDown = m - s + (m - 1)
    period = 2 * (m - 1)

solveCase' first period time = head $ dropWhile (<time) [t, t + period..]
  where
    t = (time - first) `div` period * period + first

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Control.Monad
import Data.Array
import Data.Char
class Expression a where scan' :: String -> a; showans :: a -> String
instance Expression Int where scan' = read; showans = show
instance Expression Char where scan' (x:_) = x;showans = (:[])
instance Expression Float where scan' = read;showans = show
instance Expression Double where scan' = read;showans = show
instance Expression Integer where scan' = read;showans = show
instance Expression String where scan' = id;showans = id
instance (Expression a,Expression b) => Expression (a,b) where
    scan' = (\(x:y:_) -> (scan' x,scan' y)).words;showans (x,y) = showans x++' ':showans y
instance (Expression a,Expression b,Expression c) => Expression (a,b,c) where
    scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;showans (x,y,z) = showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d) => Expression (a,b,c,d) where
    scan' = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)).words;showans (w,x,y,z) = showans w++' ':showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d,Expression e) => Expression (a,b,c,d,e) where
    scan' = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)).words;showans (v,w,x,y,z) = showans v++' ':showans w++' ':showans x++' ':showans y++' ':showans z
scan :: (Expression a) => IO a; scan = getLine>>=(return.scan')
scans :: (Expression a) => Int -> IO [a]; scans n = replicateM n scan
scanlist :: (Expression a) => IO [a]; scanlist = getLine>>=return.(map scan').words
scanlists :: (Expression a) => Int -> IO [[a]]; scanlists n = replicateM n scanlist
putAnsLn :: (Expression a) => a -> IO (); putAnsLn = putStrLn.showans
putAnsLns :: (Expression a) => [a] -> IO (); putAnsLns = mapM_ putAnsLn

data Dir = Up|Down deriving (Eq,Show)
revd Up = Down
revd Down = Up

solve :: Int -> Int -> Int -> IO ()
solve c m n = do (s,f,t) <- scan :: IO (Int,Int,Int)
                 let now = mod t c
                     (nowstair,dir) = if now<m then (now+1,Up) else (c-now+1,Down)
                     dir2 = if (dir==Up&&nowstair>s)||(dir==Down&&nowstair<s) then revd dir else dir
                     dist1 = if dir==Up then
                                 if nowstair>s then 2*m-nowstair-s else s-nowstair
                             else
                                 if nowstair<s then nowstair+s-2 else nowstair-s
                     dist2 = if dir2==Up then
                                 if s>f then 2*m-s-f else f-s
                             else
                                 if s<f then s+f-2 else s-f
                 print (if s==f then t else (dist1 + dist2 + t))
                 when (n/=1) (solve c m (n-1))

main = do (n,m) <- scan :: IO (Int,Int)
          solve (2*m-2) m n

q m[s,f,pt]|s==f=t|f<s=m+q m[m-s,m-f,pt-m]|1>0=(t-s+c-1)`div`c*c+f where c=2*m;t=succ pt
s([_,m]:l)=map(q m)l
main=interact$unlines.map show.s.map(map(pred.read).words).lines

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Control.Monad
import Data.Array
import Data.Char
class Expression a where scan' :: String -> a; showans :: a -> String
instance Expression Int where scan' = read; showans = show
instance Expression Char where scan' (x:_) = x;showans = (:[])
instance Expression Float where scan' = read;showans = show
instance Expression Double where scan' = read;showans = show
instance Expression Integer where scan' = read;showans = show
instance Expression String where scan' = id;showans = id
instance (Expression a,Expression b) => Expression (a,b) where
    scan' = (\(x:y:_) -> (scan' x,scan' y)).words;showans (x,y) = showans x++' ':showans y
instance (Expression a,Expression b,Expression c) => Expression (a,b,c) where
    scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;showans (x,y,z) = showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d) => Expression (a,b,c,d) where
    scan' = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)).words;showans (w,x,y,z) = showans w++' ':showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d,Expression e) => Expression (a,b,c,d,e) where
    scan' = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)).words;showans (v,w,x,y,z) = showans v++' ':showans w++' ':showans x++' ':showans y++' ':showans z
scan :: (Expression a) => IO a; scan = getLine>>=(return.scan')
scans :: (Expression a) => Int -> IO [a]; scans n = replicateM n scan
scanlist :: (Expression a) => IO [a]; scanlist = getLine>>=return.(map scan').words
scanlists :: (Expression a) => Int -> IO [[a]]; scanlists n = replicateM n scanlist
putAnsLn :: (Expression a) => a -> IO (); putAnsLn = putStrLn.showans
putAnsLns :: (Expression a) => [a] -> IO (); putAnsLns = mapM_ putAnsLn

data Dir = Up|Down deriving (Eq,Show)

solve :: Int -> Int -> [(Int,Int,Int)] -> [Int]
solve _ _ [] = []
solve c m ((s,f,t):xs) = let now = mod (t+1) c
                             (nowstair,dir) = if now<=m then (now,Up) else (c-now+2,Down)
                             dist1 = if dir==Up then
                                         if nowstair>s then 2*m-nowstair-s else s-nowstair
                                     else
                                         if nowstair<s then nowstair+s-2 else nowstair-s
                             dist2 = if dir==Up then
                                         if s>f then 2*m-s-f else f-s
                                     else
                                         if s<f then s+f-2 else s-f
                         in
                           (if s==f then 0 else (dist1 + dist2 + t)):(solve c m xs)

main = do (n,m) <- scan :: IO (Int,Int)
          l <- scans n :: IO [(Int,Int,Int)]
          putAnsLns (solve (2*m-2) m l)

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Control.Monad
import Data.Array
import Data.Char
class Expression a where scan' :: String -> a; showans :: a -> String
instance Expression Int where scan' = read; showans = show
instance Expression Char where scan' (x:_) = x;showans = (:[])
instance Expression Float where scan' = read;showans = show
instance Expression Double where scan' = read;showans = show
instance Expression Integer where scan' = read;showans = show
instance Expression String where scan' = id;showans = id
instance (Expression a,Expression b) => Expression (a,b) where
    scan' = (\(x:y:_) -> (scan' x,scan' y)).words;showans (x,y) = showans x++' ':showans y
instance (Expression a,Expression b,Expression c) => Expression (a,b,c) where
    scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;showans (x,y,z) = showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d) => Expression (a,b,c,d) where
    scan' = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)).words;showans (w,x,y,z) = showans w++' ':showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d,Expression e) => Expression (a,b,c,d,e) where
    scan' = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)).words;showans (v,w,x,y,z) = showans v++' ':showans w++' ':showans x++' ':showans y++' ':showans z
scan :: (Expression a) => IO a; scan = getLine>>=(return.scan')
scans :: (Expression a) => Int -> IO [a]; scans n = replicateM n scan
scanlist :: (Expression a) => IO [a]; scanlist = getLine>>=return.(map scan').words
scanlists :: (Expression a) => Int -> IO [[a]]; scanlists n = replicateM n scanlist
putAnsLn :: (Expression a) => a -> IO (); putAnsLn = putStrLn.showans
putAnsLns :: (Expression a) => [a] -> IO (); putAnsLns = mapM_ putAnsLn

data Dir = Up|Down deriving (Eq,Show)

solve :: Int -> Int -> [(Int,Int,Int)] -> [Int]
solve _ _ [] = []
solve c m ((s,f,t):xs) = let now = mod (t+1) c
                             (nowstair,dir) = if now<m then (now,Up) else (c-m+2,Down)
                             dist1 = if dir==Up then
                                         if nowstair>s then 2*m-nowstair-s else s-nowstair
                                     else
                                         if nowstair<s then nowstair+s-2 else nowstair-s
                             dist2 = if dir==Up then
                                         if s>f then 2*m-s-f else f-s
                                     else
                                         if s<f then s+f-2 else s-f-1
                         in
                           (if s==f then 0 else (dist1 + dist2 + t)):(solve c m xs)

main = do (n,m) <- scan :: IO (Int,Int)
          l <- scans n :: IO [(Int,Int,Int)]
          putAnsLns (solve (2*m-2) m l)

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Control.Monad
import Data.Array
import Data.Char
class Expression a where scan' :: String -> a; showans :: a -> String
instance Expression Int where scan' = read; showans = show
instance Expression Char where scan' (x:_) = x;showans = (:[])
instance Expression Float where scan' = read;showans = show
instance Expression Double where scan' = read;showans = show
instance Expression Integer where scan' = read;showans = show
instance Expression String where scan' = id;showans = id
instance (Expression a,Expression b) => Expression (a,b) where
    scan' = (\(x:y:_) -> (scan' x,scan' y)).words;showans (x,y) = showans x++' ':showans y
instance (Expression a,Expression b,Expression c) => Expression (a,b,c) where
    scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;showans (x,y,z) = showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d) => Expression (a,b,c,d) where
    scan' = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)).words;showans (w,x,y,z) = showans w++' ':showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d,Expression e) => Expression (a,b,c,d,e) where
    scan' = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)).words;showans (v,w,x,y,z) = showans v++' ':showans w++' ':showans x++' ':showans y++' ':showans z
scan :: (Expression a) => IO a; scan = getLine>>=(return.scan')
scans :: (Expression a) => Int -> IO [a]; scans n = replicateM n scan
scanlist :: (Expression a) => IO [a]; scanlist = getLine>>=return.(map scan').words
scanlists :: (Expression a) => Int -> IO [[a]]; scanlists n = replicateM n scanlist
putAnsLn :: (Expression a) => a -> IO (); putAnsLn = putStrLn.showans
putAnsLns :: (Expression a) => [a] -> IO (); putAnsLns = mapM_ putAnsLn

data Dir = Up|Down deriving (Eq,Show)

solve :: Int -> Int -> [(Int,Int,Int)] -> [Int]
solve _ _ [] = []
solve c m ((s,f,t):xs) = let now = mod (t+1) c
                             (nowstair,dir) = if now<m then (now,Up) else (c-now+2,Down)
                             dist1 = if dir==Up then
                                         if nowstair>s then 2*m-nowstair-s else s-nowstair
                                     else
                                         if nowstair<s then nowstair+s-2 else nowstair-s
                             dist2 = if dir==Up then
                                         if s>f then 2*m-s-f else f-s
                                     else
                                         if s<f then s+f-2 else s-f
                         in
                           (if s==f then 0 else (dist1 + dist2 + t)):(solve c m xs)

main = do (n,m) <- scan :: IO (Int,Int)
          l <- scans n :: IO [(Int,Int,Int)]
          putAnsLns (solve (2*m-2) m l)

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Control.Monad
import Data.Array
import Data.Char
class Expression a where scan' :: String -> a; showans :: a -> String
instance Expression Int where scan' = read; showans = show
instance Expression Char where scan' (x:_) = x;showans = (:[])
instance Expression Float where scan' = read;showans = show
instance Expression Double where scan' = read;showans = show
instance Expression Integer where scan' = read;showans = show
instance Expression String where scan' = id;showans = id
instance (Expression a,Expression b) => Expression (a,b) where
    scan' = (\(x:y:_) -> (scan' x,scan' y)).words;showans (x,y) = showans x++' ':showans y
instance (Expression a,Expression b,Expression c) => Expression (a,b,c) where
    scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;showans (x,y,z) = showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d) => Expression (a,b,c,d) where
    scan' = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)).words;showans (w,x,y,z) = showans w++' ':showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d,Expression e) => Expression (a,b,c,d,e) where
    scan' = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)).words;showans (v,w,x,y,z) = showans v++' ':showans w++' ':showans x++' ':showans y++' ':showans z
scan :: (Expression a) => IO a; scan = getLine>>=(return.scan')
scans :: (Expression a) => Int -> IO [a]; scans n = replicateM n scan
scanlist :: (Expression a) => IO [a]; scanlist = getLine>>=return.(map scan').words
scanlists :: (Expression a) => Int -> IO [[a]]; scanlists n = replicateM n scanlist
putAnsLn :: (Expression a) => a -> IO (); putAnsLn = putStrLn.showans
putAnsLns :: (Expression a) => [a] -> IO (); putAnsLns = mapM_ putAnsLn

data Dir = Up|Down deriving (Eq,Show)

solve :: Int -> Int -> [(Int,Int,Int)] -> [Int]
solve _ _ [] = []
solve c m ((s,f,t):xs) = let now = mod (t+1) c
                             (nowstair,dir) = if now<m then (now,Up) else (c-now+2,Down)
                             dist1 = if dir==Up then
                                         if nowstair>s then 2*m-nowstair-s else s-nowstair
                                     else
                                         if nowstair<s then nowstair+s-2 else nowstair-s
                             dist2 = if dir==Up then
                                         if s>f then 2*m-s-f else f-s
                                     else
                                         if s<f then s+f-2 else s-f
                         in
                           (if s==f then t else (dist1 + dist2 + t)):(solve c m xs)

main = do (n,m) <- scan :: IO (Int,Int)
          l <- scans n :: IO [(Int,Int,Int)]
          putAnsLns (solve (2*m-2) m l)

q m[s,f,pt]|s==f=t|f<s=m+q m[m-s,m-f,t-m]|1>0=(t-s+c-1)`div`c*c+f where c=2*m;t=succ pt
s([_,m]:l)=map(q$m)l
main=interact$unlines.map show.s.map(map(pred.read).words).lines


According to an old legeng, a long time ago Ankh-Morpork residents did something wrong to miss Fortune, and she cursed them. She said that at some time n snacks of distinct sizes will fall on the city, and the residents should build a Snacktower of them by placing snacks one on another. Of course, big snacks should be at the bottom of the tower, while small snacks should be at the top.Years passed, and once different snacks started to fall onto the city, and the residents began to build the Snacktower.  However, they faced some troubles. Each day exactly one snack fell onto the city, but their order was strange. So, at some days the residents weren't able to put the new stack on the top of the Snacktower: they had to wait until all the bigger snacks fell. Of course, in order to not to anger miss Fortune again, the residents placed each snack on the top of the tower immediately as they could do it.Write a program that models the behavior of Ankh-Morpork residents.

The first line contains single integer n (1 ≤ n ≤ 100 000) — the total number of snacks. The second line contains n integers, the i-th of them equals the size of the snack which fell on the i-th day. Sizes are distinct integers from 1 to n.

Print n lines. On the i-th of them print the sizes of the snacks which the residents placed on the top of the Snacktower on the i-th day in the order they will do that. If no snack is placed on some day, leave the corresponding line empty.

NoteIn the example a snack of size 3 fell on the first day, and the residents immediately placed it. On the second day a snack of size 1 fell, and the residents weren't able to place it because they were missing the snack of size 2. On the third day a snack of size 2 fell, and the residents immediately placed it. Right after that they placed the snack of size 1 which had fallen before.

module Main where

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import qualified Data.Set as S
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = map readInt . B.words

fst3 (a, b, c) = a
solve n = reverse . fst3 . foldl' (\(dds, inits, maxi) x -> let
  inits' = S.insert x inits
  ds = takeWhile (`S.member` inits') [maxi, maxi - 1..1]
  in (ds:dds, inits', maxi - length ds)) ([], S.empty, n)

main = do
  n <- readInt <$> B.getLine
  xs <- readInts <$> B.getLine
  putStrLn . intercalate "\n" . map (intercalate " " . map show) $ solve n xs

import Data.List
import qualified Data.Set as Set

partitionaAtNotSuccessive _ [] = ([], [])
partitionaAtNotSuccessive _ [x] = ([x], [])
partitionaAtNotSuccessive next (x : xs)
                            | next x == head xs = (x : fst t, snd t)
                            | otherwise = ([x], xs)
                                where t = partitionaAtNotSuccessive next xs

f :: Int -> [Int] -> Set.Set Int -> [[Int]]
f _ [] _ = []
f n (x:xs) p
--    | n == x = successive : f (succ (last successive)) xs (Set.fromList notSuccessive)
--    | otherwise = [] : f n xs (Set.insert x p)
--                            where (successive, notSuccessive) = partitionaAtNotSuccessive succ (Set.toList (Set.insert x p))
--
    | n == x = successive : f (succ lastSuccessive) xs (notSuccessive)
    | otherwise = [] : f n xs nextP
                            where nextP = Set.insert x p
                                  successive = takeWhile ((flip Set.member) nextP) [n..]
                                  lastSuccessive = last successive
                                  notSuccessive = snd (Set.split lastSuccessive nextP)

main = do
        nS <- getLine
        snacksS <- getLine
        let n = read nS :: Int
            snacks = map (n - ) (map read (words snacksS) :: [Int])
        putStr (unlines
                (map unwords
                        (map
                         (map (\x -> show (n - x)))
                            (f 0 snacks Set.empty)
                        )
                    )
                )

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  readLn >>= \n -> solve.(++) [n].map (fst.fromJust.C.readInt).C.words=<< C.getLine
solve::[Int]->IO ()
solve (x:xs) = foldM_ (\b a -> let pr = f b a in putStrLn (unwords $ map show pr) >> return (slv1 b a pr) ) (x,Set.empty)  $  xs
  where f (z1,z2) z3 = if z3==z1 then z3:slv2 z2 (z3-1) else []
slv1 (b, bs) x [] = (b,Set.insert x bs)
slv1 (b, bs) x ys = (b-length ys, bs)
slv2 ss1 0 =[]
slv2 ss1 x = let i = fromMaybe (-1) $ Set.lookupIndex (x) ss1 in if i/=(-1) then (x:slv2 ss1 (x-1)) else []

import Control.Applicative( (<$>))
import Data.IntSet( deleteFindMax, insert, empty, null)
import qualified Data.IntSet as IS
main = do
    n_ <- readLn
    ns_ <- map read . words <$> getLine
    let
	proc _	_	[]  = []
	proc st next (n:ns)
	  | n==next	    = let
			    (dmp,st',next') = dump [] st (next-1)
			in
			    (n:reverse dmp):(proc st' next' ns)
	  | otherwise	    = []:(proc (insert n st) next ns)
	dump v st   next
	  | IS.null st	    = (v,empty,next)
	  | otherwise	    = let
				(mx,st') = deleteFindMax st
			    in
				if mx==next
				    then dump (mx:v) st' (next-1)
				    else (v, st, next)

	putStrs [] = putStrLn ""
	putStrs (x:xs) = (putStr $ (show x)++" ") >> putStrs xs
	print' [] = return ()
	print' (x:xs) = putStrs x >> print' xs

    print' $ proc empty n_ ns_

-- 767A

import Data.Functor ((<$>))
import Control.Monad.State

checkHeap :: (Int, MaxSkewHeap) -> StateT (Int, MaxSkewHeap) IO ()
checkHeap (i, oldHeap) = do
  case pop oldHeap of
    Just (top, newHeap) ->
      if i == top
      then do
        liftIO . putStr $ ' ':(show top)
        checkHeap (i - 1, newHeap)
      else put (i, oldHeap)
    Nothing -> put (i, oldHeap)

addValue :: Int -> StateT (Int, MaxSkewHeap) IO ()
addValue x = do
  (i, heap) <- get
  if i == x
  then do
    liftIO . putStr $ show i
    checkHeap (i - 1, heap)
  else put $ (i, insert x heap)
  liftIO . putChar $ '\n'

main :: IO ()
main = do
  _ <- getLine
  nums <- fmap read <$> words <$> getLine
  evalStateT (mapM_ addValue nums) (length nums, Empty)

data MaxSkewHeap = Empty | Node Int MaxSkewHeap MaxSkewHeap

(∪) :: MaxSkewHeap -> MaxSkewHeap -> MaxSkewHeap
(∪) l Empty = l
(∪) Empty r = r
(∪) l@(Node lval l1 r1) r@(Node rval l2 r2)
   | predicate lval rval = Node lval (r ∪ r1) l1
   | otherwise = Node rval (l ∪ r2) l2
   where predicate = (>)

insert :: Int -> MaxSkewHeap -> MaxSkewHeap
insert x heap = (Node x Empty Empty) ∪ heap

pop :: MaxSkewHeap -> Maybe (Int, MaxSkewHeap)
pop Empty = Nothing
pop (Node x l r) = Just (x, l ∪ r)

module Main where

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

readInt = maybe undefined fst . B.readInt
readInts = map readInt . B.words

fst4 (a, b, c, d) = a
solve n = reverse . fst4 . foldl' (\(ds, maxi, mini, s) x ->
  let mini' = min x mini
      s' = x:s
  in if x < maxi then ([]:ds, maxi, mini', s') else (s':ds, mini' - 1, mini', [])) ([], n, n, [])

main = do
  n <- readInt <$> B.getLine
  xs <- readInts <$> B.getLine
  putStrLn . intercalate "\n" . map (intercalate " " . map show) $ solve n xs

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  readLn >>= \n -> solve.(++) [n].map (fst.fromJust.C.readInt).C.words=<< C.getLine
solve::[Int]->IO ()
solve (x:xs) = foldM_ (\b (a1,a2) -> putStrLn (f (a1,a2) b) >> return (if a2==Set.empty then a1 else b) ) (x+1)  $ zip [x,(x-1)..] $ zipWith (\ a b -> a Set.\\ b)(map Set.fromList $ tail $ inits xs) (map Set.fromList $ tail $ inits [x,(x-1)..])
  where f (z11,z12) z2 = unwords $ map show $ if z12==Set.empty then tail $ reverse [z11 .. z2] else []