Stephen Queen wants to write a story. He is a very unusual writer, he uses only letters 'a', 'b', 'c', 'd' and 'e'!To compose a story, Stephen wrote out $$$n$$$ words consisting of the first $$$5$$$ lowercase letters of the Latin alphabet. He wants to select the maximum number of words to make an interesting story.Let a story be a sequence of words that are not necessarily different. A story is called interesting if there exists a letter which occurs among all words of the story more times than all other letters together.For example, the story consisting of three words "bac", "aaada", "e" is interesting (the letter 'a' occurs $$$5$$$ times, all other letters occur $$$4$$$ times in total). But the story consisting of two words "aba", "abcde" is not (no such letter that it occurs more than all other letters in total).You are given a sequence of $$$n$$$ words consisting of letters 'a', 'b', 'c', 'd' and 'e'. Your task is to choose the maximum number of them to make an interesting story. If there's no way to make a non-empty story, output $$$0$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 5000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of the words in the sequence. Then $$$n$$$ lines follow, each of them contains a word — a non-empty string consisting of lowercase letters of the Latin alphabet. The words in the sequence may be non-distinct (i. e. duplicates are allowed). Only the letters 'a', 'b', 'c', 'd' and 'e' may occur in the words. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^5$$$; the sum of the lengths of all words over all test cases doesn't exceed $$$4 \cdot 10^5$$$.

For each test case, output the maximum number of words that compose an interesting story. Print 0 if there's no way to make a non-empty interesting story.

6
3
bac
aaada
e
3
aba
abcde
aba
2
baba
baba
4
ab
ab
c
bc
5
cbdca
d
a
d
e
3
b
c
ca

NoteIn the first test case of the example, all $$$3$$$ words can be used to make an interesting story. The interesting story is "bac aaada e".In the second test case of the example, the $$$1$$$-st and the $$$3$$$-rd words can be used to make an interesting story. The interesting story is "aba aba". Stephen can't use all three words at the same time.In the third test case of the example, Stephen can't make a non-empty interesting story. So the answer is $$$0$$$.In the fourth test case of the example, Stephen can use the $$$3$$$-rd and the $$$4$$$-th words to make an interesting story. The interesting story is "c bc".

--
-- Michael V. Antosha
-- 2021
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad
import Data.List
import Data.Tuple

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    n <- readLn
    replicateM n getLine

solve = show . maximum . map solvePMs . transpose . map toPlusMinus . toCharCounts

toCharCounts ws = transpose . map (charFreqs ws) $ ['a'..'e']
charFreqs ws c = map (charFreq c) ws
charFreq c = length . filter (==c)

toPlusMinus cnts = (map.g.sum) cnts cnts
  where
    g len cnt = (cnt, len - cnt)     -- (this char, other chars of the word)

solvePMs = length . takeWhile (>0) . scanl1 (+) . map (uncurry (-)) . sortOn (uncurry (-) . swap)

--
-- Michael V. Antosha
-- 2021
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad
import Data.List
import Data.Tuple

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    n <- readLn
    replicateM n getLine

solve = show . maximum . map solvePMs . transpose . map toPlusMinus . toCharCounts

toCharCounts ws = transpose . map (charFreqs ws) $ ['a'..'e']
charFreqs ws c = map (charFreq c) ws
charFreq c = length . filter (==c)

toPlusMinus cnts = map (g.sum $ cnts) cnts
  where
    g len cnt = (cnt, len - cnt)     -- (this char, other chars of the word)

solvePMs = length . takeWhile (>0) . scanl1 (+) . map (uncurry (-)) . sortOn (uncurry (-) . swap)

--
-- Michael V. Antosha
-- 2021
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad
import Data.List
import Data.Tuple

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    n <- readLn
    replicateM n getLine

solve = show . maximum . map solvePMs . transpose . map toPlusMinus . toCharCounts

toCharCounts :: [String] -> [[Int]]
toCharCounts ws = transpose . map (charFreqs ws) $ ['a'..'e']

charFreqs :: [String] -> Char -> [Int]
charFreqs ws c = map (charFreq c) ws

charFreq :: Char -> String -> Int
charFreq c = length . filter (==c)

toPlusMinus :: [Int] -> [(Int,Int)]
toPlusMinus cnts = map (g.sum $ cnts) cnts
  where
    g len cnt = (cnt, len - cnt)     -- (this char, other chars of the word)

solvePMs = length . takeWhile (>0) . scanl1 (+) . map (uncurry (-)) . sortOn (uncurry (-) . swap)

import Control.Monad (replicateM_, replicateM)
import Data.List (transpose, sortBy)
import Data.Map ((!), (!?))
import qualified Data.Map as M

type CharMap = M.Map Char Int

scoreWord :: String -> CharMap
scoreWord s = M.map score finalCnt where
  ins k = M.insertWith (+) k 1
  cnt = foldr ins M.empty s
  l = M.foldr (+) 0 cnt
  score x = x - (l - x)
  insMissing k = M.insertWith (\_ x -> x) k 0
  finalCnt = foldr insMissing cnt ['a'..'e']

interestingWords :: [String] -> Int
interestingWords words = maximum $ map findMax scoreByChar where
  scoreMaps = map scoreWord words
  scoreMatrix = map (map snd . M.toList) scoreMaps
  sortDesc = sortBy (flip compare)
  scoreByChar = map sortDesc $ transpose scoreMatrix
  findMax = length . takeWhile (>0) . scanl1 (+)

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    words <- replicateM n getLine
    print $ interestingWords words

import Control.Monad
import Data.IntMap (IntMap)
import qualified Data.IntMap as M
import Data.List
import Data.Maybe
import Data.Ord

numToInt :: Char -> Int
numToInt 'a' = 0
numToInt 'b' = 1
numToInt 'c' = 2
numToInt 'd' = 3
numToInt 'e' = 4
numToInt _ = undefined

-- | Take a sequence of elements and convert into frequency mapping
collect :: [Int] -> IntMap Int
collect = foldl ins_ $ M.fromList [(i, 0) | i <- [0 .. 4]]
  where
    ins_ m n = M.alter (Just . maybe 1 (+ 1)) n m

solution' :: Int -> [IntMap Int] -> Int
solution' l words = length correctWords
  where
    diff m = 2 * (m M.! l) - sum (M.elems m)
    sortedWords = sortOn (Down . diff) words
    aggWords = scanl1 (M.unionWith (+)) sortedWords
    correctWords = takeWhile ((> 0) . diff) aggWords

prepareWords :: [String] -> [IntMap Int]
prepareWords words = do
  word <- words
  let wordNum = numToInt <$> word
  return $ collect wordNum

solution :: [String] -> Int
solution words = maximum $ (`solution'` prepareWords words) <$> [0 .. 4]

