Little Susie listens to fairy tales before bed every day. Today's fairy tale was about wood cutters and the little girl immediately started imagining the choppers cutting wood. She imagined the situation that is described below.There are n trees located along the road at points with coordinates x1, x2, ..., xn. Each tree has its height hi. Woodcutters can cut down a tree and fell it to the left or to the right. After that it occupies one of the segments [xi - hi, xi] or [xi;xi + hi]. The tree that is not cut down occupies a single point with coordinate xi. Woodcutters can fell a tree if the segment to be occupied by the fallen tree doesn't contain any occupied point. The woodcutters want to process as many trees as possible, so Susie wonders, what is the maximum number of trees to fell.

The first line contains integer n (1 ≤ n ≤ 105) — the number of trees. Next n lines contain pairs of integers xi, hi (1 ≤ xi, hi ≤ 109) — the coordinate and the height of the і-th tree. The pairs are given in the order of ascending xi. No two trees are located at the point with the same coordinate.

Print a single number — the maximum number of trees that you can cut down by the given rules.

NoteIn the first sample you can fell the trees like that:   fell the 1-st tree to the left — now it occupies segment [ - 1;1]  fell the 2-nd tree to the right — now it occupies segment [2;3]  leave the 3-rd tree — it occupies point 5  leave the 4-th tree — it occupies point 10  fell the 5-th tree to the right — now it occupies segment [19;20] In the second sample you can also fell 4-th tree to the right, after that it will occupy segment [10;19].

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  show `fmap` solve `fmap` replicateM n (liftM2 (,) pin pin)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  pin = fmap (to64 . int) pop
  int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64
