Roma works in a company that sells TVs. Now he has to prepare a report for the last year.Roma has got a list of the company's incomes. The list is a sequence that consists of n integers. The total income of the company is the sum of all integers in sequence. Roma decided to perform exactly k changes of signs of several numbers in the sequence. He can also change the sign of a number one, two or more times.The operation of changing a number's sign is the operation of multiplying this number by -1.Help Roma perform the changes so as to make the total income of the company (the sum of numbers in the resulting sequence) maximum. Note that Roma should perform exactly k changes.

The first line contains two integers n and k (1 ≤ n, k ≤ 105), showing, how many numbers are in the sequence and how many swaps are to be made. The second line contains a non-decreasing sequence, consisting of n integers ai (|ai| ≤ 104). The numbers in the lines are separated by single spaces. Please note that the given sequence is sorted in non-decreasing order.

In the single line print the answer to the problem — the maximum total income that we can obtain after exactly k changes.

NoteIn the first sample we can get sequence [1, 1, 1], thus the total income equals 3.In the second test, the optimal strategy is to get sequence [-1, 1, 1], thus the total income equals 1.

import Data.List

main :: IO ()
main = do
  [_, k] <- fmap (map read . words) getLine
  income <- fmap (map read . words) getLine
  let (less, _) = partition (< 0) income
      (pre, post)  = splitAt k income
      allPos = map abs pre ++ post
      m = minimum $ map abs income

  if (length less >= k) then
    print $ sum allPos
  else
    if (k - length less) `mod` 2 == 0 then
      print $ sum allPos
    else
      print $ sum $ allPos ++ [-m, -m]

import Control.Monad (liftM)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Int -> [Int] -> Int
solve k xs
  | k <= m  =  sum $ zipWith (*) xs $ replicate k (-1) ++ [1,1..]
  | even (k - m)  =  sum xs'
  | otherwise  =  sum xs' - 2 * minimum xs'
  where
    xs'  =  map abs xs
    m  =  length $ filter (<= 0) xs

main :: IO ()
main  =  do
    [n, k]  <-  reads
    xs  <-  reads
    print $ solve k xs

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

solve (k:values) =
  sum finalValues - if restK `mod` 2 == 1
                    then 2 * minimum finalValues
                    else 0
  where finalValues = left ++ right
        restK = k - usedK
        usedK = length left
        left = map negate $ take k $ takeWhile (<0) values
        right = drop usedK values

parseInt = fst . fromJust . BS.readInt

main = BS.interact $ BS.pack . show . solve . map parseInt . tail . BS.words

solve (k:values) =
  sum finalValues - if restK `mod` 2 == 1
                    then 2 * minimum finalValues
                    else 0
  where finalValues = left ++ right
        restK = k - usedK
        usedK = length left
        left = map negate $ take k $ takeWhile (<0) values
        right = drop usedK values

main = interact $ show . solve . map read . tail . words

module Main where

solve :: Int -> [Int] -> [Int] -> Int
solve 0 neg pos = sum neg + sum pos
solve k [] pos = sum pos - 2 * head pos * (k `mod` 2)
solve k neg []
      | length neg >= k = sum (drop k neg) - sum (take k neg)
      | otherwise = -(sum neg) + 2 * last neg * ((k - length neg) `mod` 2)
solve k neg pos
      | length neg >= k = sum (drop k neg) + sum pos - sum (take k neg)
      | otherwise = if (-(last neg)) > head pos
                    then sum pos - sum neg - 2 * head pos * ((k - length neg) `mod` 2)
                    else sum pos - sum neg + 2 * last neg * ((k - length neg) `mod` 2)

main = do
     rStr <- getLine
     let [_, k] = map read $ words rStr
     revenuesStr <- getLine
     let (negative, positive) = span (<0) $ map read $ words revenuesStr
     print $ solve k negative positive

import qualified Data.ByteString.Char8 as B
import Data.List

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

main = B.getContents >>= print.sum.f.map readInt.B.words
f(n:k:x)
  | len >= k = let (y,z)  = splitAt k nx in map abs y ++ z ++ px
  | len == 0 && (head x==0 || even k) = x
  | len == 0 = negate (head x) : tail x
  | otherwise = f $ n:(k-len):sort(map abs x)
   where
     (nx,px)=partition(<0)x
     len = length nx

#!/usr/bin/env runghc
import Data.List

main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (m:a:cs) = show $ if k < nel then (sum as - sum (take k as) * 2) else (sum pl - sum ne - fl * ((k-nel)`mod`2) * 2)
  where
    [n,k] = map read . words $ m
    as = sort . map read . words $ a
    (ne,pl) = partition (<0) as
    nel = length ne
    pll = length pl
    fl = if nel==0 then (head pl) else (if pll==0 then (-(last ne)) else (min (head pl) (-(last ne))))

module Main where

solve :: Int -> [Int] -> [Int] -> Int
solve 0 neg pos = sum neg + sum pos
solve k [] pos = (sum pos) - 2 * (head pos) * (k `mod` 2)
solve k neg []
      | length neg >= k = sum (drop k neg) - sum (take k neg)
      | otherwise = -(sum neg) + 2 * (last neg) * ((k - (length neg)) `mod` 2)
solve k neg pos
      | length neg >= k = sum (drop k neg) + sum pos - sum (take k neg)
      | otherwise = if (-(last neg)) > (head pos)
                    then (sum pos) - (sum neg) - 2 * (head pos) * ((k - (length neg)) `mod` 2)
                    else (sum pos) - (sum neg) + 2 * (last neg) * ((k - (length neg)) `mod` 2)

main = do
     nkStr <- getLine
     let nk = map (read :: String -> Int) $ words nkStr
         k = nk!!1
     revenuesStr <- getLine
     let revenues = map (read :: String -> Int) $ words revenuesStr
         (negative, positive) = span (<0) revenues
     print $ solve k negative positive

import Control.Applicative
import Data.List
main = do
    [n,k] <- map read . words <$> getLine
    ns <- map read . take n . words <$> getLine
    let
        (neg, pos) = span (<0) ns
        ans = sum $ change neg pos $ k
        ans' = sum $ change' neg k
        ansPos = sum $ changePos pos k
    if length pos == 0 then print ans'
        else if length neg == 0 then print ansPos
            else print ans

f neg@(n:ns) pos@(m:ms) k
    | k `mod` 2 == 0 = neg ++ pos
    | True = case n > m of
                True -> neg ++ (-m):ms
                False -> (-n):ns ++ pos
change neg pos k
    | length neg < k = f (reverse $ map (*(-1)) $ neg) pos (k - length neg)
    | True           = (map (*(-1)) $ take k $ neg) ++ drop k neg ++ pos

f' neg@(n:ns) k
    | k `mod` 2 == 0 = neg
    | True = (-n):ns
change' neg k
    | length neg < k = f' (reverse $ map (*(-1)) $ neg) (k - length neg)
    | True           = (map (*(-1)) $ take k $ neg) ++ drop k neg

changePos (p:ps) k
    | k `mod` 2 == 0 = p:ps
    | True = (-p):ps

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

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- map read . words <$> getLine
	let
		negas = min ( length ( filter ( < 0 ) as ) ) k
		rest = ( k - negas ) `mod` 2
		tmp = sort . change negas $ as
		res = if 0 `elem` tmp then sum tmp else sum $ change rest tmp
	print res

change :: Int -> [Int] -> [Int]
change _ [] = []
change 0 as = as
change n (a:as) = a * ( -1 ) : change ( n - 1 ) as

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

solve (n : k : a)
    | k <= l                = sum pos + (sum . take k . map negate $ npos) + (sum . drop k $ npos)
    | mod (k - l) 2 == 0    = sum . map abs $ a
    | otherwise             = (sum . map abs $ a) - 2 * (minimum . map abs $ a)
    where
        npos = filter (<=0) $ a
        pos = filter (>0) $ a
        l = length npos

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

solve (n : k : a)
    | k <= l                = sum pos + (sum . take k . map (*(-1)) $ npos) + (sum . drop k $ npos)
    | mod (l - k) 2 == 0    = sum . map abs $ a
    | otherwise             = (sum . map abs $ a) + (minimum . map abs $ a)
    where
        npos = filter (<=0) $ a
        pos = filter (>0) $ a
        l = length npos

main :: IO ()
main = do
  [_, k] <- fmap (map read) $ words `fmap` getLine
  income <- fmap (map read) $ words `fmap` getLine
  let (pre, post) = splitAt k income
  print $ sum $ map abs pre ++ post

import Data.List

main :: IO ()
main = do
  [_, k] <- fmap (map read) $ words `fmap` getLine
  income <- fmap (map read) $ words `fmap` getLine
  let (less, more) = partition ((>=) 0) income
      (pre, post)  = splitAt k income
      allPos = map abs pre ++ post
      m = minimum $ map abs income

  if (length less >= k) then
    print $ sum allPos
  else
    if k `mod` 2 == 0 then
      print $ sum allPos
    else
      print $ sum $ allPos ++ [-m, -m]

import Data.List

main :: IO ()
main = do
  [_, k] <- fmap (map read . words) getLine
  income <- fmap (map read . words) getLine
  let (less, _) = partition (>= 0) income
      (pre, post)  = splitAt k income
      allPos = map abs pre ++ post
      m = minimum $ map abs income

  if (length less >= k) then
    print $ sum allPos
  else
    if (k - length less) `mod` 2 == 0 then
      print $ sum allPos
    else
      print $ sum $ allPos ++ [-m, -m]

import qualified Data.ByteString.Char8 as B

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

main = B.getContents >>= print.sum.f.map readInt.B.words
f(n:k:x)|(y,z)<-splitAt k x=map negate y++z

import qualified Data.ByteString.Char8 as B
import Data.List

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

main = B.getContents >>= print.sum.f.map readInt.B.words
f(n:k:x)
  | len >= k = let (y,z)  = splitAt k nx in map abs y ++ z ++ px
  | len == 0 && even (head x) = x
  | len == 0 = negate (head x) : tail x
  | otherwise = f $ n:(k-len):sort(map abs x)
   where
     (nx,px)=partition(<0)x
     len = length nx

#!/usr/bin/env runghc
import Data.List

main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (m:a:cs) = show $ (sum . map (*(-1)) $ take k as) + (sum $ drop k as)
  where
    k = read . head . tail . words $ m
    as = sort . map read . words $ a

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

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- map read . words <$> getLine
	let
		negas = max ( length ( filter ( < 0 ) as ) ) k
		rest = ( k - negas ) `mod` 2
		tmp = sort . change negas $ as
		res = sum $ change rest tmp
	print res

