The tycoon of a winery empire in Mondstadt, unmatched in every possible way. A thinker in the Knights of Favonius with an exotic appearance.This time, the brothers are dealing with a strange piece of wood marked with their names. This plank of wood can be represented as a string of $$$n$$$ characters. Each character is either a 'D' or a 'K'. You want to make some number of cuts (possibly $$$0$$$) on this string, partitioning it into several contiguous pieces, each with length at least $$$1$$$. Both brothers act with dignity, so they want to split the wood as evenly as possible. They want to know the maximum number of pieces you can split the wood into such that the ratios of the number of occurrences of 'D' to the number of occurrences of 'K' in each chunk are the same.Kaeya, the curious thinker, is interested in the solution for multiple scenarios. He wants to know the answer for every prefix of the given string. Help him to solve this problem!For a string we define a ratio as $$$a:b$$$ where 'D' appears in it $$$a$$$ times, and 'K' appears $$$b$$$ times. Note that $$$a$$$ or $$$b$$$ can equal $$$0$$$, but not both. Ratios $$$a:b$$$ and $$$c:d$$$ are considered equal if and only if $$$a\cdot d = b\cdot c$$$. For example, for the string 'DDD' the ratio will be $$$3:0$$$, for 'DKD' — $$$2:1$$$, for 'DKK' — $$$1:2$$$, and for 'KKKKDD' — $$$2:4$$$. Note that the ratios of the latter two strings are equal to each other, but they are not equal to the ratios of the first two strings.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1000$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 5 \cdot 10^5$$$) — the length of the wood. The second line of each test case contains a string $$$s$$$ of length $$$n$$$. Every character of $$$s$$$ will be either 'D' or 'K'. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$5 \cdot 10^5$$$.

For each test case, output $$$n$$$ space separated integers. The $$$i$$$-th of these numbers should equal the answer for the prefix $$$s_{1},s_{2},\dots,s_{i}$$$.

NoteFor the first test case, there is no way to partition 'D' or 'DDK' into more than one block with equal ratios of numbers of 'D' and 'K', while you can split 'DD' into 'D' and 'D'.For the second test case, you can split each prefix of length $$$i$$$ into $$$i$$$ blocks 'D'.

import qualified Data.Map.Strict as M
import Data.Ratio
import Control.Monad
import Control.Monad.State
import Control.Arrow
import Data.Maybe (fromJust)

--type Tracker = (State )

type Tracker = State (Int, Int, M.Map (Ratio Int) Int)

helper :: Maybe Int -> Maybe Int
helper Nothing = Just 1
helper (Just x) = Just (x + 1)

goOne :: Char -> Tracker Int
goOne c = do (ds, ks, mm) <- get
             if c == 'D'
                then put (ds + 1, ks, mm)
                else put (ds, ks + 1, mm)
             (ds1, ks1, mm1) <- get
             let key = if ks1 == 0 then (-1) % 1 else ds1 % ks1
                 mmm = M.alter helper key mm1
                 --nt = fromJust $ M.lookup key mmm
                 nt = mmm M.! key
              in do put (ds1, ks1, mmm)
                    return nt

goMany :: String -> Tracker [Int]
goMany = mapM goOne

dropEvrySnd [] = []
dropEvrySnd (x:y:xs) = y : dropEvrySnd xs

runner :: String -> String
runner = words
         >>> drop 1
         >>> dropEvrySnd
         >>> map goMany
         >>> map (flip evalState (0, 0, M.empty))
         >>> map (map show >>> unwords)
         >>> unlines

main = interact runner

import qualified Data.Map.Strict as M
import Data.Ratio
import Control.Monad
import Control.Monad.State
import Control.Arrow
import Data.Maybe (fromJust)

--type Tracker = (State )

type Tracker = State (Int, Int, M.Map (Ratio Int) Int)

helper :: Maybe Int -> Maybe Int
helper Nothing = Just 1
helper (Just x) = Just (x + 1)

goOne :: Char -> Tracker Int
goOne c = do (ds, ks, mm) <- get
             if c == 'D'
                then put (ds + 1, ks, mm)
                else put (ds, ks + 1, mm)
             (ds1, ks1, mm1) <- get
             let key = if ks1 == 0 then (-1) % 1 else ds1 % ks1
                 mmm = M.alter helper key mm1
                 nt = fromJust $ M.lookup key mmm
              in do put (ds1, ks1, mmm)
                    return nt

goMany :: String -> Tracker [Int]
goMany = mapM goOne

dropEvrySnd [] = []
dropEvrySnd (x:y:xs) = y : dropEvrySnd xs

runner :: String -> String
runner = words
         >>> drop 1
         >>> dropEvrySnd
         >>> map goMany
         >>> map (flip evalState (0, 0, M.empty))
         >>> map (map show >>> unwords)
         >>> unlines

main = interact runner

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

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

evaluate s = dfs s Map.empty 0 0
  where dfs :: String -> Map.Map (Integer, Integer) Integer -> Integer -> Integer -> [Integer]
        dfs "" _ _ _ = []
        dfs (a:as) mp d k = value : dfs as mp' d' k'
          where d' = if a == 'D' then (d + 1) else d
                k' = if a == 'K' then (k + 1) else k
                g = gcd d' k'
                value =(+) 1 $ match $ Map.lookup (d' `div` g, k' `div` g) mp
                  where match Nothing = 0
                        match (Just a) = a
                mp' = Map.insert (d' `div` g, k' `div` g) value mp

solve = do
  [n] <- readIntLine
  s <- getLine
  putStrLn (intercalate " " $ Prelude.map show $ evaluate s)
  return ()

main = do
  [t] <- readIntLine
  replicateM t solve
  return ()

import Control.Monad (replicateM)
import qualified Data.Map.Strict as Map

main = do t <- read <$> getLine
          replicateM t solve

solve = do t <- getLine
           arr <- getLine
           let ans = iterateOver 0 0 (Map.fromList []) arr
           putStrLn $ unwords $ map show ans

iterateOver :: Int -> Int -> Map.Map (Int,Int) Int -> String -> [Int]
iterateOver dcnt kcnt _map [] = []
iterateOver dcnt kcnt _map ('D':xs) = sub : (iterateOver (dcnt+1) kcnt new_map xs)
    where key_gcd = gcd (dcnt+1) kcnt
          key = ((dcnt+1) `div` key_gcd,kcnt `div` key_gcd)
          sub = Map.findWithDefault 0 key _map + 1
          new_map = Map.insertWith (+) key 1 _map

iterateOver dcnt kcnt _map ('K':xs) = sub : (iterateOver dcnt (kcnt+1) new_map xs)
    where key_gcd = gcd (dcnt) (kcnt+1)
          key = (dcnt `div` key_gcd,(kcnt+1) `div` key_gcd)
          sub = Map.findWithDefault 0 key _map + 1
          new_map = Map.insertWith (+) key 1 _map

import Data.List (intercalate)
import Control.Monad (mapM, replicateM)
import Data.Ratio ((%))
import Data.Map (empty, findWithDefault, insert)

main = do t <- read <$> getLine
          replicateM t solve

solve = do getLine
           s <- getLine
           putStrLn (intercalate " " (map show (maxBlocks s)))

maxBlocks s = helper s empty 0 0
  where helper "" _ _ _ = []
        helper (c:s) prev d k = x : helper s prev' d' k'
          where (d', k') | c == 'D' = (d + 1, k)
                         | c == 'K' = (d, k + 1)
                r | k' == 0   = 69000000 % 1
                  | otherwise = d' % k'
                x = (findWithDefault 0 r prev) + 1
                prev' = insert r x prev

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Map.Strict as M
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    wood <- take n . C.unpack <$> C.getLine
    let (_, _, _, rs) = foldl' acc (M.empty, 0, 0, []) wood
        acc (mp, x, y, results) name =
          case M.lookup frac mp of
            Nothing -> (M.insert frac 1 mp, x', y', 1 : results)
            Just num -> (M.insert frac (num + 1) mp, x', y', (num + 1) : results)
          where
          (x', y')
            | name == 'D' = (x + 1, y)
            | otherwise = (x, y + 1)
          frac = (x' `div` g, y' `div` g)
            where g = gcd x' y'
    return $ mconcat (intersperse (charUtf8 ' ') $ map intDec $ reverse rs) `mappend` charUtf8 '\n'
  hPutBuilder stdout output


Astronaut Natasha arrived on Mars. She knows that the Martians are very poor aliens. To ensure a better life for the Mars citizens, their emperor decided to take tax from every tourist who visited the planet. Natasha is the inhabitant of Earth, therefore she had to pay the tax to enter the territory of Mars.There are $$$n$$$ banknote denominations on Mars: the value of $$$i$$$-th banknote is $$$a_i$$$. Natasha has an infinite number of banknotes of each denomination.Martians have $$$k$$$ fingers on their hands, so they use a number system with base $$$k$$$. In addition, the Martians consider the digit $$$d$$$ (in the number system with base $$$k$$$) divine. Thus, if the last digit in Natasha's tax amount written in the number system with the base $$$k$$$ is $$$d$$$, the Martians will be happy. Unfortunately, Natasha does not know the Martians' divine digit yet.Determine for which values $$$d$$$ Natasha can make the Martians happy.Natasha can use only her banknotes. Martians don't give her change.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 100\,000$$$, $$$2 \le k \le 100\,000$$$) — the number of denominations of banknotes and the base of the number system on Mars. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — denominations of banknotes on Mars. All numbers are given in decimal notation.

On the first line output the number of values $$$d$$$ for which Natasha can make the Martians happy. In the second line, output all these values in increasing order. Print all numbers in decimal notation.

NoteConsider the first test case. It uses the octal number system.If you take one banknote with the value of $$$12$$$, you will get $$$14_8$$$ in octal system. The last digit is $$$4_8$$$.If you take one banknote with the value of $$$12$$$ and one banknote with the value of $$$20$$$, the total value will be $$$32$$$. In the octal system, it is $$$40_8$$$. The last digit is $$$0_8$$$.If you take two banknotes with the value of $$$20$$$, the total value will be $$$40$$$, this is $$$50_8$$$ in the octal system. The last digit is $$$0_8$$$.No other digits other than $$$0_8$$$ and $$$4_8$$$ can be obtained. Digits $$$0_8$$$ and $$$4_8$$$ could also be obtained in other ways.The second test case uses the decimal number system. The nominals of all banknotes end with zero, so Natasha can give the Martians only the amount whose decimal notation also ends with zero.

import Data.List

unique = map head . group . sort

main = do
    [n, k] <- fmap (map (read :: String -> Integer) . words) $ getLine
    a <- fmap (map ((`mod` k) . (read :: String -> Integer)) . words) $ getLine

    let d = foldl1 gcd (unique a)
    let answer = unique $ map (\x -> x * d `mod` k) [0..k - 1]

    print . length $ answer
    putStrLn . unwords . map show $ answer

