One day Polycarp published a funny picture in a social network making a poll about the color of his handle. Many of his friends started reposting Polycarp's joke to their news feed. Some of them reposted the reposts and so on.These events are given as a sequence of strings "name1 reposted name2", where name1 is the name of the person who reposted the joke, and name2 is the name of the person from whose news feed the joke was reposted. It is guaranteed that for each string "name1 reposted name2" user "name1" didn't have the joke in his feed yet, and "name2" already had it in his feed by the moment of repost. Polycarp was registered as "Polycarp" and initially the joke was only in his feed.Polycarp measures the popularity of the joke as the length of the largest repost chain. Print the popularity of Polycarp's joke.

The first line of the input contains integer n (1 ≤ n ≤ 200) — the number of reposts. Next follow the reposts in the order they were made. Each of them is written on a single line and looks as "name1 reposted name2". All the names in the input consist of lowercase or uppercase English letters and/or digits and have lengths from 2 to 24 characters, inclusive. We know that the user names are case-insensitive, that is, two names that only differ in the letter case correspond to the same social network user.

Print a single integer — the maximum length of a repost chain.

5
tourist reposted Polycarp
Petr reposted Tourist
WJMZBMR reposted Petr
sdya reposted wjmzbmr
vepifanov reposted sdya

6
Mike reposted Polycarp
Max reposted Polycarp
EveryOne reposted Polycarp
111 reposted Polycarp
VkCup reposted Polycarp
Codeforces reposted Polycarp

import Control.Applicative
import Data.Char
import Data.Map hiding (map)

main :: IO ()
main = do
  n <- read <$> getLine
  m <- go n $ singleton "polycarp" 1
  print $ maximum $ elems m
  where
  key = map toLower
  go 0 m = return m
  go i m = do
    [a, _, b] <- words <$> getLine
    go (i-1) $ insert (key a) (m!key b + 1) m

import Data.Char
main = do
	n<-getLine
	rest<-getContents
	putStrLn $ show $ solve ((map words (lines (map toLower rest)))) [("polycarp",1)]

solve [] acc = maximum $ map snd acc
solve (c:chain) acc = solve chain ((head c, getLevel (last c) acc +1):acc)

getLevel _ [] = 0
getLevel "polycarp" _ = 1
getLevel name (a:acc) | name == fst a = snd a
                      | otherwise = getLevel name acc

import Control.Monad
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Char (toLower)

toLowerS :: String -> String
toLowerS = map toLower

reposts :: [(String, [String])] -> Map String [String]
reposts = M.fromListWith (++)

maxreposts :: String -> Map String [String] -> Int
maxreposts key mapss = case M.lookup key mapss of
  Nothing -> 1
  Just values -> 1 + (maximum $ map (\k -> maxreposts k mapss) values)

main :: IO ()
main = do
  n <- readLn :: IO Int
  rawReposts <- replicateM n (getLine >>= \s -> do
                                 let ss = words s
                                 return (toLowerS (last ss), [toLowerS (head ss)]))
  print $ maxreposts "polycarp" $ reposts rawReposts

import Control.Applicative ((<$>))

import Data.Char (toLower)
import qualified Data.Map as Map
import Data.Tuple

main = do
	getLine
	pairs <- map ((\[to, _, from] -> (to, from)) . words) . lines . map toLower <$> getContents

	let distances =
			Map.fromList $ ("polycarp", 1) : (map (uncurry calc) pairs)
		where
			calc to from = (to, (distances Map.! from) + 1)

	print $ maximum $ map snd $ Map.toList distances

import Control.Applicative ((<$>))

import Data.Char (toLower)
import qualified Data.Map as Map
import Data.Tuple

main = do
	getLine
	pairs <- map ((\[to, _, from] -> (to, from)) . words) . lines . map toLower <$> getContents

	let distances =
			Map.fromList $ ("polycarp", 1) : (map (uncurry calc) pairs)
		where
			calc :: String -> String -> (String, Int)
			calc to from = (to, (distances Map.! from) + 1)

	print $ maximum $ map snd $ Map.toList distances

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ trailNum pairs "polycarp"

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 1
trailNum p   str = 1 + (x `seq` maximum1 x)
			where x = let (a,b) = partition (\(_,x) -> x == str) p
			          in map (trailNum b) (map fst a)

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ trailNum pairs "polycarp"

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 1
trailNum p   str = 1 + (maximum1 $ rmap (trailNum b) (map fst a))
			where (a,b) = partition (\(_,x) -> x == str) p

rmap :: (a -> b) -> [a] -> [b]
rmap f []     = []
rmap f (x:xs) = f x `seq` ( (f x) : rmap f xs )

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ trailNum pairs "polycarp"

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum l str = case partition (\(_,x) -> x == str) l of
			([],_) -> 1
			(a,b)  -> 1 + (maximum1 $ map (trailNum b) (map fst a))

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ trailNum pairs "polycarp"

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 1
trailNum p   str = 1 + (maximum1 $ map (trailNum b) (map fst a))
			where (a,b) = partition (\(_,x) -> x == str) p

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum p   str = 1 + (maximum1 $ map (trailNum b) (map fst a))
			where (a,b) = partition (\(_,x) -> x == str) p

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 0
trailNum p   str = 1 + (maximum $ (map (trailNum b) (map fst a)) ++ [0])
			where (a,b) = partition (\(_,x) -> x == str) p

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 1
trailNum p   str = 1 + (maximum $ (map (trailNum b) (map fst a)) ++ [0])
			where (a,b) = partition (\(_,x) -> x == str) p

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 1
trailNum p   str = 1 + (maximum $ (map (trailNum b) (map fst a)) ++ [1])
			where (a,b) = partition (\(_,x) -> x == str) p

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 1
trailNum [_] str = 1
trailNum p   str = 1 + (maximum $ (map (trailNum b) (map fst a)) ++ [0])
			where (a,b) = partition (\(_,x) -> x == str) p

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 1
trailNum p   str = 1 + (maximum1 $ map (trailNum b) (map fst a))
			where (a,b) = partition (\(_,x) -> x == str) p

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 1
trailNum p   str = 1 + (maximum $ (map (trailNum p) (map fst (filter (\(_,x) -> x == str) p))) ++ [0])


A permutation is a sequence of integers p1, p2, ..., pn, consisting of n distinct positive integers, each of them doesn't exceed n. Let's denote the i-th element of permutation p as pi. We'll call number n the size of permutation p1, p2, ..., pn.Nickolas adores permutations. He likes some permutations more than the others. He calls such permutations perfect. A perfect permutation is such permutation p that for any i (1 ≤ i ≤ n) (n is the permutation size) the following equations hold ppi = i and pi ≠ i. Nickolas asks you to print any perfect permutation of size n for the given n.

A single line contains a single integer n (1 ≤ n ≤ 100) — the permutation size.

If a perfect permutation of size n doesn't exist, print a single integer -1. Otherwise print n distinct integers from 1 to n, p1, p2, ..., pn — permutation p, that is perfect. Separate printed numbers by whitespaces.

import Control.Monad
import Data.List

getInt = read `fmap` getLine :: IO Int

main = do
    n <- getInt
    if odd n
    then print (-1)
    else do
        let (evens, odds) = partition even [1..n]
        let soln = interleave evens odds
        forM_ soln $ \i -> putStr (show i) >> putChar ' '

interleave xs ys = f xs ys [] where
    f [] [] zs = zs
    f (x:xs) (y:ys) zs = x:y: f xs ys zs

gao [] = []
gao (i:j:k) = j:i:gao k

main = do
  n <- fmap read getLine
  putStrLn $ unwords $ map show $ if odd n then [-1] else gao [1 .. n]

import Data.List
import Data.List.Split

(|>) x f = f x
main = interact solve

solve contents = let
  n = contents |> lines |> head |> read :: Int
  in pp n

pp n = if odd n then "-1" else permute n

permute n = [1..n] |> chunksOf 2 |> map reverse |> concat |> map show |> unwords

main = do
    n <- getLine
    putStr $ unwords $ map show $ f $ (read n :: Int)

f :: Int -> [Int]
f n
    | (mod n 2)==1 = [-1]
    | otherwise = f1 1 n

f1 :: Int -> Int -> [Int]
f1 a 0 = []
f1 a n = (a+1):a:(f1 (a+2) (n-2))

(?) :: Bool -> a -> a -> a
(?) True   =  const
(?) False  =  flip const

prints :: Show a => [a] -> IO ()
prints xs  =  mapM_ (putStr . (++ " ") . show) xs >> putStrLn ""

main :: IO ()
main  =  do
    n  <-  readLn
    (odd n) ? (putStrLn "-1") $ prints $ reverse [1..n]

main=interact$f.read
f::Int->[Char]
f x=if odd x then "-1" else q x
q 2="2 1"
q x=q (x-2)++" "++show x++" "++show (x-1)

import Control.Applicative

solve :: Int -> [Int]
solve 0 = []
solve n = 2:1:map (+2) (solve $ n - 2)