change :: Int -> [Int] -> [Int]
change _ [] = []
change 0 as = as
change n (a:as) = a * ( -1 ) : change ( n - 1 ) as

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

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- map read . words <$> getLine
	let
		negas = max ( length ( filter ( < 0 ) as ) ) k
		rest = ( k - negas ) `mod` 2
		tmp = sort . change negas $ as
		res = if 0 `elem` tmp then sum tmp else sum $ change rest tmp
	print res

change :: Int -> [Int] -> [Int]
change _ [] = []
change 0 as = as
change n (a:as) = a * ( -1 ) : change ( n - 1 ) as

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

solve (n : k : a)
    | k <= l                = sum pos + (sum . take k . map negate $ npos) + (sum . drop k $ npos)
    | mod (k - l) 2 == 0    = sum . map abs $ a
    | otherwise             = (sum . map abs $ a) - (minimum . map abs $ a)
    where
        npos = filter (<=0) $ a
        pos = filter (>0) $ a
        l = length npos


A string is called bracket sequence if it does not contain any characters other than "(" and ")". A bracket sequence is called regular (shortly, RBS) if it is possible to obtain correct arithmetic expression by inserting characters "+" and "1" into this sequence. For example, "", "(())" and "()()" are RBS and ")(" and "(()" are not.We can see that each opening bracket in RBS is paired with some closing bracket, and, using this fact, we can define nesting depth of the RBS as maximum number of bracket pairs, such that the $$$2$$$-nd pair lies inside the $$$1$$$-st one, the $$$3$$$-rd one — inside the $$$2$$$-nd one and so on. For example, nesting depth of "" is $$$0$$$, "()()()" is $$$1$$$ and "()((())())" is $$$3$$$.Now, you are given RBS $$$s$$$ of even length $$$n$$$. You should color each bracket of $$$s$$$ into one of two colors: red or blue. Bracket sequence $$$r$$$, consisting only of red brackets, should be RBS, and bracket sequence, consisting only of blue brackets $$$b$$$, should be RBS. Any of them can be empty. You are not allowed to reorder characters in $$$s$$$, $$$r$$$ or $$$b$$$. No brackets can be left uncolored.Among all possible variants you should choose one that minimizes maximum of $$$r$$$'s and $$$b$$$'s nesting depth. If there are multiple solutions you can print any of them.

The first line contains an even integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the length of RBS $$$s$$$. The second line contains regular bracket sequence $$$s$$$ ($$$|s| = n$$$, $$$s_i \in \{$$$"(", ")"$$$\}$$$).

Print single string $$$t$$$ of length $$$n$$$ consisting of "0"-s and "1"-s. If $$$t_i$$$ is equal to 0 then character $$$s_i$$$ belongs to RBS $$$r$$$, otherwise $$$s_i$$$ belongs to $$$b$$$.

NoteIn the first example one of optimal solutions is $$$s = $$$ "$$$\color{blue}{()}$$$". $$$r$$$ is empty and $$$b = $$$ "$$$()$$$". The answer is $$$\max(0, 1) = 1$$$.In the second example it's optimal to make $$$s = $$$ "$$$\color{red}{(}\color{blue}{(}\color{red}{)}\color{blue}{)}$$$". $$$r = b = $$$ "$$$()$$$" and the answer is $$$1$$$.In the third example we can make $$$s = $$$ "$$$\color{red}{(}\color{blue}{((}\color{red}{)()}\color{blue}{)())}$$$". $$$r = $$$ "$$$()()$$$" and $$$b = $$$ "$$$(()())$$$" and the answer is $$$2$$$.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = do
	getLine
	s <- getLine
	let
		ds = scanl1 (+) $ map ( \c -> if c == '(' then 1 else -1 ) s
		md = maximum ds
		th = md `div` 2
	putStrLn $ map ( \( c, d ) -> if ( c == '(' && th < d || c == ')' && th <= d ) then '1' else '0' ) $ zip s ds

import Data.Sequence
import Data.Foldable (toList)

main :: IO ()
main = getLine >> solve <$> getLine >>= putStrLn

solve :: String -> String
solve = toList. fst . foldl modify (empty, ((0,0), (0,0)))

type S = (Seq Char, ((Int, Int), (Int, Int)))

