Summer holidays! Someone is going on trips, someone is visiting grandparents, but someone is trying to get a part-time job. This summer Noora decided that she wants to earn some money, and took a job in a shop as an assistant.Shop, where Noora is working, has a plan on the following n days. For each day sales manager knows exactly, that in i-th day ki products will be put up for sale and exactly li clients will come to the shop that day. Also, the manager is sure, that everyone, who comes to the shop, buys exactly one product or, if there aren't any left, leaves the shop without buying anything. Moreover, due to the short shelf-life of the products, manager established the following rule: if some part of the products left on the shelves at the end of the day, that products aren't kept on the next day and are sent to the dump.For advertising purposes manager offered to start a sell-out in the shop. He asked Noora to choose any f days from n next for sell-outs. On each of f chosen days the number of products were put up for sale would be doubled. Thus, if on i-th day shop planned to put up for sale ki products and Noora has chosen this day for sell-out, shelves of the shop would keep 2·ki products. Consequently, there is an opportunity to sell two times more products on days of sell-out.Noora's task is to choose f days to maximize total number of sold products. She asks you to help her with such a difficult problem.

The first line contains two integers n and f (1 ≤ n ≤ 105, 0 ≤ f ≤ n) denoting the number of days in shop's plan and the number of days that Noora has to choose for sell-out. Each line of the following n subsequent lines contains two integers ki, li (0 ≤ ki, li ≤ 109) denoting the number of products on the shelves of the shop on the i-th day and the number of clients that will come to the shop on i-th day.

Print a single integer denoting the maximal number of products that shop can sell.

NoteIn the first example we can choose days with numbers 2 and 4 for sell-out. In this case new numbers of products for sale would be equal to [2, 6, 2, 2] respectively. So on the first day shop will sell 1 product, on the second — 5, on the third — 2, on the fourth — 2. In total 1 + 5 + 2 + 2 = 10 product units.In the second example it is possible to sell 5 products, if you choose third day for sell-out.

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.List
import Data.Ord
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến :: Int -> [(Int64, Int64)] -> Int64
chiến f = sum . map (\(i, (k, l)) -> min l $ if i <= f then 2 * k else k) . zip [1..] . sortBy (flip $ comparing (\(k, l) -> min l (2 * k) - min l k))

main = do
  n:f:_ <- readInts <$> B.getLine
  kls <- replicateM n ((\(k:l:_) -> (k, l)) . map fromIntegral . readInts <$> B.getLine)
  print $ chiến f kls

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

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

parsePairs :: [Int] -> [(Int, Int)]
parsePairs [] = []
parsePairs (x:y:xs) = (x, y) : parsePairs xs

clamp u v w = max u (min v w)

solve :: Int -> [(Int, Int)] -> Integer
solve f xs = base + extra
  where base = sum . map toInteger $  [min k l | (k, l) <- xs]
        extra = sum . map toInteger . take f . reverse . sort $ [clamp 0 k (l - k) | (k, l) <- xs]

main :: IO ()
main = do
  _:f:xs <- getInts
  print $ solve f (parsePairs xs)

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

getInts :: IO [Int]
getInts = map (fst . fromJust . B.readInt) <$> B.words <$> B.getContents
parsePairs []       = []
parsePairs (x:y:rs) = (x, y) : parsePairs rs
clamp u v w = max u $ min v $ w

main = do
    _:f:xs <- getInts
    print $ solve f (parsePairs xs)

solve :: Int -> [(Int, Int)] -> Integer
solve f ps = base + bonus where
    base = sum . map toInteger $ [min u v | (u, v) <- ps]
    bonus = sum . map toInteger . take f . reverse . sort $ [clamp 0 u (v - u) | (u, v) <- ps]