import Data.List

toint s = (read s) :: Int

solve::String -> String
solve ss =
  let (n:k:aa) = map toint $ words ss in
  let a = map (\x -> (mod x k)) aa in
  let g = gcd (foldr gcd 0 a) k in
  (show (div k g)) ++ "\n" ++ (intercalate " " $ map show [0,g..k-1]) ++ "\n"

main = interact solve

import Control.Monad (forM_)
import Data.List (sort)

-- gcd :: Int -> Int -> Int
-- gcd a 0 = a
-- gcd a b = gcd b $ a `div` b

gen :: [Int] -> Int -> Int -> Int -> [Int]
gen res denom k x | denom == x = res
gen res denom k x = gen (x:res) denom k $ (x + denom) `mod` k

main = do
    n:k:[] <- fmap (map read . words) getLine
    a <- fmap (map read . words) getLine
    let vals = filter (/=0) $ map (`mod` k) a
    if null vals then do
        print 1
        print 0
    else do
        let denom = foldl1 gcd vals
        let res = sort $ gen [denom] denom k ((denom * 2) `mod` k)
        print $ length res
        forM_ res $ \x-> do
            putStr $ show x
            putStr " "
        putStrLn ""

import Data.List

main = do
  [_, k] <- fmap (map read . words) getLine
  a <- fmap (map read . words) getLine
  let g = foldl' gcd k a
  print $ k `div` g
  putStrLn $ unwords . map show . takeWhile (< k) $ iterate (+g) 0

import Data.List

main = do
    [n, k] <- fmap (map (read :: String -> Int) . words) $ getLine
    a <- fmap (map ((`mod` k) . (read :: String -> Int)) . words) $ getLine

    let d = foldl1 gcd a
    let answerCandidate = map (* d) [0..k - 1]

    let answer = if 0 `elem` a then [0] else answerCandidate

    print . length $ answer
    putStrLn . unwords . map show . sort $ answer

main = do
    [n, k] <- fmap (map (read :: String -> Int) . words) $ getLine
    a <- fmap (map ((`mod` k) . (read :: String -> Int)) . words) $ getLine

    let d = foldl1 gcd a
    let answer = map (* d) [0..(k - 1) `div` d]

    let (l1, l2) = if 0 `elem` a then (1, [0]) else (length answer, answer)

    print l1
    putStrLn . unwords . map show $ l2

import Data.List

main = do
    [n, k] <- fmap (map (read :: String -> Integer) . words) $ getLine
    a <- fmap (map ((`mod` k) . (read :: String -> Integer)) . words) $ getLine

    let d = foldl1 gcd a
    let answerCandidate = map (\x -> x * d `mod` k) [0..k - 1]

    let answer = if 0 `elem` a then [0] else map head . group . sort $ answerCandidate

    print . length $ answer
    putStrLn . unwords . map show $ answer

import Data.List

main = do
    [n, k] <- fmap (map (read :: String -> Int) . words) $ getLine
    a <- fmap (map ((`mod` k) . (read :: String -> Int)) . words) $ getLine

    let d = foldl1 gcd a
    let answerCandidate = map (\x -> x * d `mod` k) [0..k - 1]

    let answer = if 0 `elem` a then [0] else map head . group . sort $ answerCandidate

    print . length $ answer
    putStrLn . unwords . map show $ answer


The enchanted forest got its name from the magical mushrooms growing here. They may cause illusions and generally should not be approached.—Perfect Memento in Strict SenseMarisa comes to pick mushrooms in the Enchanted Forest. The Enchanted forest can be represented by $$$n$$$ points on the $$$X$$$-axis numbered $$$1$$$ through $$$n$$$. Before Marisa started, her friend, Patchouli, used magic to detect the initial number of mushroom on each point, represented by $$$a_1,a_2,\ldots,a_n$$$.Marisa can start out at any point in the forest on minute $$$0$$$. Each minute, the followings happen in order:  She moves from point $$$x$$$ to $$$y$$$ ($$$|x-y|\le 1$$$, possibly $$$y=x$$$).  She collects all mushrooms on point $$$y$$$.  A new mushroom appears on each point in the forest. Note that she cannot collect mushrooms on minute $$$0$$$.Now, Marisa wants to know the maximum number of mushrooms she can pick after $$$k$$$ minutes.

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains two integers $$$n$$$, $$$k$$$ ($$$1 \le n \le 2 \cdot 10 ^ 5$$$, $$$1\le k \le 10^9$$$) — the number of positions with mushrooms and the time Marisa has, respectively. The second line of each test case contains $$$n$$$ integers $$$a_1,a_2,\ldots,a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the initial number of mushrooms on point $$$1,2,\ldots,n$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10 ^ 5$$$.

For each test case, print the maximum number of mushrooms Marisa can pick after $$$k$$$ minutes.

NoteTest case 1:Marisa can start at $$$x=2$$$. In the first minute, she moves to $$$x=1$$$ and collect $$$5$$$ mushrooms. The number of mushrooms will be $$$[1,7,2,3,4]$$$. In the second minute, she moves to $$$x=2$$$ and collects $$$7$$$ mushrooms. The numbers of mushrooms will be $$$[2,1,3,4,5]$$$. After $$$2$$$ minutes, Marisa collects $$$12$$$ mushrooms.It can be shown that it is impossible to collect more than $$$12$$$ mushrooms.Test case 2:This is one of her possible moving path:$$$2 \rightarrow 3 \rightarrow 2 \rightarrow 1 \rightarrow 2 \rightarrow 3 \rightarrow 4 \rightarrow 5$$$It can be shown that it is impossible to collect more than $$$37$$$ mushrooms.