main :: IO ()
main = do
  n <- read <$> getLine
  forM_ [1 .. n] $ \_ -> do
    n' <- read <$> getLine
    words <- traverse (const getLine) [1 .. n']
    print $ solution words

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict #-}

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

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = show . solve <$> numberOf str

solve :: [String] -> Int
solve ws = maximum . map compute $ ['a' .. 'e']
  where
    compute :: Char -> Int
    compute c =
      length
        . takeWhile (> 0)
        . scanl1 (+)
        . reverse
        . sort
        $ map cost ws
      where
        cost w = 2 * count c w - length w

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

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified Data.Ratio as Rat

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

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

maxlen xs ch = res
  where a = map (\word -> (length $ filter (==ch) word, length word)) xs
        b = sortBy (\x1 x2 -> let diff (q,w) = w - 2*q in compare (diff x1) (diff x2)) a
        (res, _, _) = foldl (\(taken, good, bad) (q,w) -> let (g,b) = (good+q, bad+w-q) in
                                                    (if g > b then (taken+1, g, b) else (taken, good, bad))) (0, 0, 0) b

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  a <- readrows n
  let sol = maximum $ map (maxlen a) ['a'..'e'] in
    print sol

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

----------------------------------------------------------------------------------------
readrows :: (Integral b) => b -> IO [String]
readrows 0 = return []
readrows n = do
  row <- getLine
  l <- readrows $ n-1
  return (row : l)

readintrows :: (Integral a, Integral b) => b -> IO [[a]]
readintrows 0 = return []
readintrows n = do
  row <- readInts
  l <- readintrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs

--
-- Michael V. Antosha
-- 2021
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    n <- readLn
    replicateM n getLine

solve = const "123"


Saitama accidentally destroyed a hotel again. To repay the hotel company, Genos has volunteered to operate an elevator in one of its other hotels. The elevator is special — it starts on the top floor, can only move down, and has infinite capacity. Floors are numbered from 0 to s and elevator initially starts on floor s at time 0.The elevator takes exactly 1 second to move down exactly 1 floor and negligible time to pick up passengers. Genos is given a list detailing when and on which floor passengers arrive. Please determine how long in seconds it will take Genos to bring all passengers to floor 0.

The first line of input contains two integers n and s (1 ≤ n ≤ 100, 1 ≤ s ≤ 1000) — the number of passengers and the number of the top floor respectively. The next n lines each contain two space-separated integers fi and ti (1 ≤ fi ≤ s, 1 ≤ ti ≤ 1000) — the floor and the time of arrival in seconds for the passenger number i.

Print a single integer — the minimum amount of time in seconds needed to bring all the passengers to floor 0.

NoteIn the first sample, it takes at least 11 seconds to bring all passengers to floor 0. Here is how this could be done:1. Move to floor 5: takes 2 seconds.2. Pick up passenger 3.3. Move to floor 3: takes 2 seconds.4. Wait for passenger 2 to arrive: takes 4 seconds.5. Pick up passenger 2.6. Go to floor 2: takes 1 second.7. Pick up passenger 1.8. Go to floor 0: takes 2 seconds.This gives a total of 2 + 2 + 4 + 1 + 2 = 11 seconds.

import Data.List

main = do
    interact solve

solve input = show (do_it s 0)
    where
        numbers :: [Int]
        numbers = map read (words input)
        (n,s):rest = two_by_two numbers

        do_it :: Int -> Int -> Int
        do_it (-1) current = current-1
        do_it cs current = do_it (cs-1) (newtime+1)
            where newtime = max current (last_arrival cs rest)

last_arrival :: Int -> [(Int,Int)] -> Int
last_arrival ofn inputbytwo = doloop inputbytwo
    where
        doloop [] = 0
        doloop ((floor,time):xs)
                | (floor /= ofn) = othertime
                | otherwise = max time othertime
            where
                othertime = doloop xs

two_by_two (x:y:xs) = (x,y):two_by_two(xs)
two_by_two [] = []

-- Michael V. Antosha  <Michael.Antosha@gmail.com>
-- 2015
-- http://mivael.in.ua

import Data.Array (Array)
import Data.Array.IArray (accumArray, (!))
import Data.List (foldl')

type IntType = Int

main :: IO ()
main = do
  in_str <- getContents
  putStrLn . solve $ in_str

solve :: String -> String
solve = show . solveInt . map read . words

solveInt :: [IntType] -> IntType  -- [num] -> time
solveInt (n:s:arrivals) = calculate . parse $ arrivals
  where
    parse = verifyLength n . makePairs
    makePairs = makePairsRev  -- order is not important
    calculate = calcTotalTime s . calcArrivals s
    calcArrivals = calcLastArrivalTimeForEachFloor
solveInt _ = undefined  -- not enough input data

makePairsRev :: [a] -> [(a, a)]
makePairsRev = mp [] where
  mp lst [] = lst
  mp lst (f:t:rest) = mp ((f,t):lst) rest
  mp _ (_:[]) = undefined  -- odd number of integers

verifyLength :: IntType -> [a] -> [a]  -- length -> [a] -> [a]
verifyLength len _ | (len < 0) = undefined
verifyLength list_length list_of_pairs
    = vl list_length list_of_pairs list_of_pairs
  where
    vl 0 [] list = list
    vl 0 _ _ = undefined
    vl len (_:xs) list = vl (len - 1) xs list
    vl _ [] _ = undefined  -- check failed (wrong 'len')

calcLastArrivalTimeForEachFloor ::
  IntType -> [(IntType, IntType)] -> Array IntType IntType
  -- floor -> [(floor, time)] -> Array floor time
calcLastArrivalTimeForEachFloor s = accumArray max 0 (0,s)

calcTotalTime :: IntType -> Array IntType IntType -> IntType
                 -- floor -> Array floor time -> time
calcTotalTime s arr = foldl' func (t0 - spf) lst
  where
    t0 = 0  -- start time
    spf = 1  -- seconds per floor
    lst = map (arr!) . takeWhile (>= 0) . iterate (subtract 1) $ s
    -- func prev_total last_passenger_arrival = ...
    func prev = max (prev + spf)

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

solve :: Int -> Int -> [(Int,Int)] -> Int
solve nf nt [] = nt + nf
solve nf nt ((f,t):xs)
    | nf == f = solve nf (max nt t) xs
    | otherwise = solve f (nt+nf-f) $ (f,t):xs

main :: IO ()
main = do
    [n,s] <- map read . words <$> getLine
    lst <- sort <$> replicateM n (do
        [f,t] <- map read . words <$> getLine
        return (f,t))
    print $ solve s 0 lst

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

main= do
	[n,s]<-map read. words <$> getLine ::IO [Int]
	q<- map (map read) .map words.lines <$> getContents ::IO [[Int]]
	print $ max s $  maximum $   map (\[a,b]-> a+b) q

main = do
  [n, s] <- getLine >>= return. map read. words
  a <- getContents >>= return. maximum. map (sum. map read. words). lines
  print. max s $ a

-- Michael V. Antosha  <Michael.Antosha@gmail.com>
-- 2015
-- http://mivael.in.ua

import Data.Array (Array)
import Data.Array.IArray (accumArray, (!))
import Data.List (foldl')

type IntType = Int

main :: IO ()
main = do
  in_str <- getContents
  putStrLn . solve $ in_str

solve :: String -> String
solve = show . solveInt . map read . words

solveInt :: [IntType] -> IntType  -- [num] -> time
solveInt (n:s:arrivals) = calculate . parse $ arrivals
  where
    parse = verifyLength n . makePairs
    makePairs = makePairsRev  -- order is not important
    calculate = calcTotalTime s . calcArrivals s
    calcArrivals = calcLastArrivalTimeForEachFloor
solveInt _ = undefined  -- not enough input data

makePairsRev :: [a] -> [(a, a)]
makePairsRev = mp [] where
  mp lst [] = lst
  mp lst (f:t:rest) = mp ((f,t):lst) rest
  mp _ (_:[]) = undefined  -- odd number of integers

verifyLength :: IntType -> [a] -> [a]  -- length -> [a] -> [a]
verifyLength list_length list_of_pairs
  | list_length >= 0
    = vl list_length list_of_pairs list_of_pairs
  where
    vl 0 [] list = list
    vl 0 _ _ = undefined
    vl len (_:xs) list = vl (len - 1) xs list
    vl _ [] _ = undefined  -- check failed (wrong 'len')

calcLastArrivalTimeForEachFloor ::
  IntType -> [(IntType, IntType)] -> Array IntType IntType
  -- floor -> [(floor, time)] -> Array floor time
calcLastArrivalTimeForEachFloor s = accumArray max 0 (0,s)

calcTotalTime :: IntType -> Array IntType IntType -> IntType
                 -- floor -> Array floor time -> time
calcTotalTime s arr = foldl' func 0 lst
  where
    lst = map (arr!) . takeWhile (>= 0) . iterate (subtract 1) $ s
    func x y = max (x+1) y

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

main= do
	getLine
	s<- map (map read) .map words.lines <$> getContents ::IO [[Int]]
	print $  maximum $ map (\[a,b]-> a+b) s

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

main= do
	s<- map (map read) .map words.lines <$> getContents ::IO [[Int]]
	print $  maximum $   map (\[a,b]-> a+b) s


This problem is given in two editions, which differ exclusively in the constraints on the number $$$n$$$.You are given an array of integers $$$a[1], a[2], \dots, a[n].$$$ A block is a sequence of contiguous (consecutive) elements $$$a[l], a[l+1], \dots, a[r]$$$ ($$$1 \le l \le r \le n$$$). Thus, a block is defined by a pair of indices $$$(l, r)$$$.Find a set of blocks $$$(l_1, r_1), (l_2, r_2), \dots, (l_k, r_k)$$$ such that:  They do not intersect (i.e. they are disjoint). Formally, for each pair of blocks $$$(l_i, r_i)$$$ and $$$(l_j, r_j$$$) where $$$i \neq j$$$ either $$$r_i < l_j$$$ or $$$r_j < l_i$$$.  For each block the sum of its elements is the same. Formally, $$$$$$a[l_1]+a[l_1+1]+\dots+a[r_1]=a[l_2]+a[l_2+1]+\dots+a[r_2]=$$$$$$ $$$$$$\dots =$$$$$$ $$$$$$a[l_k]+a[l_k+1]+\dots+a[r_k].$$$$$$  The number of the blocks in the set is maximum. Formally, there does not exist a set of blocks $$$(l_1', r_1'), (l_2', r_2'), \dots, (l_{k'}', r_{k'}')$$$ satisfying the above two requirements with $$$k' > k$$$.     The picture corresponds to the first example. Blue boxes illustrate blocks. Write a program to find such a set of blocks.

The first line contains integer $$$n$$$ ($$$1 \le n \le 50$$$) — the length of the given array. The second line contains the sequence of elements $$$a[1], a[2], \dots, a[n]$$$ ($$$-10^5 \le a_i \le 10^5$$$).

In the first line print the integer $$$k$$$ ($$$1 \le k \le n$$$). The following $$$k$$$ lines should contain blocks, one per line. In each line print a pair of indices $$$l_i, r_i$$$ ($$$1 \le l_i \le r_i \le n$$$) — the bounds of the $$$i$$$-th block. You can print blocks in any order. If there are multiple answers, print any of them.

{-# LANGUAGE Safe, FlexibleContexts #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import qualified Data.IntSet as S
import Data.Array.ST.Safe
import Control.Monad.ST
import Control.Monad
import Data.Int
import Data.Array
import qualified Data.Array.Unboxed as U

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

solve :: [Int] -> Builder
solve (n:a') = intDec (length ans0) <> char7 '\n' <> (mconcat $ map enc ans0)
  where
    a = take n a'
    s = scanl (+) 0 a
    x = listArray (0, n) s
    ss = S.toList $ S.fromList [(x ! i) - (x ! j) | i <- [1 .. n], j <- [0 .. pred i]]
    y = map f ss
    y' = maximum $ map fst y
    r :: U.UArray Int Int32
    (_, r) = y' `seq` head $ dropWhile ( (/= y') . fst) y
    rest i ans
      | i > n = ans
      | r U.! i < 0 = rest (succ i) ans
      | otherwise = rest (succ $ fromIntegral $ r U.! i) ( (i, fromIntegral $ r U.! i) : ans)
    ans0 = rest 1 []
    enc (u, v) = intDec u <> char7 ' ' <> intDec v <> char7 '\n'

    f sm = (res U.! 0, res)
      where
        res = runSTUArray $ do
          dp <- newArray_ (1, n + 1) :: ST s (STUArray s Int Int32)
          best <- newArray_ (0, n + 1) :: ST s (STUArray s Int Int32)
          writeArray dp (n+1) 0
          forM_ [n, n - 1 .. 1] $ \i -> do
            let si = x ! (i - 1)
            w <- readArray dp (i+1)
            writeArray dp i w
            writeArray best i (-1)
            let next = [ j | j <- [i .. n], let ss = (x ! j) - si, ss == sm]
            forM_ next $ \j -> do
              w' <- readArray dp (j+1)
              w <- readArray dp i
              when (w < succ w') $ do
                writeArray dp i (succ w')
                writeArray best i (fromIntegral j)
          readArray dp 1 >>= (writeArray best 0)
          return best

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents


Sasha likes investigating different math objects, for example, magic squares. But Sasha understands that magic squares have already been studied by hundreds of people, so he sees no sense of studying them further. Instead, he invented his own type of square — a prime square. A square of size $$$n \times n$$$ is called prime if the following three conditions are held simultaneously:   all numbers on the square are non-negative integers not exceeding $$$10^5$$$;  there are no prime numbers in the square;  sums of integers in each row and each column are prime numbers. Sasha has an integer $$$n$$$. He asks you to find any prime square of size $$$n \times n$$$. Sasha is absolutely sure such squares exist, so just help him!

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10$$$) — the number of test cases. Each of the next $$$t$$$ lines contains a single integer $$$n$$$ ($$$2 \le n \le 100$$$) — the required size of a square.

For each test case print $$$n$$$ lines, each containing $$$n$$$ integers — the prime square you built. If there are multiple answers, print any.

module Main where

import Control.Monad

isPrime :: Int -> Bool
isPrime x =
  not $ any (\y -> x `mod` y == 0) $ takeWhile (\y -> y * y <= x) [2 ..]

findGoodPrime :: Int -> Int
findGoodPrime n =
  head $ filter (\m -> isPrime m && not (isPrime (m - n + 1))) [n ..]

primeArray :: Int -> [Int]
primeArray n = replicate (n - 1) 1 ++ [m - n + 1]
   where m = findGoodPrime n

shift :: [a] -> [a]
shift [] = []
shift (x:xs) = xs ++ [x]

generateSquare :: Int -> [Int] -> [[Int]]
generateSquare n xs = take n $ iterate shift xs

solveCase :: Int -> [[Int]]
solveCase n = generateSquare n $ primeArray n

readCase :: IO Int
readCase = read <$> getLine

main :: IO ()
main = do
  t <- read <$> getLine
  ns <- replicateM t readCase
  putStr $ unlines $ map (unwords . map show) $ concatMap solveCase ns

import Control.Monad
import Data.List

rots :: [t] -> [[t]]
rots li = [q ++ p | (p, q) <- tail $ zip (inits li) (tails li)]

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    let  q = [1,1] ++ replicate (n-2) 0 :: [Int]
    forM_ (rots q) $ \a -> putStrLn . unwords $ map show a


You are given a number $$$n$$$ (divisible by $$$3$$$) and an array $$$a[1 \dots n]$$$. In one move, you can increase any of the array elements by one. Formally, you choose the index $$$i$$$ ($$$1 \le i \le n$$$) and replace $$$a_i$$$ with $$$a_i + 1$$$. You can choose the same index $$$i$$$ multiple times for different moves.Let's denote by $$$c_0$$$, $$$c_1$$$ and $$$c_2$$$ the number of numbers from the array $$$a$$$ that have remainders $$$0$$$, $$$1$$$ and $$$2$$$ when divided by the number $$$3$$$, respectively. Let's say that the array $$$a$$$ has balanced remainders if $$$c_0$$$, $$$c_1$$$ and $$$c_2$$$ are equal.For example, if $$$n = 6$$$ and $$$a = [0, 2, 5, 5, 4, 8]$$$, then the following sequence of moves is possible:   initially $$$c_0 = 1$$$, $$$c_1 = 1$$$ and $$$c_2 = 4$$$, these values are not equal to each other. Let's increase $$$a_3$$$, now the array $$$a = [0, 2, 6, 5, 4, 8]$$$;  $$$c_0 = 2$$$, $$$c_1 = 1$$$ and $$$c_2 = 3$$$, these values are not equal. Let's increase $$$a_6$$$, now the array $$$a = [0, 2, 6, 5, 4, 9]$$$;  $$$c_0 = 3$$$, $$$c_1 = 1$$$ and $$$c_2 = 2$$$, these values are not equal. Let's increase $$$a_1$$$, now the array $$$a = [1, 2, 6, 5, 4, 9]$$$;  $$$c_0 = 2$$$, $$$c_1 = 2$$$ and $$$c_2 = 2$$$, these values are equal to each other, which means that the array $$$a$$$ has balanced remainders. Find the minimum number of moves needed to make the array $$$a$$$ have balanced remainders.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. The first line of each test case contains one integer $$$n$$$ ($$$3 \le n \le 3 \cdot 10^4$$$) — the length of the array $$$a$$$. It is guaranteed that the number $$$n$$$ is divisible by $$$3$$$. The next line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \leq a_i \leq 100$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$150\,000$$$.

For each test case, output one integer — the minimum number of moves that must be made for the $$$a$$$ array to make it have balanced remainders.

NoteThe first test case is explained in the statements.In the second test case, you need to make one move for $$$i=2$$$.The third test case you need to make three moves:   the first move: $$$i=9$$$;  the second move: $$$i=9$$$;  the third move: $$$i=2$$$. In the fourth test case, the values $$$c_0$$$, $$$c_1$$$ and $$$c_2$$$ initially equal to each other, so the array $$$a$$$ already has balanced remainders.

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import Data.Map((!))

powerTwo :: Integer -> Integer -> Integer
powerTwo x y | 2 * x >= y = 0
powerTwo x y | 2 * x < y = 1+powerTwo (2*x) y

result list = aux c0 c1 c2 where
	c0 = sum [1 | x <- list, mod x 3 == 0]
	c1 = sum [1 | x <- list, mod x 3 == 1]
	c2 = sum [1 | x <- list, mod x 3 == 2]
	n = c0 + c1 + c2
	aux x y z
		| x > y = 1 + aux (x-1) (y+1) z
		| y > z = 1 + aux x (y-1) (z+1)
		| z > x = 1 + aux (x+1) y (z-1)
		| otherwise = 0

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		print $ result a
		loop $ t - 1
	loop t

-- import Debug.Trace

type InType  = [Int]
type OutType = Int

inpLines :: Int
inpLines = 2

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

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

calc :: Int -> Int -> Int -> Int
calc c0 c1 c2
    | c0 == c1 && c1 == c2 = 0
    | c1 + 1 < c0 = let (op, c1', c0') = go c1 c0 in op + calc c0' c1' c2
    | c2 + 1 < c1 = let (op, c2', c1') = go c2 c1 in op + calc c0 c1' c2'
    | c0 + 1 < c2 = let (op, c0', c2') = go c0 c2 in op + calc c0' c1 c2'
    | otherwise = maximum [c0, c1, c2] - minimum [c0, c1,c2]
    where go x y = ( (y - x) `div` 2
                   , (y + x) `div` 2
                   , (y + x + 1) `div` 2 )

solve :: InType -> OutType
solve a = {- trace (unwords [show c0, show c1, show c2]) $ -} calc c0 c1 c2
    where [c0, c1, c2] = foldr (\x xs -> up (x `mod` 3) xs) [0,0,0] a
          up 0 [x, y, z] = [x + 1, y, z]
          up 1 [x, y, z] = [x, y + 1, z]
          up 2 [x, y, z] = [x, y, z + 1]

receive :: [String] -> InType
receive [_, t] = toArr t

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

module Main where

import Control.Monad

main :: IO ()
main = do
    n <- ((read :: String -> Int) <$> getLine)
    replicateM_ n action

action = getLine >> getLine >>= print . calc . foldr counter (0, 0, 0) . map ((`mod` 3) . (read :: String -> Int)) . words
  where
    counter 0 (a,b,c) = (a+1,b,c)
    counter 1 (a,b,c) = (a,b+1,c)
    counter 2 (a,b,c) = (a,b,c+1)

calc :: (Int, Int, Int) -> Int
calc (a,b,c)
    | a >= d && c <= d = move (a,b,c)
    | b >= d && a <= d = move (b,c,a)
    | c >= d && b <= d = move (c,a,b)
  where
    d = (a+b+c) `div` 3
--    move :: (Int, Int, Int) -> ((Int, Int, Int), Int)
    move (q,w,e) = (q-d) + (d-e)

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Exception (assert)
import Control.Monad
import Control.Monad.State
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Bits
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = do
  n <- popInt
  as <- popInts
  return $ bshow $ solve n as

uncurry3 f (a, b, c) = f a b c

solve n as = (uncurry3 rot) $ count $ map (`rem` 3) as
  where
    m = n `quot` 3

    count as = count' as 0 0 0

    count' [] p q r = (p, q, r)
    count' (a : as) p q r = case a of
                              0 -> count' as (p + 1) q r
                              1 -> count' as p (q + 1) r
                              2 -> count' as p q (r + 1)

    rot a b c | a == b && b == c = 0
              | otherwise = let mx = maximum [a, b, c] in
                              case (mx == a, mx == b) of
                                (True, _) -> rot' a b c
                                (_, True) -> rot' b c a
                                _ -> rot' c a b

    rot' a b c = let d = a - m in
                   d + rot (a - d) (b + d) c

distribute :: [Integer] -> Integer -> Integer
distribute counts@(c:rest) extra
  | all (== c) counts = 0
  | otherwise         = moveCost + distribute newCounts newExtra
    where wanted = (sum counts + extra) `div` 3
          leftHere = max 0 (min (wanted - c) extra)
          takenFromHere = max 0 (c - wanted)
          moveCost = extra - leftHere + takenFromHere
          newCounts = rest ++ [c + leftHere - takenFromHere]
          newExtra = extra - leftHere + takenFromHere

solveTest :: [Integer] -> Integer
solveTest xs = distribute counts 0
    where counts = [toInteger $ length $ multiples x | x <- [0..2]]
          multiples m = filter ((== m) . (`mod` 3)) xs

solve :: String -> String
solve = unlines . map solveStringTest . odds . drop 1 . lines
    where odds = map snd . filter (odd . fst) . zip [0..]
          solveStringTest = show . solveTest . map read . words

main :: IO ()
main = interact solve

import Control.Monad

readArray :: Read a => IO [a]
readArray = fmap (map read . words) getLine

readInts :: IO [Int]
readInts = readArray

readInt :: IO Int
readInt = readLn

count :: (a -> Bool) -> [a] -> Int
count _ [] = 0
count f (x:xs) = (if f x then 1 else 0) + count f xs

hist :: [Int] -> [Int]
hist a = [count (\j -> j `mod` 3 == i) a | i <- [0..2]]

rec :: [Int] -> Int -> Int
rec (0:0:0:xs) a = 0
rec (x:xs) a = let t = max 0 (a + x) in t + rec (xs ++ [a + x - t]) t

solve :: [Int] -> Int
solve a = let want = (length a) `div` 3 in rec (map (\j -> j - want) (hist a)) 0

main :: IO ()
main = readInt >>= flip replicateM_ (readInt >> fmap solve readInts >>= print)

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    a <- readInts
    let
      rems :: UArray Int Int
      rems = accumArray (\v _ -> v+1) 0 (0, 2) $ [(rem ai 3, ()) | ai <- a]
      tar = div n 3
      cost x y = max 0 (min (rems ! x - tar) (tar - rems ! y)) * mod (y - x) 3
    -- This works because there is no room for a two-sink, two-source situation
    putInts [sum $ liftM2 cost [0..2] [0..2]]

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import Data.Map((!))

powerTwo :: Integer -> Integer -> Integer
powerTwo x y | 2 * x >= y = 0
powerTwo x y | 2 * x < y = 1+powerTwo (2*x) y

result list = aux3 c0 c1 c2 where
	c0 = sum [1 | x <- list, mod x 3 == 0]
	c1 = sum [1 | x <- list, mod x 3 == 1]
	c2 = sum [1 | x <- list, mod x 3 == 2]
	n = c0 + c1 + c2
	aux3 x y z
		| x >= y && x >= z = x - (div n 3) + (y + x - (div n 3)) - div n 3
		| y >= z && y >= x = y - (div n 3) + (z + y - (div n 3)) - div n 3
		| z >= x && z >= y = z - (div n 3) + (x + z - (div n 3)) - div n 3

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		print $ result a
		loop $ t - 1
	loop t


There are n sharks who grow flowers for Wet Shark. They are all sitting around the table, such that sharks i and i + 1 are neighbours for all i from 1 to n - 1. Sharks n and 1 are neighbours too.Each shark will grow some number of flowers si. For i-th shark value si is random integer equiprobably chosen in range from li to ri. Wet Shark has it's favourite prime number p, and he really likes it! If for any pair of neighbouring sharks i and j the product si·sj is divisible by p, then Wet Shark becomes happy and gives 1000 dollars to each of these sharks.At the end of the day sharks sum all the money Wet Shark granted to them. Find the expectation of this value.

The first line of the input contains two space-separated integers n and p (3 ≤ n ≤ 100 000, 2 ≤ p ≤ 109) — the number of sharks and Wet Shark's favourite prime number. It is guaranteed that p is prime. The i-th of the following n lines contains information about i-th shark — two space-separated integers li and ri (1 ≤ li ≤ ri ≤ 109), the range of flowers shark i can produce. Remember that si is chosen equiprobably among all integers from li to ri, inclusive.

Print a single real number — the expected number of dollars that the sharks receive in total. You answer will be considered correct if its absolute or relative error does not exceed 10 - 6.  Namely: let's assume that your answer is a, and the answer of the jury is b. The checker program will consider your answer correct, if .

NoteA prime number is a positive integer number that is divisible only by 1 and itself. 1 is not considered to be prime.Consider the first sample. First shark grows some number of flowers from 1 to 2, second sharks grows from 420 to 421 flowers and third from 420420 to 420421. There are eight cases for the quantities of flowers (s0, s1, s2) each shark grows: (1, 420, 420420): note that s0·s1 = 420, s1·s2 = 176576400, and s2·s0 = 420420. For each pair, 1000 dollars will be awarded to each shark. Therefore, each shark will be awarded 2000 dollars, for a total of 6000 dollars. (1, 420, 420421): now, the product s2·s0 is not divisible by 2. Therefore, sharks s0 and s2 will receive 1000 dollars, while shark s1 will receive 2000. The total is 4000. (1, 421, 420420): total is 4000  (1, 421, 420421): total is 0.  (2, 420, 420420): total is 6000.  (2, 420, 420421): total is 6000.  (2, 421, 420420): total is 6000. (2, 421, 420421): total is 4000.The expected value is .In the second sample, no combination of quantities will garner the sharks any money.

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  [n, p] <- fmap (map read . words) getLine
  inp <- forM [1..n] $ \_ -> do
         [l, r] <- fmap (map read . words) getLine
         return (l, r)
  print $ solve p inp

solve :: Integer -> [(Integer, Integer)] -> Double
solve p inp = sum ints + exp (head inp) (last inp)
    where
      ints = zipWith exp inp (tail inp)
      exp (l1, r1) (l1', r1') = numer*2000/fromIntegral (len1*len2)
          where
            numer :: Double
            numer = fromIntegral (num1*len2 + num2*len1 - num1*num2)
            len1 = r1 - l1 + 1
            len2 = r1' - l1' + 1
            num1 = (r1 `div` p) - (l1-1)`div`p
            num2 = (r1' `div` p) - (l1'-1)`div`p

inp1 = [(1,2), (420, 421), (420420, 420421)]
inp2 :: [(Int, Int)]
inp2 = [(1,4), (2,3), (11,14)]

import Control.Monad;

main = do
    (n:p:[]) <- getLine >>= return.(map (toInteger.read)).words
    list <- replicateM (fromInteger n) (getLine>>=return.(\[a,b]->(a,b)).(map (toInteger.read)).words)
    putStrLn $ show $ solve list p

adj x = (last x, head x):(zip x (tail x))

solve :: [(Integer, Integer)] -> Integer -> Double
solve x p = sum $ map (\a -> (pairChance a p)*2000) (adj x)

pairChance :: ((Integer, Integer), (Integer, Integer)) -> Integer -> Double
pairChance ((a,b), (c,d)) p = 1-(1-p1)*(1-p2)
    where
        p1 = singleChance (a,b) p
        p2 = singleChance (c,d) p

singleChance :: (Integer, Integer) -> Integer -> Double
singleChance (from, to) p = (fromIntegral $ (to`div`p) - ((from-1)`div`p)) / (fromIntegral $ to - from + 1)

import Control.Monad;

main = do
    (n:p:[]) <- getLine >>= return.(map (fromIntegral.read)).words
    list <- replicateM n (getLine >>= return.(\[a,b]->(a,b)).(map (fromIntegral.read)).words)
    putStrLn $ show $ solve list p

solve x p = sum $ map (\a -> (pairChance a p)*2000) (adj x)
    where adj x = (last x, head x):(zip x (tail x))

pairChance ((a,b), (c,d)) p = 1-(1-p1)*(1-p2)
    where
        p1 = singleChance (a,b) p
        p2 = singleChance (c,d) p

singleChance (from, to) p = (fromIntegral $ (to`div`p) - ((from-1)`div`p)) / (fromIntegral $ to - from + 1)

read' :: String -> (Int, Int)
read' str = let [u, v] = map read (words str) in (u, v)
cyclic :: [a] -> [a]
cyclic (x:xs) = xs ++ [x]

prob :: Int -> (Int, Int) -> Double
prob p (x, y) = fromIntegral r / fromIntegral d
    where d = y - x + 1
          r = y `div` p - x `div` p + fromEnum (x `mod` p == 0)

solve :: [(Int, Int)] -> Double
solve ((_, p):xs) = 2000 * sum (zipWith union ps (cyclic ps))
    where ps = map (prob p) xs
          union x y = x + y - x * y

main :: IO()
main = putStrLn . show . solve . map read' . lines =<< getContents

read' :: String -> (Int, Int)
read' str = let [u, v] = map read (words str) in (u, v)
solve :: [(Int, Int)] -> Double
solve ((_, p):xs) = 2000 * sum (zipWith (\x y -> x + y - x * y) ps $ pps ++ [pp])
    where ps@(pp:pps) = map prob xs
          prob (x, y) = fromIntegral (y `div` p - x `div` p + fromEnum (x `mod` p == 0)) / fromIntegral (y - x + 1)
main = putStrLn . show . solve . map read' . lines =<< getContents

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  [n, p] <- fmap (map read . words) getLine
  inp <- forM [1..n] $ \_ -> do
         [l, r] <- fmap (map read . words) getLine
         return (l, r)
  print $ solve p inp

solve :: Int -> [(Int, Int)] -> Double
solve p inp = sum leftInts + sum rightInts + exp (head inp) (last inp)
    where
      leftInts = zipWith exp inp (tail inp)
      rightInts =  zipWith exp (last inp:inp) (inp)
      exp (l1, r1) (l1', r1') = numer*1000/fromIntegral (len1*len2)
          where
            numer :: Double
            numer = fromIntegral (num1*len2 + num2*len1 - num1*num2)
            len1 = r1 - l1 + 1
            len2 = r1' - l1' + 1
            num1 = (r1 `div` p) - (l1-1)`div`p
            num2 = (r1' `div` p) - (l1'-1)`div`p

inp1 = [(1,2), (420, 421), (420420, 420421)]
inp2 :: [(Int, Int)]
inp2 = [(1,4), (2,3), (11,14)]

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  [n, p] <- fmap (map read . words) getLine
  inp <- forM [1..n] $ \_ -> do
         [l, r] <- fmap (map read . words) getLine
         return (l, r)
  print $ solve p inp

solve :: Int -> [(Int, Int)] -> Double
solve p inp = sum ints + exp (head inp) (last inp)
    where
      ints = zipWith exp inp (tail inp)
      exp (l1, r1) (l1', r1') = numer*2000/fromIntegral (len1*len2)
          where
            numer :: Double
            numer = fromIntegral (num1*len2 + num2*len1 - num1*num2)
            len1 = r1 - l1 + 1
            len2 = r1' - l1' + 1
            num1 = (r1 `div` p) - (l1-1)`div`p
            num2 = (r1' `div` p) - (l1'-1)`div`p

inp1 = [(1,2), (420, 421), (420420, 420421)]
inp2 :: [(Int, Int)]
inp2 = [(1,4), (2,3), (11,14)]

read' :: String -> (Int, Int)
read' str = let [u, v] = map read (words str) in (u, v)
cyclic :: [a] -> [a]
cyclic (x:xs) = xs ++ [x]
divisible :: Integral a => a -> a -> Bool
divisible x p = mod x p == 0

prob :: Int -> (Int, Int) -> Double
prob p (x, y) = fromIntegral pos / fromIntegral (diff + 1)
    where diff = y - x
          pos = fromEnum (divisible x p || divisible y p) + div diff p

solve :: [(Int, Int)] -> Double
solve ((_, p):xs) = 2000 * sum (zipWith union ps (cyclic ps))
    where ps = map (prob p) xs
          union x y = x + y - x * y

main :: IO()
main = putStrLn . show . solve . map read' . lines =<< getContents


In the school computer room there are n servers which are responsible for processing several computing tasks. You know the number of scheduled tasks for each server: there are mi tasks assigned to the i-th server.In order to balance the load for each server, you want to reassign some tasks to make the difference between the most loaded server and the least loaded server as small as possible. In other words you want to minimize expression ma - mb, where a is the most loaded server and b is the least loaded one.In one second you can reassign a single task. Thus in one second you can choose any pair of servers and move a single task from one server to another.Write a program to find the minimum number of seconds needed to balance the load of servers.

The first line contains positive number n (1 ≤ n ≤ 105) — the number of the servers.  The second line contains the sequence of non-negative integers m1, m2, ..., mn (0 ≤ mi ≤ 2·104), where mi is the number of tasks assigned to the i-th server.

Print the minimum number of seconds required to balance the load.

NoteIn the first example two seconds are needed. In each second, a single task from server #2 should be moved to server #1. After two seconds there should be 3 tasks on server #1 and 4 tasks on server #2.In the second example the load is already balanced.A possible sequence of task movements for the third example is:  move a task from server #4 to server #1 (the sequence m becomes: 2 2 3 3 5);  then move task from server #5 to server #1 (the sequence m becomes: 3 2 3 3 4);  then move task from server #5 to server #2 (the sequence m becomes: 3 3 3 3 3). The above sequence is one of several possible ways to balance the load of servers in three seconds.

import Data.List (sort)

main = do
  [n] <- (map read . words) `fmap` getLine
  ms <- (sort . map read . words) `fmap` getLine

  let
    s = sum ms
    b = s `div` n
    k = s `mod` n
    as = replicate (n - k) b ++ replicate k (b + 1)

    ss = sum . map abs $ zipWith (-) ms as

  print $ ss `div` 2

import Data.Ord
--import Control.Lens.At
--import Control.Lens.Operators
import Control.Applicative ((<$>))
import Test.QuickCheck
import Data.List

solve :: Int -> [Int] -> Int
solve n m =
  max smaller_iters bigger_iters
  where
    base = (sum m) `div` n
    smaller = filter (\x -> x < base) m
    bigger = filter (\x -> x > base+1) m
    smaller_iters = sum $ map (base -) $ smaller
    bigger_iters = sum $ map (\x -> x - (base+1)) $ bigger

{-
bruteForce :: [Int] -> Int -> Int
bruteForce x n
  | maxVal - minVal > 1 = bruteForce x' (n+1)
  | otherwise = n
  where
    (maxVal, maxIdx) = maximumBy (comparing fst) $ zip x [0..]
    (minVal, minIdx) = minimumBy (comparing fst) $ zip x [0..]
    x' = x & ix maxIdx .~ (maxVal - 1) & ix minIdx .~ (minVal + 1)

runChecks :: IO ()
runChecks =
  let
    genVec = sized $ \n -> listOf1 $ choose (0, n)
    prop_num_iter x = solve (length x) x == bruteForce x 0
  in quickCheck $ forAll genVec prop_num_iter
-}

main :: IO ()
main = do
  n <- read <$> getLine
  m <- map read . words <$> getLine
  putStrLn $ show $ solve n m

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

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST
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                 as IM
import qualified Data.IntSet                 as IS
import           Data.List
import qualified Data.Map                    as M
import           Data.Ord
import qualified Data.Set                    as S
import           Data.STRef
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Data.Word
import           Debug.Trace

main :: IO ()
main = do
    n <- readLn :: IO Int
    xs <- U.unfoldrN n (B.readInt.B.dropWhile isSpace) <$> B.getContents
    print $ solve n $ U.map fromIntegral xs

solve :: Int -> U.Vector Int64 -> Int64
solve n xs = div (U.sum (U.map (abs.subtract q) ys) + U.sum (U.map (abs.subtract(q+1)) zs)) 2
  where
    s = U.sum xs
    (q, r) = divMod s (fromIntegral n)
    (ys, zs) = U.splitAt (n-fromIntegral r) $ radixSort32 xs

radixSort32 :: U.Vector Int64 -> U.Vector Int64
radixSort32 v = foldl' step v [0, 16]
  where
    mask k x = fromIntegral $ unsafeShiftR x k .&. 0xffff
    step v k = U.create $ do
        pref <- U.unsafeThaw
            . U.prescanl' (+) 0
            . U.unsafeAccumulate (+) (U.replicate 0x10000 0)
            $ U.map ((,1) . mask k) v
        res <- UM.unsafeNew $ U.length v
        U.forM_ v $ \x -> do
            let !masked = mask k x
            i <- UM.unsafeRead pref masked
            UM.unsafeWrite pref masked $ i + 1
            UM.unsafeWrite res i x
        return res

import Data.List

read_int :: String -> Int
read_int = read

solve :: [Int] -> Int
solve xs =
  let n = length xs
      s = sum xs
      q = s `quot` n
      r = s `mod` n
      (y,z) = (splitAt (n-r)) . sort $ xs
  in  ((sum . (map (\x -> abs $ x-q)) $ y) + (sum . (map (\x -> abs $ x-q-1)) $ z)) `quot` 2

main = interact $ show. solve . (map read_int) . words . (!! 1) . lines

import Control.Applicative

solve :: Int -> [Int] -> Int
solve n m =
  sum $ map (base -) $ smaller
  where
    base = (sum m) `div` n
    smaller = filter (\x -> x < base) m

main :: IO ()
main = do
  n <- read <$> getLine
  m <- map read . words <$> getLine
  putStrLn $ show $ solve n m

import Data.List

read_int :: String -> Int
read_int = read

solve :: [Int] -> Int
solve xs =
  let n = length xs
      s = sum xs
      q = s `quot` n
      r = s `mod` n
      (y,z) = (splitAt r) . sort $ xs
  in  if r == 0 then sum . (map (\x -> abs $ x-q)) $ xs
      else ((sum . (map (\x -> abs $ x-q)) $ y) + (sum . (map (\x -> abs $ x-q-1)) $ z))`quot` 2

main = interact $ show. solve . (map read_int) . words . (!! 1) . lines

import Data.List

read_int :: String -> Int
read_int = read

solve :: [Int] -> Int
solve xs =
  let n = length xs
      s = sum xs
      q = s `quot` n
      r = s `mod` n
      sxs = sort xs
      (y,z) = splitAt r sxs
  in  if r == 0 then (sum . (map (\x -> abs $ x-q)) $ sxs) `quot` 2
      else ((sum . (map (\x -> abs $ x-q)) $ y) + (sum . (map (\x -> abs $ x-q-1)) $ z)) `quot` 2

main = interact $ show. solve . (map read_int) . words . (!! 1) . lines

import Data.List

read_int :: String -> Int
read_int = read

solve :: [Int] -> Int
solve xs =
  let n = length xs
      s = sum xs
      q = s `quot` n
      r = s `mod` n
      (y,z) = (splitAt r) . sort $ xs
  in  if r == 0 then (sum . (map (\x -> abs $ x-q)) $ xs) `quot` 2
      else ((sum . (map (\x -> abs $ x-q)) $ y) + (sum . (map (\x -> abs $ x-q-1)) $ z)) `quot` 2

main = interact $ show. solve . (map read_int) . words . (!! 1) . lines

import Data.List

read_int :: String -> Int
read_int = read

solve :: [Int] -> Int
solve xs =
  let n = length xs
      s = sum xs
      q = s `quot` n
      r = s `mod` n
      (y,z) = (splitAt r) . sort $ xs
  in  ((sum . (map (\x -> abs $ x-q)) $ y) + (sum . (map (\x -> abs $ x-q-1)) $ z))`quot` 2

main = interact $ show. solve . (map read_int) . words . (!! 1) . lines


Vasya likes taking part in Codeforces contests. When a round is over, Vasya follows all submissions in the system testing tab.There are $$$n$$$ solutions, the $$$i$$$-th of them should be tested on $$$a_i$$$ tests, testing one solution on one test takes $$$1$$$ second. The solutions are judged in the order from $$$1$$$ to $$$n$$$. There are $$$k$$$ testing processes which test solutions simultaneously. Each of them can test at most one solution at a time.At any time moment $$$t$$$ when some testing process is not judging any solution, it takes the first solution from the queue and tests it on each test in increasing order of the test ids. Let this solution have id $$$i$$$, then it is being tested on the first test from time moment $$$t$$$ till time moment $$$t + 1$$$, then on the second test till time moment $$$t + 2$$$ and so on. This solution is fully tested at time moment $$$t + a_i$$$, and after that the testing process immediately starts testing another solution.Consider some time moment, let there be exactly $$$m$$$ fully tested solutions by this moment. There is a caption "System testing: $$$d$$$%" on the page with solutions, where $$$d$$$ is calculated as$$$$$$d = round\left(100\cdot\frac{m}{n}\right),$$$$$$where $$$round(x) = \lfloor{x + 0.5}\rfloor$$$ is a function which maps every real to the nearest integer.Vasya calls a submission interesting if there is a time moment (possibly, non-integer) when the solution is being tested on some test $$$q$$$, and the caption says "System testing: $$$q$$$%". Find the number of interesting solutions.Please note that in case when multiple processes attempt to take the first submission from the queue at the same moment (for instance, at the initial moment), the order they take the solutions does not matter.

The first line contains two positive integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 1000$$$, $$$1 \le k \le 100$$$) standing for the number of submissions and the number of testing processes respectively. The second line contains $$$n$$$ positive integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 150$$$), where $$$a_i$$$ is equal to the number of tests the $$$i$$$-th submission is to be run on.

Output the only integer — the number of interesting submissions.

NoteConsider the first example. At time moment $$$0$$$ both solutions start testing. At time moment $$$49$$$ the first solution is fully tested, so at time moment $$$49.5$$$ the second solution is being tested on the test $$$50$$$, and the caption says "System testing: $$$50$$$%" (because there is one fully tested solution out of two). So, the second solution is interesting.Consider the second example. At time moment $$$0$$$ the first and the second solutions start testing. At time moment $$$32$$$ the first solution is fully tested, the third solution starts testing, the caption says "System testing: $$$25$$$%". At time moment $$$32 + 24.5 = 56.5$$$ the third solutions is being tested on test $$$25$$$, the caption is still the same, thus this solution is interesting. After that the third solution is fully tested at time moment $$$32 + 33 = 65$$$, the fourth solution is fully tested at time moment $$$65 + 1 = 66$$$. The captions becomes "System testing: $$$75$$$%", and at time moment $$$74.5$$$ the second solution is being tested on test $$$75$$$. So, this solution is also interesting. Overall, there are two interesting solutions.

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

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

main :: IO ()
main = do
  [n,k] <- map readInt . words <$> getLine
  as <- A.listArray (0,n-1) .
    unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
  print $ queue n (min k n) as

queue :: Int -> Int -> UArray Int Int -> Int
queue !n !k tests = runST $ do
  nextSub <- newSTRef (k::Int)
  proc_testMax <- A.newListArray (0,k-1) $ take k $ A.elems tests
                 :: ST s (STUArray s Int Int)
  proc_testCnt <- newSTUA (0,k-1::Int) (1::Int)
  isInteresting <- newSTUA (0,k-1::Int) False
  done <- newSTRef (0::Int)
  interesting <- newSTRef (0::Int)
  fix $ \cont -> do
    percentage <- (`div` shiftL n 1) . (+n) . (200*) <$> readSTRef done
    continues <- foldM
      (\ !lives procid -> do
          cnt <- A.readArray proc_testCnt procid
          tmax <- A.readArray proc_testMax procid
          when (cnt == percentage) $ A.writeArray isInteresting procid True
          (!nextCnt,!nextMax) <-
            if | cnt < tmax -> return (cnt+1,tmax)
               | tmax < 0 -> return (-1,-1)
               | otherwise -> do
                   modifySTRef' done (+1)
                   interest <- A.readArray isInteresting procid
                   when interest $ modifySTRef' interesting (+1)
                   !ns <- readSTRef nextSub
                   A.writeArray isInteresting procid False
                   if ns >= n then return (-1,-1) else do
                     writeSTRef nextSub $! ns+1
                     return (1,tests A.! ns)
          A.writeArray proc_testCnt procid nextCnt
          A.writeArray proc_testMax procid nextMax
          return $! tmax > 0 || lives)
      False [0..k-1]
    when continues $ cont
  readSTRef interesting

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

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

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