main = do
    n <- read <$> getLine
    if n `mod` 2 == 1
        then print $ -1
        else putStrLn $ concatMap ((++" ").show) $ solve n

main=interact$unwords.map show.f.read
f n|odd n=[-1]|1>0=[1..n`div`2]>>= \i->[2*i,2*i-1]

main :: IO ()
main = readLn >>= putStrLn . unwords . map show . solve

solve :: Integer -> [Integer]
solve n | even n = concatMap (\i -> [ 2 * i, 2 * i - 1 ]) [ 1 .. n `div` 2 ]
        | otherwise = [ -1 ]

module Main where

import Control.Applicative

swapL [] = []
swapL (x:y:l) = y:x:swapL l

main = do
  n <- read <$> getLine
  if n `mod` 2 == 1
   then (putStrLn "-1")
   else (putStrLn . unwords . map show $ swapL [1..n])

main = do
  n <- readLn
  if odd n
    then print (-1)
    else putStrLn $ unwords $ map show $ solve n 1
solve n i | i >= n    = []
          | otherwise = i+1 : i : solve n (i+2)

main :: IO()
main = do
    a <- getLine
    let n = read a :: Int
    if odd n
        then putStrLn "-1"
        else putStrLn $ unwords $ map show $ reverse [1..n]

main = interact $ unwords . map show . f . read
f n | odd n     = [-1]
    | otherwise = [1..div n 2] >>= (\x -> [2*x, 2*x-1])

main=readLn>>=putStrLn.unwords.map show.f
f n| odd n = [-1]
   | otherwise = [1..div n 2] >>= \i->[2*i,2*i-1]

import Control.Applicative
import Data.List

perm n = myswap [1..n]

myswap [] = []
myswap (a:b:cs) = b:a:(myswap cs)

main= do
	n<- read <$> getLine
	let x= if even n then perm n else [-1]
	putStrLn $ intercalate " " $ map show x

process :: Int -> [Int]
process n
    | odd n = [-1]
    | otherwise = concat $ map (\x -> [x,x-1]) [2,4..n]

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    putStrLn . unwords . map show $ process n

f :: [Int] -> Int -> [Int]
f [] _ = []
f (x:xs) n | n==1 = (x+1):(f xs 2)
           | n==2 = (x-1):(f xs 1)

main :: IO()
main = do
  a <- getLine
  let b = read a::Int
  if (odd b)
    then putStrLn "-1"
    else putStrLn $ unwords $ map show $ f [1..b] 1

main = readLn >>= putStrLn . unwords . map show . f
f n
  | odd n = [-1]
  | otherwise = [1.. div n 2] >>= \i -> [2*i, 2*i-1]

main = putStrLn . unwords . map show . slv . read =<< getLine
slv 1 = [-1]
slv n
 | n `mod` 2 == 0 = [n,n-1..1]
 | True           = [-1]

import Data.List
perfectPerms n = [ p | p <- permutations [1..n],
                       i <- [1..n],
                       p !! (i-1) /= i,
                       p !! ((p !! (i-1)) - 1) == i]
p [] = "-1"
p a = unwords . map show $ a
main = interact $ p . perfectPerms . read

import Data.List
perfectPerms n = [ p | p <- permutations [1..n],
                       i <- [1..n],
                       p !! (i-1) /= i,
                       p !! ((p !! (i-1)) - 1) == i]
p [] = "-1"
p (a:as) = unwords . map show $ a
main = interact $ p . perfectPerms . read

main = putStrLn . unwords . map show . slv . read =<< getLine
slv 1 = [-1]
slv n = [n,n-1..1]


Every Codeforces user has rating, described with one integer, possibly negative or zero. Users are divided into two divisions. The first division is for users with rating 1900 or higher. Those with rating 1899 or lower belong to the second division. In every contest, according to one's performance, his or her rating changes by some value, possibly negative or zero.Limak competed in n contests in the year 2016. He remembers that in the i-th contest he competed in the division di (i.e. he belonged to this division just before the start of this contest) and his rating changed by ci just after the contest. Note that negative ci denotes the loss of rating.What is the maximum possible rating Limak can have right now, after all n contests? If his rating may be arbitrarily big, print "Infinity". If there is no scenario matching the given information, print "Impossible".

The first line of the input contains a single integer n (1 ≤ n ≤ 200 000). The i-th of next n lines contains two integers ci and di ( - 100 ≤ ci ≤ 100, 1 ≤ di ≤ 2), describing Limak's rating change after the i-th contest and his division during the i-th contest contest.

If Limak's current rating can be arbitrarily big, print "Infinity" (without quotes). If the situation is impossible, print "Impossible" (without quotes). Otherwise print one integer, denoting the maximum possible value of Limak's current rating, i.e. rating after the n contests.

NoteIn the first sample, the following scenario matches all information Limak remembers and has maximum possible final rating:  Limak has rating 1901 and belongs to the division 1 in the first contest. His rating decreases by 7.  With rating 1894 Limak is in the division 2. His rating increases by 5.  Limak has rating 1899 and is still in the division 2. In the last contest of the year he gets  + 8 and ends the year with rating 1907. In the second sample, it's impossible that Limak is in the division 1, his rating increases by 57 and after that Limak is in the division 2 in the second contest.

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

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

type N = Int
toNum = toInt

data Div = Lower | Higher
    deriving (Eq, Ord, Show, Enum, Bounded)

data Output a = Impossible | Out a | Infinity
    deriving (Eq, Ord)

data DorC = D Div | C N
    deriving (Eq, Ord, Show)

instance Show a => Show (Output a) where
    show Impossible = "Impossible"
    show Infinity = "Infinity"
    show (Out a) = show a

answer :: [DorC] -> Output N
answer [] = Infinity
{-answer xs
  | traceShow xs False = undefined-}
answer (D Lower : xs) = go Lower Nothing (Just 1899) xs
answer (D Higher : xs) = go Higher (Just 1900) Nothing xs

{-go d mn mx xs
  | traceShow (d, mn, mn, take 3 xs) False = undefined -}
go _ (Just mn) (Just mx) _
  | mn > mx = Impossible
go Lower (Just mn) _ _
  | mn >= 1900 = Impossible
go Higher _ (Just mx) _
  | mx < 1900 = Impossible
go _ _ (Just mx) [C n] = Out $ mx + n
go _ _ Nothing [C n] = Infinity
go _ (Just mn) _ (C c : D Lower : xs)
  | mn + c >= 1900 = Impossible
go _ _ (Just mx) (C c : D Higher : xs)
  | mx + c < 1900 = Impossible
go Lower mn mx (C c : D Higher : xs)
  | c < 1 = Impossible
  | otherwise = go Higher (Just $ max (fromMaybe neginf mn + c) 1900)
                          (Just $ min (fromMaybe inf mx + c) (1899 + c))
                          xs
go Higher mn mx (C c : D Lower : xs)
  | c > (-1) = Impossible
  | otherwise = go Lower (Just $ max (fromMaybe neginf mn + c) (1900 + c))
                         (Just $ min (fromMaybe inf mx + c) 1899)
                         xs
go d mn mx (C 0 : _ : xs) = go d mn mx xs
go Lower mn mx (C c : D Lower : xs)
  | c > 0 = go Lower ((+ c) <$> mn)
                     (Just $ min (fromMaybe inf mx + c) 1899)
                     xs
  | c < 0 = go Lower ((+ c) <$> mn)
                     (Just $ min (fromMaybe inf mx + c) (1899 + c))
                     xs
go Higher mn mx (C c : D Higher : xs)
  | c > 0 = go Higher (Just $ max (fromMaybe neginf mn + c) (1900 + c))
                      ((+ c) <$> mx)
                      xs
  | c < 0 = go Higher (Just $ max (fromMaybe neginf mn + c) 1900)
                      ((+ c) <$> mx)
                      xs

inf = 2000000000
neginf = negate inf

handleInput :: ByteString -> ByteString
handleInput = lines .- map (words .- map toNum)
            .- coerceInput answer
            .- show .- pack

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

coerceInput f ((a:_):xs) = f (take (a*2) (concatMap toIn xs))
coerceInput _ _ = error "invalid input"

toIn (a:1:_) = [D Higher, C a]
toIn (a:2:_) = [D Lower, C a]
toIn _ = error "invalid in"

main :: IO ()
main = interact handleInput

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