{-# LANGUAGE BangPatterns #-}

import Data.Maybe
import Data.Int
import Data.Bool
import Data.List
import Control.Monad

modulant :: Int64
modulant = 1000000007

twos :: [Int64]
twos = work 1
    where
        work c = c : work (let x = 2*c in if x > modulant then x - modulant else x)

main :: IO ()
main = do
    [n, f] <- liftM (\l -> (read :: String -> Int) <$> words l) getLine
    days <- getDays n
    let newCustomers = (\(p, c) -> (max 0 (min p (c- p)), (p,c))) <$> days
        sorted = reverse $ sort newCustomers
        doubled = (\(a,(b, c)) -> min (a+b) c) <$> take f sorted
        normal = (\(a,(b, c)) -> min b c) <$> drop f sorted
    print $ sum doubled + sum normal

getDays :: Int -> IO [(Int64, Int64)]
getDays t = mapM (\_ -> do
    [a,b] <- liftM (\l -> (read :: String -> Int64) <$> words l) getLine
    return (a,b)) [1..t]

import Control.Monad  (replicateM)
import Data.Functor   ((<$>))
import Data.List      (sortBy)
import Data.Maybe     (fromMaybe)

import qualified Data.ByteString.Char8 as B

newtype ShopDay = ShopDay (Integer, Integer, Integer)
  deriving (Show, Eq, Ord)

main :: IO ()
main = do
  n:f:_ <- readLine
  v <- sortBy (flip compare) <$> replicateM (fromInteger n) readDay
  putStrLn $ show $ solution f v
  where readLine = map (fst . fromMaybe undefined . B.readInteger) <$> (B.words <$> B.getLine)
        readDay = do
          a:b:_ <- readLine
          return $ ShopDay (min (2 * a) b - min a b, a, b)

solution :: Integer -> [ShopDay] -> Integer
solution 0 v = sum $ map (\ (ShopDay (_, a, b)) -> min a b) v
solution n (v:vs) = min (2 * a) b + solution (n - 1) vs
  where ShopDay (_, a, b) = v

import Control.Monad  (replicateM)
import Data.Functor   ((<$>))
import Data.Int       (Int64)
import Data.List      (sortBy)
import Data.Maybe     (fromMaybe)

import qualified Data.ByteString.Char8 as B

newtype ShopDay = ShopDay (Integer, Integer, Integer)
  deriving (Show, Eq, Ord)

main :: IO ()
main = do
  n:f:_ <- readLine
  v <- sortBy (flip compare) <$> replicateM (fromInteger n) readDay
  putStrLn $ show $ solution f v
  where readLine = map (fst . fromMaybe undefined . B.readInteger) <$> (B.words <$> B.getLine)
        readDay = do
          a:b:_ <- readLine
          return $ ShopDay (min (2 * a) b - min a b, a, b)

solution :: Integer -> [ShopDay] -> Integer
solution 0 v = sum $ map (\ (ShopDay (_, a, b)) -> min a b) v
solution n (v:vs) = min (2 * a) b + solution (n - 1) vs
  where ShopDay (_, a, b) = v

import Control.Applicative( (<$>))
import Control.Monad( replicateM, forM_)
import Data.ByteString.Char8( readInteger, readInt, tail)
import qualified Data.ByteString.Char8 as B
import System.IO( stdin)
import Data.List( sortBy)

main = do
    let
	getLine' = B.hGetLine stdin

	readPair::IO (Integer, Integer)
	readPair = do
	    Just (l,rest) <- readInteger <$> getLine'
	    let
		Just (r,_) = readInteger $ B.tail rest

	    return (l,r)

    Just (n_, rest) <- readInt <$> getLine'
    let
	Just (f_, _) = readInt $ B.tail rest

    klPairs_ <- replicateM (fromIntegral n_) readPair
    let
	sortedKlpairs = sortBy cmp klPairs_
	  where
	    cmp (k1,l1) (k2,l2) = let
				    mn l k = min (2*k) l
		in
		    compare ((mn l2 k2)-k2) ((mn l1 k1)-k1)

	sell::Int->Integer->[(Integer,Integer)]->[Integer]
	sell _ now [] = [now]
	sell 0 now ((k,l):kls) = sell 0 ((min k l)+now) kls
	sell f now ((k,l):kls)
	  | k>=l	= sell f (l+now) kls
	  | otherwise	= sell (f-1) ((min (2*k) l)+now) kls

    print . maximum $ sell f_ 0 sortedKlpairs

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.List
import Data.Ord
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến :: Int -> [(Int64, Int64)] -> Int64
chiến f = sum . map (\(i, (k, l)) -> min l $ if i <= f then 2 * k else k) . zip [1..] . sortBy (flip $ comparing (\(k, l) -> min l $ 2 * k))

main = do
  n:f:_ <- readInts <$> B.getLine
  kls <- replicateM n ((\(k:l:_) -> (k, l)) . map fromIntegral . readInts <$> B.getLine)
  print $ chiến f kls

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.List
import Data.Ord

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến f = sum . map (\(i, (k, l)) -> min l $ if i <= f then 2 * k else k) . zip [1..] . sortBy (flip $ comparing (\(k, l) -> min l $ 2 * k))

main = do
  n:f:_ <- readInts <$> B.getLine
  kls <- replicateM n ((\(k:l:_) -> (k, l)) . readInts <$> B.getLine)
  print $ chiến f kls

import           Data.Functor
import           Data.List

getInts :: IO [Int]
getInts = map read <$> words <$> getContents
parsePairs []       = []
parsePairs (x:y:rs) = (x, y) : parsePairs rs
clamp u v w = max u $ min v $ w

main = getInts >>= print . go where
    go (_:f:xs) = solve f (parsePairs xs)

solve :: Int -> [(Int, Int)] -> Int
solve f ps = base + bonus where
    base = sum [min u v | (u, v) <- ps]
    bonus = sum . take f . reverse . sort $ [clamp 0 u (v - u) | (u, v) <- ps]

{-# LANGUAGE BangPatterns #-}

import Data.Maybe
import Data.Int
import Data.Bool
import Data.List
import Control.Monad

modulant :: Int64
modulant = 1000000007

twos :: [Int64]
twos = work 1
    where
        work c = c : work (let x = 2*c in if x > modulant then x - modulant else x)

main :: IO ()
main = do
    [n, f] <- liftM (\l -> (read :: String -> Int) <$> words l) getLine
    days <- getDays n
    let newCustomers = (\(p, c) -> (max 0 (min p (c- p)), (p,c))) <$> days
        sorted = reverse $ sort newCustomers
        doubled = (\(a,(b, c)) -> min (a+b) c) <$> take f sorted
        normal = (\(a,(b, c)) -> min b c) <$> drop f sorted
    print $ sum doubled + sum normal

getDays :: Int -> IO [(Int, Int)]
getDays t = mapM (\_ -> do
    [a,b] <- liftM (\l -> (read :: String -> Int) <$> words l) getLine
    return (a,b)) [1..t]

import Data.Functor ((<$>))

newtype ShopDay = ShopDay (Int, Int, Int)
  deriving (Show, Eq, Ord)

main :: IO ()
main = do
  n:f:_ <- readLine
  v <- loop n
  case f of
       0 -> putStrLn $ show $ solution f v
       _ -> putStrLn $ show $ solution f (qsr v)
  where readLine = map (read :: String -> Int) . words <$> getLine
        loop :: Int -> IO [ShopDay]
        loop 0 = return []
        loop n = do
          a:b:_ <- readLine
          rest <- loop $ n - 1
          return $ ShopDay (min (2 * a) b, a, b) : rest

solution :: Int -> [ShopDay] -> Int
solution 0 v = sum $ map (\ (ShopDay (_, a, b)) -> min a b) v
solution n (v:vs) = a + solution (n - 1) vs
  where ShopDay (a, _, _) = v

qsr :: (Ord a) => [a] -> [a]
qsr [] = []
qsr (x:xs) = qsr (filter (>=x) xs) ++ [x] ++ qsr (filter (<x) xs)

import Control.Monad  (replicateM)
import Data.Functor   ((<$>))
import Data.Int       (Int64)
import Data.List      (sortBy)
import Data.Maybe     (fromMaybe)

import qualified Data.ByteString.Char8 as B

newtype ShopDay = ShopDay (Integer, Integer, Integer)
  deriving (Show, Eq, Ord)

main :: IO ()
main = do
  n:f:_ <- readLine
  v <- sortBy (flip compare) <$> replicateM (fromInteger n) readDay
  putStrLn $ show $ solution f v
  where readLine = map (fst . fromMaybe undefined . B.readInteger) <$> (B.words <$> B.getLine)
        readDay = do
          a:b:_ <- readLine
          return $ ShopDay (min (2 * a) b, a, b)

solution :: Integer -> [ShopDay] -> Integer
solution 0 v = sum $ map (\ (ShopDay (_, a, b)) -> min a b) v
solution n (v:vs) = a + solution (n - 1) vs
  where ShopDay (a, _, _) = v


Professor Dumbledore is helping Harry destroy the Horcruxes. He went to Gaunt Shack as he suspected a Horcrux to be present there. He saw Marvolo Gaunt's Ring and identified it as a Horcrux. Although he destroyed it, he is still affected by its curse. Professor Snape is helping Dumbledore remove the curse. For this, he wants to give Dumbledore exactly x drops of the potion he made. Value of x is calculated as maximum of p·ai + q·aj + r·ak for given p, q, r and array a1, a2, ... an such that 1 ≤ i ≤ j ≤ k ≤ n. Help Snape find the value of x. Do note that the value of x may be negative.

First line of input contains 4 integers n, p, q, r ( - 109 ≤ p, q, r ≤ 109, 1 ≤ n ≤ 105). Next line of input contains n space separated integers a1, a2, ... an ( - 109 ≤ ai ≤ 109).

Output a single integer the maximum value of p·ai + q·aj + r·ak that can be obtained provided 1 ≤ i ≤ j ≤ k ≤ n.

NoteIn the first sample case, we can take i = j = k = 5, thus making the answer as 1·5 + 2·5 + 3·5 = 30.In second sample case, selecting i = j = 1 and k = 5 gives the answer 12.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  show `fmap` liftM4 solve p64 p64 p64 (replicateM n p64)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  p64 = fmap to64 poi
  int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

solve p q r = maximum . liftM3 (zipWith3 (\a b c -> a + b + c)) (scanl1 max . map (p*)) (map (q*)) (scanr1 max . map (r*))

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import Data.Int (Int64)

readInt = fst . M.fromJust . C.readInt

main = do
    (map readInt . C.words -> (_:(map fromIntegral -> [p :: Int64, q, r]))) <- B.getLine
    (map (fromIntegral . readInt) . C.words -> xs) <- B.getLine
    let ls = scanl1 (if p < 0 then min else max) xs
        rs = scanr1 (if r < 0 then min else max) xs
    print . maximum $ zipWith3 (\a b c -> p * a + q * b + r * c) ls xs rs


In an ICPC contest, balloons are distributed as follows:   Whenever a team solves a problem, that team gets a balloon.  The first team to solve a problem gets an additional balloon.  A contest has 26 problems, labelled $$$\textsf{A}$$$, $$$\textsf{B}$$$, $$$\textsf{C}$$$, ..., $$$\textsf{Z}$$$. You are given the order of solved problems in the contest, denoted as a string $$$s$$$, where the $$$i$$$-th character indicates that the problem $$$s_i$$$ has been solved by some team. No team will solve the same problem twice.Determine the total number of balloons that the teams received. Note that some problems may be solved by none of the teams.

The first line of the input contains an integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of testcases. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 50$$$) — the length of the string. The second line of each test case contains a string $$$s$$$ of length $$$n$$$ consisting of uppercase English letters, denoting the order of solved problems.

For each test case, output a single integer — the total number of balloons that the teams received.

6

3

ABA

1

A

3

ORZ

5

BAAAA

4

BKPT

10

CODEFORCES

NoteIn the first test case, $$$5$$$ balloons are given out:   Problem $$$\textsf{A}$$$ is solved. That team receives $$$2$$$ balloons: one because they solved the problem, an an additional one because they are the first team to solve problem $$$\textsf{A}$$$.  Problem $$$\textsf{B}$$$ is solved. That team receives $$$2$$$ balloons: one because they solved the problem, an an additional one because they are the first team to solve problem $$$\textsf{B}$$$.  Problem $$$\textsf{A}$$$ is solved. That team receives only $$$1$$$ balloon, because they solved the problem. Note that they don't get an additional balloon because they are not the first team to solve problem $$$\textsf{A}$$$.  The total number of balloons given out is $$$2+2+1=5$$$.In the second test case, there is only one problem solved. The team who solved it receives $$$2$$$ balloons: one because they solved the problem, an an additional one because they are the first team to solve problem $$$\textsf{A}$$$.

module Main (main) where
import Numeric (showFFloat)
import Data.Char (toUpper)
import Control.Monad (forM_)
import qualified Data.Foldable as String

import qualified Data.Set as Set

-- reset && stack build && echo "success" && stack exec haskell-codeforces-exe && echo finished
--  gen-hie > hie.yaml

strToInt a = read a :: Int
strToFloat a = read a :: Float

pshow x = putStr (show x)
pfshow x = putStr (showFFloat (Just 2) x "")

solve :: IO()
solve = do
    _ <- getLine
    s <- getLine
    let cntUnique = Set.size $ Set.fromList s
    let cntTotal = String.length s
    print (cntUnique + cntTotal)

main :: IO ()
main = do
    n <- readLn
    forM_[1..n] $ \_ -> do
        solve

import Control.Monad (replicateM_)
import Data.List (nub)

main = do
    tests_n <- read <$> getLine
    replicateM_ tests_n $ do
        getLine
        s <- getLine
        print (findTotalBalloonsWon s)

findTotalBalloonsWon s = length s + length (nub s)

import Data.List

testcase 0 = return ()
testcase t = do
    getLine
    s <- getLine
    putStrLn $ show (length s + (length $ group $ sort s))
    testcase (t - 1)

main :: IO ()
main = do
    t <- read <$> getLine
    testcase t

module Main where

import Control.Monad (replicateM_, void)

import Data.Map (Map)
import qualified Data.Map as Map

testCase :: IO ()
testCase = do
    getLine
    line <- getLine

    let mp = foldr (flip (Map.insertWith (+)) 1) Map.empty line

    print $ length (Map.keys mp) + sum (Map.elems mp)

main :: IO ()
main = do
    t <- read <$> getLine

    replicateM_ t testCase

{-# LANGUAGE LambdaCase #-}

module Main where

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

--
import Data.List

solve :: C.ByteString -> Int
solve = sum . map (succ . length) . group . sort . C.unpack

input = int *> bstr

output = C.pack . show

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

-- 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 sp sc = evalState sc . sp

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

read' :: (C.ByteString -> Maybe (a, C.ByteString)) -> Scanner a
read' q = fst . fromJust . q <$> bstr

int :: Scanner Int
int = read' C.readInt

integer :: Scanner Integer
integer = read' C.readInteger

(><) :: Int -> Scanner a -> Scanner [a]
(><) = replicateM

numberOf :: Scanner a -> Scanner [a]
numberOf = (int >>=) . flip (><)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, nub)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&))

-- road map in reverse, and the number of cities, init pen state
type Domain = String
type CoDomain = Int
type Solver  = Domain -> CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

parse :: IO Domain
parse = do
  _ <- getLine
  line <- getLine
  -- putStrLn line
  return line

solve :: Solver
solve = uncurry (+) . ((length . nub) &&& (length))

main :: IO ()
main = do
  [n] <- readChar8
  replicateM_ n $ printAns =<< solve <$> parse
  return ()

import Control.Monad
import Data.List

testCaseMain :: Int -> IO ()
testCaseMain _ = do n <- (readLn :: IO Int)
                    line <- getLine
                    print $ n + length (group (sort line))

main :: IO ()
main = do n <- (readLn :: IO Int)
          forM_ [1 .. n] testCaseMain

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

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM)
import Data.Array ((!))
import Data.Array.ST (MArray (newArray), readArray, runSTArray, writeArray)
import qualified Data.ByteString.Char8 as C
import Data.Char (toLower)
import Data.Maybe (fromJust)
import Data.List (nub, sort)

