You have decided to watch the best moments of some movie. There are two buttons on your player:   Watch the current minute of the movie. By pressing this button, you watch the current minute of the movie and the player automatically proceeds to the next minute of the movie.  Skip exactly x minutes of the movie (x is some fixed positive integer). If the player is now at the t-th minute of the movie, then as a result of pressing this button, it proceeds to the minute (t + x). Initially the movie is turned on in the player on the first minute, and you want to watch exactly n best moments of the movie, the i-th best moment starts at the li-th minute and ends at the ri-th minute (more formally, the i-th best moment consists of minutes: li, li + 1, ..., ri). Determine, what is the minimum number of minutes of the movie you have to watch if you want to watch all the best moments?

The first line contains two space-separated integers n, x (1 ≤ n ≤ 50, 1 ≤ x ≤ 105) — the number of the best moments of the movie and the value of x for the second button. The following n lines contain the descriptions of the best moments of the movie, the i-th line of the description contains two integers separated by a space li, ri (1 ≤ li ≤ ri ≤ 105). It is guaranteed that for all integers i from 2 to n the following condition holds: ri - 1 < li.

Output a single number — the answer to the problem.

NoteIn the first sample, the player was initially standing on the first minute. As the minutes from the 1-st to the 4-th one don't contain interesting moments, we press the second button. Now we can not press the second button and skip 3 more minutes, because some of them contain interesting moments. Therefore, we watch the movie from the 4-th to the 6-th minute, after that the current time is 7. Similarly, we again skip 3 minutes and then watch from the 10-th to the 12-th minute of the movie. In total, we watch 6 minutes of the movie.In the second sample, the movie is very interesting, so you'll have to watch all 100000 minutes of the movie.

input :: Int -> [String] -> IO ([String])
input 0 s = return s
input i s = do
  nexts <- getLine
  input (i-1) (s ++ [nexts])

toints :: [String] -> [[Int]]
toints dat = map ((map read).words) dat

solve :: Int -> [[Int]] -> Int -> Int
solve _ [] _ = 0
solve start ([f, t]:lst) step
  | start + step <= f = solve (start+step) ([f,t]:lst) step
  | start > t = solve start lst step
  | otherwise = 1 + solve (start+1) ([f,t]:lst) step

main = do
  inp <- getLine
  let [n, x] = map read (words inp)
  dat <- input n []
  let res = toints dat
--  mapM_ print (res)
  print (solve 1 res x)

main = do
	t<-getLine
	rest<-getContents
	let [n,x] = map read $ words t
	let dat = map (map read) $ map words $ lines rest
	putStrLn $ show $ solve 1 x 0 dat

solve cur step all [] = all
solve cur step all (m:ms) | head m - cur >=step = solve (cur+step) step (all) (m:ms)
                          | head m - cur < step = solve (last m+1) step (all+last m - cur+1) ms

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

solve :: [Int] -> Int
solve (n:x:seg) = solve' 0 seg
    where
        solve' :: Int -> [Int] -> Int
        solve' _    []       = 0
        solve' last (l:r:ss) = (mod (l-last-1) x) + (r-l+1) + (solve' r ss)

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

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

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

main = do
  [n, x] <- getInts
  lrs <- replicateM n getInts

  let
    count c [] = 0
    count c ([l, r]:lrs) =
      (l-c) `mod` x + (r-l+1) + count (r+1) lrs

  print $ count 1 lrs

import Data.Functor

getInts :: IO [Int]
getInts = map read <$> words <$> getContents

main = getInts >>= putStrLn . show . solve

solve :: [Int] -> Int
solve (n:x:rs) = solve' x 0 rs

solve' x t [] = 0
solve' x t (l:r:rs) = (r-l+1) + mod (l-t-1) x + solve' x r rs

import Control.Monad
solution x l = best l + wait x l
best = sum.map (uncurry subtract)
wait x l = sum $ map (flip mod x) $ zipWith subtract (map snd l) $ tail $ map fst l
readPair = fmap (l2p.map read.words) getLine where l2p [x,y] = (x,y)
main = do
    (n,x) <- readPair
    l <- replicateM n readPair
    print $ solution x $ (1,1):map (fmap (+1)) l

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe

main :: IO ()
main = do
  [n, x] <- readIntsIO
  lrs <- replicateM n readIntsIO
  print $ solve x lrs