A competitive eater, Alice is scheduling some practices for an eating contest on a magical calendar. The calendar is unusual because a week contains not necessarily $$$7$$$ days!In detail, she can choose any integer $$$k$$$ which satisfies $$$1 \leq k \leq r$$$, and set $$$k$$$ days as the number of days in a week.Alice is going to paint some $$$n$$$ consecutive days on this calendar. On this calendar, dates are written from the left cell to the right cell in a week. If a date reaches the last day of a week, the next day's cell is the leftmost cell in the next (under) row.She wants to make all of the painted cells to be connected by side. It means, that for any two painted cells there should exist at least one sequence of painted cells, started in one of these cells, and ended in another, such that any two consecutive cells in this sequence are connected by side.Alice is considering the shape of the painted cells. Two shapes are the same if there exists a way to make them exactly overlapped using only parallel moves, parallel to the calendar's sides.For example, in the picture, a week has $$$4$$$ days and Alice paints $$$5$$$ consecutive days. [1] and [2] are different shapes, but [1] and [3] are equal shapes.    Alice wants to know how many possible shapes exists if she set how many days a week has and choose consecutive $$$n$$$ days and paints them in calendar started in one of the days of the week. As was said before, she considers only shapes, there all cells are connected by side.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Next $$$t$$$ lines contain descriptions of test cases. For each test case, the only line contains two integers $$$n$$$, $$$r$$$ ($$$1 \le n \le 10^9, 1 \le r \le 10^9$$$).

For each test case, print a single integer  — the answer to the problem. Please note, that the answer for some test cases won't fit into $$$32$$$-bit integer type, so you should use at least $$$64$$$-bit integer type in your programming language.

NoteIn the first test case, Alice can set $$$1,2,3$$$ or $$$4$$$ days as the number of days in a week.There are $$$6$$$ possible paintings shown in the picture, but there are only $$$4$$$ different shapes. So, the answer is $$$4$$$. Notice that the last example in the picture is an invalid painting because all cells are not connected by sides.    In the last test case, be careful with the overflow issue, described in the output format.

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  [n, r] <- map read . words <$> getLine
  print $ if r < n then triangle r else triangle (n - 1) + 1

triangle n = (n * (n + 1)) `div` 2