data TC = TC {s :: String}

solve TC {..} = unique + allC
  where
    unique = length s
    allC = length $ nub $ sort s

main = C.interact $ runScanner scan >>> map solve >>> map (C.pack . show) >>> C.unlines

scan = numberOf $ int >> TC <$> C.unpack <$> str

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

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

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

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

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

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 (,)

import           Data.List
import qualified Data.Char as DC

solveCase :: IO ()
solveCase = do
    n <- fmap (read :: String -> Int) getLine
    s <- getLine
    putStrLn $ show $ length s + (length $ nub s)

solve :: Int -> IO ()
solve 0 = do
    return ()
solve cases_left = do
    solveCase
    solve $ cases_left - 1

main = do
    s_testcases <- getLine
    solve $ (read s_testcases :: Int)


A big football championship will occur soon! $$$n$$$ teams will compete in it, and each pair of teams will play exactly one game against each other.There are two possible outcomes of a game:  the game may result in a tie, then both teams get $$$1$$$ point;  one team might win in a game, then the winning team gets $$$3$$$ points and the losing team gets $$$0$$$ points. The score of a team is the number of points it gained during all games that it played.You are interested in a hypothetical situation when all teams get the same score at the end of the championship. A simple example of that situation is when all games result in ties, but you want to minimize the number of ties as well.Your task is to describe a situation (choose the result of each game) so that all teams get the same score, and the number of ties is the minimum possible.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then the test cases follow. Each test case is described by one line containing one integer $$$n$$$ ($$$2 \le n \le 100$$$) — the number of teams.

For each test case, print $$$\frac{n(n - 1)}{2}$$$ integers describing the results of the games in the following order: the first integer should correspond to the match between team $$$1$$$ and team $$$2$$$, the second — between team $$$1$$$ and team $$$3$$$, then $$$1$$$ and $$$4$$$, ..., $$$1$$$ and $$$n$$$, $$$2$$$ and $$$3$$$, $$$2$$$ and $$$4$$$, ..., $$$2$$$ and $$$n$$$, and so on, until the game between the team $$$n - 1$$$ and the team $$$n$$$. The integer corresponding to the game between the team $$$x$$$ and the team $$$y$$$ should be $$$1$$$ if $$$x$$$ wins, $$$-1$$$ if $$$y$$$ wins, or $$$0$$$ if the game results in a tie. All teams should get the same score, and the number of ties should be the minimum possible. If there are multiple optimal answers, print any of them. It can be shown that there always exists a way to make all teams have the same score.

NoteIn the first test case of the example, both teams get $$$1$$$ point since the game between them is a tie.In the second test case of the example, team $$$1$$$ defeats team $$$2$$$ (team $$$1$$$ gets $$$3$$$ points), team $$$1$$$ loses to team $$$3$$$ (team $$$3$$$ gets $$$3$$$ points), and team $$$2$$$ wins against team $$$3$$$ (team $$$2$$$ gets $$$3$$$ points).

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      func :: Int -> [((Int, Int), Int)]
      func 0 = []
      func 1 = []
      func n
        | odd n = ((n - 1, n), -1) : map (\i -> ((i, n), 1)) l1 ++ map (\i -> ((i, n), -1)) l2 ++ map (\i -> ((i, n - 1), -1)) l1 ++ map (\i -> ((i, n - 1), 1)) l2 ++ func (n - 2)
        | otherwise = ((n - 1, n), 0) : map (\i -> ((i, n - 1), 1)) l1 ++ map (\i -> ((i, n - 1), -1)) l2 ++ map (\i -> ((i, n), -1)) l1 ++ map (\i -> ((i, n), 1)) l2 ++ func (n - 2)
        where
        l1 = [1, 3 .. n - 2]
        l2 = [2, 4 .. n - 2]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map (show . snd) $ sort $ func n

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

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

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

run1 = B.unwords . map bshow . solve <$> popInt

solve n =
  let ms = (flip concatMap) [1 .. (n - 1) `quot` 2] $
           \d -> (flip map) [0 .. n - 1] $
           \i -> (i, (i + d) `rem` n)
      scores = listArray ((0, 0), (n - 1, n - 1)) (repeat 0) //
               concatMap (\(i, j) -> [((i, j), 1), ((j, i), -1)]) ms in
    (flip concatMap) [0 .. n - 1] $
    \i -> (flip map) [i + 1 .. n - 1] $
    \j -> scores ! (i, j)

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

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

type SIO = StateT P.ByteString IO

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    let
      (wins, ties) = divMod (n-1) 2
      solve x y = if  y - x <= wins
        then  1
        else  if  y - x <= wins + ties
        then  0
        else  0-1
    putInts [solve x y | x <- [1..n], y <- [x+1 .. n]]

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

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

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

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      func :: Int -> [((Int, Int), Int)]
      func 0 = []
      func 1 = []
      func x
        | odd x = ((n - 1, n), -1) : map (\i -> ((i, n), 1)) l1 ++ map (\i -> ((i, n), -1)) l2 ++ map (\i -> ((i, n - 1), -1)) l1 ++ map (\i -> ((i, n - 1), 1)) l2 ++ func (x - 2)
        | otherwise = ((n - 1, n), 0) : map (\i -> ((i, n - 1), 1)) l1 ++ map (\i -> ((i, n - 1), -1)) l2 ++ map (\i -> ((i, n), -1)) l1 ++ map (\i -> ((i, n), 1)) l2 ++ func (x - 2)
        where
        l1 = [1, 3 .. n - 2]
        l2 = [2, 4 .. n - 2]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map (show . snd) $ sort $ func n

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      func :: Int -> [((Int, Int), Int)]
      func 0 = []
      func 1 = []
      func x
        | odd x = ((n, n - 1), 1) : map (\i -> ((i, n), 1)) l1 ++ map (\i -> ((i, n), -1)) l2 ++ map (\i -> ((i, n - 1), -1)) l1 ++ map (\i -> ((i, n - 1), 1)) l2 ++ func (x - 2)
        | otherwise = ((n - 1, n), 0) : map (\i -> ((i, n - 1), 1)) l1 ++ map (\i -> ((i, n - 1), -1)) l2 ++ map (\i -> ((i, n), -1)) l1 ++ map (\i -> ((i, n), 1)) l2 ++ func (x - 2)
        where
        l1 = [1, 3 .. n - 2]
        l2 = [2, 4 .. n - 2]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map (show . snd) $ sort $ func n

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      func :: Int -> [((Int, Int), Int)]
      func 0 = []
      func 1 = []
      func x
        | odd x = ((n - 1, n), 1) : map (\i -> ((i, n), 1)) l1 ++ map (\i -> ((i, n), -1)) l2 ++ map (\i -> ((i, n - 1), -1)) l1 ++ map (\i -> ((i, n - 1), 1)) l2 ++ func (x - 2)
        | otherwise = ((n - 1, n), 0) : map (\i -> ((i, n - 1), 1)) l1 ++ map (\i -> ((i, n - 1), -1)) l2 ++ map (\i -> ((i, n), -1)) l1 ++ map (\i -> ((i, n), 1)) l2 ++ func (x - 2)
        where
        l1 = [1, 3 .. n - 2]
        l2 = [2, 4 .. n - 2]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map (show . snd) $ sort $ func n

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

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

type State = (S.Set (Int, Int), [((Int, Int), String)])

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      dfs :: Int -> [Int] -> State -> State
      dfs _ [] p = p
      dfs u (v : vs) p@(visits, results)
        | v == u || S.member e visits = dfs u vs p
        | otherwise = dfs u vs $ dfs v [1..n] (S.insert e visits, (e, r) : results)
        where
        (e, r) = (if u < v then ((u, v), "1") else ((v, u), "-1"))
      results
        | even n = snd $ dfs 1 [2..n] (S.fromAscList adjs, zip adjs (repeat "0"))
        | otherwise = snd $ dfs 1 [2..n] (S.empty, [])
        where
        adjs = map (\i -> (i, i + 1)) $ filter odd [1..n]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map snd results


It is the hard version of the problem. The only difference is that in this version $$$1 \le n \le 300$$$.In the cinema seats can be represented as the table with $$$n$$$ rows and $$$m$$$ columns. The rows are numbered with integers from $$$1$$$ to $$$n$$$. The seats in each row are numbered with consecutive integers from left to right: in the $$$k$$$-th row from $$$m (k - 1) + 1$$$ to $$$m k$$$ for all rows $$$1 \le k \le n$$$. $$$1$$$$$$2$$$$$$\cdots$$$$$$m - 1$$$$$$m$$$$$$m + 1$$$$$$m + 2$$$$$$\cdots$$$$$$2 m - 1$$$$$$2 m$$$$$$2m + 1$$$$$$2m + 2$$$$$$\cdots$$$$$$3 m - 1$$$$$$3 m$$$$$$\vdots$$$$$$\vdots$$$$$$\ddots$$$$$$\vdots$$$$$$\vdots$$$$$$m (n - 1) + 1$$$$$$m (n - 1) + 2$$$$$$\cdots$$$$$$n m - 1$$$$$$n m$$$ The table with seats indices There are $$$nm$$$ people who want to go to the cinema to watch a new film. They are numbered with integers from $$$1$$$ to $$$nm$$$. You should give exactly one seat to each person.It is known, that in this cinema as lower seat index you have as better you can see everything happening on the screen. $$$i$$$-th person has the level of sight $$$a_i$$$. Let's define $$$s_i$$$ as the seat index, that will be given to $$$i$$$-th person. You want to give better places for people with lower sight levels, so for any two people $$$i$$$, $$$j$$$ such that $$$a_i < a_j$$$ it should be satisfied that $$$s_i < s_j$$$.After you will give seats to all people they will start coming to their seats. In the order from $$$1$$$ to $$$nm$$$, each person will enter the hall and sit in their seat. To get to their place, the person will go to their seat's row and start moving from the first seat in this row to theirs from left to right. While moving some places will be free, some will be occupied with people already seated. The inconvenience of the person is equal to the number of occupied seats he or she will go through.Let's consider an example: $$$m = 5$$$, the person has the seat $$$4$$$ in the first row, the seats $$$1$$$, $$$3$$$, $$$5$$$ in the first row are already occupied, the seats $$$2$$$ and $$$4$$$ are free. The inconvenience of this person will be $$$2$$$, because he will go through occupied seats $$$1$$$ and $$$3$$$.Find the minimal total inconvenience (the sum of inconveniences of all people), that is possible to have by giving places for all people (all conditions should be satisfied).

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 $$$m$$$ ($$$1 \le n, m \le 300$$$) — the number of rows and places in each row respectively. The second line of each test case contains $$$n \cdot m$$$ integers $$$a_1, a_2, \ldots, a_{n \cdot m}$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the sight level of $$$i$$$-th person. It's guaranteed that the sum of $$$n \cdot m$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print a single integer — the minimal total inconvenience that can be achieved.

