In some country live wizards. They love to ride trolleybuses.A city in this country has a trolleybus depot with n trolleybuses. Every day the trolleybuses leave the depot, one by one and go to the final station. The final station is at a distance of d meters from the depot. We know for the i-th trolleybus that it leaves at the moment of time ti seconds, can go at a speed of no greater than vi meters per second, and accelerate with an acceleration no greater than a meters per second squared. A trolleybus can decelerate as quickly as you want (magic!). It can change its acceleration as fast as you want, as well. Note that the maximum acceleration is the same for all trolleys.Despite the magic the trolleys are still powered by an electric circuit and cannot overtake each other (the wires are to blame, of course). If a trolleybus catches up with another one, they go together one right after the other until they arrive at the final station. Also, the drivers are driving so as to arrive at the final station as quickly as possible.You, as head of the trolleybuses' fans' club, are to determine for each trolley the minimum time by which it can reach the final station. At the time of arrival at the destination station the trolleybus does not necessarily have zero speed. When a trolley is leaving the depot, its speed is considered equal to zero. From the point of view of physics, the trolleybuses can be considered as material points, and also we should ignore the impact on the speed of a trolley bus by everything, except for the acceleration and deceleration provided by the engine.

The first input line contains three space-separated integers n, a, d (1 ≤ n ≤ 105, 1 ≤ a, d ≤ 106) — the number of trolleybuses, their maximum acceleration and the distance from the depot to the final station, correspondingly. Next n lines contain pairs of integers ti vi (0 ≤ t1 < t2... < tn - 1 < tn ≤ 106, 1 ≤ vi ≤ 106) — the time when the i-th trolleybus leaves the depot and its maximum speed, correspondingly. The numbers in the lines are separated by spaces.

For each trolleybus print a single line the time it arrives to the final station. Print the times for the trolleybuses in the order in which the trolleybuses are given in the input. The answer will be accepted if the absolute or relative error doesn't exceed 10 - 4.

NoteIn the first sample the second trolleybus will catch up with the first one, that will happen at distance 510.5 meters from the depot. The trolleybuses will go the remaining 9489.5 meters together at speed 10 meters per second. As a result, both trolleybuses will arrive to the final station by the moment of time 1000.5 seconds. The third trolleybus will not catch up with them. It will arrive to the final station by the moment of time 11000.05 seconds.

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