-- 1687A
{-# LANGUAGE Strict  #-}
{-# LANGUAGE ParallelListComp  #-}

import Control.Monad (replicateM_)
import Data.Array.IArray

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

run :: IO ()
run = do
  [n, k] <- map read . words <$> getLine :: IO [Int]
  as <- map read . words <$> getLine :: IO [Int]
  print $ if n < k then solve2 n k as else solve1 n k as

solve1 :: Int -> Int -> [Int] -> Int
-- solve1 n k as = ((k-1)*k) `div` 2 + maximum (ksum n k as)
solve1 n k as = ((k-1)*k) `div` 2 + ksum'' k ss
  where
    -- ksum n k as = ksum' n k as
    ss = 0 : [a + s | a <- as | s <- ss]
    ksum'' k sums = maximum [s2 - s1 | s2 <- drop k ss | s1 <- ss]
    -- ksum n k as = ksum' as (drop (k-1) as) (sum (take (k-1) as))
    -- ksum' (p:prevs) (n:nexts) curr = (curr+n) : ksum' prevs nexts (curr+n-p)
    -- ksum' _ [] _ = []
    -- ksum' [] _ _ = []

solve2 :: Int -> Int -> [Int] -> Int
solve2 n k as = sum as + n*k - ((n*(n+1)) `div` 2)

-- 1687A
{-# LANGUAGE Strict  #-}
{-# LANGUAGE ParallelListComp  #-}

import Control.Monad (replicateM_)
import Data.Array.IArray

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

run :: IO ()
run = do
  [n, k] <- map read . words <$> getLine :: IO [Int]
  as <- map read . words <$> getLine :: IO [Int]
  print $ if n < k then solve2 n k as else solve1 n k as

solve1 :: Int -> Int -> [Int] -> Int
-- solve1 n k as = ((k-1)*k) `div` 2 + maximum (ksum n k as)
solve1 n k as = ((k-1)*k) `div` 2 + ksum'' k ss
  where
    -- ksum n k as = ksum' n k as
    ss = 0 : [a + s | a <- as | s <- ss]
    ksum'' k sums = maximum [s2 - s1 | s2 <- drop k ss | s1 <- ss]
    ksum n k as = ksum' as (drop (k-1) as) (sum (take (k-1) as))
    ksum' (p:prevs) (n:nexts) curr = (curr+n) : ksum' prevs nexts (curr+n-p)
    ksum' _ [] _ = []
    ksum' [] _ _ = []

solve2 :: Int -> Int -> [Int] -> Int
solve2 n k as = sum as + n*k - ((n*(n+1)) `div` 2)

-- 1687A
{-# LANGUAGE Strict  #-}

import Control.Monad (replicateM_)
import Data.Array.IArray

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

run :: IO ()
run = do
  [n, k] <- map read . words <$> getLine :: IO [Int]
  as <- map read . words <$> getLine :: IO [Int]
  print $ if n < k then solve2 n k as else solve1 n k as

solve1 :: Int -> Int -> [Int] -> Int
solve1 n k as = ((k-1)*k) `div` 2 + maximum (ksum n k as)
  where
    -- ksum n k as = ksum' n k as
    ksum n k as = ksum' as (drop (k-1) as) (sum (take (k-1) as))
    ksum' (p:prevs) (n:nexts) curr = (curr+n) : ksum' prevs nexts (curr+n-p)
    ksum' _ [] _ = []
    ksum' [] _ _ = []

solve2 :: Int -> Int -> [Int] -> Int
solve2 n k as = sum as + n*k - ((n*(n+1)) `div` 2)

-- 1687A

import Control.Monad (replicateM_)
import Data.Array.IArray

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

run :: IO ()
run = do
  [n, k] <- map read . words <$> getLine :: IO [Int]
  as <- map read . words <$> getLine :: IO [Int]
  print $ if n < k then solve2 n k as else solve1 n k as

solve1 :: Int -> Int -> [Int] -> Int
solve1 n k as = ((k-1)*k) `div` 2 + maximum (ksum n k as)
  where
    -- ksum n k as = ksum' n k as
    ksum n k as = ksum' as (drop (k-1) as) (sum (take (k-1) as))
    ksum' (p:prevs) (n:nexts) curr = (curr+n) : ksum' prevs nexts (curr+n-p)
    ksum' _ [] _ = []
    ksum' [] _ _ = []

solve2 :: Int -> Int -> [Int] -> Int
solve2 n k as = sum as + n*k - ((n*(n+1)) `div` 2)


Each New Year Timofey and his friends cut down a tree of n vertices and bring it home. After that they paint all the n its vertices, so that the i-th vertex gets color ci.Now it's time for Timofey birthday, and his mother asked him to remove the tree. Timofey removes the tree in the following way: he takes some vertex in hands, while all the other vertices move down so that the tree becomes rooted at the chosen vertex. After that Timofey brings the tree to a trash can.Timofey doesn't like it when many colors are mixing together. A subtree annoys him if there are vertices of different color in it. Timofey wants to find a vertex which he should take in hands so that there are no subtrees that annoy him. He doesn't consider the whole tree as a subtree since he can't see the color of the root vertex.A subtree of some vertex is a subgraph containing that vertex and all its descendants.Your task is to determine if there is a vertex, taking which in hands Timofey wouldn't be annoyed.

The first line contains single integer n (2 ≤ n ≤ 105) — the number of vertices in the tree. Each of the next n - 1 lines contains two integers u and v (1 ≤ u, v ≤ n, u ≠ v), denoting there is an edge between vertices u and v. It is guaranteed that the given graph is a tree. The next line contains n integers c1, c2, ..., cn (1 ≤ ci ≤ 105), denoting the colors of the vertices.

Print "NO" in a single line, if Timofey can't take the tree in such a way that it doesn't annoy him. Otherwise print "YES" in the first line. In the second line print the index of the vertex which Timofey should take in hands. If there are multiple answers, print any of them.

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

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

solve :: Int -> [(Int, Int)] -> [Int] -> Maybe Int
solve n g cs' =
  let
    bnd = (1, n)
    cs = listArray bnd cs'
    diffs = filter (\(u, v) -> cs!u /= cs!v) g
    ln = length diffs
  in
    fst <$> (find (\(u, c) -> c == ln) . assocs . accumArray (\c u -> c + 1) 0 bnd $ concatMap (\(u, v) -> [(u, v), (v, u)]) diffs)

main = do
  n <- readInt <$> B.getLine
  g <- map ((\(u:v:_) -> (u, v)) . readInts) <$> replicateM (n - 1) B.getLine
  cs <- readInts <$> B.getLine
  putStrLn $ maybe "NO" (("YES\n" ++) . show) $ solve n g cs

import Data.Array as A
import Data.List

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. split. fmap (fmap read. words). lines
    where split a = (a !! 0 !! 0, init. tail $ a, last a)
          prep = fork (id, fmap toTpl, id)
            where fork (f, g, h) (a, b, c) = (f a, g b, h c)
                  toTpl a = (a !! 0, a !! 1)

printAns x = case x of
    Nothing -> "NO"
    Just v -> unlines ["YES", show v]

solve :: Int -> [(Int, Int)] -> [Int] -> Maybe Int
solve n edges colors =
    fmap fst. find sufficient. A.assocs. countForVertices $ importantEdges
    where
        importantEdges = filter isImportant edges
            where isImportant (u, v) = colorArr A.! u /= colorArr A.! v
                  colorArr = A.listArray bounds colors
        countForVertices = A.accumArray (\v _ -> v+1) 0 bounds. undirect
            where undirect = concatMap (\(u,v) -> [(u,v), (v,u)])
        sufficient = (== (length importantEdges)). snd
        bounds = (1, n)

import Data.Array as A
import Data.List

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. split. fmap (fmap read. words). lines
    where split a = (head a !! 0, init. tail $ a, last a)
          prep = fork (id, fmap toTpl, id)
            where fork (f, g, h) (a, b, c) = (f a, g b, h c)
                  toTpl a = (a !! 0, a !! 1)

printAns x = case x of
    Nothing -> "NO"
    Just v -> unlines ["YES", show v]

solve :: Int -> [(Int, Int)] -> [Int] -> Maybe Int
solve n edges colors =
    fmap fst. find sufficient. A.assocs. countForVertices $ importantEdges
    where
        importantEdges = filter isImportant edges
            where isImportant (u, v) = colorArr A.! u /= colorArr A.! v
                  colorArr = A.listArray bounds colors
        countForVertices = A.accumArray (\v _ -> v+1) 0 bounds. undirect
            where undirect = concatMap (\(u,v) -> [(u,v), (v,u)])
        sufficient = (==) importantCnt. snd
            where importantCnt = length importantEdges
        bounds = (1, n)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function (on)
import           Data.Array
-- import           Data.Array.Unboxed
-- import           Data.Array.IArray
-- import           Data.Array.ST
-- import           Data.Array.MArray
-- import           Data.Array.Unsafe
import           Data.Ix
import           Data.Maybe
import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
import           Data.Graph
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntSet (IntSet)
-- import qualified Data.IntSet as S
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as M
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S
-- import           Debug.Trace

main = do
  v <- readInt1 <$> BS.getLine
  es <- map readInt2 <$> replicateM (v-1) BS.getLine
  cs <- readIntN <$> BS.getLine
  -- print $ fst . maximumBy (compare `on` snd) . assocs . outdegree . buildG (1,v) $ es ++ map swap es
  format $ solve v es cs

format :: Maybe Int -> IO ()
format Nothing = putStrLn "NO"
format (Just a) = do
  putStrLn "YES"
  print a

hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]

solve :: Int -> [Edge] -> [Int] -> Maybe Int
solve v es cs = if
  | uniColor cs -> Just 1
  | maxDiffEdges == cntDiffColor (edges graph) -> Just maxDiffNode
  | otherwise -> Nothing
  where
    uniColor (c:cs) = all (==c) cs
    graph = buildG (1,v) $ es ++ map swap es
    -- maxDegNode = fst . maximumBy (compare `on` snd) . assocs $ outdegree graph
    -- maxDegEdges = map (,maxDegNode) $ graph!maxDegNode
    color = listArray (1,v) cs
    isDiffColor (a,b) = (color!a) /= (color!b)
    cntDiffColor = length . filter isDiffColor
    diffEdgeHist = hist (1,v) . concatMap fromTuple . filter isDiffColor $ edges graph
    maxDiffEdges = maximum $ elems diffEdgeHist
    maxDiffNode = fst . maximumBy (compare `on` snd) . assocs $ diffEdgeHist

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

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

readInt641 :: BS.ByteString -> Int64
readInt641 = fromIntegral . fst . fromJust . BS.readInteger

readInt642 :: BS.ByteString -> (Int64,Int64)
readInt642 = toTuple . readInt64N

readInt643 :: BS.ByteString -> (Int64,Int64,Int64)
readInt643 = toTriple . readInt64N

readInt64N :: BS.ByteString -> [Int64]
readInt64N =  map readInt641 . BS.words

readInteger1 :: BS.ByteString -> Integer
readInteger1 = fst . fromJust . BS.readInteger

readInteger2 :: BS.ByteString -> (Integer,Integer)
readInteger2 = toTuple . readIntegerN

readInteger3 :: BS.ByteString -> (Integer,Integer,Integer)
readInteger3 = toTriple . readIntegerN

readIntegerN :: BS.ByteString -> [Integer]
readIntegerN =  map readInteger1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

toTriple :: [a] -> (a, a, a)
toTriple [x, y, z] =(x, y, z)

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

fromTriple :: (a, a, a) -> [a]
fromTriple (x, y, z) = [x, y, z]

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)


The statement of this problem is the same as the statement of problem C1. The only difference is that, in problem C1, $$$n$$$ is always even, and in C2, $$$n$$$ is always odd.You are given a regular polygon with $$$2 \cdot n$$$ vertices (it's convex and has equal sides and equal angles) and all its sides have length $$$1$$$. Let's name it as $$$2n$$$-gon.Your task is to find the square of the minimum size such that you can embed $$$2n$$$-gon in the square. Embedding $$$2n$$$-gon in the square means that you need to place $$$2n$$$-gon in the square in such way that each point which lies inside or on a border of $$$2n$$$-gon should also lie inside or on a border of the square.You can rotate $$$2n$$$-gon and/or the square.

The first line contains a single integer $$$T$$$ ($$$1 \le T \le 200$$$) — the number of test cases. Next $$$T$$$ lines contain descriptions of test cases — one per line. Each line contains single odd integer $$$n$$$ ($$$3 \le n \le 199$$$). Don't forget you need to embed $$$2n$$$-gon, not an $$$n$$$-gon.

Print $$$T$$$ real numbers — one per test case. For each test case, print the minimum length of a side of the square $$$2n$$$-gon can be embedded in. Your answer will be considered correct if its absolute or relative error doesn't exceed $$$10^{-6}$$$.

import Data.List

solve :: Double -> Double
solve n = cos(pi/(4*n))/sin(pi/(2*n))

main = interact $
          (intercalate "\n")
          . (map (show . solve . read))
          . (drop 1)
          . words

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

type Long = Int

solve :: Double -> Double
solve n = r*2 * cos (pi * abs (i/n - 1/4))
    where
        r = 0.5 / sin (pi/2/n)
        i = fromIntegral $ round (n/4)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:_) <- readWords
    print $ solve n
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine


The only difference between the easy and hard versions is that the given string $$$s$$$ in the easy version is initially a palindrome, this condition is not always true for the hard version.A palindrome is a string that reads the same left to right and right to left. For example, "101101" is a palindrome, while "0101" is not.Alice and Bob are playing a game on a string $$$s$$$ of length $$$n$$$ consisting of the characters '0' and '1'. Both players take alternate turns with Alice going first.In each turn, the player can perform one of the following operations:   Choose any $$$i$$$ ($$$1 \le i \le n$$$), where $$$s[i] =$$$ '0' and change $$$s[i]$$$ to '1'. Pay 1 dollar.  Reverse the whole string, pay 0 dollars. This operation is only allowed if the string is currently not a palindrome, and the last operation was not reverse. That is, if Alice reverses the string, then Bob can't reverse in the next move, and vice versa. Reversing a string means reordering its letters from the last to the first. For example, "01001" becomes "10010" after reversing.The game ends when every character of string becomes '1'. The player who spends minimum dollars till this point wins the game and it is a draw if both spend equal dollars. If both players play optimally, output whether Alice wins, Bob wins, or if it is a draw.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^3$$$). Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^3$$$). The second line of each test case contains the string $$$s$$$ of length $$$n$$$, consisting of the characters '0' and '1'. It is guaranteed that the string $$$s$$$ contains at least one '0'. Note that there is no limit on the sum of $$$n$$$ over test cases.

For each test case print a single word in a new line:    "ALICE", if Alice will win the game,  "BOB", if Bob will win the game,  "DRAW", if the game ends in a draw.

NoteIn the first test case of example,   in the $$$1$$$-st move, Alice will use the $$$2$$$-nd operation to reverse the string, since doing the $$$1$$$-st operation will result in her loss anyway. This also forces Bob to use the $$$1$$$-st operation.  in the $$$2$$$-nd move, Bob has to perform the $$$1$$$-st operation, since the $$$2$$$-nd operation cannot be performed twice in a row. All characters of the string are '1', game over.  Alice spends $$$0$$$ dollars while Bob spends $$$1$$$ dollar. Hence, Alice wins.In the second test case of example,   in the $$$1$$$-st move Alice has to perform the $$$1$$$-st operation, since the string is currently a palindrome.  in the $$$2$$$-nd move Bob reverses the string.  in the $$$3$$$-rd move Alice again has to perform the $$$1$$$-st operation. All characters of the string are '1', game over.  Alice spends $$$2$$$ dollars while Bob spends $$$0$$$ dollars. Hence, Bob wins.

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if midZero then 1 else 0)
        midZero = odd n && C.index str (n `div` 2) == '0'
        z = C.count '0' str
        result
            | m == 0 = "BOB"
            | m == 1 && midZero && z > 1 = "ALICE"
            | m == 1 && midZero = "BOB"
            | m == 2 && midZero && z == 2 = "DRAW"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import           Control.Monad

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        _ <- getLine
        s <- getLine
        let winner = if reverse s == s
                        then solvePalin s
                        else solveNonPalin s
        putStrLn winner

countZeros :: String -> Int
countZeros = length . filter (== '0')

solvePalin :: String -> String
solvePalin s = let z = countZeros s in if even z || z == 1
                                        then "BOB"
                                        else "ALICE"

solveNonPalin :: String -> String
solveNonPalin s
  | even n || countZeros s /= 2  = "ALICE"
  | otherwise                    = if s !! quot n 2 == '0'
                                      then "DRAW"
                                      else "ALICE"
  where n = length s

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if midZero then 1 else 0)
        midZero = odd n && C.index str (n `div` 2) == '0'
        z = C.count '0' str
        result
            | m == 0 = "BOB"
            | m == 1 && midZero && z > 1 = "ALICE"
            | m == 1 && midZero = "BOB"
            | m == 2 && midZero && z == 2 = "DRAW"
            | m == 2 && midZero = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if odd n && C.index str (n `div` 2) == '0' then 1 else 0)
        z = C.count '0' str
        result
            | m == 0 = "BOB"
            | m == 1 && (odd n && C.index str (n `div` 2) == '0') && z > 1 = "ALICE"
            | m == 1 && (odd n && C.index str (n `div` 2) == '0') = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if odd n && C.index str (n `div` 2) == '0' then 1 else 0)
        result
            | m == 1 && (odd n && C.index str (n `div` 2) == '0') || m == 0 = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if odd n && C.index str (n `div` 2) == '0' then 1 else 0)
        z = C.count '0' str
        result
            | z - m >= 2 && m == 0 = "BOB"
            | z == 1 && odd n && C.index str (n `div` 2) == '0' = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let m = length [() | i <- [0 .. (n - 2) `div` 2], C.index str i /= C.index str (n - 1 - i)] + (if odd n && C.index str (n `div` 2) == '0' then 1 else 0)
        z = C.count '0' str
        result
            | z - m >= 2 && m == 0 = "BOB"
            | otherwise = "ALICE"
    return $ stringUtf8 result `mappend` charUtf8 '\n'
  hPutBuilder stdout result