NoteIn the first test case, there is a single way to give seats: the first person sits in the first place and the second person — in the second. The total inconvenience is $$$1$$$.In the second test case the optimal seating looks like this:   In the third test case the optimal seating looks like this:   The number in a cell is the person's index that sits on this place.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe
import Data.Foldable
import Data.Monoid

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Sequence (Seq(Empty, (:<|), (:|>)))
import qualified Data.Sequence as Seq

invNum xs = if n == 1 then (xs, 0) else merge ls' rs' Seq.empty (accl + accr)
  where
    n = Seq.length xs
    m = n `div` 2
    (ls, rs) = Seq.splitAt m xs
    (ls', accl) = invNum ls
    (rs', accr) = invNum rs
    merge Empty Empty xs acc = (xs, acc)
    merge Empty (x :<| xss) ys acc = merge Empty xss (ys :|> x) acc
    merge (x :<| xss) Empty ys acc = merge xss Empty (ys :|> x) acc
    merge p@(l :<| lss) q@(r :<| rss) ys acc =
      if l > r then merge lss q (ys :|> l) acc
        else merge p rss (ys :|> r) (acc + Seq.length p)

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    as <- listArray (1, m*n) <$> (getInts $ n * m) :: SP (UArray Int Int)
    let xs = Seq.fromList $ sortOn ((,)<$>(as!)<*>id) [1..n*m]
        ans = getSum $ foldMap (Sum . snd . invNum . Seq.sortOn ((,)<$>(as!)<*>negate)) $ Seq.chunksOf m xs
    pure $! putInts [ans]

type SP = State [P.ByteString]

readInt :: P.ByteString -> Int
readInt = fst . fromJust . P.readInt

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map readInt <$> getNext k

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    [n, m] <- readMany :: IO [Int]
    as <- readMany :: IO [Int]
    let xss = map (map snd . sortOn (negate . fst) . reverse) $ chunksOf m $ reverse $ sort $ zip as [1 :: Int ..]
        f xs = sum [length $ filter (<i) xs' | (i:xs') <- tails xs]
    print $ sum $ map f xss

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = go where
    go [] = []
    go xs = xs' : go xs'' where (xs', xs'') = splitAt n xs

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

main :: IO ()
main = readLn >>= flip replicateM_ solve

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

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

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

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

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