modify :: S -> Char -> S
modify (s, ((a, b), (c, d))) '(' = (s', ((aa, bb), (cc, dd)))
    where (s', (aa, bb)) = if a < b then (s |> '1', (a + 1, b)) else (s |> '0', (a, b + 1))
          (cc, dd) = (max aa c, max bb d)

modify (s, ((a, b), (c, d))) _ = (s', ((aa, bb), (c, d)))
    where (s', (aa, bb)) =  if a > b then (s |> '1', (a - 1, b)) else (s |> '0', (a , b - 1))


Vasiliy has an exam period which will continue for n days. He has to pass exams on m subjects. Subjects are numbered from 1 to m.About every day we know exam for which one of m subjects can be passed on that day. Perhaps, some day you can't pass any exam. It is not allowed to pass more than one exam on any day. On each day Vasiliy can either pass the exam of that day (it takes the whole day) or prepare all day for some exam or have a rest. About each subject Vasiliy know a number ai — the number of days he should prepare to pass the exam number i. Vasiliy can switch subjects while preparing for exams, it is not necessary to prepare continuously during ai days for the exam number i. He can mix the order of preparation for exams in any way.Your task is to determine the minimum number of days in which Vasiliy can pass all exams, or determine that it is impossible. Each exam should be passed exactly one time.

The first line contains two integers n and m (1 ≤ n, m ≤ 105) — the number of days in the exam period and the number of subjects.  The second line contains n integers d1, d2, ..., dn (0 ≤ di ≤ m), where di is the number of subject, the exam of which can be passed on the day number i. If di equals 0, it is not allowed to pass any exams on the day number i.  The third line contains m positive integers a1, a2, ..., am (1 ≤ ai ≤ 105), where ai is the number of days that are needed to prepare before passing the exam on the subject i.

Print one integer — the minimum number of days in which Vasiliy can pass all exams. If it is impossible, print -1.

NoteIn the first example Vasiliy can behave as follows. On the first and the second day he can prepare for the exam number 1 and pass it on the fifth day, prepare for the exam number 2 on the third day and pass it on the fourth day.In the second example Vasiliy should prepare for the exam number 3 during the first four days and pass it on the fifth day. Then on the sixth day he should prepare for the exam number 2 and then pass it on the seventh day. After that he needs to prepare for the exam number 1 on the eighth day and pass it on the ninth day. In the third example Vasiliy can't pass the only exam because he hasn't anough time to prepare for it.

import Data.Functor ((<$>))
import Data.Array
import Data.Char (isSpace)
import Data.List
import Data.Ord (comparing)
import qualified Data.ByteString.Char8 as B

bsearch :: (Int -> Bool) -> Int -> Int -> Int
bsearch f l r
    | l == r    = r
    | f m       = bsearch f l m
    | otherwise = bsearch f (m + 1) r
    where m = (l + r) `div` 2

check :: Array Int Int -> [Int] -> Int -> Bool
check d a n = and (zipWith (\x y -> exam!x >= y) subj requ)
    where m  = snd (bounds d)
          exam = accumArray (const id) 0 (0, m) (zip a [1..n]) -- deadline
          subj = sortBy (comparing (exam!)) [1..m]  -- subjects sorted by deadline
          requ = scanl1 (+) (map (d!) subj)         -- times required for each subjects w.r.t. subj

solve :: [Int] -> [Int] -> Int
solve dl a
    | check d a (length a) = bsearch (check d a) 0 (length a)
    | otherwise            = -1
    where d = listArray (1, length dl) (map (+1) dl)

main :: IO()
main = do
    _ <- B.getLine
    a <- unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine
    d <- unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine
    print (a `seq` d `seq` solve d a)

import Data.Functor ((<$>))
import Data.Array
import Data.Char (isSpace)
import Data.List
import Data.Ord (comparing)
import qualified Data.ByteString.Char8 as B

bsearch :: (Int -> Bool) -> Int -> Int -> Int
bsearch f l r
    | l == r    = r
    | f m       = bsearch f l m
    | otherwise = bsearch f (m + 1) r
    where m = (l + r) `div` 2

check :: Array Int Int -> [Int] -> Bool
check d a = and (zipWith (\x y -> exam!x >= y) subj requ)
    where m  = snd (bounds d)
          exam = accumArray (const id) 0 (0, m) (zip a [1::Int ..]) -- deadline
          subj = sortBy (comparing (exam!)) [1..m]  -- subjects sorted by deadline
          requ = scanl1 (+) (map (d!) subj)         -- times required for each subjects w.r.t. subj

solve :: [Int] -> [Int] -> Int
solve dl a
    | check d a = bsearch (check d . (`take` a)) 0 (length a)
    | otherwise = -1
    where d = listArray (1, length dl) (map (+1) dl)

main :: IO()
main = do
    _ <- B.getLine
    a <- unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine
    d <- unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine
    print $ solve d a

import Data.Functor ((<$>))
import Data.Array
import Data.Char (isSpace)
import Data.List
import Data.Ord (comparing)
import qualified Data.ByteString.Char8 as B

bsearch :: (Int -> Bool) -> Int -> Int -> Int
bsearch f l r
    | l == r    = r
    | f m       = bsearch f l m
    | otherwise = bsearch f (m + 1) r
    where m = (l + r) `div` 2

check :: Array Int Int -> [Int] -> Int -> Bool
check d a n = and (zipWith (\x y -> exam!x >= y) subj requ)
    where m  = snd (bounds d)
          exam = accumArray (const id) 0 (0, m) (zip a [1..n]) -- deadline
          subj = sortBy (comparing (exam!)) [1..m]  -- subjects sorted by deadline
          requ = scanl1 (+) (map (d!) subj)         -- times required for each subjects w.r.t. subj

solve :: [Int] -> [Int] -> Int
solve dl a
    | check d a (length a) = bsearch (check d a) 0 (length a)
    | otherwise            = -1
    where d = listArray (1, length dl) (map (+1) dl)

main :: IO()
main = do
    _ <- B.getLine
    a <- unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine
    d <- unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine
    print $ solve d a

import Data.Functor ((<$>))
import Data.Array
import Data.List
import Data.Ord (comparing)
import Data.Ix (inRange)

bsearch :: (Int -> Bool) -> Int -> Int -> Int
bsearch f l r
    | l == r    = r
    | f m       = bsearch f l m
    | otherwise = bsearch f (m + 1) r
    where m = (l + r) `div` 2

check :: Array Int Int -> [(Int, Int)] -> Bool
check d a = and (zipWith (\x y -> exam!x >= y) subj requ)
    where exam = accumArray (const id) 0 (bounds d) a   -- deadline
          subj = sortBy (comparing (exam!)) (indices d) -- subjects sorted by deadline
          requ = scanl1 (+) (map (d!) subj)             -- times required for each subjects w.r.t. subj

solve :: [Int] -> [Int] -> Int
solve dl a0
    | check d a = snd $ a !! (bsearch (check d . (`take` a)) 0 (length a) - 1)
    | otherwise = -1
    where d = listArray (1, length dl) (map (+1) dl)
          a = filter (inRange (bounds d) . fst) (zip a0 [1..])

main :: IO()
main = do
    _ <- getLine
    a <- map read . words <$> getLine
    d <- map read . words <$> getLine
    print $ solve d a

import Data.Functor ((<$>))
import Data.Array
import Data.List
import Data.Ord (comparing)

bsearch :: (Int -> Bool) -> Int -> Int -> Int
bsearch f l r
    | l == r    = r
    | f m       = bsearch f l m
    | otherwise = bsearch f (m + 1) r
    where m = (l + r) `div` 2

check :: [Int] -> [Int] -> Bool
check d a = all (uncurry (<=)) (zip x (map snd st))
    where m  = length d :: Int
          ed = accumArray (const id) 0 (0, m) (zip a [1::Int ..])
          st = sortBy (comparing snd) (zip d (map (ed!) [1..m]))
          x  = scanl1 (+) (map fst st)

solve :: [Int] -> [Int] -> Int
solve d a
    | check d a = bsearch (check d . (`take` a)) 0 (length a)
    | otherwise = -1

main :: IO()
main = do
    _ <- getLine
    a <- map read . words <$> getLine
    d <- map read . words <$> getLine
    print $ solve (map (+1) d) a

import Data.Functor ((<$>))
import Data.Array
import Data.List
import Data.Ord (comparing)

bsearch :: (Int -> Bool) -> Int -> Int -> Int
bsearch f l r
    | l == r    = r
    | f m       = bsearch f l m
    | otherwise = bsearch f (m + 1) r
    where m = (l + r) `div` 2

check :: Array Int Int -> [Int] -> Bool
check d a = and (zipWith (\x y -> exam!x >= y) subj requ)
    where m  = snd (bounds d)
          exam = accumArray (const id) 0 (0, m) (zip a [1::Int ..]) -- deadline
          subj = sortBy (comparing (exam!)) [1..m]          -- subjects sorted by deadline
          requ = scanl1 (+) (map (d!) subj) -- times required for each subjects w.r.t. subj

solve :: Array Int Int -> [Int] -> Int
solve d a
    | check d a = bsearch (check d . (`take` a)) 0 (length a)
    | otherwise = -1

main :: IO()
main = do
    _ <- getLine
    a <- map read . words <$> getLine
    dList <- map ((+1) . read) . words <$> getLine
    let d = listArray (1, length dList) dList
    print $ solve d a

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import           Data.List
import           Data.List.Split
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine :: IO [Int]
    ds <- map readInt.B.words <$> B.getLine
    xs <- map (fromIntegral.readInt).B.words <$> B.getLine
    print $ solve n m ds xs

solve :: Int -> Int -> [Int] -> [Int64] -> Int
solve n m ds xs
  | isOK n = lowerBound 1 n isOK
  | otherwise = -1
  where
    arr :: UArray Int Int64
    arr = listArray (1, m) xs
    isOK i = go (IS.fromList[1..m]) 0 . reverse $ take i ds
      where
        go !unused !acc (x:xs)
          | IS.member x unused = go (IS.delete x unused) (acc+arr!x) xs
          | otherwise = go unused (max 0 $ acc-1) xs
        go unused acc [] = IS.null unused && acc == 0

lowerBound :: (Integral i) => i -> i -> (i -> Bool) -> i
lowerBound low high p =  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 #-}

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import           Data.List
import           Data.List.Split
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine :: IO [Int]
    ds <- map readInt.B.words <$> B.getLine
    xs <- map (fromIntegral.readInt).B.words <$> B.getLine
    print $ solve n m ds xs

solve :: Int -> Int -> [Int] -> [Int64] -> Int
solve n m ds xs
  | isOK n = lowerBound 1 n isOK
  | otherwise = -1
  where
    arr :: UArray Int Int64
    arr = listArray (1, m) xs
    isOK i = go (IS.fromList[1..n]) 0 . reverse $ take i ds
      where
        go !unused !acc (x:xs)
          | IS.member x unused = go (IS.delete x unused) (acc+arr!x) xs
          | otherwise = go unused (max 0 $ acc-1) xs
        go _ acc [] = acc <= 0

lowerBound :: (Integral i) => i -> i -> (i -> Bool) -> i
lowerBound low high p =  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 #-}

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import           Data.List
import           Data.List.Split
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine :: IO [Int]
    ds <- map readInt.B.words <$> B.getLine
    xs <- map (fromIntegral.readInt).B.words <$> B.getLine
    print $ solve n m ds xs

solve :: Int -> Int -> [Int] -> [Int64] -> Int
solve n m ds xs
  | isOK n = lowerBound 1 n isOK
  | otherwise = -1
  where
    arr :: UArray Int Int64
    arr = listArray (1, m) xs
    isOK i = go (IS.fromList[1..n]) 0 . reverse $ take i ds
      where
        go !unused !acc (x:xs)
          | IS.member x unused = go (IS.delete x unused) (acc+arr!x) xs
          | otherwise = go unused (acc-1) xs
        go _ acc [] = acc <= 0

lowerBound :: (Integral i) => i -> i -> (i -> Bool) -> i
lowerBound low high p =  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 #-}


Wilbur is playing with a set of n points on the coordinate plane. All points have non-negative integer coordinates. Moreover, if some point (x, y) belongs to the set, then all points (x', y'), such that 0 ≤ x' ≤ x and 0 ≤ y' ≤ y also belong to this set.Now Wilbur wants to number the points in the set he has, that is assign them distinct integer numbers from 1 to n. In order to make the numbering aesthetically pleasing, Wilbur imposes the condition that if some point (x, y) gets number i, then all (x',y') from the set, such that x' ≥ x and y' ≥ y must be assigned a number not less than i. For example, for a set of four points (0, 0), (0, 1), (1, 0) and (1, 1), there are two aesthetically pleasing numberings. One is 1, 2, 3, 4 and another one is 1, 3, 2, 4.Wilbur's friend comes along and challenges Wilbur. For any point he defines it's special value as s(x, y) = y - x. Now he gives Wilbur some w1, w2,..., wn, and asks him to find an aesthetically pleasing numbering of the points in the set, such that the point that gets number i has it's special value equal to wi, that is s(xi, yi) = yi - xi = wi.Now Wilbur asks you to help him with this challenge.

The first line of the input consists of a single integer n (1 ≤ n ≤ 100 000) — the number of points in the set Wilbur is playing with. Next follow n lines with points descriptions. Each line contains two integers x and y (0 ≤ x, y ≤ 100 000), that give one point in Wilbur's set. It's guaranteed that all points are distinct. Also, it is guaranteed that if some point (x, y) is present in the input, then all points (x', y'), such that 0 ≤ x' ≤ x and 0 ≤ y' ≤ y, are also present in the input. The last line of the input contains n integers. The i-th of them is wi ( - 100 000 ≤ wi ≤ 100 000) — the required special value of the point that gets number i in any aesthetically pleasing numbering.

If there exists an aesthetically pleasant numbering of points in the set, such that s(xi, yi) = yi - xi = wi, then print "YES" on the first line of the output. Otherwise, print "NO". If a solution exists, proceed output with n lines. On the i-th of these lines print the point of the set that gets number i. If there are multiple solutions, print any of them.

NoteIn the first sample, point (2, 0) gets number 3, point (0, 0) gets number one, point (1, 0) gets number 2, point (1, 1) gets number 5 and point (0, 1) gets number 4. One can easily check that this numbering is aesthetically pleasing and yi - xi = wi.In the second sample, the special values of the points in the set are 0,  - 1, and  - 2 while the sequence that the friend gives to Wilbur is 0, 1, 2. Therefore, the answer does not exist.

import           Control.Monad
import qualified Data.Set as S
import qualified Data.IntMap.Strict as M
import qualified Data.ByteString.Char8 as B
import           Data.Bool (bool)
import           Debug.Trace (trace)

type State = ([(Int, Int)], M.IntMap (Int, Int), M.IntMap Int, M.IntMap Int)

oneM :: Int
oneM = 1000000

solve :: [(Int, Int)] -> [Int] -> Maybe [(Int, Int)]
solve points spvals =
  bool Nothing (fmap (reverse . fst') res) $ S.member (0, 0) pointSet
  where
    fst' (a, _, _, _) = a
    res = foldM doit initVal spvals
    pointSet = S.fromList points
    initVal = ([], M.singleton 0 (0, 0), M.singleton 0 0, M.singleton 0 0)
    adj (x, y) = [(x + 1, y), (x, y + 1)]
    check (xs, ys) p@(x, y) = S.member p pointSet &&
                              M.findWithDefault y x xs == y &&
                              M.findWithDefault x y ys == x
    doit :: State -> Int -> Maybe State
    doit (pts, spMap, xMs, yMs) v = do
      pt <- M.lookup v spMap
      let
        ncands = (M.delete (fst pt) xMs, M.delete (snd pt) yMs)
        nspMap = M.delete v spMap
        adjPts = filter (check ncands) $ adj pt
        finalcands =
          (fst ncands `M.union` M.fromList adjPts,
           snd ncands `M.union` M.fromList (map (\(x, y) -> (y, x)) adjPts))
        finalMap = M.union nspMap $
                   M.fromList $
                   map (\(x, y) -> (y - x, (x, y))) adjPts
        dbg = show (pt:pts, finalMap, fst finalcands, snd finalcands)
      -- trace dbg $ Just ()
      return $ (pt:pts, finalMap, fst finalcands, snd finalcands)

main :: IO ()
main = do
  n <- liftM (maybe 0 fst . B.readInt) B.getLine
  points <- replicateM n $
            B.getLine >>= (return .
                           (\(x:y:_) -> (x, y)) .
                           map (maybe 0 fst . B.readInt) .
                           B.words)
  spVals <- liftM (map (maybe 0 fst . B.readInt) . B.words) B.getLine
  case solve points spVals of
    Just vals -> do
      putStrLn "YES"
      mapM_ (putStrLn . unwords . map show . (\(x, y) -> [x, y])) vals
    Nothing -> putStrLn "NO"


Highway 201 is the most busy street in Rockport. Traffic cars cause a lot of hindrances to races, especially when there are a lot of them. The track which passes through this highway can be divided into $$$n$$$ sub-tracks. You are given an array $$$a$$$ where $$$a_i$$$ represents the number of traffic cars in the $$$i$$$-th sub-track. You define the inconvenience of the track as $$$\sum\limits_{i=1}^{n} \sum\limits_{j=i+1}^{n} \lvert a_i-a_j\rvert$$$, where $$$|x|$$$ is the absolute value of $$$x$$$. You can perform the following operation any (possibly zero) number of times: choose a traffic car and move it from its current sub-track to any other sub-track.Find the minimum inconvenience you can achieve.

The first line of input contains a single integer $$$t$$$ ($$$1\leq t\leq 10\,000$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1\leq n\leq 2\cdot 10^5$$$). The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0\leq a_i\leq 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot 10^5$$$.

For each test case, print a single line containing a single integer: the minimum inconvenience you can achieve by applying the given operation any (possibly zero) number of times.

NoteFor the first test case, you can move a car from the $$$3$$$-rd sub-track to the $$$1$$$-st sub-track to obtain $$$0$$$ inconvenience.For the second test case, moving any car won't decrease the inconvenience of the track.

module Main where
import Control.Monad ( replicateM )
import Data.Foldable ( traverse_ )
main :: IO ()
main = do
    t <- read <$> getLine :: IO Int
    inp <- replicateM t $ do
        n <- read <$> getLine :: IO Integer
        arr <- map read . words <$> getLine :: IO [Integer]
        return (n, arr)
    let solved1 = zip [0..] inp
    let solved = map solve solved1
    -- print inp
    traverse_ putStrLn solved

solve :: (Int, (Integer, [Integer])) -> String
solve (tc, (n, arr)) =
    let
        sm = sum arr
        -- avg = div sm n
        k = mod sm n
        -- lft = sm - avg * n
    in
        -- if tc == 6
        -- then unwords $ map show arr
        -- else show $ k * (n - k)
        show $ k * (n - k)

import Control.Monad

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    arr <- map read.words <$> getLine :: IO [Int]
    let s = sum arr
        k = s `mod` n
    print (k * (n - k))

main = do
    test <- readLn :: IO Int
    replicateM_ test solve

import Control.Monad (replicateM_)

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

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    a <- readInts
    let
      s = sum a
      miss = s `rem` n
    print $ (n - miss) * miss

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
--import Data.Char as C
--import Data.IntSet as S

solve :: IO ()
solve = do
  n <- readLn :: IO Int64
  s <- getLine
  let a = map read $ words s :: [Int64]
      su = sum a
      (high, low) = (rem su n, n - (rem su n))
      res = high*low
    in print res

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

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

printResult = do
    n <- readLn :: IO Integer
    a <- readInts
    let m = mod (sum a) n
        r = m * (n-m)
    print r

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

import Control.Monad ( replicateM_ )
import Data.Int ( Int64 )

solve :: IO ()
solve = do
    n <- readLn :: IO Int64
    a <- readMany :: IO [Int64]
    let m = sum a `mod` n
    print (m * (n - m))

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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

module Main where
import Control.Monad ( replicateM )
import Data.Foldable ( traverse_ )
main :: IO ()
main = do
    t <- read <$> getLine :: IO Int
    inp <- replicateM t $ do
        n <- read <$> getLine :: IO Int
        arr <- map read . words <$> getLine :: IO [Int]
        return (n, arr)
    let solved1 = zip [0..] inp
    let solved = map solve solved1
    -- print inp
    traverse_ putStrLn solved

solve :: (Int, (Int, [Int])) -> String
solve (tc, (n, arr)) =
    let
        sm = sum arr
        -- avg = div sm n
        k = mod sm n
        -- lft = sm - avg * n
    in
        if tc == 6
        then unwords $ map show arr
        else show $ k * (n - k)

module Main where
import Data.List ( intercalate )
main :: IO ()
main = interact solve

solve :: String -> String
solve inp =
    let
        inps = drop 1 . lines $ inp
        ans = [map read . words $ j | (i, j) <- zip [0..] inps, odd i] :: [[Int]]
        sans = map (show . slv) ans

    in
        unlines sans

slv :: [Int] -> Int
slv arr =
    let
        n = length arr
        sm = sum arr
        k = mod sm n
    in
        k * (n - k)

module Main where
import Control.Monad ( replicateM )
import Data.Foldable ( traverse_ )
main :: IO ()
main = do
    t <- read <$> getLine :: IO Int
    inp <- replicateM t $ do
        n <- read <$> getLine :: IO Int
        arr <- map read . words <$> getLine :: IO [Int]
        return (n, arr)
    let solved = map solve inp
    -- print inp
    traverse_ print solved

solve :: (Int, [Int]) -> Int
solve (n, arr) =
    let
        sm = sum arr
        -- avg = div sm n
        k = mod sm n
        -- lft = sm - avg * n
    in
        k * (n - k)

module Main where
import Control.Monad ( replicateM )
import Data.Foldable ( traverse_ )
main :: IO ()
main = do
    t <- read <$> getLine :: IO Int
    inp <- replicateM t $ do
        n <- read <$> getLine :: IO Int
        arr <- map read . words <$> getLine :: IO [Int]
        return (n, arr)
    let solved = map solve inp
    -- print inp
    traverse_ print solved

solve :: (Int, [Int]) -> Int
solve (n, arr) =
    let
        sm = sum arr
        avg = div sm n
        lft = sm - avg * n
    in
        lft * (n - lft)


You are given some text $$$t$$$ and a set of $$$n$$$ strings $$$s_1, s_2, \dots, s_n$$$. In one step, you can choose any occurrence of any string $$$s_i$$$ in the text $$$t$$$ and color the corresponding characters of the text in red. For example, if $$$t=\texttt{bababa}$$$ and $$$s_1=\texttt{ba}$$$, $$$s_2=\texttt{aba}$$$, you can get $$$t=\color{red}{\texttt{ba}}\texttt{baba}$$$, $$$t=\texttt{b}\color{red}{\texttt{aba}}\texttt{ba}$$$ or $$$t=\texttt{bab}\color{red}{\texttt{aba}}$$$ in one step.You want to color all the letters of the text $$$t$$$ in red. When you color a letter in red again, it stays red.In the example above, three steps are enough:  Let's color $$$t[2 \dots 4]=s_2=\texttt{aba}$$$ in red, we get $$$t=\texttt{b}\color{red}{\texttt{aba}}\texttt{ba}$$$;  Let's color $$$t[1 \dots 2]=s_1=\texttt{ba}$$$ in red, we get $$$t=\color{red}{\texttt{baba}}\texttt{ba}$$$;  Let's color $$$t[4 \dots 6]=s_2=\texttt{aba}$$$ in red, we get $$$t=\color{red}{\texttt{bababa}}$$$. Each string $$$s_i$$$ can be applied any number of times (or not at all). Occurrences for coloring can intersect arbitrarily.Determine the minimum number of steps needed to color all letters $$$t$$$ in red and how to do it. If it is impossible to color all letters of the text $$$t$$$ in red, output -1.

The first line of the input contains an integer $$$q$$$ ($$$1 \le q \le 100$$$) —the number of test cases in the test. The descriptions of the test cases follow. The first line of each test case contains the text $$$t$$$ ($$$1 \le |t| \le 100$$$), consisting only of lowercase Latin letters, where $$$|t|$$$ is the length of the text $$$t$$$. The second line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10$$$) — the number of strings in the set. This is followed by $$$n$$$ lines, each containing a string $$$s_i$$$ ($$$1 \le |s_i| \le 10$$$) consisting only of lowercase Latin letters, where $$$|s_i|$$$ — the length of string $$$s_i$$$.

For each test case, print the answer on a separate line. If it is impossible to color all the letters of the text in red, print a single line containing the number -1. Otherwise, on the first line, print the number $$$m$$$ — the minimum number of steps it will take to turn all the letters $$$t$$$ red. Then in the next $$$m$$$ lines print pairs of indices: $$$w_j$$$ and $$$p_j$$$ ($$$1 \le j \le m$$$), which denote that the string with index $$$w_j$$$ was used as a substring to cover the occurrences starting in the text $$$t$$$ from position $$$p_j$$$. The pairs can be output in any order. If there are several answers, output any of them.

6

bababa

2

ba

aba

caba

2

bac

acab

abacabaca

3

aba

bac

aca

baca

3

a

c

b

codeforces

4

def

code

efo

forces

aaaabbbbcccceeee

4

eeee

cccc

aaaa

bbbb

NoteThe first test case is explained in the problem statement.In the second test case, it is impossible to color all the letters of the text in red.

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

ri = readLn :: IO Int

main = do
    t   <- ri
    tcs <- replicateM t $ do
        text       <- getLine
        n          <- ri
        substrings <- replicateM n getLine
        return (text, substrings)
    mapM (putStrLn . showAnswer . solve) tcs

solve (t, ss) = ops
  where
    inds = (`searchIn` t) <$> ss
    matchInfos = concat $ zipWith3 mergeIndLenMatches [0..] (length <$> ss) inds
    ops = reverse . extractAnswer . foldl (next matchInfos) (0,[]) . take (length t) $ [0..]
    extractAnswer (len, operations) | (len /= length t)  = []
                                    | otherwise          = operations

next ms (uncoloredStart, ops) substrStart
    | isNothing maybeMaxmatch  = (uncoloredStart, ops)
    | otherwise                = (matchEnd, (substrIndex, matchStart) : ops)
  where
    (substrIndex, matchStart, matchEnd) = fromJust maybeMaxmatch
    maybeMaxmatch = listToMaybe . reverse . sortOn t3of3 . mapMaybe convertMatch $ ms
    convertMatch (i,l,m)
        | (m+l <= uncoloredStart)                       = Nothing
        | not (inRange (substrStart,uncoloredStart) m)  = Nothing
        | otherwise                                     = Just (i, m, m+l)

showAnswer [] = unlines ["-1"]
showAnswer ms = unlines $ (show.length) ms : map showP ms
showP (a, b) = show (a+1) ++ " " ++ show (b+1)

mergeIndLenMatches i l = map f  where  f m = (i,l,m)

searchIn :: (Eq a) => [a] -> [a] -> [Int]
substr `searchIn` s = findIndices (substr `isPrefixOf`) (tails s)

t3of3 (_,_,c) = c

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

ri = readLn :: IO Int

main = do
    t   <- ri
    tcs <- replicateM t $ do
        text       <- getLine
        n          <- ri
        substrings <- replicateM n getLine
        return (text, substrings)
    mapM (putStrLn . showAnswer . solve) tcs

solve (t, ss) = ops
  where
    inds = (`searchIn` t) <$> ss
    matchInfos = concat $ zipWith3 mergeIndLenMatches [0..] (length <$> ss) inds
    ops = reverse . snd . foldl (next matchInfos) (0,[]) . take (length t) $ [0..]

next ms (uncoloredStart, ops) substrStart
    | isNothing maybeMaxmatch  = (uncoloredStart, ops)
    | otherwise                = (matchEnd, (substrIndex, matchStart) : ops)
  where
    (substrIndex, matchStart, matchEnd) = fromJust maybeMaxmatch
    maybeMaxmatch = listToMaybe . reverse . sortOn t3of3 . mapMaybe convertMatch $ ms
    convertMatch (i,l,m)
        | (m+l <= uncoloredStart)                       = Nothing
        | not (inRange (substrStart,uncoloredStart) m)  = Nothing
        | otherwise                                     = Just (i, m, m+l)

showAnswer [] = unlines ["-1"]
showAnswer ms = unlines $ (show.length) ms : map showP ms
showP (a, b) = show (a+1) ++ " " ++ show (b+1)

mergeIndLenMatches i l = map f  where  f m = (i,l,m)

searchIn :: (Eq a) => [a] -> [a] -> [Int]
substr `searchIn` s = findIndices (substr `isPrefixOf`) (tails s)

t3of3 (_,_,c) = c

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

ri = readLn :: IO Int

main = do
    t   <- ri
    tcs <- replicateM t $ do
        text       <- getLine
        n          <- ri
        substrings <- replicateM n getLine
        return (text, substrings)
    mapM (putStrLn . showAnswer . solve) tcs

solve (t, ss) = ops
  where
    inds = (`searchIn` t) <$> ss
    matchInfos = concat $ zipWith3 mergeIndLenMatches [0..] (length <$> ss) inds
    ops = reverse . snd . foldl (next matchInfos) (0,[]) . take (length t) $ [0..]

next ms (uncoloredStart, ops) substrStart
    | isNothing maybeMaxmatch  = (uncoloredStart, ops)
    | otherwise                = (matchEnd, (substrIndex, matchStart) : ops)
  where
    (substrIndex, matchStart, matchEnd) = fromJust maybeMaxmatch
    maybeMaxmatch = listToMaybe . reverse . sortOn t3of3 . mapMaybe convertMatch $ ms
    convertMatch (i,l,m)
        | (m+l <= uncoloredStart)                       = Nothing
        | not (inRange (substrStart,uncoloredStart) m)  = Nothing
        | otherwise                                     = Just (i, m, m+l)

showAnswer [] = "-1"
showAnswer ms = unlines $ (show.length) ms : strPairs
  where
    strPairs = map showP ms
showP (a, b) = show (a+1) ++ " " ++ show (b+1)

mergeIndLenMatches i l = map f  where  f m = (i,l,m)

searchIn :: (Eq a) => [a] -> [a] -> [Int]
substr `searchIn` s = findIndices (substr `isPrefixOf`) (tails s)

t3of3 (_,_,c) = c

import Control.Monad
import Data.List
import Data.Maybe
ri = readLn :: IO Int
main = do
    t   <- ri
    tcs <- replicateM t $ do
        text       <- getLine
        n          <- ri
        substrings <- replicateM n getLine
        return (text, substrings)
    mapM (putStrLn . showAnswer . solve) tcs
solve (t, ss) = ops
  where
    inds = (`searchIn` t) <$> ss
    matchInfos = concat $ zipWith3 mergeIndLenMatches [0..] (length <$> ss) inds
    ops = reverse . snd . foldl (next matchInfos) (0,[]) . take (length t) $ [0..]
next ms (uncoloredStart, ops) substrStart
    | isNothing maybeMaxmatch  = (uncoloredStart, ops)
    | otherwise                = (matchEnd, (substrIndex, substrStart) : ops)
  where
    (substrIndex, matchEnd) = fromJust maybeMaxmatch
    maybeMaxmatch = listToMaybe . reverse . sortOn snd . mapMaybe ifMatches $ ms
    ifMatches (i,l,m)
        | (m   /= substrStart   )  = Nothing
        | (m+l <= uncoloredStart)  = Nothing
        | otherwise                = Just (i, m+l)
showAnswer [] = "-1"
showAnswer ms = unlines $ (show.length) ms : strPairs
  where
    strPairs = map showP ms
showP (a, b) = show (a+1) ++ " " ++ show (b+1)

mergeIndLenMatches i l = map f  where  f m = (i,l,m)

x `injectBefore` ys = map f ys  where  f y = (x,y)

-- original version: https://hackage.haskell.org/package/utility-ht-0.0.16/docs/src/Data.List.HT.Private.html#search
searchIn :: (Eq a) => [a] -> [a] -> [Int]
searchIn substr s = findIndices (substr `isPrefixOf`) (tails s)

import Control.Monad
import Data.List
import Data.Maybe
ri = readLn :: IO Int
main = do
    t   <- ri
    tcs <- replicateM t $ do
        text       <- getLine
        n          <- ri
        substrings <- replicateM n getLine
        return (text, substrings)
    mapM (putStrLn . showAnswer . solve) tcs
solve (t, ss) = ops
  where
    inds = (`searchIn` t) <$> ss
    matchInfos = concat $ zipWith3 mergeIndLenMatches [0..] (length <$> ss) inds
    ops = reverse . snd . foldl (next matchInfos) (0,[]) . take (length t) $ [0..]
next ms (uncoloredStart, ops) substrStart
    | isNothing maybeMaxmatch  = (uncoloredStart, ops)
    | otherwise                = (matchEnd, (substrIndex, substrStart) : ops)
  where
    (substrIndex, matchEnd) = fromJust maybeMaxmatch
    maybeMaxmatch = listToMaybe . reverse . sortOn snd . mapMaybe ifMatches $ ms
    ifMatches (i,l,m)
        | (m   /= substrStart   )  = Nothing
        | (m+l <= uncoloredStart)  = Nothing
        | otherwise                = Just (i, m+l)
showAnswer [] = "-1"
showAnswer ms = unlines $ (show.length) ms : strPairs
  where
    strPairs = map showP ms
showP (a, b) = show a ++ " " ++ show b

mergeIndLenMatches i l = map f  where  f m = (i,l,m)

x `injectBefore` ys = map f ys  where  f y = (x,y)

-- original version: https://hackage.haskell.org/package/utility-ht-0.0.16/docs/src/Data.List.HT.Private.html#search
searchIn :: (Eq a) => [a] -> [a] -> [Int]
searchIn substr s = findIndices (substr `isPrefixOf`) (tails s)

import Control.Monad
import Data.List
import Data.Maybe
ri = readLn :: IO Int
main = do
    t   <- ri
    tcs <- replicateM t $ do
        text       <- getLine
        n          <- ri
        substrings <- replicateM n getLine
        return (text, substrings)
    mapM (putStrLn . showAnswer . solve) tcs
solve (t, ss) = (t, ss, inds, ops)
  where
    inds = (`searchIn` t) <$> ss
    matchInfos = concat $ zipWith3 mergeIndLenMatches [0..] (length <$> ss) inds
    ops = reverse . snd . foldl (next matchInfos) (0,[]) . take (length t) $ [0..]
next ms (uncoloredStart, ops) substrStart
    | isNothing maybeMaxmatch  = (uncoloredStart, ops)
    | otherwise                = (matchEnd, (substrIndex, substrStart) : ops)
  where
    (substrIndex, matchEnd) = fromJust maybeMaxmatch
    maybeMaxmatch = listToMaybe . reverse . sortOn snd . mapMaybe ifMatches $ ms
    ifMatches (i,l,m)
        | (m   /= substrStart   )  = Nothing
        | (m+l <= uncoloredStart)  = Nothing
        | otherwise                = Just (i, m+l)
showAnswer = show  -- TODO

mergeIndLenMatches i l = map f  where  f m = (i,l,m)

x `injectBefore` ys = map f ys  where  f y = (x,y)

-- original version: https://hackage.haskell.org/package/utility-ht-0.0.16/docs/src/Data.List.HT.Private.html#search
searchIn :: (Eq a) => [a] -> [a] -> [Int]
searchIn substr s = findIndices (substr `isPrefixOf`) (tails s)

import Control.Monad
import Data.List
import Data.Maybe
ri = readLn :: IO Int
main = do
    t   <- ri
    tcs <- replicateM t $ do
        text       <- getLine
        n          <- ri
        substrings <- replicateM n getLine
        return (text, substrings)
    mapM (putStrLn . showAnswer . solve) tcs
solve (t, ss) = (t, ss, inds)
  where
    inds = (`searchIn` t) <$> ss
    matchInfos = concat $ zipWith3 mergeIndLenMatches [0..] (length <$> ss) inds
    ops = reverse . snd . foldl (next matchInfos) (0,[]) . take (length t) $ [0..]
next ms (uncoloredStart, ops) substrStart
    | isNothing maybeMaxmatch  = (uncoloredStart, ops)
    | otherwise                = (matchEnd, (substrIndex, substrStart) : ops)
  where
    (substrIndex, matchEnd) = fromJust maybeMaxmatch
    maybeMaxmatch = listToMaybe . reverse . sortOn snd . mapMaybe ifMatches $ ms
    ifMatches (i,l,m)
        | (m   /= substrStart   )  = Nothing
        | (m+l <= uncoloredStart)  = Nothing
        | otherwise                = Just (i, m+l)
showAnswer = show  -- TODO

mergeIndLenMatches i l = map f  where  f m = (i,l,m)

x `injectBefore` ys = map f ys  where  f y = (x,y)

-- original version: https://hackage.haskell.org/package/utility-ht-0.0.16/docs/src/Data.List.HT.Private.html#search
searchIn :: (Eq a) => [a] -> [a] -> [Int]
searchIn substr s = findIndices (substr `isPrefixOf`) (tails s)

import Control.Monad
import Data.List
ri = readLn :: IO Int
main = do
    t   <- ri
    tcs <- replicateM t $ do
        text       <- getLine
        n          <- ri
        substrings <- replicateM n getLine
        return (text, substrings)
    mapM (putStrLn . showAnswer . solve) tcs
solve (t, ss) = (t, ss, inds)
  where
    inds = flip search t <$> ss
showAnswer = show  -- TODO

-- original version: https://hackage.haskell.org/package/utility-ht-0.0.16/docs/src/Data.List.HT.Private.html#search
search :: (Eq a) => [a] -> [a] -> [Int]
search substr s = findIndices (substr `isPrefixOf`) (tails s)


The Little Girl loves problems on games very much. Here's one of them.Two players have got a string s, consisting of lowercase English letters. They play a game that is described by the following rules:  The players move in turns; In one move the player can remove an arbitrary letter from string s.  If the player before his turn can reorder the letters in string s so as to get a palindrome, this player wins. A palindrome is a string that reads the same both ways (from left to right, and vice versa). For example, string "abba" is a palindrome and string "abc" isn't. Determine which player will win, provided that both sides play optimally well — the one who moves first or the one who moves second.

The input contains a single line, containing string s (1 ≤ |s|  ≤  103). String s consists of lowercase English letters.

In a single line print word "First" if the first player wins (provided that both players play optimally well). Otherwise, print word "Second". Print the words without the quotes.

import Data.List

main :: IO ()
main = do
  s <- getLine
  let t = length $ filter odd $ map length $ group $ sort s
  putStrLn $ if t == 0 || odd t then "First" else "Second"

import Data.Array (accumArray, elems)

solve :: String -> String
solve s
  | odd countOdd || countOdd == 0  =  "First"
  | otherwise  =  "Second"
  where
    countOdd  =  length $ filter odd $ elems array
    array  =  accumArray (+) 0 ('a', 'z') $ zip s $ repeat 1

main :: IO ()
main  =  getLine >>= putStrLn . solve

import Data.Array.Base
main=getLine>>=putStrLn.f.unsafeAccumArray (+) 0 (0,128) . (`zip`(repeat 1)) . map fromEnum
f :: UArray Int Int -> String
f arr
    | n > 0 && even n = "Second"
    | otherwise = "First"
   where
     xs = map (unsafeAt arr) [fromEnum 'a'..fromEnum 'z']
     n = length $ filter odd xs

module Main where

import Data.List
import Data.Set (toList, fromList)

other "First" = "Second"
other "Second" = "First"

countAllElems xs = reverse . sort . map counter . uniques $ xs
    where
        uniques = toList . fromList
        counter c = length $ filter (== c) xs

canPalindrome xs = countOdds < 2
    where countOdds = length . filter odd $ xs

findFirst p xs = findFirst' p xs 0
findFirst' p [] _ = Nothing
findFirst' p (x:xs) ind
    | p x = (Just (x, ind))
    | otherwise = findFirst' p xs (ind+1)

replace i e xs = (take i xs) ++ [e] ++ (drop (i+1) xs)

makeMove xs = filter (> 0) . mkmv . findFirst even $ xs
    where
        mkmv (Just (c, i)) = replace i (c-1) xs
        mkmv Nothing = replace 0 (head xs - 1) xs

canWin plr xs
    | canPalindrome xs = plr
    | otherwise = canWin (other plr) (makeMove xs)

main = do
  starting <- getLine
  putStrLn . canWin "First" . countAllElems $ starting

module Main where

import Data.List

odds :: String -> Int
odds = (foldl (+) 0) . map ((`mod` 2) . length) . group . sort

solve :: String -> String
solve str = if odds str == 0 || (odds str) `mod` 2 == 1
               then "First"
               else "Second"

main = getLine >>= (putStrLn . solve)

import Data.List
classify list = classify' (tail list) (head list) 1

classify' [] char pat = [pat]
classify' list char pat
    | (head list) /= char = pat : (classify' (tail list) (head list) 1)
    | otherwise = classify' (tail list) char (pat + 1)

main = do
    input <- getContents
    let sorted = Data.List.sort $ head $ lines input
    let classified = filter (\x -> x `mod` 2 == 1) $ classify sorted
    let total = length classified
    let res = if total == 0 || total `mod` 2 == 1 then "First" else "Second"
    putStrLn res

import Data.List
classify list = classify' (tail list) (head list) 1

classify' [] char pat = [pat]
classify' list char pat
    | (head list) /= char = pat : (classify' (tail list) (head list) 1)
    | otherwise = classify' (tail list) char (pat + 1)

main = do
    input <- getContents
    let sorted = Data.List.sort $ head $ lines input
    let total = sum $ classify sorted
    let res = if total `mod` 2 == 0 then "Second" else "First"
    putStrLn res


During their New Year holidays, Alice and Bob play the following game using an array $$$a$$$ of $$$n$$$ integers:   Players take turns, Alice moves first.  Each turn a player chooses any element and removes it from the array.  If Alice chooses even value, then she adds it to her score. If the chosen value is odd, Alice's score does not change.  Similarly, if Bob chooses odd value, then he adds it to his score. If the chosen value is even, then Bob's score does not change. If there are no numbers left in the array, then the game ends. The player with the highest score wins. If the scores of the players are equal, then a draw is declared.For example, if $$$n = 4$$$ and $$$a = [5, 2, 7, 3]$$$, then the game could go as follows (there are other options):   On the first move, Alice chooses $$$2$$$ and get two points. Her score is now $$$2$$$. The array $$$a$$$ is now $$$[5, 7, 3]$$$.  On the second move, Bob chooses $$$5$$$ and get five points. His score is now $$$5$$$. The array $$$a$$$ is now $$$[7, 3]$$$.  On the third move, Alice chooses $$$7$$$ and get no points. Her score is now $$$2$$$. The array $$$a$$$ is now $$$[3]$$$.  On the last move, Bob chooses $$$3$$$ and get three points. His score is now $$$8$$$. The array $$$a$$$ is empty now.  Since Bob has more points at the end of the game, he is the winner. You want to find out who will win if both players play optimally. Note that there may be duplicate numbers in the array.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains an integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of elements in the array $$$a$$$. The next line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the array $$$a$$$ used to play the game. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output on a separate line:    "Alice" if Alice wins with the optimal play;  "Bob" if Bob wins with the optimal play;  "Tie", if a tie is declared during the optimal play.

{-# LANGUAGE
    BangPatterns
  , BlockArguments
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , DerivingVia
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , NPlusKPatterns
  , NegativeLiterals
  , OverloadedLabels
  , OverloadedStrings
  , ParallelListComp
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , StrictData
  , TupleSections
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , ViewPatterns
  #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
import           System.IO
import           Data.Proxy
import           GHC.TypeLits
import           GHC.Generics                   ( Generic )
import           Data.Function
-- import           Data.List.HT                   ( mapAdjacent
--                                                 , isAscending
--                                                 )
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
import qualified Data.Set                      as S
-- import qualified Data.Vector.Algorithms.Radix  as VA
-- import           Text.Parsec.ByteString

-- #if defined(LOCAL_ZER0STAR)
-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}
-- #endif

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

both2 f (a1, b1) (a2, b2) = (f a1 a2, f b1 b2)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . BS.readInteger) . BS.words <$> BS.getLine

main = do
  t <- getInt
  replicateM_
    t
    do
      n <- getInt
      a <- reverse . sort <$> getIntegers
      putStrLn case flip compare 0 $ solve a True 0 of
        LT -> "Bob"
        EQ -> "Tie"
        GT -> "Alice"

solve []       _     ans = ans
solve (a : as) True  ans = solve as False $ ans + if even a then a else 0
solve (a : as) False ans = solve as True $ ans - if odd a then a else 0

alice n = (if even n then n else 0, 0)

bob n = (0, if odd n then n else 0)

gd :: Down a -> a
gd (Down x) = x

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import safe Control.Arrow ((>>>))
import qualified Data.Text as T
import qualified Data.Text.IO as TI
import Data.List
import Data.Function
import Data.Maybe

main :: IO ()
main = TI.getContents >>= (T.lines >>> drop 1 >>> tcio >>> (mapM_ putStrLn)) where
  tcio :: [T.Text] -> [String]
  tcio [] = []
  tcio (_ : ns : rest) = ((:[]). solve . linetois) (ns) ++ tcio (rest)
  linetoi = toi; linetois = (map linetoi).(T.words); linestoiss = map linetois
  toi t = toi0 0 t where toi0 n t = if (T.null) t then n else toi0 (10*n + fromIntegral(on (-) fromEnum (T.head t) '0') ) (T.tail t) ;

solve :: [Integer] -> String
solve ns
 |a>b = "Alice"
 |b>a = "Bob"
 |otherwise = "Tie" where
 (a,b) = rec (reverse $ sort $ ns) (0,0)

rec [] (a,b)= (a,b)
rec [k] (a,b) = if even k then (a+k,b) else (a,b)
rec (k1:k2:ks) (a,b) = rec ks (if even k1 then a+k1 else a, if odd k2 then b+k2 else b)

import Control.Monad
import Data.List
import Data.Int -- Int is 32-bit on CF...

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _n <- getLine
    a <- map read . words <$> getLine :: IO [Int64]
    let
      eoT = sum [if  even x  then  x  else  0-x | x <- a]
      -- sort is so slow! hopefully OK with 2e5?
      abT = sum [x * y | (x, y) <- zip (cycle [1, 0-1]) (reverse $ sort a)]
    putStrLn $ case  compare 0 $ eoT + abT  of
      LT -> "Alice"
      EQ -> "Tie"
      GT -> "Bob"

import Prelude
import Data.Int
import Data.List

pairplus :: (Int64,Int64) -> (Int64,Int64) -> (Int64,Int64)
pairplus (a,b) (c,d) = (a+c,b+d)

game :: Int64 -> [Int64] -> (Int64,Int64)
game _ [] = (0,0)
game n (x:xs) = if (mod n 2 == 0) then (if (mod x 2==0)then pairplus(x,0)rec else rec) else (if(mod x 2==1)then pairplus(0,x)rec else rec) where rec = game (n+1) xs

result :: (Int64,Int64) -> String
result (a,b) | a == b = "Tie"
             | a > b = "Alice"
             | otherwise = "Bob"

everyother :: [a] -> [a]
everyother [] = []
everyother (x:y:xs) = y : (everyother xs)
everyother (x:xs) = []

readL :: String -> [Int64]
readL list = map read $ words list

solve :: String -> String
solve string = list where list = concat $ intersperse "\n"  $ map result $ map (game 0) $ map (reverse . sort) $ map readL $ everyother $ tail $ lines string

main :: IO ()
main = interact $ solve

{-# LANGUAGE
    BangPatterns
  , BlockArguments
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , DerivingVia
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , NPlusKPatterns
  , NegativeLiterals
  , OverloadedLabels
  , OverloadedStrings
  , ParallelListComp
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , StrictData
  , TupleSections
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , ViewPatterns
  #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
import           System.IO
import           Data.Proxy
import           GHC.TypeLits
import           GHC.Generics                   ( Generic )
import           Data.Function
-- import           Data.List.HT                   ( mapAdjacent
--                                                 , isAscending
--                                                 )
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
import qualified Data.Set                      as S
-- import qualified Data.Vector.Algorithms.Radix  as VA
-- import           Text.Parsec.ByteString

-- #if defined(LOCAL_ZER0STAR)
-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}
-- #endif

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

both2 f (a1, b1) (a2, b2) = (f a1 a2, f b1 b2)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . BS.readInteger) . BS.words <$> BS.getLine

main = do
  t <- getInt
  replicateM_
    t
    do
      n <- getInt
      a <- reverse . sort <$> getInts
      putStrLn case flip compare 0 $ solve a True 0 of
        LT -> "Bob"
        EQ -> "Tie"
        GT -> "Alice"

solve []       _     ans = ans
solve (a : as) True  ans = solve as False $ ans + if even a then a else 0
solve (a : as) False ans = solve as True $ ans - if odd a then a else 0

alice n = (if even n then n else 0, 0)

bob n = (0, if odd n then n else 0)

gd :: Down a -> a
gd (Down x) = x

{-# LANGUAGE
    BangPatterns
  , BlockArguments
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , DerivingVia
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , NPlusKPatterns
  , NegativeLiterals
  , OverloadedLabels
  , OverloadedStrings
  , ParallelListComp
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , StrictData
  , TupleSections
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , ViewPatterns
  #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
import           System.IO
import           Data.Proxy
import           GHC.TypeLits
import           GHC.Generics                   ( Generic )
import           Data.Function
-- import           Data.List.HT                   ( mapAdjacent
--                                                 , isAscending
--                                                 )
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
import qualified Data.Set                      as S
-- import qualified Data.Vector.Algorithms.Radix  as VA
-- import           Text.Parsec.ByteString

-- #if defined(LOCAL_ZER0STAR)
-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}
-- #endif

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

both2 f (a1, b1) (a2, b2) = (f a1 a2, f b1 b2)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . BS.readInteger) . BS.words <$> BS.getLine

main = do
  t <- getInt
  replicateM_
    t
    do
      n <- getInt
      a <- map gd . sort . map Down <$> getInts
      putStrLn case flip compare 0 $ solve a True 0 of
        LT -> "Bob"
        EQ -> "Tie"
        GT -> "Alice"

solve []       _     ans = ans
solve (a : as) True  ans = solve as False $ ans + if even a then a else 0
solve (a : as) False ans = solve as True $ ans - if odd a then a else 0

alice n = (if even n then n else 0, 0)

bob n = (0, if odd n then n else 0)

gd :: Down a -> a
gd (Down x) = x

{-# LANGUAGE
    BangPatterns
  , BlockArguments
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , DerivingVia
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , NPlusKPatterns
  , NegativeLiterals
  , OverloadedLabels
  , OverloadedStrings
  , ParallelListComp
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , StrictData
  , TupleSections
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , ViewPatterns
  #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
import           System.IO
import           Data.Proxy
import           GHC.TypeLits
import           GHC.Generics                   ( Generic )
import           Data.Function
-- import           Data.List.HT                   ( mapAdjacent
--                                                 , isAscending
--                                                 )
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
import qualified Data.Set                      as S
-- import qualified Data.Vector.Algorithms.Radix  as VA
-- import           Text.Parsec.ByteString

-- #if defined(LOCAL_ZER0STAR)
-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}
-- #endif

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

both2 f (a1, b1) (a2, b2) = (f a1 a2, f b1 b2)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . BS.readInteger) . BS.words <$> BS.getLine

main = do
  t <- getInt
  replicateM_
    t
    do
      n <- getInt
      a <- map gd . sort . map Down <$> getInts
      guard $ length a == n
      putStrLn
        case
          uncurry compare
          . foldl (both2 (+)) (0, 0)
          . zipWith ($) (cycle [alice, bob])
          $ a
        of
          LT -> "Bob"
          EQ -> "Tie"
          GT -> "Alice"

alice n = (if even n then n else 0, 0)

bob n = (0, if odd n then n else 0)

gd :: Down a -> a
gd (Down x) = x

{-# LANGUAGE
    BangPatterns
  , BlockArguments
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , DerivingVia
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , NPlusKPatterns
  , NegativeLiterals
  , OverloadedLabels
  , OverloadedStrings
  , ParallelListComp
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , StrictData
  , TupleSections
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , ViewPatterns
  #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
import           System.IO
import           Data.Proxy
import           GHC.TypeLits
import           GHC.Generics                   ( Generic )
import           Data.Function
-- import           Data.List.HT                   ( mapAdjacent
--                                                 , isAscending
--                                                 )
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
import qualified Data.Set                      as S
-- import qualified Data.Vector.Algorithms.Radix  as VA
-- import           Text.Parsec.ByteString

-- #if defined(LOCAL_ZER0STAR)
-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}
-- #endif

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

both2 f (a1, b1) (a2, b2) = (f a1 a2, f b1 b2)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . BS.readInteger) . BS.words <$> BS.getLine

main = do
  t <- getInt
  replicateM_
    t
    do
      n <- getInt
      a <- map gd . sort . map Down <$> getInts
      putStrLn
        case
          uncurry compare
          . foldl (both2 (+)) (0, 0)
          . zipWith ($) (cycle [alice, bob])
          $ a
        of
          LT -> "Bob"
          EQ -> "Tie"
          GT -> "Alice"

alice n = (if even n then n else 0, 0)

bob n = (0, if odd n then n else 0)

gd :: Down a -> a
gd (Down x) = x

{-# LANGUAGE
    BangPatterns
  , BlockArguments
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , DerivingVia
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , NPlusKPatterns
  , NegativeLiterals
  , OverloadedLabels
  , OverloadedStrings
  , ParallelListComp
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , StrictData
  , TupleSections
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , ViewPatterns
  #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
import           System.IO
import           Data.Proxy
import           GHC.TypeLits
import           GHC.Generics                   ( Generic )
import           Data.Function
-- import           Data.List.HT                   ( mapAdjacent
--                                                 , isAscending
--                                                 )
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
import qualified Data.Set                      as S
-- import qualified Data.Vector.Algorithms.Radix  as VA
-- import           Text.Parsec.ByteString

-- #if defined(LOCAL_ZER0STAR)
-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}
-- #endif

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

both2 f (a1, b1) (a2, b2) = (f a1 a2, f b1 b2)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . BS.readInteger) . BS.words <$> BS.getLine

main = do
  t <- getInt
  replicateM_
    t
    do
      n <- getInt
      a <- map gd . sort . map Down <$> getInts
      putStrLn
        case flip compare 0 . sum . zipWith ($) (cycle [alice, bob]) $ a of
          LT -> "Bob"
          EQ -> "Tie"
          GT -> "Alice"

alice n = if even n then n else 0

bob n = if odd n then -n else 0

gd :: Down a -> a
gd (Down x) = x

{-# LANGUAGE
    BangPatterns
  , BlockArguments
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , DerivingVia
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , NPlusKPatterns
  , NegativeLiterals
  , OverloadedLabels
  , OverloadedStrings
  , ParallelListComp
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , StrictData
  , TupleSections
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , ViewPatterns
  #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
import           System.IO
import           Data.Proxy
import           GHC.TypeLits
import           GHC.Generics                   ( Generic )
import           Data.Function
-- import           Data.List.HT                   ( mapAdjacent
--                                                 , isAscending
--                                                 )
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
import qualified Data.Set                      as S
-- import qualified Data.Vector.Algorithms.Radix  as VA
-- import           Text.Parsec.ByteString

-- #if defined(LOCAL_ZER0STAR)
-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}
-- #endif

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

both2 f (a1, b1) (a2, b2) = (f a1 a2, f b1 b2)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . BS.readInteger) . BS.words <$> BS.getLine