{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Monad (forM_, replicateM_)
import           Data.Word

sol n r =
  let p1 = if r < n
           then 0
           else 1
      p2 = if r >= n - 1
           then (n - 1) * n `div` 2
           else r * (r + 1) `div` 2 in
    p1 + p2

main = do
  t <- readLn
  replicateM_ t $ do
    [n, r] :: [Word64] <- map read . words <$> getLine
    print $ sol n r

import Data.Int
import Control.Monad

main = do
  t <- readLn :: IO Int
  forM_ [1 .. t] $ \_ -> do
    [n, r] <- fmap (fmap read . words) getLine :: IO [Int64]
    let result = if r < n
                 then (r * (r + 1)) `div` 2
                 else ((n - 1) * n) `div` 2 + 1
    print result

import           Control.Monad

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    [n, r] <- map read . words <$> getLine :: IO [Integer]
    if r < n
      then
        print $ r * (r + 1) `div` 2
      else
        print $ n * (n - 1) `div` 2 + 1

{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Monad (forM_, replicateM_)

sol n r =
  let p1 = if r < n
           then 0
           else 1
      p2 = if r >= n - 1
           then (n - 1) * n `div` 2
           else r * (r + 1) `div` 2 in
    p1 + p2

main = do
  t <- readLn
  replicateM_ t $ do
    [n, r] :: [Word] <- map read . words <$> getLine
    print $ sol n r

import           Control.Monad

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    [n, r] <- map read . words <$> getLine :: IO [Int]
    if r < n
      then
        print $ r * (r + 1) `div` 2
      else
        print $ n * (n - 1) `div` 2 + 1


Today we will be playing a red and white colouring game (no, this is not the Russian Civil War; these are just the colours of the Canadian flag).You are given an $$$n \times m$$$ grid of "R", "W", and "." characters. "R" is red, "W" is white and "." is blank. The neighbours of a cell are those that share an edge with it (those that only share a corner do not count).Your job is to colour the blank cells red or white so that every red cell only has white neighbours (and no red ones) and every white cell only has red neighbours (and no white ones). You are not allowed to recolour already coloured cells.

The first line contains $$$t$$$ ($$$1 \le t \le 100$$$), the number of test cases. In each test case, the first line will contain $$$n$$$ ($$$1 \le n \le 50$$$) and $$$m$$$ ($$$1 \le m \le 50$$$), the height and width of the grid respectively. The next $$$n$$$ lines will contain the grid. Each character of the grid is either 'R', 'W', or '.'.

For each test case, output "YES" if there is a valid grid or "NO" if there is not. If there is, output the grid on the next $$$n$$$ lines. If there are multiple answers, print any. In the output, the "YES"s and "NO"s are case-insensitive, meaning that outputs such as "yEs" and "nO" are valid. However, the grid is case-sensitive.

YES
WRWRWR
RWRWRW
WRWRWR
RWRWRW
NO
YES
R
W
R
W
R

NoteThe answer for the first example case is given in the example output, and it can be proven that no grid exists that satisfies the requirements of the second example case. In the third example all cells are initially coloured, and the colouring is valid.

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: [BS.ByteString] -> Int
solve ss
    | all (ok 0) $ zip ss [0..] = 0
    | all (ok 1) $ zip ss [0..] = 1
    | otherwise = 2
    where
        ok i0 (s,i1) = all (\j -> ok2 (BS.index s j) (i0 `xor` i1 `xor` j)) [0..m-1]
            where
                m = BS.length s
                ok2 '.' _ = True
                ok2 'R' i = even i
                ok2 'W' i = odd i

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        [n, m] <- map parseInt . BS.words <$> BS.getLine
        grid <- replicateM n $ BS.pack . dropWhileEnd isSpace . BS.unpack <$> BS.getLine
        let r = solve grid
        if r == 2 then
            putStrLn "NO"
        else do
            putStrLn "YES"
            forM_ [0..n-1] $ \i -> do
                let x = i `mod` 2 == r
                let ss = if x then "RW" else "WR"
                let s = take m $ concat $ repeat ss
                putStrLn s

import Control.Monad
import Data.List
readInts = fmap (map read.words) getLine :: IO [Int]

sample1 0 _ = []
sample1 n m = [if even i then w else r |i<-[1..m]] : sample1 (n-1) m
            where
                w = if even n then 'W' else 'R'
                r = if even n then 'R' else 'W'

sample2 0 _ = []
sample2 n m = [if odd i then w else r |i<-[1..m]] : sample2 (n-1) m
            where
                w = if even n then 'W' else 'R'
                r = if even n then 'R' else 'W'

myZip _ '.' =  True
myZip '.' _ = True
myZip a b = a == b

solve [] [] = True
solve (a:as) (b:bs) = solve as bs && (and $ zipWith myZip a b)

printResult = do
    [n,m] <- readInts
    xs <- replicateM n getLine
    let a = sample1 n m
        b = sample2 n m
        ra = solve a xs
        rb = solve b xs
        r = ra || rb
    putStrLn $ if r then "YES" else "NO"
    if r then mapM_ putStrLn (if ra then a else b)
    else return ()

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult


Malek has recently found a treasure map. While he was looking for a treasure he found a locked door. There was a string s written on the door consisting of characters '(', ')' and '#'. Below there was a manual on how to open the door. After spending a long time Malek managed to decode the manual and found out that the goal is to replace each '#' with one or more ')' characters so that the final string becomes beautiful. Below there was also written that a string is called beautiful if for each i (1 ≤ i ≤ |s|) there are no more ')' characters than '(' characters among the first i characters of s and also the total number of '(' characters is equal to the total number of ')' characters. Help Malek open the door by telling him for each '#' character how many ')' characters he must replace it with.

The first line of the input contains a string s (1 ≤ |s| ≤ 105). Each character of this string is one of the characters '(', ')' or '#'. It is guaranteed that s contains at least one '#' character.

If there is no way of replacing '#' characters which leads to a beautiful string print  - 1. Otherwise for each character '#' print a separate line containing a positive integer, the number of ')' characters this character must be replaced with. If there are several possible answers, you may output any of them.

Note|s| denotes the length of the string s.

main = getLine >>= putStr . unlines . map show . g . f 0 0
f m n _ | m < 0 = [-1]
f m n ('(':x) = f (m+1) n x
f m n (')':x) = f (m-1) (min m n) x
f m n ('#':x) = 1:f (m-1) m x
f m n [] | n > m = [m+1] | otherwise = [-1]
g x | last x == -1 = [-1] | otherwise = init (init x) ++ [last x]

import Data.List (intercalate)

parse :: Int -> String -> Int
parse p (c:cs) | p < 0 = -1
               | c == '(' = parse (p+1) cs
               | otherwise = parse (p-1) cs
parse p _ = p

transform :: Int -> String -> String
transform n = snd . foldr f (False, "")
    where f c (r, cs) | c == '#' && r = (r, ')':cs)
                      | c == '#' = (not r, replicate n ')' ++ cs)
                      | otherwise = (r, c:cs)

solve :: String -> String
solve str | p < 0 || i < 0 = "-1"
          | otherwise = intercalate "\n" $ replicate h "1" ++ [show $ p + 1]
    where h = (subtract 1) $ length $ filter (== '#') str
          p = parse 0 str
          t = transform (p+1) str
          i = parse 0 t

main = getLine >>= putStrLn . solve

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

main :: IO ()
main = do
  cs <- getLine
  putStr.unlines.map show.maybe[-1]id $ solve cs

solve :: String -> Maybe [Int]
solve cs = go0 0 (reverse cs) >>= go [] 0
   where
     go _ _ "(" = Nothing
     go res stk ('(':cs) = go res (stk+1) cs
     go res stk ('#':cs)
       | stk > 0 = go (1:res) (stk-1) cs
       | otherwise = Nothing
     go res stk (')':cs)
       | stk > 0 = go res (stk-1) cs
       | otherwise = Nothing
     go (r:res) stk [] = Just (reverse $ (r + stk) : res)
     go _ _ _ = Nothing

     go0 stk (')':cs) = go0 (stk+1) cs
     go0 stk ('(':cs)
        | stk > 0 = go0 (stk-1) cs
        | otherwise = Nothing
     go0 stk cs = Just $ reverse $ replicate stk ')' ++ cs

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

process [] n a | n>=0 = reverse ( (n+1) : (tail a))
               | otherwise= [-1]

process (s:ss) n a	|n<0 = [-1]
			| s=='(' = process ss (n+1) a
			| s==')' = process ss (n-1) a
			| otherwise = process ss (n-1) (1:a)

check [] _ = True
check (s:ss) n	| n<0 =False
		| s==')' = check ss (n+1)
	       	| s=='(' = check ss (n-1)
	       	| otherwise = n>=0

main=do
	s<- getLine
	putStrLn $ if not (check (reverse s) 0) then "-1" else intercalate "\n"$ map show $ process s 0 []

main = getLine >>= putStr . unlines . map show . g . f 0 0
f m _ _ | m < 0 = [-1]
f m n ('(':x) = f (m+1) n x
f m n (')':x) = f (m-1) n x
f m n ('#':x) = 1:f (m-1) m x
f m n [] | n > m = [m+1] | otherwise = [-1]
g x | last x == -1 = [-1] | otherwise = init (init x) ++ [last x]

import Data.Maybe
main = interact $ unlines . map show . fromMaybe [-1] . f 0
f 0 [] = Just []
f _ [] = Nothing
f n ('(':y) = f (n+1) y
f n (')':y)
  | n > 0 = f (n-1) y
  | otherwise = Nothing
f n ('#':'#':y)
  | n > 0 = fmap (1:) $ f (n-1) ('#':y)
  | otherwise = Nothing
f n ('#':y)
  | n > length a = fmap (n-length a:) $ f 0 b
  | otherwise = Nothing
  where (a,b) = span (==')') y
f n (x:y) = f n y

main = getLine >>= putStr . unlines . map show . g . f 0 0
f m n _ | m < 0 || n < 1 = [-1]
f m n ('(':x) = f (m+1) n x
f m n (')':x) = f (m-1) (min (m-1) n) x
f m n ('#':x) = 1:f (m-1) m x
f m n [] | n > m = [m+1] | otherwise = [-1]
g x | last x == -1 = [-1] | otherwise = init (init x) ++ [last x]

import Data.List (intercalate)

parse :: String -> ([Int], Int, Int)
parse = foldl func ([], 0, 0)
    where func (xs, p, h) x =
            let (n, nh) | x == '#' = (p - 1, h + 1)
                        | x == '(' = (p + 1, h)
                        | x == ')' = (p - 1, h)
            in (n:xs, n, nh)

solve :: ([Int], Int, Int) -> String
solve ((x:_), _, h) =
    intercalate "\n" $ replicate (h - 1) "1" ++ [show $ x + 1]

main = getLine >>= putStrLn . solve . parse

import Data.List (intercalate)

parse :: Int -> Int -> String -> Maybe (Int, Int)
parse p h (c:cs) | p < 0 = Nothing
                 | c == '#' = parse (p-1) (h+1) cs
                 | c == '(' = parse (p+1) h cs
                 | c == ')' = parse (p-1) h cs
parse p h [] = if p < 0 then Nothing else Just (p, h)

solve :: Maybe (Int, Int) -> String
solve Nothing = "-1"
solve (Just (x, h)) =
    intercalate "\n" $ replicate (h - 1) "1" ++ [show $ x + 1]

main = getLine >>= putStrLn . solve . parse 0 0

import Data.List (intercalate)

parse :: String -> ([Int], Int, Int)
parse = foldl func ([], 0, 0)
    where func (xs, p, h) x =
            let (n, nh) | x == '#' = (p - 1, h + 1)
                        | x == '(' = (p + 1, h)
                        | x == ')' = (p - 1, h)
            in (n:xs, n, nh)

solve :: ([Int], Int, Int) -> String
solve ((x:_), _, h) =
    intercalate "\n" $ replicate (h - 1) "1" ++ [show x]

main = getLine >>= putStrLn . solve . parse

import Data.List (intercalate)

prepare :: Int -> Int -> [Int] -> String -> [Int]
prepare hashes prev res (c:cs)
    | c == '#' = prepare (hashes+1) next (next:res) cs
    | otherwise = prepare hashes next (next:res) cs
        where next = if c == '(' then prev + 1 else prev - 1
prepare h _ res _ = h : reverse res

solve :: [Int] -> [Int]
solve [h, x] = if x > 0 then [h, x] else [h, -1]
solve (h:x:xs) | x == -1 = [h, -1]
               | otherwise = solve (h:xs)

output :: [Int] -> String
output [_, -1] = "-1\n"
output [h, 0] = intercalate "\n" $ replicate h "1"
output [h, x] = intercalate "\n" $ replicate (h-1) "1" ++ [show (x+1)]

main = getLine >>= putStrLn . output . solve . prepare 0 0 []

import Data.List (intercalate)

prepare :: Int -> Int -> [Int] -> String -> [Int]
prepare hashes prev res (c:cs)
    | c == '#' = prepare (hashes+1) next (next:res) cs
    | otherwise = prepare hashes next (next:res) cs
        where next = if c == '(' then prev + 1 else prev - 1
prepare h _ res _ = h : reverse res

solve :: [Int] -> [Int]
solve [h, x] = if x >= 0 then [h, x] else [h, -1]
solve (h:x:xs) | x == -1 = [h, -1]
               | otherwise = solve (h:xs)

output :: [Int] -> String
output [_, -1] = "-1\n"
output [h, 0] = intercalate "\n" $ replicate h "1"
output [h, x] = intercalate "\n" $ replicate (h-1) "1" ++ [show (x+1)]

main = getLine >>= putStrLn . output . solve . prepare 0 0 []

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

main :: IO ()
main = do
  cs <- getLine
  putStr.unlines.map show.maybe[-1]id $ solve cs

solve :: String -> Maybe [Int]
solve cs = go [] 0 cs
   where
     go res stk ('(':cs) = go res (stk+1) cs
     go res stk ('#':cs)
       | stk > 0 = go (1:res) (stk-1) cs
       | otherwise = Nothing
     go res stk (')':cs)
       | stk > 0 = go res (stk-1) cs
       | otherwise = Nothing
     go (r:res) stk [] = Just (reverse $ (r + stk) : res)
     go _ _ _ = Nothing

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

process [] n a | n<0 = [-1]
               | otherwise= reverse ( (n+1) : (tail a))

process (s:ss) n a	|n<0 = [-1]
			| s=='(' = process ss (n+1) a
			| s==')' = process ss (n-1) a
			| otherwise = process ss (n-1) (1:a)

main=do
	s<- getLine
	putStrLn $ intercalate "\n"$ map show $ process s 0 []

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

process [] n a | n==0 = reverse ( (n+1) : (tail a))
               | otherwise= [-1]

process (s:ss) n a	|n<0 = [-1]
			| s=='(' = process ss (n+1) a
			| s==')' = process ss (n-1) a
			| otherwise = process ss (n-1) (1:a)

main=do
	s<- getLine
	putStrLn $ intercalate "\n"$ map show $ process s 0 []


This is the easy version of the problem. The difference between the versions is that the easy version does not require you to output the numbers of the rods to be removed. You can make hacks only if all versions of the problem are solved.Stitch likes experimenting with different machines with his friend Sparky. Today they built another machine.The main element of this machine are $$$n$$$ rods arranged along one straight line and numbered from $$$1$$$ to $$$n$$$ inclusive. Each of these rods must carry an electric charge quantitatively equal to either $$$1$$$ or $$$-1$$$ (otherwise the machine will not work). Another condition for this machine to work is that the sign-variable sum of the charge on all rods must be zero.More formally, the rods can be represented as an array of $$$n$$$ numbers characterizing the charge: either $$$1$$$ or $$$-1$$$. Then the condition must hold: $$$a_1 - a_2 + a_3 - a_4 + \ldots = 0$$$, or $$$\sum\limits_{i=1}^n (-1)^{i-1} \cdot a_i = 0$$$.Sparky charged all $$$n$$$ rods with an electric current, but unfortunately it happened that the rods were not charged correctly (the sign-variable sum of the charge is not zero). The friends decided to leave only some of the rods in the machine. Sparky has $$$q$$$ questions. In the $$$i$$$th question Sparky asks: if the machine consisted only of rods with numbers $$$l_i$$$ to $$$r_i$$$ inclusive, what minimal number of rods could be removed from the machine so that the sign-variable sum of charges on the remaining ones would be zero? Perhaps the friends got something wrong, and the sign-variable sum is already zero. In that case, you don't have to remove the rods at all.If the number of rods is zero, we will assume that the sign-variable sum of charges is zero, that is, we can always remove all rods.Help your friends and answer all of Sparky's questions!

Each test contains multiple test cases. The first line contains one positive integer $$$t$$$ ($$$1 \le t \le 10^3$$$), denoting the number of test cases. Description of the test cases follows. The first line of each test case contains two positive integers $$$n$$$ and $$$q$$$ ($$$1 \le n, q \le 3 \cdot 10^5$$$) — the number of rods and the number of questions. The second line of each test case contains a non-empty string $$$s$$$ of length $$$n$$$, where the charge of the $$$i$$$-th rod is $$$1$$$ if $$$s_i$$$ is the "+" symbol, or $$$-1$$$ if $$$s_i$$$ is the "-" symbol. Each next line from the next $$$q$$$ lines contains two positive integers $$$l_i$$$ ans $$$r_i$$$ ($$$1 \le l_i \le r_i \le n$$$) — numbers, describing Sparky's questions. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$, and the sum of $$$q$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$.

For each test case, print a single integer — the minimal number of rods that can be removed.

NoteIn the first test case for the first query you can remove the rods numbered $$$5$$$ and $$$8$$$, then the following set of rods will remain: +--+--++-++-. It is easy to see that here the sign-variable sum is zero.In the second test case:  For the first query, we can remove the rods numbered $$$1$$$ and $$$11$$$, then the following set of rods will remain: --++---++---. It is easy to see that here the sign-variable sum is zero.  For the second query we can remove the rod numbered $$$9$$$, then the following set of rods will remain: ---++-. It is easy to see that here the variable sum is zero.  For the third query we can not remove the rods at all.

import Control.Monad
import qualified Data.Array.Unboxed as A
import Data.Array.Unboxed ((!))

type Arr = A.UArray Int Int
type Dp = Arr

countLeft' :: [Int] -> (Int,Char) -> [Int]
countLeft' lst@(b:xb) (i,'+') | (even i) = ((b+1):lst)
countLeft' lst@(b:xb) (i,'-') | (even i) = ((b-1):lst)
countLeft' lst@(b:xb) (i,'+') | otherwise = ((b-1):lst)
countLeft' lst@(b:xb) (i,'-') | otherwise = ((b+1):lst)

countLeft :: String -> [Int]
countLeft s =
  reverse $ foldl countLeft' [0] (zip [0..] s)

toArray :: [Int] -> Arr
toArray a = A.array (0,(length a)-1) (zip [0..] a)

prepare :: String -> Dp
prepare x = toArray $ countLeft x

query' :: Int -> Int -> Dp -> Int
query' l r _ | l > r = 0
query' l r dp | odd l = (dp ! r) - (dp ! (l-1))
query' l r dp | otherwise = (dp ! (l-1)) - (dp ! r)

query :: Int -> Int -> Dp -> Int
query l r dp =
  let sum = query' l r dp
  in
    if sum == 0 then 0
    else if even (r-l+1) then 2
    else 1

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [n,q] = map read $ words line :: [Int]
    str <- getLine
    --print str
    let dp = prepare str
    --print dp
    forM_ [1..q] $ \_ -> do
      line <- getLine
      let [l,r] = map read $ words line :: [Int]
      --print [l,r]
      let res = query l r dp
      print res

{-# LANGUAGE LambdaCase #-}

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

import Data.Array

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

type Input = (String, [(Int, Int)])
type Output = [Int]

input :: Scanner Input
input = do
  str
  q <- int
  (,) <$> str <*> (q >< pair int int)

output :: Output -> C.ByteString
output = C.unlines . map showB

solve :: Input -> Output
solve (s, qs) = map query qs
  where
    conv c i = (if c == '+' then 1 else -1) * (if odd i then 1 else -1)

    pref = listArray (0, length s) $ scanl (+) 0 $ zipWith conv s [0..]
    rsum l r = pref ! r - pref ! (l - 1)

    query (l, r)
      | rsum l r == 0 = 0
      | odd (r - l + 1) = 1
      | otherwise = 2

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show


Not so long ago, Vlad came up with an interesting function: $$$f_a(x)=\left\lfloor\frac{x}{a}\right\rfloor + x \bmod a$$$, where $$$\left\lfloor\frac{x}{a}\right\rfloor$$$ is $$$\frac{x}{a}$$$, rounded down, $$$x \bmod a$$$ — the remainder of the integer division of $$$x$$$ by $$$a$$$.For example, with $$$a=3$$$ and $$$x=11$$$, the value $$$f_3(11) = \left\lfloor\frac{11}{3}\right\rfloor + 11 \bmod 3 = 3 + 2 = 5$$$.The number $$$a$$$ is fixed and known to Vlad. Help Vlad find the maximum value of $$$f_a(x)$$$ if $$$x$$$ can take any integer value from $$$l$$$ to $$$r$$$ inclusive ($$$l \le x \le r$$$).

The first line of input data contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of input test cases. This is followed by $$$t$$$ lines, each of which contains three integers $$$l_i$$$, $$$r_i$$$ and $$$a_i$$$ ($$$1 \le l_i \le r_i \le 10^9, 1 \le a_i \le 10^9$$$) — the left and right boundaries of the segment and the fixed value of $$$a$$$.

For each test case, output one number on a separate line — the maximum value of the function on a given segment for a given $$$a$$$.

NoteIn the first sample:  $$$f_3(1) = \left\lfloor\frac{1}{3}\right\rfloor + 1 \bmod 3 = 0 + 1 = 1$$$,  $$$f_3(2) = \left\lfloor\frac{2}{3}\right\rfloor + 2 \bmod 3 = 0 + 2 = 2$$$,  $$$f_3(3) = \left\lfloor\frac{3}{3}\right\rfloor + 3 \bmod 3 = 1 + 0 = 1$$$,  $$$f_3(4) = \left\lfloor\frac{4}{3}\right\rfloor + 4 \bmod 3 = 1 + 1 = 2$$$ As an answer, obviously, $$$f_3(2)$$$ and $$$f_3(4)$$$ are suitable.

import Control.Monad (forM_)

solve :: Int -> Int -> Int -> Int
solve l r a = max (r `div` a + r `mod` a) (ll `div` a + ll `mod` a)
    where
        ll = max (r - (r `mod` a) - 1) l

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let [a, b, c] = (map read . words) l
        print $ solve a b c

import Control.Arrow

main = interact $ lines >>> drop 1 >>> map processTest >>> unlines

processTest = words >>> map read >>> solve >>> show

solve [l, r, a]
  | not (l <= r) = solve [r, l, a]
  | div l a == div r a = f a r
  | mod r a == a - 1 = f a r
  | otherwise = f a (r - mod r a - 1)

f a x = div x a + mod x a

import Data.List ( sort )
solve :: [String] -> [String]
solve = map (show . func)

func b
    | (l `div` a) == (r `div` a) = uncurry (+) (r `divMod` a)
    | (r `mod` a) == a-1 = uncurry (+) (r `divMod` a)
    | otherwise = (r `div` a) + a - 2
    where
        [l,r,a] = map read $ words b

main :: IO()
main = interact $ unlines.solve.tail.lines

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

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

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = (Int, Int, Int)
type OutType = Int

solve :: InType -> OutType
solve (l, r, a) = if x >= l then f x else f r
  where x = if r `mod` a == a - 1 then r else r - r `mod` a - 1
        f z = z `div` a + z `mod` a

receive :: [String] -> InType
receive [s] =
  case toArr s of
    [l, r, a] -> (l, r, a)
    _         -> error "input"

main :: IO ()
main = interact $ unlines . map (show . solve . receive) . chunksOf 1 . tail . lines

import Control.Monad (forM_)

solve :: Int -> Int -> Int -> Int
solve l r a = maximum [x `div` a + x `mod` a | x <- [r - (r `mod` a) - 1.. r]]

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let [a, b, c] = (map read . words) l
        print $ solve a b c

import Control.Monad (forM_)

solve :: Int -> Int -> Int -> Int
solve l r a = maximum [x `div` a + x `mod` a | x <- [ll .. r]]
  where
    ll = if r - l < l then l else r - l

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let [a, b, c] = (map read . words) l
        print $ solve a b c

import Control.Monad (forM_)

solve :: Int -> Int -> Int -> Int
solve l r a = max (b + c) (d + e)
    where
        b = r `mod` a
        c = r `div` a
        d = (r-1) `mod` a
        e = (r-1) `div` a

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let [n, b, x] = (map read . words) l
        print $ solve n b x


Polycarp had an array $$$a$$$ of $$$3$$$ positive integers. He wrote out the sums of all non-empty subsequences of this array, sorted them in non-decreasing order, and got an array $$$b$$$ of $$$7$$$ integers.For example, if $$$a = \{1, 4, 3\}$$$, then Polycarp wrote out $$$1$$$, $$$4$$$, $$$3$$$, $$$1 + 4 = 5$$$, $$$1 + 3 = 4$$$, $$$4 + 3 = 7$$$, $$$1 + 4 + 3 = 8$$$. After sorting, he got an array $$$b = \{1, 3, 4, 4, 5, 7, 8\}.$$$Unfortunately, Polycarp lost the array $$$a$$$. He only has the array $$$b$$$ left. Help him to restore the array $$$a$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 5000$$$) — the number of test cases. Each test case consists of one line which contains $$$7$$$ integers $$$b_1, b_2, \dots, b_7$$$ ($$$1 \le b_i \le 10^9$$$; $$$b_i \le b_{i+1}$$$).  Additional constraint on the input: there exists at least one array $$$a$$$ which yields this array $$$b$$$ as described in the statement.

For each test case, print $$$3$$$ integers — $$$a_1$$$, $$$a_2$$$ and $$$a_3$$$. If there can be several answers, print any of them.

NoteThe subsequence of the array $$$a$$$ is a sequence that can be obtained from $$$a$$$ by removing zero or more of its elements.Two subsequences are considered different if index sets of elements included in them are different. That is, the values of the elements don't matter in the comparison of subsequences. In particular, any array of length $$$3$$$ has exactly $$$7$$$ different non-empty subsequences.

import Control.Monad (forM_)

solve :: (Eq a, Num a) => [a] -> [a]
solve arr =
    if a + b == c then [a, b, d] else [a, b, c]
  where
    (a : b : c : d : cs) = arr

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ unwords $ map show $ solve arr

-- https://codeforces.com/contest/1618/problem/A
import Control.Monad (replicateM)

answer [a,_,_,_, ac, bc,_] = show a ++ " " ++ show b ++ " " ++ show c where
    c = ac - a
    b = bc - c

main = getLine >>= flip replicateM run . read
run = do
    line <- (read <$>) . words <$> getLine
    putStrLn $ answer line

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

solve :: IO ()
solve = do
    xs <- readInts
    let a = head xs
        b = a + minimum (map (subtract a) $ tail xs)
        c = last xs - a - b
    putStrLn $ unwords $ map show [a, b, c]

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

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


Given an array $$$a$$$ of $$$n$$$ integers, find a range of values $$$[x, y]$$$ ($$$x \le y$$$), and split $$$a$$$ into exactly $$$k$$$ ($$$1 \le k \le n$$$) subarrays in such a way that:  Each subarray is formed by several continuous elements of $$$a$$$, that is, it is equal to $$$a_l, a_{l+1}, \ldots, a_r$$$ for some $$$l$$$ and $$$r$$$ ($$$1 \leq l \leq r \leq n$$$).  Each element from $$$a$$$ belongs to exactly one subarray.  In each subarray the number of elements inside the range $$$[x, y]$$$ (inclusive) is strictly greater than the number of elements outside the range. An element with index $$$i$$$ is inside the range $$$[x, y]$$$ if and only if $$$x \le a_i \le y$$$.  Print any solution that minimizes $$$y - x$$$.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 3 \cdot 10^4$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 2 \cdot 10^5$$$) — the length of the array $$$a$$$ and the number of subarrays required in the partition. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$) where $$$a_i$$$ is the $$$i$$$-th element of the array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot10^5$$$.