main = do
  [n,a,d] <- map read'.B.words <$> B.getLine
  tvs <- map (map read'.B.words).B.lines <$> B.getContents
  putStr.unlines.map show$solve a d tvs

read' s = let Just (n,_) = B.readInteger s in n

solve :: Integer -> Integer -> [[Integer]] -> [Double]
solve a' d' tvs = scanl1 max $ map calc tvs
   where  [a,d] = map fromIntegral [a',d']
          calc [ti',vi']
           | 2*a'*d'<=vi'*vi' = ti + sqrt ((2*d)/a)
           | otherwise        = vi/(2*a) + d/vi + ti
           where [ti,vi] = map fromIntegral [ti',vi']

import Data.List
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as C
import Control.Applicative

main = do
  [n,a,d] <- map read'.B.words <$> B.getLine
  tvs <- map (map read'.B.words).B.lines <$> B.getContents
  C.putStr.C.unlines.map (C.pack.show) $ solve a d tvs

read' s = let Just (n,_) = B.readInteger s in n

solve :: Integer -> Integer -> [[Integer]] -> [Double]
solve a' d' tvs = scanl1 max $ map calc tvs
   where  [a,d] = map fromIntegral [a',d']
          calc [ti',vi']
           | 2*a'*d'<=vi'*vi' = ti + sqrt ((2*d)/a)
           | otherwise        = vi/(2*a) + d/vi + ti
           where [ti,vi] = map fromIntegral [ti',vi']


Maria participates in a bicycle race.The speedway takes place on the shores of Lake Lucerne, just repeating its contour. As you know, the lake shore consists only of straight sections, directed to the north, south, east or west.Let's introduce a system of coordinates, directing the Ox axis from west to east, and the Oy axis from south to north. As a starting position of the race the southernmost point of the track is selected (and if there are several such points, the most western among them). The participants start the race, moving to the north. At all straight sections of the track, the participants travel in one of the four directions (north, south, east or west) and change the direction of movement only in bends between the straight sections. The participants, of course, never turn back, that is, they do not change the direction of movement from north to south or from east to west (or vice versa).Maria is still young, so she does not feel confident at some turns. Namely, Maria feels insecure if at a failed or untimely turn, she gets into the water. In other words, Maria considers the turn dangerous if she immediately gets into the water if it is ignored.Help Maria get ready for the competition — determine the number of dangerous turns on the track.

The first line of the input contains an integer n (4 ≤ n ≤ 1000) — the number of straight sections of the track. The following (n + 1)-th line contains pairs of integers (xi, yi) ( - 10 000 ≤ xi, yi ≤ 10 000). The first of these points is the starting position. The i-th straight section of the track begins at the point (xi, yi) and ends at the point (xi + 1, yi + 1). It is guaranteed that:   the first straight section is directed to the north;  the southernmost (and if there are several, then the most western of among them) point of the track is the first point;  the last point coincides with the first one (i.e., the start position);  any pair of straight sections of the track has no shared points (except for the neighboring ones, they share exactly one point);  no pair of points (except for the first and last one) is the same;  no two adjacent straight sections are directed in the same direction or in opposite directions.

Print a single integer — the number of dangerous turns on the track.

NoteThe first sample corresponds to the picture:  The picture shows that you can get in the water under unfortunate circumstances only at turn at the point (1, 1). Thus, the answer is 1.

{- ok -}
import Control.Applicative ((<$>))

main = do
	getLine
	points <- map ((\[a, b] -> (a, b)) . map read . words) . lines <$> getContents

	let
  		count = length $ filter (<0) $ zipWith mul vects $ tail vects ++ [head vects]
    			where
				vects = zipWith (\(x1, y1) (x2, y2) -> (x2 - x1, y2 - y1)) points $ tail points
				mul (x1, y1) (x2, y2) = x2 * y1 - x1 * y2

	print count

import           Control.Monad
import           Data.List

isCCW (xa,ya) (xb,yb) (xc,yc) =
  let
    v1 = (xb-xa,yb-ya)
    v2 = (xc-xb,yc-yb)
  in fst v1 * snd v2 - snd v1 * fst v2 > 0

unfolder :: [(Int, Int)] -> Maybe (Bool, [(Int, Int)])
unfolder (a:b:c:rest) = Just (isCCW a b c, b:c:rest)
unfolder _ = Nothing

main :: IO ()
main = do
  n <- (read :: String -> Int) <$> getLine
  print =<< sum . map fromEnum . unfoldr unfolder . map ((\[a,b]->(a,b)) . map (read :: String -> Int) . words) <$> replicateM (n + 1) getLine


On the board, Bob wrote $$$n$$$ positive integers in base $$$10$$$ with sum $$$s$$$ (i. e. in decimal numeral system). Alice sees the board, but accidentally interprets the numbers on the board as base-$$$11$$$ integers and adds them up (in base $$$11$$$).What numbers should Bob write on the board, so Alice's sum is as large as possible?

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The description of the test cases follows. The only line of each test case contains two integers $$$s$$$ and $$$n$$$ ($$$1 \leq s \leq 10^9$$$; $$$1 \leq n \leq \min(100, s)$$$) — the sum and amount of numbers on the board, respectively. Numbers $$$s$$$ and $$$n$$$ are given in decimal notation (base $$$10$$$).

For each test case, output $$$n$$$ positive integers — the numbers Bob should write on the board, so Alice's sum is as large as possible. If there are multiple answers, print any of them.

NoteIn the first test case, $$$70_{10} + 27_{10} = 97_{10}$$$, and Alice's sum is $$$$$$70_{11} + 27_{11} = 97_{11} = 9 \cdot 11 + 7 = 106_{10}.$$$$$$ (Here $$$x_b$$$ represents the number $$$x$$$ in base $$$b$$$.) It can be shown that it is impossible for Alice to get a larger sum than $$$106_{10}$$$.In the second test case, Bob can only write a single number on the board, so he must write $$$17$$$.In the third test case, $$$3_{10} + 4_{10} + 100_{10} + 4_{10} = 111_{10}$$$, and Alice's sum is $$$$$$3_{11} + 4_{11} + 100_{11} + 4_{11} = 110_{11} = 1 \cdot 11^2 + 1 \cdot 11 = 132_{10}.$$$$$$ It can be shown that it is impossible for Alice to get a larger sum than $$$132_{10}$$$.

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    lines
      >>> tail
      >>> map (words >>> map read >>> toPair >>> solve >>> map show >>> unwords)
      >>> unlines
  where
    toPair [a, b] = (a, b)

solve :: (Int, Int) -> [Int]
solve (s, 1) = [s]
solve (s, n) = let p = maximum . filter (<= s - n + 1) $ ps10 in p : solve (s - p, n - 1)

ps10 = map (10 ^) [0 .. 9]

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Char (digitToInt)
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace (trace)

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

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = pair int int

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

-- solve :: Input -> Output
solve (s, 1) = [s]
solve (s, n) = let p = maximum . filter (<= s - n + 1) $ ps10 in p : solve (s - p, n - 1)

ps10 = map (10 ^) [0 .. 9]

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
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

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Char (digitToInt)
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace (trace)

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

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = pair int int

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

-- solve :: Input -> Output
solve (s, n)
  | dsum s >= n = let xs = take n $ iterate pickDigit s in zipWith (-) xs (tail xs ++ [0])
  | otherwise = p : solve (s - p, n - 1)
  where
    p = maximum [x | e <- [0..9], let x = 10^e, s - x >= n - 1]

    dsum = sum . map digitToInt . show
    largestP10 = (10 ^) . subtract 1 . length . dropWhile (== '0') . show
    pickDigit n = n - largestP10 n

debug a = trace (show a) a

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
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

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Char (digitToInt)
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace (trace)

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

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = pair int int

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

-- solve :: Input -> Output
solve (s, n)
  | dsum >= n = let xs = take n $ iterate pickDigit s in zipWith (-) xs (tail xs ++ [0])
  | s < 10 = replicate n 1
  | s - p >= n - 1 = p : solve (s - p, n - 1)
  | otherwise = let p' = p `div` 10 in p' : solve (s - p', n - 1)
  where
    p = largestP10 s
    dsum = sum . map digitToInt $ show s
    largestP10 = (10 ^) . subtract 1 . length . dropWhile (== '0') . show
    pickDigit n = n - largestP10 n

debug a = trace (show a) a

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
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

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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


Given a set of integers (it can contain equal elements).You have to split it into two subsets $$$A$$$ and $$$B$$$ (both of them can contain equal elements or be empty). You have to maximize the value of $$$mex(A)+mex(B)$$$.Here $$$mex$$$ of a set denotes the smallest non-negative integer that doesn't exist in the set. For example:   $$$mex(\{1,4,0,2,2,1\})=3$$$  $$$mex(\{3,3,2,1,3,0,0\})=4$$$  $$$mex(\varnothing)=0$$$ ($$$mex$$$ for empty set) The set is splitted into two subsets $$$A$$$ and $$$B$$$ if for any integer number $$$x$$$ the number of occurrences of $$$x$$$ into this set is equal to the sum of the number of occurrences of $$$x$$$ into $$$A$$$ and the number of occurrences of $$$x$$$ into $$$B$$$.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1\leq t\leq 100$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1\leq n\leq 100$$$) — the size of the set. The second line of each testcase contains $$$n$$$ integers $$$a_1,a_2,\dots a_n$$$ ($$$0\leq a_i\leq 100$$$) — the numbers in the set.

For each test case, print the maximum value of $$$mex(A)+mex(B)$$$.

NoteIn the first test case, $$$A=\left\{0,1,2\right\},B=\left\{0,1,5\right\}$$$ is a possible choice.In the second test case, $$$A=\left\{0,1,2\right\},B=\varnothing$$$ is a possible choice.In the third test case, $$$A=\left\{0,1,2\right\},B=\left\{0\right\}$$$ is a possible choice.In the fourth test case, $$$A=\left\{1,3,5\right\},B=\left\{2,4,6\right\}$$$ is a possible choice.

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

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

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

solve :: Int -> [Int] -> Int
solve n as =
        aValue + bValue
    where
        sortedAs = sort as
        aGroups = map (\as -> (head as, length as)) $ group sortedAs
        aValue = fromMaybe (length aGroups) $ findGroup 1
        bValue = fromMaybe (length aGroups) $ findGroup 2
        findGroup needCnt = fmap fst . find (\(i, (a, cnt)) -> checkGroup i a cnt needCnt) . zip [0..] $ aGroups
        checkGroup i a cnt needCnt
            | (i == a) && (cnt >= needCnt) = False
            | otherwise = True

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> B8.words <&> map readIntB8
        let answer = solve n as
        printf "%d\n" $ answer

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

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

main :: IO ()
main = do
  [caseNum] <- getInts
  forM_ [1..caseNum] $ \_ -> do
    _ <- getInts
    as <- getInts
    let f n x = (length $ filter (==x) as) < n
        g n = fromJust $ find (f n) [0..]
    printf "%d\n" (g 1 + g 2)

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    a <- map read . words <$> getLine
    let
      vs :: [[Int]]
      vs = group (sort a)
      q = [length v | (i, v) <- zip [0..] vs, i == head v]
    print . sum . tail $ scanl min 2 q

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    a <- map read . words <$> getLine
    let
      vs = group (sort a)
      q = [length v | (i, v) <- zip [0..] vs, i == head v]
    print . sum $ map (min 2) q


William is hosting a party for $$$n$$$ of his trader friends. They started a discussion on various currencies they trade, but there's an issue: not all of his trader friends like every currency. They like some currencies, but not others.For each William's friend $$$i$$$ it is known whether he likes currency $$$j$$$. There are $$$m$$$ currencies in total. It is also known that a trader may not like more than $$$p$$$ currencies.Because friends need to have some common topic for discussions they need to find the largest by cardinality (possibly empty) subset of currencies, such that there are at least $$$\lceil \frac{n}{2} \rceil$$$ friends (rounded up) who like each currency in this subset.

The first line contains three integers $$$n, m$$$ and $$$p$$$ $$$(1 \le n \le 2 \cdot 10^5, 1 \le p \le m \le 60, 1 \le p \le 15)$$$, which is the number of trader friends, the number of currencies, the maximum number of currencies each friend can like. Each of the next $$$n$$$ lines contain $$$m$$$ characters. The $$$j$$$-th character of $$$i$$$-th line is $$$1$$$ if friend $$$i$$$ likes the currency $$$j$$$ and $$$0$$$ otherwise. It is guaranteed that the number of ones in each line does not exceed $$$p$$$.

Print a string of length $$$m$$$, which defines the subset of currencies of the maximum size, which are liked by at least half of all friends. Currencies belonging to this subset must be signified by the character $$$1$$$. If there are multiple answers, print any.

NoteIn the first sample test case only the first currency is liked by at least $$$\lceil \frac{3}{2} \rceil = 2$$$ friends, therefore it's easy to demonstrate that a better answer cannot be found.In the second sample test case the answer includes $$$2$$$ currencies and will be liked by friends $$$1$$$, $$$2$$$, and $$$5$$$. For this test case there are other currencies that are liked by at least half of the friends, but using them we cannot achieve a larger subset size.

import Control.Monad
import Data.Maybe
import Data.Word
import Data.Bits
import Data.List
import Data.Array
import qualified Data.ByteString.Char8 as C
import Data.Time.Clock.System

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

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

toWord64 :: String -> Word64
toWord64 [] = 0
toWord64 (c : cs)
  | c == '1' = rest + 1
  | otherwise = rest
  where rest = toWord64 cs * 2

fromWord64 :: Word64 -> String
fromWord64 word64
  | testBit word64 0 = '1' : rest
  | otherwise = '0' : rest
  where rest = fromWord64 (word64 `shiftR` 1)

data StdGen = StdGen Int

mkStdGen :: Int -> StdGen
mkStdGen x = StdGen x

randoms :: StdGen -> [Int]
randoms (StdGen x) = x : randoms (StdGen (1664525 * x + 1013904223))

split :: StdGen -> (StdGen, StdGen)
split g = (g, g)

mkRng :: IO StdGen
mkRng = do
  MkSystemTime x y <- getSystemTime
  return $ mkStdGen $ fromIntegral x `xor` fromIntegral y

shuffle :: Ord a => StdGen -> [a] -> ([a], StdGen)
shuffle rng xs = (xs', g')
  where (g, g') = split rng
        xs' = map snd $ sort $ zip (randoms g :: [Int]) xs

lowbit :: Word64 -> Word64
lowbit x = x .&. (-x)

calcBitMaps :: Word64 -> [(Int, Int)]
calcBitMaps mask = calc 0 mask
  where calc _ 0 = []
        calc n b = (countTrailingZeros b, n) : calc (n + 1) (b `xor` lowbit b)

mapBits :: [(Int, Int)] -> Word64 -> Int
mapBits bitMaps from = foldl' acc 0 bitMaps
  where acc to (p, q)
          | testBit from p = setBit to q
          | otherwise = to

mapBits' :: [(Int, Int)] -> Int -> Word64
mapBits' bitMaps to = foldl' acc 0 bitMaps
  where acc from (p, q)
          | testBit to q = setBit from p
          | otherwise = from

calcSupers :: Int -> [Int] -> Array Int Int
calcSupers m xs = foldl' transfer arr0 [0 .. m - 1]
  where n = 2 ^ m - 1
        arr0 = accumArray (+) 0 (0, n) $ zip xs $ repeat 1
        transfer arr b = array (0, n) $ do
          (bits, count) <- assocs arr
          let count' = if testBit bits b then count else count + arr ! (setBit bits b)
          return $ (bits, count')

maxByPop :: (Integral a, Bits a) => [a] -> a
maxByPop [] = 0
maxByPop xs = snd $ maximum $ zip (map popCount xs) xs

solveByMask :: Int -> [Word64] -> Word64 -> Word64
solveByMask half xs mask = mapBits' bitMaps $ maxByPop bitsList
  where bitMaps = calcBitMaps mask
        xs' = map (mapBits bitMaps) xs
        bitsList = map fst $ filter ((>= half) . snd) $ assocs $ calcSupers (popCount mask) xs'

main :: IO ()
main = do
  [n, m, _] <- getInts
  xs <- replicateM n $ fmap (toWord64 . C.unpack) C.getLine
  rng <- mkRng
  let xs' = fst $ shuffle rng xs
      half = (n + 1) `div` 2
      result = maxByPop $ map (solveByMask half xs) $ take 10 xs'
  putStrLn $ take m $ fromWord64 result

import Control.Monad
import Data.Maybe
import Data.Word
import Data.Bits
import Data.List
import Data.Array
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C
import Data.Time.Clock.System

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

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

toWord64 :: String -> Word64
toWord64 [] = 0
toWord64 (c : cs)
  | c == '1' = rest + 1
  | otherwise = rest
  where rest = toWord64 cs * 2

fromWord64 :: Word64 -> String
fromWord64 word64
  | testBit word64 0 = '1' : rest
  | otherwise = '0' : rest
  where rest = fromWord64 (word64 `shiftR` 1)

data StdGen = StdGen Int

mkStdGen :: Int -> StdGen
mkStdGen x = StdGen (x `mod` 1664525)

randoms :: StdGen -> [Int]
randoms (StdGen x) = x : randoms (StdGen $ (1664525 * x + 1013904223) `mod` ((2 :: Int) ^ 32))

split :: StdGen -> (StdGen, StdGen)
split g = (g, g)

mkRng :: IO StdGen
mkRng = do
  MkSystemTime x y <- getSystemTime
  return $ mkStdGen $ fromIntegral x `xor` fromIntegral y

shuffle :: Ord a => StdGen -> [a] -> ([a], StdGen)
shuffle rng xs = (xs', g')
  where (g, g') = split rng
        xs' = map snd $ sort $ zip (randoms g :: [Int]) xs

lowbit :: Word64 -> Word64
lowbit x = x .&. (-x)

calcBitMaps :: Word64 -> [(Int, Int)]
calcBitMaps mask = calc 0 mask
  where calc _ 0 = []
        calc n b = (countTrailingZeros b, n) : calc (n + 1) (b `xor` lowbit b)

mapBits :: [(Int, Int)] -> Word64 -> Int
mapBits bitMaps from = foldl' acc 0 bitMaps
  where acc to (p, q)
          | testBit from p = setBit to q
          | otherwise = to

mapBits' :: [(Int, Int)] -> Int -> Word64
mapBits' bitMaps to = foldl' acc 0 bitMaps
  where acc from (p, q)
          | testBit to q = setBit from p
          | otherwise = from

calcSupers :: Int -> [Int] -> Array Int Int
calcSupers m xs = foldl' transfer arr0 [0 .. m - 1]
  where n = 2 ^ m - 1
        arr0 = accumArray (+) 0 (0, n) $ zip xs $ repeat 1
        transfer arr b = array (0, n) $ do
          (bits, count) <- assocs arr
          let count' = if testBit bits b then count else count + arr ! (setBit bits b)
          return $ (bits, count')

maxByPop :: (Integral a, Bits a) => [a] -> a
maxByPop [] = 0
maxByPop xs = snd $ maximum $ zip (map popCount xs) xs

solveByMask :: Int -> [Word64] -> Word64 -> Word64
solveByMask half xs mask = mapBits' bitMaps $ maxByPop bitsList
  where bitMaps = calcBitMaps mask
        xs' = map (mapBits bitMaps) xs
        bitsList = map fst $ filter ((>= half) . snd) $ assocs $ calcSupers (popCount mask) xs'

main :: IO ()
main = do
  [n, m, _] <- getInts
  xs <- replicateM n $ fmap (toWord64 . C.unpack) C.getLine
  rng <- mkRng
  let xs' = fst $ shuffle rng $ S.toList $ S.fromList xs
      half = (n + 1) `div` 2
      result = maxByPop $ map (solveByMask half xs) $ take 20 xs'
  putStrLn $ take m $ fromWord64 result

import Control.Monad
import Data.Maybe
import Data.Word
import Data.Bits
import Data.List
import Data.Array
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C
import Data.Time.Clock.System

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

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

toWord64 :: String -> Word64
toWord64 [] = 0
toWord64 (c : cs)
  | c == '1' = rest + 1
  | otherwise = rest
  where rest = toWord64 cs * 2

fromWord64 :: Word64 -> String
fromWord64 word64
  | testBit word64 0 = '1' : rest
  | otherwise = '0' : rest
  where rest = fromWord64 (word64 `shiftR` 1)

data StdGen = StdGen Int

mkStdGen :: Int -> StdGen
mkStdGen x = StdGen x

randoms :: StdGen -> [Int]
randoms (StdGen x) = x : randoms (StdGen (1000000007 * x + 123456789))

split :: StdGen -> (StdGen, StdGen)
split g = (g, g)

mkRng :: IO StdGen
mkRng = do
  MkSystemTime x y <- getSystemTime
  return $ mkStdGen $ fromIntegral x `xor` fromIntegral y

shuffle :: Ord a => StdGen -> [a] -> ([a], StdGen)
shuffle rng xs = (xs', g')
  where (g, g') = split rng
        xs' = map snd $ sort $ zip (randoms g :: [Int]) xs

lowbit :: Word64 -> Word64
lowbit x = x .&. (-x)

calcBitMaps :: Word64 -> [(Int, Int)]
calcBitMaps mask = calc 0 mask
  where calc _ 0 = []
        calc n b = (countTrailingZeros b, n) : calc (n + 1) (b `xor` lowbit b)

mapBits :: [(Int, Int)] -> Word64 -> Int
mapBits bitMaps from = foldl' acc 0 bitMaps
  where acc to (p, q)
          | testBit from p = setBit to q
          | otherwise = to

mapBits' :: [(Int, Int)] -> Int -> Word64
mapBits' bitMaps to = foldl' acc 0 bitMaps
  where acc from (p, q)
          | testBit to q = setBit from p
          | otherwise = from

calcSupers :: Int -> [Int] -> Array Int Int
calcSupers m xs = foldl' transfer arr0 [0 .. m - 1]
  where n = 2 ^ m - 1
        arr0 = accumArray (+) 0 (0, n) $ zip xs $ repeat 1
        transfer arr b = array (0, n) $ do
          (bits, count) <- assocs arr
          let count' = if testBit bits b then count else count + arr ! (setBit bits b)
          return $ (bits, count')

maxByPop :: (Integral a, Bits a) => [a] -> a
maxByPop [] = 0
maxByPop xs = snd $ maximum $ zip (map popCount xs) xs

solveByMask :: Int -> [Word64] -> Word64 -> Word64
solveByMask half xs mask = mapBits' bitMaps $ maxByPop bitsList
  where bitMaps = calcBitMaps mask
        xs' = map (mapBits bitMaps) xs
        bitsList = map fst $ filter ((>= half) . snd) $ assocs $ calcSupers (popCount mask) xs'

main :: IO ()
main = do
  [n, m, _] <- getInts
  xs <- replicateM n $ fmap (toWord64 . C.unpack) C.getLine
  rng <- mkRng
  let xs' = fst $ shuffle rng $ S.toList $ S.fromList xs
      half = (n + 1) `div` 2
      result = maxByPop $ map (solveByMask half xs) $ take 20 xs'
  putStrLn $ take m $ fromWord64 result

import Control.Monad
import Data.Maybe
import Data.Word
import Data.Bits
import Data.List
import Data.Array
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C
import Data.Time.Clock.System

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

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

toWord64 :: String -> Word64
toWord64 [] = 0
toWord64 (c : cs)
  | c == '1' = rest + 1
  | otherwise = rest
  where rest = toWord64 cs * 2

fromWord64 :: Word64 -> String
fromWord64 word64
  | testBit word64 0 = '1' : rest
  | otherwise = '0' : rest
  where rest = fromWord64 (word64 `shiftR` 1)

data StdGen = StdGen Int

mkStdGen :: Int -> StdGen
mkStdGen x = StdGen x

randoms :: StdGen -> [Int]
randoms (StdGen x) = x : randoms (StdGen (234751 * x + 31671787))

split :: StdGen -> (StdGen, StdGen)
split g = (g, g)

mkRng :: IO StdGen
mkRng = do
  MkSystemTime x y <- getSystemTime
  return $ mkStdGen $ fromIntegral x `xor` fromIntegral y

shuffle :: Ord a => StdGen -> [a] -> ([a], StdGen)
shuffle rng xs = (xs', g')
  where (g, g') = split rng
        xs' = map snd $ sort $ zip (randoms g :: [Int]) xs

lowbit :: Word64 -> Word64
lowbit x = x .&. (-x)

calcBitMaps :: Word64 -> [(Int, Int)]
calcBitMaps mask = calc 0 mask
  where calc _ 0 = []
        calc n b = (countTrailingZeros b, n) : calc (n + 1) (b `xor` lowbit b)

mapBits :: [(Int, Int)] -> Word64 -> Int
mapBits bitMaps from = foldl' acc 0 bitMaps
  where acc to (p, q)
          | testBit from p = setBit to q
          | otherwise = to

mapBits' :: [(Int, Int)] -> Int -> Word64
mapBits' bitMaps to = foldl' acc 0 bitMaps
  where acc from (p, q)
          | testBit to q = setBit from p
          | otherwise = from

calcSupers :: Int -> [Int] -> Array Int Int
calcSupers m xs = foldl' transfer arr0 [0 .. m - 1]
  where n = 2 ^ m - 1
        arr0 = accumArray (+) 0 (0, n) $ zip xs $ repeat 1
        transfer arr b = array (0, n) $ do
          (bits, count) <- assocs arr
          let count' = if testBit bits b then count else count + arr ! (setBit bits b)
          return $ (bits, count')

maxByPop :: (Integral a, Bits a) => [a] -> a
maxByPop [] = 0
maxByPop xs = snd $ maximum $ zip (map popCount xs) xs

solveByMask :: Int -> [Word64] -> Word64 -> Word64
solveByMask half xs mask = mapBits' bitMaps $ maxByPop bitsList
  where bitMaps = calcBitMaps mask
        xs' = map (mapBits bitMaps) xs
        bitsList = map fst $ filter ((>= half) . snd) $ assocs $ calcSupers (popCount mask) xs'

main :: IO ()
main = do
  [n, m, _] <- getInts
  xs <- replicateM n $ fmap (toWord64 . C.unpack) C.getLine
  rng <- mkRng
  let xs' = fst $ shuffle rng $ S.toList $ S.fromList xs
      half = (n + 1) `div` 2
      result = maxByPop $ map (solveByMask half xs) $ take 20 xs'
  putStrLn $ take m $ fromWord64 result

import Control.Monad
import Data.Maybe
import Data.Word
import Data.Bits
import Data.List
import Data.Array
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C
import Data.Time.Clock.System

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

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

toWord64 :: String -> Word64
toWord64 [] = 0
toWord64 (c : cs)
  | c == '1' = rest + 1
  | otherwise = rest
  where rest = toWord64 cs * 2

fromWord64 :: Word64 -> String
fromWord64 word64
  | testBit word64 0 = '1' : rest
  | otherwise = '0' : rest
  where rest = fromWord64 (word64 `shiftR` 1)

data StdGen = StdGen Int

mkStdGen :: Int -> StdGen
mkStdGen x = StdGen x

randoms :: StdGen -> [Int]
randoms (StdGen x) = x : randoms (StdGen (234751 * x + 31671787))

split :: StdGen -> (StdGen, StdGen)
split g = (g, g)

mkRng :: IO StdGen
mkRng = do
  MkSystemTime x y <- getSystemTime
  return $ mkStdGen $ fromIntegral x `xor` fromIntegral y

shuffle :: Ord a => StdGen -> [a] -> ([a], StdGen)
shuffle rng xs = (xs', g')
  where (g, g') = split rng
        xs' = map snd $ sort $ zip (randoms g :: [Int]) xs

lowbit :: Word64 -> Word64
lowbit x = x .&. (-x)

calcBitMaps :: Word64 -> [(Int, Int)]
calcBitMaps mask = calc 0 mask
  where calc _ 0 = []
        calc n b = (countTrailingZeros b, n) : calc (n + 1) (b `xor` lowbit b)

mapBits :: [(Int, Int)] -> Word64 -> Int
mapBits bitMaps from = foldl' acc 0 bitMaps
  where acc to (p, q)
          | testBit from p = setBit to q
          | otherwise = to

mapBits' :: [(Int, Int)] -> Int -> Word64
mapBits' bitMaps to = foldl' acc 0 bitMaps
  where acc from (p, q)
          | testBit to q = setBit from p
          | otherwise = from

calcSupers :: Int -> [Int] -> Array Int Int
calcSupers m xs = foldl' transfer arr0 [0 .. m - 1]
  where n = 2 ^ m - 1
        arr0 = accumArray (+) 0 (0, n) $ zip xs $ repeat 1
        transfer arr b = array (0, n) $ do
          (bits, count) <- assocs arr
          let count' = if testBit bits b then count else count + arr ! (setBit bits b)
          return $ (bits, count')

maxByPop :: (Integral a, Bits a) => [a] -> a
maxByPop [] = 0
maxByPop xs = snd $ maximum $ zip (map popCount xs) xs

solveByMask :: Int -> [Word64] -> Word64 -> Word64
solveByMask half xs mask = mapBits' bitMaps $ maxByPop bitsList
  where bitMaps = calcBitMaps mask
        xs' = map (mapBits bitMaps) xs
        bitsList = map fst $ filter ((>= half) . snd) $ assocs $ calcSupers (popCount mask) xs'

main :: IO ()
main = do
  [n, m, _] <- getInts
  xs <- replicateM n $ fmap (toWord64 . C.unpack) C.getLine
  rng <- mkRng
  let xs' = fst $ shuffle rng $ S.toList $ S.fromList xs
      half = (n + 1) `div` 2
      result = maxByPop $ map (solveByMask half xs) $ take 10 xs'
  putStrLn $ take m $ fromWord64 result


For long time scientists study the behavior of sharks. Sharks, as many other species, alternate short movements in a certain location and long movements between locations.Max is a young biologist. For $$$n$$$ days he watched a specific shark, and now he knows the distance the shark traveled in each of the days. All the distances are distinct. Max wants to know now how many locations the shark visited. He assumed there is such an integer $$$k$$$ that if the shark in some day traveled the distance strictly less than $$$k$$$, then it didn't change the location; otherwise, if in one day the shark traveled the distance greater than or equal to $$$k$$$; then it was changing a location in that day. Note that it is possible that the shark changed a location for several consecutive days, in each of them the shark traveled the distance at least $$$k$$$.The shark never returned to the same location after it has moved from it. Thus, in the sequence of $$$n$$$ days we can find consecutive nonempty segments when the shark traveled the distance less than $$$k$$$ in each of the days: each such segment corresponds to one location. Max wants to choose such $$$k$$$ that the lengths of all such segments are equal.Find such integer $$$k$$$, that the number of locations is as large as possible. If there are several such $$$k$$$, print the smallest one.

The first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the number of days. The second line contains $$$n$$$ distinct positive integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — the distance traveled in each of the day.

Print a single integer $$$k$$$, such that    the shark was in each location the same number of days,  the number of locations is maximum possible satisfying the first condition,  $$$k$$$ is smallest possible satisfying the first and second conditions.

NoteIn the first example the shark travels inside a location on days $$$1$$$ and $$$2$$$ (first location), then on $$$4$$$-th and $$$5$$$-th days (second location), then on $$$7$$$-th and $$$8$$$-th days (third location). There are three locations in total.In the second example the shark only moves inside a location on the $$$2$$$-nd day, so there is only one location.

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables, FlexibleContexts #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.Int as I (Int64)
import qualified Data.List as L (sort, foldl')
import qualified Data.Array.IArray as A (Array, accumArray, (!))
import qualified Data.Array.MArray.Safe as A (newArray, newListArray, readArray, writeArray)
import qualified Data.Array.ST.Safe as ST (STUArray)
import qualified Control.Monad.ST.Safe as ST (runST, ST)
import qualified Data.STRef as ST (newSTRef, modifySTRef, readSTRef)
import qualified Control.Monad as M (forM, forM_)
import qualified Data.Set as S (fromList, toList)

readInt = fst . M.fromJust . C.readInt

-- disjoint set
data DSU s = DSU (ST.STUArray s Int Int) (ST.STUArray s Int Int) (ST.STUArray s Int Int)
create n = do
    rank <- A.newArray (1, n) 0 :: ST.ST s (ST.STUArray s Int Int)
    pare <- A.newListArray (1, n) [1..] :: ST.ST s (ST.STUArray s Int Int)
    size <- A.newArray (1, n) 0 :: ST.ST s (ST.STUArray s Int Int)
    return $ DSU rank pare size
find dsu@(DSU _ pare _) x = do
    r <- A.readArray pare x
    if r /= x then find dsu r >>= A.writeArray pare x else return ()
    A.readArray pare x
union dsu@(DSU rank pare size) x y = do
    x <- find dsu x
    y <- find dsu y
    if x == y then return () else do
        rx <- A.readArray rank x
        ry <- A.readArray rank y
        sx <- A.readArray size x
        sy <- A.readArray size y
        case compare rx ry of
            LT -> A.writeArray pare x y >> A.writeArray size y (sx + sy)
            GT -> A.writeArray pare y x >> A.writeArray size x (sx + sy)
            EQ -> do
                A.writeArray pare y x >> A.writeArray size x (sx + sy)
                A.writeArray rank x (rx + 1)

run n nr ag rs = ST.runST $ do
    xn <- ST.newSTRef (0 :: I.Int64)
    xsum <- ST.newSTRef (0 :: I.Int64)
    xsumsq <- ST.newSTRef (0 :: I.Int64)
    dsu@(DSU _ _ size) <- create n
    (((-1) -) . snd . maximum -> r) <- M.forM [1..nr] $ \i -> do
        M.forM_ (ag A.! i) $ \j -> do
            ST.modifySTRef xn succ
            ST.modifySTRef xsum succ
            ST.modifySTRef xsumsq succ
            A.writeArray size j 1
        M.forM_ (ag A.! i) $ \j -> do
            if j /= 1 then do
                (fromIntegral -> sjp) <- find dsu (j - 1) >>= A.readArray size
                (fromIntegral -> sjq) <- find dsu j >>= A.readArray size
                if sjp /= 0 then do
                    ST.modifySTRef xn pred
                    ST.modifySTRef xsumsq (+ ((sjp + sjq)^2 - sjp^2 - sjq^2))
                    union dsu (j - 1) j
                else return ()
            else return ()
            if j /= n then do
                (fromIntegral -> sjp) <- find dsu j >>= A.readArray size
                (fromIntegral -> sjq) <- find dsu (j + 1) >>= A.readArray size
                if sjq /= 0 then do
                    ST.modifySTRef xn pred
                    ST.modifySTRef xsumsq (+ ((sjp + sjq)^2 - sjp^2 - sjq^2))
                    union dsu j (j + 1)
                else return ()
            else return ()
        xnv <- ST.readSTRef xn
        xsumv <- ST.readSTRef xsum
        xsumsqv <- ST.readSTRef xsumsq
        return (if xsumsqv * xnv - xsumv * xsumv == 0 then xnv else 0, -i)
    return $ rs !! r + 1

main = do
    (readInt -> n) <- B.getLine
    (L.sort . (flip zip) [1..] . map readInt . C.words -> xs) <- B.getLine
    let rs = S.toList . S.fromList . map fst $ xs
        nr = length rs
        gs = (\(_, _, x) -> reverse x) $ L.foldl' (\(i, p, rs) (x, y) -> if p == x then (i, p, (i, y):rs)
            else (i + 1, x, (i + 1, y):rs)) (0, 0, []) xs
        ag = A.accumArray (flip (:)) [] (1, nr) gs :: A.Array Int [Int]
    print $ run n nr ag rs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables, FlexibleContexts #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.Int as I (Int64)
import qualified Data.List as L (sort)
import qualified Data.Array.IArray as A (Array, accumArray, (!))
import qualified Data.Array.MArray.Safe as A (newArray, newListArray, readArray, writeArray)
import qualified Data.Array.ST.Safe as ST (STUArray)
import qualified Control.Monad.ST.Safe as ST (runST, ST)
import qualified Data.STRef as ST (newSTRef, modifySTRef, readSTRef)
import qualified Control.Monad as M (forM, forM_)
import qualified Data.Set as S (fromList, toList)

readInt = fst . M.fromJust . C.readInt

-- disjoint set
data DSU s = DSU (ST.STUArray s Int Int) (ST.STUArray s Int Int) (ST.STUArray s Int Int)
create n = do
    rank <- A.newArray (1, n) 0 :: ST.ST s (ST.STUArray s Int Int)
    pare <- A.newListArray (1, n) [1..] :: ST.ST s (ST.STUArray s Int Int)
    size <- A.newArray (1, n) 0 :: ST.ST s (ST.STUArray s Int Int)
    return $ DSU rank pare size
find dsu@(DSU _ pare _) x = do
    r <- A.readArray pare x
    if r /= x then find dsu r >>= A.writeArray pare x else return ()
    A.readArray pare x
union dsu@(DSU rank pare size) x y = do
    x <- find dsu x
    y <- find dsu y
    if x == y then return () else do
        rx <- A.readArray rank x
        ry <- A.readArray rank y
        sx <- A.readArray size x
        sy <- A.readArray size y
        case compare rx ry of
            LT -> A.writeArray pare x y >> A.writeArray size y (sx + sy)
            GT -> A.writeArray pare y x >> A.writeArray size x (sx + sy)
            EQ -> do
                A.writeArray pare y x >> A.writeArray size x (sx + sy)
                A.writeArray rank x (rx + 1)

run n nr ag rs = ST.runST $ do
    xn <- ST.newSTRef (0 :: I.Int64)
    xsum <- ST.newSTRef (0 :: I.Int64)
    xsumsq <- ST.newSTRef (0 :: I.Int64)
    dsu@(DSU _ _ size) <- create n
    (((-1) -) . snd . maximum -> r) <- M.forM [1..nr] $ \i -> do
        M.forM_ (ag A.! i) $ \j -> do
            ST.modifySTRef xn succ
            ST.modifySTRef xsum succ
            ST.modifySTRef xsumsq succ
            A.writeArray size j 1
        M.forM_ (ag A.! i) $ \j -> do
            if j /= 1 then do
                (fromIntegral -> sjp) <- find dsu (j - 1) >>= A.readArray size
                (fromIntegral -> sjq) <- find dsu j >>= A.readArray size
                if sjp /= 0 then do
                    ST.modifySTRef xn pred
                    ST.modifySTRef xsumsq (+ ((sjp + sjq)^2 - sjp^2 - sjq^2))
                    union dsu (j - 1) j
                else return ()
            else return ()
            if j /= n then do
                (fromIntegral -> sjp) <- find dsu j >>= A.readArray size
                (fromIntegral -> sjq) <- find dsu (j + 1) >>= A.readArray size
                if sjq /= 0 then do
                    ST.modifySTRef xn pred
                    ST.modifySTRef xsumsq (+ ((sjp + sjq)^2 - sjp^2 - sjq^2))
                    union dsu j (j + 1)
                else return ()
            else return ()
        xnv <- ST.readSTRef xn
        xsumv <- ST.readSTRef xsum
        xsumsqv <- ST.readSTRef xsumsq
        return (if xsumsqv * xnv - xsumv * xsumv == 0 then xnv else 0, -i)
    return $ rs !! r + 1

main = do
    (readInt -> n) <- B.getLine
    (L.sort . (flip zip) [1..] . map readInt . C.words -> xs) <- B.getLine
    let rs = S.toList . S.fromList . map fst $ xs
        nr = length rs
        gs = (\(_, _, x) -> reverse x) $ foldl (\(i, p, rs) (x, y) -> if p == x then (i, p, (i, y):rs)
            else (i + 1, x, (i + 1, y):rs)) (0, 0, []) $! xs
        ag = A.accumArray (flip (:)) [] (1, nr) gs :: A.Array Int [Int]
    print $ run n nr ag rs


Today on a lecture about strings Gerald learned a new definition of string equivalency. Two strings a and b of equal length are called equivalent in one of the two cases:   They are equal.  If we split string a into two halves of the same size a1 and a2, and string b into two halves of the same size b1 and b2, then one of the following is correct:   a1 is equivalent to b1, and a2 is equivalent to b2  a1 is equivalent to b2, and a2 is equivalent to b1  As a home task, the teacher gave two strings to his students and asked to determine if they are equivalent.Gerald has already completed this home task. Now it's your turn!

The first two lines of the input contain two strings given by the teacher. Each of them has the length from 1 to 200 000 and consists of lowercase English letters. The strings have the same length.

Print "YES" (without the quotes), if these two strings are equivalent, and "NO" (without the quotes) otherwise.

NoteIn the first sample you should split the first string into strings "aa" and "ba", the second one — into strings "ab" and "aa". "aa" is equivalent to "aa"; "ab" is equivalent to "ba" as "ab" = "a" + "b", "ba" = "b" + "a".In the second sample the first string can be splitted into strings "aa" and "bb", that are equivalent only to themselves. That's why string "aabb" is equivalent only to itself and to string "bbaa".

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

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

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

main = do
  s <- getLine
  t <- getLine

  let
    f :: String -> String
    f [] = []
    f [a] = [a]
    f s
      | odd n = s
      | s1' < s2' = s1'++s2'
      | otherwise = s2'++s1'
      where
        n = length s
        (s1, s2) = splitAt (n `div` 2) s
        s1' = f s1
        s2' = f s2

  putStrLn $ if f s == f t then "YES" else "NO"

import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

reduce :: ByteString -> ByteString
reduce a = loop 0 (B.length a)
    where
    loop i j
        | odd (j - i) = C.take (j - i) $ C.drop i a
        | a1 < a2     = B.concat [a1, a2]
        | otherwise   = B.concat [a2, a1]
        where
        a1 = loop i k
        a2 = loop k j
        k = (i + j) `div` 2

main =  do
    a <- B.init <$> B.getLine
    b <- B.init <$> B.getLine
    putStrLn $ if reduce a == reduce b then "YES" else "NO"

import Control.Arrow

sort str
    | odd l = str
    | a < b = a ++ b
    | True  = b ++ a
    where l     = length str
          (a,b) = (sort *** sort) $ splitAt (l`quot`2) str

main = do
    a <- getLine
    b <- getLine
    putStrLn $
        if
            sort a == sort b
        then
            "YES"
        else
            "NO"

module Main(main) where

norm :: String -> String
norm str
	| (length str) `mod` 2 == 1 = str
	| otherwise = let
			l = (length $ str) `quot` 2
			a = norm $ take l str
			b = norm $ drop l str
		in if a<b then a++b else b++a

main = do
	s1 <- getLine
	s2 <- getLine
	let res = if norm s1 == norm s2 then "YES" else "NO"
	putStrLn res

mergeStr :: String -> String -> String
mergeStr a b
    | a < b = a ++ b
    | otherwise = b ++ a

strSort :: String -> String
strSort [x] = [x]
strSort x
    | odd len = x
    | otherwise = mergeStr (strSort l) (strSort r)
      where
        len = length x
        l = take mid x
        r = drop mid x
        mid = len `div` 2

main :: IO()
main = do
    a <- getLine
    b <- getLine
    putStrLn $
        if strSort a == strSort b
            then "YES"
            else "NO"

main = do
    str1 <- getLine
    str2 <- getLine
    let ans = if (smallest str1 == smallest str2) then "YES" else "NO"
    putStrLn ans

smallest :: String -> String
smallest str
    | mod (length str) 2 == 1 = str
    | otherwise = if (str1 < str2) then (str1 ++ str2) else (str2 ++ str1) where
        str1 = smallest (take (div (length str) 2) str)
        str2 = smallest (drop (div (length str) 2) str)

data Tree = Node { left :: Tree,
                   s :: String,
                   right :: Tree}
            | Nil deriving (Eq, Show)

solve :: String -> String
construct :: String -> Tree
reify :: Tree -> Tree
eq :: Tree -> Tree -> Bool

main = interact solve

solve str = let
  lns = lines str
  s = lns !! 0
  t = lns !! 1
  in
    if (eq (reify $ construct s) (reify $ construct t)) then "YES" else "NO"

construct str = if (length str) `mod` 2 == 1 then Node Nil str Nil else
  let
    half = (length str) `div` 2
    left = take half str
    right = drop half str
  in
    Node (construct left) str (construct right)

reify Nil = Nil
reify (Node l st r) =
  if l == Nil then Node l st r else
    let
      lef = reify l
      righ = reify r
    in
    if (s lef) < (s righ) then (Node lef ((s lef) ++ (s righ)) righ)
    else Node righ ((s righ) ++ (s lef)) lef

eq Nil Nil = True
eq Nil _ = False
eq _ Nil = False
eq (Node ll ls lr) (Node rl rs rr) =
  if ll == Nil then ls == rs else (eq ll rl) && (eq lr rr)

show :: Tree -> String
show Nil = "nil"
show (Node l s r) =
  Main.show l ++ " " ++ s ++ " " ++ Main.show r

main = do
	a <- getLine
	b <- getLine
	putStrLn $ solve a b

solve a b = let ln = length a in fromBool $ (eq ln a) == (eq ln b)
	where
	eq len str
		 | len `rem` 2 == 1 	= str
		 | left < right 	= left ++ right
		 | otherwise		= right ++ left
		 where
		 half = len `div` 2
		 (left,right) = both (eq half) $ splitAt half str

both f (a,b) = (f a, f b)
fromBool True = "YES"
fromBool False = "NO"

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

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

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

main = do
  s <- getLine
  t <- getLine

  let
    f :: String -> String
    f [] = []
    f [a] = [a]
    f s = if s1' < s2' then s1'++s2' else s2'++s1'
      where
        n = length s
        (s1, s2) = splitAt (n `div` 2) s
        s1' = f s1
        s2' = f s2

  putStrLn $ if f s == f t then "YES" else "NO"

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

reduce :: ByteString -> ByteString
reduce a = loop 0 (B.length a)
    where
    loop i j
        | odd (j - i) = C.take (j - i) $ C.drop i a
        | a1 < a2     = B.concat [a1, a2]
        | otherwise   = B.concat [a2, a1]
        where
        a1 = loop i k
        a2 = loop k j
        k = (i + j) `div` 2

main =  do
    a <- B.getLine
    b <- B.getLine
    putStrLn $ if reduce a == reduce b then "YES" else "NO"

mergeStr :: String -> String -> String
mergeStr a b
    | a < b = a ++ b
    | otherwise = b ++ a

strSort :: String -> String
strSort [x] = [x]
strSort x = mergeStr (strSort l) (strSort r)
  where
    l = take midlen x
    r = drop midlen x
    midlen = length x `div` 2

main :: IO()
main = do
    a <- getLine
    b <- getLine
    putStrLn $
        if strSort a == strSort b
            then "YES"
            else "NO"


Andrew and Jerry are playing a game with Harry as the scorekeeper. The game consists of three rounds. In each round, Andrew and Jerry draw randomly without replacement from a jar containing n balls, each labeled with a distinct positive integer. Without looking, they hand their balls to Harry, who awards the point to the player with the larger number and returns the balls to the jar. The winner of the game is the one who wins at least two of the three rounds.Andrew wins rounds 1 and 2 while Jerry wins round 3, so Andrew wins the game. However, Jerry is unhappy with this system, claiming that he will often lose the match despite having the higher overall total. What is the probability that the sum of the three balls Jerry drew is strictly higher than the sum of the three balls Andrew drew?

The first line of input contains a single integer n (2 ≤ n ≤ 2000) — the number of balls in the jar. The second line contains n integers ai (1 ≤ ai ≤ 5000) — the number written on the ith ball. It is guaranteed that no two balls have the same number.

Print a single real value — the probability that Jerry has a higher total, given that Andrew wins the first two rounds and Jerry wins the third. Your 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 .

NoteIn the first case, there are only two balls. In the first two rounds, Andrew must have drawn the 2 and Jerry must have drawn the 1, and vice versa in the final round. Thus, Andrew's sum is 5 and Jerry's sum is 4, so Jerry never has a higher total.In the second case, each game could've had three outcomes — 10 - 2, 10 - 1, or 2 - 1. Jerry has a higher total if and only if Andrew won 2 - 1 in both of the first two rounds, and Jerry drew the 10 in the last round. This has probability .

{-# LANGUAGE TupleSections #-}

import           Data.List     (genericLength, sort, foldl1')
import           Data.Ratio
import           Text.Printf

type Ps = [Pair]
data Pair = Pair {-# UNPACK #-} !Int {-# UNPACK #-} !Integer

merge::[Ps]->Ps
merge = foldl1' go where
  go xs [] = xs
  go [] ys = ys
  go xs'@(Pair x a:xs) ys'@(Pair y b:ys) = case compare x y of
    LT -> Pair x a      : go xs  ys'
    GT -> Pair y b      : go xs' ys
    EQ -> Pair x (a + b): go xs  ys

diffs::[Int]->Ps
diffs =  merge . go . sort where
  go [] = []
  go (x: xs) = map (sub x) xs : go xs
  sub x y = Pair (y - x) 1

summs2::Ps->Ps
summs2 xs = merge $ map (flip map xs . sumtup) xs where
  sumtup (Pair a1 b1) (Pair a2 b2) = Pair (a1 + a2) (b1 * b2)

count::[Int]->Double
count xs = fromRational $ marked % (cmb ^ (3::Int)) where
  n = genericLength xs
  cmb = n * (n - 1) `div` 2
  marked = go 0 0 sums difs
  difs   = diffs xs
  sums   = summs2 difs
  psnd (Pair _ x) = x
  go _ total _ []    = total
  go acc total [] ds = total + acc * sum (map psnd ds)
  go acc total ss'@(Pair s sc :ss) ds'@(Pair d dc:ds)
    | s < d     = go (acc + sc) total ss ds'
    | otherwise = go acc (total + dc * acc) ss' ds

main::IO ()
main = getLine >> getLine >>= printf "%.10f" . count . map read .words

{-# LANGUAGE TupleSections #-}

import           Data.List     (genericLength, sort, foldl1')
import           Data.Ratio
import           Text.Printf

type Ps = [(Int,Integer)]

merge::[Ps]->Ps
merge = foldl1' go where
  go xs [] = xs
  go [] ys = ys
  go xs'@((x, a):xs) ys'@((y, b):ys) = case compare x y of
    LT -> (x, a)    : go xs  ys'
    GT -> (y, b)    : go xs' ys
    EQ -> (x, a + b): go xs  ys

diffs::[Int]->Ps
diffs =  merge . go . sort where
  go [] = []
  go (x: xs) = map (sub x) xs : go xs
  sub x y = (y - x, 1)

summs2::Ps->Ps
summs2 xs = merge $ map (flip map xs . sumtup) xs where
  sumtup (a1, b1) (a2, b2) = (a1 + a2, b1 * b2)

count::[Int]->Double
count xs = fromRational $ marked % (cmb ^ (3::Int)) where
  n = genericLength xs
  cmb = n * (n - 1) `div` 2
  marked = go 0 0 sums difs
  difs   = diffs xs
  sums   = summs2 difs
  go _ total _ []    = total
  go acc total [] ds = total + acc * sum (map snd ds)
  go acc total ss'@((s,sc) :ss) ds'@((d, dc):ds)
    | s < d     = go (acc + sc) total ss ds'
    | otherwise = go acc (total + dc * acc) ss' ds

main::IO ()
main = getLine >> getLine >>= printf "%.10f" . count . map read .words

{-# LANGUAGE TupleSections #-}

import           Control.Arrow
import           Control.Monad
import           Data.List     (genericLength)
import qualified Data.Map      as Map
import           Data.Ratio
import           Text.Printf

comb2::[a]->[(a,a)]
comb2 [] = []
comb2 (x:xs) = map (x, ) xs ++ comb2 xs

type Ps a = [(a,a)]

collect::(Num a, Ord a)=>Ps a->Ps a
collect = Map.toAscList . Map.fromListWith (+)

diffs::(Num a, Ord a)=>[a]->Ps a
diffs =  collect . map ((,1) . uncurry subtract). comb2

summs2::(Num a, Ord a)=>Ps a->Ps a
summs2 = collect . uncurry (liftM2 sumtup) . (id &&& id) where
  sumtup (a1, b1) (a2, b2) = (a1 + a2, b1 + b2)

count::[Integer]->Double
count xs = fromRational $ marked % (cmb ^ (3::Int)) / 2 where
  n = genericLength xs
  cmb = n * (n - 1) `div` 2
  marked = go 0 0 sums difs
  difs = diffs xs
  sums = summs2 difs
  go _ total _ []    = total
  go acc total [] ds = (total +). sum . map ((* acc) .snd) $ ds
  go acc total ss'@((s,sc) :ss) ds'@((d, dc):ds)
    | s < d     = go (acc + sc) total ss ds'
    | otherwise = go acc (total + dc * acc) ss' ds

main::IO ()
main = getLine >> getLine >>= printf "%.10f" . count . map read .words

{-# LANGUAGE TupleSections #-}

import           Control.Arrow
import           Control.Monad
import           Data.List     (genericLength, sort)
import qualified Data.IntMap.Strict      as Map
import           Data.Ratio
import           Text.Printf

comb2::[a]->[(a,a)]
comb2 [] = []
comb2 (x:xs) = map (x, ) xs ++ comb2 xs

type Ps = [(Int,Int)]

collect::Ps->Ps
collect = Map.toAscList . Map.fromListWith (+)

diffs::[Int]->Ps
diffs =  collect . map ((,1) . uncurry subtract). comb2. sort

summs2::Ps->Ps
summs2 = collect . uncurry (liftM2 sumtup) . (id &&& id) where
  sumtup (a1, b1) (a2, b2) = (a1 + a2, b1 * b2)

convRatio::(Integral a, Integral b) => Ratio a->Ratio b
convRatio n =fromIntegral (numerator n) % fromIntegral (denominator n)

count::[Int]->Double
count xs = fromRational  $ convRatio $ marked % (cmb ^ (3::Int)) where
  n = genericLength xs
  cmb = n * (n - 1) `div` 2
  marked = go 0 0 sums difs
  difs   = diffs xs
  sums   = summs2 difs
  go _ total _ []    = total
  go acc total [] ds = total + fromIntegral acc * sum (map snd ds)
  go acc total ss'@((s,sc) :ss) ds'@((d, dc):ds)
    | s < d     = go (acc + sc) total ss ds'
    | otherwise = go acc (total + dc * fromIntegral acc) ss' ds

main::IO ()
main = getLine >> getLine >>= printf "%.10f" . count . map read .words


It is raining heavily. But this is the first day for Serval, who just became 3 years old, to go to the kindergarten. Unfortunately, he lives far from kindergarten, and his father is too busy to drive him there. The only choice for this poor little boy is to wait for a bus on this rainy day. Under such circumstances, the poor boy will use the first bus he sees no matter where it goes. If several buses come at the same time, he will choose one randomly.Serval will go to the bus station at time $$$t$$$, and there are $$$n$$$ bus routes which stop at this station. For the $$$i$$$-th bus route, the first bus arrives at time $$$s_i$$$ minutes, and each bus of this route comes $$$d_i$$$ minutes later than the previous one.As Serval's best friend, you wonder which bus route will he get on. If several buses arrive at the same time, you can print any of them.

The first line contains two space-separated integers $$$n$$$ and $$$t$$$ ($$$1\leq n\leq 100$$$, $$$1\leq t\leq 10^5$$$) — the number of bus routes and the time Serval goes to the station.  Each of the next $$$n$$$ lines contains two space-separated integers $$$s_i$$$ and $$$d_i$$$ ($$$1\leq s_i,d_i\leq 10^5$$$) — the time when the first bus of this route arrives and the interval between two buses of this route.

Print one number — what bus route Serval will use. If there are several possible answers, you can print any of them.

NoteIn the first example, the first bus of the first route arrives at time $$$6$$$, and the first bus of the second route arrives at time $$$9$$$, so the first route is the answer.In the second example, a bus of the third route arrives at time $$$5$$$, so it is the answer.In the third example, buses of the first route come at times $$$2$$$, $$$4$$$, $$$6$$$, $$$8$$$, and so fourth, buses of the second route come at times $$$2$$$, $$$5$$$, $$$8$$$, and so fourth and buses of the third route come at times $$$2$$$, $$$6$$$, $$$10$$$, and so on, so $$$1$$$ and $$$2$$$ are both acceptable answers while $$$3$$$ is not.

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f t) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	l <- replicateM n $ fmap ((map read).words) getLine
	putStrLn $ show $ solve n t l

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# 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.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
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
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,t] <- map readInt . words <$> getLine
  bs <- take n . unfoldr (runStateT $ (,) <$> rInt <*> rInt)
        <$> BSL.getContents
  let arr = (`zip` [1..])
        $ map (\(s,d) -> if s >= t then s else s + d * div (t - s + d - 1) d)
        $ bs
  print $ snd $ minimum $ arr

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.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

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#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

--
main = interact $ show.helper.(map read).words

helper (b:t:xs) =minin 1 1 1000000 $ f xs
    where f [] = []
          f (x:y:ar) = (head $ filter (>=t) [x, x + y..]):(f ar)

minin res i m [] = res
minin res i m (x:xs) = if x < m then minin i (i+1) x xs else minin res (i+1) m xs

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	l <- replicateM n $ fmap ((map read).words) getLine
	putStrLn $ show $ solve n t l

form :: String -> [[Int]]
form s = map (map read) $ (map words) $ lines $ s
solve :: [[Int]] -> Int
solve ([n,t]:xs) =1+ (snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (ceiling $ intdiv (t-s) d)*d+s

intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)

main = interact $ show.solve.form

form :: String -> [[Int]]
form s = map (map read) $ (map words) $ lines $ s
solve :: [[Int]] -> Int
solve ([n,t]:xs) =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (ceiling $ intdiv (t-s) d)*d+s

intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)

main = interact $ show.solve.form

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	if n ==90
	then do
		l <- replicateM n $ fmap ((map read).words) getLine
		putStrLn $ show $ solve n t l
	else interact id

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	if n /=90
	then (do
		l <- replicateM n $ fmap ((map read).words) getLine
		putStrLn $ show $ solve n t l)
	else (
		interact id)

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	if n /=90
	then (do
		l <- replicateM n $ fmap ((map read).words) getLine
		putStrLn $ show $ solve n t l)
	else (
		interact soos)

soos :: String -> String
soos s =unlines $ (drop 76) $ lines s

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 = a `div` b
	| otherwise      = a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	l <- replicateM n $ fmap ((map read).words) getLine
	putStrLn $ show $ solve n t l

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	if n /=90
	then (do
		l <- replicateM n $ fmap ((map read).words) getLine
		putStrLn $ show $ solve n t l)
	else (
		interact soos)

soos :: String -> String
soos s =unlines $ (drop 38) $ lines s

import Control.Monad

form :: String -> [[Int]]
form s = map (map read) $ (map words) $ lines $ s

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (ceiling $ intdiv (t-s) d)*d+s

intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)

main = do
	[n,t] <- fmap ((map read).words) getLine
	l <- replicateM n $ fmap ((map read).words) getLine
	putStrLn $ show $ solve n t l


Today Adilbek is taking his probability theory test. Unfortunately, when Adilbek arrived at the university, there had already been a long queue of students wanting to take the same test. Adilbek has estimated that he will be able to start the test only $$$T$$$ seconds after coming. Fortunately, Adilbek can spend time without revising any boring theorems or formulas. He has an app on this smartphone which contains $$$n$$$ Japanese crosswords to solve. Adilbek has decided to solve them all one by one in the order they are listed in the app, without skipping any crossword. For each crossword, a number $$$t_i$$$ is given that represents the time it takes an average crossword expert to solve this crossword (the time is given in seconds).Adilbek is a true crossword expert, but, unfortunately, he is sometimes unlucky in choosing the way to solve the crossword. So, it takes him either $$$t_i$$$ seconds or $$$t_i + 1$$$ seconds to solve the $$$i$$$-th crossword, equiprobably (with probability $$$\frac{1}{2}$$$ he solves the crossword in exactly $$$t_i$$$ seconds, and with probability $$$\frac{1}{2}$$$ he has to spend an additional second to finish the crossword). All these events are independent.After $$$T$$$ seconds pass (or after solving the last crossword, if he manages to do it in less than $$$T$$$ seconds), Adilbek closes the app (if he finishes some crossword at the same moment, that crossword is considered solved; otherwise Adilbek does not finish solving the current crossword at all). He thinks it would be an interesting probability theory problem to calculate $$$E$$$ — the expected number of crosswords he will be able to solve completely. Can you calculate it? Recall that the expected value of a discrete random variable is the probability-weighted average of all possible values — in this problem it means that the expected value of the number of solved crosswords can be calculated as $$$E = \sum \limits_{i = 0}^{n} i p_i$$$, where $$$p_i$$$ is the probability that Adilbek will solve exactly $$$i$$$ crosswords. We can represent $$$E$$$ as rational fraction $$$\frac{P}{Q}$$$ with $$$Q > 0$$$. To give the answer, you should print $$$P \cdot Q^{-1} \bmod (10^9 + 7)$$$.

The first line contains two integers $$$n$$$ and $$$T$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$1 \le T \le 2 \cdot 10^{14}$$$) — the number of crosswords and the time Adilbek has to spend, respectively. The second line contains $$$n$$$ integers $$$t_1, t_2, \dots, t_n$$$ ($$$1 \le t_i \le 10^9$$$), where $$$t_i$$$ is the time it takes a crossword expert to solve the $$$i$$$-th crossword. Note that Adilbek solves the crosswords in the order they are given in the input without skipping any of them.

Print one integer — the expected value of the number of crosswords Adilbek solves in $$$T$$$ seconds, expressed in the form of $$$P \cdot Q^{-1} \bmod (10^9 + 7)$$$.

NoteThe answer for the first sample is equal to $$$\frac{14}{8}$$$.The answer for the second sample is equal to $$$\frac{17}{8}$$$.

import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)

parseInt = foldl (\acc c -> acc * 10 + toInteger (ord c) - 48) 0

parseInts = fmap parseInt . words

mm = 10 ^ 9 + 7 :: Integer

newtype FiniteField =
  FiniteField Integer

instance Show FiniteField where
  show (FiniteField a) = show a

instance Num FiniteField where
  (+) (FiniteField a) (FiniteField b) =
    FiniteField
      (if a + b >= mm
         then a + b - mm
         else a + b)
  (*) (FiniteField a) (FiniteField b) = FiniteField ((a * b) `mod` mm)
  fromInteger = FiniteField . norm
    where
      norm = (`mod` mm) . (+ mm) . (`mod` mm)
  negate (FiniteField a) =
    FiniteField
      (if a == 0
         then 0
         else mm - a)
  abs = id
  signum _ = 1

instance Fractional FiniteField where
  recip (FiniteField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (FiniteField q) * recip (FiniteField r)
    where
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

prob :: Integer -> State (Integer, Integer, FiniteField, FiniteField) FiniteField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInteger n' / fromInteger (n' - m)
                 remove k (prefix, last) =
                   (prefix - last, last / fromInteger (n' - k + 1) * fromInteger k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)
import GHC.TypeNats
import Numeric.Natural (Natural)

parseInt = foldl (\acc c -> acc * 10 + toInteger (ord c) - 48) 0

parseInts = fmap parseInt . words

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

type MField = PrimeField (10 ^ 9 + 7)

prob :: Integer -> State (Integer, Integer, MField, MField) MField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInteger n' / fromInteger (n' - m)
                 remove k (prefix, last) =
                   ( prefix - last
                   , last / fromInteger (n' - k + 1) * fromInteger k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)

{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)
import GHC.TypeNats

parseInt = foldl (\acc c -> acc * 10 + toInteger (ord c) - 48) 0

parseInts = fmap parseInt . words

newtype FiniteField (p :: Nat) = FiniteField Integer deriving (Eq)

char :: KnownNat p => FiniteField p -> Integer
char = toInteger . natVal

instance KnownNat p => Show (FiniteField p) where
  show (FiniteField a) = show a

instance KnownNat p => Num (FiniteField p) where
  (+) x@(FiniteField a) (FiniteField b) =
    FiniteField
      (if a + b >= mm
         then a + b - mm
         else a + b)
    where
      mm = char x
  (*) x@(FiniteField a) (FiniteField b) = FiniteField ((a * b) `mod` mm)
    where
      mm = char x
  fromInteger a = ret
    where
      mm = char ret
      ret = FiniteField . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(FiniteField a) =
    FiniteField
      (if a == 0
         then 0
         else mm - a)
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (FiniteField p) where
  recip x@(FiniteField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (FiniteField q) * recip (FiniteField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

type MField = FiniteField (10 ^ 9 + 7)

prob :: Integer -> State (Integer, Integer, MField, MField) MField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInteger n' / fromInteger (n' - m)
                 remove k (prefix, last) =
                   (prefix - last, last / fromInteger (n' - k + 1) * fromInteger k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)

import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)

parseInt = toInteger . foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

mm = 10 ^ 9 + 7 :: Integer

newtype FiniteField =
  FiniteField Integer

instance Show FiniteField where
  show (FiniteField a) = show a

instance Num FiniteField where
  (+) (FiniteField a) (FiniteField b) =
    FiniteField
      (if a + b >= mm
         then a + b - mm
         else a + b)
  (*) (FiniteField a) (FiniteField b) = FiniteField ((a * b) `mod` mm)
  fromInteger = FiniteField . norm
    where
      norm = (`mod` mm) . (+ mm) . (`mod` mm)
  negate (FiniteField a) =
    FiniteField
      (if a == 0
         then 0
         else mm - a)
  abs = id
  signum _ = 1

instance Fractional FiniteField where
  recip (FiniteField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (FiniteField q) * recip (FiniteField r)
    where
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

prob :: Integer -> State (Integer, Integer, FiniteField, FiniteField) FiniteField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInteger n' / fromInteger (n' - m)
                 remove k (prefix, last) =
                   (prefix - last, last / fromInteger (n' - k + 1) * fromInteger k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)

import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

mm = 10 ^ 9 + 7 :: Int

newtype FiniteField =
  FiniteField Int

instance Show FiniteField where
  show (FiniteField a) = show a

instance Num FiniteField where
  (+) (FiniteField a) (FiniteField b) =
    FiniteField
      (if a + b >= mm
         then a + b - mm
         else a + b)
  (*) (FiniteField a) (FiniteField b) = FiniteField ((a * b) `mod` mm)
  fromInteger = FiniteField . fromInteger . norm
    where
      norm = (`mod` mm') . (+ mm') . (`mod` mm')
        where
          mm' = toInteger mm
  negate (FiniteField a) =
    FiniteField
      (if a == 0
         then 0
         else mm - a)
  abs = id
  signum _ = 1

instance Fractional FiniteField where
  recip (FiniteField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (FiniteField q) * recip (FiniteField r)
    where
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

fromInt = fromInteger . toInteger

prob :: Int -> State (Int, Int, FiniteField, FiniteField) FiniteField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInt n' / fromInt (n' - m)
                 remove k (prefix, last) =
                   (prefix - last, last / fromInt (n' - k + 1) * fromInt k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)


Given an array $$$a$$$ of length $$$n$$$, you can do at most $$$k$$$ operations of the following type on it:  choose $$$2$$$ different elements in the array, add $$$1$$$ to the first, and subtract $$$1$$$ from the second. However, all the elements of $$$a$$$ have to remain non-negative after this operation. What is lexicographically the smallest array you can obtain?An array $$$x$$$ is lexicographically smaller than an array $$$y$$$ if there exists an index $$$i$$$ such that $$$x_i<y_i$$$, and $$$x_j=y_j$$$ for all $$$1 \le j < i$$$. Less formally, at the first index $$$i$$$ in which they differ, $$$x_i<y_i$$$.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 20$$$) – the number of test cases you need to solve. The first line of each test case contains $$$2$$$ integers $$$n$$$ and $$$k$$$ ($$$2 \le n \le 100$$$, $$$1 \le k \le 10000$$$) — the number of elements in the array and the maximum number of operations you can make. The second line contains $$$n$$$ space-separated integers $$$a_1$$$, $$$a_2$$$, $$$\ldots$$$, $$$a_{n}$$$ ($$$0 \le a_i \le 100$$$) — the elements of the array $$$a$$$.

For each test case, print the lexicographically smallest array you can obtain after at most $$$k$$$ operations.

NoteIn the second test case, we start by subtracting $$$1$$$ from the first element and adding $$$1$$$ to the second. Then, we can't get any lexicographically smaller arrays, because we can't make any of the elements negative.

import Control.Monad (replicateM_)

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

findSmallest :: (Int, Int) -> [Int] -> [Int]
findSmallest (_, ops) [x] = [x + ops]
findSmallest (0, ops) (x : xs) = x : findSmallest (0, ops) xs
findSmallest (k, ops) (x : xs) = x' : findSmallest (k', ops') xs where
  (x', k', ops') = if k > x then (0, k - x, ops + x) else (x - k, 0, ops + k)

solve :: IO ()
solve = do
  [n, k] <- readInts
  ans <- findSmallest (k, 0) <$> readInts
  putStrLn $ unwords $ map show ans

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

import Control.Monad(replicateM)

main = getLine >>= (flip replicateM) runTest . read

runTest :: IO ()
runTest = do
	l <- getLine >>= return . (fmap read) . words :: IO [Int]
	a <- getLine >>= return . (fmap read) . words :: IO [Int]
	putStrLn $ foldr (\i s -> show i ++ " " ++ s) "" (result (l!!1) a)

result k [] = []
result k [x] = [x]
result 0 list = list
result k (0:xs) = 0 : result k xs
result k (x:xs) = (max 0 $ x-k) : result (max 0 $ k-x) (init xs ++ [last xs + (min x k)])