main = do
  t <- getInt
  replicateM_
    t
    do
      n <- getInt
      a <- map gd . sort . map Down <$> getInts
      putStrLn
        case flip compare 0 . sum . zipWith s (cycle [True, False]) $ a of
          LT -> "Bob"
          EQ -> "Tie"
          GT -> "Alice"

s True n | odd n     = 0
         | otherwise = n

s False n | odd n     = -n
          | otherwise = 0

gd (Down x) = x

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import safe Control.Arrow ((>>>))
import qualified Data.Text as T
import qualified Data.Text.IO as TI
import Data.List
import Data.Function

main :: IO ()
main = TI.getContents >>= (T.lines >>> drop 1 >>> tcio >>> (mapM_ putStrLn)) where
  tcio :: [T.Text] -> [String]
  tcio [] = []
  tcio (_ : ns : rest) = ((:[]). solve . linetois) (ns) ++ tcio (rest)
  linetoi = toi; linetois = (map linetoi).(T.words); linestoiss = map linetois
  toi t = toi0 0 t where toi0 n t = if (T.null) t then n else toi0 (10*n + fromIntegral(on (-) fromEnum (T.head t) '0') ) (T.tail t) ;

solve :: [Int] -> String
solve ns
 |a>b = "Alice"
 |b>a = "Bob"
 |otherwise = "Tie" where
 (a,b) = rec (reverse $ sort $ ns) (0,0)