You are given a grid with $$$n$$$ rows and $$$m$$$ columns, where each cell has a positive integer written on it. Let's call a grid good, if in each row the sequence of numbers is sorted in a non-decreasing order. It means, that for each $$$1 \le i \le n$$$ and $$$2 \le j \le m$$$ the following holds: $$$a_{i,j} \ge a_{i, j-1}$$$.You have to to do the following operation exactly once: choose two columns with indexes $$$i$$$ and $$$j$$$ (not necessarily different), $$$1 \le i, j \le m$$$, and swap them.You are asked to determine whether it is possible to make the grid good after the swap and, if it is, find the columns that need to be swapped.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 2 \cdot 10^5$$$) — the number of rows and columns respectively. Each of the next $$$n$$$ rows contains $$$m$$$ integers, $$$j$$$-th element of $$$i$$$-th row is $$$a_{i,j}$$$ ($$$1 \le a_{i,j} \le 10^9$$$) — the number written in the $$$j$$$-th cell of the $$$i$$$-th row. It's guaranteed that the sum of $$$n \cdot m$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

If after the swap it is impossible to get a good grid, output $$$-1$$$. In the other case output $$$2$$$ integers — the indices of the columns that should be swapped to get a good grid. If there are multiple solutions, print any.

NoteIn the first test case the grid is initially good, so we can, for example, swap the first column with itself.In the second test case it is impossible to make the grid good.In the third test case it is needed to swap the first and the second column, then the grid becomes good.

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO
import Text.Printf

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    (n : _) <- getInts
    as <- transpose <$> replicateM n getInts
    let as' = merge (1, 1, head as) $ tail as
          where merge p [] = [p]
                merge (l, r, x) (y : ys)
                  | x == y = merge (l, r + 1, x) ys
                  | otherwise = (l, r, x) : merge (r + 1, r + 1, y) ys
        cmp [] _ = True
        cmp _ [] = False
        cmp (x : xs) (y : ys) = if x <= y then cmp xs ys else False
        acc p ((l, _, a), (_, r, b))
          | cmp a b = p
          | isNothing p = Just (l, r)
          | otherwise = Just (fst $ fromJust p, r)
        result = case foldl' acc Nothing (zip as' $ tail as') of
          Nothing -> "1 1"
          Just (l, r) -> if all (\(x, y) -> cmp x y) (zip s' (tail s')) then printf "%d %d" l r else "-1"
            where (s1, b : bs) = splitAt (l - 1) as
                  (s2, c : cs) = splitAt (r - l - 1) bs
                  s' = s1 ++ [c] ++ s2 ++ [b] ++ cs
    return $ string7 result <> charUtf8 '\n'
  hPutBuilder stdout output

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO
import Text.Printf

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    (n : _) <- getInts
    as <- transpose <$> replicateM n getInts
    let cmp [] _ = True
        cmp _ [] = False
        cmp (x : xs) (y : ys) = if x <= y then cmp xs ys else False
        acc Nothing (i, a, b)
          | cmp a b = Nothing
          | otherwise = Just (i, i + 1)
        acc (Just (l, r)) (i, a, b)
          | r == i && a == b = Just (l, i + 1)
          | cmp a b = Just (l, r)
          | otherwise = Just (l, i + 1)
        result = case foldl' acc Nothing (zip3 [1..] as $ tail as) of
          Nothing -> "1 1"
          Just (l, r) -> if all (\(x, y) -> cmp x y) (zip s' (tail s')) then printf "%d %d" l r else "-1"
            where (s1, b : bs) = splitAt (l - 1) as
                  (s2, c : cs) = splitAt (r - l - 1) bs
                  s' = s1 ++ [c] ++ s2 ++ [b] ++ cs
    return $ string7 result <> charUtf8 '\n'
  hPutBuilder stdout output

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO
import Text.Printf

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    (n : _) <- getInts
    as <- transpose <$> replicateM n getInts
    let cmp [] _ = True
        cmp _ [] = False
        cmp (x : xs) (y : ys) = if x <= y then cmp xs ys else False
        acc p (i, a, b)
          | cmp a b = p
          | isNothing p = Just (i, i + 1)
          | otherwise = Just (fst $ fromJust p, i + 1)
        result = case foldl' acc Nothing (zip3 [1..] as $ tail as) of
          Nothing -> "1 1"
          Just (l, r) -> if all (\(x, y) -> cmp x y) (zip s' (tail s')) then printf "%d %d" l r else "-1"
            where (s1, b : bs) = splitAt (l - 1) as
                  (s2, c : cs) = splitAt (r - l - 1) bs
                  s' = s1 ++ [c] ++ s2 ++ [b] ++ cs
    return $ string7 result <> charUtf8 '\n'
  hPutBuilder stdout output


Hands that shed innocent blood!There are n guilty people in a line, the i-th of them holds a claw with length Li. The bell rings and every person kills some of people in front of him. All people kill others at the same time. Namely, the i-th person kills the j-th person if and only if j < i and j ≥ i - Li.You are given lengths of the claws. You need to find the total number of alive people after the bell rings.

The first line contains one integer n (1 ≤ n ≤ 106) — the number of guilty people. Second line contains n space-separated integers L1, L2, ..., Ln (0 ≤ Li ≤ 109), where Li is the length of the i-th person's claw.

Print one integer — the total number of alive people after the bell rings.

NoteIn first sample the last person kills everyone in front of him.

module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
main = B.interact exec
exec = B.pack . show . solve . map int . B.words
  where int = maybe undefined fst . B.readInt
