For a given array $$$a$$$ consisting of $$$n$$$ integers and a given integer $$$m$$$ find if it is possible to reorder elements of the array $$$a$$$ in such a way that $$$\sum_{i=1}^{n}{\sum_{j=i}^{n}{\frac{a_j}{j}}}$$$ equals $$$m$$$? It is forbidden to delete elements as well as insert new elements. Please note that no rounding occurs during division, for example, $$$\frac{5}{2}=2.5$$$.

The first line contains a single integer $$$t$$$ — the number of test cases ($$$1 \le t \le 100$$$). The test cases follow, each in two lines. The first line of a test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n \le 100$$$, $$$0 \le m \le 10^6$$$). The second line contains integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^6$$$) — the elements of the array.

For each test case print "YES", if it is possible to reorder the elements of the array in such a way that the given formula gives the given value, and "NO" otherwise.

NoteIn the first test case one of the reorders could be $$$[1, 2, 5]$$$. The sum is equal to $$$(\frac{1}{1} + \frac{2}{2} + \frac{5}{3}) + (\frac{2}{2} + \frac{5}{3}) + (\frac{5}{3}) = 8$$$. The brackets denote the inner sum $$$\sum_{j=i}^{n}{\frac{a_j}{j}}$$$, while the summation of brackets corresponds to the sum over $$$i$$$.

module Main where

import Control.Monad

solveCase :: (Int, [Int]) -> String
solveCase (m, xs)
  | sum xs == m = "YES"
  | otherwise = "NO"

readCase :: IO (Int, [Int])
readCase = do
  [_, m] <- map read . words <$> getLine
  xs <- map read . words <$> getLine
  return (m, xs)

main :: IO ()
main = do
  t <- read <$> getLine
  answer <- map solveCase <$> replicateM t readCase
  putStr $ unlines answer

import Control.Monad

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

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [_n, m] <- readInts
    a <- readInts
    putStrLn $ if  m == sum a
      then  "YES"
      else  "NO"


You are given two integers $$$a$$$ and $$$b$$$. You can perform a sequence of operations: during the first operation you choose one of these numbers and increase it by $$$1$$$; during the second operation you choose one of these numbers and increase it by $$$2$$$, and so on. You choose the number of these operations yourself.For example, if $$$a = 1$$$ and $$$b = 3$$$, you can perform the following sequence of three operations:   add $$$1$$$ to $$$a$$$, then $$$a = 2$$$ and $$$b = 3$$$;  add $$$2$$$ to $$$b$$$, then $$$a = 2$$$ and $$$b = 5$$$;  add $$$3$$$ to $$$a$$$, then $$$a = 5$$$ and $$$b = 5$$$. Calculate the minimum number of operations required to make $$$a$$$ and $$$b$$$ equal.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The only line of each test case contains two integers $$$a$$$ and $$$b$$$ ($$$1 \le a, b \le 10^9$$$).

For each test case print one integer — the minimum numbers of operations required to make $$$a$$$ and $$$b$$$ equal.

NoteFirst test case considered in the statement.In the second test case integers $$$a$$$ and $$$b$$$ are already equal, so you don't need to perform any operations.In the third test case you have to apply the first, the second, the third and the fourth operation to $$$b$$$ ($$$b$$$ turns into $$$20 + 1 + 2 + 3 + 4 = 30$$$).

import Data.Char
import Data.List
import Control.Monad

-- a + trSum(ans) - x = b + x
-- a + trSum(ans) - b = 2x
-- x has to non negative for a valid ans

trSum :: Integer -> Integer
trSum n = (n * (n + 1)) `div` 2

solve :: Integer -> [Integer] -> Integer
solve ans [a,b]
    | x < 0 || x `mod` 2 /= 0 = solve (ans + 1) [a,b]
    | otherwise               = ans
    where x = (a + (trSum ans) - b)
solve _ _ = 0

-- putStrLn :: String -> IO ()
main :: IO ()
main = do
    input <- getContents
    putStrLn $ unlines . map (show . solve 0) . map (sort . map read . words) . tail . lines $ input