rec [] (a,b)= (a,b)
rec [k] (a,b) = if even k then (a+k,b) else (a,b)
rec (k1:k2:ks) (a,b) = rec ks (if even k1 then a+k1 else a, if odd k2 then b+k2 else b)

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _n <- getLine
    a <- map read . words <$> getLine :: IO [Int]
    let
      eoT = sum [if  even x  then  x  else  0-x | x <- a]
      -- sort is so slow! hopefully OK with 2e5?
      abT = sum [x * y | (x, y) <- zip (cycle [1, 0-1]) (reverse $ sort a)]
    putStrLn $ case  compare 0 $ eoT + abT  of
      LT -> "Alice"
      EQ -> "Tie"
      GT -> "Bob"


There is an infinite 2-dimensional grid. The robot stands in cell $$$(0, 0)$$$ and wants to reach cell $$$(x, y)$$$. Here is a list of possible commands the robot can execute:  move north from cell $$$(i, j)$$$ to $$$(i, j + 1)$$$;  move east from cell $$$(i, j)$$$ to $$$(i + 1, j)$$$;  move south from cell $$$(i, j)$$$ to $$$(i, j - 1)$$$;  move west from cell $$$(i, j)$$$ to $$$(i - 1, j)$$$;  stay in cell $$$(i, j)$$$. The robot wants to reach cell $$$(x, y)$$$ in as few commands as possible. However, he can't execute the same command two or more times in a row.What is the minimum number of commands required to reach $$$(x, y)$$$ from $$$(0, 0)$$$?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of testcases. Each of the next $$$t$$$ lines contains two integers $$$x$$$ and $$$y$$$ ($$$0 \le x, y \le 10^4$$$) — the destination coordinates of the robot.