solve (n:ls) = length $ filter (== 0) $ scanl1 (+) $  elems (accumArray (+) 0 (1, n) $ concat $ zipWith (\i l -> let lo = max 1 $ i -l in if lo > i - 1 then [] else [(max 1 $ i - l, 1), (i, -1)]) [1..] ls :: UArray Int Int)

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU
{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Char8 as C
import Data.Maybe

readI = fst . fromJust . C.readInt

main = C.interact $ C.pack . solve . map readI . C.words

solve (_:xs) = show ans
    where
        ans = fst $ foldl f (0, 0) $ reverse xs
        f (a, 0) x = (a + 1, x)
        f (a, k) x = (a, max (k-1) x)

module Main where
import Data.Array.Unboxed
main = interact exec
exec = show . solve . map read . words
solve (n:ls) = length $ filter (== 0) $ elems (accumArray (+) 0 (1, n) $ concat $ zipWith (\i l -> [(max 1 $ i - l, 1), (i, -1)]) [1..] ls :: UArray Int Int)


You've got an array a, consisting of n integers a1, a2, ..., an. You are allowed to perform two operations on this array:  Calculate the sum of current array elements on the segment [l, r], that is, count value al + al + 1 + ... + ar.  Apply the xor operation with a given number x to each array element on the segment [l, r], that is, execute . This operation changes exactly r - l + 1 array elements. Expression  means applying bitwise xor operation to numbers x and y. The given operation exists in all modern programming languages, for example in language C++ and Java it is marked as "^", in Pascal — as "xor".You've got a list of m operations of the indicated type. Your task is to perform all given operations, for each sum query you should print the result you get.

The first line contains integer n (1 ≤ n ≤ 105) — the size of the array. The second line contains space-separated integers a1, a2, ..., an (0 ≤ ai ≤ 106) — the original array. The third line contains integer m (1 ≤ m ≤ 5·104) — the number of operations with the array. The i-th of the following m lines first contains an integer ti (1 ≤ ti ≤ 2) — the type of the i-th query. If ti = 1, then this is the query of the sum, if ti = 2, then this is the query to change array elements. If the i-th operation is of type 1, then next follow two integers li, ri (1 ≤ li ≤ ri ≤ n). If the i-th operation is of type 2, then next follow three integers li, ri, xi (1 ≤ li ≤ ri ≤ n, 1 ≤ xi ≤ 106). The numbers on the lines are separated by single spaces.

For each query of type 1 print in a single line the sum of numbers on the given segment. Print the answers to the queries in the order in which the queries go in the input. Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams, or the %I64d specifier.

{-# OPTIONS_GHC -O3 -optc-O3 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, MagicHash #-}

import GHC.Prim (uncheckedIShiftL#,uncheckedIShiftRL#)
import GHC.Exts (Int(..))
import Control.Applicative ((<$>))
import Control.Monad (unless,when,forM_)
import Data.Array.Base
import Data.Array.IO (IOUArray)
import Data.Bits (testBit,shiftL,shiftR,xor,(.&.),(.|.))
import qualified Data.ByteString.Char8 as B (ByteString,readInt,words,getContents,getLine)
import Data.Int (Int64)
import Data.List (foldl')

infixl 8 .<<. , .>>.
(.<<.) :: Int -> Int -> Int
(I# x).<<.(I# i) = I# (uncheckedIShiftL# x i)
(.>>.) :: Int -> Int -> Int
(I# x).>>.(I# i) = I# (uncheckedIShiftRL# x i)
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
{-# INLINE readInt #-}

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

toDecimal :: [Int] -> Int64
toDecimal xs = foldl' (\x y->x`shiftL`1 + fromIntegral y) 0 xs
{-# INLINE toDecimal #-}

data SegTree = Node !Int !Int !(IOUArray Int Int) !(IOUArray Int Int) !SegTree !SegTree
             | Leaf !Int !(IOUArray Int Int)

merge :: SegTree -> SegTree -> IO SegTree
merge stx sty = do
  cnt <- newArray (0,19) 0 :: IO (IOUArray Int Int)
  f   <- newArray (0,19) 0 :: IO (IOUArray Int Int)
  rep 20 $ \b-> do
    x <- unsafeRead (getCnt stx) b
    y <- unsafeRead (getCnt sty) b
    unsafeWrite cnt b $! x+y
  return $! Node (getLeft stx) (getRight sty) cnt f stx sty

getLeft :: SegTree -> Int
getLeft (Node l _ _ _ _ _) = l
getLeft (Leaf k _) = k

getRight :: SegTree -> Int
getRight (Node _ r _ _ _ _) = r
getRight (Leaf k _ ) = k

getCnt :: SegTree -> IOUArray Int Int
getCnt (Node _ _ cnt _ _ _) = cnt
getCnt (Leaf _ cnt) = cnt

mkSegTree :: Int -> Int -> UArray Int Int  -> IO SegTree
mkSegTree l r arr
  | l/=r = do
      let !m = (l+r).>>.1
      lt <- mkSegTree l m arr
      rt <- mkSegTree (m+1) r arr
      merge lt rt
  | otherwise = do
      let !x = unsafeAt arr (l-1)
      cnt <- newListArray (0,19) $ map (\b->x.>>.b.&.1) [0..19]
      return $! Leaf l cnt

query :: Int -> Int -> SegTree -> IO ()
query kl kr segtree = mapM (go segtree) [19,18..0] >>= print.toDecimal
   where
     go (Node l r cnt flag lt rt) b = do
       if r<kl || kr<l
          then return 0
          else if kl<=l && r<=kr
                  then unsafeRead cnt b
                  else do
                    ql <- go lt b
                    qr <- go rt b
                    f <- unsafeRead flag b
                    if f==1
                       then  return $! min kr r-max kl l+1-ql-qr
                       else  return $! ql+qr
     go (Leaf k cnt) b
       | kl<=k && k<=kr = unsafeRead cnt b
       | otherwise = return 0

update :: Int -> Int -> Int -> SegTree -> IO ()
update kl kr x segtree = go segtree
   where
     !bs = filter (testBit x) [0..19]
     go (Node l r cnt flag lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then do
              forM_ bs $ \b-> do
                f <- unsafeRead flag b
                unsafeWrite flag b $! xor 1 f
                c <- unsafeRead cnt b
                unsafeWrite cnt b $! r-l+1-c
            else do
              go lt
              go rt
              forM_ bs $ \b-> do
                cntl <- unsafeRead (getCnt lt) b
                cntr <- unsafeRead (getCnt rt) b
                f <- unsafeRead flag b
                if f==1
                   then unsafeWrite cnt b $! r-l+1-cntl-cntr
                   else unsafeWrite cnt b $! cntl+cntr
     go (Leaf k cnt) = do
       when (kl<=k && k<=kr) $ do
         forM_ bs $ \b-> do
           c <- unsafeRead cnt b
           unsafeWrite cnt b $! xor 1 c

main = do
  n <- readLn
  arr <- listArray(0,n-1).map readInt.B.words <$> B.getLine :: IO (UArray Int Int)
  segtree <- mkSegTree 1 n arr
  queries <- map readInt.tail.B.words <$> B.getContents
  let parse (1:rest) = parse1 rest
      parse (_:rest) = parse2 rest
      parse _ = []
      parse1 (l:r:rest)   = query  l r   segtree : parse rest
      parse2 (l:r:x:rest) = update l r x segtree : parse rest
  sequence_ $ parse queries

{-# OPTIONS_GHC -O3 -optc-O3 #-}
{-# LANGUAGE BangPatterns, MagicHash #-}

import GHC.Prim (uncheckedIShiftL#,uncheckedIShiftRL#)
import GHC.Exts (Int(..))
import Data.Bits (testBit,shiftL,shiftR,xor,(.&.),(.|.))
import qualified Data.ByteString.Char8 as B (ByteString,readInt,words,getContents,getLine)
import Data.Int (Int64)
import Data.List (foldl')
import Control.Applicative ((<$>),(<*>))
import Control.Monad (unless,forM_)
import Data.Array.Base (UArray,listArray,newArray,unsafeAt,unsafeRead,unsafeWrite)
import Data.Array.IO (IOUArray)

infixl 8 .<<. , .>>.
(.<<.) :: Int -> Int -> Int
(I# x).<<.(I# i) = I# (uncheckedIShiftL# x i)
(.>>.) :: Int -> Int -> Int
(I# x).>>.(I# i) = I# (uncheckedIShiftRL# x i)
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
{-# INLINE readInt #-}

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

toDecimal :: [Int] -> Int64
toDecimal xs = foldl' (\x y->x`shiftL`1 + fromIntegral y) 0 xs
{-# INLINE toDecimal #-}

main = do
  n <- readLn
  arr <- listArray(0,n-1).map readInt.B.words <$> B.getLine :: IO (UArray Int Int)

  segtree <- newArray (0,20*(1.<<.18)-1) 0 :: IO (IOUArray Int Int)
  flag    <- newArray (0,20*(1.<<.18)-1) 0 :: IO (IOUArray Int Int)

  let build node l r = do
        if r-l==1
           then do
             let !al = unsafeAt arr l
             rep 20 $ \b-> do
               unsafeWrite segtree (b.<<.18+ node) $! al.>>.b.&.1
           else do
             let !nodel = node.<<.1 .|. 1
                 !noder = node.<<.1 + 2
                 !m = (l+r).>>.1
             build nodel l m
             build noder m r
             rep 20 $ \b-> do
               cntl <- unsafeRead segtree $! b.<<.18+nodel
               cntr <- unsafeRead segtree $! b.<<.18+noder
               unsafeWrite segtree (b.<<.18+ node)  $! cntl + cntr

  let query kl kr = mapM (go 0 0 n) [19,18..0] >>= print.toDecimal
        where
          go node l r b = do
            if r<=kl || kr<=l
               then return 0
               else if kl<=l && r<=kr
                       then unsafeRead segtree $! b.<<.18+node
                       else do
                         let !nodel = node.<<.1 .|. 1
                             !noder = node.<<.1 + 2
                             !m = (l+r).>>.1
                         ql <- go nodel l m b
                         qr <- go noder m r b
                         f <- unsafeRead flag $! b.<<.18+node
                         if f==1
                            then return $! min kr r-max kl l-ql-qr
                            else return $! ql+qr

  let update kl kr x = go 0 0 n
         where
           !bs = filter (testBit x) [0..19]
           go node l r = do
             unless (r<=kl || kr<=l) $ do
                if kl<=l && r<=kr
                   then do
                     forM_ bs $ \b-> do
                       let !i = b.<<.18 + node
                       f <- unsafeRead flag i
                       unsafeWrite flag i $! xor 1 f
                       cnt <- unsafeRead segtree i
                       unsafeWrite segtree i $! r-l-cnt
                   else do
                     let !nodel = node.<<.1 .|. 1
                         !noder = node.<<.1 + 2
                         !m = (l+r).>>.1
                     go nodel l m
                     go noder m r
                     forM_ bs $ \b-> do
                       cntl <- unsafeRead segtree $! b.<<.18+nodel
                       cntr <- unsafeRead segtree $! b.<<.18+noder
                       f <- unsafeRead flag $! b.<<.18 + node
                       if f==1
                          then unsafeWrite segtree (b.<<.18+node) $! r-l-cntl-cntr
                          else unsafeWrite segtree (b.<<.18+node) $! cntl+cntr

  let parse (1:rest) = parse1 rest
      parse (_:rest) = parse2 rest
      parse _ = []
      parse1 (l:r:rest)   = query  (l-1) r   : parse rest
      parse2 (l:r:x:rest) = update (l-1) r x : parse rest

  build 0 0 n
  queries <- map readInt.tail.B.words <$> B.getContents
  sequence_ $ parse queries


Nick is attracted by everything unconventional. He doesn't like decimal number system any more, and he decided to study other number systems. A number system with base b caught his attention. Before he starts studying it, he wants to write in his notepad all the numbers of length n without leading zeros in this number system. Each page in Nick's notepad has enough space for c numbers exactly. Nick writes every suitable number only once, starting with the first clean page and leaving no clean spaces. Nick never writes number 0 as he has unpleasant memories about zero divide.Would you help Nick find out how many numbers will be written on the last page.

The only input line contains three space-separated integers b, n and c (2 ≤ b < 10106, 1 ≤ n < 10106, 1 ≤ c ≤ 109). You may consider that Nick has infinite patience, endless amount of paper and representations of digits as characters. The numbers doesn't contain leading zeros.

In the only line output the amount of numbers written on the same page as the last number.

NoteIn both samples there are exactly 4 numbers of length 3 in binary number system. In the first sample Nick writes 3 numbers on the first page and 1 on the second page. In the second sample all the 4 numbers can be written on the first page.

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

powMod _ 0 m = mod 1 m
powMod a b m = mod (if odd b then powMod a (pred b) m * a else powMod a (div b 2) m ^ 2) m

phi n = phi' n n [2 ..] where
	phi' 1 m _ = m
	phi' n m (p:q)
		| p * p > n		= m * (n - 1) `div` n
		| mod n p == 0	= phi' (until ((/=0) . (`mod`p)) (`div`p) n) (m * (p - 1) `div` p) q
		| otherwise		= phi' n m q

gao a b c = if r > 0 then r else c where
	n = phi c
	t = powMod b (if a > c then n + mod (a - 1) n else a - 1) c
	r = (b - 1) * t `mod` c

main = do
	[b, n, c] <- fmap (map (fst . fromJust . C.readInteger) . C.words) (C.hGetContents stdin)
	putStrLn $ show $ gao n b c


Naruto has sneaked into the Orochimaru's lair and is now looking for Sasuke. There are $$$T$$$ rooms there. Every room has a door into it, each door can be described by the number $$$n$$$ of seals on it and their integer energies $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$. All energies $$$a_i$$$ are nonzero and do not exceed $$$100$$$ by absolute value. Also, $$$n$$$ is even.In order to open a door, Naruto must find such $$$n$$$ seals with integer energies $$$b_1$$$, $$$b_2$$$, ..., $$$b_n$$$ that the following equality holds: $$$a_{1} \cdot b_{1} + a_{2} \cdot b_{2} + ... + a_{n} \cdot b_{n} = 0$$$. All $$$b_i$$$ must be nonzero as well as $$$a_i$$$ are, and also must not exceed $$$100$$$ by absolute value. Please find required seals for every room there.

The first line contains the only integer $$$T$$$ ($$$1 \leq T \leq 1000$$$) standing for the number of rooms in the Orochimaru's lair. The other lines contain descriptions of the doors. Each description starts with the line containing the only even integer $$$n$$$ ($$$2 \leq n \leq 100$$$) denoting the number of seals. The following line contains the space separated sequence of nonzero integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$|a_{i}| \leq 100$$$, $$$a_{i} \neq 0$$$) denoting the energies of seals.

For each door print a space separated sequence of nonzero integers $$$b_1$$$, $$$b_2$$$, ..., $$$b_n$$$ ($$$|b_{i}| \leq 100$$$, $$$b_{i} \neq 0$$$) denoting the seals that can open the door. If there are multiple valid answers, print any. It can be proven that at least one answer always exists.

NoteFor the first door Naruto can use energies $$$[-100, 1]$$$. The required equality does indeed hold: $$$1 \cdot (-100) + 100 \cdot 1 = 0$$$.For the second door Naruto can use, for example, energies $$$[1, 1, 1, -1]$$$. The required equality also holds: $$$1 \cdot 1 + 2 \cdot 1 + 3 \cdot 1 + 6 \cdot (-1) = 0$$$.

{-# LANGUAGE BlockArguments  #-}

import Data.Foldable
import Data.Traversable

getLineOfInts :: IO [Int]
getLineOfInts = do
  line <- getLine
  let ints = read <$> words line :: [Int]
  return ints

putLineOfInts :: [Int] -> IO ()
putLineOfInts xs =
  putStrLn $ unwords $ show <$> xs

pairs :: [a] -> [(a, a)]
pairs [] = []
pairs (x:y:ys) = (x,y):(pairs ys)

unpairs :: [(a, a)] -> [a]
unpairs [] = []
unpairs ((x,y):ys) = x:y:(unpairs ys)

main :: IO ()
main = do
  [t] <- getLineOfInts
  for_ [1..t] $ \_ -> do

    [n] <- getLineOfInts
    as <- getLineOfInts

    let bs = unpairs $ (\(x,y) -> ((-y),x)) <$> pairs as

    putLineOfInts bs

{-# LANGUAGE BlockArguments  #-}

import Data.Foldable
import Data.Traversable

getLineOfInts :: IO [Int]
getLineOfInts = do
  line <- getLine
  let ints = read <$> words line :: [Int]
  return ints

putLineOfInts :: [Int] -> IO ()
putLineOfInts xs =
  putStrLn $ unwords $ show <$> xs

pairs :: [a] -> [(a, a)]
pairs [] = []
pairs (x:y:ys) = (x,y):(pairs ys)

unpairs :: [(a, a)] -> [a]
unpairs [] = []
unpairs ((x,y):ys) = x:y:(unpairs ys)

main :: IO ()
main = do
  [t] <- getLineOfInts
  for_ [1..t] $ \_ -> do

    [n] <- getLineOfInts
    as <- getLineOfInts

    let bs = unpairs $ (\(x,y) -> ((-y),(-x))) <$> pairs as

    putLineOfInts bs


There is a robot staying at $$$X=0$$$ on the $$$Ox$$$ axis. He has to walk to $$$X=n$$$. You are controlling this robot and controlling how he goes. The robot has a battery and an accumulator with a solar panel.The $$$i$$$-th segment of the path (from $$$X=i-1$$$ to $$$X=i$$$) can be exposed to sunlight or not. The array $$$s$$$ denotes which segments are exposed to sunlight: if segment $$$i$$$ is exposed, then $$$s_i = 1$$$, otherwise $$$s_i = 0$$$.The robot has one battery of capacity $$$b$$$ and one accumulator of capacity $$$a$$$. For each segment, you should choose which type of energy storage robot will use to go to the next point (it can be either battery or accumulator). If the robot goes using the battery, the current charge of the battery is decreased by one (the robot can't use the battery if its charge is zero). And if the robot goes using the accumulator, the current charge of the accumulator is decreased by one (and the robot also can't use the accumulator if its charge is zero).If the current segment is exposed to sunlight and the robot goes through it using the battery, the charge of the accumulator increases by one (of course, its charge can't become higher than it's maximum capacity).If accumulator is used to pass some segment, its charge decreases by 1 no matter if the segment is exposed or not.You understand that it is not always possible to walk to $$$X=n$$$. You want your robot to go as far as possible. Find the maximum number of segments of distance the robot can pass if you control him optimally.

The first line of the input contains three integers $$$n, b, a$$$ ($$$1 \le n, b, a \le 2 \cdot 10^5$$$) — the robot's destination point, the battery capacity and the accumulator capacity, respectively. The second line of the input contains $$$n$$$ integers $$$s_1, s_2, \dots, s_n$$$ ($$$0 \le s_i \le 1$$$), where $$$s_i$$$ is $$$1$$$ if the $$$i$$$-th segment of distance is exposed to sunlight, and $$$0$$$ otherwise.

Print one integer — the maximum number of segments the robot can pass if you control him optimally.

NoteIn the first example the robot can go through the first segment using the accumulator, and charge levels become $$$b=2$$$ and $$$a=0$$$. The second segment can be passed using the battery, and charge levels become $$$b=1$$$ and $$$a=1$$$. The third segment can be passed using the accumulator, and charge levels become $$$b=1$$$ and $$$a=0$$$. The fourth segment can be passed using the battery, and charge levels become $$$b=0$$$ and $$$a=1$$$. And the fifth segment can be passed using the accumulator.In the second example the robot can go through the maximum number of segments using battery two times and accumulator one time in any order.

analyze _ _ 0 0 _ = 0
analyze b a p q s
  | a == q = 1 + (analyze b a p (q - 1) (tail s))
  | p == 0 = 1 + (analyze b a p (q - 1) (tail s))
  | (head s) == 1 = 1 + (analyze b a (p - 1) (q + 1) (tail s))
  | q == 0 = 1 + (analyze b a (p - 1) q (tail s))
  | otherwise = 1 + (analyze b a p (q - 1) (tail s))

main = do
  line1 <- getLine
  line2 <- getLine
  let
    nums1 = map read (words line1)
    (n:b:a:_) = nums1
    s = (map read (words line2)) ++ (repeat 0)
  putStrLn (show (min n (analyze b a b a s)))

main :: IO ()
main = do
    inp <- getLine
    let l = map read $ words inp
        a = l!!0
        b = l!!1
        c = l!!2
    inp <- getLine
    let liste = map read $ words inp
    putStrLn $ show $ steps $ Just (liste,c,b,c,b)
    return ()
steps :: (Maybe ([Int],Int,Int,Int,Int)) -> Int
steps Nothing = -1
steps (Just x)  = 1+(steps $ step x)

step :: ([Int],Int,Int,Int,Int) -> Maybe ([Int],Int,Int,Int,Int)
step (liste,acc,batt,cacc,cbatt)
    |null liste        = Nothing
    |cacc==cbatt && cacc==0    = Nothing
    |(head liste) == 0 =
        if cacc==0
            then Just (tail liste,acc,batt,cacc,cbatt-1)
            else Just (tail liste,acc,batt,cacc-1,cbatt)
    |otherwise         =
        if cacc==acc || cbatt==0
            then Just (tail liste,acc,batt,cacc-1,cbatt)
            else Just (tail liste,acc,batt,cacc+1,cbatt-1)

main :: IO ()
main = do
    inp <- getLine
    let l = map read $ words inp
        a = l!!0
        b = l!!1
        c = l!!2
    inp <- getLine
    let liste = map read $ words inp
    putStrLn $ show $ steps $ Just (liste,c,b,c,b)
    return ()
steps :: (Maybe ([Int],Int,Int,Int,Int)) -> Int
steps Nothing = -1
steps (Just x)  = 1+(steps $ step x)

step :: ([Int],Int,Int,Int,Int) -> Maybe ([Int],Int,Int,Int,Int)
step (liste,acc,batt,cacc,cbatt)
    |null liste        = Nothing
    |cacc==cbatt && cacc==0    = Nothing
    |(head liste) == 0 =
        if cacc==0
            then Just (tail liste,acc,batt,cacc,cbatt-1)
            else Just (tail liste,acc,batt,cacc-1,cbatt)
    |otherwise         =
        if cacc==acc
            then Just (tail liste,acc,batt,cacc-1,cbatt)
            else Just (tail liste,acc,batt,cacc+1,cbatt-1)

main :: IO ()
main = do
    inp <- getLine
    let l = map read $ words inp
        a = l!!0
        b = l!!1
        c = l!!2
    inp <- getLine
    let liste = map read $ words inp
    putStrLn $ show $ steps $ Just (liste,c,b,c,b)
    return ()
steps :: (Maybe ([Int],Int,Int,Int,Int)) -> Int
steps Nothing = 0
steps (Just x)  = 1+(steps $ step x)

step :: ([Int],Int,Int,Int,Int) -> Maybe ([Int],Int,Int,Int,Int)
step (liste,acc,batt,cacc,cbatt)
    |null liste        = Nothing
    |cacc==cbatt && cacc==0    = Nothing
    |(head liste) == 0 =
        if cacc==0
            then Just (tail liste,acc,batt,cacc,cbatt-1)
            else Just (tail liste,acc,batt,cacc-1,cbatt)
    |otherwise         =
        if cacc==acc
            then Just (tail liste,acc,batt,cacc-1,cbatt)
            else Just (tail liste,acc,batt,cacc+1,cbatt-1)

main :: IO ()
main = do
    inp <- getLine
    let l = map read $ words inp
        a = l!!0
        b = l!!1
        c = l!!2
    inp <- getLine
    let liste = map read $ words inp
    putStrLn $ show $ steps $ Just (liste,c,b,c,b)
    return ()
steps :: (Maybe ([Int],Int,Int,Int,Int)) -> Int
steps Nothing = -1
steps (Just x)  = 1+(steps $ step x)

step :: ([Int],Int,Int,Int,Int) -> Maybe ([Int],Int,Int,Int,Int)
step (liste,acc,batt,cacc,cbatt)
    |null liste        = Nothing
    |cacc==cbatt && cacc==0    = Nothing
    |(head liste) == 0 =
        if cacc==0
            then Just (tail liste,acc,batt,cacc,cbatt-1)
            else Just (tail liste,acc,batt,cacc-1,cbatt)
    |otherwise         =
        if cacc==acc || cacc==0
            then Just (tail liste,acc,batt,cacc-1,cbatt)
            else Just (tail liste,acc,batt,cacc+1,cbatt-1)


Dima is a beginner programmer. During his working process, he regularly has to repeat the following operation again and again: to remove every second element from the array. One day he has been bored with easy solutions of this problem, and he has come up with the following extravagant algorithm.Let's consider that initially array contains n numbers from 1 to n and the number i is located in the cell with the index 2i - 1 (Indices are numbered starting from one) and other cells of the array are empty. Each step Dima selects a non-empty array cell with the maximum index and moves the number written in it to the nearest empty cell to the left of the selected one. The process continues until all n numbers will appear in the first n cells of the array. For example if n = 4, the array is changing as follows:  You have to write a program that allows you to determine what number will be in the cell with index x (1 ≤ x ≤ n) after Dima's algorithm finishes.

The first line contains two integers n and q (1 ≤ n ≤ 1018, 1 ≤ q ≤ 200 000), the number of elements in the array and the number of queries for which it is needed to find the answer. Next q lines contain integers xi (1 ≤ xi ≤ n), the indices of cells for which it is necessary to output their content after Dima's algorithm finishes.

For each of q queries output one integer number, the value that will appear in the corresponding array cell after Dima's algorithm finishes.

NoteThe first example is shown in the picture.In the second example the final array is [1, 12, 2, 8, 3, 11, 4, 9, 5, 13, 6, 10, 7].

import Control.Applicative ((<$>))
import Control.Monad (replicateM_)
import Data.Word (Word64)

main :: IO ()
main = do
  [n, q] <- map read . words <$> getLine
  replicateM_ (fromIntegral q) $ print . solve n =<< readLn

solve :: Word64 -> Word64 -> Word64
solve n = (`div` 2) . (+ 1) . fst . head . dropWhile (even . fst) .
    iterate go . (\q -> (q, n + div q 2))
  where go (q, q') = (q', q' + div (q' - q) 2)

import Control.Applicative ((<$>))
import Control.Monad (replicateM_)

main :: IO ()
main = do
  [n, q] <- map read . words <$> getLine
  replicateM_ q $ print . solve n =<< readLn

solve :: Int -> Int -> Int
solve n = (`div` 2) . (+ 1) . fst . head . dropWhile (even . fst) .
    iterate go . (\q -> (q, n + div q 2))
  where go (q, q') = (q', q' + div (q' - q) 2)


You are given $$$n$$$ segments on the coordinate axis. The $$$i$$$-th segment is $$$[l_i, r_i]$$$. Let's denote the set of all integer points belonging to the $$$i$$$-th segment as $$$S_i$$$.Let $$$A \cup B$$$ be the union of two sets $$$A$$$ and $$$B$$$, $$$A \cap B$$$ be the intersection of two sets $$$A$$$ and $$$B$$$, and $$$A \oplus B$$$ be the symmetric difference of $$$A$$$ and $$$B$$$ (a set which contains all elements of $$$A$$$ and all elements of $$$B$$$, except for the ones that belong to both sets).Let $$$[\mathbin{op}_1, \mathbin{op}_2, \dots, \mathbin{op}_{n-1}]$$$ be an array where each element is either $$$\cup$$$, $$$\oplus$$$, or $$$\cap$$$. Over all $$$3^{n-1}$$$ ways to choose this array, calculate the sum of the following values:$$$$$$|(((S_1\ \mathbin{op}_1\ S_2)\ \mathbin{op}_2\ S_3)\ \mathbin{op}_3\ S_4)\ \dots\ \mathbin{op}_{n-1}\ S_n|$$$$$$In this expression, $$$|S|$$$ denotes the size of the set $$$S$$$.

The first line contains one integer $$$n$$$ ($$$2 \le n \le 3 \cdot 10^5$$$). Then, $$$n$$$ lines follow. The $$$i$$$-th of them contains two integers $$$l_i$$$ and $$$r_i$$$ ($$$0 \le l_i \le r_i \le 3 \cdot 10^5$$$).

Print one integer — the sum of $$$|(((S_1\ \mathbin{op}_1\ S_2)\ \mathbin{op}_2\ S_3)\ \mathbin{op}_3\ S_4)\ \dots\ \mathbin{op}_{n-1}\ S_n|$$$ over all possible ways to choose $$$[\mathbin{op}_1, \mathbin{op}_2, \dots, \mathbin{op}_{n-1}]$$$. Since the answer can be huge, print it modulo $$$998244353$$$.

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

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Ratio as R
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

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

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

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

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

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

{- mod -}

m :: Int64
m = 998_244_353
-- m = 10 ^ 9 + 7

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

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

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

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)
    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

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

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

    abs    = id
    signum = undefined

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

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

{- solution -}

solve :: Int -> [(Int, Int)] -> Int64
solve n lrs = flip MS.evalState IS.empty $ do
    let power2s = A.listArray (0, n) . L.take (n + 1) . L.iterate (* M 2) $ M 1
        power3s = A.listArray (0, n) . L.take (n + 1) . L.iterate (* M 3) $ M 1

    let xs = L.concatMap (\(l, r) -> [l, r]) lrs
    let ls = L.map fst lrs
        rs = L.map snd lrs
    let lis = L.zip ls [1 .. ]
        ris = L.zip rs [1 .. ]
    let insertEvents = IM.fromList . L.map (\g -> (fst $ L.head g, g)) . L.groupBy (\a b -> fst a == fst b) . L.sort $ lis
        deleteEvents = IM.fromList . L.map (\g -> (fst $ L.head g, g)) . L.groupBy (\a b -> fst a == fst b). L.sort $ ris

    cnts <- M.forM [(minimum xs - 1) .. (maximum xs + 1)] $ \i -> do
        M.forM_ (fromMaybe [] . IM.lookup i $ insertEvents) $ \(x, idx) -> do
            MS.modify $ IS.insert idx

        s <- MS.get
        tracingM "s" s
        q <- MS.gets $ IS.lookupLE n
        let cntI = case q of
                Just 1 -> power2s A.! (n - 1)
                Just q -> (power3s A.! (q - 2)) * (power2s A.! (n - q + 1))
                Nothing -> M 0

        tracingM "cntI" cntI

        M.forM_ (fromMaybe [] . IM.lookup i $ deleteEvents) $ \(x, idx) -> do
            MS.modify $ IS.delete idx

        return $ cntI

    let M answer = L.sum cnts
    return $ answer

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    lrs <- M.replicateM n $ do
        [l, r] <- B8.getLine <&> readIntB8s
        return $ (l, r)
    let answer = solve n lrs
    printf "%lld\n" answer


A bitstring is a string consisting only of the characters 0 and 1. A bitstring is called $$$k$$$-balanced if every substring of size $$$k$$$ of this bitstring has an equal amount of 0 and 1 characters ($$$\frac{k}{2}$$$ of each).You are given an integer $$$k$$$ and a string $$$s$$$ which is composed only of characters 0, 1, and ?. You need to determine whether you can make a $$$k$$$-balanced bitstring by replacing every ? characters in $$$s$$$ with either 0 or 1.A string $$$a$$$ is a substring of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) characters from the beginning and several (possibly, zero or all) characters from the end.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le k \le n \le 3 \cdot 10^5$$$, $$$k$$$ is even)  — the length of the string and the parameter for a balanced bitstring. The next line contains the string $$$s$$$ ($$$|s| = n$$$). It is given that $$$s$$$ consists of only 0, 1, and ?. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$.

For each test case, print YES if we can replace every ? in $$$s$$$ with 0 or 1 such that the resulting bitstring is $$$k$$$-balanced, or NO if it is not possible.

NoteFor the first test case, the string is already a $$$4$$$-balanced bitstring.For the second test case, the string can be transformed into 101.For the fourth test case, the string can be transformed into 0110.For the fifth test case, the string can be transformed into 1100110.

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Control.Applicative
import Data.Int
import Data.Maybe
import Data.List
import Data.Functor
import Data.Bool
import Data.Array.Unboxed as UA
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

readInt64B8 :: B8.ByteString -> Int64
readInt64B8 = fromIntegral . fst . fromJust . B8.readInteger

solve :: Int -> Int -> B8.ByteString -> Bool
solve n k s = fromMaybe False result
    where
        result = do
            convolution <- convolution
            let zerosCount = B8.count '0' convolution
            let onesCount = B8.count '1' convolution
            let delta = k - zerosCount - onesCount
            return $ (abs $ zerosCount - onesCount) <= delta

        convolution = B8.pack <$> foldr (liftA2 (:)) (Just "") collapsedColumns
        collapsedColumns = map collapseColumn stripesColumns

        collapseColumn column
            | ('1' `B8.elem` column) && ('0' `B8.elem` column) = Nothing
            | ('1' `B8.elem` column) = Just '1'
            | ('0' `B8.elem` column) = Just '0'
            | otherwise = Just '?'

        stripesColumns = do
            groupId <- [0 .. k - 1]
            let columns = map (B8.index s) [groupId, groupId + k .. n - 1]
            return $ B8.pack columns

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        [n, k] <- B8.getLine <&> B8.words <&> map readIntB8
        s <- B8.getLine
        let answer = solve n k s
        printf "%s\n" $ ((bool "NO" "YES" answer)::String)

import Data.List

boolToAns :: Bool -> String
boolToAns x = if x then "YES" else "NO"

computeAnswer :: Integer -> String -> Bool
computeAnswer k str
    | any (=='x') firstSubstring = False
    | n0 + n1 + abs (n0-n1) > k = False
    | otherwise = True
  where
    classes :: [String]
    classes =
      map (map fst)
      $ groupBy (\x y -> snd x == snd y)
      $ sortOn (snd)
      $ zip str $ cycle [0..(k-1)]
    firstSubstring :: String
    firstSubstring = map repr classes
    repr :: String -> Char
    repr str
      | any (=='0') str && any (=='1') str = 'x'
      | any (=='1') str = '1'
      | any (=='0') str = '0'
      | otherwise = '?'
    count :: Char -> String -> Integer
    count c = genericLength . filter (==c)
    n0 = count '0' firstSubstring
    n1 = count '1' firstSubstring

answerTestcase :: IO ()
answerTestcase = do
  line1 <- getLine
  line2 <- getLine
  let k = readInt $ words line1 !! 1
  (putStrLn . boolToAns) $ computeAnswer k line2

readInt :: String -> Integer
readInt = read

main = (fmap readInt getLine) >>= (\t -> sequence (genericReplicate t answerTestcase))


There is a straight snowy road, divided into n blocks. The blocks are numbered from 1 to n from left to right. If one moves from the i-th block to the (i + 1)-th block, he will leave a right footprint on the i-th block. Similarly, if one moves from the i-th block to the (i - 1)-th block, he will leave a left footprint on the i-th block. If there already is a footprint on the i-th block, the new footprint will cover the old one.  At the beginning, there were no footprints. Then polar bear Alice starts from the s-th block, makes a sequence of moves and ends in the t-th block. It is known that Alice never moves outside of the road. You are given the description of Alice's footprints. Your task is to find a pair of possible values of s, t by looking at the footprints.

The first line of the input contains integer n (3 ≤ n ≤ 1000). The second line contains the description of the road — the string that consists of n characters. Each character will be either "." (a block without footprint), or "L" (a block with a left footprint), "R" (a block with a right footprint). It's guaranteed that the given string contains at least one character not equal to ".". Also, the first and the last character will always be ".". It's guaranteed that a solution exists.

Print two space-separated integers — the values of s and t. If there are several possible solutions you can print any of them.

NoteThe first test sample is the one in the picture.

main :: IO ()
main = interact $ unwords . map show . solve . (!! 1) . lines

solve :: String -> [Int]
solve s
  | r == 0 = [n + l, n]
  | l == 0 = [n + 1, n + r + 1]
  | otherwise = [n + 1, n + r]
  where
  (nn, t) = span (== '.') s
  (rr, u) = span (== 'R') t
  (ll, _) = span (== 'L') u
  n = length nn
  r = length rr
  l = length ll

import Data.List
main = interact $ (\(a,b) -> (show $ a+1) ++ " " ++ (show $ b+1)) . go . last . lines

go s | ('R'`elem`s) && ('L'`elem`s) = (fnd 'R',fnl 'R')
     | 'R'`elem`s                   = (fnd 'R',(fnl 'R')+1)
     | otherwise                    = (fnl 'L',(fnd 'L')-1)
                                      where lst c = elemIndices c s
                                            fnd   = head . lst
                                            fnl   = last . lst

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate)

solve :: String -> (Int, Int)
solve s
  | not (elem 'L' s)  =  (r1, rm+1)
  | not (elem 'R' s)  =  (lm, l1-1)
  | otherwise  =  (r1, l1-1)
  where
    l1  =  (+1) $ length $ takeWhile (/= 'L') s
    r1  =  (+1) $ length $ takeWhile (/= 'R') s
    lm  =  (+(l1-1)) $ length $ takeWhile (== 'L') $ dropWhile (/= 'L') s
    rm  =  (+(r1-1)) $ length $ takeWhile (== 'R') $ dropWhile (/= 'R') s

main :: IO ()
main  =  do
    getLine
    s  <-  getLine
    let (a, b)  =  solve s
    prints [a, b]

  where
    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

main::IO()
main = do
	num <- getLine
	input <- getLine
	let
		a = zip input [1..(read num)]
		cnt c = length $ filter ( (== c).fst ) a
		first c = foldl (\a b -> if (fst b)==c && a==0 then (snd b) else a) 0 a
		second c = foldl (\a b -> if (fst b)==c then (snd b) else a) 0 a
		(a1,a2) = if cnt 'R' > 0 then (first 'R',second 'R' + if cnt 'L' > 0 then 0 else 1) else (second 'L',(first 'L')-1)
	putStrLn $ (show a1) ++ " " ++ (show a2)

z l=[0,length(filter(=='R')l)-(if any(=='L')l then 1 else 0)]
s l=case span(=='.')l of
  (d,r)->map (+(length d+1))(z r)
main=interact$unwords.map show.s.(!!1).lines

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate)

solve :: String -> (Int, Int)
solve s
  | not (elem 'L' s)  =  (r1, rm)
  | not (elem 'R' s)  =  (lm, l1)
  | otherwise  =  (r1, l1)
  where
    l1  =  (+1) $ length $ takeWhile (/= 'L') s
    r1  =  (+1) $ length $ takeWhile (/= 'R') s
    lm  =  (+(l1-1)) $ length $ takeWhile (== 'L') $ dropWhile (/= 'L') s
    rm  =  (+(r1-1)) $ length $ takeWhile (== 'R') $ dropWhile (/= 'R') s

main :: IO ()
main  =  do
    s  <-  getLine
    let (a, b)  =  solve s
    prints [a, b]

  where
    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

main::IO()
main = do
	num <- getLine
	input <- getLine
	let
		a = zip input [1..(read num)]
		cnt c = length $ filter ( (== c).fst ) a
		first c = foldl (\a b -> if (fst b)==c && a==0 then (snd b) else a) 0 a
		second c = foldl (\a b -> if (fst b)==c then (snd b) else a) 0 a
		(a1,a2) = if cnt 'R' > 0 then (first 'R',second 'R') else (second 'L',(first 'L')-1)
	putStrLn $ (show a1) ++ " " ++ (show a2)

z l=[0,length(filter(=='R')l)-(if any(=='L')l then 1 else 0)]
s l=case span(=='.')l of
  (d,r)->map (+(length d+1))(z r)
main=interact$show.s.(!!1).lines


You are given a pair of integers $$$(a, b)$$$ and an integer $$$x$$$.You can change the pair in two different ways:   set (assign) $$$a := |a - b|$$$;  set (assign) $$$b := |a - b|$$$,  where $$$|a - b|$$$ is the absolute difference between $$$a$$$ and $$$b$$$.The pair $$$(a, b)$$$ is called $$$x$$$-magic if $$$x$$$ is obtainable either as $$$a$$$ or as $$$b$$$ using only the given operations (i.e. the pair $$$(a, b)$$$ is $$$x$$$-magic if $$$a = x$$$ or $$$b = x$$$ after some number of operations applied). You can apply the operations any number of times (even zero).Your task is to find out if the pair $$$(a, b)$$$ is $$$x$$$-magic or not.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The next $$$t$$$ lines describe test cases. The only line of the test case contains three integers $$$a$$$, $$$b$$$ and $$$x$$$ ($$$1 \le a, b, x \le 10^{18}$$$).

For the $$$i$$$-th test case, print YES if the corresponding pair $$$(a, b)$$$ is $$$x$$$-magic and NO otherwise.

main = interact $ unlines . map (f . map read . words) . drop 1 . lines

f [a, b, x]
  | a > b = f [b, a, x]
  | b < x || (a == 0 && b /= x) = "NO"
  | a == 0 || mod (b - x) a == 0 = "YES"
  | otherwise = f [a, mod b a, x]

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [a, b, x] = map read $ words input
        output = if isPairXMagic (a, b) x then "YES" else "NO"

isPairXMagic :: (Integer, Integer) -> Integer -> Bool
isPairXMagic (a, b) x
    | not (a <= b) = isPairXMagic (b, a) x
    | b < x = False
    | a == 0 = b == x
    | (b - x) `mod` a == 0 = True
    | otherwise = isPairXMagic (a, b `mod` a) x

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [a, b, x] = map read $ words input
        output = if isPairXMagic (a, b) x then "YES" else "NO"

isPairXMagic :: (Integer, Integer) -> Integer -> Bool
isPairXMagic (a, b) x
    | not (a <= b) = isPairXMagic (b, a) x
    | b < x = False
    | a == 0 && b /= x = False
    | (b - x) `mod` a == 0 = True
    | otherwise = isPairXMagic (a, b `mod` a) x

{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

recurse :: Integral a => a -> a -> a -> Bool
recurse x a b
  | a<b = recurse x b a
  | x>a || b==0 = False
  | x `mod` b == a `mod` b = True
  | otherwise = recurse x b (a `mod` b)

solve :: IO ()
solve = do
  ~[a,b,x] <- readv
  let ans = recurse x a b
  putStrLn $ if ans then "YES" else "NO"

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x <> DBB.char8 ' ' | x <- xs] <> DBB.char8 '\n'

readv :: IO [Integer]
readv = map (maybe 0 fst . DBC.readInteger) <$> (DBC.words <$> DBC.getLine)

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ (fromIntegral nTc) solve


The first algorithm for detecting a face on the image working in realtime was developed by Paul Viola and Michael Jones in 2001. A part of the algorithm is a procedure that computes Haar features. As part of this task, we consider a simplified model of this concept.Let's consider a rectangular image that is represented with a table of size n × m. The table elements are integers that specify the brightness of each pixel in the image.A feature also is a rectangular table of size n × m. Each cell of a feature is painted black or white.To calculate the value of the given feature at the given image, you must perform the following steps. First the table of the feature is put over the table of the image (without rotations or reflections), thus each pixel is entirely covered with either black or white cell. The value of a feature in the image is the value of W - B, where W is the total brightness of the pixels in the image, covered with white feature cells, and B is the total brightness of the pixels covered with black feature cells.Some examples of the most popular Haar features are given below.   Your task is to determine the number of operations that are required to calculate the feature by using the so-called prefix rectangles.A prefix rectangle is any rectangle on the image, the upper left corner of which coincides with the upper left corner of the image.You have a variable value, whose value is initially zero. In one operation you can count the sum of pixel values at any prefix rectangle, multiply it by any integer and add to variable value.You are given a feature. It is necessary to calculate the minimum number of operations required to calculate the values of this attribute at an arbitrary image. For a better understanding of the statement, read the explanation of the first sample.

The first line contains two space-separated integers n and m (1 ≤ n, m ≤ 100) — the number of rows and columns in the feature. Next n lines contain the description of the feature. Each line consists of m characters, the j-th character of the i-th line equals to "W", if this element of the feature is white and "B" if it is black.

Print a single number — the minimum number of operations that you need to make to calculate the value of the feature.

6 8
BBBBBBBB
BBBBBBBB
BBBBBBBB
WWWWWWWW
WWWWWWWW
WWWWWWWW

NoteThe first sample corresponds to feature B, the one shown in the picture. The value of this feature in an image of size 6 × 8 equals to the difference of the total brightness of the pixels in the lower and upper half of the image. To calculate its value, perform the following two operations:  add the sum of pixels in the prefix rectangle with the lower right corner in the 6-th row and 8-th column with coefficient 1 to the variable value (the rectangle is indicated by a red frame);  add the number of pixels in the prefix rectangle with the lower right corner in the 3-rd row and 8-th column with coefficient  - 2 and variable value.  Thus, all the pixels in the lower three rows of the image will be included with factor 1, and all pixels in the upper three rows of the image will be included with factor 1 - 2 =  - 1, as required.

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

need 'W' = 1
need 'B' = -1

solve l = snd $ foldl f (repeat 0, 0) l where
  f (have, accum) row =
    let next_need = map need row in
    let res = sum $ snd $ mapAccumL (\adds (have, char) ->
              (need char - have, if adds == need char - have then 0 else 1)) 0 (zip have row) in
    (next_need, accum+res)

main = interact $ unlines . return . show . solve . map reverse . reverse . tail . lines

parse :: String -> [[Int]]
parse = map (map weight) . tail . lines
        where weight 'B' =  1
              weight 'W' = -1

diff :: [[Int]] -> [[Int]]
diff = d (zipWith (-)) . map (d (-))
       where d f l = (zipWith f l (tail l)) ++ [last l]

solve :: [[Int]] -> Int
solve = length . filter (/= 0) . concat . diff

main :: IO ()
main = print . solve . parse =<< getContents