solve :: Int -> [[Int]] -> Int
solve x = go 0 0
  where
    go acc _ [] = acc
    go acc curr ([l, r]:lrs') = go (acc + timeToSkip curr l + (r - l + 1)) r lrs'
    timeToSkip curr next = mod (next - curr - 1) x

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

import Data.List

main = do
    contents <- getContents
    let allLines = lines contents
    let firstLineOfContentAsList = words $ head allLines
    --let nExcitingTimeFrames = firstLineOfContentAsList !! 0
    let skipThisLengthByRemote = read $ firstLineOfContentAsList !! 1
    let excitingTimeFrames = readTimeFrames $ tail allLines
    let lastExcitingFrameEndPoints = map (\(x, y) -> y) $ (0, 0) : init excitingTimeFrames
    let timesCannotSkip = sum $ zipWith (\x (y, z) -> calculateTimeCannotSkip skipThisLengthByRemote x y z) lastExcitingFrameEndPoints excitingTimeFrames
    let timesForWatching = foldl' (\acc (leftTimePoint, rightTimePoint) -> rightTimePoint - leftTimePoint + 1 + acc) 0 excitingTimeFrames
    let minimunTimeSpend = timesCannotSkip + timesForWatching
    print minimunTimeSpend

readTimeFrames :: [String] -> [(Int, Int)]
readTimeFrames [] = []
readTimeFrames (lineToProcess:remainLines) = (twoWordsToTwoInts $ words lineToProcess) : (readTimeFrames remainLines)

twoWordsToTwoInts :: [String] -> (Int, Int)
twoWordsToTwoInts (firstWord:secondWord:remain) = (read firstWord, read secondWord)

calculateTimeCannotSkip :: Int -> Int -> Int -> Int -> Int
calculateTimeCannotSkip skipThisLengthByRemote lastExcitingTimeFrameEndsHere nextExcitingTimeFrameStartsHere nextExcitingTimeFrameEndsHere = (nextExcitingTimeFrameStartsHere - 1 - lastExcitingTimeFrameEndsHere) `mod` skipThisLengthByRemote

main :: IO ()
main = getContents >>= print . solve . map read . tail . words

solve :: [Integer] -> Integer
solve (x:xs) = go 0 xs
  where go t zs@(l:r:ys) | t + x < l = go (t + x) zs
                         | otherwise = r - t + go r ys
        go _ _ = 0
solve _ = undefined

main :: IO ()
main = getContents >>= print . solve . map (map read . words) . lines

solve :: [[Integer]] -> Integer
solve ([_, x]:xs) = go 0 xs
  where go t lrlrs@([ l, r ] : lrs) | t + x < l = go (t + x) lrlrs
                                    | otherwise = r - t + go r lrs
        go _ _ = 0
solve _ = undefined

input 0 s = return s
input i s = do
  nexts <- getLine
  input (i - 1) (s ++ [nexts])

tointlist :: [String] -> [[Int]]
tointlist [] = []
tointlist l = do
    let f = map read $ words $ head l
    let s = tointlist $ tail l
    return f ++ s

localAnswer :: Int -> Int -> Int
localAnswer interval val = (quot interval val) * val

getAnswer :: Int -> Int -> [[Int]] -> Int
getAnswer start x [] = 0
getAnswer start x ([l, r]:ys)
    | x > l - start = l - start + r - l + 1 + getAnswer (r + 1) x ys
    | otherwise = getAnswer (start + localAnswer (l - start) x) x ([l, r]:ys)

main = do
  inp <- getLine
  let [n, x] = map read $ words inp
  interest <- input n []
  let val = getAnswer 1 x $ tointlist interest
  print val

import Control.Applicative
import Data.List

process _ _ [] a =a
process m n (s1:s2:ss) a = process m s2 ss (a+(mod (s1-n-1) m) + s2-s1+1)

main= do
	[n,m]<-map read.words <$>getLine ::IO [Int]
	s<- map read. words <$>getContents
	print $ process m 0 s 0

main = do
	t<-getLine
	rest<-getContents
	let [n,x] = map read $ words t
	let dat = map (map read) $ map words $ lines rest
	putStrLn $ show $ solve 1 x 1 dat

solve cur step all [] = all
solve cur step all (m:ms) | head m - cur >=step = solve (cur+step) step (all) (m:ms)
                          | head m - cur < step = solve (last m) step (all+last m - cur) ms
                          | otherwise = solve (last m) step (all+ last m - cur) ms

import Control.Monad
solution x l = best l + wait x l
best = sum.map ((+1).uncurry subtract)
wait x l = sum $ map (flip mod x) $ zipWith subtract (map snd l) $ tail $ map fst l
readPair = fmap (l2p.map read.words) getLine where l2p [x,y] = (x,y)
main = do
    (n,x) <- readPair
    l <- replicateM n readPair
    print $ solution x $ (2,1):l

import Control.Monad
solution x l = best l + wait x l
best = sum.map ((+1).uncurry subtract)
wait x l = sum $ map (flip mod x) $ zipWith subtract (map snd l) $ tail $ map fst l
readPair = fmap (l2p.map read.words) getLine where l2p [x,y] = (x,y)
main = do
    (n,x) <- readPair
    l <- replicateM n readPair
    print $ solution x l

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe

main :: IO ()
main = do
  [n, x] <- readIntsIO
  lrs <- replicateM n readIntsIO
  print $ solve x lrs

solve :: Int -> [[Int]] -> Int
solve x = go 0 (-1)
  where
    go acc _ [] = acc
    go acc curr ([l, r]:lrs') = go (acc + timeToSkip curr l + (r - l + 1)) r lrs'
    timeToSkip curr next = mod (next - curr - 1) x

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

import Control.Applicative
import Data.List

process _ _ [] a =a
process m n (s1:s2:ss) a = process m s2 ss (a+(mod (s1-n-1) 3) + s2-s1+1)
main= do
	[n,m]<-map read.words <$>getLine ::IO [Int]
	s<- map read. words <$>getContents
	print $ process m 0 s 0


There are $$$n$$$ traps numbered from $$$1$$$ to $$$n$$$. You will go through them one by one in order. The $$$i$$$-th trap deals $$$a_i$$$ base damage to you.Instead of going through a trap, you can jump it over. You can jump over no more than $$$k$$$ traps. If you jump over a trap, it does not deal any damage to you. But there is an additional rule: if you jump over a trap, all next traps damages increase by $$$1$$$ (this is a bonus damage).Note that if you jump over a trap, you don't get any damage (neither base damage nor bonus damage). Also, the bonus damage stacks so, for example, if you go through a trap $$$i$$$ with base damage $$$a_i$$$, and you have already jumped over $$$3$$$ traps, you get $$$(a_i + 3)$$$ damage.You have to find the minimal damage that it is possible to get if you are allowed to jump over no more than $$$k$$$ traps.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$1 \le k \le n$$$) — the number of traps and the number of jump overs that you are allowed to make. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — base damage values of all traps. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case output a single integer — the minimal total damage that it is possible to get if you are allowed to jump over no more than $$$k$$$ traps.

NoteIn the first test case it is allowed to jump over all traps and take $$$0$$$ damage.In the second test case there are $$$5$$$ ways to jump over some traps:  Do not jump over any trap.Total damage: $$$5 + 10 + 11 + 5 = 31$$$. Jump over the $$$1$$$-st trap.Total damage: $$$\underline{0} + (10 + 1) + (11 + 1) + (5 + 1) = 29$$$. Jump over the $$$2$$$-nd trap.Total damage: $$$5 + \underline{0} + (11 + 1) + (5 + 1) = 23$$$. Jump over the $$$3$$$-rd trap.Total damage: $$$5 + 10 + \underline{0} + (5 + 1) = 21$$$. Jump over the $$$4$$$-th trap.Total damage: $$$5 + 10 + 11 + \underline{0} = 26$$$.To get minimal damage it is needed to jump over the $$$3$$$-rd trap, so the answer is $$$21$$$.In the third test case it is optimal to jump over the traps $$$1$$$, $$$3$$$, $$$4$$$, $$$5$$$, $$$7$$$:Total damage: $$$0 + (2 + 1) + 0 + 0 + 0 + (2 + 4) + 0 = 9$$$.

import Data.Char
import Data.List
import qualified Data.ByteString.Char8 as BS

skipWhitespace :: BS.ByteString -> BS.ByteString
skipWhitespace = BS.dropWhile (`elem` " \n\t")

readInts :: BS.ByteString -> [Int]
readInts line = case BS.readInt line of Just (x, t) -> x : (readInts (skipWhitespace t))
                                        Nothing -> []

solve :: Int -> Int -> [Int] -> Int
solve n k a = (sum a) - (k * (k - 1) `div` 2) + k * (n - 1) - sum (take k $ reverse $ sort [elem + ind | (elem, ind) <- zip a [0..]])

mainLoop 0 = return ()
mainLoop t = do firstLine <- BS.getLine
                secondLine <- BS.getLine
                let [n, k] = readInts firstLine
                let a = readInts secondLine
                print (solve n k a)
                mainLoop (t - 1)

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

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n, k] <- getInts
    as <- map fromIntegral <$> getInts
    let bs = scanl' (+) 0 $ reverse $ sort $ zipWith (\i a -> a - fromIntegral n + i) [1..] as
        optimal = maximum $ take (k + 1) $ zipWith (\i a -> i * (i - 1) `div` 2 + a) [0..] bs
    return $ int64Dec (sum as - optimal) <> charUtf8 '\n'
  hPutBuilder stdout output


Shubham has an array $$$a$$$ of size $$$n$$$, and wants to select exactly $$$x$$$ elements from it, such that their sum is odd. These elements do not have to be consecutive. The elements of the array are not guaranteed to be distinct.Tell him whether he can do so.

The first line of the input contains a single integer $$$t$$$ $$$(1\le t \le 100)$$$ — the number of test cases. The description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$x$$$ $$$(1 \le x \le n \le 1000)$$$ — the length of the array and the number of elements you need to choose. The next line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ $$$(1 \le a_i \le 1000)$$$ — elements of the array.

For each test case, print "Yes" or "No" depending on whether it is possible to choose $$$x$$$ elements such that their sum is odd. You may print every letter in any case you want.

NoteFor $$$1$$$st case: We must select element $$$999$$$, and the sum is odd.For $$$2$$$nd case: We must select element $$$1000$$$, so overall sum is not odd.For $$$3$$$rd case: We can select element $$$51$$$.For $$$4$$$th case: We must select both elements $$$50$$$ and $$$51$$$  — so overall sum is odd.For $$$5$$$th case: We must select all elements  — but overall sum is not odd.

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

routine :: IO ()
routine = do
  [n,x] <- (map read.words) <$> getLine
  xs <- (map read.words) <$> getLine
  putStrLn $ if solve n x xs then "Yes" else "No"

solve :: Int -> Int -> [Int] -> Bool
solve n x xs
  | n == x = odd $ sum xs
  | otherwise = b || (odd $ sum $ take x xs)
  where
    b = (any odd xs) && (any even xs)

-- as <- getLine
-- putStrLn (show (foldr (+) 0 (map read (words as))))

getNums :: IO [Int]
getNums = do
    nums <- getLine
    return (map (read :: String -> Int) $ (words nums))

getNum = do
    num <- getLine
    return (read num :: Int)

tuplify2 [x, y] = (x, y)

repeatAction 0 _ = return ()
repeatAction n action = do
    action
    repeatAction (n - 1) action

answer cap o e target =
    if o > fst cap then False
    else if o + e == target then True
         else if e + 1 > snd cap then answer cap (o + 2) 0 target
              else answer cap o (e + 1) target

body = do
    params <- getNums
    values <- getNums

    let (n, x) = tuplify2 params
    let odds = foldr (+) 0 $ map (fromEnum . odd) values
    let evens = n - odds
    let evensFromOdds = odds `div` 2

    putStrLn $ if answer (odds, evens) 1 0 x then "Yes"
               else "No"

    return ()

main = do
    t <- getNum
    repeatAction t body

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

routine :: IO ()
routine = do
    [n, x] <- (map read.words) <$> getLine
    xs <- (map read.words) <$> getLine
    putStrLn $ if (solve x xs) then "No" else "Yes"

solve :: Int -> [Int] -> Bool
solve x a =
    let evens = length $ filter (\x->mod x 2 ==0) a in
    let odds = length a - evens in
    let min_odds = if (evens > x) then 0 else (x - evens) in
    let max_odds = min x odds in
    (min_odds == max_odds) && (mod min_odds 2 == 0)

count :: [Int] -> Int -> Int
count [] n = n
count (x : list) n = count list (n + (mod x 2))
while i = do
    if i == 0 then
        return 0
    else do
        input1 <- getLine
        input2 <- getLine
        let [n, x] = map read (words input1) :: [Int]
        let list = map read (words input2) :: [Int]
        --print count list
        let od = count list 0
        let ev = n - od
        if ev >= x then
            if od > 0 then
                putStrLn "Yes"
            else
                putStrLn "No"
        else do
            let d = x - ev
            if (mod d 2) == 1 then
                putStrLn "Yes"
            else if od > d && ev > 0 then
                putStrLn "Yes"
            else
                putStrLn "No"
        while (i - 1)
main = do
    input <- getLine
    let tests = read input :: (Int)
    while tests

main :: IO ()
main = do
  t <- readLn
  routine t

routine :: Int -> IO ()
routine t
  | t > 1 = do
      solve
      routine (t-1)
  | t == 1 = solve

solve :: IO()
solve = do
  [n,x] <- map read.words <$> getLine
  xs <- map read.words <$> getLine
  putStrLn (if possible n x xs then "Yes" else "No")

possible :: Int -> Int -> [Int] -> Bool
possible n x xs
  | x == n = odd (sum xs)
  | otherwise = do
      let a = take x xs
      let b = drop x xs
      if even (sum a) then ((any even a) && (any odd b)) || ((any odd a) && (any even b))
      else True

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}

import Data.List

--import Debug.Trace

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let _:tokens = read <$> split input :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          n:k:rest0   ->
            let (vals, rest1) = splitAt n rest0
                anyOdd = any (\x -> x `mod` 2 == 1) vals
                anyEven = any (\x -> x `mod` 2 == 0) vals
                sumParity = foldl (+) 0 vals `mod` 2
                hasChoice = k < n
                res = if
                  | hasChoice   -> anyOdd && (anyEven || k `mod` 2 == 1)
                  | otherwise   -> sumParity == 1
            in Just (if res then "Yes" else "No", rest1)
        ) tokens
  sequence_ $ putStrLn <$> res

import Data.List (unfoldr)
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Char8 (readInt)
import Prelude hiding (span, dropWhile)
import Data.Word (Word8)

newLine :: Word8
newLine = 0x0a
space :: Word8
space = 0x20

skipLine :: L.ByteString -> L.ByteString
skipLine = L.dropWhile (== newLine) . L.dropWhile (/= newLine)

readIntLine :: L.ByteString -> ([Int], L.ByteString)
readIntLine str = let
  (currLine, lf) = L.span (/= newLine) str
  (_, rest) = L.span (== newLine) lf
  in (unfoldr (readInt . L.dropWhile (== space)) currLine, rest)

parseCase :: L.ByteString -> Maybe (([Int], Int), L.ByteString)
parseCase str = case  readIntLine str  of
  ([_n, x], xs1) -> Just ((a, x), xs2)  where
    (a, xs2) = readIntLine xs1
  _ -> Nothing

solve :: ([Int], Int) -> Bool
solve (a, x) = let
  (n, k) = go 0 0 a
  go p q [] = (p, q)
  go p q (w:ws) = seq (seq p q) $ go (p+1) (if  odd w  then  q + 1  else  q) ws
  in
    case  ()  of
     ()
      | k == n  -> odd x
      | k == 0  -> False
      | x == n  -> odd k
      | x == 0  -> False
      | otherwise  -> True

pprint :: Bool -> String
pprint True = "Yes\n"
pprint False = "No\n"

main :: IO ()
main = (putStr . concatMap (pprint . solve) . unfoldr parseCase . skipLine)
  =<< L.getContents

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n strings = (take n strings):(groupByNLines n (drop n strings))