For each test case, print $$$k+1$$$ lines. In the first line, print $$$x$$$ and $$$y$$$ — the limits of the found range. Then print $$$k$$$ lines, the $$$i$$$-th should contain $$$l_i$$$ and $$$r_i$$$ ($$$1\leq l_i \leq r_i \leq n$$$) — the limits of the $$$i$$$-th subarray. You can print the subarrays in any order.

NoteIn the first test, there should be only one subarray, which must be equal to the whole array. There are $$$2$$$ elements inside the range $$$[1, 2]$$$ and $$$0$$$ elements outside, if the chosen range is $$$[1, 1]$$$, there will be $$$1$$$ element inside ($$$a_1$$$) and $$$1$$$ element outside ($$$a_2$$$), and the answer will be invalid.In the second test, it is possible to choose the range $$$[2, 2]$$$, and split the array in subarrays $$$(1, 3)$$$ and $$$(4, 4)$$$, in subarray $$$(1, 3)$$$ there are $$$2$$$ elements inside the range ($$$a_2$$$ and $$$a_3$$$) and $$$1$$$ element outside ($$$a_1$$$), in subarray $$$(4, 4)$$$ there is only $$$1$$$ element ($$$a_4$$$), and it is inside the range.In the third test, it is possible to choose the range $$$[5, 5]$$$, and split the array in subarrays $$$(1, 4)$$$, $$$(5, 7)$$$ and $$$(8, 11)$$$, in the subarray $$$(1, 4)$$$ there are $$$3$$$ elements inside the range and $$$1$$$ element outside, in the subarray $$$(5, 7)$$$ there are $$$2$$$ elements inside and $$$1$$$ element outside and in the subarray $$$(8, 11)$$$ there are $$$3$$$ elements inside and $$$1$$$ element outside.