solve = (\(_, _, l, r, s) -> max l $ max r s) . foldl' (\(!x', !h', !l', !r', !s') (!x, !h) -> let s = mcon (x > x' + h') r' (max l' s') in (x, h, 1 + mcon (x - h > x' + h') r' (mcon (x - h > x') (max l' s') (-1)), 1 + s, s)) (minBound, 0, 0 :: Int, 0 :: Int, 0 :: Int)

mcon True x = max x
mcon False _ = id

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1@(Tree _ _) t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1
chopLeft t1 _ = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1@(Tree _ _) t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1
chopRight t1 _ = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopped:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Control.Monad
import Data.List
f pos c | x10 > r+h1 = (1 + num,0)
        | x21 >h1 = (1 + num,h1) --right
        | otherwise = (num,0)  -- not
  where (x10,h1,x21) = head pos
        num = fst c
        r = snd c
iterateh' f [] l = l
iterateh' f h l  = iterateh' f (tail h) $!(f h l)
makeTriple h n| n == 2 = []
              | otherwise = (x10,h1,x21):makeTriple t0 (n-1)
  where preA = head h
        t0 = tail h
        a = head t0
        t1 = tail t0
        nextA = head t1
        x1 = fst a
        x0 = fst preA
        x2 = fst nextA
        h1 = snd a
        x10 = x1 - x0
        x21 = x2 - x1
toTup a = ((w !! 0),(w !! 1))
  where w = [read n::Int| n <-(words a)]
doit (a,b,c) (d,e,f) = (a,e,f)
main = do
  w0 <- getLine
  let n= read w0::Int
  w1 <- getContents
  let s = lines w1
  let a = map toTup s
  if n == 1 then print 1 else print $ fst $ iterateh' f (makeTriple a n) (2,0)

main = interact $ show . solve . pairs . map read . tail . words
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []
solve ts = go ([(-10^10,undefined)] ++ ts ++ [(10^10,undefined)]) 0 where
  go [_,_] a = a
  go ((prev,_):ts@((cur,h):ts'@((next,_):_))) a
    | prev < cur-h = go ((cur,undefined) : ts') $! a+1
    | next > cur+h = go ((cur+h,undefined) : ts') $! a+1
    | otherwise = go ts a

import Data.Array

solve [(_, _)] = 1
solve ns = 1 + go lb' rb' 1
  where (lb', rb') = ds ! 1
        end = length ns - 1
        go lb rb n
          | n == end = 1
          | h < lb = 1 + go lb2 rb2 (n+1)
          | h < rb = 1 + go (lb2-h) rb2 (n+1)
          | otherwise = go lb2 rb2 (n+1)
          where h = hs ! n
                (lb2, rb2) = ds ! (n+1)
        hs = listArray (0, end) [h | (_, h) <- ns]
        ds = listArray (0, end-1) ((0,0): twobounds xs)
        xs = [i | (i, _) <- ns]

twobounds xs = zip ys (tail ys)
  where ys = zipWith (-) (tail xs) xs

toTuple [] = []
toTuple (x:xs:xss) = (x, xs) : toTuple xss

main = do
    getLine
    ns <- fmap (toTuple . map read . words) getContents :: IO [(Int, Int)]
    print $ solve ns

import Data.Array

solve [_, _] = 1
solve ns = 1 + go lb' rb' 1
  where (lb', rb') = ds ! 1
        end = l `div` 2 - 1
        l = length ns
        go lb rb n
          | n == end = 1
          | h < lb = 1 + go lb2 rb2 (n+1)
          | h < rb = 1 + go (lb2-h) rb2 (n+1)
          | otherwise = go lb2 rb2 (n+1)
          where h = hs' ! n
                (lb2, rb2) = ds ! (n+1)
        ys = listArray (0, l-1) ns
        (hs, is) = ([ys ! j | j <- [1,3..(l-1)]], [ys ! k | k <- [0,2..(l-2)]])
        hs' = listArray (0, end) hs
        ds = listArray (0, end-1) ((0,0): twobounds is)

twobounds xs = zip ys (tail ys)
  where ys = zipWith (-) (tail xs) xs

toTuple [] = []
toTuple (x:xs:xss) = (x, xs) : toTuple xss

main = do
    getLine
    ns <- fmap (map read . words) getContents :: IO [Int]
    print $ solve ns

{-# LANGUAGE BangPatterns #-}

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

data Tree = Tree {
    coord :: {-# UNPACK #-} !Int
  , height :: {-# UNPACK #-} !Int
  } deriving (Show, Eq)

main :: IO ()
main = do
    n <- fmap read getLine
    trees <- replicateM n $ do
        [x, h] <- map read . words <$> getLine
        return $ Tree x h
    print $ solve trees

solve :: [Tree] -> Int
solve [] = 0
solve [_] = 1
solve (Tree firstPoint _ : rest) = go 1 firstPoint rest
  where
    go !felled _ [_] = felled + 1
    go !felled pointToLeft (Tree x1 h1 : ts@(~(Tree x2 _) : _))
        | x1 - h1 > pointToLeft = go (felled + 1) x1 ts
        | x1 + h1 < x2 = go (felled + 1) (x1 + h1) ts
        | otherwise = go felled x1 ts

import Control.Applicative
import Data.List
import Data.Ord
import Control.Monad
import Debug.Trace

main = do
    n <- read <$> getLine
    xhs <- forM [1..n] $ \_ -> do
        [xi, hi] <- map read . words <$> getLine
        return (xi, hi)
    let st = (\(x, h) -> x-h-1) . head $ xhs
    putStrLn . show $ sol st xhs

sol :: Int -> -- last covering point
       [(Int, Int)] -> -- tree list to consider
       Int
sol _ [(x, h)] = 1
sol lcp ((x, h):xs@((nx, _):_))
    | lcp < x-h = 1 + sol x xs
    | x+h < nx = 1 + sol (x+h) xs
    | otherwise = sol x xs

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1@(Tree _ _) t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1
chopLeft t1 _ = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1@(Tree _ _) t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1
chopRight t1 _ = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopped:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopped:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 t1:ts) False

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 >= (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 <= (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 >= (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 <= (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Control.Applicative
import Data.List
import Data.Ord
import Control.Monad
import Debug.Trace

main = do
    n <- read <$> getLine
    xhs <- forM [1..n] $ \_ -> do
        [xi, hi] <- map read . words <$> getLine
        return (xi, hi)
    let st = (\(x, h) -> x-h-1) . head $ xhs
    putStrLn . show $ sol st xhs

sol :: Int -> -- last covering point
       [(Int, Int)] -> -- tree list to consider
       Int
sol _ [(x, h)] = 1
sol lcp ((x, h):xs@((nx, _):_))
    | lcp < x-h = 1 + sol x xs
    | x+h < nx = 1 + sol (x+h) xs
    | otherwise = sol lcp xs


Yeah, we failed to make up a New Year legend for this problem.A permutation of length $$$n$$$ is an array of $$$n$$$ integers such that every integer from $$$1$$$ to $$$n$$$ appears in it exactly once. An element $$$y$$$ of permutation $$$p$$$ is reachable from element $$$x$$$ if $$$x = y$$$, or $$$p_x = y$$$, or $$$p_{p_x} = y$$$, and so on. The decomposition of a permutation $$$p$$$ is defined as follows: firstly, we have a permutation $$$p$$$, all elements of which are not marked, and an empty list $$$l$$$. Then we do the following: while there is at least one not marked element in $$$p$$$, we find the leftmost such element, list all elements that are reachable from it in the order they appear in $$$p$$$, mark all of these elements, then cyclically shift the list of those elements so that the maximum appears at the first position, and add this list as an element of $$$l$$$. After all elements are marked, $$$l$$$ is the result of this decomposition.For example, if we want to build a decomposition of $$$p = [5, 4, 2, 3, 1, 7, 8, 6]$$$, we do the following:  initially $$$p = [5, 4, 2, 3, 1, 7, 8, 6]$$$ (bold elements are marked), $$$l = []$$$;  the leftmost unmarked element is $$$5$$$; $$$5$$$ and $$$1$$$ are reachable from it, so the list we want to shift is $$$[5, 1]$$$; there is no need to shift it, since maximum is already the first element;  $$$p = [\textbf{5}, 4, 2, 3, \textbf{1}, 7, 8, 6]$$$, $$$l = [[5, 1]]$$$;  the leftmost unmarked element is $$$4$$$, the list of reachable elements is $$$[4, 2, 3]$$$; the maximum is already the first element, so there's no need to shift it;  $$$p = [\textbf{5}, \textbf{4}, \textbf{2}, \textbf{3}, \textbf{1}, 7, 8, 6]$$$, $$$l = [[5, 1], [4, 2, 3]]$$$;  the leftmost unmarked element is $$$7$$$, the list of reachable elements is $$$[7, 8, 6]$$$; we have to shift it, so it becomes $$$[8, 6, 7]$$$;  $$$p = [\textbf{5}, \textbf{4}, \textbf{2}, \textbf{3}, \textbf{1}, \textbf{7}, \textbf{8}, \textbf{6}]$$$, $$$l = [[5, 1], [4, 2, 3], [8, 6, 7]]$$$;  all elements are marked, so $$$[[5, 1], [4, 2, 3], [8, 6, 7]]$$$ is the result. The New Year transformation of a permutation is defined as follows: we build the decomposition of this permutation; then we sort all lists in decomposition in ascending order of the first elements (we don't swap the elements in these lists, only the lists themselves); then we concatenate the lists into one list which becomes a new permutation. For example, the New Year transformation of $$$p = [5, 4, 2, 3, 1, 7, 8, 6]$$$ is built as follows:  the decomposition is $$$[[5, 1], [4, 2, 3], [8, 6, 7]]$$$;  after sorting the decomposition, it becomes $$$[[4, 2, 3], [5, 1], [8, 6, 7]]$$$;  $$$[4, 2, 3, 5, 1, 8, 6, 7]$$$ is the result of the transformation. We call a permutation good if the result of its transformation is the same as the permutation itself. For example, $$$[4, 3, 1, 2, 8, 5, 6, 7]$$$ is a good permutation; and $$$[5, 4, 2, 3, 1, 7, 8, 6]$$$ is bad, since the result of transformation is $$$[4, 2, 3, 5, 1, 8, 6, 7]$$$.Your task is the following: given $$$n$$$ and $$$k$$$, find the $$$k$$$-th (lexicographically) good permutation of length $$$n$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then the test cases follow. Each test case is represented by one line containing two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 50$$$, $$$1 \le k \le 10^{18}$$$).

For each test case, print the answer to it as follows: if the number of good permutations of length $$$n$$$ is less than $$$k$$$, print one integer $$$-1$$$; otherwise, print the $$$k$$$-th good permutation on $$$n$$$ elements (in lexicographical order).

import Data.List
import Control.Monad
maxN = 53::Int

fct :: Int->Integer
fct x = if x <= 1 then 1 else (toInteger x) * (fct $ x - 1)

inter ls = zipWith (*) ls $ map fct $ [-1..(length ls)]

good :: Int->[Integer]
good 0 = [1]
good n = (foldl (+) 0 $ inter ls): ls where ls = good $ n - 1

rec :: [(Int, Int)]->Int->Integer->[Int]
rec [(a, _)] _ _ = [a]
rec ls w k = (fst key) : rec (uno ++ ((elm, snd key) : dos)) (w + 1) (mod k mdl)
 where
  (one, (elm,_):two) = break ((w==) . snd) ls
  mdl = fct ((length ls) - 2)
  key = (one++two) !! (fromIntegral (quot k mdl))
  uno = fl one; dos = fl two
  fl = filter (key/=)

-- This is just a wrapper. The real magic happens in rec.
perm :: Int->Integer->[Int]
perm 1 _ = [1]
perm n k = (n: rec ((1, n) : zip x x) 2 k) where x = [2..(n-1)]

solve :: Int->Integer->[Integer]->[Int]
solve 0 _ _ = []
solve n k (t:tm) = if k >= t then [-1] else
 (perm sz $ quot kl vl)++(map (sz+) $ solve (n - sz) (mod kl vl) (drop (sz - 1) tm))
 where
  (sm,_) = break (k<) $ scanl (+) 0 $ inter tm
  sz = length sm
  kl = k - (last sm)
  vl = tm !! (sz - 1)

fnc n k = solve n k (good n)
caso str = intercalate " " $ map show (solve sn (k - 1) (good sn))
 where
  [n, k] = map (\x->read x::Integer) $ words str
  sn = fromIntegral n

main=do
 fl<-getLine
 let t = read fl::Int
 lsta <- (replicateM t getLine)
 let rsps = map caso lsta
 mapM putStrLn rsps

import Data.List
import Control.Monad
maxN = 53

fct x = if x <= 1 then 1 else (toInteger x) * (fct $ x - 1)

inter ls = zipWith (*) ls $ map fct $ [-1..(length ls)]

good 0 = [1]
good n = (foldl (+) 0 $ inter ls): ls where ls = good $ n - 1

rec [(a, _)] _ _ = [a]
rec ls w k = (fst key) : rec (uno ++ ((elm, snd key) : dos)) (w + 1) (mod k mdl)
 where
  (one, (elm,_):two) = break ((w==) . snd) ls
  mdl = fct ((length ls) - 2)
  key = (one++two) !! (fromIntegral (quot k mdl))
  uno = fl one; dos = fl two
  fl = filter (key/=)

perm 1 _ = [1]
perm n k = (n: rec ((1, n) : zip x x) 2 k) where x = [2..(n-1)]

solve 0 _ _ = []
solve n k (t:tm) = if k >= t then [-1] else
 (perm sz $ quot kl vl)++(map (sz+) $ solve (n - sz) (mod kl vl) (drop (sz - 1) tm))
 where
  (sm,_) = break (k<) $ scanl (+) 0 $ inter tm
  sz = length sm
  kl = k - (last sm)
  vl = tm !! (sz - 1)

caso str = intercalate " " $ map show (solve sn (k - 1) (good sn))
 where
  [n, k] = map (\x->read x::Integer) $ words str
  sn = fromIntegral n

main=do
 fl<-getLine
 let t = read fl::Int
 lsta <- (replicateM t getLine)
 let rsps = map caso lsta
 mapM putStrLn rsps


Because of budget cuts one IT company established new non-financial reward system instead of bonuses.Two kinds of actions are rewarded: fixing critical bugs and suggesting new interesting features. A man who fixed a critical bug gets "I fixed a critical bug" pennant on his table. A man who suggested a new interesting feature gets "I suggested a new feature" pennant on his table.Because of the limited budget of the new reward system only 5 "I fixed a critical bug" pennants and 3 "I suggested a new feature" pennants were bought.In order to use these pennants for a long time they were made challenge ones. When a man fixes a new critical bug one of the earlier awarded "I fixed a critical bug" pennants is passed on to his table. When a man suggests a new interesting feature one of the earlier awarded "I suggested a new feature" pennants is passed on to his table.One man can have several pennants of one type and of course he can have pennants of both types on his table. There are n tables in the IT company. Find the number of ways to place the pennants on these tables given that each pennant is situated on one of the tables and each table is big enough to contain any number of pennants.

The only line of the input contains one integer n (1 ≤ n ≤ 500) — the number of tables in the IT company.

Output one integer — the amount of ways to place the pennants on n tables.

main = getLine >>= print . solve . read

solve :: Integer -> Integer
solve n = (multi_cnk n 5) * (multi_cnk n 3)

multi_cnk n k = cnk (n + k - 1) k

fact n = product [1..n]

cnk n k | k > n = 0
        | otherwise = product [n,n-1..(n - k + 1)] `div` fact k

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

import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    a <- (toInteger.fst.fromJust.C.readInt) <$> C.getLine
    let b = (a+2) * (a+1) `div` 2 * (a) `div` 3
    let c = (a+4) * (a+3) `div` 2 * (a+2) `div` 3 * (a+1) `div`4 *(a)`div`5
    print $ b*c

import Control.Monad
main = do
    a <- liftM read getLine
    putStrLn $ show $ (choose (a+4) (a-1)) * (choose (a+2) (a-1))
choose n k = (product [(n-k+1)..n]) `div` (product [1..k])

import Control.Applicative
import Data.Array

fac = listArray (0,550)  (1:( [product [1..i]| i<-[1..550]]))

c n r = div (fac!n) ((fac!(n-r))*(fac!r))

main= do
	n<- read  <$>getLine::IO Integer
	print $  (  c (n+4) (n-1) )* (c (n+2) (n-1))

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

solve :: Integer -> Integer
solve n = n * (n + 1) * (n + 2) * n * (n + 1) * (n + 2) * (n + 3) * (n + 4) `div` (1 * 2 * 3 * 1 * 2 * 3 * 4 * 5)

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

import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    a <- (toInteger.fst.fromJust.C.readInt) <$> C.getLine
    let b = (a+2) * (a+1) `div` 2 * (a) `div` 3
    let c = (a+4) * (a+3) `div` 2 * (a+2) `div` 3 * (a+1) `div`4 *(a)`div`5
    print $ b+c


You are given an array of integers $$$a_1, a_2, \ldots, a_n$$$ and an integer $$$x$$$.You need to select the maximum number of elements in the array, such that for every subsegment $$$a_l, a_{l + 1}, \ldots, a_r$$$ containing strictly more than one element $$$(l < r)$$$, either:   At least one element on this subsegment is not selected, or  $$$a_l + a_{l+1} + \ldots + a_r \geq x \cdot (r - l + 1)$$$.

The first line of input contains one integer $$$t$$$ ($$$1 \leq t \leq 10$$$): the number of test cases. The descriptions of $$$t$$$ test cases follow, three lines per test case. In the first line you are given one integer $$$n$$$ ($$$1 \leq n \leq 50\,000$$$): the number of integers in the array. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$-100\,000 \leq a_i \leq 100\,000$$$). The third line contains one integer $$$x$$$ ($$$-100\,000 \leq x \leq 100\,000$$$).

For each test case, print one integer: the maximum number of elements that you can select.

NoteIn the first example, one valid way to select the elements is $$$[\underline{1}, 2, \underline{3}, \underline{4}, \underline{5}]$$$. All subsegments satisfy at least one of the criteria. For example, for the subsegment $$$l = 1$$$, $$$r = 2$$$ we have that the element $$$2$$$ is not selected, satisfying the first criterion. For the subsegment $$$l = 3$$$, $$$r = 5$$$ we have $$$3 + 4 + 5 = 12 \ge 2 \cdot 3$$$, satisfying the second criterion.We can't select all elements, because in this case for $$$l = 1$$$, $$$r = 2$$$ all elements are selected and we have $$$a_1 + a_2 = 3 < 2 \cdot 2$$$. Thus, the maximum number of selected elements is $$$4$$$.In the second example, one valid solution is $$$[\underline{2}, \underline{4}, 2, \underline{4}, \underline{2}, \underline{4}, 2, \underline{4}, \underline{2}, \underline{4}]$$$.In the third example, one valid solution is $$$[\underline{-10}, -5, \underline{-10}]$$$.In the fourth example, one valid solution is $$$[\underline{9}, \underline{9}, -3]$$$.

import Control.Monad
import Data.Maybe
import Data.List
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
  output <- fmap mconcat $ replicateM t $ do
    _ <- getInts
    as <- getInts
    [d] <- getInts
    let (u, _, v) = foldl' acc (0, 0, 0) $ map (subtract d) as
        acc (x, m, y) a
          | m + a >= 0 && x > y = (x + 1, min a (m + a), y')
          | otherwise = (y + 1, a, y')
          where y' = max x y
    return $ intDec (max u v) <> charUtf8 '\n'
  hPutBuilder stdout output

{-# 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 Data.Bool
import System.IO hiding (getLine,print)
import Prelude hiding (getLine)
import Data.Char

recurse _ _ _ ans [] = ans
recurse tot isFirst peaktot ans (x:xs)
  | isFirst = recurse (tot+x) False 0 (ans+1) xs
  | tot+x < peaktot = recurse 0 True minBound ans xs
  | otherwise = recurse (tot+x) False (max tot peaktot) (ans+1) xs

solve :: IO ()
solve = do
  ~[n] <- readv
  xs'{-'-} <- readv
  ~[y] <- readv
  let
    xs = subtract y <$> xs'{-'-}
    ans = recurse 0 True minBound 0 xs
  printv [ans]

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

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

getLine :: IO [Char]
getLine = DL.dropWhileEnd isSpace . DBC.unpack <$> DBC.getLine

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

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

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

data S = S !Int !Int !Int !Int

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    ~[x] <- getInts 1
    let
      step :: S -> Int -> S
      step (S p2 p1 wait count) v = let
        oof2 = v + p1      < x + x     && wait >= 2
        oof3 = v + p1 + p2 < x + x + x && wait >= 3
        in  if  oof2 || oof3
        then  S p1 v 1 (count + 1)
        else  S p1 v (wait + 1) count
      S _ _ _ toSkip = foldl' step (S 0 0 1 0) a
    pure $ putInts [n - toSkip]

type SP = State [P.ByteString]

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

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

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

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


We have a point $$$A$$$ with coordinate $$$x = n$$$ on $$$OX$$$-axis. We'd like to find an integer point $$$B$$$ (also on $$$OX$$$-axis), such that the absolute difference between the distance from $$$O$$$ to $$$B$$$ and the distance from $$$A$$$ to $$$B$$$ is equal to $$$k$$$.  The description of the first test case. Since sometimes it's impossible to find such point $$$B$$$, we can, in one step, increase or decrease the coordinate of $$$A$$$ by $$$1$$$. What is the minimum number of steps we should do to make such point $$$B$$$ exist?

The first line contains one integer $$$t$$$ ($$$1 \le t \le 6000$$$) — the number of test cases. The only line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$0 \le n, k \le 10^6$$$) — the initial position of point $$$A$$$ and desirable absolute difference.

For each test case, print the minimum number of steps to make point $$$B$$$ exist.

NoteIn the first test case (picture above), if we set the coordinate of $$$B$$$ as $$$2$$$ then the absolute difference will be equal to $$$|(2 - 0) - (4 - 2)| = 0$$$ and we don't have to move $$$A$$$. So the answer is $$$0$$$.In the second test case, we can increase the coordinate of $$$A$$$ by $$$3$$$ and set the coordinate of $$$B$$$ as $$$0$$$ or $$$8$$$. The absolute difference will be equal to $$$|8 - 0| = 8$$$, so the answer is $$$3$$$.

import Control.Monad

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, k] <- map read . words <$> getLine
    if n >= k then
      if even (n - k) then
        putStrLn "0"
      else
        putStrLn "1"
    else
      putStrLn $ show (k - n)

module Main where

    solve :: IO ()
    solve = do
        s <- getLine
        let [n, k] = map (\x -> read x :: Integer) $ words s
        print $ if n < k then
            k - n
        else
            (n - k) `mod` 2

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

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

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> Int
solve (x:xs)
    | n == k = 0
    | n < k = k - n
    | otherwise = mod (n-k) 2
    where
        n = x
        k = head xs

deal :: IO()
deal = do
    x <- map read . words <$> getLine
    putStrLn $ show $ solve x

main :: IO()
main = getLine >>= flip replicateM_ deal . read

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

testCase :: IO a -> IO ()
testCase f = do
  t <- read <$> getLine
  replicateM_ t f

main = testCase $ do
  [a, b] <- map read . words <$> getLine
  print $ if a >= b then (a - b) `mod` 2 else b - a

import Control.Monad (replicateM_)

solve :: Int -> Int -> Int
solve n k
  | n < k       = k - n
  | even (n-k)  = 0
  | otherwise   = 1

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

module Main where

import Control.Monad

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, k] <- fmap read . words <$> getLine
    print $ solve n k

solve :: Int -> Int -> Int
solve a k
  | k > abs a = abs $ k - abs a
  | a `mod` 2 /= k `mod` 2 = 1
  | otherwise = 0

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> Int
solve (x:xs)
    | a == b = 0
    | b == 0 = mod a 2
    | otherwise = abs (a-b)
    where
        a = x
        b = head xs

deal :: IO()
deal = do
    x <- map read . words <$> getLine
    putStrLn $ show $ solve x

main :: IO()
main = getLine >>= flip replicateM_ deal . read


Mishka got an integer array $$$a$$$ of length $$$n$$$ as a birthday present (what a surprise!).Mishka doesn't like this present and wants to change it somehow. He has invented an algorithm and called it "Mishka's Adjacent Replacements Algorithm". This algorithm can be represented as a sequence of steps:  Replace each occurrence of $$$1$$$ in the array $$$a$$$ with $$$2$$$;  Replace each occurrence of $$$2$$$ in the array $$$a$$$ with $$$1$$$;  Replace each occurrence of $$$3$$$ in the array $$$a$$$ with $$$4$$$;  Replace each occurrence of $$$4$$$ in the array $$$a$$$ with $$$3$$$;  Replace each occurrence of $$$5$$$ in the array $$$a$$$ with $$$6$$$;  Replace each occurrence of $$$6$$$ in the array $$$a$$$ with $$$5$$$;  $$$\dots$$$  Replace each occurrence of $$$10^9 - 1$$$ in the array $$$a$$$ with $$$10^9$$$;  Replace each occurrence of $$$10^9$$$ in the array $$$a$$$ with $$$10^9 - 1$$$. Note that the dots in the middle of this algorithm mean that Mishka applies these replacements for each pair of adjacent integers ($$$2i - 1, 2i$$$) for each $$$i \in\{1, 2, \ldots, 5 \cdot 10^8\}$$$ as described above.For example, for the array $$$a = [1, 2, 4, 5, 10]$$$, the following sequence of arrays represents the algorithm: $$$[1, 2, 4, 5, 10]$$$ $$$\rightarrow$$$ (replace all occurrences of $$$1$$$ with $$$2$$$) $$$\rightarrow$$$ $$$[2, 2, 4, 5, 10]$$$ $$$\rightarrow$$$ (replace all occurrences of $$$2$$$ with $$$1$$$) $$$\rightarrow$$$ $$$[1, 1, 4, 5, 10]$$$ $$$\rightarrow$$$ (replace all occurrences of $$$3$$$ with $$$4$$$) $$$\rightarrow$$$ $$$[1, 1, 4, 5, 10]$$$ $$$\rightarrow$$$ (replace all occurrences of $$$4$$$ with $$$3$$$) $$$\rightarrow$$$ $$$[1, 1, 3, 5, 10]$$$ $$$\rightarrow$$$ (replace all occurrences of $$$5$$$ with $$$6$$$) $$$\rightarrow$$$ $$$[1, 1, 3, 6, 10]$$$ $$$\rightarrow$$$ (replace all occurrences of $$$6$$$ with $$$5$$$) $$$\rightarrow$$$ $$$[1, 1, 3, 5, 10]$$$ $$$\rightarrow$$$ $$$\dots$$$ $$$\rightarrow$$$ $$$[1, 1, 3, 5, 10]$$$ $$$\rightarrow$$$ (replace all occurrences of $$$10$$$ with $$$9$$$) $$$\rightarrow$$$ $$$[1, 1, 3, 5, 9]$$$. The later steps of the algorithm do not change the array.Mishka is very lazy and he doesn't want to apply these changes by himself. But he is very interested in their result. Help him find it.

The first line of the input contains one integer number $$$n$$$ ($$$1 \le n \le 1000$$$) — the number of elements in Mishka's birthday present (surprisingly, an array). The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the elements of the array.

Print $$$n$$$ integers — $$$b_1, b_2, \dots, b_n$$$, where $$$b_i$$$ is the final value of the $$$i$$$-th element of the array after applying "Mishka's Adjacent Replacements Algorithm" to the array $$$a$$$. Note that you cannot change the order of elements in the array.

NoteThe first example is described in the problem statement.

module Main (main) where

--ghc 7.10

main :: IO ()
main = getLine >> getInts >>= (out . solve)

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

out :: [Int] -> IO ()
out = putStrLn . seri

solve :: [Int] -> [Int]
solve = map chng

chng :: Int -> Int
chng n = if even n then pred n else n

seri :: [Int] -> String
seri = unwords . map show

f::Integer->String
f x
  |x `mod` 2==0 =show (x-1)
  |otherwise =show x

main = do
       e<-getLine
       e2<-getLine
       let xs=map read (words e2)::[Integer]
       putStrLn $ unwords $  map f xs

import Control.Monad

main = readInput >>= putStrLn . calc

readInput :: IO [String]
readInput = liftM2 getSnd getLine getLine
  where getSnd _ a = words a

calc :: [String] -> String
calc ns = foldr go "" ns
  where go numStr ans = " " ++ (show final) ++ ans
          where num = read numStr
                final = if num `rem` 2 == 0 then num - 1
        		        else num

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')
import Data.Bits

readInt :: String -> Int
readInt = Prelude.read

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

solve :: [Int] -> [Int]
solve = map (\x -> x - ((x + 1) .&. 1))

main :: IO ()
main = do
    n <- readInt <$> getLine
    arr <- (map readInt . words) <$> getLine
    let answer = solve arr
    forM_ answer $ printf "%d "
    printf "\n"

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve :: String -> String
solve =
    let mapper x
          | x `mod` 2 == 0 = x-1
          | otherwise = x
    in intercalate " " . map show . map mapper . tail . map fastRead . words

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
    let as_numbers = map fastRead $ words input
        n:xs = as_numbers
        answer = map mapper xs
        mapper x
          | x `mod` 2 == 0 = x-1
          | otherwise = x
    in intercalate " " . map show $ answer

import Control.Applicative
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C

process a | even a  = a-1
          | otherwise = a

main::IO ()
main=do
   getLine
   x <-  (map (fromIntegral.fst.fromJust.C.readInteger)) <$>     C.words <$> C.getLine::IO [Int]
   putStrLn $ intercalate " " $ map show $  map process x

import Data.Bits
main = interact $ unwords . map (show . succ . ((.&.) (complement 1 :: Int)) . pred . read) . tail . words

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

main= do
		a<- read <$> getLine ::IO Int
		b<- map read <$> words <$> getLine ::IO [Int]
		putStrLn $ intercalate " " $ map show $  map (\z-> if even z then z-1 else z) b

--ghc 7.10

adjReplacement :: (Integral a) => [a] -> [a]
adjReplacement = map (\x -> if even x then x-1 else x)

main = do
    line1 <- getLine
    line2 <- getLine
    let a = map read . words $ line2 :: [Int]
    putStrLn . unwords . map show . adjReplacement $ a

import Data.ByteString as BS (ByteString)
import qualified Data.ByteString.Char8 as C
import Control.Monad

readInts :: ByteString -> [Int]
readInts bs = map (\bsWord -> let Just (int, _) = C.readInt bsWord in int) $ C.words bs

main :: IO ()
main = do
  _ <- getLine
  bs <- C.getContents
  let array = readInts bs
  forM_ array (\el ->
                  if el `mod` 2 == 0
                  then putStr $ show (el - 1) ++ " "
                  else putStr $ show el ++ " ")

import Data.List
import qualified Data.ByteString as B8

main = do
        _ <- getLine
        xstr <- getLine
        let xs =  map read $ words xstr :: [Int]
        putStrLn . unwords $ map (\x -> show $ if odd x then x else x - 1) xs

rule n
  | n `mod` 2 == 1 = n
  | otherwise      = n - 1

main = do
  trash <- getLine
  input <- getLine
  doOutput $ map (rule . read) $ words input

doOutput (x : []) = putStr $ show x
doOutput (x : xs) = (putStr $ show x ++ " ") >> doOutput xs

{-# LANGUAGE TypeApplications #-}
import Data.Bits
main = interact $ unwords . map (show . (xor @Int 1) . read) . tail . words

import Data.Bits
main = interact $ unwords . map (show . ((.&.) (complement 1 :: Int)) . read) . tail . words


Vasya goes to visit his classmate Petya. Vasya knows that Petya's apartment number is $$$n$$$. There is only one entrance in Petya's house and the distribution of apartments is the following: the first floor contains $$$2$$$ apartments, every other floor contains $$$x$$$ apartments each. Apartments are numbered starting from one, from the first floor. I.e. apartments on the first floor have numbers $$$1$$$ and $$$2$$$, apartments on the second floor have numbers from $$$3$$$ to $$$(x + 2)$$$, apartments on the third floor have numbers from $$$(x + 3)$$$ to $$$(2 \cdot x + 2)$$$, and so on.Your task is to find the number of floor on which Petya lives. Assume that the house is always high enough to fit at least $$$n$$$ apartments.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of the test case contains two integers $$$n$$$ and $$$x$$$ ($$$1 \le n, x \le 1000$$$) — the number of Petya's apartment and the number of apartments on each floor of the house except the first one (there are two apartments on the first floor).

For each test case, print the answer: the number of floor on which Petya lives.

NoteConsider the first test case of the example: the first floor contains apartments with numbers $$$1$$$ and $$$2$$$, the second one contains apartments with numbers $$$3$$$, $$$4$$$ and $$$5$$$, the third one contains apartments with numbers $$$6$$$, $$$7$$$ and $$$8$$$. Therefore, Petya lives on the third floor.In the second test case of the example, Petya lives in the apartment $$$1$$$ which is on the first floor.

solve :: Int -> Int -> Int
solve n x = if (n < 3) then 1 else div (n - 3) x + 2

queries :: Int -> IO ()
queries 0 = return ()
queries t = do
    line <- getLine
    let list = words line
    let n = read (head list) :: Int
    let x = read (head (tail list)) :: Int
    let ans = solve n x
    putStrLn ((show ans) :: String)
    queries (t - 1)

main = do
    t1 <- getLine
    let t = read t1 :: Int
    queries t

import Control.Arrow ( (>>>) )

main :: IO ()
main = interact $
  lines >>> drop 1
  >>> map (words >>> map read >>> solve >>> show)
  >>> unlines

solve :: [Int] -> Int
solve [n, x]
  | n <= 2 = 1
  | otherwise = 2 + div (n - 3) x

test :: String -> String
test s =
    let (n:x:[]) = map read $ words s :: [Int] in
    if n <= 2 then
        "1\n"
    else
        (show $ 2 + (n - 3) `div` x) ++ "\n"

solve :: String -> String
solve s =
    let ans = map test $ lines s in
    foldr1 (++) ans

main = do
    n <- getLine
    interact solve

import Control.Monad
import Data.Char

getList :: (Read t) => IO [t]
getList = getLine >>= return . (map read) . words

getOne :: (Read t) => IO t
getOne = getLine >>= return . read

main :: IO ()
main = do
  t <- getOne
  -- let t = 1
  replicateM_ t solve

solve :: IO ()
solve = do
  [n, x] <- getList
  print $ countAns n x

countAns :: Integral t => t -> t -> t
countAns n x
  | n <= 2 = 1
  | otherwise = ((n - 3) `div` x) + 2

calc :: Int -> Int -> Int
calc n x
    | n `mod` x == 0 = n `div` x
    | otherwise = n `div` x + 1

solve :: String -> String
solve str
    | n <= 2 = show 1
    | otherwise = show $ calc (n-2) x + 1
    where xs = map read $ words str
          n = head xs
          x = last xs

main = interact $ unlines . map solve . tail . lines

getResult :: [Int] -> Int
getResult a | head a == 1 = 1
            | otherwise = (div ((head a) - 3) (last a)) + 2

convertList :: [String] -> [Int]
convertList [] = []
convertList a = [read (head a) :: Int] ++ convertList (tail a)

solveb :: String -> Int
solveb nString = getResult (convertList (words nString));

solve :: Int -> IO ()
solve 0 = do
     putStr ""
solve t = do
    nString <- getLine
    putStrLn ((show (solveb nString)) :: String)
    solve (t - 1)

main = do
    teste <- getLine
    let t = read teste :: Int
    solve t
    putStr ""

import Data.List

readInt = fmap (\x -> read x :: Int) getLine

convertLine :: Read a => String -> [a]
convertLine = map read . words
-- readInt

main :: IO ()
main = do
    let multipleTests = True

    if multipleTests then do
        line <- getLine
        let [t] = convertLine line
        mapM_ solveAndPrint [1..t]
    else do
        let t = 1
        mapM_ solveAndPrint [1..t]

-- Aici citeste datele si paseaza-le catre solve
solveAndPrint :: Int -> IO ()
solveAndPrint _ = do
    line <- getLine
    -- putStrLn line
    let [n, x] = convertLine line :: [Int]
    putStrLn $ show $ findFloor n x

findFloor :: Int -> Int -> Int
findFloor n x
    | n <= 2 = 1
    | otherwise = (n - 3) `div` x + 2

module Main where

import Control.Monad (replicateM_)

-- n -> x -> floor_number
findFloorNumber :: Int -> Int -> Int
findFloorNumber n x | n <= 2    = 1
                    | otherwise = ((n - 3) `div` x) + 2

readCaseInput :: IO (Int, Int)
readCaseInput = do
    numbers <- words <$> getLine
    let n = read (head numbers) :: Int
    let x = read (last numbers) :: Int
    pure (n, x)

solveCase :: IO ()
solveCase = do
    (n, x) <- readCaseInput
    let solution = findFloorNumber n x
    print solution

readT :: IO Int
readT = do
    line <- getLine
    pure (read line :: Int)

main :: IO ()
main = do
    t <- readT
    replicateM_ t solveCase

-- vim: set ts=4 expandtab sw=4:

import Control.Monad

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, x] <- map read . words <$> getLine
    print $ if  n <= 2
      then  1 :: Int
      else  1 + ceilDiv (n - 2) x

{-# LANGUAGE TypeApplications #-}

main :: IO ()
main = do
  getLine -- discard
  input <- map ((\[x, y] -> (x, y)) . map (read @Int) . words) . lines <$> getContents
  mapM_ (print . uncurry f) input

f :: Int -> Int -> Int
f target step = case step of
                  1 -> max (target - 1) 1
                  _ -> ((target - 3) `div` step) + 2

import Data.List
import Control.Monad
import Data.Maybe

readNumber :: IO Int
readNumber = fmap read getLine

readPair :: IO (Int, Int)
readPair = fmap (unpackList . map read . words) getLine
  where unpackList list = (head list, last list)

doStuff :: Int -> IO Int
doStuff _ = do
  (n, x) <- readPair
  pure $ f n x

checkCondition :: Int -> Int -> Int -> Bool
checkCondition n x floorNumber =
  (n >= (floorNumber - 2) * x + 3) && (n <= (floorNumber - 1) * x + 2)

f :: Int -> Int -> Int
f n x
  | n < 3 = 1
  | otherwise = fromJust $ find (checkCondition n x) [2..]

main = do
  n <- readNumber
  results <- forM [1..n] doStuff
  forM_ results (putStrLn . show)

solve :: Int -> Int -> Int
solve n x =  (quot (n - 2)  x) + 1

queries :: Int -> IO ()
queries 0 = return ()
queries t = do
    line <- getLine
    let list = words line
    let n = read (head list) :: Int
    let x = read (head (tail list)) :: Int
    let ans = solve n x
    putStrLn ((show ans) :: String)
    queries (t - 1)

main = do
    t1 <- getLine
    let t = read t1 :: Int
    queries t

solve :: Int -> Int -> Int
solve n x = 0

queries :: Int -> IO ()
queries 0 = return ()
queries t = do
    line <- getLine
    let list = words line
    let n = read (head list) :: Int
    let x = read (head (tail list)) :: Int
    let ans = solve n x
    putStrLn ((show ans) :: String)
    queries (t - 1)

main = do
    t1 <- getLine
    let t = read t1 :: Int
    queries t

getResult :: [Int] -> Int
getResult a = (div ((head a) - 3) (last a)) + 2

convertList :: [String] -> [Int]
convertList [] = []
convertList a = [read (head a) :: Int] ++ convertList (tail a)

solveb :: String -> Int
solveb nString = getResult (convertList (words nString));

solve :: Int -> IO ()
solve 0 = do
     putStr ""
solve t = do
    nString <- getLine
    putStrLn ((show (solveb nString)) :: String)
    solve (t - 1)

main = do
    teste <- getLine
    let t = read teste :: Int
    solve t
    putStr ""

getResult :: [Int] -> Int
getResult a | head a == 1 = 0
            | otherwise = (div ((head a) - 3) (last a)) + 2

convertList :: [String] -> [Int]
convertList [] = []
convertList a = [read (head a) :: Int] ++ convertList (tail a)

solveb :: String -> Int
solveb nString = getResult (convertList (words nString));

solve :: Int -> IO ()
solve 0 = do
     putStr ""
solve t = do
    nString <- getLine
    putStrLn ((show (solveb nString)) :: String)
    solve (t - 1)

main = do
    teste <- getLine
    let t = read teste :: Int
    solve t
    putStr ""

{-# LANGUAGE TypeApplications #-}

main :: IO ()
main = do
  getLine -- discard
  input <- map ((\[x, y] -> (x, y)) . map (read @Int) . words) . lines <$> getContents
  mapM_ (print . uncurry f) input

f :: Int -> Int -> Int
f target step = ((target - 3) `div` step) + 2


DLS and JLS are bored with a Math lesson. In order to entertain themselves, DLS took a sheet of paper and drew $$$n$$$ distinct lines, given by equations $$$y = x + p_i$$$ for some distinct $$$p_1, p_2, \ldots, p_n$$$.Then JLS drew on the same paper sheet $$$m$$$ distinct lines given by equations $$$y = -x + q_i$$$ for some distinct $$$q_1, q_2, \ldots, q_m$$$.DLS and JLS are interested in counting how many line pairs have integer intersection points, i.e. points with both coordinates that are integers. Unfortunately, the lesson will end up soon, so DLS and JLS are asking for your help.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$), the number of test cases in the input. Then follow the test case descriptions. The first line of a test case contains an integer $$$n$$$ ($$$1 \le n \le 10^5$$$), the number of lines drawn by DLS. The second line of a test case contains $$$n$$$ distinct integers $$$p_i$$$ ($$$0 \le p_i \le 10^9$$$) describing the lines drawn by DLS. The integer $$$p_i$$$ describes a line given by the equation $$$y = x + p_i$$$. The third line of a test case contains an integer $$$m$$$ ($$$1 \le m \le 10^5$$$), the number of lines drawn by JLS. The fourth line of a test case contains $$$m$$$ distinct integers $$$q_i$$$ ($$$0 \le q_i \le 10^9$$$) describing the lines drawn by JLS. The integer $$$q_i$$$ describes a line given by the equation $$$y = -x + q_i$$$. The sum of the values of $$$n$$$ over all test cases in the input does not exceed $$$10^5$$$. Similarly, the sum of the values of $$$m$$$ over all test cases in the input does not exceed $$$10^5$$$. In hacks it is allowed to use only one test case in the input, so $$$t=1$$$ should be satisfied.

For each test case in the input print a single integer — the number of line pairs with integer intersection points.

NoteThe picture shows the lines from the first test case of the example. Black circles denote intersection points with integer coordinates.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

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

solve = do
	n <- readInteger
	ps <- readInts
	m <- readInteger
	qs <- readInts
	let
		odd1 :: Integer = fromIntegral $ length $ filter odd ps
		even1 = n - odd1
		odd2 :: Integer = fromIntegral $ length $ filter odd qs
		even2 = m - odd2
	return $ odd1 * odd2 + even1 * even2

import Control.Monad
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    _ <- getLine
    as <- (map read.words) <$> getLine
    _ <- getLine
    bs <- (map read.words) <$> getLine
    print $ solve as bs

solve :: [Integer] -> [Integer] -> Integer
solve as bs = a1*b1+a2*b2
  where
      count (e,o) x = if even x
        then (e+1,o)
        else (e,o+1)
      (a1,a2) = foldl count (0,0) as
      (b1,b2) = foldl count (0,0) bs

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}
#ifndef DEBUG
{-# LANGUAGE Safe              #-}
#endif

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.State.Strict
import qualified Data.Array                 as A
import qualified Data.Array.Unboxed         as UA
import qualified Data.Array.ST.Safe         as MA
import           Data.Bool
import qualified Data.ByteString.Builder    as B
import qualified Data.ByteString.Char8      as C
import           Data.Char
import           Data.Function
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import qualified Data.List                  as L
import qualified Data.List.NonEmpty         as NL
import           Data.Monoid
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup
import qualified Data.Set                   as S
import           Data.Tuple
import           Foreign
import qualified System.IO                  as IO
#ifdef DEBUG
import           Debug.Trace
#endif

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
      n <- readLn
      ps <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
      m <- readLn
      qs <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
      print $ solve n ps m qs
      IO.hFlush IO.stdout

solve :: Int -> [Int] -> Int -> [Int] -> Int64
solve n xs m ys = fromIntegral xsEven * fromIntegral ysEven + fromIntegral xsOdd * fromIntegral ysOdd
  where
    p x = x .&. 1 == 0
    !xsEven = length $ filter p xs
    !xsOdd = n - xsEven
    !ysEven = length $ filter p ys
    !ysOdd = m - ysEven

import           Control.Monad
readInt = read :: String -> Int
readInteger = read :: String -> Integer

folder :: (Integer, Integer) -> Integer -> (Integer, Integer)
folder (o, z) 1 = (o+1, z)
folder (o, z) 0 = (o, z+1)

main :: IO ()
main = do
  t <- readInt <$> getLine
  replicateM_ t $ do
    n <- readInt <$> getLine
    ps <- map readInteger . words <$> getLine
    m <- readInt <$> getLine
    qs <- map readInteger . words <$> getLine
    print $ (\(os,zs) -> product os + product zs) . unzip . map ( foldl folder (0,0) . map (`mod`2) ) $ [ps, qs]

import Control.Monad
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    _ <- getLine
    as <- (map read.words) <$> getLine
    _ <- getLine
    bs <- (map read.words) <$> getLine
    print $ solve as bs

solve :: [Int] -> [Int] -> Int
solve as bs = a1*b1+a2*b2
  where
      count (e,o) x = if even x
        then (e+1,o)
        else (e,o+1)
      (a1,a2) = foldl count (0,0) as
      (b1,b2) = foldl count (0,0) bs

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}
#ifndef DEBUG
{-# LANGUAGE Safe              #-}
#endif

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.State.Strict
import qualified Data.Array                 as A
import qualified Data.Array.Unboxed         as UA
import qualified Data.Array.ST.Safe         as MA
import           Data.Bool
import qualified Data.ByteString.Builder    as B
import qualified Data.ByteString.Char8      as C
import           Data.Char
import           Data.Function
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import qualified Data.List                  as L
import qualified Data.List.NonEmpty         as NL
import           Data.Monoid
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup
import qualified Data.Set                   as S
import           Data.Tuple
import           Foreign
import qualified System.IO                  as IO
#ifdef DEBUG
import           Debug.Trace
#endif

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
      n <- readLn
      ps <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
      m <- readLn
      qs <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
      print $ solve n ps m qs
      IO.hFlush IO.stdout

solve :: Int -> [Int] -> Int -> [Int] -> Int
solve n xs m ys = xsEven * ysEven + xsOdd * ysOdd
  where
    p x = x .&. 1 == 0
    !xsEven = length $ filter p xs
    !xsOdd = n - xsEven
    !ysEven = length $ filter p ys
    !ysOdd = m - ysEven

import           Control.Monad

readInt = read :: String -> Int

folder :: (Int, Int) -> Int -> (Int, Int)
folder (o, z) 1 = (o+1, z)
folder (o, z) 0 = (o, z+1)

main :: IO ()
main = do
  t <- readInt <$> getLine
  replicateM_ t $ do
    n <- readInt <$> getLine
    ps <- map readInt . words <$> getLine
    m <- readInt <$> getLine
    qs <- map readInt . words <$> getLine
    print $ (\(os,zs) -> product os + product zs) . unzip . map ( foldl folder (0,0) . map (`mod`2) ) $ [ps, qs]


You are given an array of positive integers $$$a = [a_0, a_1, \dots, a_{n - 1}]$$$ ($$$n \ge 2$$$).In one step, the array $$$a$$$ is replaced with another array of length $$$n$$$, in which each element is the greatest common divisor (GCD) of two neighboring elements (the element itself and its right neighbor; consider that the right neighbor of the $$$(n - 1)$$$-th element is the $$$0$$$-th element).Formally speaking, a new array $$$b = [b_0, b_1, \dots, b_{n - 1}]$$$ is being built from array $$$a = [a_0, a_1, \dots, a_{n - 1}]$$$ such that $$$b_i$$$ $$$= \gcd(a_i, a_{(i + 1) \mod n})$$$, where $$$\gcd(x, y)$$$ is the greatest common divisor of $$$x$$$ and $$$y$$$, and $$$x \mod y$$$ is the remainder of $$$x$$$ dividing by $$$y$$$. In one step the array $$$b$$$ is built and then the array $$$a$$$ is replaced with $$$b$$$ (that is, the assignment $$$a$$$ := $$$b$$$ is taking place).For example, if $$$a = [16, 24, 10, 5]$$$ then $$$b = [\gcd(16, 24)$$$, $$$\gcd(24, 10)$$$, $$$\gcd(10, 5)$$$, $$$\gcd(5, 16)]$$$ $$$= [8, 2, 5, 1]$$$. Thus, after one step the array $$$a = [16, 24, 10, 5]$$$ will be equal to $$$[8, 2, 5, 1]$$$.For a given array $$$a$$$, find the minimum number of steps after which all values $$$a_i$$$ become equal (that is, $$$a_0 = a_1 = \dots = a_{n - 1}$$$). If the original array $$$a$$$ consists of identical elements then consider the number of steps is equal to $$$0$$$.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. Each test case contains two lines. The first line contains an integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — length of the sequence $$$a$$$. The second line contains $$$n$$$ integers $$$a_0, a_1, \dots, a_{n - 1}$$$ ($$$1 \le a_i \le 10^6$$$). It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^5$$$.

Print $$$t$$$ numbers — answers for each test case.

data Stree = Node Int Stree Stree | Leaf
  deriving Show

getStreeVal:: Stree -> Int
getStreeVal Leaf = 0
getStreeVal (Node x _ _) = x

buildStree:: [Int] -> Stree
buildStree [] = Leaf
buildStree [x] = Node x Leaf Leaf
buildStree x = Node (gcd l r) lS rS
               where len = 1 + length x
                     mi = len `div` 2
                     (lx, rx) = splitAt (mi) x
                     lS = buildStree lx
                     rS = buildStree rx
                     l = getStreeVal lS
                     r = getStreeVal rS

fStree:: Int -> Int -> Int -> Int -> Stree -> Int
fStree _ _ _ _ Leaf = 0
fStree l r lx rx (Node x lN rN)
 | lx <= l && r <= rx = x
 | r < lx || rx < l = 0
 | True = gcd (fStree l mi lx rx lN) (fStree (mi + 1) r lx rx rN)
   where mi = (l + r) `div` 2

allSame:: (Eq a) => [a] -> Bool
allSame (x:y:xs) = if x == y then allSame (y:xs) else False
allSame _ = True

binS:: Int -> Int -> Int -> Stree -> Int
binS lo hi n sG
 | lo > hi = -1
 | lo == hi = lo
 | True = if allSame [ fStree 0 (2 * n - 1) i (i + mi) sG | i <- [0..(n - 1)]]
          then binS lo mi n sG
          else binS (mi + 1) hi n sG
   where mi = (lo + hi) `div` 2

solve:: Int -> IO()
solve 0 = return ()
solve nn = do ns <- getLine
              as <- getLine
              let n = read ns::Int
              let a = map (\x -> read x::Int) (words as)
              let sG = buildStree (a ++ a)

              print (binS 0 n n sG)
              solve (nn - 1)

main:: IO()
main = do i <- getLine
          solve (read i::Int)


Innokentiy decides to change the password in the social net "Contact!", but he is too lazy to invent a new password by himself. That is why he needs your help. Innokentiy decides that new password should satisfy the following conditions:  the length of the password must be equal to n,  the password should consist only of lowercase Latin letters,  the number of distinct symbols in the password must be equal to k,  any two consecutive symbols in the password must be distinct. Your task is to help Innokentiy and to invent a new password which will satisfy all given conditions.

The first line contains two positive integers n and k (2 ≤ n ≤ 100, 2 ≤ k ≤ min(n, 26)) — the length of the password and the number of distinct symbols in it.  Pay attention that a desired new password always exists.

Print any password which satisfies all conditions given by Innokentiy.

NoteIn the first test there is one of the appropriate new passwords — java, because its length is equal to 4 and 3 distinct lowercase letters a, j and v are used in it.In the second test there is one of the appropriate new passwords — python, because its length is equal to 6 and it consists of 6 distinct lowercase letters.In the third test there is one of the appropriate new passwords — phphp, because its length is equal to 5 and 2 distinct lowercase letters p and h are used in it.Pay attention the condition that no two identical symbols are consecutive is correct for all appropriate passwords in tests.

import Control.Applicative
import Control.Monad

solve :: [Int] -> String
solve [n, k] = take n $ concat $ repeat $ take k ['a'..'z']

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

module Main where

import Data.Char

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

letters = filter isLower [minBound..maxBound]

main = do
    [n, k] <- readInts
    putStrLn $ (($) concat (replicate (n `div` k) $ take k letters)) ++ (take (n `mod` k) letters)

import Data.List.Split

main = do
  xs <- fmap (splitOn " ") getLine
  let n = read $ head xs
      k = read $ last xs
      in putStrLn $ take n $ concat $ repeat $ take k ['a'..'z']

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

s="abcdefghijklmnopqrstuvwxyz"

main = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		putStrLn  $ take a $ cycle $ take b s

module Main where

import Data.Char

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

letters = filter isLower [minBound..maxBound]

main = do
    [n, k] <- readInts
    print $ (($) concat (replicate (n `div` k) $ take k letters)) ++ (take (n `mod` k) letters)

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

s="abcdefghijklmnopqrstuvwxyz"

main = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		print $ take a $ cycle $ take b s


HDD hard drives group data by sectors. All files are split to fragments and each of them are written in some sector of hard drive. Note the fragments can be written in sectors in arbitrary order.One of the problems of HDD hard drives is the following: the magnetic head should move from one sector to another to read some file.Find the time need to read file split to n fragments. The i-th sector contains the fi-th fragment of the file (1 ≤ fi ≤ n). Note different sectors contains the different fragments. At the start the magnetic head is in the position that contains the first fragment. The file are reading in the following manner: at first the first fragment is read, then the magnetic head moves to the sector that contains the second fragment, then the second fragment is read and so on until the n-th fragment is read. The fragments are read in the order from the first to the n-th.It takes |a - b| time units to move the magnetic head from the sector a to the sector b. Reading a fragment takes no time.

The first line contains a positive integer n (1 ≤ n ≤ 2·105) — the number of fragments. The second line contains n different integers fi (1 ≤ fi ≤ n) — the number of the fragment written in the i-th sector.

Print the only integer — the number of time units needed to read the file.

NoteIn the second example the head moves in the following way:  1->2 means movement from the sector 1 to the sector 5, i.e. it takes 4 time units  2->3 means movement from the sector 5 to the sector 2, i.e. it takes 3 time units  3->4 means movement from the sector 2 to the sector 4, i.e. it takes 2 time units  4->5 means movement from the sector 4 to the sector 3, i.e. it takes 1 time units So the answer to the second example is 4 + 3 + 2 + 1 = 10.

import Data.ByteString.Char8 (words, readInt, getLine)
import Data.List (sort)
import Data.Maybe
import Prelude hiding (words, getLine)

main = do
  getLine
  as <- (map (fst . fromJust . readInt) . words) `fmap` getLine :: IO [Int]

  let
    r = sum . zipWith (\a b -> abs $ a - b) ps $ tail ps
      where
        ps = map snd . sort $ zip as [1..]

  print r

import Control.Applicative
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
    f <- map snd . sort . (flip zip) [0 .. ] . tail . map fst . mapMaybe BS.readInt . BS.words <$> BS.getContents
    print . sum . map abs . zipWith (-) f $ tail f

import Data.Array

delta (x, y) = abs $ x - y

timeUnits a n = sum $ map delta $ changes
    where
        an = array (1, n) $ zip a [1..]
        pos = map (\x -> an!(x)) [1..n]
        changes = zip pos (drop 1 pos)

main = do
    n <- readLn
    s <- getLine
    let a = map read $ words s
    putStrLn $ show $ timeUnits a n

import Data.Array

main = interact $ show . sol . map read . words

sol :: [Integer] -> Integer
sol (n:fs) = sum $ map (\idx -> abs $ ar!(idx+1) - ar!idx) [1..n-1]
    where
    ar = array (1, n) $ zip fs [1..]

import Data.List

main = interact $ show . sol . map read . words

sol :: [Int] -> Int
sol (n:fs) = sum . map abs . zipWith (-) tr $ tail tr
    where
    tr = map snd . sort $ zip fs [1..]

import Data.List

main = interact $ show . sol . words

sol (n:fs) = sum . map abs . zipWith (-) tr $ tail tr
    where
    tr = map snd . sort $ zip fs [1..]


Valera's finally decided to go on holiday! He packed up and headed for a ski resort.Valera's fancied a ski trip but he soon realized that he could get lost in this new place. Somebody gave him a useful hint: the resort has n objects (we will consider the objects indexed in some way by integers from 1 to n), each object is either a hotel or a mountain.Valera has also found out that the ski resort had multiple ski tracks. Specifically, for each object v, the resort has at most one object u, such that there is a ski track built from object u to object v. We also know that no hotel has got a ski track leading from the hotel to some object.Valera is afraid of getting lost on the resort. So he wants you to come up with a path he would walk along. The path must consist of objects v1, v2, ..., vk (k ≥ 1) and meet the following conditions:  Objects with numbers v1, v2, ..., vk - 1 are mountains and the object with number vk is the hotel.  For any integer i (1 ≤ i < k), there is exactly one ski track leading from object vi. This track goes to object vi + 1.  The path contains as many objects as possible (k is maximal). Help Valera. Find such path that meets all the criteria of our hero!

The first line contains integer n (1 ≤ n ≤ 105) — the number of objects. The second line contains n space-separated integers type1, type2, ..., typen — the types of the objects. If typei equals zero, then the i-th object is the mountain. If typei equals one, then the i-th object is the hotel. It is guaranteed that at least one object is a hotel. The third line of the input contains n space-separated integers a1, a2, ..., an (0 ≤ ai ≤ n) — the description of the ski tracks. If number ai equals zero, then there is no such object v, that has a ski track built from v to i. If number ai doesn't equal zero, that means that there is a track built from object ai to object i.

In the first line print k — the maximum possible path length for Valera. In the second line print k integers v1, v2, ..., vk — the path. If there are multiple solutions, you can print any of them.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = do
    n <- readInt <$> B.getLine
    types <- readsInt
    as    <- readsInt
    let p = solve n types as
    print $ length p
    putStrLn $ unwords $ map show $ p

solve n types as = maximize length [ go i [] | i <- [1..n], hotel ! i]
    where
    graph :: UArray Int Int
    graph = listArray (1,n) as
    hotel :: UArray Int Bool
    hotel = listArray (1,n) $ map (==1) types
    degree :: UArray Int Int
    degree = accumArray (+) 0 (1,n) [ (i,1) | i <- as, i /= 0 ]
    go i !acc | next == 0 || hotel ! next || degree ! next > 1 = i:acc
         | otherwise = go next (i:acc)
        where
        next = graph ! i

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.Function
import Data.List
import Data.Ord
import Data.Tuple
import Data.Array.Base
import Data.Array.ST (runSTUArray)

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

main :: IO ()
main = do
  n <- readLn
  xs <- map (obj.readInt).B.words <$> B.getLine
  ys <- map readInt.B.words <$> B.getLine
  let (l,p) = solve n xs [(from,to) | [(from,to)]<-groupBy ((==)`on`fst).sort $ zip ys [1..n], from/=0]
  print l
  putStrLn.unwords.map show $ p

data Object = Mountain | Hotel deriving Eq

obj :: Int -> Object
obj 0 = Mountain
obj 1 = Hotel

solve :: Int -> [Object] -> [(Int,Int)] -> (Int,[Int])
solve n objects edges = maximum [ (length p, reverse p) | i<-[1..n]
                                                        , unsafeAt isHotel i
                                                        , let p = path i
                                                        , all (not.unsafeAt isHotel) $ tail p
                                                        ]
   where
     isHotel :: UArray Int Bool
     isHotel = listArray (0,n) $ False : map (Hotel==) objects
     prev :: UArray Int Int
     prev = runSTUArray $ do
       arr <- newArray (0,n) 0 :: ST s (STUArray s Int Int)
       forM_ edges $ \ (from,to) -> do
         unsafeWrite arr to from
       return arr
     path :: Int -> [Int]
     path v = takeWhile (/=0) $ iterate (unsafeAt prev) v


Petya and Gena love playing table tennis. A single match is played according to the following rules: a match consists of multiple sets, each set consists of multiple serves. Each serve is won by one of the players, this player scores one point. As soon as one of the players scores t points, he wins the set; then the next set starts and scores of both players are being set to 0. As soon as one of the players wins the total of s sets, he wins the match and the match is over. Here s and t are some positive integer numbers.To spice it up, Petya and Gena choose new numbers s and t before every match. Besides, for the sake of history they keep a record of each match: that is, for each serve they write down the winner. Serve winners are recorded in the chronological order. In a record the set is over as soon as one of the players scores t points and the match is over as soon as one of the players wins s sets.Petya and Gena have found a record of an old match. Unfortunately, the sequence of serves in the record isn't divided into sets and numbers s and t for the given match are also lost. The players now wonder what values of s and t might be. Can you determine all the possible options?

The first line contains a single integer n — the length of the sequence of games (1 ≤ n ≤ 105). The second line contains n space-separated integers ai. If ai = 1, then the i-th serve was won by Petya, if ai = 2, then the i-th serve was won by Gena. It is not guaranteed that at least one option for numbers s and t corresponds to the given record.

In the first line print a single number k — the number of options for numbers s and t. In each of the following k lines print two integers si and ti — the option for numbers s and t. Print the options in the order of increasing si, and for equal si — in the order of increasing ti.

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = assert (low>=0 && p high) $ go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

main :: IO ()
main = do
  n <- readLn
  xs <- listArray(0,n-1).map ((2==).readInt).B.words <$> B.getLine
  let res =  solve n xs
  print $ length res
  putStr.unlines.map (unwords.map show) $ res

solve :: Int -> UArray Int Bool -> [[Int]]
solve n arr = sort [[s,t] | t<-[1..n], Just s<-[simulate t]]
   where
     simulate point = go 0 0 0
      where
        go !x !y !i = case (nextx, nexty) of
                        (Just xi, Just yi)
                          | xi < yi -> go (x+1) y (xi+1)
                          | otherwise -> go x (y+1) (yi+1)
                        (Just xi, Nothing)
                          | unsafeAt arr (n-1) && r == 0 && y < res -> Just res
                         where
                           (q,r) = quotRem (unsafeAt arrX (n-1) - unsafeAt arrX xi) point
                           res = x + 1 + q
                        (Nothing, Just yi)
                          | not(unsafeAt arr (n-1)) && r == 0 && x < res -> Just $ y + 1 + q
                         where
                           (q,r) = quotRem (unsafeAt arrY (n-1) - unsafeAt arrY yi) point
                           res = y + 1 + q
                        _ -> Nothing
         where
           !ai = fromEnum $ unsafeAt arr i
           !sumX = unsafeAt arrX i - ai
           !sumY = unsafeAt arrY i - (1 - ai)
           nextx
             | unsafeAt arrX (n-1) - sumX >= point = Just $ lowerBound (\i->unsafeAt arrX i - sumX >= point) i (n-1)
             | otherwise = Nothing
           nexty
             | unsafeAt arrY (n-1) - sumY >= point = Just $ lowerBound (\i->unsafeAt arrY i - sumY >= point) i (n-1)
             | otherwise = Nothing
     pair :: (UArray Int Int, UArray Int Int)
     pair@(arrX, arrY) = runST $ do
       arrX <- newArray (0,n-1) 0 :: ST s (STUArray s Int Int)
       arrY <- newArray (0,n-1) 0 :: ST s (STUArray s Int Int)
       if unsafeAt arr 0 then unsafeWrite arrX 0 1
       else unsafeWrite arrY 0 1
       for 1 (n-1) $ \i -> do
         if unsafeAt arr i then do
            unsafeRead arrX (i-1) >>= unsafeWrite arrX i . (1+)
            unsafeRead arrY (i-1) >>= unsafeWrite arrY i
         else do
            unsafeRead arrX (i-1) >>= unsafeWrite arrX i
            unsafeRead arrY (i-1) >>= unsafeWrite arrY i . (1+)
       (,) <$> unsafeFreeze arrX <*> unsafeFreeze arrY

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

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    n <- readLn
    as <- readInts
    let l = solve n as
    print $ length l
    putStr $ unlines $ [ show s ++ " " ++ show t | (s,t) <- l]

solve :: Int -> [Int] -> [(Int,Int)]
solve n as = sort [ (s,t) | t <- [1..n], s <- calc n tbl t ] where
    tbl :: UArray Int Int
    tbl = listArray (0,n) $ scanl (+) 0 $ map (2-) as

calc :: Int -> UArray Int Int -> Int -> [Int]
calc n tbl s = go 0 0 0 where
    go !wx !wy !p =
        let l = min n (p+s-1) in
        let r = min n (p+2*s-1) in
        let check q =
                let a = tbl ! q - tbl ! p in
                let b = (q - p) - a in
                max a b < s in
        let d = binSearch check l r in
        if tbl ! d - tbl ! p == s then
            -- winner is Petya
            if d == n then
                guard (wx >= wy) >> pure (wx+1)
            else
                go (wx+1) wy d
        else if (d-p) - (tbl ! d - tbl ! p) == s then
            -- winner is Gena
            if d == n then
                guard (wx <= wy) >> pure (wy+1)
            else
                go wx (wy+1) d
        else
            empty

{-# INLINE binSearch #-}
binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p = go  where
    go l r
        | l >= r - 1 = r
        | p m = go m r
        | otherwise = go l m where
        m = (l + r) `div` 2


This is the hard version of the problem. The difference is the constraints on $$$n$$$, $$$m$$$ and $$$t$$$. You can make hacks only if all versions of the problem are solved.Alice and Bob are given the numbers $$$n$$$, $$$m$$$ and $$$k$$$, and play a game as follows:The game has a score that Alice tries to maximize, and Bob tries to minimize. The score is initially $$$0$$$. The game consists of $$$n$$$ turns. Each turn, Alice picks a real number from $$$0$$$ to $$$k$$$ (inclusive) which Bob either adds to or subtracts from the score of the game. But throughout the game, Bob has to choose to add at least $$$m$$$ out of the $$$n$$$ turns.Bob gets to know which number Alice picked before deciding whether to add or subtract the number from the score, and Alice gets to know whether Bob added or subtracted the number for the previous turn before picking the number for the current turn (except on the first turn since there was no previous turn).If Alice and Bob play optimally, what will the final score of the game be?

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. The description of test cases follows. Each test case consists of a single line containing the three integers, $$$n$$$, $$$m$$$, and $$$k$$$ ($$$1 \le m \le n \le 10^6, 0 \le k < 10^9 + 7$$$) — the number of turns, how many of those turns Bob has to add, and the biggest number Alice can choose, respectively. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^6$$$.

For each test case output a single integer number — the score of the optimal game modulo $$$10^9 + 7$$$. Formally, let $$$M = 10^9 + 7$$$. It can be shown that the answer can be expressed as an irreducible fraction $$$\frac{p}{q}$$$, where $$$p$$$ and $$$q$$$ are integers and $$$q \not \equiv 0 \pmod{M}$$$. Output the integer equal to $$$p \cdot q^{-1} \bmod M$$$. In other words, output such an integer $$$x$$$ that $$$0 \le x < M$$$ and $$$x \cdot q \equiv p \pmod{M}$$$.

NoteIn the first test case, the entire game has $$$3$$$ turns, and since $$$m = 3$$$, Bob has to add in each of them. Therefore Alice should pick the biggest number she can, which is $$$k = 2$$$, every turn.In the third test case, Alice has a strategy to guarantee a score of $$$\frac{75}{8} \equiv 375000012 \pmod{10^9 + 7}$$$.In the fourth test case, Alice has a strategy to guarantee a score of $$$\frac{45}{2} \equiv 500000026 \pmod{10^9 + 7}$$$.

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

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

p :: Int
p = 1000_000_007

cv :: Int -> Int
cv x = rem x p

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(-!) :: Int -> Int -> Int
infixl 6 -!
x -! y = cv $ x + p - y

(*!) :: Int -> Int -> Int
infixl 7 *!
x *! y = cv $ x * y

newtype ModP = ModP { unModP :: Int }
instance  Semigroup ModP  where
  ModP x <> ModP y = ModP $ x *! y
  stimes = stimesMonoid -- don't be an idiot, check the whole mainFun
instance  Monoid ModP  where
  mempty = ModP 1

inv :: Int -> Int
inv = unModP . stimes (p - 2) . ModP

getFacts :: Int -> UArray Int Int
getFacts n = listArray (0, n) $ scanl' (*!) 1 [1 .. n]

getIFacts :: UArray Int Int -> UArray Int Int
getIFacts arr = let
  (0, n) = bounds arr
  step :: (Int, Int) -> (Int, Int)
  step (n, inf) = (n - 1, n *! inf)
  in  array (0, n) $ takeWhile ((>= 0) . fst) $ iterate step (n, inv $ arr ! n)

half :: Int
half = div (p + 1) 2

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    m <- getInt
    k <- getInt
    let
      facts = getFacts n
      ifacts = getIFacts facts
      x `choose` y = facts ! x *! ifacts ! y *! ifacts ! (x - y)
      raw = zipWith (*!) [1..] $ iterate (*! 2) 1
      coeffs = zipWith (-!) raw (0 : raw)
      bcs = [choose (n - i) (n - m) | i <- [1 .. m]]
      unscaledAns = foldl' (+!) 0 $ zipWith (*!) coeffs bcs
    pure $ putInts [k *! unscaledAns *! unModP (stimes (n - 1) $ ModP half)]

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

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

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

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

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

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