parse :: [String] -> String
parse [l, arr']
   | solve arr x = "YES"
   | otherwise = "NO"
   where arr = map (\x -> read x :: Integer) $ words arr'
         [_, x] = map (\x -> read x :: Integer) $ words l

main :: IO ()
main = interact (unlines . map parse . groupByNLines 2 . tail . lines)

possibilities :: Integer -> [(Integer, Integer)]
possibilities n = [(i, n-i) | i <- [0..n], odd (n-i)]

solve :: [Integer] -> Integer -> Bool
solve arr x = length (filter (\(e, o) -> numberOfOdd >= o && numberOfEven >= e) pos) > 0
  where numberOfOdd = toInteger $ length $ filter odd arr
        numberOfEven = toInteger $ length $ filter even arr
        pos = possibilities x

-- as <- getLine
-- putStrLn (show (foldr (+) 0 (map read (words as))))

getNums :: IO [Int]
getNums = do
    nums <- getLine
    return (map (read :: String -> Int) $ (words nums))

getNum = do
    num <- getLine
    return (read num :: Int)

tuplify2 [x, y] = (x, y)

repeatAction 0 _ = return ()
repeatAction n action = do
    action
    repeatAction (n - 1) action

body = do
    params <- getNums
    values <- getNums

    let (n, x) = tuplify2 params
    let odds = foldr (+) 0 $ map (fromEnum . odd) values
    let evens = n - odds
    let evensFromOdds = odds `div` 2

    putStrLn $ if odds >= 1 && evens >= x - 1 ||
                  (odd odds) && evens + evensFromOdds >= x - 1 ||
                  (odds >= 2) && evens + evensFromOdds - 1 >= x - 1
               then "Yes"
               else "No"

    return ()

main = do
    t <- getNum
    repeatAction t body

hasEven :: [Integer] -> Bool
hasEven arr = not $ null $ filter even arr

hasOdd :: [Integer] -> Bool
hasOdd arr = not $ null $ filter odd arr

withoutAnEven :: [Integer] -> [Integer]
withoutAnEven arr = (takeWhile odd arr) ++ (tail (dropWhile odd arr))

withoutAnOdd :: [Integer] -> [Integer]
withoutAnOdd arr = (takeWhile even arr) ++ (tail (dropWhile even arr))

atLeastTwoOdd :: [Integer] -> Bool
atLeastTwoOdd arr = (length $ filter odd arr) >= 2

solve :: Integer -> [Integer] -> Bool
solve 1 arr = hasOdd arr
solve x arr
  | null arr = False
  | x <= 0 = False
  | hasEven arr = solve (x-1) (withoutAnEven arr)
  | atLeastTwoOdd arr = solve (x-2) (withoutAnOdd $ withoutAnOdd arr)
  | hasOdd arr = solve (x-1) (withoutAnOdd arr)

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n strings = (take n strings):(groupByNLines n (drop n strings))

parse :: [String] -> String
parse [l, arr']
  | solve x arr = "YES"
  | otherwise = "NO"
  where arr = map (\x -> read x :: Integer) $ words arr'
        [_, x] = map (\x -> read x :: Integer) $ words l

main :: IO ()
main = interact (unlines . map parse . groupByNLines 2 . tail . lines)


You've got a string $$$a_1, a_2, \dots, a_n$$$, consisting of zeros and ones.Let's call a sequence of consecutive elements $$$a_i, a_{i + 1}, \ldots, a_j$$$ ($$$1\leq i\leq j\leq n$$$) a substring of string $$$a$$$. You can apply the following operations any number of times:  Choose some substring of string $$$a$$$ (for example, you can choose entire string) and reverse it, paying $$$x$$$ coins for it (for example, «0101101» $$$\to$$$ «0111001»);  Choose some substring of string $$$a$$$ (for example, you can choose entire string or just one symbol) and replace each symbol to the opposite one (zeros are replaced by ones, and ones — by zeros), paying $$$y$$$ coins for it (for example, «0101101» $$$\to$$$ «0110001»). You can apply these operations in any order. It is allowed to apply the operations multiple times to the same substring.What is the minimum number of coins you need to spend to get a string consisting only of ones?

The first line of input contains integers $$$n$$$, $$$x$$$ and $$$y$$$ ($$$1 \leq n \leq 300\,000, 0 \leq x, y \leq 10^9$$$) — length of the string, cost of the first operation (substring reverse) and cost of the second operation (inverting all elements of substring). The second line contains the string $$$a$$$ of length $$$n$$$, consisting of zeros and ones.

Print a single integer — the minimum total cost of operations you need to spend to get a string consisting only of ones. Print $$$0$$$, if you do not need to perform any operations.

NoteIn the first sample, at first you need to reverse substring $$$[1 \dots 2]$$$, and then you need to invert substring $$$[2 \dots 5]$$$. Then the string was changed as follows:«01000» $$$\to$$$ «10000» $$$\to$$$ «11111».The total cost of operations is $$$1 + 10 = 11$$$.In the second sample, at first you need to invert substring $$$[1 \dots 1]$$$, and then you need to invert substring $$$[3 \dots 5]$$$. Then the string was changed as follows:«01000» $$$\to$$$ «11000» $$$\to$$$ «11111».The overall cost is $$$1 + 1 = 2$$$.In the third example, string already consists only of ones, so the answer is $$$0$$$.

{-# LANGUAGE ScopedTypeVariables #-}

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

main = do
    [n, x, y] <- map read <$> words <$> getLine
    s <- getLine

    let gs = group s
        m  = fromIntegral $ length $ filter (\x -> head x == '0') gs

    --print m

    if m == 0
    then print 0
    else print $ foldl' min (10000000000000000000000000000000000000) $
            [(m - t) * y + t * x | t <- [0 .. m - 1]]

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

main = do
    [n, x, y] <- map read <$> words <$> getLine
    s <- getLine

    let gs = group s
        m  = length $ filter (\x -> head x == '0') gs

    --print m

    if m == 0
    then print 0
    else print $ foldl' min (100000000000000) $
            [(m - t) * y + t * x | t <- [0 .. m - 1]]

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

main = do
    [n, x, y] <- map read <$> words <$> getLine
    s <- getLine

    let gs = group s
        m  = length $ filter (\x -> head x == '0') gs

    --print m

    if m == 0
    then print 0
    else print $ foldl' min (10^10) $
            [(m - t) * y + t * x | t <- [0 .. m - 1]]

{-# LANGUAGE ScopedTypeVariables #-}

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

main = do
    [n, x, y] <- map read <$> words <$> getLine
    s <- getLine

    let gs = group s
        m  = fromIntegral $ length $ filter (\x -> head x == '0') gs

    --print m

    if m == 0
    then print 0
    else print $ foldl' min (100000000000000) $
            [(m - t) * y + t * x | t <- [0 .. m - 1]]


You are given an integer array of length $$$n$$$.You have to choose some subsequence of this array of maximum length such that this subsequence forms a increasing sequence of consecutive integers. In other words the required sequence should be equal to $$$[x, x + 1, \dots, x + k - 1]$$$ for some value $$$x$$$ and length $$$k$$$.Subsequence of an array can be obtained by erasing some (possibly zero) elements from the array. You can erase any elements, not necessarily going successively. The remaining elements preserve their order. For example, for the array $$$[5, 3, 1, 2, 4]$$$ the following arrays are subsequences: $$$[3]$$$, $$$[5, 3, 1, 2, 4]$$$, $$$[5, 1, 4]$$$, but the array $$$[1, 3]$$$ is not.

The first line of the input containing integer number $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the length of the array. The second line of the input containing $$$n$$$ integer numbers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the array itself.

On the first line print $$$k$$$ — the maximum length of the subsequence of the given array that forms an increasing sequence of consecutive integers. On the second line print the sequence of the indices of the any maximum length subsequence of the given array that forms an increasing sequence of consecutive integers.

NoteAll valid answers for the first example (as sequences of indices):   $$$[1, 3, 5, 6]$$$  $$$[2, 3, 5, 6]$$$ All valid answers for the second example:   $$$[1, 4]$$$  $$$[2, 5]$$$  $$$[3, 6]$$$ All valid answers for the third example:   $$$[1]$$$  $$$[2]$$$  $$$[3]$$$  $$$[4]$$$ All valid answers for the fourth example:   $$$[1, 2, 3, 7, 8, 9]$$$

module Main where

import Data.List
import qualified Data.HashMap.Strict as H

solve :: [Int] -> [Int]
solve ns = go H.empty (zip [1..] ns)
  where
    go :: H.HashMap Int ([Int], Int) -> [(Int, Int)] -> [Int]
    go h [] = reverse $ fst $ snd $ maximumBy (\(_, (_, a)) (_, (_, b)) -> compare a b) (H.toList h)
    go h ((i, x):xs) = case H.lookup (x - 1) h of
      Just (ys, l) -> go (H.insert x (i:ys, l + 1) h) xs
      Nothing -> go (H.insert x ([i], 1) h) xs

main :: IO ()
main = do
  _ <- getLine
  ns <- fmap (map read . words) getLine
  let result = solve ns
  print $ length result
  putStrLn $ unwords (map show result)

import qualified Data.ByteString.Char8 as B
import qualified Data.IntMap as M
import qualified Data.Foldable as F
import Data.List
import Data.Ord
import qualified Data.Sequence as S

main = do
  input <- B.getContents
  let ns =  map readI $ tail $ B.words $ input
  let ans = solve ns
  print (length ans)
  putStrLn $ unwords $  map show ans

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

solve :: [Int] -> [Int]
solve ns =
  F.toList $ M.foldl (\xs ys-> maximumBy (comparing S.length) [xs,ys]) S.empty $ foldl f M.empty $ zip [1..] ns
  where
    f :: M.IntMap (S.Seq Int) -> (Int,Int) -> M.IntMap (S.Seq Int)
    f m (i,x) =
      case M.lookup x m of
        Nothing -> M.alter (Just . g (S.singleton i)) (x+1) m
        Just js -> M.alter (Just . g (js S.|> i)) (x+1) m

    g :: S.Seq Int -> Maybe (S.Seq Int) -> S.Seq Int
    g xs Nothing   = xs
    g xs (Just ys) = maximumBy (comparing S.length) [xs,ys]

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

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

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

main :: IO ()
main = do
    n <- readLn :: IO Int
    xs <- unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    let res = solve n xs
    print $ length res
    putStrLn . unwords . map show $ res

solve :: Int -> [Int] -> [Int]
solve _ xs = construct [1..] xs . subseq $ go IM.empty xs
  where
    go !im (x:xs) = case IM.lookup (x - 1) im of
        Nothing -> go (IM.insert x 1 im) xs
        Just l  -> go (IM.insertWith max x (l + 1) im) xs
    go im [] = maximum [(v,k)|(k,v)<-IM.toList im]
    subseq (v, k) = [k-v+1..k]
    construct (i:is) (x:xs) (y:ys)
        | x == y = i : construct is xs ys
        | otherwise = construct is xs (y:ys)
    construct _ _ _ = []

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

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

main :: IO ()
main = do
    n <- readLn :: IO Int
    xs <- unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    let res = solve n xs
    print $ length res
    putStrLn . unwords $ map show res

solve :: Int -> [Int] -> [Int]
solve _ xs = construct [1..] xs $ go IM.empty xs
  where
    go !im (x:xs) = case IM.lookup (x - 1) im of
        Nothing -> go (IM.insert x 1 im) xs
        Just l  -> go (IM.insertWith max x (l + 1) im) xs
    go im [] = snd $ maximum [(len, [lst-len+1..lst])|(lst, len)<-IM.toList im]
    construct (i:is) (x:xs) (y:ys)
        | x == y = i : construct is xs ys
        | otherwise = construct is xs (y:ys)
    construct _ _ _ = []


Petya loves lucky numbers very much. Everybody knows that lucky numbers are positive integers whose decimal record contains only the lucky digits 4 and 7. For example, numbers 47, 744, 4 are lucky and 5, 17, 467 are not.Petya has two strings a and b of the same length n. The strings consist only of lucky digits. Petya can perform operations of two types:   replace any one digit from string a by its opposite (i.e., replace 4 by 7 and 7 by 4);  swap any pair of digits in string a. Petya is interested in the minimum number of operations that are needed to make string a equal to string b. Help him with the task.

The first and the second line contains strings a and b, correspondingly. Strings a and b have equal lengths and contain only lucky digits. The strings are not empty, their length does not exceed 105.

Print on the single line the single number — the minimum number of operations needed to convert string a into string b.

NoteIn the first sample it is enough simply to swap the first and the second digit.In the second sample we should replace the second digit with its opposite.In the third number we should replace all three digits with their opposites.

diff [] _ _ = 0
diff (x:xs) (y:ys) c = if x==c && x/=y then 1 + diff xs ys c
						  		        else diff xs ys c
ans x y = let
			f = diff x y '4'
			s = diff x y '7'
		  in
		    f + s - min f s
main = do
		x <- getLine
		y <- getLine
		putStrLn $ show $ ans x y

diff4 [] _ = 0
diff4 (x:xs) (y:ys) = if x=='4' && x/=y then 1 + diff4 xs ys
						  		        else diff4 xs ys
diff7 [] _ = 0
diff7 (x:xs) (y:ys) = if x=='7' && x/=y then 1 + diff7 xs ys
						  		        else diff7 xs ys
ans x y = diff4 x y + diff7 x y - min (diff4 x y) (diff7 x y)
main = do
		x <- getLine
		y <- getLine
		putStrLn $ show $ ans x y

{-# 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.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- 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 Debug.Trace
import System.IO

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

main = do
  a <- getLine
  b <- getLine

  let
    c1 = length $ filter (== '4') a
    c2 = length $ filter (== '4') b

    k = abs $ c1-c2

    a' = f a b k
      where
        f [] _ _ = []
        f (x:xs) (y:ys) k
          | x /= y && k > 0 = y:(f xs ys (k-1))
          | otherwise = x:(f xs ys k)

    k2 = (length $ filter id $ zipWith (/=) a' b) `div` 2

  print $ k + k2

is4  =  \ch -> ch == '4'
is7  =  \ch -> ch == '7'
is47 =  \ch -> is4 ch || is7 ch

filterEq :: String -> String -> String
filterEq "" ""  =  ""
filterEq "" _   =  ""
filterEq _ ""   =  ""
filterEq (x:xs) (y:ys)
  | x == y     =  filterEq xs ys
  | otherwise  =  x:(filterEq xs ys)

solve :: String -> String -> Int
solve s1 s2  =  max c4 c7
  where
    s   =  filterEq s1 s2
    c4  =  length (filter is4 s)
    c7  =  length (filter is7 s)

main :: IO ()
main = do
    s1 <- getLine
    s2 <- getLine
    print (solve s1 s2)

s [a, b] = f ('4', '7') `max`  f ('7', '4')
  where f x = length $ filter (==x) $ zip a b
main = interact $ show . s . words

solve a = f ('4','7') `max` f ('7','4')
    where f x = length$filter (==x) $ head a `zip` last a

main=interact$show.solve.lines

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    a <- readString
    b <- readString
    return (BS.unpack a, BS.unpack b)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve (x, y) = max cnt47 cnt74
  where
    pairs = zip x y
    cnt47 = length $ filter (== ('4', '7')) pairs
    cnt74 = length $ filter (== ('7', '4')) pairs

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((&&&))

main :: IO ()
main = print =<< solve <$> (zip <$> getLine <*> getLine)

solve :: [(Char, Char)] -> Int
solve = uncurry max <$> (count ('7', '4') &&& count ('4', '7'))

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

g :: String -> String -> (Int, Int) -> Int
g [] [] (p, q) = max p q
g ('4':as) ('4':bs) (p, q) = g as bs (p, q)
g ('4':as) ('7':bs) (p, q) = g as bs (p+1, q)
g ('7':as) ('4':bs) (p, q) = g as bs (p, q+1)
g ('7':as) ('7':bs) (p, q) = g as bs (p, q)

main :: IO ()
main = do
  a <- getLine
  b <- getLine
  print $ g a b (0, 0)

import Control.Applicative
import Data.ByteString(ByteString)
import qualified Data.ByteString.Char8 as B

main = do a <- B.getLine
          b <- B.getLine
          print $ solve a b

solve :: ByteString -> ByteString -> Int
solve a b = (d+) $ div (n-d) 2
   where la4 = B.length $ B.filter ('4'==) a
         lb4 = B.length $ B.filter ('4'==) b
         d = abs $ la4 - lb4
         n = length $ filter id $ B.zipWith (/=) a b

module Main where

import Data.List

main = interact $ show . uncurry max . foldl' (\(x, y) [a, b] ->
    if a /= b
        then if a == '4'
            then (x + 1, y)
            else (x, y + 1)
        else (x, y)) (0, 0) . transpose . lines

module Main where

import Data.List

main = interact $ show . uncurry max . foldl (\(x, y) [a, b] ->
    if a /= b
        then if a == '4'
            then (x + 1, y)
            else (x, y + 1)
        else (x, y)) (0, 0) . transpose . lines

x#y=x+y-min x y
s[a,b]=c(<)#c(>)where c f=length.filter id$zipWith f a b
main=interact$show.s.lines

s[a,b]=c(<)`max`c(>)where c f=length.filter id$zipWith f a b
main=interact$show.s.lines

import Data.Char
parse = map (map digitToInt) . lines

solve [a, b] = loop a b 0 0

loop [] [] at ta = max at ta
loop (4:x) (7:y) at ta = loop x y (1 + at) ta
loop (7:x) (4:y) at ta = loop x y at (1 + ta)
loop (_:x) (_:y) at ta = loop x y at ta

main = (print . solve . parse =<< getContents)

count :: (Eq a) => a -> [a] -> Int
count _ [] = 0
count x (a:as) =
    if a == x
    then
        1 + count x as
    else
        count x as

countsev = count '7'

mismatches :: (Eq a) => [a] -> [a] -> Int
mismatches [] [] = 0
mismatches (a:as) (b:bs) =
    if a /= b
    then
        1 + mismatches as bs
    else
        mismatches as bs

addsevens :: Int -> [Char] -> [Char] -> [Char]
addsevens 0 f _ = f
addsevens rem (f:fewer) (m:more) =
    if f == '4' && m == '7'
    then
        '7' : addsevens (rem-1) fewer more
    else
        f : addsevens rem fewer more

operations :: [Char] -> [Char] -> Int
operations as bs =
    difference + (div swaps 2)
      where difference = abs $ (countsev as) - (countsev bs)
            swaps = mismatches (addsevens difference left right) right
                where (left, right) = if countsev as < countsev bs
                                      then (as, bs) else (bs, as)

main = do
    as <- getLine
    bs <- getLine
    putStrLn $ show $ operations as bs

import Debug.Trace

getAns a b = max n m
  where unequal = filter (\(x, y) -> x /= y) $ zip a b
        n = length $ filter (\(x, y) -> x == '7') unequal
        m = length $ filter (\(x, y) -> x == '4') unequal

main = do
  a <- getLine
  b <- getLine
  putStrLn $ show $ getAns a b

s [a, b] = f ('4', '7') `max` f ('7', '4')
  where f z = length $ filter (==z) $ zip a b
main = interact $ show . s . words

import Data.List
import Control.Applicative

main = do a <- map (read.return) <$> getLine
          b <- map (read.return) <$> getLine
          print $ solve a b

solve :: [Int] -> [Int] -> Int
solve a b
  | la4 == lb4 = div n 2
  | otherwise  = (d+) $ div (n-d) 2
   where (a4,a7) = partition (4==) a
         (b4,b7) = partition (4==) b
         la4 = length a4
         lb4 = length b4
         d = abs $ la4 - lb4
         n = length $ filter id $ zipWith (/=) a b

solve::String->String->Int
solve a b
    | a == []                 = 0
    | head a == head b        = solve (tail a) (tail b)
    | length a == 1           = 1
    | head a == b!!1 && head b == a!!1 = 1+(solve (tail.tail$a) (tail.tail$b))
    | a /= b                   = 1+solve (tail a) (tail b)

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

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    a <- readString
    b <- readString
    return (BS.unpack a, BS.unpack b)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve (x, y) = go x y
  where
    go [] [] = 0
    go (x:xs) (y:ys) | x == y = go xs ys
    go [x] [y] = 1
    go (x0:x:xs) (_:y:ys)
        | x == y    = go (x:xs) (y:ys) + 1
        | x0 == x   = go (x:xs) (y:ys) + 1
        | otherwise = go xs ys + 1 -- swap
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State


Vasya has several phone books, in which he recorded the telephone numbers of his friends. Each of his friends can have one or several phone numbers.Vasya decided to organize information about the phone numbers of friends. You will be given n strings — all entries from Vasya's phone books. Each entry starts with a friend's name. Then follows the number of phone numbers in the current entry, and then the phone numbers themselves. It is possible that several identical phones are recorded in the same record.Vasya also believes that if the phone number a is a suffix of the phone number b (that is, the number b ends up with a), and both numbers are written by Vasya as the phone numbers of the same person, then a is recorded without the city code and it should not be taken into account.The task is to print organized information about the phone numbers of Vasya's friends. It is possible that two different people have the same number. If one person has two numbers x and y, and x is a suffix of y (that is, y ends in x), then you shouldn't print number x. If the number of a friend in the Vasya's phone books is recorded several times in the same format, it is necessary to take it into account exactly once.Read the examples to understand statement and format of the output better.

First line contains the integer n (1 ≤ n ≤ 20) — number of entries in Vasya's phone books.  The following n lines are followed by descriptions of the records in the format described in statement. Names of Vasya's friends are non-empty strings whose length does not exceed 10. They consists only of lowercase English letters. Number of phone numbers in one entry is not less than 1 is not more than 10. The telephone numbers consist of digits only. If you represent a phone number as a string, then its length will be in range from 1 to 10. Phone numbers can contain leading zeros.

Print out the ordered information about the phone numbers of Vasya's friends. First output m — number of friends that are found in Vasya's phone books. The following m lines must contain entries in the following format "name number_of_phone_numbers phone_numbers". Phone numbers should be separated by a space. Each record must contain all the phone numbers of current friend. Entries can be displayed in arbitrary order, phone numbers for one record can also be printed in arbitrary order.

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.Map as M
import qualified Data.Set as S

main = B.interact exec
exec = evalState app . B.words
app = do
  n <- poi
  dir <- replicateM n $ do
    name <- pop
    k <- poi
    ts <- replicateM k pop
    return (name, ts)
  let r = solve dir
  return $ B.unlines $ ((B.pack $ show (length r)):) $ map (\(na, ts) -> B.unwords $ [na, B.pack $ show (length ts)] ++ ts) r
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap (maybe undefined fst . B.readInt) pop

solve dir
  = map (\(n, ts0) -> (n, map (B.reverse . fst) $ filter (\(c, p) -> not $ c `B.isPrefixOf` p) $ (\ts -> zip ts (B.pack "":ts)) $ S.toDescList ts0))
  $ M.assocs
  $ M.fromListWith S.union $ map (\(n, ts) -> (n, S.fromList $ map B.reverse ts)) dir

import Data.List
import Control.Monad
import qualified Data.Map as M

readData :: IO (String, [String])
readData = do
    line <- getLine
    let ws = words line
    return (head ws, drop 2 ws)

readInt :: IO Int
readInt = read `fmap` getLine

printVal :: (String, [String]) -> IO ()
printVal (a, ls) = do
    let start = a ++ " " ++ show (length ls)
    let res = intercalate " " ls
    putStrLn (start ++ " " ++ res)

main :: IO ()
main = do
    n <- readInt
    ls <- replicateM n readData
    let friends = (M.fromListWith (++) ls) :: M.Map String [String]
    let friends' = M.map (\l -> let l' = nub l in filter (\x-> all (\y -> x == y || not (x `isSuffixOf` y)) l') l') friends
    let ls = M.toList friends'
    print (length ls)
    mapM_ printVal ls

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words, unpack, reverse, dropWhile)
import qualified Data.Maybe as M (fromJust)
import qualified Data.Char as C (isSpace)
import qualified Data.List as L (sort, nub, isPrefixOf)
import qualified Control.Monad as M (forM, forM_)
import qualified Data.Map.Strict as MP (fromListWith, map, assocs, size)

readInt = fst . M.fromJust . C.readInt
rstrip = C.reverse . C.dropWhile C.isSpace . C.reverse

run (L.nub . L.sort . map reverse -> xs) = map reverse $ (last xs) : pp where
    pp = map snd $ filter (\(a, b) -> not (b `L.isPrefixOf` a)) (zip (tail xs) xs)

main = do
    (map readInt . C.words -> [n]) <- B.getLine
    (MP.map run . MP.fromListWith (++) -> mp) <- M.forM [1..n] $ \_ -> do
        (map (C.unpack . rstrip) . C.words -> name : xs) <- B.getLine
        return (name, tail xs)
    putStrLn $ show (MP.size mp)
    M.forM_ (MP.assocs mp) $ \(a, b) ->
        putStrLn $ a ++ " " ++ show (length b) ++ " " ++ unwords b

import Data.Maybe
import Data.Function
import Data.List
import qualified Data.HashMap.Strict as M

main = interact $ unlines . parse . tail . lines

type MM = M.HashMap String [String]

parse ls = let
    lss = map words ls :: [[String]]
    m = M.toList $ foldl (\m (n:_:ns) ->
                M.insert n (ns++M.lookupDefault [] n m) m) M.empty lss
    m' = map ((uncurry sol).(\(n,ns)->(n,sortBy (compare `on` length) ns))) m
    m'' = map (\(n,ns)-> intercalate " " (n:(show $ length ns):ns)) m'
  in (show$ length m''):m''

sol nn [] = (nn, [])
sol nn (n:ns) = let
    (_,ns') = sol nn ns
    nns = case find (\n'-> n `isSuffixOf` n') ns' of
              Just _ -> ns'
              Nothing -> n : ns'
  in (nn, nns)
--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)
--------------------------------------------------------------------------------

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
import Data.Function

main = B.interact exec
exec = evalState app . B.words
app = do
  n <- poi
  dir <- replicateM n $ do
    name <- pop
    k <- poi
    ts <- replicateM k pop
    return (name, ts)
  let r = solve dir
  return $ B.unlines $ ((B.pack $ show (length r)):) $ map (\(na, ts) -> B.unwords $ [na, B.pack $ show (length ts)] ++ ts) r
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap (maybe undefined fst . B.readInt) pop

solve dir = map (\(n, ts) -> (n, map (B.reverse . maximumBy (compare `on` B.length)) $ groupBy B.isPrefixOf $ S.toList ts)) $ M.assocs $ M.fromListWith S.union $ map (\(n, ts) -> (n, S.fromList $ map B.reverse ts)) dir

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List

main = B.interact exec
exec = evalState app . B.words
app = do
  n <- poi
  dir <- replicateM n $ do
    name <- pop
    k <- poi
    ts <- replicateM k pop
    return (name, ts)
  let r = solve dir
  return $ B.unlines $ ((B.pack $ show (length r)):) $ map (\(na, ts) -> B.unwords $ [na, B.pack $ show (length ts)] ++ ts) r
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap (maybe undefined fst . B.readInt) pop

solve dir = map (\(n, ts) -> (n, map (B.reverse .  last) $ groupBy B.isPrefixOf $ S.toList ts)) $ M.assocs $ M.fromListWith S.union $ map (\(n, ts) -> (n, S.fromList $ map B.reverse ts)) dir

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.Map as M
import qualified Data.Set as S

main = B.interact exec
exec = evalState app . B.words
app = do
  n <- poi
  dir <- replicateM n $ do
    name <- pop
    k <- poi
    ts <- replicateM k pop
    return (name, ts)
  let r = solve dir
  return $ B.unlines $ ((B.pack $ show (length r)):) $ map (\(na, ts) -> B.unwords $ [na, B.pack $ show (length ts)] ++ ts) r
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap (maybe undefined fst . B.readInt) pop

solve dir
  = map (\(n, ts0) -> (n, map fst $ filter (\(c, p) -> not $ c `B.isPrefixOf` p) $ (\ts -> zip ts (B.pack "":ts)) $ S.toDescList ts0))
  $ M.assocs
  $ M.fromListWith S.union $ map (\(n, ts) -> (n, S.fromList $ map B.reverse ts)) dir

import Data.List
import Control.Monad
import qualified Data.Map as M

readData :: IO (String, [String])
readData = do
    line <- getLine
    let ws = words line
    return (head ws, drop 2 ws)

readInt :: IO Int
readInt = read `fmap` getLine

printVal :: (String, [String]) -> IO ()
printVal (a, ls) = do
    let start = a ++ " " ++ show (length ls)
    let res = intercalate " " ls
    putStrLn (start ++ " " ++ res)

main :: IO ()
main = do
    n <- readInt
    ls <- replicateM n readData
    let friends = (M.fromListWith (++) ls) :: M.Map String [String]
    let friends' = M.map (\l -> let l' = nub l in filter (\x-> all (\y -> x == y || not (x `isSuffixOf` y)) l') l') friends
    let ls = M.toList friends'
    mapM_ printVal ls


Peter got a new snow blower as a New Year present. Of course, Peter decided to try it immediately. After reading the instructions he realized that it does not work like regular snow blowing machines. In order to make it work, you need to tie it to some point that it does not cover, and then switch it on. As a result it will go along a circle around this point and will remove all the snow from its path.Formally, we assume that Peter's machine is a polygon on a plane. Then, after the machine is switched on, it will make a circle around the point to which Peter tied it (this point lies strictly outside the polygon). That is, each of the points lying within or on the border of the polygon will move along the circular trajectory, with the center of the circle at the point to which Peter tied his machine.Peter decided to tie his car to point P and now he is wondering what is the area of the region that will be cleared from snow. Help him.

The first line of the input contains three integers — the number of vertices of the polygon n (), and coordinates of point P. Each of the next n lines contains two integers — coordinates of the vertices of the polygon in the clockwise or counterclockwise order. It is guaranteed that no three consecutive vertices lie on a common straight line. All the numbers in the input are integers that do not exceed 1 000 000 in their absolute value.

Print a single real value number — the area of the region that will be cleared. 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 sample snow will be removed from that area:

module Main where

import Control.Monad
import Control.Monad.State
import Data.Maybe (fromJust)
import Text.Printf (printf)
import qualified Data.ByteString.Lazy.Char8 as L

type Point = (Double, Double)

add, sub :: Point -> Point -> Point
add (a, b) (u, v) = (a + u, b + v)
sub (a, b) (u, v) = (a - u, b - v)

scale :: Point -> Double -> Point
scale (a, b) s = (a * s, b * s)

distance :: Point -> Double
distance (a, b) = sqrt $ a * a + b * b

dot :: Point -> Point -> Double
dot (a, b) (u, v) = a * u + b * v

projection :: Point -> Point -> Point -> Point
projection p a b | offset < 0  = a
                 | offset > sl = b
                 | otherwise   = a `add` (ba `scale` (offset / sl))
    where ba = sub b a
          pa = sub p a
          sl = distance ba

          offset = (dot pa ba) / sl

getMaxDist :: Point -> [Point] -> Double
getMaxDist p = maximum . map (distance . sub p)

getMinDist :: Point -> [Point] -> Double
getMinDist p ps = minimum $ zipWith distToSegment ps (tail ps ++ [head ps])
    where distToSegment a b =  distance $ p `sub` q
              where q = projection p a b

solve :: Point -> [Point] -> Double
solve p ps = pi * (hi - lo) * (hi + lo)
    where lo = getMinDist p ps
          hi = getMaxDist p ps

test0 = ((0, 0), [(0, 1), (-1, 2), (1, 2)])
test1 = ((1, -1), [(0, 0), (1, 2), (2, 0), (1, 1)])
runTests = map (uncurry solve) [test0, test1]

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> (fst . fromJust $ L.readInt s, ss)

nextDouble :: Tokenizer Double
nextDouble = liftM fromIntegral nextInt

nextPoint :: Tokenizer Point
nextPoint = liftM2 (,) nextDouble nextDouble

go :: Tokenizer Double
go = do
  n  <- nextInt
  p  <- nextPoint
  ps <- replicateM n nextPoint
  return $ solve p ps

main :: IO ()
main = do
  input <- liftM L.words L.getContents
  let result = evalState go input
  printf "%.6f\n" result

import           Control.Monad
import           Data.List
import           Data.Int

main :: IO ()
main = do
    [n, px, py] <- map read . words <$> getLine :: IO [Int64]
    ps          <- map (\[x, y] -> (x - fromIntegral px, y - fromIntegral py))
        <$> replicateM (fromIntegral n) (map (fromIntegral . read) . words <$> getLine)
    let maxDis = maximum $ map (uncurry dis) ps
        minDis = minimum $ zipWith (curry getMinDis) ps (tail $ cycle ps)
    print $ pi * (maxDis - minDis)

dis :: Double -> Double -> Double
dis x y = x ^ 2 + y ^ 2

getMinDis ((x, y), (x', y'))
    | lambda <= 0 = dis x y
    | lambda >= 1 = dis x' y'
    | otherwise   = dis (x + lambda * (x' - x)) (y + lambda * (y' - y))
    where lambda = ((x - x') * x + (y - y') * y) / dis (x' - x) (y' - y)

import           Control.Monad
import           Data.List
import           Control.Arrow

main :: IO ()
main = do
    [n, px, py] <- map read . words <$> getLine
    ps          <- replicateM n (map read . words <$> getLine)
    let (minDis, maxDis) =
            (minimum &&& maximum) $ map (\[x, y] -> (px - x) ^ 2 + (py - y) ^ 2) ps
    print $ pi * fromIntegral (maxDis - minDis)

import           Control.Monad
import           Data.List
import           Control.Arrow

main :: IO ()
main = do
    [n, px, py] <- map read . words <$> getLine
    ps          <- map (\[x, y] -> (x - px, y - py))
        <$> replicateM n (map read . words <$> getLine)
    let dis x y = fromIntegral $ x ^ 2 + y ^ 2
        maxDis = fromIntegral $ maximum $ map (\(x, y) -> x ^ 2 + y ^ 2) ps
        minDis =
            minimum $ zipWith
                (curry
                    (\((x, y), (x', y')) -> if dis x y == dis x' y'
                        then fromIntegral ((x' * y - y' * x) ^ 2) / dis (x' - x) (y' - y)
                        else min (dis x y) (dis x' y')
                    )
                )
                ps
                (tail $ cycle ps) :: Double
    print (minDis, maxDis)
    print $ pi * (maxDis - minDis)

import           Control.Monad
import           Data.List
import           Data.Int

main :: IO ()
main = do
    [n, px, py] <- map read . words <$> getLine :: IO [Int64]
    ps          <- map (\[x, y] -> (x - px, y - py))
        <$> replicateM (fromIntegral n) (map (fromIntegral . read) . words <$> getLine)
    let dis x y = fromIntegral $ x ^ 2 + y ^ 2
        maxDis = fromIntegral $ maximum $ map (\(x, y) -> x ^ 2 + y ^ 2) ps
        minDis =
            minimum $ zipWith
                (curry
                    (\((x, y), (x', y')) -> if dis x y == dis x' y'
                        then fromIntegral ((x' * y - y' * x) ^ 2) / dis (x' - x) (y' - y)
                        else min (dis x y) (dis x' y')
                    )
                )
                ps
                (tail $ cycle ps) :: Double
    print $ pi * (maxDis - minDis)

import           Control.Monad
import           Data.List
import           Control.Arrow

main :: IO ()
main = do
    [n, px, py] <- map read . words <$> getLine
    ps          <- map (\[x, y] -> (x - px, y - py))
        <$> replicateM n (map read . words <$> getLine)
    let dis x y = fromIntegral $ x ^ 2 + y ^ 2
        maxDis = fromIntegral $ maximum $ map (\(x, y) -> x ^ 2 + y ^ 2) ps
        minDis =
            minimum $ zipWith
                (curry
                    (\((x, y), (x', y')) -> if dis x y == dis x' y'
                        then fromIntegral ((x' * y - y' * x) ^ 2) / dis (x' - x) (y' - y)
                        else min (dis x y) (dis x' y')
                    )
                )
                ps
                (tail $ cycle ps) :: Float
    print (minDis, maxDis)
    print $ pi * (maxDis - minDis)

import           Control.Monad
import           Data.List
import           Control.Arrow

main :: IO ()
main = do
    [n, px, py] <- map read . words <$> getLine
    ps          <- map (\[x, y] -> (x - px, y - py))
        <$> replicateM n (map read . words <$> getLine)
    let dis x y = fromIntegral $ x ^ 2 + y ^ 2
        maxDis = fromIntegral $ maximum $ map (\(x, y) -> x ^ 2 + y ^ 2) ps
        minDis =
            minimum $ zipWith
                (curry
                    (\((x, y), (x', y')) -> if dis x y == dis x' y'
                        then fromIntegral ((x' * y - y' * x) ^ 2) / dis (x' - x) (y' - y)
                        else min (dis x y) (dis x' y')
                    )
                )
                ps
                (tail $ cycle ps) :: Double
    print $ pi * (maxDis - minDis)


The Smart Beaver from ABBYY began to develop a new educational game for children. The rules of the game are fairly simple and are described below.The playing field is a sequence of n non-negative integers ai numbered from 1 to n. The goal of the game is to make numbers a1, a2, ..., ak (i.e. some prefix of the sequence) equal to zero for some fixed k (k < n), and this should be done in the smallest possible number of moves.One move is choosing an integer i (1 ≤ i ≤ n) such that ai > 0 and an integer t (t ≥ 0) such that i + 2t ≤ n. After the values of i and t have been selected, the value of ai is decreased by 1, and the value of ai + 2t is increased by 1. For example, let n = 4 and a = (1, 0, 1, 2), then it is possible to make move i = 3, t = 0 and get a = (1, 0, 0, 3) or to make move i = 1, t = 1 and get a = (0, 0, 2, 2) (the only possible other move is i = 1, t = 0).You are given n and the initial sequence ai. The task is to calculate the minimum number of moves needed to make the first k elements of the original sequence equal to zero for each possible k (1 ≤ k < n).

The first input line contains a single integer n. The second line contains n integers ai (0 ≤ ai ≤ 104), separated by single spaces. The input limitations for getting 20 points are:    1 ≤ n ≤ 300  The input limitations for getting 50 points are:    1 ≤ n ≤ 2000  The input limitations for getting 100 points are:    1 ≤ n ≤ 105

Print exactly n - 1 lines: the k-th output line must contain the minimum number of moves needed to make the first k elements of the original sequence ai equal to zero. Please do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams, or the %I64d specifier.

main::IO()
main =
    do cs <- getContents
       (putStr.showSolve.solve.parseIn) cs

parseIn::String->(Int,[Integer])
parseIn s = (n,an)
    where
      (ns:l:_) = lines s
      n = read ns
      an = map read $ words l

showSolve ::[Integer]->String
showSolve [] = ""
showSolve [x] = show x
showSolve (x:xs) = show x ++ "\n"++  showSolve xs

pow2seq=map (\x -> 2^x) [0..]

getPlusedIndex s p = last $ takeWhile (\x -> x < s) $ map (+ p) pow2seq

updateList::[Integer]->Int->Integer->[Integer]
updateList [] _ _ = []
updateList (a:as) 0 x = (a+x):as
updateList (a:as) n x = a:(updateList as (n-1) x)

solveSeq::[Integer]->[Integer]->Int->Int->[Integer]
solveSeq _ ret _ 0 = ret
solveSeq _ ret _ 1 = ret
solveSeq l ret size n = solveSeq ln retn size (n-1)
    where
      p = size - n
      c = l!!p
      next = getPlusedIndex size p
      ln   = updateList l next c
      retn = updateList ret p c

plusReduce::[Integer]->[Integer]
plusReduce [] = []
plusReduce (x:xs) = x:(map (+x) $ plusReduce xs)

solve::(Int,[Integer])->[Integer]
solve (n,ps) = cnts
    where
      cnts = plusReduce $ solveSeq ps (take (n-1) [0,0..]) n n


Vasya has recently got a job as a cashier at a local store. His day at work is $$$L$$$ minutes long. Vasya has already memorized $$$n$$$ regular customers, the $$$i$$$-th of which comes after $$$t_{i}$$$ minutes after the beginning of the day, and his service consumes $$$l_{i}$$$ minutes. It is guaranteed that no customer will arrive while Vasya is servicing another customer. Vasya is a bit lazy, so he likes taking smoke breaks for $$$a$$$ minutes each. Those breaks may go one after another, but Vasya must be present at work during all the time periods he must serve regular customers, otherwise one of them may alert his boss. What is the maximum number of breaks Vasya can take during the day?

Output one integer  — the maximum number of breaks.

NoteIn the first sample Vasya can take $$$3$$$ breaks starting after $$$2$$$, $$$5$$$ and $$$8$$$ minutes after the beginning of the day.In the second sample Vasya can take $$$2$$$ breaks starting after $$$0$$$ and $$$2$$$ minutes after the beginning of the day.In the third sample Vasya can't take any breaks.

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

readIntBS = fst . fromJust . BS.readInt

main = do
  [n,l,a] <- map read . words <$> getLine :: IO [Int]
  dat <- map (map readIntBS . BS.words) . BS.lines <$> BS.getContents :: IO [[Int]]

  let dat' = ([0,0] : dat) ++ [[l,0]]

  print $ sum [(j-(i+k))`div`a | ([i,k], [j,_]) <- zip dat' (tail dat')]

-- Codeforces 1059A
import Data.List

countBreaks :: Int -> [Int] -> [Int] -> Int
countBreaks breakLength startTime endTime = sum countList
    where breakList = zipWith (-) startTime endTime
          countList = map (`div` breakLength) breakList

mapStartTime :: [Int] -> Int -> [Int]
mapStartTime starts end = starts ++ [end]

mapEndTime :: [Int] -> [Int] -> [Int]
mapEndTime starts durations = 0:zipWith (+) starts durations

main :: IO ()
main = do
    [n, l, a] <- getLine >>= return.(map read::[String]->[Int]).words
    [start, duration] <-
            if n == 0 then return [[], []]
            else do getContents >>=
                        return.(map $ map read).transpose.(map words).(take n).lines :: IO [[Int]]
    let startTime = mapStartTime start l
    let endTime   = mapEndTime start duration
    putStrLn $ show $ countBreaks a startTime endTime


Shohag has an integer sequence $$$a_1, a_2, \ldots, a_n$$$. He can perform the following operation any number of times (possibly, zero):  Select any positive integer $$$k$$$ (it can be different in different operations).  Choose any position in the sequence (possibly the beginning or end of the sequence, or in between any two elements) and insert $$$k$$$ into the sequence at this position.  This way, the sequence $$$a$$$ changes, and the next operation is performed on this changed sequence. For example, if $$$a=[3,3,4]$$$ and he selects $$$k = 2$$$, then after the operation he can obtain one of the sequences $$$[\underline{2},3,3,4]$$$, $$$[3,\underline{2},3,4]$$$, $$$[3,3,\underline{2},4]$$$, or $$$[3,3,4,\underline{2}]$$$.Shohag wants this sequence to satisfy the following condition: for each $$$1 \le i \le |a|$$$, $$$a_i \le i$$$. Here, $$$|a|$$$ denotes the size of $$$a$$$.Help him to find the minimum number of operations that he has to perform to achieve this goal. We can show that under the constraints of the problem it's always possible to achieve this goal in a finite number of operations.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 200$$$)  — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 100$$$) — the initial length of the sequence. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the elements of the sequence.

For each test case, print a single integer  — the minimum number of operations needed to perform to achieve the goal mentioned in the statement.

NoteIn the first test case, we have to perform at least one operation, as $$$a_2=3>2$$$. We can perform the operation $$$[1, 3, 4] \rightarrow [1, \underline{2}, 3, 4]$$$ (the newly inserted element is underlined), now the condition is satisfied.In the second test case, Shohag can perform the following operations:$$$[1, 2, 5, 7, 4] \rightarrow [1, 2, \underline{3}, 5, 7, 4] \rightarrow [1, 2, 3, \underline{4}, 5, 7, 4] \rightarrow [1, 2, 3, 4, 5, \underline{3}, 7, 4]$$$.In the third test case, the sequence already satisfies the condition.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

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.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool

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

data TC = TC { n :: Int, as :: [Int] }

input :: Scanner TC
input = do
  n <- int
  as <- n >< int
  return TC {..}

type Output = Int

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

solve :: TC -> Output
solve TC {..} = rec as 1
  where
    rec [] _ = 0
    rec (x:xs) i = (if x <= i then 0 else x - i) + rec xs (max x i + 1)

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


A non-empty string s is called binary, if it consists only of characters "0" and "1". Let's number the characters of binary string s from 1 to the string's length and let's denote the i-th character in string s as si.Binary string s with length n is periodical, if there is an integer 1 ≤ k < n such that:   k is a divisor of number n  for all 1 ≤ i ≤ n - k, the following condition fulfills: si = si + k For example, binary strings "101010" and "11" are periodical and "10" and "10010" are not.A positive integer x is periodical, if its binary representation (without leading zeroes) is a periodic string.Your task is to calculate, how many periodic numbers are in the interval from l to r (both ends are included).

The single input line contains two integers l and r (1 ≤ l ≤ r ≤ 1018). The numbers are separated by a space. Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

Print a single integer, showing how many periodic numbers are in the interval from l to r (both ends are included).

NoteIn the first sample periodic numbers are 3, 7 and 10.In the second sample periodic numbers are 31 and 36.

base b = map (`mod`b) . takeWhile (>0) . iterate (`div`b)

bitLength n = until ((>n) . (2^)) succ 0

period r n = max 0 $ u - div b 2 + 1
  where
    b = 2 ^ r
    d = base b n
    u = let (h:t) = reverse d in unit h t
    unit a []    = a
    unit a (h:t) =
      case compare h a of
        LT -> a - 1
        EQ -> unit a t
        GT -> a

periods n = d
  where
    w = bitLength n
    c = 0: map (`period` n) [1 .. w]
    d = 0: map f [1 .. w]
    f r
      | mod w r > 0 = 0
      | otherwise   = c!!r - sum [d!!i | i <- [1 .. r - 1], mod r i == 0]

count n = sum $ concatMap (init . periods) $ n: [2^i-1 | i <- [1 .. w - 1]]
  where
    w = bitLength n

main = do
  [l, r] <- fmap (map read . words) getLine
  print $ count r - count (l - 1)

base b = map (`mod`b) . takeWhile (>0) . iterate (`div`b)

bitLength n = until ((>n) . (2^)) succ 0

period r n = max 0 $ u + 1 - div b 2
  where
    b = 2 ^ r
    d = base b n
    u = let (h:t) = reverse d in unit h t
    unit a []    = a
    unit a (h:t) = if a > h then a - 1 else unit a t

periods n = d
  where
    w = bitLength n
    c = 0: map (`period` n) [1 .. w - 1]
    d = 0: map f [1 .. w - 1]
    f r = c!!r - sum [d!!i | i <- [1 .. r - 1], div r i == 0]

count n = sum $ periods n ++ [sum $ periods m | m <- map (pred . (2^)) [1 .. w - 1]]
  where
    w = bitLength n

main = do
  [l, r] <- fmap (map read . words) getLine
  print $ count r - count (l - 1)

base b = map (`mod`b) . takeWhile (>0) . iterate (`div`b)

bitLength n = until ((>n) . (2^)) succ 0

period r n = max 0 $ u + 1 - div b 2
  where
    b = 2 ^ r
    d = base b n
    u = let (h:t) = reverse d in unit h t
    unit a []    = a
    unit a (h:t) = if a > h then a - 1 else unit a t

periods n = sum d
  where
    w = bitLength n
    c = 0: map (`period` n) [1 .. w - 1]
    d = 0: map f [1 .. w - 1]
    f r = if c!!r == 0 then 0 else c!!r - sum [d!!i | i <- [1 .. r - 1], mod r i == 0]

count n = sum $ periods n: [periods m | m <- map (pred . (2^)) [1 .. w - 1]]
  where
    w = bitLength n

main = do
  [l, r] <- fmap (map read . words) getLine
  print $ count r - count (l - 1)


Valery is very interested in magic. Magic attracts him so much that he sees it everywhere. He explains any strange and weird phenomenon through intervention of supernatural forces. But who would have thought that even in a regular array of numbers Valera manages to see something beautiful and magical.Valera absolutely accidentally got a piece of ancient parchment on which an array of numbers was written. He immediately thought that the numbers in this array were not random. As a result of extensive research Valera worked out a wonderful property that a magical array should have: an array is defined as magic if its minimum and maximum coincide.He decided to share this outstanding discovery with you, but he asks you for help in return. Despite the tremendous intelligence and wit, Valera counts very badly and so you will have to complete his work. All you have to do is count the number of magical subarrays of the original array of numbers, written on the parchment. Subarray is defined as non-empty sequence of consecutive elements.

The first line of the input data contains an integer n (1 ≤ n ≤ 105). The second line contains an array of original integers a1, a2, ..., an ( - 109 ≤ ai ≤ 109).

Print on the single line the answer to the problem: the amount of subarrays, which are magical. Please do not use the %lld specificator to read or write 64-bit numbers in C++. It is recommended to use cin, cout streams (you can also use the %I64d specificator).

NoteNotes to sample tests:Magical subarrays are shown with pairs of indices [a;b] of the beginning and the end.In the first sample: [1;1], [2;2], [3;3], [4;4], [2;3].In the second sample: [1;1], [2;2], [3;3], [4;4], [5;5], [1;2], [2;3], [1;3].

module Main where

import List

parseInt :: String -> Int
parseInt token = read token :: Int

subArrays :: Int -> Integer
subArrays x = n * (n + 1) `div` 2
              where n = toInteger x

solve :: [Int] -> Integer
solve = sum . map (subArrays . length) . group

main = interact (show . solve . map parseInt . tail . words)

module Main where

import Data.Char;

main = do
  s <- getLine
  interact in2out

in2out input
  = output
  where
    nums :: [Integer]
    nums = map read $ words input
    output = show $ count nums (10^9+1) 0 0
    count [] _ cx ans
      = cx + ans
    count (x:xs) px cx ans
      = count xs x cx' $! cx+ans
      where
        cx'
          | x == px
          = cx + 1
          | otherwise
          = 1

import List (group)
import Monad (liftM)

solve :: [Int] -> Integer
solve  =  sum . map (f . fromIntegral . length) . group
  where
    f :: Integer -> Integer
    f n  =  div (n * (n + 1)) 2

main :: IO ()
main  =  getLine >> liftM (map read . words) getLine >>= print . solve

import Data.List
main = getLine >> (group . words) `fmap` getLine >>=
       print . foldl' (\x n -> x + n*(n+1) `div` 2) 0 . map (fromIntegral . length)

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

f :: Integer -> Integer -> Integer
f x n = seq y (x + y)
    where y = n * (n+1) `div` 2

main = do
    getLine
    xs <- map read . words <$> getLine :: IO [Integer]
    print $ foldl' f 0 $ map (fromIntegral . length) $ group xs

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    replicateM n readInt
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = do
    a <- evalState parseInput <$> BS.getContents
    print $ solve a

solve :: [Int] -> Int64
solve a = sum .  map (\x -> (fromIntegral x * (fromIntegral x + 1) `div` 2) ) . map length $ group a

--{{{ Start of a minimal State Monad
class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State
--}}} end of a minimal State Monad

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

module Main where

import Data.List
import Data.Ord
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Set(Set)
import qualified Data.Set as Set
import Control.Applicative
import Control.Monad
import Data.Bits

main = do
    [n::Integer] <- map read . words <$> getLine
    (numbers::[Integer]) <- map read . words <$> getLine
    let sizes = map genericLength (group numbers) :: [Integer]
    let solve size = (size+1) * size `div` 2
    putStrLn $ show $ sum $ map solve sizes

import Data.List (genericLength)

decompose [] = []
decompose (x:xs) =
  case span (== x) (x:xs) of
    (a, b) -> a:(decompose b)

solve :: [Integer] -> Integer
solve xs = sum $ map (\x -> x * (x + 1) `div` 2) $ map genericLength (decompose xs)

main = do _ <- getLine
          line <- getLine
          putStrLn $ show $ solve $ map (read :: String -> Integer) (words line)

import Data.List (genericLength, group)
solve xs = sum $ map (\x -> (x + 1) * x `div` 2) $ map genericLength $ group xs
main = interact $ show . solve . tail . words

import List
import Control.Monad

main =
	do
		n <- getLine
		l <- liftM (\x -> map read $ words x) getLine
		putStrLn $ show $ foldl (\x y -> x + y * (y+1) `div` 2) 0 (map fromIntegral (map length $ group (l::[Int])))

import Data.List
import Data.Int
main = do
    n <- read `fmap` getLine :: IO Int
    l <- (map read . words) `fmap` getLine :: IO [Int32]
    putStr $ show $ sum $ map (\x -> let k = (fromIntegral (length x) :: Integer) in
			k * (k + 1) `div` 2) $ group l

readd line = map (\x-> (read x)::Int) $ parsespace line

parsespace' res cur [] = cur:res
parsespace' res cur (a:xs) =
  if a == ' ' then
   parsespace' (cur:res) [] xs
  else
   parsespace' res (cur++[a]) xs

parsespace line = filter (\x->length x > 0) $ parsespace' [] [] line

magicparts' res cur last [] = cur:res
magicparts' res cur last (a:xs) =
 if a==last then
   magicparts' res (cur+1) last (xs)
 else
   magicparts' (cur:res) 1 a (xs)

magicparts arr = magicparts' [] 1 (head arr) (tail arr)

res line = foldr (+) 0 $ map (\x->x*(x+1) `div` 2) (magicparts (readd line))

main = do
  line1 <- getLine
  line <- getLine
  putStrLn (show (res line))

{-# OPTIONS_GHC -O2 #-}
import Data.List (genericLength, group)
import qualified Data.ByteString.Char8 as B
solve :: [B.ByteString] -> Integer
solve = sum . map ((\x -> x * (x+1) `quot` 2) . genericLength) . group
main = B.getLine >> B.getLine >>= putStrLn . show . solve . B.words

import Data.List (group)
solve :: [String] -> Integer
solve = sum . map (f . length) . group
    where f x = let x' = fromIntegral x in quot (x' * (x' + 1)) 2
main = getLine >> getLine >>= putStrLn . show . solve . words

import Data.List (genericLength, group)
solve :: [String] -> Integer
solve = sum . map ((\x -> x * (x+1) `quot` 2) . genericLength) . group
main = getLine >> getLine >>= putStrLn . show . solve . words

import List (group)
import Monad (liftM)

solve :: [Int] -> Int
solve  =  sum . map f . map length . group
  where
    f n  =  div (n * (n + 1)) 2

main :: IO ()
main  =  getLine >> liftM (map read . words) getLine >>= print . solve

decompose [] = []
decompose (x:xs) =
  case span (== x) (x:xs) of
    (a, b) -> a:(decompose b)

solve xs = sum $ map (\x -> x * (x + 1) `div` 2) $ map length (decompose xs)

main = do _ <- getLine
          line <- getLine
          putStrLn $ show $ solve $ map (read :: String -> Integer) (words line)

import List
import Control.Monad

main =
	do
		n <- getLine
		l <- liftM (\x -> map read $ words x) getLine
		putStrLn $ show $ foldl (\x y -> x + y * (y+1) `div` 2) 0 (map length $ group (l::[Int]))

import Data.List
import Data.Int
main = do
    n <- read `fmap` getLine :: IO Int
    l <- (map read . words) `fmap` getLine :: IO [Int32]
    putStr $ show $ sum $ map (\x -> let k = length x in k * (k + 1) `div` 2) $ group l

import Data.List
main = do
    n <- read `fmap` getLine :: IO Int
    l <- (map read . words) `fmap` getLine :: IO [Int]
    putStr $ show $ sum $ map (\x -> let k = length x in k * (k + 1) `div` 2) $ group l


During the last Sereja's Codesecrof round the server crashed many times, so the round was decided to be made unrated for some participants. Let's assume that n people took part in the contest. Let's assume that the participant who got the first place has rating a1, the second place participant has rating a2, ..., the n-th place participant has rating an. Then changing the rating on the Codesecrof site is calculated by the formula .After the round was over, the Codesecrof management published the participants' results table. They decided that if for a participant di < k, then the round can be considered unrated for him. But imagine the management's surprise when they found out that the participants' rating table is dynamic. In other words, when some participant is removed from the rating, he is removed from the results' table and the rating is recalculated according to the new table. And of course, all applications for exclusion from the rating are considered in view of the current table.We know that among all the applications for exclusion from the rating the first application to consider is from the participant with the best rank (the rank with the minimum number), for who di < k. We also know that the applications for exclusion from rating were submitted by all participants.Now Sereja wonders, what is the number of participants to be excluded from the contest rating, and the numbers of the participants in the original table in the order of their exclusion from the rating. Pay attention to the analysis of the first test case for a better understanding of the statement.

The first line contains two integers n, k (1 ≤ n ≤ 2·105,  - 109 ≤ k ≤ 0). The second line contains n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109) — ratings of the participants in the initial table.

Print the numbers of participants in the order in which they were removed from the table. Print the initial numbers of the participants, that is, the numbers that the participants had in the initial table.

NoteConsider the first test sample.  Initially the sequence of the contest participants' ratings equals [5, 3, 4, 1, 2]. You can use this sequence to calculate the sequence of rating changes: [0, -9, -13, 8, 14]. According to the problem statement, the application of the participant who won the second place will be considered first. As soon as the second place winner is out from the ratings, the participants' rating sequence will equal [5, 4, 1, 2]. By this sequence you can count the new sequence of rating changes: [0, -8, 2, 6]. According to the problem statement, the application of the participant who won the second place will be considered. Initially this participant won third place. The new rating sequence equals [5, 1, 2], the new sequence of rating changes equals [0, -1, 1]. The second place participant's application is taken into consideration, initially this participant won the fourth place. The new rating sequence equals [5, 2], the new sequence of rating changes equals [0, 0]. No more applications will be considered. Thus, you should print 2, 3, 4.

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

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

readInteger :: BS.ByteString -> Integer
readInteger s = case BS.readInteger s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Integer"

solve :: Integer -> Integer -> [Integer] -> [Integer]
solve n k a = solve' n 1 0 (zip a [1 ..])
  where solve' n i _ _ | i > n = []
        solve' n i s ((a, x):as) = if rating < k
                                   then x : solve' (n - 1) i s as
                                   else solve' n (i + 1) s' as
          where rating = s - (i - 1) * (n - i) * a
                s'     = s + a * (i - 1)

main = do
  (n:k:a) <- liftM (map readInteger . BS.words) BS.getContents
  let result = solve n k a
  BS.putStr . BS.unlines $ map (BS.pack . show) result

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

import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
main = do
    n:k:l <- map readInt . B.words <$> B.getContents
    putStr $ unlines $ map show $ solve n k l

solve :: Int -> Int -> [Int] -> [Int]
solve n k l = loop 2 0 n l
    where
        loop :: Int -> Int64 -> Int -> [Int] -> [Int]
        loop c b m (a1:a2:as)
            | d < itol k = (c+n-m):loop c b (m-1) (a1:as)
            | otherwise = loop (c+1) b' m (a2:as)
            where
                b' = b  + itol a1*itol (c-2)
                d  = b' - itol (c-1)*itol (m-c)*itol a2
        loop c b n _ = []

itol = fromIntegral

import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Int

main = do
    n:k:l <- map read . words <$> getContents
    putStr $ unlines $ map show $ solve n k l

solve :: Int -> Int -> [Int] -> [Int]
solve n k l = loop 2 0 n l
    where
        loop :: Int -> Int64 -> Int -> [Int] -> [Int]
        loop c b m (a1:a2:as)
            | d < itol k = (c+n-m):loop c b (m-1) (a1:as)
            | otherwise = loop (c+1) b' m (a2:as)
            where
                b' = b  + itol a1*itol (c-2)
                d  = b' - itol (c-1)*itol (m-c)*itol a2
        loop c b n _ = []

itol = fromIntegral

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

main = do
    n:k:l <- map read . words <$> getContents
    putStr $ unlines $ map show $ solve n k l

solve :: Int -> Int -> [Int] -> [Int]
solve n k l = loop 2 0 n l
    where
        loop c b m (a1:a2:as)
            | d < k = (c+n-m):loop c b (m-1) (a2:as)
            | otherwise = loop (c+1) b' m (a2:as)
            where
                b' = b  + a1*(c-2)
                d  = b' - (c-1)*(m-c)*a2
        loop c b n _ = []

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

main = do
    n:k:l <- map read . words <$> getContents
    putStr $ unlines $ map show $ solve n k l

solve :: Int -> Int -> [Int] -> [Int]
solve n k l = loop 2 0 n l
    where
        loop c b m (a1:a2:as)
            | d < k = (c+n-m):loop c b (m-1) (a1:as)
            | otherwise = loop (c+1) b' m (a2:as)
            where
                b' = b  + a1*(c-2)
                d  = b' - (c-1)*(m-c)*a2
        loop c b n _ = []