{-# LANGUAGE Safe #-}

module Main where

import qualified Data.ByteString.Char8 as B
import           Data.Maybe (fromJust)
import           Control.Monad (replicateM)
import qualified Data.Set as S
import qualified Data.Map.Strict as MS
import qualified Data.Map as M

main :: IO ()
main = do
  n <- bInt <$> B.getLine
  xs <- map (show . diff . (map bInt . B.words)) <$> replicateM n B.getLine
  putStr (unlines xs)

bInt = fst . fromJust . B.readInt

diff :: [Int] -> Int
diff (x:y:_) = f sums where
  d = abs (x-y)
  l = floor . max 0 . (\x -> 1+x/2) . sqrt . fromIntegral $ (4*d+1)
  sums = [(i, (i * (i + 1)) `div` 2) | i <- [l-1 ..]]
  f ((i, x):xs) = if (x >= d) && (x `mod` 2 == d `mod` 2) then i else f xs

sums = [(i, (i * (i + 1)) `div` 2) | i <- [0 .. 44722]]

{-# LANGUAGE Safe #-}

module Main where

import qualified Data.ByteString.Char8 as B
import           Data.Maybe (fromJust)
import           Control.Monad (replicateM)
import qualified Data.Set as S
import qualified Data.Map.Strict as MS
import qualified Data.Map as M

main :: IO ()
main = do
  n <- bInt <$> B.getLine
  xs <- map (show . diff . (map bInt . B.words)) <$> replicateM n B.getLine
  putStr (unlines xs)

bInt = fst . fromJust . B.readInt

diff :: [Int] -> Int
diff (x:y:_) = f sums where
  d = abs (x-y)
  l = floor . max 0 . (\x -> 1+x/2) . sqrt . fromIntegral $ (4*d+1)
  sums = (0,0):[(i, (i * (i + 1)) `div` 2) | i <- [l ..]]
  f ((i, x):xs) = if (x >= d) && (x `mod` 2 == d `mod` 2) then i else f xs

sums = [(i, (i * (i + 1)) `div` 2) | i <- [0 .. 44722]]


Very soon Berland will hold a School Team Programming Olympiad. From each of the m Berland regions a team of two people is invited to participate in the olympiad. The qualifying contest to form teams was held and it was attended by n Berland students. There were at least two schoolboys participating from each of the m regions of Berland. The result of each of the participants of the qualifying competition is an integer score from 0 to 800 inclusive.The team of each region is formed from two such members of the qualifying competition of the region, that none of them can be replaced by a schoolboy of the same region, not included in the team and who received a greater number of points. There may be a situation where a team of some region can not be formed uniquely, that is, there is more than one school team that meets the properties described above. In this case, the region needs to undertake an additional contest. The two teams in the region are considered to be different if there is at least one schoolboy who is included in one team and is not included in the other team. It is guaranteed that for each region at least two its representatives participated in the qualifying contest.Your task is, given the results of the qualifying competition, to identify the team from each region, or to announce that in this region its formation requires additional contests.

The first line of the input contains two integers n and m (2 ≤ n ≤ 100 000, 1 ≤ m ≤ 10 000, n ≥ 2m) — the number of participants of the qualifying contest and the number of regions in Berland. Next n lines contain the description of the participants of the qualifying contest in the following format: Surname (a string of length from 1 to 10 characters and consisting of large and small English letters), region number (integer from 1 to m) and the number of points scored by the participant (integer from 0 to 800, inclusive). It is guaranteed that all surnames of all the participants are distinct and at least two people participated from each of the m regions. The surnames that only differ in letter cases, should be considered distinct.

Print m lines. On the i-th line print the team of the i-th region — the surnames of the two team members in an arbitrary order, or a single character "?" (without the quotes) if you need to spend further qualifying contests in the region.

5 2
Ivanov 1 763
Andreev 2 800
Petrov 1 595
Sidorov 1 790
Semenov 2 503

5 2
Ivanov 1 800
Andreev 2 763
Petrov 1 800
Sidorov 1 800
Semenov 2 503

NoteIn the first sample region teams are uniquely determined.In the second sample the team from region 2 is uniquely determined and the team from region 1 can have three teams: "Petrov"-"Sidorov", "Ivanov"-"Sidorov", "Ivanov" -"Petrov", so it is impossible to determine a team uniquely.

import Data.List (foldl',sort)
import Control.Monad
import Data.IntMap hiding (map,foldl')
import qualified Data.ByteString.Char8 as B

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    l <- (forM [1..n] $ \i ->  do
        [name,region,rank] <- fmap (words . B.unpack) B.getLine
        return (read region,(-(read rank),name)) :: IO (Int,(Int,String)))
    let a = foldl' (\mp (k,v) -> update (\il -> return (v:il)) k mp) (fromList (zip [1..m] (repeat []))) l
        ls = elems a
    forM_ ls $ \i -> do
        let (x:xs) = take 3 (sort i)
        if and[length (x:xs) > 2,all (\(a,_) -> a == fst (head xs)) (take 2 xs)]
            then putStrLn "?"
            else putStrLn (snd x ++ " " ++ snd (xs!!0))

{- ok -}
import Control.Applicative ((<$>))
import Data.List (groupBy, sortBy)
import Data.Function (on)
import Data.ByteString (getLine, getContents)
import Data.ByteString.Char8 (readInt, lines, words, unpack)
import Data.Maybe (fromJust)
import Prelude hiding (getLine, getContents, lines, words)

readInt' = fst . fromJust . readInt

main = do
	getLine
	people <- map ((\[a, b, c] -> (unpack a, readInt' b, readInt' c)) . words) . lines <$> getContents

	let
		select [(name1, _, _), (name2, _, _)] = name1 ++ " " ++ name2
		select ((name1, _, score1):(name2, _, score2):(name3, _, score3):_) = if score2 == score3 then "?" else name1 ++ " " ++ name2

	putStr . unlines . map (select . reverse) . groupBy ((==) `on` (\(_, a, _) -> a)) $ sortBy (compare `on` (\(a, b, c) -> (b, c))) people

import Data.List (foldl',sort)
import Control.Monad
import Data.IntMap hiding (map,foldl')

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    l <- (forM [1..n] $ \i ->  do
        [name,region,rank] <- fmap words getLine
        return (read region,(-(read rank),name)) :: IO (Int,(Int,String)))
    let a = foldl' (\mp (k,v) -> update (\il -> return (v:il)) k mp) (fromList (zip [1..m] (repeat []))) l
        ls = elems a
    forM_ ls $ \i -> do
        let (x:xs) = take 5 (sort i)
        if all (\(a,_) -> a == fst x) (x:xs)
            then putStrLn "?"
            else putStrLn (snd x ++ " " ++ snd (xs!!0))

import Data.List (foldl',sort)
import Control.Monad
import Data.IntMap hiding (map,foldl')

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    l <- (forM [1..n] $ \i ->  do
        [name,region,rank] <- fmap words getLine
        return (read region,(-(read rank),name)) :: IO (Int,(Int,String)))
    let a = foldl' (\mp (k,v) -> update (\il -> return (v:il)) k mp) (fromList (zip [1..m] (repeat []))) l
        ls = elems a
    forM_ ls $ \i -> do
        let (x:xs) = take 3 (sort i)
        if all (\(a,_) -> a == fst x) (x:xs)
            then putStrLn "?"
            else putStrLn (snd x ++ " " ++ snd (xs!!0))

import Data.List (foldl',sort)
import Control.Monad
import Data.IntMap hiding (map,foldl')
import qualified Data.ByteString.Char8 as B

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    l <- (forM [1..n] $ \i ->  do
        [name,region,rank] <- fmap (words . B.unpack) B.getLine
        return (read region,(-(read rank),name)) :: IO (Int,(Int,String)))
    let a = foldl' (\mp (k,v) -> update (\il -> return (v:il)) k mp) (fromList (zip [1..m] (repeat []))) l
        ls = elems a
    forM_ ls $ \i -> do
        let (x:xs) = take 3 (sort i)
        if and[length (x:xs) > 2,all (\(a,_) -> a == fst x) (take 2 xs)]
            then putStrLn "?"
            else putStrLn (snd x ++ " " ++ snd (xs!!0))


The capital of Berland looks like a rectangle of size n × m of the square blocks of same size.Fire!It is known that k + 1 blocks got caught on fire (k + 1 ≤ n·m). Those blocks are centers of ignition. Moreover positions of k of these centers are known and one of these stays unknown. All k + 1 positions are distinct.The fire goes the following way: during the zero minute of fire only these k + 1 centers of ignition are burning. Every next minute the fire goes to all neighbouring blocks to the one which is burning. You can consider blocks to burn for so long that this time exceeds the time taken in the problem. The neighbouring blocks are those that touch the current block by a side or by a corner.Berland Fire Deparment wants to estimate the minimal time it takes the fire to lighten up the whole city. Remember that the positions of k blocks (centers of ignition) are known and (k + 1)-th can be positioned in any other block.Help Berland Fire Department to estimate the minimal time it takes the fire to lighten up the whole city.

The first line contains three integers n, m and k (1 ≤ n, m ≤ 109, 1 ≤ k ≤ 500). Each of the next k lines contain two integers xi and yi (1 ≤ xi ≤ n, 1 ≤ yi ≤ m) — coordinates of the i-th center of ignition. It is guaranteed that the locations of all centers of ignition are distinct.

Print the minimal time it takes the fire to lighten up the whole city (in minutes).

NoteIn the first example the last block can have coordinates (4, 4).In the second example the last block can have coordinates (8, 3).

-- 845E

{-# LANGUAGE RecordWildCards #-}

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Monoid (mconcat)

maxN = 1000000000 :: Int
toInt = fst . fromJust . B.readInt
parse = map toInt . B.words

data Rect = Rect { left :: Int
                 , right :: Int
                 , top :: Int
                 , bottom :: Int
                 } deriving (Show)

main = do
  (n:m:_) <- fmap parse B.getLine
  B.interact $ B.pack . show . program (n, m) . input
  where input = map parse . B.lines

program :: (Int, Int) -> [[Int]] -> Int
program (n, m) centers = binarySearch check 0 (max n m)
  where check :: Int -> Bool
        check t = maxBound <= (2*t + 1)
          where rects :: [Rect]
                rects = foldr f [Rect 1 n 1 m] centers
                  where f [x,y] = mconcat . map (subdivide (x, y) t)
                maxBound = max (right - left + 1) (bottom - top + 1)
                  where Rect{..} = bounds rects

binarySearch :: (Int -> Bool) -> Int -> Int -> Int
binarySearch pred l h
  | l == h    = l
  | otherwise =
      let mid = (l + h) `div` 2 in
      if pred mid
      then binarySearch pred l mid
      else binarySearch pred (mid + 1) h

{-
   x1  x2  x3  x4
y1 ----|-------|
   |  ||       |
   |  ||-------|
y2 |  |#####----
y3 ----#####|  |
   |-------||  |
y4 |-------|----
-}
subdivide :: (Int, Int) -> Int -> Rect -> [Rect]
subdivide (x, y) t r@Rect{..}
  | ((x+t) < left) ||
    ((x-t) > right) ||
    ((y+t) < top) ||
    ((y-t) > bottom) = [r]
  | otherwise =
    let partition (l1, r1) (l2, r2) = (l1, max l1 l2, min r1 r2, r1)
        (x1, x2, x3, x4) = partition (left, right) (x - t, x + t)
        (y1, y2, y3, y4) = partition (top, bottom) (y - t, y + t)
        valid Rect{..} = (left <= right) && (top <= bottom)
    in filter valid [ Rect x1     (x2-1) y1     y3
                    , Rect x2     x4     y1     (y2-1)
                    , Rect (x3+1) x4     y2     y4
                    , Rect x1     x3     (y3+1) y4
                    ]

-- minimum bounding rectangle
bounds :: [Rect] -> Rect
bounds = foldr getBounds (Rect maxN 0 maxN 0)
  where getBounds (Rect x1 x2 y1 y2) Rect{..} =
          let l = min x1 left
              r = max x2 right
              t = min y1 top
              b = max y2 bottom
          in Rect l r t b

-- 845E

{-# LANGUAGE RecordWildCards #-}

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Monoid (mconcat)

maxN = 1000000000 :: Int
toInt = fst . fromJust . B.readInt
parse = map toInt . B.words

data Rect = Rect { left :: Int
                 , right :: Int
                 , top :: Int
                 , bottom :: Int
                 } deriving (Show)

main = do
  (n:m:_) <- fmap parse B.getLine
  B.interact $ B.pack . show . program (n, m) . input
  where input = map parse . B.lines

program :: (Int, Int) -> [[Int]] -> Int
program (n, m) centers = binarySearch check 0 (max n m)
  where check :: Int -> Bool
        check t = maxBound <= (2*t + 1)
          where rects :: [Rect]
                rects = foldr f [Rect 1 n 1 m] centers
                  where f [x,y] = mconcat . map (subdivide (x, y) t)
                maxBound = max (right - left) (bottom - top)
                  where Rect{..} = bounds rects

binarySearch :: (Int -> Bool) -> Int -> Int -> Int
binarySearch pred l h
  | l == h    = l
  | otherwise =
      let mid = (l + h) `div` 2 in
      if pred mid
      then binarySearch pred l mid
      else binarySearch pred (mid + 1) h

{-
   x1  x2  x3  x4
y1 ----|-------|
   |  ||       |
   |  ||-------|
y2 |  |#####----
y3 ----#####|  |
   |-------||  |
y4 |-------|----
-}
subdivide :: (Int, Int) -> Int -> Rect -> [Rect]
subdivide (x, y) t r@Rect{..}
  | ((x+t) < left) ||
    ((x-t) > right) ||
    ((y+t) < top) ||
    ((y-t) > bottom) = [r]
  | otherwise =
    let partition (l1, r1) (l2, r2) = (l1, max l1 l2, min r1 r2, r1)
        (x1, x2, x3, x4) = partition (left, right) (x - t, x + t)
        (y1, y2, y3, y4) = partition (top, bottom) (y - t, y + t)
        valid Rect{..} = (left <= right) && (top <= bottom)
    in filter valid [ Rect x1     (x2-1) y1     y3
                    , Rect x2     x4     y1     (y2-1)
                    , Rect (x3+1) x4     y2     y4
                    , Rect x1     x3     (y3+1) y4
                    ]

-- minimum bounding rectangle
bounds :: [Rect] -> Rect
bounds = foldr getBounds (Rect maxN 0 maxN 0)
  where getBounds (Rect x1 x2 y1 y2) Rect{..} =
          let l = min x1 left
              r = max x2 right
              t = min y1 top
              b = max y2 bottom
          in Rect l r t b


You are given a permutation of length $$$n$$$. Recall that the permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$[2, 3, 1, 5, 4]$$$ is a permutation, but $$$[1, 2, 2]$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$[1, 3, 4]$$$ is also not a permutation ($$$n=3$$$ but there is $$$4$$$ in the array).You can perform at most $$$n-1$$$ operations with the given permutation (it is possible that you don't perform any operations at all). The $$$i$$$-th operation allows you to swap elements of the given permutation on positions $$$i$$$ and $$$i+1$$$. Each operation can be performed at most once. The operations can be performed in arbitrary order.Your task is to find the lexicographically minimum possible permutation obtained by performing some of the given operations in some order.You can see the definition of the lexicographical order in the notes section.You have to answer $$$q$$$ independent test cases.For example, let's consider the permutation $$$[5, 4, 1, 3, 2]$$$. The minimum possible permutation we can obtain is $$$[1, 5, 2, 4, 3]$$$ and we can do it in the following way:  perform the second operation (swap the second and the third elements) and obtain the permutation $$$[5, 1, 4, 3, 2]$$$;  perform the fourth operation (swap the fourth and the fifth elements) and obtain the permutation $$$[5, 1, 4, 2, 3]$$$;  perform the third operation (swap the third and the fourth elements) and obtain the permutation $$$[5, 1, 2, 4, 3]$$$.  perform the first operation (swap the first and the second elements) and obtain the permutation $$$[1, 5, 2, 4, 3]$$$; Another example is $$$[1, 2, 4, 3]$$$. The minimum possible permutation we can obtain is $$$[1, 2, 3, 4]$$$ by performing the third operation (swap the third and the fourth elements).

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 100$$$) — the number of test cases. Then $$$q$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 100$$$) — the number of elements in the permutation. The second line of the test case contains $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ — the given permutation.

For each test case, print the answer on it — the lexicograhically minimum possible permutation obtained by performing some of the given operations in some order.

NoteRecall that the permutation $$$p$$$ of length $$$n$$$ is lexicographically less than the permutation $$$q$$$ of length $$$n$$$ if there is such index $$$i \le n$$$ that for all $$$j$$$ from $$$1$$$ to $$$i - 1$$$ the condition $$$p_j = q_j$$$ is satisfied, and $$$p_i < q_i$$$. For example:  $$$p = [1, 3, 5, 2, 4]$$$ is less than $$$q = [1, 3, 5, 4, 2]$$$ (such $$$i=4$$$ exists, that $$$p_i < q_i$$$ and for each $$$j < i$$$ holds $$$p_j = q_j$$$),  $$$p = [1, 2]$$$ is less than $$$q = [2, 1]$$$ (such $$$i=1$$$ exists, that $$$p_i < q_i$$$ and for each $$$j < i$$$ holds $$$p_j = q_j$$$).

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = readInt >>= flip replicateM solve >>= mapM_ ( putStrLn . unwords . map show )

solve = do
	n <- readInt
	as <- readInts
	return $ solve' as

solve' [] = []
solve' as = ini ++ solve' las
	where
		mi = minimum as
		idx = fromJust $ elemIndex mi as
		ini = if head as == mi
			then [ mi ]
			else mi : take ( pred idx ) as
		las = if head as == mi
			then tail as
			else ( as !! pred idx ) : drop ( succ idx ) as


Vasya and Petya have invented a new game. Vasya takes a stripe consisting of 1 × n square and paints the squares black and white. After that Petya can start moves — during a move he may choose any two neighboring squares of one color and repaint these two squares any way he wants, perhaps in different colors. Petya can only repaint the squares in white and black colors. Petya’s aim is to repaint the stripe so that no two neighboring squares were of one color. Help Petya, using the given initial coloring, find the minimum number of moves Petya needs to win.

The first line contains number n (1 ≤ n ≤ 1000) which represents the stripe’s length. The second line contains exactly n symbols — the line’s initial coloring. 0 corresponds to a white square, 1 corresponds to a black one.

If Petya cannot win with such an initial coloring, print -1. Otherwise print the minimum number of moves Petya needs to win.

NoteIn the first sample Petya can take squares 1 and 2. He repaints square 1 to black and square 2 to white.In the second sample Petya can take squares 2 and 3. He repaints square 2 to white and square 3 to black.

main = do
	n <- getLine
	s <- getLine
	putStr $ show $ minimum [length $ filter id $ zipWith (==) s $ f $ concat $ repeat "01" | f <- [id, tail]]

main = getLine >> getLine >>= print.solve

solve :: String -> Int
solve xs = min a b
  where ys = map read $ sequence [xs]
        a = count 1 0 ys
        b = count 0 0 ys

count :: Int    -- 次に来ると予想される数字
      -> Int    -- 現在までに塗り替えた回数
      -> [Int]  -- 数字列
      -> Int    -- 塗り替えた回数
count _ r []                = r
count n r (x:xs) | n == x   = count (0^n) r xs
                 |otherwise = count (0^n)(r+1)xs

gao [] _ = 0
gao (a:b) (c:d) = if a == c then gao b d else 1 + gao (drop 1 b) (tail d)

main = do
	n <- getLine
	s <- getLine
	putStr $ show $ minimum [gao s $ f $ concat $ repeat "01" | f <- [id, tail]]

main = do getLine >>= putStr . unwords . map show . (\n -> n:[1..n-1]) . read


You are given a 4x4 grid. You play a game — there is a sequence of tiles, each of them is either 2x1 or 1x2. Your task is to consequently place all tiles from the given sequence in the grid. When tile is placed, each cell which is located in fully occupied row or column is deleted (cells are deleted at the same time independently). You can place tile in the grid at any position, the only condition is that tiles (and tile parts) should not overlap. Your goal is to proceed all given figures and avoid crossing at any time.

The only line contains a string $$$s$$$ consisting of zeroes and ones ($$$1 \le |s| \le 1000$$$). Zero describes vertical tile, one describes horizontal tile.

Output $$$|s|$$$ lines — for each tile you should output two positive integers $$$r,c$$$, not exceeding $$$4$$$, representing numbers of smallest row and column intersecting with it. If there exist multiple solutions, print any of them.

NoteFollowing image illustrates the example after placing all three tiles:    Then the first row is deleted:

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = getLine >>= mapM_ ( uncurry $ printf "%d %d\n" ) . map ( succ *** succ ) . solve 0 0

solve :: Int -> Int -> String -> [ ( Int, Int ) ]
solve _ _ [] = []
solve v h (c:s)
	| c == '0' = ( 2, v `mod` 4 ) : solve ( succ v ) h s
	| otherwise = ( 0, h `mod` 2 * 2 ) : solve v ( succ h ) s

-- Codeforces Round #534 Div.2 (C), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

-- 1st dim: False for vertical, True for Horizontal
-- 3rd dim: False for y, True for x
places :: UArray (Bool,Int,Bool) Int
places = A.listArray ((False,0,False), (True,3,True))
             [1, 1,
              2, 1,
              3, 1,
              4, 1,
              1, 4,
              3, 4,
              1, 4,
              3, 4]

main :: IO ()
main = do
  xs <- map (=='1') <$> getLine
  acc <- A.newArray (False,True) 0 :: IO (IOUArray Bool Int)
  forM_ xs $ \b -> do
    k <- A.readArray acc b
    let y = places A.! (b,k,False)
        x = places A.! (b,k,True)
    putStrLn $ shows x $ ' ' : show y
    A.writeArray acc b $ if k >= 3 then 0 else k+1

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

main = do
  s <- getLine
  putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ solve 0 0 s

solve _ _ [] = []
solve v h ('0' : s) = (v + 1, 1) : solve ((v + 2) `mod` 4) h s
solve v h ('1' : s) = (h + 1, 2) : solve v ((h + 1) `mod` 4) s

-- Codeforces Round #534 Div.2 (C), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

-- 1st dim: False for vertical, True for Horizontal
-- 3rd dim: False for x, True for y
places :: UArray (Bool,Int,Bool) Int
places = A.listArray ((False,0,False), (True,3,True))
             [1, 1,
              2, 1,
              3, 1,
              4, 1,
              1, 4,
              3, 4,
              1, 4,
              3, 4]

main :: IO ()
main = do
  xs <- map (=='1') <$> getLine
  acc <- A.newArray (False,True) 0 :: IO (IOUArray Bool Int)
  forM_ xs $ \b -> do
    k <- A.readArray acc b
    let x = places A.! (b,k,False)
        y = places A.! (b,k,True)
    putStrLn $ shows x $ ' ' : show y
    A.writeArray acc b $ if k >= 3 then 0 else k+1


Sasha likes programming. Once, during a very long contest, Sasha decided that he was a bit tired and needed to relax. So he did. But since Sasha isn't an ordinary guy, he prefers to relax unusually. During leisure time Sasha likes to upsolve unsolved problems because upsolving is very useful.Therefore, Sasha decided to upsolve the following problem:You have an array $$$a$$$ with $$$n$$$ integers. You need to count the number of funny pairs $$$(l, r)$$$ $$$(l \leq r)$$$. To check if a pair $$$(l, r)$$$ is a funny pair, take $$$mid = \frac{l + r - 1}{2}$$$, then if $$$r - l + 1$$$ is an even number and $$$a_l \oplus a_{l+1} \oplus \ldots \oplus a_{mid} = a_{mid + 1} \oplus a_{mid + 2} \oplus \ldots \oplus a_r$$$, then the pair is funny. In other words, $$$\oplus$$$ of elements of the left half of the subarray from $$$l$$$ to $$$r$$$ should be equal to $$$\oplus$$$ of elements of the right half. Note that $$$\oplus$$$ denotes the bitwise XOR operation.It is time to continue solving the contest, so Sasha asked you to solve this task.

The first line contains one integer $$$n$$$ ($$$2 \le n \le 3 \cdot 10^5$$$) — the size of the array. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i < 2^{20}$$$) — array itself.

Print one integer — the number of funny pairs. You should consider only pairs where $$$r - l + 1$$$ is even number.

NoteBe as cool as Sasha, upsolve problems!In the first example, the only funny pair is $$$(2, 5)$$$, as $$$2 \oplus 3 = 4 \oplus 5 = 1$$$.In the second example, funny pairs are $$$(2, 3)$$$, $$$(1, 4)$$$, and $$$(3, 6)$$$.In the third example, there are no funny pairs.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

main :: IO ()
main = do
  n <- readInt <$> getLine
  as <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let xored = scanl' (\(!bpat,!oddity) a -> (xor a bpat, not oddity))
              (0,False) as
  print $ sum $ map (\l -> (l * (l -1)) `shiftR` 1) $ map (toI64 . length)
    $ group $ sort xored

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

main :: IO ()
main = do
  n <- readInt <$> getLine
  as <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let xored = scanl' (\(!bpat,!oddity) a -> (xor a bpat, not oddity))
              (0,False) as
  print $ sum $ map (\l -> (l * (l -1)) `shiftR` 1) $ map length
    $ group $ sort xored

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N


An array $$$b$$$ is called to be a subarray of $$$a$$$ if it forms a continuous subsequence of $$$a$$$, that is, if it is equal to $$$a_l$$$, $$$a_{l + 1}$$$, $$$\ldots$$$, $$$a_r$$$ for some $$$l, r$$$.Suppose $$$m$$$ is some known constant. For any array, having $$$m$$$ or more elements, let's define it's beauty as the sum of $$$m$$$ largest elements of that array. For example:   For array $$$x = [4, 3, 1, 5, 2]$$$ and $$$m = 3$$$, the $$$3$$$ largest elements of $$$x$$$ are $$$5$$$, $$$4$$$ and $$$3$$$, so the beauty of $$$x$$$ is $$$5 + 4 + 3 = 12$$$. For array $$$x = [10, 10, 10]$$$ and $$$m = 2$$$, the beauty of $$$x$$$ is $$$10 + 10 = 20$$$.You are given an array $$$a_1, a_2, \ldots, a_n$$$, the value of the said constant $$$m$$$ and an integer $$$k$$$. Your need to split the array $$$a$$$ into exactly $$$k$$$ subarrays such that:  Each element from $$$a$$$ belongs to exactly one subarray. Each subarray has at least $$$m$$$ elements. The sum of all beauties of $$$k$$$ subarrays is maximum possible.

The first line contains three integers $$$n$$$, $$$m$$$ and $$$k$$$ ($$$2 \le n \le 2 \cdot 10^5$$$, $$$1 \le m$$$, $$$2 \le k$$$, $$$m \cdot k \le n$$$) — the number of elements in $$$a$$$, the constant $$$m$$$ in the definition of beauty and the number of subarrays to split to. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$).

In the first line, print the maximum possible sum of the beauties of the subarrays in the optimal partition. In the second line, print $$$k-1$$$ integers $$$p_1, p_2, \ldots, p_{k-1}$$$ ($$$1 \le p_1 < p_2 < \ldots < p_{k-1} < n$$$) representing the partition of the array, in which:  All elements with indices from $$$1$$$ to $$$p_1$$$ belong to the first subarray. All elements with indices from $$$p_1 + 1$$$ to $$$p_2$$$ belong to the second subarray. $$$\ldots$$$. All elements with indices from $$$p_{k-1} + 1$$$ to $$$n$$$ belong to the last, $$$k$$$-th subarray. If there are several optimal partitions, print any of them.

NoteIn the first example, one of the optimal partitions is $$$[5, 2, 5]$$$, $$$[2, 4]$$$, $$$[1, 1, 3, 2]$$$.  The beauty of the subarray $$$[5, 2, 5]$$$ is $$$5 + 5 = 10$$$.  The beauty of the subarray $$$[2, 4]$$$ is $$$2 + 4 = 6$$$.  The beauty of the subarray $$$[1, 1, 3, 2]$$$ is $$$3 + 2 = 5$$$. The sum of their beauties is $$$10 + 6 + 5 = 21$$$.In the second example, one optimal partition is $$$[4]$$$, $$$[1, 3]$$$, $$$[2, 2]$$$, $$$[3]$$$.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

main :: IO ()
main = do
  [n,m,k] <- map readInt . words <$> getLine
  as <- take (m*k) . sortBy (compare `on` (Down . snd))
      . zip [1..] . map toI64 . unfoldr (BS.readInt . BS.dropWhile (<'!'))
        <$> BS.getLine
  print $ sum $ map snd as
  let arr = A.accumArray (\_ -> id) False (1,n) $ map ((,True) . fst) as
            :: UArray Int Bool
      taills = iterate (drop m) $ drop (m-1)
        $ map fst $ filter snd $ A.assocs arr
      ans = map head $ takeWhile (not . null) taills
  putStrLn $ unwords $ map show $ init ans

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

import Data.List

main = interact (format . solve . parse)

parse s = case words s of
  (_:m:k:a) -> (read m :: Integer,
    read k :: Integer,
    map read a :: [Integer])
  _ -> (0, 0, [])

solve :: (Integer, Integer, [Integer]) -> ([Integer], Integer)
solve (m, k, a) =
  foldr (\(i, (index, value)) (l, sum) ->
    (if (mod i m == 0 && not (i == m * k)) then index:l else l, sum + value))
    ([], 0) $
  zip [1..] $
  sortBy (\a b -> compare (fst a) (fst b)) $
  genericTake (m * k) $
  sortBy (\a b -> compare (snd b) (snd a)) $
  zip [1..] a

format (l, sum) = (show sum) ++ "\n" ++ (unwords $ map show l)


Bajtek is learning to skate on ice. He's a beginner, so his only mode of transportation is pushing off from a snow drift to the north, east, south or west and sliding until he lands in another snow drift. He has noticed that in this way it's impossible to get from some snow drifts to some other by any sequence of moves. He now wants to heap up some additional snow drifts, so that he can get from any snow drift to any other one. He asked you to find the minimal number of snow drifts that need to be created.We assume that Bajtek can only heap up snow drifts at integer coordinates.

The first line of input contains a single integer n (1 ≤ n ≤ 100) — the number of snow drifts. Each of the following n lines contains two integers xi and yi (1 ≤ xi, yi ≤ 1000) — the coordinates of the i-th snow drift. Note that the north direction coinсides with the direction of Oy axis, so the east direction coinсides with the direction of the Ox axis. All snow drift's locations are distinct.

Output the minimal number of snow drifts that need to be created in order for Bajtek to be able to reach any snow drift from any other one.

import Data.List
import Data.Maybe (fromMaybe)
import Data.Function
import qualified Data.Map as Map
import qualified Data.Set as Set

readInt s    = read s :: Int
readInts n s = map readInt $ take n $ words s

data Point = Point { pid :: Int
                   , xCoord :: Int
                   , yCoord :: Int
                   } deriving (Show, Eq)

---------------------------------------------
data Queue a = Queue { input :: [a]
                     , output :: [a]
                     } deriving (Show)

emptyQueue = Queue [] []

isEmpty :: Queue e -> Bool
isEmpty q@Queue{input = [], output = []} = True
isEmpty _ = False

pushQueue :: a -> Queue a -> Queue a
pushQueue x q@Queue{input = i} = q{input = x : i}

popQueue :: Queue a -> (a, Queue a)
popQueue q@Queue{input = i, output = o}
    | null i && null o  = error "Que is empty!"
    | null o            = popQueue (pour q)
    | otherwise         = (head o, q{output = tail o})
    where pour q@Queue{input = i, output = o}
            | null i    = q
            | otherwise = pour q{input = tail i, output = head i : o}
---------------------------------------------

tryAdd :: Ord a => Queue a -> Set.Set a -> [a] -> ( Queue a, Set.Set a )
tryAdd que unused elems
  | null elems = (que, unused)
  | otherwise  = let (cur:elemtail) = elems
                 in if cur `Set.member` unused
                    then tryAdd (pushQueue cur que) (Set.delete cur unused) elemtail
                    else tryAdd que unused elemtail

globalBFS points pointsByX pointsByY = let n = length points
    in bfs emptyQueue (Set.fromList [0 .. n - 1])
    where bfs queue unused
            | Set.null unused = 0
            | isEmpty queue    = bfs (Queue [] [first]) (Set.delete first unused) + 1
                where first = head (Set.toList unused)
          bfs queue unused = bfs queue' unused'
                where (quetop, quetail) = popQueue queue
                      topX = xCoord (points !! quetop)
                      topY = yCoord (points !! quetop)
                      neighbors = fromMaybe [] (Map.lookup topX pointsByX) ++ fromMaybe [] (Map.lookup topY pointsByY)
                      (queue', unused') = tryAdd quetail unused neighbors

main = do
    args0 <- getLine
    content <- getContents
    let n = head (readInts 1 args0)
        raw_points = map (readInts 2) . take n . lines $ content
        points = map (\(pid, [x,y]) -> Point pid x y) numeredPoints
            where numeredPoints = zip [0 .. ] raw_points

        pointsByX = Map.fromList . map extract $ grouped
            where grouped = groupBy ((==) `on` xCoord) . sortBy (compare `on` xCoord) $ points
                  extract ps = (xCoord (head ps), map pid ps)

        pointsByY = Map.fromList . map extract $ grouped
            where grouped = groupBy ((==) `on` yCoord) . sortBy (compare `on` yCoord) $ points
                  extract ps = (yCoord (head ps), map pid ps)

    putStrLn . show $ globalBFS points pointsByX pointsByY - 1

import Data.List
import Data.Function
import qualified Data.Map as Map
import qualified Data.Set as Set

readInt s    = read s :: Int
readInts n s = map readInt $ take n $ words s

data Point = Point { pid :: Int
                   , xCoord :: Int
                   , yCoord :: Int
                   } deriving (Show, Eq)

tryAdd :: Ord a => [a] -> (Set.Set a) -> [a] -> ( [a], (Set.Set a) )
tryAdd que unused elems
  | null elems = (que, unused)
  | otherwise  = let (cur:elemtail) = elems
                 in if cur `Set.member` unused
                    then tryAdd (cur : que) (Set.delete cur unused) elemtail
                    else tryAdd que unused elemtail

unwrap :: Maybe [a] -> [a]
unwrap (Just x) = x
unwrap Nothing  = []

globalBFS points pointsByX pointsByY = let n = length points
    in bfs [] (Set.fromList [0 .. n - 1])
    where bfs queue unused
            | Set.null unused = 0
            | null queue    = bfs [first] (Set.delete first unused) + 1
                where first = head (Set.toList unused)
          bfs (quetop:quetail) unused = bfs queue' unused'
                where topX = xCoord (points !! quetop)
                      topY = yCoord (points !! quetop)
                      neighbors = unwrap (Map.lookup topX pointsByX) ++ unwrap (Map.lookup topY pointsByY)
                      (queue', unused') = tryAdd quetail unused neighbors

main = do
    args0 <- getLine
    content <- getContents
    let n = head (readInts 1 args0)
        raw_points = map (readInts 2) . take n . lines $ content
        points = map (\(pid, [x,y]) -> Point pid x y) numeredPoints
            where numeredPoints = zip [0 .. ] raw_points

        pointsByX = Map.fromList . map extract $ grouped
            where grouped = groupBy ((==) `on` xCoord) . sortBy (compare `on` xCoord) $ points
                  extract ps = (xCoord (head ps), map pid ps)

        pointsByY = Map.fromList . map extract $ grouped
            where grouped = groupBy ((==) `on` yCoord) . sortBy (compare `on` yCoord) $ points
                  extract ps = (yCoord (head ps), map pid ps)

    putStrLn . show $ globalBFS points pointsByX pointsByY - 1

import Data.Graph
import qualified Data.Set as DS

main = interact $ f . map (map read . words)  . tail . lines

g v@(z, x:y:_) s1 = nodes
  where ans = DS.toList $ DS.filter (\(_, i:j:_) -> i==x || y==j) s1
        nodes = zip [z,z..] $ map (\(i, _) -> i) ans

f :: [[Int]] -> String
f x = show tvl
  where pre = zip [0..] x
        l = (length x) -1
        mx = DS.fromList $ pre
        e = concat $ map (\v -> g v mx) pre
        gf = buildG (0, l) e
        tvl = (length (dfs gf [0..l])) -1

import Data.List
import Control.Monad

f ([]) = -1
f (x:xs) = 1 + f (dfsF cmp xs x)

cmp x y = or $ zipWith (==) x y

dfsF cf vs v = let (sm,ds) = partition (cf v) vs
               in foldl (dfsF cf) ds sm

main = getLine >>= ((`replicateM` (words `fmap` getLine)).read) >>= print.f

--    ghc --make -O Main.hs
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Control.Monad.ST as ST
import qualified Data.STRef as STRef

data Point = Point {
    x :: Int
  , y :: Int
  } deriving (Eq, Ord, Show)

listToPoint :: [Int] -> Point
listToPoint [x',y'] = Point { x = x', y = y'}
listToPoint _ = error "Point parsing error"

inputToList :: String -> [Point]
inputToList s = map (listToPoint.( map read ).words) $ filter (not.null) $ tail.lines $ s

getInts :: (Point -> Int) -> [Point] -> [Int]
getInts f l = foldr step [] l
            where step p acc = (f p):acc

getAdj :: (Point -> Int) -> (Point -> Int) -> [Point] -> Map.Map Int [Int]
getAdj key val l = foldr step Map.empty l
   where step :: Point -> Map.Map Int [Int] -> Map.Map Int [Int]
         updateWith :: Map.Map Int [Int]->Int->Int->Maybe [Int] -> Map.Map Int [Int]
         updateWith acc k v Nothing = Map.insert k [v] acc
         updateWith acc k v (Just vs) = Map.insert k (v:vs) acc
         step p acc = let k = key p
                          v = val p
                      in updateWith acc k v (Map.lookup k acc)

getAdjToX :: [Point] -> Map.Map Int [Int]
getAdjToX = getAdj x y

getAdjToY :: [Point] -> Map.Map Int [Int]
getAdjToY = getAdj y x

xyToPoint :: Int -> Int -> Point
xyToPoint x' y' = Point{ x = x', y = y' }

yxToPoint :: Int -> Int -> Point
yxToPoint y' x' = Point{ x = x', y = y' }

getAdjPoints' :: (Point -> Int) -> (Point -> Int) -> (Int -> Int -> Point ) -> Map.Map Int [Int] -> Point -> [Point]
getAdjPoints' dec1 dec2 comp adj p = let k1 = dec1 p
                                         k2 = dec2 p
                                      in case Map.lookup k1 adj of
                                         Nothing -> []
                                         Just l -> map (comp k1) (filter (/= k2) l)

data Graph = Graph {
    xAdjList :: Map.Map Int [Int]
  , yAdjList :: Map.Map Int [Int]
  } deriving (Show)

graphFromList :: [Point] -> Graph
graphFromList ps = Graph { xAdjList = getAdjToX ps, yAdjList = getAdjToY ps  }

getAdjPoints :: Graph -> Point -> [Point]
getAdjPoints g p = (getAdjPoints' x y xyToPoint (xAdjList g) p) ++
                                    (getAdjPoints' y x yxToPoint (yAdjList g) p)

dfs :: Graph -> STRef.STRef s (Set.Set Point) -> Point -> ST.ST s()
dfs g seenST p = do
  seen <- STRef.readSTRef seenST
  STRef.writeSTRef seenST (Set.insert p seen)
  dfs' g seenST (filter (\ e -> Set.notMember e seen) (getAdjPoints g p))

dfs' :: Graph -> STRef.STRef s (Set.Set Point) -> [Point] -> ST.ST s()
dfs' _ _ [] = return ()
dfs' g seenST (p:ps) = do
   dfs g seenST p
   dfs' g seenST ps

connectedComponents :: [Point] -> Int
connectedComponents ps = ST.runST $ do
                           seenST <- STRef.newSTRef Set.empty
                           loop 0 ps seenST
                         where
                           g = graphFromList ps
                           loop :: Int -> [Point] -> STRef.STRef s (Set.Set Point) -> ST.ST s(Int)
                           loop acc [] _ = return (acc)
                           loop acc (p:ps') seenST = do
                               seen <- STRef.readSTRef seenST
                               if Set.member p seen
                               then loop acc ps' seenST
                               else do
                                 dfs g seenST p
                                 loop (acc+1) ps' seenST
solve :: String -> String
solve in_str = show ( (connectedComponents (inputToList in_str)) - 1 ) ++ "\n"

main :: IO ()
main = do interact $ solve

import Data.Graph
import Data.List
main = interact $ show . solve . pairs . map read . tail . words
pairs (a:b:xs) = (a,b :: Int) : pairs xs
pairs [] = []
solve ps = length (dff g) - 1
  where g = buildG (1,length ps) [ (i,j) | (i,u) <- zip [1..] ps
                                         , (j,v) <- zip [1..] ps
                                         , touch u v ]
touch (i,j) (i',j') = i == i' || j == j'

{-# LANGUAGE BangPatterns #-}

import Data.Array.Base
import Data.Array.IO (IOUArray)
import qualified Data.IntSet as IS
import Control.Applicative
import Control.Monad

toPairs (x:y:xys) = (x,y):toPairs xys
toPairs [] = []

rep :: Int -> (Int -> IO ()) -> IO ()
rep !n f = go 0
   where
     go !i
       | i<n = f i >> go (i+1)
       | otherwise = return ()

for :: Int -> Int -> (Int -> IO ()) -> IO ()
for !m !n f = go m
   where
     go !i
       | i<n = f i >> go (i+1)
       | otherwise = return ()

main = do
  n <- readLn

-- Union-Find Tree
  parent <- newListArray (0,n-1) [0..n-1] :: IO (IOUArray Int Int)
  rank <- newArray (0,n-1) 0 :: IO (IOUArray Int Int)

  let find :: Int -> IO Int
      find x = do
        let go y hist = do
              py <- unsafeRead parent y
              if py == y
                 then return (y:hist)
                 else go py (y:hist)
        (root:hist) <- go x []
        forM_ hist $ \h-> do
          unsafeWrite parent h root
        return root

      union :: Int -> Int -> IO ()
      union x y = do
        rootx <- find x
        rooty <- find y
        if rootx == rooty
           then return ()
           else do
             rankx <- unsafeRead rank rootx
             ranky <- unsafeRead rank rooty
             case compare rankx ranky of
               LT -> unsafeWrite parent rootx rooty
               GT -> unsafeWrite parent rooty rootx
               EQ -> do
                 unsafeWrite parent rootx rooty
                 unsafeWrite rank rooty (ranky+1)

  (xs,ys) <- unzip.toPairs.map read.words <$> getContents
  let xarr = listArray (0,n-1) xs :: UArray Int Int
      yarr = listArray (0,n-1) ys :: UArray Int Int
      i===j = unsafeAt xarr i == unsafeAt xarr j
                || unsafeAt yarr i == unsafeAt yarr j

  rep n $ \i-> do
    for (i+1) n $ \j-> do
      when (i===j) $ union i j

  mapM find [0..n-1] >>= print.pred.IS.size.IS.fromList

import Data.List
import Control.Monad

f :: [[Int]] -> Int
f ([]) = -1
f (x:xs) = 1 + (f $ dfsFilter cmp xs x)

cmp [x1,y1] [x2,y2] = x1 == x2 || y1 == y2

dfsFilter :: (a -> a -> Bool) -> [a] -> a -> [a]
dfsFilter cf vs v = let sm = filter (cf v) vs
                        ds = filter (not.cf v) vs
                    in foldl (dfsFilter cf) ds sm

main = (f `fmap` ((read `fmap` getLine) >>= (flip replicateM ((map read. words) `fmap` getLine)))) >>= print

import Data.List
main = interact $ show . solve . pairs . map read . tail . words
pairs (a:b:xs) = (a,b :: Int) : pairs xs
pairs [] = []
solve ps = length (foldl ins [] ps) - 1
ins gs p | Just g <- find (gr p) gs = (p:g) : delete g gs
         | otherwise = [p] : gs
gr (i,j) ps = any (\(i',j') -> i == i' || j == j') ps

import Data.List
import Control.Monad

f :: [[Int]] -> Int
f = (\x -> x-1) . length . nubBy (\[x1,y1] [x2,y2] -> x1 == x2 || y1 == y2)

main = (f `fmap` ((read `fmap` getLine) >>= (flip replicateM ((map read. words) `fmap` getLine)))) >>= print


You are given an array $$$a$$$ consisting of $$$n$$$ integers. Let's denote monotonic renumeration of array $$$a$$$ as an array $$$b$$$ consisting of $$$n$$$ integers such that all of the following conditions are met:  $$$b_1 = 0$$$;  for every pair of indices $$$i$$$ and $$$j$$$ such that $$$1 \le i, j \le n$$$, if $$$a_i = a_j$$$, then $$$b_i = b_j$$$ (note that if $$$a_i \ne a_j$$$, it is still possible that $$$b_i = b_j$$$);  for every index $$$i \in [1, n - 1]$$$ either $$$b_i = b_{i + 1}$$$ or $$$b_i + 1 = b_{i + 1}$$$. For example, if $$$a = [1, 2, 1, 2, 3]$$$, then two possible monotonic renumerations of $$$a$$$ are $$$b = [0, 0, 0, 0, 0]$$$ and $$$b = [0, 0, 0, 0, 1]$$$.Your task is to calculate the number of different monotonic renumerations of $$$a$$$. The answer may be large, so print it modulo $$$998244353$$$.

The first line contains one integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the number of elements in $$$a$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$).

Print one integer — the number of different monotonic renumerations of $$$a$$$, taken modulo $$$998244353$$$.

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  prevs <- newIORef $ IM.empty
  acc <- A.newArray (0,n) 0 :: IO (IOUArray Int Int)
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  forM_ as $ \(!i_now,!key) -> do
    !prevs0 <- readIORef prevs
    let (!i_prev, !prevs1) = IM.insertLookupWithKey
                             (\_ _ -> id) key i_now prevs0
    writeIORef prevs prevs1
    flip (maybe $ return ()) i_prev $ \i_prev -> do
      A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
      A.writeArray acc (i_now+1) . (subtract 1) =<< A.readArray acc (i_now+1)
  A.writeArray acc 0 1
  A.writeArray acc 1 . (subtract 1) =<< A.readArray acc 1
  brackets <- newIORef (0::Int)
  forM_ [1..n-1] $ \i -> do
    prev <- A.readArray acc (i-1)
    intvs <- (prev+) <$> A.readArray acc i
    A.writeArray acc i intvs
    when (intvs == 0) $ do
      writeIORef brackets . (+1) =<< readIORef brackets
  print . fromMon . (2^) =<< readIORef brackets

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  print $ query n as

query :: Int -> [(Int, Int)] -> Word32
query n as = fromMon $ (2^)
  $ length $ filter (==0) $ scanl1 (+) $ init $ A.elems acc
  where
    acc :: UArray Int Int
    acc = runSTUArray $ do
      acc <- A.newArray (0,n) 0
      forM_ groupedAs $ \(i,j) -> do
        A.writeArray acc (i+1) 1
        A.writeArray acc (j+1) (-1)
      A.writeArray acc 0 1
      A.writeArray acc 1 . (+(-1)) =<< A.readArray acc 1
      return acc
    group_ [] = []
    group_ ((i,x):xs) = go0 i x xs
      where
        go0 !i !x ((j,y):xs) | x == y    = go i j x xs
                             | otherwise = go0 j y xs
        go0 !i !x [] = []
        go !i !j !x ((k,y):xs) | x == y    = go i k x xs
                               | otherwise = (i,j) : go0 k y xs
        go !i !j !x [] = [(i,j)]
    groupedAs = group_ $ sortBy (compare `on` snd) as

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((parsed,(i,i)),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  let intvs = IM.elems $ IM.fromListWith (\(_,x) (y,_) -> (y,x)) as
      goodIntvs = unionIntvs $ sort intvs
      unionIntvs ((x0,x1):(y0,y1):is)
        | y0 <= x1 = unionIntvs ((x0,max x1 y1):is)
      unionIntvs (i:is) = i:unionIntvs is
      unionIntvs [] = []
      ansExpt = (n -) $ sum $ map (uncurry subtract) goodIntvs :: Int
  print $ fromMon $ 2^(ansExpt-1)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  print $ query n as

query :: Int -> [(Int, Int)] -> Word32
query n as = fromMon $ (2^)
  $ length $ filter (==0) $ scanl1 (+) $ init $ A.elems $ acc
  where
    acc :: UArray Int Int
    acc = runSTUArray $ do
      acc <- A.newArray (0,n) 0
      prevs <- newSTRef $ IM.empty
      A.writeArray acc 0 1
      A.writeArray acc 1 (-1)
      forM_ as $ \(!i_now,!key) -> do
        !prevs0 <- readSTRef prevs
        let (!i_prev, !prevs1) = IM.insertLookupWithKey
                                 (\_ -> const) key i_now prevs0
        writeSTRef prevs prevs1
        flip (maybe $ return ()) i_prev $ \i_prev -> do
          A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
          A.writeArray acc (i_now+1) . (subtract 1)
            =<< A.readArray acc (i_now+1)
      return acc

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

{-# LANGUAGE Strict #-}
import Data.List as List
import Data.Function

m = 998244353

powmod a x n
 |n==0 = a
 |even n = powmod a (mod (x*x) m) (div n 2)
 |otherwise = powmod (mod (a*x) m) x (n-1)

ff a [] = [a]
ff (a,b) ((c,d):xs)
 |b>d = ff (a,b) xs
 |b>c = (a,d):xs
 |otherwise = (a,b):(c,d):xs

f xs0 = --trace (show (xs1,xs2,xs3,xs4,xs5,n))
 powmod 1 2 n
 where
  xs1 = sort $ zip xs0 [0..]
  xs2 = List.groupBy (on (==) fst) xs1
  xs3 = fmap (\xs-> (snd $ head xs, snd $ last xs)) xs2
  xs4 = sort xs3
  xs5 = foldr ff [] xs4
  n = length xs5 - 1

main = do
  getLine
  line <- getLine
  let xs = fmap read $ words line :: [Int]
  print $ f xs

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  prevs <- newIORef $ IM.empty
  acc <- A.newArray (0,n-1) 0 :: IO (IOUArray Int Int)
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  forM_ (init as) $ \(!i_now,!key) -> do
    !prevs0 <- readIORef prevs
    let (!i_prev, !prevs1) = IM.updateLookupWithKey
                             (\_ _ -> Just i_now) key prevs0
    writeIORef prevs prevs1
    flip (maybe $ return ()) i_prev $ \i_prev -> do
      A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
      A.writeArray acc (i_now+1) . (subtract 1) =<< A.readArray acc (i_now+1)
  A.writeArray acc 0 1
  A.writeArray acc 1 . (subtract 1) =<< A.readArray acc 1
  brackets <- newIORef (0::Int)
  forM_ [1..n-1] $ \i -> do
    prev <- A.readArray acc (i-1)
    intvs <- (prev+) <$> A.readArray acc (i-1)
    A.writeArray acc i intvs
    when (intvs == 0) $ do
      writeIORef brackets . (+1) =<< readIORef brackets
  print . fromMon . (2^) =<< readIORef brackets

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,(parsed,parsed)),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  let intvs = IM.elems $ IM.fromListWith (\(x,_) (_,y) -> (x,y)) as
      goodIntvs = unionIntvs $ sort intvs
      unionIntvs ((x0,x1):(y0,y1):is)
        | y0 <= x1 = unionIntvs ((x0,y1):is)
      unionIntvs (i:is) = i:unionIntvs is
      unionIntvs [] = []
      ansExpt = (n -) $ sum $ map (uncurry subtract) goodIntvs :: Int
  print $ fromMon $ 2^(ansExpt-2)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((parsed,(i,i)),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  let intvs = IM.elems $ IM.fromListWith (\(_,x) (y,_) -> (y,x)) as
      goodIntvs = unionIntvs $ sort intvs
      unionIntvs ((x0,x1):(y0,y1):is)
        | y0 <= x1 = unionIntvs ((x0,y1):is)
      unionIntvs (i:is) = i:unionIntvs is
      unionIntvs [] = []
      ansExpt = (n -) $ sum $ map (uncurry subtract) goodIntvs :: Int
  print $ fromMon $ 2^(ansExpt-1)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  prevs <- newIORef $ IM.empty
  acc <- A.newArray (0,n) 0 :: IO (IOUArray Int Int)
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  forM_ (init as) $ \(!i_now,!key) -> do
    !prevs0 <- readIORef prevs
    let (!i_prev, !prevs1) = IM.updateLookupWithKey
                             (\_ _ -> Just i_now) key prevs0
    writeIORef prevs prevs1
    flip (maybe $ return ()) i_prev $ \i_prev -> do
      A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
      A.writeArray acc (i_now+1) . (subtract 1) =<< A.readArray acc (i_now+1)
  A.writeArray acc 0 1
  A.writeArray acc 1 . (subtract 1) =<< A.readArray acc 1
  brackets <- newIORef (0::Int)
  forM_ [1..n-1] $ \i -> do
    prev <- A.readArray acc (i-1)
    intvs <- (prev+) <$> A.readArray acc (i-1)
    A.writeArray acc i intvs
    when (intvs == 0) $ do
      writeIORef brackets . (+1) =<< readIORef brackets
  print . fromMon . (2^) =<< readIORef brackets

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  prevs <- newIORef $ IM.empty
  acc <- A.newArray (0,n) 0 :: IO (IOUArray Int Int)
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  forM_ (init as) $ \(!i_now,!key) -> do
    !prevs0 <- readIORef prevs
    let (!i_prev, !prevs1) = IM.updateLookupWithKey
                             (\_ _ -> Just i_now) key prevs0
    writeIORef prevs prevs1
    flip (maybe $ return ()) i_prev $ \i_prev -> do
      A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
      A.writeArray acc (i_now+1) . (subtract 1) =<< A.readArray acc (i_now+1)
  A.writeArray acc 0 1
  A.writeArray acc 1 . (subtract 1) =<< A.readArray acc 1
  brackets <- newIORef (0::Int)
  forM_ [1..n-1] $ \i -> do
    prev <- A.readArray acc (i-1)
    intvs <- (prev+) <$> A.readArray acc i
    A.writeArray acc i intvs
    when (intvs == 0) $ do
      writeIORef brackets . (+1) =<< readIORef brackets
  print . fromMon . (2^) =<< readIORef brackets

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

{-# LANGUAGE Strict #-}
import Data.List as List
import Data.Function

m = 998244353

powmod a x n
 |n==0 = a
 |even n = powmod a (mod (x*x) m) (div n 2)
 |otherwise = powmod (mod (a*x) m) x (n-1)

ff a [] = [a]
ff (a,b) ((c,d):xs)
 |b>c = (a,d):xs
 |otherwise = (a,b):(c,d):xs

f xs0 = powmod 1 2 n
 where
  xs1 = sort $ zip xs0 [0..]
  xs2 = List.groupBy (on (==) fst) xs1
  xs3 = fmap (\xs-> (snd $ head xs, snd $ last xs)) xs2
  xs4 = sort xs3
  xs5 = foldr ff [] xs4
  n = length xs5 - 1

main = do
  getLine
  line <- getLine
  let xs = fmap read $ words line :: [Int]
  print $ f xs


There are $$$n$$$ piles of stones, where the $$$i$$$-th pile has $$$a_i$$$ stones. Two people play a game, where they take alternating turns removing stones.In a move, a player may remove a positive number of stones from the first non-empty pile (the pile with the minimal index, that has at least one stone). The first player who cannot make a move (because all piles are empty) loses the game. If both players play optimally, determine the winner of the game.

The first line contains a single integer $$$t$$$ ($$$1\le t\le 1000$$$)  — the number of test cases. Next $$$2t$$$ lines contain descriptions of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1\le n\le 10^5$$$)  — the number of piles. The second line of each test case contains $$$n$$$ integers $$$a_1,\ldots,a_n$$$ ($$$1\le a_i\le 10^9$$$)  — $$$a_i$$$ is equal to the number of stones in the $$$i$$$-th pile. It is guaranteed that the sum of $$$n$$$ for all test cases does not exceed $$$10^5$$$.

For each test case, if the player who makes the first move will win, output "First". Otherwise, output "Second".

First
Second
Second
First
First
Second
First

NoteIn the first test case, the first player will win the game. His winning strategy is:   The first player should take the stones from the first pile. He will take $$$1$$$ stone. The numbers of stones in piles will be $$$[1, 5, 4]$$$.  The second player should take the stones from the first pile. He will take $$$1$$$ stone because he can't take any other number of stones. The numbers of stones in piles will be $$$[0, 5, 4]$$$.  The first player should take the stones from the second pile because the first pile is empty. He will take $$$4$$$ stones. The numbers of stones in piles will be $$$[0, 1, 4]$$$.  The second player should take the stones from the second pile because the first pile is empty. He will take $$$1$$$ stone because he can't take any other number of stones. The numbers of stones in piles will be $$$[0, 0, 4]$$$.  The first player should take the stones from the third pile because the first and second piles are empty. He will take $$$4$$$ stones. The numbers of stones in piles will be $$$[0, 0, 0]$$$.  The second player will lose the game because all piles will be empty.

import Data.List
import Control.Monad

data Player = First | Second deriving (Show, Eq)

solve :: [Int] -> Player
solve xs
  | null rest && odd ones = First
  | null rest && even ones = Second
  | odd ones = Second
  | even ones = First
  where
    ones = length $ takeWhile (== 1) xs
    rest = dropWhile (== 1) xs

getTest :: IO [Int]
getTest = getLine >> map read . words <$> getLine

main :: IO ()
main = do
  t <- read <$> getLine
  tests <- replicateM t getTest
  mapM_ (print . solve) tests