solve :: TC -> Int
solve TC {..} =
  fst
    . foldl update (0, [])
    . map (sort . map snd)
    . groupOn fst
    . sort
    $ zip as [1 ..]
  where
    update (acc, row) ixs = (acc + cost, tetris $ row ++ ixs)
      where
        cixs = take (m - length row) ixs
        cost = sum [countBy (< i) row | i <- cixs]

    tetris xs = let l = length xs in drop (l - l `mod` m) xs

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

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

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import qualified Data.Set as S
import Data.Function
import Data.Int

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = unfoldr $ \li -> do
  guard $ not $ null li
  pure $ splitAt n li

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    a <- getInts (n * m)
    let
      aips = sort $ zip a [1..]
      unsrows = chunksOf m aips
      soln row = do
        w <- groupBy ((==) `on` fst) row
        reverse $ map snd w
      rows = map soln unsrows
      cost :: [Int] -> Int64
      cost row = let
        incls = scanl' (flip S.insert) S.empty row
        in  foldl' (+) 0 $ do
        (i, s) <- zip row incls
        pure $ fromIntegral $ S.size $ fst $ S.split i s
    pure $ putInt64s [foldl' (\x y -> x + cost y) 0 rows]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> Builder
putInt64s vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.int64Dec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> int64Dec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


Mr. Chanek has an array $$$a$$$ of $$$n$$$ integers. The prettiness value of $$$a$$$ is denoted as:$$$$$$\sum_{i=1}^{n} {\sum_{j=1}^{n} {\gcd(a_i, a_j) \cdot \gcd(i, j)}}$$$$$$where $$$\gcd(x, y)$$$ denotes the greatest common divisor (GCD) of integers $$$x$$$ and $$$y$$$.In other words, the prettiness value of an array $$$a$$$ is the total sum of $$$\gcd(a_i, a_j) \cdot \gcd(i, j)$$$ for all pairs $$$(i, j)$$$.Help Mr. Chanek find the prettiness value of $$$a$$$, and output the result modulo $$$10^9 + 7$$$!

The first line contains an integer $$$n$$$ ($$$2 \leq n \leq 10^5$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^5$$$).

Output an integer denoting the prettiness value of $$$a$$$ modulo $$$10^9 + 7$$$.

-- Resubmission, to see if 64-bit runtime is any help here, time-wise

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int

import Control.Monad.ST
  -- I need to re-use a large mutable array to get good complexity

import Debug.Trace

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
infixl 7 *! -- Don't make typos in your operator precedence. Or else!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral $ x64 * y64 `rem` p64

getSPFs :: Int -> UArray Int Int
getSPFs n = accumArray (const id) 0 (1, n) $ do
  i <- [n, n-1 .. 2]
  j <- [i, 2*i .. n]
  pure (j, i)

getEulerPhi :: UArray Int Int -> UArray Int Int
getEulerPhi spfs = runSTUArray $ do
  let  (1, n) = bounds spfs
  ans <- newArray_ (1, n)
  writeArray ans 1 1
  forM_ [2 .. n] $ \x -> let
    px = spfs ! x
    y = quot x px
    py = spfs ! y
    in  do
    prev <- readArray ans y
    writeArray ans x $ prev * if  px == py  then  px  else  px - 1
  pure ans

solve :: Int -> [Int] -> Int
solve n aLi = let
  a :: UArray Int Int
  a = listArray (1, n) aLi
  maxa = foldl' max n $ elems a

  spfs = getSPFs maxa
  phi = getEulerPhi spfs

  primeList = filter (\q -> spfs ! q == q) [1 .. maxa] -- another n vs maxa bug
  nPrimes = length primeList
  primes :: UArray Int Int
  primes = listArray (1, nPrimes) primeList

  factors :: Array Int (UArray Int Int)
  factors = let
    mkListArr :: [Int] -> UArray Int Int
    mkListArr li = listArray (1, length li) li
    in  fmap mkListArr $ accumArray (flip (:)) [] (1, maxa) $ do
      i <- [1 .. maxa]
      j <- [i, 2*i .. maxa]
      pure (j, i)

  getFactors :: Int -> [Int]
  getFactors ix = elems $ factors ! ix

  incrAt :: STUArray s Int Int -> Int -> Int -> ST s ()
  incrAt arr ix amt = readArray arr ix >>= writeArray arr ix . (+ amt)

  insertSmall :: STUArray s Int Int -> [Int] -> ST s [Int]
  insertSmall arr vals = fmap concat $ forM vals $ \x ->
    flip filterM (getFactors x) $ \y -> do
      prev <- readArray arr y
      writeArray arr y (prev + 1)
      pure $ prev == 0

  insertLarge :: STUArray s Int Int -> [Int] -> ST s [Int]
  insertLarge arr vals = do
    forM_ vals $ \x -> incrAt arr x 1
    forM_ (elems primes) $ \q -> do
      let  start = quot maxa q -- n vs maxa -- Too subtle for me!
      forM_ [start, start - 1 .. 1] $ \i -> do
        readArray arr (q * i) >>= incrAt arr i
    pure [1 .. maxa]

  in  runST $ do
  counts <- newArray (1, maxa) 0 :: ST s (STUArray s Int Int)
  (\fun -> foldM fun 0 [1 .. n]) $ \acc1 stride -> acc1 `seq` do
    let
      relas = map (a !) [stride, 2*stride .. n]
      isLarge = quot n stride >= 1000
    relixs <- if  isLarge
      then  insertLarge counts relas
      else  insertSmall counts relas
    --cts <- getAssocs counts
    --traceShow ("stride", stride, "counts", cts, "acc1", acc1) $ pure ()
    newv <- (\fun -> foldM fun 0 relixs) $ \acc2 ix -> acc2 `seq` do
      ct <- readArray counts ix
      writeArray counts ix 0
      --traceShow ("ix", ix, "acc2", acc2, "ct", ct) $ pure ()
      pure $ acc2 +! phi ! ix *! ct *! ct
    --traceShow ("newv", newv) $ pure ()
    pure $ acc1 +! phi ! stride *! newv

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  aLi <- getInts n
  pure $ putInts [solve n aLi]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

-- This is probably still a little too slow.
-- Let's see if the test data can prove it.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int

import Control.Monad.ST
  -- I need to re-use a large mutable array to get good complexity

import Debug.Trace

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
infixl 7 *! -- Don't make typos in your operator precedence. Or else!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral $ x64 * y64 `rem` p64

getSPFs :: Int -> UArray Int Int
getSPFs n = accumArray (const id) 0 (1, n) $ do
  i <- [n, n-1 .. 2]
  j <- [i, 2*i .. n]
  pure (j, i)

getEulerPhi :: UArray Int Int -> UArray Int Int
getEulerPhi spfs = runSTUArray $ do
  let  (1, n) = bounds spfs
  ans <- newArray_ (1, n)
  writeArray ans 1 1
  forM_ [2 .. n] $ \x -> let
    px = spfs ! x
    y = quot x px
    py = spfs ! y
    in  do
    prev <- readArray ans y
    writeArray ans x $ prev * if  px == py  then  px  else  px - 1
  pure ans

solve :: Int -> [Int] -> Int
solve n aLi = let
  a :: UArray Int Int
  a = listArray (1, n) aLi
  maxa = foldl' max n $ elems a

  spfs = getSPFs maxa
  phi = getEulerPhi spfs

  primeList = filter (\q -> spfs ! q == q) [1 .. maxa] -- another n vs maxa bug
  nPrimes = length primeList
  primes :: UArray Int Int
  primes = listArray (1, nPrimes) primeList

  factors :: Array Int (UArray Int Int)
  factors = let
    mkListArr :: [Int] -> UArray Int Int
    mkListArr li = listArray (1, length li) li
    in  fmap mkListArr $ accumArray (flip (:)) [] (1, maxa) $ do
      i <- [1 .. maxa]
      j <- [i, 2*i .. maxa]
      pure (j, i)

  getFactors :: Int -> [Int]
  getFactors ix = elems $ factors ! ix

  incrAt :: STUArray s Int Int -> Int -> Int -> ST s ()
  incrAt arr ix amt = readArray arr ix >>= writeArray arr ix . (+ amt)

  insertSmall :: STUArray s Int Int -> [Int] -> ST s [Int]
  insertSmall arr vals = fmap concat $ forM vals $ \x ->
    flip filterM (getFactors x) $ \y -> do
      prev <- readArray arr y
      writeArray arr y (prev + 1)
      pure $ prev == 0

  insertLarge :: STUArray s Int Int -> [Int] -> ST s [Int]
  insertLarge arr vals = do
    forM_ vals $ \x -> incrAt arr x 1
    forM_ (elems primes) $ \q -> do
      let  start = quot maxa q -- n vs maxa -- Too subtle for me!
      forM_ [start, start - 1 .. 1] $ \i -> do
        readArray arr (q * i) >>= incrAt arr i
    pure [1 .. maxa]

  in  runST $ do
  counts <- newArray (1, maxa) 0 :: ST s (STUArray s Int Int)
  (\fun -> foldM fun 0 [1 .. n]) $ \acc1 stride -> acc1 `seq` do
    let
      relas = map (a !) [stride, 2*stride .. n]
      isLarge = quot n stride >= 1000
    relixs <- if  isLarge
      then  insertLarge counts relas
      else  insertSmall counts relas
    --cts <- getAssocs counts
    --traceShow ("stride", stride, "counts", cts, "acc1", acc1) $ pure ()
    newv <- (\fun -> foldM fun 0 relixs) $ \acc2 ix -> acc2 `seq` do
      ct <- readArray counts ix
      writeArray counts ix 0
      --traceShow ("ix", ix, "acc2", acc2, "ct", ct) $ pure ()
      pure $ acc2 +! phi ! ix *! ct *! ct
    --traceShow ("newv", newv) $ pure ()
    pure $ acc1 +! phi ! stride *! newv

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  aLi <- getInts n
  pure $ putInts [solve n aLi]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int

import Control.Monad.ST
  -- I need to re-use a large mutable array to get good complexity

--import Debug.Trace

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
infixl 7 *! -- Don't make typos in your operator precedence. Or else!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral $ x64 * y64 `rem` p64

getSPFs :: Int -> UArray Int Int
getSPFs n = accumArray (const id) 0 (1, n) $ do
  i <- [n, n-1 .. 2]
  j <- [i, 2*i .. n]
  pure (j, i)

getEulerPhi :: UArray Int Int -> UArray Int Int
getEulerPhi spfs = runSTUArray $ do
  let  (1, n) = bounds spfs
  ans <- newArray_ (1, n)
  writeArray ans 1 1
  forM_ [2 .. n] $ \x -> let
    px = spfs ! x
    y = quot x px
    py = spfs ! y
    in  do
    prev <- readArray ans y
    writeArray ans x $ prev * if  px == py  then  px  else  px - 1
  pure ans

solve :: Int -> [Int] -> Int
solve n aLi = let
  a :: UArray Int Int
  a = listArray (1, n) aLi
  maxa = foldl' max n $ elems a

  spfs = getSPFs maxa
  phi = getEulerPhi spfs

  primeList = filter (\q -> spfs ! q == q) [1 .. n]
  nPrimes = length primeList
  primes :: UArray Int Int
  primes = listArray (1, nPrimes) primeList

  getPrimeFactors :: Int -> [Int]
  getPrimeFactors 1 = []
  getPrimeFactors x = let
    px = spfs ! x
    in  px : getPrimeFactors (quot x px)

  getFactors :: Int -> [Int]
  getFactors x = let
    opts = map (scanl' (*) 1) $ group $ getPrimeFactors x
    in  foldr (liftM2 (*)) [1] opts

  incrAt :: STUArray s Int Int -> Int -> Int -> ST s ()
  incrAt arr ix amt = readArray arr ix >>= writeArray arr ix . (+ amt)

  insertSmall :: STUArray s Int Int -> [Int] -> ST s ()
  insertSmall arr vals = forM_ vals $ \x ->
    forM_ (getFactors x) $ \y -> incrAt arr y 1

  insertLarge :: STUArray s Int Int -> [Int] -> ST s ()
  insertLarge arr vals = do
    forM_ vals $ \x -> incrAt arr x 1
    forM_ (elems primes) $ \q -> do
      let  start = quot maxa q -- n vs maxa -- Too subtle for me!
      forM_ [start, start - 1 .. 1] $ \i ->
        readArray arr (q * i) >>= incrAt arr i

  in  runST $ do
  counts <- newArray (1, maxa) 0 :: ST s (STUArray s Int Int)
  (\fun -> foldM fun 0 [1 .. n]) $ \acc1 stride -> acc1 `seq` do
    let
      relas = map (a !) [stride, 2*stride .. n]
      isLarge = quot n stride >= 1000
      relixs = if  isLarge
        then  [1 .. maxa]
        else  concatMap getFactors relas
    if  isLarge
      then  insertLarge counts relas
      else  insertSmall counts relas
    --cts <- getAssocs counts
    --traceShow ("stride", stride, "counts", cts, "acc1", acc1) $ pure ()
    newv <- (\fun -> foldM fun 0 relixs) $ \acc2 ix -> acc2 `seq` do
      ct <- readArray counts ix
      writeArray counts ix 0
      --traceShow ("ix", ix, "acc2", acc2, "ct", ct) $ pure ()
      pure $ acc2 +! phi ! ix *! ct *! ct
    --traceShow ("newv", newv) $ pure ()
    pure $ acc1 +! phi ! stride *! newv

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  aLi <- getInts n
  pure $ putInts [solve n aLi]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int

import Control.Monad.ST
  -- I need to re-use a large mutable array to get good complexity

--import Debug.Trace

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
infixl 7 *! -- Don't make typos in your operator precedence. Or else!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral $ x64 * y64 `rem` p64

getSPFs :: Int -> UArray Int Int
getSPFs n = accumArray (const id) 0 (1, n) $ do
  i <- [n, n-1 .. 2]
  j <- [i, 2*i .. n]
  pure (j, i)

getEulerPhi :: UArray Int Int -> UArray Int Int
getEulerPhi spfs = runSTUArray $ do
  let  (1, n) = bounds spfs
  ans <- newArray_ (1, n)
  writeArray ans 1 1
  forM_ [2 .. n] $ \x -> let
    px = spfs ! x
    y = quot x px
    py = spfs ! y
    in  do
    prev <- readArray ans y
    writeArray ans x $ prev * if  px == py  then  px  else  px - 1
  pure ans

solve :: Int -> [Int] -> Int
solve n aLi = let
  a :: UArray Int Int
  a = listArray (1, n) aLi
  maxa = foldl' max n $ elems a

  spfs = getSPFs maxa
  phi = getEulerPhi spfs

  primeList = filter (\q -> spfs ! q == q) [1 .. n]
  nPrimes = length primeList
  primes :: UArray Int Int
  primes = listArray (1, nPrimes) primeList

  getPrimeFactors :: Int -> [Int]
  getPrimeFactors 1 = []
  getPrimeFactors x = let
    px = spfs ! x
    in  px : getPrimeFactors (quot x px)

  getFactors :: Int -> [Int]
  getFactors x = let
    opts = map (scanl' (*) 1) $ group $ getPrimeFactors x
    in  foldr (liftM2 (*)) [1] opts

  incrAt :: STUArray s Int Int -> Int -> Int -> ST s ()
  incrAt arr ix amt = readArray arr ix >>= writeArray arr ix . (+ amt)

  insertSmall :: STUArray s Int Int -> [Int] -> ST s ()
  insertSmall arr vals = forM_ vals $ \x ->
    forM_ (getFactors x) $ \y -> incrAt arr y 1

  insertLarge :: STUArray s Int Int -> [Int] -> ST s ()
  insertLarge arr vals = do
    forM_ vals $ \x -> incrAt arr x 1
    forM_ (elems primes) $ \q -> do
      let  start = quot n q
      forM_ [start, start - 1 .. 1] $ \i ->
        readArray arr (q * i) >>= incrAt arr i

  in  runST $ do
  counts <- newArray (1, maxa) 0 :: ST s (STUArray s Int Int)
  (\fun -> foldM fun 0 [1 .. n]) $ \acc1 stride -> acc1 `seq` do
    let
      relas = map (a !) [stride, 2*stride .. n]
      isLarge = quot n stride >= 1000
      relixs = if  isLarge
        then  [1 .. maxa]
        else  concatMap getFactors relas
    if  isLarge
      then  insertLarge counts relas
      else  insertSmall counts relas
    cts <- getAssocs counts
    --traceShow ("stride", stride, "counts", cts, "acc1", acc1) $ pure ()
    newv <- (\fun -> foldM fun 0 relixs) $ \acc2 ix -> acc2 `seq` do
      ct <- readArray counts ix
      writeArray counts ix 0
      --traceShow ("ix", ix, "acc2", acc2, "ct", ct) $ pure ()
      pure $ acc2 +! phi ! ix *! ct *! ct
    --traceShow ("newv", newv) $ pure ()
    pure $ acc1 +! phi ! stride *! newv

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  aLi <- getInts n
  pure $ putInts [solve n aLi]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


Little walrus Fangy loves math very much. That's why when he is bored he plays with a number performing some operations.Fangy takes some positive integer x and wants to get a number one from it. While x is not equal to 1, Fangy repeats the following action: if x is odd, then he adds 1 to it, otherwise he divides x by 2. Fangy knows that for any positive integer number the process ends in finite time.How many actions should Fangy perform to get a number one from number x?

The first line contains a positive integer x in a binary system. It is guaranteed that the first digit of x is different from a zero and the number of its digits does not exceed 106.

NoteLet's consider the third sample. Number 101110 is even, which means that we should divide it by 2. After the dividing Fangy gets an odd number 10111 and adds one to it. Number 11000 can be divided by 2 three times in a row and get number 11. All that's left is to increase the number by one (we get 100), and then divide it by 2 two times in a row. As a result, we get 1.

module Main where

import Control.Monad
import Data.List

main = do
    s <- reverse `liftM` getLine

    let trailZero = length $ takeWhile (=='0') s
        s' = drop trailZero s
        res = trailZero + if null $ tail s'
            then 0
            else length ( filter (=='0') s' ) + length s' + 1

    putStrLn $ show res

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.Char

main = do
	input <- fmap (C.takeWhile (/='\r') . head . C.lines) $ C.hGetContents stdin
	let n = C.length input
	let z = C.count '0' input
	let o = C.count '1' input
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if o == 1 then 2 else 0

import Data.Char

main = do
	s <- getLine
	let a = map digitToInt $ reverse s
	print $ solve a 0

solve [1]    c 	    = c
solve (x:xs) c
	| x == c    = 1 + (solve xs c)
	| otherwise = 2 + (solve xs 1)

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

import Control.Applicative
import Control.DeepSeq (deepseq)
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 Data.STRef
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.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
-- import Debug.Trace
import System.IO
import System.Random

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

main = do
  s <- getLine

  let
    count "1" = 0
    count ('0':s) = 1 + count s
    count s = length s1 + 1 + count (if null s2 then "1" else '1':tail s2)
      where
        (s1, s2) = span (== '1') s

  print $ count $ reverse s

-- binares

solve ('1':[]) pl1 akk = akk+pl1
solve ('0':xs) pl1 akk = solve xs pl1 (akk+(1+pl1))
solve ('1':xs) pl1 akk = solve xs 1 (akk + (2-pl1))

main = do
			num <- getLine
			print $ solve (reverse num) 0 0

import Debug.Trace

solve :: [Int] -> Int
solve x = solve' (reverse x) 0
  where
    solve' [1] 0 = 0
    solve' [1] 1 = 1
    solve' (x:xs) c =
      case (x + c) of
        0 -> 1 + (solve' xs 0)
        1 -> 2 + (solve' xs 1)
        2 -> 1 + (solve' xs 1)

solver :: String -> String
solver str = show $ solve $ map (\x -> if x == '0' then 0 else 1) ((lines str) !! 0)

main :: IO ()
main = interact solver

import List (group)

solve :: String -> Int
solve  =  solve' 0 . group . reverse
  where
    solve' acc [x]
      | length x == 1  =  acc
      | otherwise  =  acc + 1 + length x
    solve' acc [x,y]  =  solve' (acc + length x) [y]
    solve' acc (x:y:z:xs)
      | head x == '0'  =  solve' (acc + length x) (y:z:xs)
      | otherwise  =  solve' (acc + 2 * length y + length x - 1) (('1':z):xs)

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

countzero [] n = n
countzero ('0':xs) n = countzero xs (n+1)
countzero ('1':xs) n = countzero xs n

solve digits = let digits' = dropWhile (=='0') digits
               in
                 if digits' == "1" then
                     (length digits) -1
                 else
                     (length digits)+1+(countzero digits' 0)

main = getLine>>=print.solve.reverse

import qualified Data.Char as C

solve :: [Int] -> Int
solve = loop 0

loop acc [1] = acc
loop acc [0] = acc + 1
loop acc (0:foo) = loop (acc + 1) foo
loop acc foo@(1:_) = loop' (acc + 1) foo

loop' acc (1:foo) = loop' (1 + acc) foo
loop' acc (0:foo) = loop acc (1:foo)
loop' acc [] = loop acc [1]

parse :: String -> [Int]
parse = reverse . map C.digitToInt . filter (/= '\n')

main = interact (show . solve . parse)

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.Char

main = do
	input <- fmap (head . C.lines) $ C.hGetContents stdin
	let z = C.count '0' input
	let o = C.count '1' input
	let n = z + o
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if o == 1 then 2 else 0

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

main = do
	input <- fmap (head . C.lines) $ C.hGetContents stdin
	let n = C.length input
	let z = C.count '0' input
	print n
	print z
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if n - z == 1 then 2 else 0

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

main = do
	input <- fmap (head . C.lines) $ C.hGetContents stdin
	let n = C.length input
	let z = C.count '0' input
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if n - z == 1 then 2 else 0

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.Char

main = do
	input <- fmap (head . C.lines) $ C.hGetContents stdin
	let n = C.length input
	let z = C.count '0' input
	print $ ord $ C.index input 1
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if n - z == 1 then 2 else 0

-- binares

solve ('1':[]) pl1 akk = if (pl1 == 0) then akk else akk+1
solve ('0':xs) pl1 akk = if (pl1 == 0) then solve xs pl1 (akk+1) else solve ('1':xs) (pl1-1) (akk+1)
solve ('1':xs) pl1 akk = if (pl1 == 1) then solve xs (pl1-1) (akk + 1) else solve xs (pl1+1) (akk+2)

main = do
			num <- getLine
			print $ solve (reverse num) 0 0

import Data.Char

bToD [] n = n
bToD (x:xs) n = bToD xs (n*2+(ord x - ord '0'))

solve n = rec (bToD n 0) 0
    where
      rec x n |x<8 = ([0,0,1,3,2,5,4,4]!!x)+n
              |otherwise = case mod x 8 of
                             0 -> rec (div x 8) (n+3)
                             1 -> rec ((div x 8)+1) (n+6)
                             2 -> rec ((div x 8)+1) (n+5)
                             3 -> rec ((div x 8)+1) (n+5)
                             4 -> rec ((div x 8)+2) (n+5)
                             5 -> rec ((div x 8)+2) (n+6)
                             6 -> rec ((div x 8)+2) (n+5)
                             7 -> rec ((div x 8)+1) (n+4)

main = getLine>>=print.solve

import Data.Char

bToD [] n = n
bToD (x:xs) n = bToD xs (n*2+(ord x - ord '0'))

solve n = rec (bToD n 0) 0
    where
      rec x n |x<8 = ([0,0,1,3,2,5,4,4]!!x)+n
              |otherwise = case mod x 8 of
                             0 -> rec (div x 8) (n+3)
                             1 -> rec ((div x 8)+1) (n+6)
                             2 -> rec ((div x 8)+1) (n+5)
                             3 -> rec ((div x 8)+1) (n+5)
                             4 -> rec ((div x 8)+2) (n+5)
                             5 -> rec ((div x 8)+2) (n+6)
                             6 -> rec ((div x 8)+1) (n+4)
                             7 -> rec ((div x 8)+1) (n+4)
main = getLine>>=print.solve


And again a misfortune fell on Poor Student. He is being late for an exam.Having rushed to a bus stop that is in point (0, 0), he got on a minibus and they drove along a straight line, parallel to axis OX, in the direction of increasing x.Poor Student knows the following:   during one run the minibus makes n stops, the i-th stop is in point (xi, 0)  coordinates of all the stops are different  the minibus drives at a constant speed, equal to vb  it can be assumed the passengers get on and off the minibus at a bus stop momentarily  Student can get off the minibus only at a bus stop  Student will have to get off the minibus at a terminal stop, if he does not get off earlier  the University, where the exam will be held, is in point (xu, yu)  Student can run from a bus stop to the University at a constant speed vs as long as needed  a distance between two points can be calculated according to the following formula:   Student is already on the minibus, so, he cannot get off at the first bus stop Poor Student wants to get to the University as soon as possible. Help him to choose the bus stop, where he should get off. If such bus stops are multiple, choose the bus stop closest to the University.

The first line contains three integer numbers: 2 ≤ n ≤ 100, 1 ≤ vb, vs ≤ 1000. The second line contains n non-negative integers in ascending order: coordinates xi of the bus stop with index i. It is guaranteed that x1 equals to zero, and xn ≤ 105. The third line contains the coordinates of the University, integers xu and yu, not exceeding 105 in absolute value.

In the only line output the answer to the problem — index of the optimum bus stop.

NoteAs you know, students are a special sort of people, and minibuses usually do not hurry. That's why you should not be surprised, if Student's speed is higher than the speed of the minibus.

import Control.Monad
import Data.List
import Data.Monoid
import Data.Ord

double = read :: String -> Double
doubles = map double . words <$> getLine
dist x y b = sqrt $ ( b - x) **2 + y**2
main = do
    [[n,vb,vs],bs,[x,y]] <- replicateM 3 doubles
    print $ fst $ head $ sortBy (comparing snd `mappend` flip (comparing fst) ) $ zip [2..]  $ map (\z -> z/vb  + (dist x y z)/vs  ) $ tail bs

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

type I  =  Integer

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

solve :: (Floating d, Ord d) => d -> d -> (d, d) -> [d] -> Int
solve vs vb (xu, yu) xs  =  solve' $ tail $ zip [1..] xs
  where
    solve' [(ni, xi)]  =  ni
    solve' ((ni, xi) : (nj, xj) : xs)
      | (xj - xi) / vs + sqrt ((xu - xj)^2 + yu^2) / vb <= sqrt ((xu - xi)^2 + yu^2) / vb
        =  solve' ((nj, xj) : xs)
      | otherwise  =  ni

main :: IO ()
main  =  do
    [n, vs, vb]  <-  reads
    xs  <-  reads
    [xu, yu]  <-  reads
    print $ solve vs vb (xu, yu) xs

import Data.Functor

type Pos = (Double, Double)

distance :: Pos -> Pos -> Double
distance (x1, y1) (x2, y2) = sqrt $ (x2 - x1) ^ 2 + (y2 - y1) ^ 2

trd :: (a, b, c) -> c
trd (_, _, c) = c

main = do
    n:vb:vs:_ <- map read . words <$> getLine
    poss <- tail . map read . words <$> getLine
    xu:yu:_ <- map read . words <$> getLine
    let step (i, xs) x = (i + 1, f i x : xs)
        f i x = ((distance (xu, yu) (x, 0)) / vs + x / vb
                , distance (xu, yu) (x, 0), i)
        shortest = minimum $ snd $ foldl step (2, []) poss
    print $ trd shortest

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

type Time = Double
type Distance = Double
type Estimatation = (Distance, Time)

conv :: Double -> Double -> (Double, Double) -> [Time] -> [Estimatation]
conv vb vs univ@(ux, uy) = do
  let distance sx = sqrt $ (ux - sx) ^ 2 + uy ^ 2
  let time (d, sx) = (d, sx / vb + d / vs)
  map (time . (distance >>= (,)))

check :: [Estimatation] -> String
check = do
  let epsilon = 1e-9
  let f (_, (d1, t1)) (_, (d2, t2))
        | abs (t2 - t1) <= epsilon = compare d1 d2
        | otherwise                = compare t1 t2

  (idx, _) <- minimumBy f . drop 1 . zip [1 ..]
  return $ show idx

solve :: [String] -> [String]
solve = fmap return $ do
  let toDoubles = map read . words . head
  [vb, vs] <- drop 1 . toDoubles
  ts       <- toDoubles . drop 1
  [ux, uy] <- toDoubles . drop 2
  let es = conv vb vs (ux, uy) ts
  return $ check es

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

import Control.Monad
import Data.List

double = read :: String -> Double
doubles = map double . words <$> getLine
dist x y b = sqrt $ ( b - x) **2 + y**2
main = do
    [[n,vb,vs],bs,[x,y]] <- replicateM 3 doubles
    print $  fst $ head $  sortOn snd $ zip [2..] $ map (\z -> z/vb  + (dist x y z)/vs  ) $ tail bs

import Control.Monad
import Data.List

double = read :: String -> Double
doubles = map double . words <$> getLine
dist x y b = sqrt $ ( b - x) **2 + y**2
main = do
    [[n,vb,vs],bs,[x,y]] <- replicateM 3 doubles
    print $ fst $ head $ sortOn snd $ zip [2..] $ map (\z -> z/vb + dist x y z ) $ tail bs

import Data.Functor

type Pos = (Double, Double)

distance :: Pos -> Pos -> Double
distance (x1, y1) (x2, y2) = (x2 - x1) ^ 2 + (y2 - y1) ^ 2

trd :: (a, b, c) -> c
trd (_, _, c) = c

main = do
    n:vb:vs:_ <- map read . words <$> getLine
    poss <- map read . words <$> getLine
    xu:yu:_ <- map read . words <$> getLine
    let step (i, xs) x = (i + 1, f i x : xs)
        f i x = ((distance (xu, yu) (x, 0)) / vs + x / vb
                , distance (xu, yu) (x, 0), i)
        shortest = minimum $ snd $ foldl step (1, []) poss
    print $ trd shortest
  where

import Data.Functor

type Pos = (Double, Double)

distance :: Pos -> Pos -> Double
distance (x1, y1) (x2, y2) = (x2 - x1) ^ 2 + (y2 - y1) ^ 2

trd :: (a, b, c) -> c
trd (_, _, c) = c

main = do
    n:vb:vs:_ <- map read . words <$> getLine
    poss <- map read . words <$> getLine
    xu:yu:_ <- map read . words <$> getLine
    let step (i, xs) x = (i + 1, f i x : xs)
        f i x = ((distance (xu, yu) (x, 0)) / vs + x / vb, - x, i)
        shortest = minimum $ snd $ foldl step (1, []) poss
    print $ trd shortest
  where

import Data.Functor

type Pos = (Double, Double)

distance :: Pos -> Pos -> Double
distance (x1, y1) (x2, y2) = sqrt $ (x2 - x1) ^ 2 + (y2 - y1) ^ 2

trd :: (a, b, c) -> c
trd (_, _, c) = c

main = do
    n:vb:vs:_ <- map read . words <$> getLine
    poss <- map read . words <$> getLine
    xu:yu:_ <- map read . words <$> getLine
    let step (i, xs) x = (i + 1, f i x : xs)
        f i x = ((distance (xu, yu) (x, 0)) / vs + x / vb
                , distance (xu, yu) (x, 0), i)
        shortest = minimum $ snd $ foldl step (1, []) poss
    print $ trd shortest


Petya once wrote a sad love song and shared it to Vasya. The song is a string consisting of lowercase English letters. Vasya made up $$$q$$$ questions about this song. Each question is about a subsegment of the song starting from the $$$l$$$-th letter to the $$$r$$$-th letter. Vasya considers a substring made up from characters on this segment and repeats each letter in the subsegment $$$k$$$ times, where $$$k$$$ is the index of the corresponding letter in the alphabet. For example, if the question is about the substring "abbcb", then Vasya repeats letter 'a' once, each of the letters 'b' twice, letter 'c" three times, so that the resulting string is "abbbbcccbb", its length is $$$10$$$. Vasya is interested about the length of the resulting string.Help Petya find the length of each string obtained by Vasya.

The first line contains two integers $$$n$$$ and $$$q$$$ ($$$1\leq n\leq 100\,000$$$, $$$1\leq q \leq 100\,000$$$) — the length of the song and the number of questions.  The second line contains one string $$$s$$$ — the song, consisting of $$$n$$$ lowercase letters of English letters. Vasya's questions are contained in the next $$$q$$$ lines. Each line contains two integers $$$l$$$ and $$$r$$$ ($$$1 \leq l \leq r \leq n$$$) — the bounds of the question.

Print $$$q$$$ lines: for each question print the length of the string obtained by Vasya.

NoteIn the first example Vasya is interested in three questions. In the first question Vasya considers the substring "aba", that transforms to "abba", so the answer is equal to $$$4$$$. In the second question Vasya considers "baca", that transforms to "bbaccca", so the answer is $$$7$$$. In the third question Vasya considers the string "abacaba",that transforms to "abbacccabba" of length $$$11$$$.

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

printResult s n = do
    [l,r] <- readInts
    let
        a = listArray (0,n-1) $ map (\x -> ord x - 96) s
        b = array (0,n) ((0,0):[(i,a!(i-1)+b!(i-1))|i<-[1..n]])
    print $ b ! r - b ! (l-1)

main = do
    [n,q] <- readInts
    s <- getLine
    replicateM_ q $ printResult s n

import Control.Monad (forM_)
import qualified Data.Map as M (fromList, lookup)
import qualified Data.Sequence as S (fromList, lookup)
import Data.Maybe (fromMaybe)

main :: IO ()
main = do
  [n, q] <- pure . map read . words =<< getLine
  dct <- pure . M.fromList $ zip ['a'..'z'] [1..]
  arr <- pure . S.fromList
            . (0 :) . scanl1 (+) . fromMaybe []
            . sequence . map (flip M.lookup dct)
            =<< getLine
  forM_ [1..q] $ \_ -> do
    [l, r] <- pure . map read . words =<< getLine
    [t, b] <- pure . fromMaybe [0, 0] . sequence
            $ [S.lookup r arr, S.lookup (l - 1) $ arr]
    putStrLn . show $ t - b


You have k pieces of laundry, each of which you want to wash, dry and fold. You are at a laundromat that has n1 washing machines, n2 drying machines and n3 folding machines. Each machine can process only one piece of laundry at a time. You can't dry a piece of laundry before it is washed, and you can't fold it before it is dried. Moreover, after a piece of laundry is washed, it needs to be immediately moved into a drying machine, and after it is dried, it needs to be immediately moved into a folding machine.It takes t1 minutes to wash one piece of laundry in a washing machine, t2 minutes to dry it in a drying machine, and t3 minutes to fold it in a folding machine. Find the smallest number of minutes that is enough to wash, dry and fold all the laundry you have.

The only line of the input contains seven integers: k, n1, n2, n3, t1, t2, t3 (1 ≤ k ≤ 104; 1 ≤ n1, n2, n3, t1, t2, t3 ≤ 1000).

Print one integer — smallest number of minutes to do all your laundry.

NoteIn the first example there's one instance of each machine, each taking 5 minutes to complete. You have only one piece of laundry, so it takes 15 minutes to process it.In the second example you start washing first two pieces at moment 0. If you start the third piece of laundry immediately, then by the time it is dried, there will be no folding machine available, so you have to wait, and start washing third piece at moment 2. Similarly, you can't start washing next piece until moment 5, since otherwise there will be no dryer available, when it is washed. Start time for each of the eight pieces of laundry is 0, 0, 2, 5, 10, 10, 12 and 15 minutes respectively. The last piece of laundry will be ready after 15 + 10 + 5 + 2 = 32 minutes.

{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.Foldable as F
import qualified Data.Traversable as T

import qualified Data.Sequence as Seq
import Data.Sequence (Seq, ViewL(..), ViewR(..), (|>))

data Cadre = Cadre {
    dt :: Int
    ,ts :: Seq Int
}

type Laundromat = [Cadre]

mkLaundromat :: [Int] -> [Int] -> Laundromat
mkLaundromat = zipWith $ \n t -> Cadre {dt = t, ts = Seq.replicate n 0}

main = do
    [k, n0, n1, n2, t0, t1, t2] <- fmap (map read . words) getLine
    putStrLn . show . run k $ mkLaundromat [n0, n1, n2] [t0, t1, t2]

run :: Int -> Laundromat -> Int
run k cs = t
    where _ :> t = Seq.viewr . ts . last $ iterate step cs !! k

step :: Laundromat -> Laundromat
step cs = snd $ T.mapAccumL rot nextT cs
    where
        rot t c@(Cadre {dt, ts = ts0}) = (t + dt, c {ts = ts |> (t + dt)})
            where _ :< ts = Seq.viewl ts0
        nextT = fst $ F.foldl accT (0, 0) cs
        accT (t0, dt0) (Cadre {dt, ts}) = (max t0 (t - dt0), dt0 + dt)
            where t :< _ = Seq.viewl ts

{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.Foldable as F

import qualified Data.Set as Set
import Data.Set (Set)

import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

data Machine = Machine {
    mI :: (Int, Int)
    ,mN :: Int
    ,mT0 :: Int
    ,mT1 :: Int
} deriving (Eq, Show)

newtype Start = Start { unStart :: Machine } deriving (Eq, Show)
instance Ord Start where
    compare a b = compare (aT, aI) (bT, bI)
        where
            Machine {mI = aI, mT0 = aT} = unStart a
            Machine {mI = bI, mT0 = bT} = unStart b

newtype End = End { unEnd :: Machine } deriving (Eq, Show)
instance Ord End where
    compare a b = compare (aT, aI) (bT, bI)
        where
            Machine {mI = aI, mT1 = aT} = unEnd a
            Machine {mI = bI, mT1 = bT} = unEnd b

data Cadre = Cadre {
    cN :: Int
    ,cT :: Int
    ,cF :: Set Start
    ,cL :: Set End
} deriving (Eq, Show)

mkCadre :: Int -> Int -> Int -> Cadre
mkCadre cI n t = Cadre {
    cN = n
    ,cT = t
    ,cF = Set.empty
    ,cL = Set.fromList [End $ Machine {
        mI = (cI, i)
        ,mN = 0
        ,mT0 = 0
        ,mT1 = 0
    } | i <- [0..n-1]]
}

data Laundromat = Laundromat Int (Seq Cadre) deriving (Eq, Show)

mkLaundromat :: Int -> [Int] -> [Int] -> Laundromat
mkLaundromat k ns ts =
     Laundromat 0 . (!! k) . iterate (Seq.adjust (inc 0) 0) . Seq.fromList $ zipWith3 mkCadre [0..] ns ts

main = do
    [k, n0, n1, n2, t0, t1, t2] <- fmap (map read . words) getLine
    putStrLn . show . run $ mkLaundromat k [n0, n1, n2] [t0, t1, t2]

run :: Laundromat -> Int
run l = case step l of
    Left t -> t
    Right l -> run l

next :: Seq Cadre -> Maybe Machine
next = fmap unStart . F.foldl' proc Nothing
    where
        proc Nothing c = start c
        proc (Just a) c = case start c of
            Nothing -> Just a
            Just b -> Just $ min a b

step :: Laundromat -> Either Int Laundromat
step (Laundromat t0 c0) = case next c0 of
    Nothing ->
        Left t0
    Just m@(Machine {mI = (cI, _), mT0}) ->
        let
            c = Seq.adjust (dec m) cI c0
            c1 = if cI+1 == Seq.length c then c else Seq.adjust (inc mT0) (cI+1) c
        in Right $ Laundromat mT0 c1

dec :: Machine -> Cadre -> Cadre
dec m0 c@(Cadre {cT}) = add m $ rm m0 c
    where
        m = case m0 of
            Machine {mN = 1} ->
                m0 {mN = 0, mT0 = 0, mT1 = 0}
            Machine {mN, mT0} ->
                m0 {mN = mN-1, mT0 = mT0+cT}

inc :: Int -> Cadre -> Cadre
inc t c@(Cadre {cT}) =add m $ rm m0 c
    where
        m0 = unEnd $ end c
        m = case m0 of
            Machine {mN = 0} ->
                m0 {mN = 1, mT0 = t+cT, mT1 = t+cT}
            Machine {mN, mT1} ->
                m0 {mN = mN+1, mT1 = mT1+cT}

start :: Cadre -> Maybe Start
start (Cadre {cF}) = if Set.null cF then Nothing else Just $ Set.findMin cF

end :: Cadre -> End
end = Set.findMin . cL

rm :: Machine -> Cadre -> Cadre
rm m c@(Cadre {cF, cL}) = c {cF = Set.delete (Start m) cF, cL = Set.delete (End m) cL}

add :: Machine -> Cadre -> Cadre
add m@(Machine {mN}) c@(Cadre {cF, cL}) = c {cF = f, cL = Set.insert (End m) cL}
    where f = if mN == 0 then cF else Set.insert (Start m) cF

{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.Foldable as F

import qualified Data.Set as Set
import Data.Set (Set)

import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

data Machine = Machine {
    mI :: (Int, Int)
    ,mT :: Int
    ,mN :: Int
    ,mT0 :: Int
    ,mT1 :: Int
} deriving (Eq, Show)

newtype Start = Start { unStart :: Machine } deriving (Eq, Show)
instance Ord Start where
    compare a b = compare (aT, aI) (bT, bI)
        where
            Machine {mI = aI, mT0 = aT} = unStart a
            Machine {mI = bI, mT0 = bT} = unStart b

newtype End = End { unEnd :: Machine } deriving (Eq, Show)
instance Ord End where
    compare a b = compare (aT, aI) (bT, bI)
        where
            Machine {mI = aI, mT1 = aT} = unEnd a
            Machine {mI = bI, mT1 = bT} = unEnd b

data Cadre = Cadre {
    cN :: Int
    ,cT :: Int
    ,cF :: Set Start
    ,cL :: Set End
} deriving (Eq, Show)

mkCadre :: Int -> Int -> Int -> Cadre
mkCadre cI n t = Cadre {
    cN = n
    ,cT = t
    ,cF = Set.empty
    ,cL = Set.fromList [End $ Machine {
        mI = (cI, i)
        ,mT = t
        ,mN = 0
        ,mT0 = 0
        ,mT1 = 0
    } | i <- [0..n-1]]
}

data Laundromat = Laundromat Int (Seq Cadre) deriving (Eq, Show)

mkLaundromat :: Int -> [Int] -> [Int] -> Laundromat
mkLaundromat k ns ts =
     Laundromat 0 . (!! k) . iterate (Seq.adjust (inc 0) 0) . Seq.fromList $ zipWith3 mkCadre [0..] ns ts

main = do
    [k, n0, n1, n2, t0, t1, t2] <- fmap (map read . words) getLine
    putStrLn . show . run $ mkLaundromat k [n0, n1, n2] [t0, t1, t2]

run :: Laundromat -> Int
run l = case step l of
    Left t -> t
    Right l -> run l

next :: Seq Cadre -> Maybe Machine
next = fmap unStart . F.foldl' proc Nothing
    where
        proc Nothing c = start c
        proc (Just a) c = case start c of
            Nothing -> Just a
            Just b -> Just $ min a b

step :: Laundromat -> Either Int Laundromat
step (Laundromat t0 c0) = case next c0 of
    Nothing ->
        Left t0
    Just m@(Machine {mI = (cI, _), mT0}) ->
        let
            c = Seq.adjust (dec m) cI c0
            c1 = if cI+1 == Seq.length c then c else Seq.adjust (inc mT0) (cI+1) c
        in Right $ Laundromat mT0 c1

dec :: Machine -> Cadre -> Cadre
dec m0 = add m . rm m0
    where m = case m0 of
            Machine {mN = 1} ->
                m0 {mN = 0, mT0 = 0, mT1 = 0}
            Machine {mT, mN, mT0} ->
                m0 {mN = mN-1, mT0 = mT0+mT}

inc :: Int -> Cadre -> Cadre
inc t c =
    let m@(Machine {mT, mN, mT0, mT1}) = unEnd $ end c
    in add (m {mN = mN+1, mT0 = if mN == 0 then t+mT else mT0, mT1 = mT1+mT}) $ rm m c

start :: Cadre -> Maybe Start
start (Cadre {cF}) = if Set.null cF then Nothing else Just $ Set.findMin cF

end :: Cadre -> End
end = Set.findMin . cL

rm :: Machine -> Cadre -> Cadre
rm m c@(Cadre {cF, cL}) = c {cF = Set.delete (Start m) cF, cL = Set.delete (End m) cL}

add :: Machine -> Cadre -> Cadre
add m@(Machine {mN}) c@(Cadre {cF, cL}) = c {cF = f, cL = Set.insert (End m) cL}
    where f = if mN == 0 then cF else Set.insert (Start m) cF

{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.Foldable as F
import qualified Data.Traversable as T

import qualified Data.Sequence as Seq
import Data.Sequence (Seq, ViewL(..), ViewR(..), (|>))

data Cadre = Cadre {
    dt :: Int
    ,ts :: Seq Int
}

type Laundromat = [Cadre]

mkLaundromat :: [Int] -> [Int] -> Laundromat
mkLaundromat = zipWith $ \n t -> Cadre {dt = t, ts = Seq.replicate n 0}

main = do
    [k, n0, n1, n2, t0, t1, t2] <- fmap (map read . words) getLine
    putStrLn . show . run k $ mkLaundromat [n0, n1, n2] [t0, t1, t2]

run :: Int -> Laundromat -> Int
run k cs = t
    where _ :> t = Seq.viewr . ts . last $ iterate step cs !! k

step :: Laundromat -> Laundromat
step cs = snd $ T.mapAccumL rot nextT cs
    where
        rot t c@(Cadre {dt, ts = ts0}) = (t + dt, c {ts = ts |> (t + dt)})
            where _ :< ts = Seq.viewl ts0
        nextT = fst $ F.foldl accT (0, 0) cs
        accT (t0, dt0) (Cadre {dt, ts}) = (max t0 (t - dt0 - dt), dt0 + dt)
            where t :< _ = Seq.viewl ts