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

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

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

import Data.List

main = do
    interact solve

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

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

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

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

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

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

type IntType = Int

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

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

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

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

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

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

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

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

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

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

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

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

type IntType = Int

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

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

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

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

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

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

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

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

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

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

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


module Main where

import Control.Monad

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

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

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

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

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

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

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

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

import Control.Monad
import Data.List

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

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


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

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

import Data.Array.Unboxed

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

type SIO = StateT P.ByteString IO

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

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

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

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

import Data.Map((!))

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

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

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

-- import Debug.Trace

type InType  = [Int]
type OutType = Int

inpLines :: Int
inpLines = 2

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

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

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

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

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

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

module Main where

import Control.Monad

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

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

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

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

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

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

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

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

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

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

    count as = count' as 0 0 0

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

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

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

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

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

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

main :: IO ()
main = interact solve

import Control.Monad

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

readInts :: IO [Int]
readInts = readArray

readInt :: IO Int
readInt = readLn

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

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

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

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

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

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

import Data.Map((!))

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

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

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


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

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

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

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

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

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

import Control.Monad;

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

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

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

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

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

import Control.Monad;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


import Data.List

read_int :: String -> Int
read_int = read

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

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

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

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8       as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap                 as IM
import qualified Data.IntSet                 as IS
import           Data.List
import qualified Data.Map                    as M
import           Data.Ord
import qualified Data.Set                    as S
import           Data.STRef
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Data.Word
import           Debug.Trace

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

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

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

import Data.List (sort)

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

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

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

  print $ ss `div` 2

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

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

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

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

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

import Control.Applicative

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

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

import Data.List

read_int :: String -> Int
read_int = read

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

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

import Data.List

read_int :: String -> Int
read_int = read

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

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

import Data.List

read_int :: String -> Int
read_int = read

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

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

import Data.List

read_int :: String -> Int
read_int = read

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

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