For each testcase print a single integer — the minimum number of commands required for the robot to reach $$$(x, y)$$$ from $$$(0, 0)$$$ if no command is allowed to be executed two or more times in a row.

NoteThe explanations for the example test:We use characters N, E, S, W and 0 to denote going north, going east, going south, going west and staying in the current cell, respectively.In the first test case, the robot can use the following sequence: NENENENENE.In the second test case, the robot can use the following sequence: NENENEN.In the third test case, the robot can use the following sequence: ESENENE0ENESE.In the fourth test case, the robot doesn't need to go anywhere at all.In the fifth test case, the robot can use the following sequence: E0E.

import Control.Monad

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

main = do
	n <- getInt
	forM_ [1..n] $ \_ -> do
		[x, y] <- getInts
		let common = min x y
		let rest = x + y - common - common
		let answer = (common * 2) + (max 0 (rest * 2 - 1))
		print answer

{-# LANGUAGE FlexibleInstances, UndecidableInstances, DuplicateRecordFields #-}

module Main where

import Control.Monad
import System.IO

ca2 0 = 0
ca2 n = 1 + 2*(n-1)

calc x y = 2 * x + ca2 (y - x)

calculate x y = do
    let x1 = max x y
    let y1 = min x y
    calc y1 x1

main :: IO()
main = do
    t <- readLn :: IO Int
    forM_ [1..t] $ \t_itr -> do
        nmsTemp <- getLine
        let nms = words nmsTemp
        let x = read (nms !! 0) :: Int
        let y = read (nms !! 1) :: Int
        let result = calculate x y
        putStrLn(show result)


You are given a string s consisting of lowercase Latin letters. Character c is called k-dominant iff each substring of s with length at least k contains this character c.You have to find minimum k such that there exists at least one k-dominant character.

The first line contains string s consisting of lowercase Latin letters (1 ≤ |s| ≤ 100000).

Print one number — the minimum value of k such that there exists at least one k-dominant character.

module Main where
import qualified Data.IntMap as M
import Data.List

main = getLine >>= print . solve
solve xs0 = go 0 (length xs)
  where
  xs = map fromEnum xs0
  go l r
    | r - l <= 1 = r
    | ok m xs = go l m
    | otherwise = go m r
    where
    m = (l + r) `quot` 2

ok k xs = any (> 0) . M.elems . foldl' (\m (r, i) -> if i == r then m else M.adjust (+1) i $ M.update (\c -> if c > 1 then Just $ c - 1 else Nothing) r m) (M.fromListWith (+) $ zip fir (repeat 1 :: [Int])) $ zip xs sec
  where
  (fir, sec) = splitAt k xs

module Main where
import Data.List
import qualified Data.IntMap as M
main = getContents >>= print . solve
solve xs0 = go 0 (length xs)
  where
  xs = map fromEnum xs0
  go l r
    | r - l <= 1 = r
    | ok m xs = go l m
    | otherwise = go m r
    where
    m = (l + r) `quot` 2
ok k xs = any (> 0) . M.elems . foldl1 (M.intersectionWith min) . map (M.fromListWith (+)) . windows k $ zip xs (repeat 1 :: [Int])
windows n xs = zipWith const (map (take n) $ tails xs) (drop (n - 1) xs)


For a given sequence of distinct non-negative integers $$$(b_1, b_2, \dots, b_k)$$$ we determine if it is good in the following way:  Consider a graph on $$$k$$$ nodes, with numbers from $$$b_1$$$ to $$$b_k$$$ written on them. For every $$$i$$$ from $$$1$$$ to $$$k$$$: find such $$$j$$$ ($$$1 \le j \le k$$$, $$$j\neq i$$$), for which $$$(b_i \oplus b_j)$$$ is the smallest among all such $$$j$$$, where $$$\oplus$$$ denotes the operation of bitwise XOR (https://en.wikipedia.org/wiki/Bitwise_operation#XOR). Next, draw an undirected edge between vertices with numbers $$$b_i$$$ and $$$b_j$$$ in this graph. We say that the sequence is good if and only if the resulting graph forms a tree (is connected and doesn't have any simple cycles). It is possible that for some numbers $$$b_i$$$ and $$$b_j$$$, you will try to add the edge between them twice. Nevertheless, you will add this edge only once.You can find an example below (the picture corresponding to the first test case). Sequence $$$(0, 1, 5, 2, 6)$$$ is not good as we cannot reach $$$1$$$ from $$$5$$$.However, sequence $$$(0, 1, 5, 2)$$$ is good.   You are given a sequence $$$(a_1, a_2, \dots, a_n)$$$ of distinct non-negative integers. You would like to remove some of the elements (possibly none) to make the remaining sequence good. What is the minimum possible number of removals required to achieve this goal?It can be shown that for any sequence, we can remove some number of elements, leaving at least $$$2$$$, so that the remaining sequence is good.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 200,000$$$) — length of the sequence. The second line contains $$$n$$$ distinct non-negative integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^9$$$) — the elements of the sequence.

You should output exactly one integer — the minimum possible number of elements to remove in order to make the remaining sequence good.

NoteNote that numbers which you remove don't impact the procedure of telling whether the resulting sequence is good.It is possible that for some numbers $$$b_i$$$ and $$$b_j$$$, you will try to add the edge between them twice. Nevertheless, you will add this edge only once.

import Data.Bits

maxTree :: [Int] -> Int -> Int
maxTree [_] _ = 1
maxTree [_, _] _ = 2
maxTree as b
  | null ones || null zeros = maxTree as b'
  | otherwise = 1 + maxTree ones b' `max` maxTree zeros b'
  where b' = shift b (-1)
        isSet x = 0 /= x .&. b
        ones = filter isSet as
        zeros = filter (not . isSet) as

solve :: String -> String
solve input = show $ minRemoval $ map read $ tail $ words input
  where minRemoval as = length as - maxTree as (2^29)

main = interact solve


Let's define an unambiguous arithmetic expression (UAE) as follows.   All non-negative integers are UAE's. Integers may have leading zeroes (for example, 0000 and 0010 are considered valid integers).  If X and Y are two UAE's, then "(X) + (Y)", "(X) - (Y)", "(X) * (Y)", and "(X) / (Y)" (all without the double quotes) are UAE's.  If X is an UAE, then " - (X)" and " + (X)" (both without the double quotes) are UAE's.You are given a string consisting only of digits ("0" - "9") and characters "-", "+", "*", and "/". Your task is to compute the number of different possible unambiguous arithmetic expressions such that if all brackets (characters "(" and ")") of that unambiguous arithmetic expression are removed, it becomes the input string. Since the answer may be very large, print it modulo 1000003 (106 + 3).

The first line is a non-empty string consisting of digits ('0'-'9') and characters '-', '+', '*', and/or '/'. Its length will not exceed 2000. The line doesn't contain any spaces.

Print a single integer representing the number of different unambiguous arithmetic expressions modulo 1000003 (106 + 3) such that if all its brackets are removed, it becomes equal to the input string (character-by-character).

NoteFor the first example, the two possible unambiguous arithmetic expressions are:((1) + (2)) * (3)(1) + ((2) * (3))For the second example, the three possible unambiguous arithmetic expressions are:(03) + (( - (30)) + (40))(03) + ( - ((30) + (40)))((03) + ( - (30))) + (40)

import Char
import List
import Data.Function
main = interact$show.solve.groupBy((==)`on`isDigit).head.words
solve xs | head (head xs)`elem`"*/" = 0
         | otherwise                = head $ go xs
go [x:_] | isDigit x = repeat 1
go ((x:y):z)
  | isDigit x        = go z
  | any(`elem`"*/")y = repeat 0
  | otherwise        = map (`mod`1000003) $ scanl1 (+) $ drop (length y+1) $ go z
go _ = repeat 0

import Char
import List
import Data.Function
main = interact$show.solve.groupBy((==)`on`isDigit).head.words
solve xs = head $ go xs
go [x:_] | isDigit x = repeat 1
go ((x:y):z)
  | isDigit x        = go z
  | any(`elem`"*/")y = repeat 0
  | otherwise        = map (`mod`1000003) $ scanl1 (+) $ drop (length y+1) $ go z
go _ = repeat 0


You are given an integer $$$n$$$. You have to apply $$$m$$$ operations to it.In a single operation, you must replace every digit $$$d$$$ of the number with the decimal representation of integer $$$d + 1$$$. For example, $$$1912$$$ becomes $$$21023$$$ after applying the operation once.You have to find the length of $$$n$$$ after applying $$$m$$$ operations. Since the answer can be very large, print it modulo $$$10^9+7$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^5$$$) — the number of test cases. The only line of each test case contains two integers $$$n$$$ ($$$1 \le n \le 10^9$$$) and $$$m$$$ ($$$1 \le m \le 2 \cdot 10^5$$$) — the initial number and the number of operations.

For each test case output the length of the resulting number modulo $$$10^9+7$$$.

NoteFor the first test, $$$1912$$$ becomes $$$21023$$$ after $$$1$$$ operation which is of length $$$5$$$.For the second test, $$$5$$$ becomes $$$21$$$ after $$$6$$$ operations which is of length $$$2$$$.For the third test, $$$999$$$ becomes $$$101010$$$ after $$$1$$$ operation which is of length $$$6$$$.For the fourth test, $$$88$$$ becomes $$$1010$$$ after $$$2$$$ operations which is of length $$$4$$$.

import Data.Array
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Monad

maxNumber=2*10^5
moduleNumber=10^9+7

solve :: [[Int]] -> [Int]
solve l = [go num m | [num,m] <- l]
  where
    go 0 _ = 0
    go num m =
      let d = num `rem` 10
       in (f d m + go (num `div` 10) m) `rem` moduleNumber
    mem = listArray (0,maxNumber + 9) [g n | n <- [0..maxNumber + 9]] :: Array Int Int
    f d m = g (m + d)
    g :: Int -> Int
    g n
      | n <= 9 = 1
      | otherwise = (mem ! (n - 10 + 1) + mem ! (n - 10)) `rem` moduleNumber

readInt :: ByteString -> Int
readInt b =  fst . fromJust $ B.readInt b
main = do
  B.getLine
  l <- B.lines <$> B.getContents
  let ll = map (map readInt . B.words) l
  forM_ (solve ll) print