{-# LANGUAGE RecordWildCards #-}
import Control.Monad
import qualified Data.Array as AR
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C
import Text.Printf (printf)

data TC = TC { n::Int, k::Int, a::[Int]}

main = do
  [tt] <- readInts
  replicateM_ tt solve

solve = do
  TC {..} <- tc

  let
    b = AR.listArray (0, n - 1) (sort a)
    ar = AR.listArray (0, n - 1) a
    inc = (n + k + 1) `div` 2

  -- traceIO $ show b

  let
    search i x y
      | i == (n - inc + 1) = (x, y)
      | otherwise =
        let
          l = b AR.! i
          r = b AR.! (i + inc - 1)
        in
          if r - l < y - x
            then search (i + 1) l r
            else search (i + 1) x y

  let (x, y) = search 0 (-1) (n + 1)

  printf "%d %d\n" x y

  let
    splitAR::Int -> Int -> Int -> Int -> IO Int
    splitAR i last mx cur
      | i == n = pure last
      | otherwise = do
        let cur1 = cur + (if x <= (ar AR.! i) && ar AR.! i <= y then 1 else -1)
        if cur1 > mx
          then
            if cur1 >= 1 && cur1 <= k - 1
              then do
                printf "%d %d\n" (last + 2) (i + 1)
                splitAR (i + 1) i cur1 cur1
              else splitAR (i + 1) last cur1 cur1
        else splitAR (i + 1) last mx cur1

  lst <- splitAR 0 (-1) 0 0
  printf "%d %d\n" (lst + 2) n

tc = do
  [n, k] <- readInts
  TC n k <$> readInts

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    k <- getInt
    aLi <- replicateM n getInt
    let
      a :: UArray Int Int
      a = listArray (1, n) aLi
      -- need: sizeof ok - sizeof notok >= k
      -- i.e.  sz - (n - sz) >= k, i.e.  2 * sz >= n + k,
      -- i.e. sz >= div (n + k + 1) 2
      tarSz = div (n + k + 1) 2
      sa :: UArray Int Int
      sa = listArray (1, n) $ sort $ elems a
      (x, y) = minimumBy (\(x0, y0) (x1, y1) -> compare (y0 - x0) (y1 - x1))
        $ [(sa ! (i - tarSz + 1), sa ! i) | i <- [tarSz .. n]]
      getrs :: Int -> Int -> Int -> Int -> [[Int]]
      getrs i _ _ 1 = [[i, n]]
      getrs i j 1 left = [i, j] : getrs (j+1) j 0 (left - 1)
      getrs i j net left = let  ajp = a ! (j + 1)
        in  if  inRange (x, y) ajp
        then  getrs i (j + 1) (net + 1) left
        else  getrs i (j + 1) (net - 1) left
    pure $ putInts [x, y] <> foldMap putInts (getrs 1 0 0 k)

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    k <- getInt
    aLi <- replicateM n getInt
    let
      a :: UArray Int Int
      a = listArray (1, n) aLi
      -- need: sizeof ok - sizeof notok >= k
      -- i.e.  sz - (n - sz) >= k, i.e.  2 * sz >= n + k,
      -- i.e. sz >= div (n + k + 1) 2
      tarSz = div (n + k + 1) 2
      sa :: UArray Int Int
      sa = listArray (1, n) $ sort $ elems a
      (x, y) = minimumBy (\(x0, y0) (x1, y1) -> compare (y0 - x0) (x1 - y1))
        $ [(sa ! (i - tarSz + 1), sa ! i) | i <- [tarSz .. n]]
      getrs :: Int -> Int -> Int -> Int -> [[Int]]
      getrs i _ _ 1 = [[i, n]]
      getrs i j 1 left = [i, j] : getrs (j+1) j 0 (left - 1)
      getrs i j net left = let  ajp = a ! (j + 1)
        in  if  inRange (x, y) ajp
        then  getrs i (j + 1) (net + 1) left
        else  getrs i (j + 1) (net - 1) left
    pure $ putInts [x, y] <> foldMap putInts (getrs 1 0 0 k)

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


This is the easy version of the problem. The difference between the versions is that in the easy version all prices $$$a_i$$$ are different. You can make hacks if and only if you solved both versions of the problem.Today is Sage's birthday, and she will go shopping to buy ice spheres. All $$$n$$$ ice spheres are placed in a row and they are numbered from $$$1$$$ to $$$n$$$ from left to right. Each ice sphere has a positive integer price. In this version all prices are different.An ice sphere is cheap if it costs strictly less than two neighboring ice spheres: the nearest to the left and the nearest to the right. The leftmost and the rightmost ice spheres are not cheap. Sage will choose all cheap ice spheres and then buy only them.You can visit the shop before Sage and reorder the ice spheres as you wish. Find out the maximum number of ice spheres that Sage can buy, and show how the ice spheres should be reordered.

The first line contains a single integer $$$n$$$ $$$(1 \le n \le 10^5)$$$ — the number of ice spheres in the shop. The second line contains $$$n$$$ different integers $$$a_1, a_2, \dots, a_n$$$ $$$(1 \le a_i \le 10^9)$$$ — the prices of ice spheres.

In the first line print the maximum number of ice spheres that Sage can buy. In the second line print the prices of ice spheres in the optimal order. If there are several correct answers, you can print any of them.

NoteIn the example it's not possible to place ice spheres in any order so that Sage would buy $$$3$$$ of them. If the ice spheres are placed like this $$$(3, 1, 4, 2, 5)$$$, then Sage will buy two spheres: one for $$$1$$$ and one for $$$2$$$, because they are cheap.

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

main = do
  getLine
  as <- sort . map read . words <$> getLine :: IO [Integer]
  let solution = solve as
  print $ cheap solution
  putStrLn $ unwords $ map show solution

solve as
  | even $ length as = (\(a, b) -> [a, b]) =<< zip (as !! pred d : take (pred d) as) (drop d as)
  | otherwise = (as !! d :) $ (\(a, b) -> [a, b]) =<< zip (take d as) (drop (succ d) as)
  where
    d = length as `div` 2

cheap = length . filter (\(a, b, c) -> a > b && b < c) . (zip3 <*> tail <*> tail . tail)

import Data.List

main :: IO ()
main = do
  n <- readLn
  as <- (map read.words) <$> getLine
  let (a,b) = solve n as
  print a
  putStrLn $ (unwords.map show) b

solve :: Int -> [Int] -> (Int,[Int])
solve n as = ((n-1) `div` 2, merge bigs smalls)
  where
    as' = sort as
    (smalls,bigs) = splitAt ((n-1) `div` 2) as'

merge :: [a] -> [a] -> [a]
merge (a:as) (b:bs) = a:b:merge as bs
merge as bs = as ++ bs

import Data.List
import Data.Int
import Data.Char
import Control.Monad
import Data.Bits

readArray :: IO [Int64]
readArray = do
    line <- getLine
    return $ map (read::String->Int64) $ words line

readInt :: IO Int
readInt = do
    line <- getLine
    return $ (read::String->Int) $ line

count :: Eq a => a -> [a] -> Int
count x = length . filter (==x)

merge :: [a] -> [a] -> [a]
merge [] ys = ys
merge (x:xs) ys = x:(merge ys xs)

calc :: [Int64] -> Int64
calc (x:y:z:xs) = (if y < x && y < z then 1 else 0) + calc (z:xs)
calc _ = 0

solve :: IO ()
solve = do
    n <- readInt
    b <- readArray
    let a = reverse $ sort b
    let (large,small) = splitAt ((n + 1) `div` 2) a
    let res = merge large small
    let answer = calc res
    print answer
    forM_ res $ (\x -> print x)
    return ()

main :: IO ()
main = do
    -- t <- readInt
    -- forM_ [0..t-1] $ (\i -> solve)
    solve

import Data.List

trySolve :: Int -> [Int] -> Int -> Maybe [Int]
trySolve n as k = if  k + k + 1 > n
  then  Nothing
  else  let
    (lows, nonlows) = splitAt k as
    (rev_his, mids) = splitAt (k+1) (reverse nonlows)
    his = reverse rev_his
  in  if  and $ zipWith (<) lows his
  then  Just $ stitch lows his ++ mids
  else  Nothing

stitch :: [Int] -> [Int] -> [Int]
stitch [] [] = []
stitch ps (q:qs) = q : stitch qs ps
stitch _ _ = error "stitch: invalid args"

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p = let
  go low top = if  low == top
    then  low
    else  let
    mid = div (low + top + 1) 2
    in  if  p mid
    then  go mid top
    else  go low (mid - 1)
  in  go

solve :: Int -> [Int] -> (Int, [Int])
solve n li = let
  p k = case  trySolve n li k  of
    Nothing -> False
    _ -> True
  ktar = binSearch p 0 (n + 100)
  in  case  trySolve n li ktar  of
    Nothing -> error "binSearch failed?"
    Just ans -> (ktar, ans)

main :: IO ()
main = do
  n <- read <$> getLine
  a <- map read . words <$> getLine
  let  (ktar, ans) = solve n (sort a)
  print ktar
  putStrLn . unwords $ map show ans


CQXYM is counting permutations length of $$$2n$$$.A permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$[2,3,1,5,4]$$$ is a permutation, but $$$[1,2,2]$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$[1,3,4]$$$ is also not a permutation ($$$n=3$$$ but there is $$$4$$$ in the array).A permutation $$$p$$$(length of $$$2n$$$) will be counted only if the number of $$$i$$$ satisfying $$$p_i<p_{i+1}$$$ is no less than $$$n$$$. For example:  Permutation $$$[1, 2, 3, 4]$$$ will count, because the number of such $$$i$$$ that $$$p_i<p_{i+1}$$$ equals $$$3$$$ ($$$i = 1$$$, $$$i = 2$$$, $$$i = 3$$$). Permutation $$$[3, 2, 1, 4]$$$ won't count, because the number of such $$$i$$$ that $$$p_i<p_{i+1}$$$ equals $$$1$$$ ($$$i = 3$$$). CQXYM wants you to help him to count the number of such permutations modulo $$$1000000007$$$ ($$$10^9+7$$$).In addition, modulo operation is to get the remainder. For example:  $$$7 \mod 3=1$$$, because $$$7 = 3 \cdot 2 + 1$$$,  $$$15 \mod 4=3$$$, because $$$15 = 4 \cdot 3 + 3$$$.

The input consists of multiple test cases.  The first line contains an integer $$$t (t \geq 1)$$$ — the number of test cases. The description of the test cases follows. Only one line of each test case contains an integer $$$n(1 \leq n \leq 10^5)$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$

For each test case, print the answer in a single line.

import Control.Monad
import Data.Int

bound :: Int64
bound = 1000000007

calc :: Int64 -> Int64
calc n =
  foldl (\acc x -> (acc*x) `mod` bound) 1 [3..n]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line
    print $ calc (2*n)

import Control.Monad

bound :: Int
bound = 1000000007

calc :: Int -> Int
calc n =
  foldl (\acc x -> (acc*x) `mod` bound) 1 [3..n]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line
    print $ calc (2*n)


Valera has array a, consisting of n integers a0, a1, ..., an - 1, and function f(x), taking an integer from 0 to 2n - 1 as its single argument. Value f(x) is calculated by formula , where value bit(i) equals one if the binary representation of number x contains a 1 on the i-th position, and zero otherwise.For example, if n = 4 and x = 11 (11 = 20 + 21 + 23), then f(x) = a0 + a1 + a3.Help Valera find the maximum of function f(x) among all x, for which an inequality holds: 0 ≤ x ≤ m.

The first line contains integer n (1 ≤ n ≤ 105) — the number of array elements. The next line contains n space-separated integers a0, a1, ..., an - 1 (0 ≤ ai ≤ 104) — elements of array a. The third line contains a sequence of digits zero and one without spaces s0s1... sn - 1 — the binary representation of number m. Number m equals .

Print a single integer — the maximum value of function f(x) for all .

NoteIn the first test case m = 20 = 1, f(0) = 0, f(1) = a0 = 3.In the second sample m = 20 + 21 + 23 = 11, the maximum value of function equals f(5) = a0 + a2 = 17 + 10 = 27.

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
-- import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
-- import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
-- import Data.HashMap.Strict (HashMap)
-- import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  as <- getInts
  m <- getLine

  let
    ls = scanl (+) 0 as
    rs = scanr (+) 0 $ zipWith (\a b -> if b == '1' then a else 0) as m
    r = maximum $ zipWith3 (\l a r -> if a == '1' then l + r else 0) ls m $ tail rs

  print $ max r $ head rs

{-# 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
--import System.IO

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

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

solution :: [Int] -> [Char] -> Int -> Int -> Int -> Int
solution [] _ acc curmax _  = max acc curmax
solution (a:as) ('0':bs)   acc curmax s = solution as bs acc curmax (s-a)
solution (a:as) ('1':bs)   acc curmax s = solution as bs (acc + a) (max curmax (acc+s')) s'
    where s' = s - a

main = do
    _ <- getLine
    a <- readsInt
    b <- getLine
    print $ solution (reverse a) (reverse b) 0 0 (sum a)

{-# 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 <- readLn
    l <- readsLine
    m <- getLine
    print $ solve n l m

solve :: Int -> [Int] -> String -> Int
solve n l m = go (reverse l) (reverse m) (sum l) 0
    where
    go (a:as) ('0':m) !s !sm = go as m (s-a) sm
    go (a:as) ('1':m) !s !sm = go as m s     (max sm (s-a))
    go [] _ s sm = max sm s

{-# 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 <- readLn
    l <- readsInt
    m <- getLine
    print $ solve n l m

solve :: Int -> [Int] -> String -> Int
solve n l m = go (reverse l) (reverse m) (sum l) 0
    where
    go (a:as) ('0':m) !s !sm = go as m (s-a) sm
    go (a:as) ('1':m) !s !sm = go as m s     (max sm (s-a))
    go [] _ s sm = max sm s

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

import Control.Applicative
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List
import Data.Ord

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

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  bits <- map digitToInt.B.unpack.fst.B.spanEnd (\c-> isSpace c || c == '0') <$> B.getLine
  let !l = length bits
  print $ solve l (take l xs) bits

solve :: Int -> [Int] -> [Int] -> Int
solve 0 [] [] = 0
solve 1 [x] [b] = b * x
solve n xs bits = max (unsafeAt sumR 0).maximum $ map f [0..n-1]
   where
     arr = listArray (0,n-1) bits :: UArray Int Int
     sumR = listArray (0,n-1) $ scanr1 (+) $ zipWith (*) xs bits :: UArray Int Int
     sumL = listArray (0,n-1) $ scanl1 (+) xs :: UArray Int Int
     f i
       | unsafeAt arr i == 0 = unsafeAt sumR 0
       | i == n-1  = unsafeAt sumL (i-1)
       | i == 0    = unsafeAt sumR (i+1)
       | otherwise = unsafeAt sumL (i-1) + unsafeAt sumR (i+1)

solve_ :: [Integer] -> String -> (Integer, Integer)
solve_ [] [] = (0, 0)
solve_ (x:xs) (y:ys)
        | y == '1'  = (max (x + ans) sum, x + sum)
        | otherwise = (ans, x + sum)
    where (ans, sum) = solve_ xs ys

solve :: String -> String -> Integer
solve a m = ans
    where (ans, sum) = solve_ (map read $ reverse $ words a) $ reverse m

main = do
    n <- getLine
    a <- getLine
    m <- getLine
    print $ solve a m

module Main where

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List (foldl')
main :: IO ()
main = do
  xs <- fmap BS.words BS.getContents
  let m = BS.unpack $ last xs
      c:ns = map (fst . fromJust . BS.readInteger) (init xs)
  print $ rush c (m) (ns)

rush _ m xs
  | '1' `notElem` m = 0
  | otherwise = maximum (r:ls)
    where b = zipWith (\n i -> if i == '1' then (n,True) else (n,False)) xs m
          r = one b
          (_,_,ls) = foldl' (\(cums,rs,l) (x,h)-> (cums+x,if h then rs+x else rs,
                                        if h then ((r - rs - x)+cums):l else l))
                                        (0,0,[]) b

one = foldl' (\a (l,b) -> if b then l + a else a) 0

two x = let c = dropWhile (not . snd) x
            s1 = map fst $ takeWhile snd c
            s2 = one  . map (\(x,_) -> (x,True)) $ c
        in s2 - minimum s1

import System.IO

solution :: [Int] -> [Char] -> Int -> Int
solution [] _ acc = acc
solution a b acc = max s t
    where (a',b') = unzip $ dropWhile (\(_,bit) -> bit == '0') $ zip a b
          s = sum $ tail a'
          t = solution (tail a') (tail b') (acc + (head a'))

main = do
    _ <- getLine
    as <- getLine
    b <- getLine
    let a = map (\s -> read s :: Int) $ words as
        r = solution (reverse a) (reverse b) 0

    print r

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

import Control.Applicative
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List
import Data.Ord

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

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  bits <- map digitToInt.B.unpack.fst.B.spanEnd (\c-> isSpace c || c == '0') <$> B.getLine
  let !l = length bits
  print $ solve l (take l xs) bits

solve :: Int -> [Int] -> [Int] -> Int
solve 1 [x] [b] = b * x
solve n xs bits = max (unsafeAt sumR 0).maximum $ map f [0..n-1]
   where
     arr = listArray (0,n-1) xs :: UArray Int Int
     sumR = listArray (0,n-1) $ scanr1 (+) $ zipWith (*) xs bits :: UArray Int Int
     sumL = listArray (0,n-1) $ scanl1 (+) xs :: UArray Int Int
     f i
       | unsafeAt arr i == 0 = unsafeAt sumR 0
       | i == n-1  = unsafeAt sumL (i-1)
       | i == 0    = unsafeAt sumR (i+1)
       | otherwise = unsafeAt sumL (i-1) + unsafeAt sumR (i+1)

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

import Control.Applicative
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List
import Data.Ord

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

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  bits <- map digitToInt.B.unpack.fst.B.spanEnd (\c-> isSpace c || c == '0') <$> B.getLine
  let l = length bits
  print $ solve l (take l xs) bits

solve :: Int -> [Int] -> [Int] -> Int
solve 1 [x] [b] = b * x
solve n xs bits = maximum $ map f [0..n-1]
   where
     arr = listArray (0,n-1) xs :: UArray Int Int
     sumR = listArray (0,n-1) $ scanr1 (+) $ zipWith (*) xs bits :: UArray Int Int
     sumL = listArray (0,n-1) $ scanl1 (+) xs :: UArray Int Int
     f i
       | unsafeAt arr i == 0 = unsafeAt sumR 0
       | i == n-1  = unsafeAt sumL (i-1)
       | i == 0    = unsafeAt sumR (i+1)
       | otherwise = unsafeAt sumL (i-1) + unsafeAt sumR (i+1)

module Main where

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List (foldl')
main :: IO ()
main = do
  xs <- fmap BS.words BS.getContents
  let m = BS.unpack $ last xs
      c:ns = map (fst . fromJust . BS.readInteger) (init xs)
  print $ rush c (reverse m) (reverse ns)

rush _ m xs
  | '1' `notElem` m = 0
  | otherwise = max (one b) (two b)
    where b = zipWith (\n i -> if i == '1' then (n,True) else (n,False)) xs m

one = foldl' (\a (l,b) -> if b then l + a else a) 0

two x = let c = dropWhile (not . snd) x
            s1 = map fst $ takeWhile snd c
            s2 = one  . map (\(x,_) -> (x,True)) $ c
        in s2 - minimum s1

module Main where

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List (foldl')
main :: IO ()
main = do
  xs <- fmap BS.words BS.getContents
  let m = BS.unpack $ last xs
      c:ns = map (fst . fromJust . BS.readInt) (init xs)
  print $ rush c (reverse m) (reverse ns)

rush :: Int -> String -> [Int] -> Int
rush c m xs
  | '1' `notElem` m = 0
  | otherwise = max (one b) (two b)
    where b = zipWith (\n i -> if i == '1' then (n,True) else (n,False)) xs m

one :: [(Int,Bool)] -> Int
one = foldl' (\a (l,b) -> if b then l + a else a) 0

two :: [(Int,Bool)] -> Int
two x = let c = dropWhile (not . snd) x
            s1 = (one . init . takeWhile snd) c
            s2 = one  . map (\(x,_) -> (x,True)) . dropWhile snd $ c
        in s1 + s2

module Main where

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List (foldl')
main :: IO ()
main = do
  xs <- fmap BS.words BS.getContents
  let m = BS.unpack $ last xs
      c:ns = map (fst . fromJust . BS.readInteger) (init xs)
  print $ rush c (reverse m) (reverse ns)

rush _ m xs
  | '1' `notElem` m = 0
  | otherwise = max (one b) (two b)
    where b = zipWith (\n i -> if i == '1' then (n,True) else (n,False)) xs m

one = foldl' (\a (l,b) -> if b then l + a else a) 0

two x = let c = dropWhile (not . snd) x
            s1 = (one . init . takeWhile snd) c
            s2 = one  . map (\(x,_) -> (x,True)) . dropWhile snd $ c
        in s1 + s2