{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Int
import Data.Maybe
import Data.List
import Data.Array.Unboxed
import Data.Array.Base(unsafeAt)
import qualified Data.ByteString.Char8 as B
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
l2p (a:b:_) = (a,b)
mid :: Int -> Int -> Int
mid x y = fromIntegral $ (fromIntegral x + fromIntegral y :: Int64) `div` 2

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p a b = do
    if p a then a else go a b
    where
    go a b | b - a <= 1 = b
           | p m = go a m
           | otherwise = go m b
        where m = mid a b

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = binSearch (check n k arr [1..n-1]) 0 (cost as)
    where
    arr = listArray (1,n) (map fromIntegral as) :: UArray Int Int64

cost :: [Int] -> Int
cost as = maximum $ zipWith (\a b -> abs (a-b)) as (tail as)

check :: Int -> Int -> UArray Int Int64 -> [Int] -> Int -> Bool
check n k arr is obj = or $ zipWith (\v i -> v + i <= k) (go [0] is) [0..]
    where
    obj' = fromIntegral obj
    go :: [Int] -> [Int] -> [Int]
    go vs [] = vs
    go vs (i:is) = go (v:vs) is
        where
        v = f vs (i-1) 0 obj' i
        ai = unsafeAt arr i
        f :: [Int] -> Int -> Int -> Int64 -> Int -> Int
        f vs _ x _ m | null vs || x >= m = m
        f (v:vs) j x y m = f vs (j-1) (x+1) (y+obj') m'
            where
            aj = unsafeAt arr j
            m' | ai - aj > y || ai - aj < - y = m
               | otherwise = min m (v + x)

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Int
import Data.Maybe
import Data.List
import Data.Array.Unboxed
import Data.Array.Base(unsafeAt)
import qualified Data.ByteString.Char8 as B
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
l2p (a:b:_) = (a,b)
mid :: Int -> Int -> Int
mid x y = fromIntegral $ (fromIntegral x + fromIntegral y :: Int64) `div` 2

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p a b = do
    if p a then a else go a b
    where
    go a b | b - a <= 1 = b
           | p m = go a m
           | otherwise = go m b
        where m = mid a b

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = binSearch (check n k arr [1..n-1]) 0 (cost as)
    where
    arr = listArray (1,n) (map fromIntegral as) :: UArray Int Int64

cost :: [Int] -> Int
cost as = maximum $ zipWith (\a b -> abs (a-b)) as (tail as)

check :: Int -> Int -> UArray Int Int64 -> [Int] -> Int -> Bool
check n k arr is obj = minimum (zipWith (+) [0..] $ go [0] is) <= k
    where
    obj' = fromIntegral obj
    go :: [Int] -> [Int] -> [Int]
    go vs [] = vs
    go vs (i:is) = go (v:vs) is
        where
        v = f vs (i-1) 0 obj' i
        ai = unsafeAt arr i
        f :: [Int] -> Int -> Int -> Int64 -> Int -> Int
        f vs (-1) x y m = m
        f (v:vs) !j !x !y !m = f vs (j-1) (x+1) (y+obj') m'
            where
            aj = unsafeAt arr j
            m' | ai - aj > y || ai - aj < - y = m
               | otherwise = min m (v + x)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
l2p (a:b:_) = (a,b)

type UArray1 a = UArray Int a
type RecFun m a b = (a -> m b) -> a -> m b

class IArray UArray e => Unboxable e where
    newSTUArray_ :: forall s i. Ix i => (i, i) -> ST s (STUArray s i e)
    readSTUArray :: forall s i. Ix i => STUArray s i e -> i -> ST s e
    writeSTUArray :: forall s i. Ix i => STUArray s i e -> i -> e -> ST s ()

instance Unboxable Int where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

fixMemoUArray :: (Ix a,Unboxable b) => (a,a) -> (forall s . RecFun (ST s) a b) -> UArray a b
fixMemoUArray b f = runSTUArray $ do
    arr <- newSTUArray_ b
    forM_ (range b) $ \x -> f (\y -> readSTUArray arr y) x >>= writeSTUArray arr x
    return arr

mid :: Int -> Int -> Int
mid x y = fromIntegral $ (fromIntegral x + fromIntegral y :: Int64) `div` 2

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p a b = if p a then a else go a b
    where
    go a b | b - a <= 1 = b
           | p m        = go a m
           | otherwise  = go m b
        where m = mid a b

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = binSearch f 0 (cost as)
    where
    as' = listArray (1,n) (map fromIntegral as) :: UArray1 Int64
    f obj = minPos2 n as' (fromIntegral obj) <= k

cost :: [Int] -> Int
cost as = maximum $ zipWith (\a b -> abs (a-b)) as (tail as)

minPos :: Int -> UArray1 Int64 -> Int64 -> Int
minPos n as obj = minimum $ zipWith (+) [n-1,n-2..] (elems dp)
    where
    dp :: UArray1 Int
    dp = fixMemoUArray (1,n) f
    f :: RecFun (ST s) Int Int
    f _ 1 = return 0
    f g i = h (i-1) 1 (i-1)
        where
        a = as ! i
        check j x = inRange (a - x * obj, a + x * obj) (as ! j)
        h  j  x m | j == 0 || i - 1 - j >= m = return m
        h !j !x !m | check j x = g j >>= (\v -> h (j-1) (x+1) $ min m (v+i-1-j))
                | otherwise = h (j-1) (x+1) m

minPos1 :: Int -> UArray1 Int64 -> Int64 -> Int
minPos1 n as obj = minimum $ zipWith (+) [n-1,n-2..] (elems dp)
    where
    dp :: Array Int Int
    dp = listArray (1,n) [f i | i <- [1..n]]
    f 1 = 0
    f i = h (i-1) 1 (i-1)
        where
        a = as ! i
        check j x = inRange (a - x * obj, a + x * obj) (as ! j)
        h 0   x m = m
        h !j !x !m {- | i - 1 - j >= m = m-}
                   | check j x  = h (j-1) (x+1) $ min m ((dp!j)+i-1-j)
                   | otherwise = h (j-1) (x+1) m

minPos2 :: Int -> UArray1 Int64 -> Int64 -> Int
minPos2 n as obj = minimum $ zipWith (+) [n-1,n-2..] (elems dp)
    where
    check a j x = inRange (a - x * obj, a + x * obj) (as ! j)
    dp :: UArray1 Int
    dp = runSTUArray $ do
        memo <- newArray_ (1,n)
        writeArray memo 1 0
        forM_ [1..n] $ \i -> do
            let a = as ! i
            writeArray memo i (i-1)
            h memo a i (i-1) (i-1)
        return memo
    h memo a i j m | i - 1 - j >= m = return ()
    h memo a i j m =
        if check a j (fromIntegral $ i-j) then do
            v <- readArray memo j
            let m' = min m (v+i-1-j)
            writeArray memo i m'
            h memo a i (j-1) m'
        else
            h memo a i (j-1) m

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.Int
import Data.Maybe
import Data.List
import Data.Array.Unboxed
--{-
import qualified Data.ByteString.Char8 as B
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
---}

--readInt :: String -> Int
--readInt = read
--readInts = map readInt . words <$> getLine
--readIntPair = l2p . map readInt . take 2 . words <$> getLine
l2p (a:b:_) = (a,b)

{-# INLINE mid #-}
mid :: Int -> Int -> Int
mid x y = fromIntegral $ (fromIntegral x + fromIntegral y :: Int64) `div` 2

{-# INLINE binSearch #-}
binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p a b = do
    if p a then a else go a b
    where
    go a b | b - a <= 1 = b
           | p m = go a m
           | otherwise = go m b
        where m = mid a b

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = binSearch f 0 (cost as)
    where
    --ass = drop 2 $ reverse $ tails $ reverse $ map fromIntegral as
    arr = listArray (1,n) (map fromIntegral as) :: UArray Int Int64
    {-# INLINE f #-}
    f obj = (<=k) $ minPos n arr (fromIntegral obj)

cost :: [Int] -> Int
cost as = maximum $ zipWith (\a b -> abs (a-b)) as (tail as)

minPos :: Int -> UArray Int Int64 -> Int64 -> Int
minPos n arr obj = minimum $ zipWith (+) [0..] $ go [0] [1..]
    where
    go :: [Int] -> [Int] -> [Int]
    go vs (i:is) | i >= n = vs
    go vs (i:is) = go (v:vs) is
        where
        v = f vs i 0 obj i
        ai = arr ! (i+1)
        {-# INLINE f #-}
        f :: [Int] -> Int -> Int -> Int64 -> Int -> Int
        f vs j x y m | x >= m = m
        f (v:vs) !j !x !y !m = f vs (j-1) (x+1) (y+obj) m'
            where
            aj = arr ! j
            m' | ai - aj > y || ai - aj < -y = m
               | otherwise = min m (v + x)

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Int
import Data.Maybe
import Data.List
import Data.Array.Unboxed
import Data.Array.Base(unsafeAt)
import qualified Data.ByteString.Char8 as B
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
l2p (a:b:_) = (a,b)
{-# INLINE mid #-}
mid :: Int -> Int -> Int
mid x y = fromIntegral $ (fromIntegral x + fromIntegral y :: Int64) `div` 2

{-# INLINE binSearch #-}
binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p a b = do
    if p a then a else go a b
    where
    go a b | b - a <= 1 = b
           | p m = go a m
           | otherwise = go m b
        where m = mid a b

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = binSearch f 0 (cost as)
    where
    arr = listArray (1,n) (map fromIntegral as) :: UArray Int Int64
    {-# INLINE f #-}
    f obj = (<=k) $ minPos n arr (fromIntegral obj)

cost :: [Int] -> Int
cost as = maximum $ zipWith (\a b -> abs (a-b)) as (tail as)

minPos :: Int -> UArray Int Int64 -> Int64 -> Int
minPos n arr obj = minimum $ zipWith (+) [0..] $ go [0] [1..]
    where
    go :: [Int] -> [Int] -> [Int]
    go vs (i:is) | i >= n = vs
    go vs (i:is) = go (v:vs) is
        where
        v = f vs i 0 obj i
        ai = unsafeAt arr i
        {-# INLINE f #-}
        f :: [Int] -> Int -> Int -> Int64 -> Int -> Int
        f vs j x y m | x >= m = m
        f (v:vs) !j !x !y !m = f vs (j-1) (x+1) (y+obj) m'
            where
            aj = unsafeAt arr (j-1)
            m' | ai - aj > y || ai - aj < -y = m
               | otherwise = min m (v + x)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
l2p (a:b:_) = (a,b)

type UArray1 a = UArray Int a
type RecFun m a b = (a -> m b) -> a -> m b

class IArray UArray e => Unboxable e where
    newSTUArray_ :: forall s i. Ix i => (i, i) -> ST s (STUArray s i e)
    readSTUArray :: forall s i. Ix i => STUArray s i e -> i -> ST s e
    writeSTUArray :: forall s i. Ix i => STUArray s i e -> i -> e -> ST s ()

instance Unboxable Int where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

fixMemoUArray :: (Ix a,Unboxable b) => (a,a) -> (forall s . RecFun (ST s) a b) -> UArray a b
fixMemoUArray b f = runSTUArray $ do
    arr <- newSTUArray_ b
    forM_ (range b) $ \x -> f (\y -> readSTUArray arr y) x >>= writeSTUArray arr x
    return arr

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p a b = if p a then a else go a b
    where
    go a b | b - a <= 1 = b
           | p m        = go a m
           | otherwise  = go m b
        where m = (a + b) `div` 2

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = binSearch f 0 (cost as)
    where
    as' = listArray (1,n) (map fromIntegral as) :: UArray1 Int64
    f obj = minPos n as' (fromIntegral obj) <= k

cost :: [Int] -> Int
cost as = maximum $ zipWith (\a b -> abs (a-b)) as (tail as)

minPos :: Int -> UArray1 Int64 -> Int64 -> Int
minPos n as obj = minimum $ zipWith (+) [n-1,n-2..] (elems dp)
    where
    dp :: UArray1 Int
    dp = fixMemoUArray (1,n) f
    f :: RecFun (ST s) Int Int
    f _ 1 = return 0
    f g i = minimum . catMaybes <$> zipWithM h [i-1,i-2..0] [1..]
        where
        a = as ! i
        check j x = inRange (a - x * obj, a + x * obj) (as ! j)
        h 0 _ = return $ Just (i-1)
        h j x | check j x = (\v -> Just $ v+i-1-j) <$> g j
              | otherwise = return Nothing

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Int
import Data.Maybe
import Data.List
import Data.Array.Unboxed
import Data.Array.Base(unsafeAt)
import qualified Data.ByteString.Char8 as B
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
l2p (a:b:_) = (a,b)
mid :: Int -> Int -> Int
mid x y = fromIntegral $ (fromIntegral x + fromIntegral y :: Int64) `div` 2

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p a b = do
    if p a then a else go a b
    where
    go a b | b - a <= 1 = b
           | p m = go a m
           | otherwise = go m b
        where m = mid a b

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = binSearch (check n k arr [1..n-1]) 0 (cost as)
    where
    arr = listArray (1,n) (map fromIntegral as) :: UArray Int Int64

cost :: [Int] -> Int
cost as = maximum $ zipWith (\a b -> abs (a-b)) as (tail as)

check :: Int -> Int -> UArray Int Int64 -> [Int] -> Int -> Bool
check n k arr is obj = minimum (zipWith (+) [0..] $ go [0] is) <= k
    where
    obj' = fromIntegral obj
    go :: [Int] -> [Int] -> [Int]
    go vs [] = vs
    go vs (i:is) = go (v:vs) is
        where
        v = f vs (i-1) 0 obj' i
        ai = unsafeAt arr i
        f :: [Int] -> Int -> Int -> Int64 -> Int -> Int
        f vs 0 x y m = m
        f (v:vs) !j !x !y !m = f vs (j-1) (x+1) (y+obj') m'
            where
            aj = unsafeAt arr j
            m' | ai - aj > y || ai - aj < - y = m
               | otherwise = min m (v + x)

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Int
import Data.Maybe
import Data.List
import Data.Array.Unboxed
import Data.Array.Base(unsafeAt)
import qualified Data.ByteString.Char8 as B
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
l2p (a:b:_) = (a,b)
{-# INLINE mid #-}
mid :: Int -> Int -> Int
mid x y = fromIntegral $ (fromIntegral x + fromIntegral y :: Int64) `div` 2

{-# INLINE binSearch #-}
binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p a b = do
    if p a then a else go a b
    where
    go a b | b - a <= 1 = b
           | p m = go a m
           | otherwise = go m b
        where m = mid a b

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = binSearch f 0 (cost as)
    where
    arr = listArray (1,n) (map fromIntegral as) :: UArray Int Int64
    {-# INLINE f #-}
    f obj = (<=k) $ minPos n arr (fromIntegral obj)

cost :: [Int] -> Int
cost as = maximum $ zipWith (\a b -> abs (a-b)) as (tail as)

minPos :: Int -> UArray Int Int64 -> Int64 -> Int
minPos n arr obj = minimum $ zipWith (+) [0..] $ go [0] [1..]
    where
    go :: [Int] -> [Int] -> [Int]
    go vs (i:is) | i >= n = vs
    go vs (i:is) = go (v:vs) is
        where
        v = f vs i 0 obj i
        ai = unsafeAt arr (i+1)
        {-# INLINE f #-}
        f :: [Int] -> Int -> Int -> Int64 -> Int -> Int
        f vs j x y m | x >= m = m
        f (v:vs) !j !x !y !m = f vs (j-1) (x+1) (y+obj) m'
            where
            aj = unsafeAt arr j
            m' | ai - aj > y || ai - aj < -y = m
               | otherwise = min m (v + x)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a
type RecFun m a b = (a -> m b) -> a -> m b

class IArray UArray e => Unboxable e where
    newSTUArray_ :: forall s i. Ix i => (i, i) -> ST s (STUArray s i e)
    readSTUArray :: forall s i. Ix i => STUArray s i e -> i -> ST s e
    writeSTUArray :: forall s i. Ix i => STUArray s i e -> i -> e -> ST s ()

instance Unboxable Int where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

fixMemoUArray :: (Ix a,Unboxable b) => (a,a) -> (forall s . RecFun (ST s) a b) -> UArray a b
fixMemoUArray b f = runSTUArray $ do
    arr <- newSTUArray_ b
    forM_ (range b) $ \x -> f (\y -> readSTUArray arr y) x >>= writeSTUArray arr x
    return arr

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = binSearch f 0 (cost as)
    where
        as' :: UArray1 Int
        as' = listArray (1,n) as
        f obj = minPos n as' (fromIntegral obj) <= k

cost :: [Int] -> Int
cost as = maximum $ zipWith (\a b -> abs (a-b)) as (tail as)

minPos :: Int -> UArray1 Int -> Int64 -> Int
minPos n as obj = minimum $ zipWith (+) [n-1,n-2..] (elems dp)
    where
    dp :: UArray1 Int
    dp = fixMemoUArray (1,n) f
    f :: RecFun (ST s) Int Int
    f g 1 = return 0
    f g i = go (i-1) (i-1)
        where
        a = fromIntegral (as ! i)
        go  0  m = return m
        go !j !m = do
            let x = fromIntegral (i - 1 - j+1)
                aj = fromIntegral (as ! j)
            v <- g j
            let m' | inRange (a - x * obj,a + x * obj) aj = min m (v+(i-1-j))
                   | otherwise =  m
            go (j-1) m'

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p a b = if p a then a else go a b
    where
    go a b | b - a <= 1 = b
           | p m        = go a m
           | otherwise  = go m b
               where m = (a + b) `div` 2

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

type IndexSet = S.Set (Int,Int)
singleton :: (Int,Int) -> IndexSet
singleton = S.singleton
expand :: IndexSet -> Int -> IndexSet
expand s c = S.fromAscList $ myunion $ map ((+) (-c) *** (+) c) $ S.elems s
dist s p = minimum $ map (dist1 p) $ S.elems s

dist1 c (a,b) | a <= c && c <= b = 0
              | otherwise = min (abs (a-c)) (abs (b-c))

append s p | dist s p == 0 = s
           | otherwise = S.insert (p,p) s

myunion (x:xs) = go x xs
    where
    go x [] = [x]
    go (a,b) ((c,d):xs) | c <= b = go (a,d) xs
                        | otherwise = (a,b):go (c,d) xs

inf :: Int
inf = 10^9

solve :: Int -> Int -> [Int] -> Int
solve n k as =  fst $ dp ! (n,k)
    where
    a :: UArray Int Int
    a = listArray (1,n) as
    dp :: Array (Int,Int) (Int,IndexSet)
    dp = listArray ((1,0),(n,k)) [ f i j | i <- [1..n], j <- [0..k]]
    f 1 0 = (0,singleton (a ! 1,a ! 1))
    f 1 j = (0,singleton (-inf,inf))
    f i 0 = let c = max (fst (dp ! (i-1,0))) (abs (a ! (i-1) - a ! i)) in
        (c,singleton (a ! i,a ! i))
    f i j | c3 < c4 = (c3,s3)
          | c4 < c3 = (c4,s4)
          | otherwise = (c3,append s4 (a ! i))
        where
        (c1,s1) = dp ! (i-1,j)
        (c2,s2) = dp ! (i-1,j-1)
        c3 = max c1 (dist s1 (a ! i))
        s3 = singleton (a ! i, a ! i)
        c4 = c2
        s4 = expand s2 c2


import Data.Char

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

c2o :: Char -> Int
c2o c = (ord c) - ord '0'

diff 12 = 0
diff n = n

--gettime tod h m
gettime a 12 m = dogettime a 0 m
gettime a h m = dogettime a h m

dogettime 'a' h m = h*60 + m
dogettime 'p' h m = (h+12)*60 + m

log2time ('[':a1:a2:':':b1:b2:' ':tod:_) =
    gettime tod ((c2o a1)*10 + (c2o a2)) ((c2o b1)*10 + (c2o b2))

count l n 10 = count l (n+1) 0
count [log] n doubles = n
count (l1:l2:ls) n doubles | l1 > l2 = count (l2:ls) (n+1) 0
                           | True    = count (l2:ls) n doubles2
        where doubles2 = if (l1 == l2) then (doubles+1) else 0

main :: IO ()
main = do
    s <- getLine
    let n:_ = un s
    log <- getLines n
    let times = map log2time log
        days = count times 1 0
    --putStrLn $ show times
    putStrLn $ show days

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad
import Text.Printf

import Data.Functor
import Data.IORef
import System.IO.Unsafe

import Data.List
import Data.Ord
import Data.Ratio

import Debug.Trace

sep :: Char -> String -> [String]
sep c s =  case dropWhile (c==) s of
  "" -> []
  s' -> w : sep c s''
    where (w, s'') = break (c==) s'

cut a b = drop a . take (b+1)

solve = do n <- read <$> getLine
           ts <- map f `liftM` replicateM n getLine
           let inc | length ts == 1 = 0
                   | last ts == 24*60 = 1
                   | True             = 0
               a = foldr (\xs v -> v + (length xs-1) `div` 10) 0 $ group ts
               b = length . filter id . zipWith (>) ts $ tail ts
           return . show $ a+b+1
  where
    f cs = let cs' = cut 1 7 cs
               hour' | last cs' == 'a' = 0
                     | True            = 12
               (h':m':[]) = sep ':' $ take 5 cs'
               hour | read h' == 12 = 0
                    | True          = read h'
           in (hour + hour') * 60 + read m'

main = putStrLn =<< solve

class Read' a where
  read' :: String -> a

instance Read' Rational where
  read' = toRational . (read :: String -> Integer)

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

import Data.Char

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

c2o :: Char -> Int
c2o c = (ord c) - ord '0'

log2time ('[':a1:a2:':':b1:b2:' ':tod:_) =
     ((c2o tod)*60*60*12 +
     ((c2o a1)*10 + (c2o a2))*60*60 +
     ((c2o b1)*10 + (c2o b2))*60)

count l n 10 = count l (n+1) 0
count [log] n doubles = n
count (l1:l2:ls) n doubles | l1 > l2 = count (l2:ls) (n+1) 0
                           | True    = count (l2:ls) n doubles2
        where doubles2 = if (l1 == l2) then (doubles+1) else doubles

main :: IO ()
main = do
    s <- getLine
    let n:_ = un s
    log <- getLines n
    let times = map log2time log
        days = count times 1 0
    --putStrLn $ show times
    putStrLn $ show days

import Data.Char

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

c2o :: Char -> Int
c2o c = (ord c) - ord '0'

diff 12 = 0
diff n = n

--gettime tod h m
gettime 'a' 12 m = gettime 'p' 0 m
gettime 'p' 12 m = gettime 'a' 0 m
gettime 'a' h m = h*60 + m
gettime 'p' h m = (h+12)*60 + m

log2time ('[':a1:a2:':':b1:b2:' ':tod:_) =
    gettime tod ((c2o a1)*10 + (c2o a2)) ((c2o b1)*10 + (c2o b2))

count l n 10 = count l (n+1) 0
count [log] n doubles = n
count (l1:l2:ls) n doubles | l1 > l2 = count (l2:ls) (n+1) 0
                           | True    = count (l2:ls) n doubles2
        where doubles2 = if (l1 == l2) then (doubles+1) else doubles

main :: IO ()
main = do
    s <- getLine
    let n:_ = un s
    log <- getLines n
    let times = map log2time log
        days = count times 1 0
    --putStrLn $ show times
    putStrLn $ show days

import Data.Char

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

c2o :: Char -> Int
c2o c = (ord c) - ord '0'

diff 12 = 0
diff n = n

log2time ('[':a1:a2:':':b1:b2:' ':tod:_) =
     ((d tod)*60*60*12 +
     (diff ((c2o a1)*10 + (c2o a2)))*60*60 +
     ((c2o b1)*10 + (c2o b2))*60)
    where d 'a' = 0
          d 'p' = 1

count l n 10 = count l (n+1) 0
count [log] n doubles = n
count (l1:l2:ls) n doubles | l1 > l2 = count (l2:ls) (n+1) 0
                           | True    = count (l2:ls) n doubles2
        where doubles2 = if (l1 == l2) then (doubles+1) else doubles

main :: IO ()
main = do
    s <- getLine
    let n:_ = un s
    log <- getLines n
    let times = map log2time log
        days = count times 1 0
    --putStrLn $ show times
    putStrLn $ show days

import Data.Char

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

c2o :: Char -> Int
c2o c = (ord c) - ord '0'

log2time ('[':a1:a2:':':b1:b2:' ':tod:_) =
     ((d tod)*60*60*12 +
     ((c2o a1)*10 + (c2o a2))*60*60 +
     ((c2o b1)*10 + (c2o b2))*60)
    where d 'a' = 0
          d 'p' = 1

count l n 10 = count l (n+1) 0
count [log] n doubles = n
count (l1:l2:ls) n doubles | l1 > l2 = count (l2:ls) (n+1) 0
                           | True    = count (l2:ls) n doubles2
        where doubles2 = if (l1 == l2) then (doubles+1) else doubles

main :: IO ()
main = do
    s <- getLine
    let n:_ = un s
    log <- getLines n
    let times = map log2time log
        days = count times 1 0
    --putStrLn $ show times
    putStrLn $ show days

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad
import Text.Printf

import Data.IORef
import System.IO.Unsafe

import Data.List
import Data.Ord
import Data.Ratio

import Debug.Trace

sep :: Char -> String -> [String]
sep c s =  case dropWhile (c==) s of
  "" -> []
  s' -> w : sep c s''
    where (w, s'') = break (c==) s'

cut a b = drop a . take (b+1)

solve = do n <- fmap read getLine
           ts <- map f `liftM` replicateM n getLine
           return . show . (1+) . length . filter id . zipWith (>) ts $ tail ts
  where
    f cs = let cs' = cut 1 7 cs
               hour' | last cs' == 'a' = 0
                     | True            = 12
               (h':m':[]) = sep ':' $ take 5 cs'
           in (read h' + hour') * 60 + read m'

main = putStrLn =<< solve

class Read' a where
  read' :: String -> a

instance Read' Rational where
  read' = toRational . (read :: String -> Integer)

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad
import Text.Printf

import Data.IORef
import System.IO.Unsafe

import Data.List
import Data.Ord
import Data.Ratio

import Debug.Trace

sep :: Char -> String -> [String]
sep c s =  case dropWhile (c==) s of
  "" -> []
  s' -> w : sep c s''
    where (w, s'') = break (c==) s'

cut a b = drop a . take (b+1)

solve = do n <- fmap read getLine
           ts <- map f `liftM` replicateM n getLine
           return . show . (1+) . length . filter id . zipWith (>) ts $ tail ts
  where
    f cs = let cs' = cut 1 7 cs
               hour' | last cs' == 'a' = 0
                     | True            = 12
               (h':m':[]) = sep ':' $ take 5 cs'
           in (`mod` (24*60)) $ (read h' + hour') * 60 + read m'

main = putStrLn =<< solve

class Read' a where
  read' :: String -> a

instance Read' Rational where
  read' = toRational . (read :: String -> Integer)

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad
import Text.Printf

import Data.IORef
import System.IO.Unsafe

import Data.List
import Data.Ord
import Data.Ratio

import Debug.Trace

sep :: Char -> String -> [String]
sep c s =  case dropWhile (c==) s of
  "" -> []
  s' -> w : sep c s''
    where (w, s'') = break (c==) s'

cut a b = drop a . take (b+1)

solve = do n <- fmap read getLine
           ts <- map f `liftM` replicateM n getLine
           let inc | length ts == 1 = 0
                   | last ts == 24*60 = 1
                   | True             = 0
           return . show . (1+) . length . filter id
             . zipWith (>) ts $ tail ts
  where
    f cs = g cs
    g cs = let cs' = cut 1 7 cs
               hour' | last cs' == 'a' = 0
                     | True            = 12
               (h':m':[]) = sep ':' $ take 5 cs'
           in ((read h' + hour') * 60 + read m') `mod` (24*60)

main = putStrLn =<< solve

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad
import Text.Printf

import Data.IORef
import System.IO.Unsafe

import Data.List
import Data.Ord
import Data.Ratio

import Debug.Trace

sep :: Char -> String -> [String]
sep c s =  case dropWhile (c==) s of
  "" -> []
  s' -> w : sep c s''
    where (w, s'') = break (c==) s'

cut a b = drop a . take (b+1)

solve = do n <- fmap read getLine
           ts <- map f `liftM` replicateM n getLine
           let inc | last ts == 24*60 = 1
                   | True             = 0
           return . show . (inc+1+) . length . filter id . zipWith (>) ts $ tail ts
  where
    f cs = let cs' = cut 1 7 cs
               hour' | last cs' == 'a' = 0
                     | True            = 12
               (h':m':[]) = sep ':' $ take 5 cs'
           in (read h' + hour') * 60 + read m'

main = putStrLn =<< solve

class Read' a where
  read' :: String -> a

instance Read' Rational where
  read' = toRational . (read :: String -> Integer)

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad
import Text.Printf

import Data.IORef
import System.IO.Unsafe

import Data.List
import Data.Ord
import Data.Ratio

import Debug.Trace

sep :: Char -> String -> [String]
sep c s =  case dropWhile (c==) s of
  "" -> []
  s' -> w : sep c s''
    where (w, s'') = break (c==) s'

cut a b = drop a . take (b+1)

solve = do n <- fmap read getLine
           ts <- map f `liftM` replicateM n getLine
           let inc | length ts == 1 = 0
                   | last ts == 24*60 = 1
                   | True             = 0
           return . show . (inc+1+) . length . filter id
             . zipWith (>) ts $ tail ts
  where
    f cs = g cs
    g cs = let cs' = cut 1 7 cs
               hour' | last cs' == 'a' = 0
                     | True            = 12
               (h':m':[]) = sep ':' $ take 5 cs'
           in (read h' + hour') * 60 + read m'

main = putStrLn =<< solve

class Read' a where
  read' :: String -> a

instance Read' Rational where
  read' = toRational . (read :: String -> Integer)

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad
import Text.Printf

import Data.Functor
import Data.IORef
import System.IO.Unsafe

import Data.List
import Data.Ord
import Data.Ratio

import Debug.Trace

sep :: Char -> String -> [String]
sep c s =  case dropWhile (c==) s of
  "" -> []
  s' -> w : sep c s''
    where (w, s'') = break (c==) s'

cut a b = drop a . take (b+1)

solve = do n <- read <$> getLine
           ts <- map f `liftM` replicateM n getLine
           let inc | length ts == 1 = 0
                   | last ts == 24*60 = 1
                   | True             = 0
               a = foldr (\xs v -> v + length xs `div` 10) 0 $ group ts
               b = length . filter id . zipWith (>) ts $ tail ts
           return . show $ a+b+1
  where
    f cs = let cs' = cut 1 7 cs
               hour' | last cs' == 'a' = 0
                     | True            = 12
               (h':m':[]) = sep ':' $ take 5 cs'
               hour | read h' == 12 = 0
                    | True          = read h'
           in (hour + hour') * 60 + read m'

main = putStrLn =<< solve

class Read' a where
  read' :: String -> a

instance Read' Rational where
  read' = toRational . (read :: String -> Integer)

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad
import Text.Printf

import Data.Functor
import Data.IORef
import System.IO.Unsafe

import Data.List
import Data.Ord
import Data.Ratio

import Debug.Trace

sep :: Char -> String -> [String]
sep c s =  case dropWhile (c==) s of
  "" -> []
  s' -> w : sep c s''
    where (w, s'') = break (c==) s'

cut a b = drop a . take (b+1)

solve = do n <- read <$> getLine
           ts <- map f `liftM` replicateM n getLine
           let inc | length ts == 1 = 0
                   | last ts == 24*60 = 1
                   | True             = 0
               a = foldr (\xs v -> v + length xs `div` 10) 0 $ group ts
               b = (1+) . length . filter id
                   . zipWith (>) ts $ tail ts
           return . show $ a+b
  where
    f cs = let cs' = cut 1 7 cs
               hour' | last cs' == 'a' = 0
                     | True            = 12
               (h':m':[]) = sep ':' $ take 5 cs'
           in ((read h' + hour') * 60 + read m') `mod` (24*60)

main = putStrLn =<< solve

class Read' a where
  read' :: String -> a

instance Read' Rational where
  read' = toRational . (read :: String -> Integer)

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

import Data.Char

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

c2o :: Char -> Int
c2o c = (ord c) - ord '0'

diff 12 = 0
diff n = n

--gettime tod h m
gettime 'a' 12 m = gettime 'a' 0 m
gettime 'p' 12 m = gettime 'a' 12 m
gettime 'a' h m = h*60 + m
gettime 'p' h m = (h+12)*60 + m

log2time ('[':a1:a2:':':b1:b2:' ':tod:_) =
    gettime tod ((c2o a1)*10 + (c2o a2)) ((c2o b1)*10 + (c2o b2))

count l n 10 = count l (n+1) 0
count [log] n doubles = n
count (l1:l2:ls) n doubles | l1 > l2 = count (l2:ls) (n+1) 0
                           | True    = count (l2:ls) n doubles2
        where doubles2 = if (l1 == l2) then (doubles+1) else doubles

main :: IO ()
main = do
    s <- getLine
    let n:_ = un s
    log <- getLines n
    let times = map log2time log
        days = count times 1 0
    --putStrLn $ show times
    putStrLn $ show days

import Data.Char

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

c2o :: Char -> Int
c2o c = (ord c) - ord '0'

diff 12 = 0
diff n = n

--gettime tod h m
gettime 'a' 12 m = dogettime 'a' 0 m
gettime 'p' 12 m = dogettime 'a' 12 m
gettime a h m = dogettime a h m

dogettime 'a' h m = h*60 + m
dogettime 'p' h m = (h+12)*60 + m

log2time ('[':a1:a2:':':b1:b2:' ':tod:_) =
    gettime tod ((c2o a1)*10 + (c2o a2)) ((c2o b1)*10 + (c2o b2))

count l n 10 = count l (n+1) 0
count [log] n doubles = n
count (l1:l2:ls) n doubles | l1 > l2 = count (l2:ls) (n+1) 0
                           | True    = count (l2:ls) n doubles2
        where doubles2 = if (l1 == l2) then (doubles+1) else doubles

main :: IO ()
main = do
    s <- getLine
    let n:_ = un s
    log <- getLines n
    let times = map log2time log
        days = count times 1 0
    --putStrLn $ show times
    putStrLn $ show days


-- Codeforces Round #533 Div.2 (A), Contest 1105, Problem set ?.
-- UNDONE

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (BS.readInt . BS.dropWhile (==' ')) <$> BS.getLine
  let (t,cost) =
        minimumBy (compare `on` snd) $
        map (\t ->(t,  sum $ filter (>0) $ map ((subtract 1).abs.(t-)) as))
        [1..100]
  putStrLn $ shows t $ ' ' : show cost

{-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
-- import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	n <- readInt
	as <- readInts
	let
		( c, t ) = minimum $ do
			t <- [ 1 .. 100 ]
			let
				c = sum $ filter ( 0 <= ) $ map ( pred . abs . subtract t ) as
			return ( c, t )
	printf "%d %d\n" t c


import Data.List
import Data.Char
import Control.Exception
import Control.Monad

readVal :: Read a => IO a
readVal = (return . read)  =<< getWord_ True
 where
  delimiter = (`elem` " \n")
  getWord_ :: Bool -> IO String
  getWord_ first = do
   c <- catch getChar ((\msg -> return ' ') :: IOException -> IO Char)
   if delimiter c
    then
     if first
      then getWord_ True
      else return ""
    else do
     xs <- getWord_ False
     return $ c : xs

solve' num n
	| n < 0 = -1
	| mod n 2 == 1 = solve' (num+1) (n-9)
	| mod n 4 == 0 = num + (div n 4)
	| otherwise = solve' (num+1) (n-6)

solve = solve' 0

subtask = print =<< fmap solve readVal

main = readVal >>= (flip replicateM_ subtask)

main = interact (unwords . map (show . solve . read) . tail . words)
solve 1 = -1 :: Int
solve 2 = -1
solve 3 = -1
solve 5 = -1
solve 7 = -1
solve 11 = -1
solve n = case quotRem n 4 of
  (q, 0) -> q
  (q, 2) -> q
  (_, 1) -> 1 + solve (n - 9)
  (_, 3) -> 1 + solve (n - 6)

import Data.List

composites :: [Int]
composites = [4, 6, 9]

maxLength :: [[Int]] -> [Int]
maxLength a =
  maximumBy helper a
  where
    helper a b =
      if a == b
      then EQ
      else if (length a) > (length b)
        then GT
        else LT

helper :: Int -> [Int] -> Int -> Int -> [Int]
helper n solution sum_solution candidate
  | new_solution > n  = []
  | new_solution == n = candidate:solution
  | otherwise =
    if length filtered > 0
    then maxLength filtered
    else []
  where
    new_solution = candidate + sum_solution
    results  = map (helper n (candidate:solution) new_solution) composites
    filtered = filter (not . null) $ results

split :: Int -> [Int]
split n =
  maxLength $ map (helper n [] 0) composites

split2 :: Int -> [Int]
split2 n
  | n < 12 = split n
  | n `mod` 4 == 0 = take (n      `div` 4) (repeat 4)
  | n `mod` 4 == 1 = take ((n-8)  `div` 4) (repeat 4) ++ [9]
  | n `mod` 4 == 2 = take ((n-4)  `div` 4) (repeat 4) ++ [6]
  | n `mod` 4 == 3 = take ((n-15) `div` 4) (repeat 4) ++ [6,9]
  | otherwise = []

solve n
  | n < 12 = if l > 0 then l else -1
  | n `mod` 4 == 0 = n      `div` 4
  | n `mod` 4 == 1 = (n-8)  `div` 4 + 1
  | n `mod` 4 == 2 = (n-4)  `div` 4 + 1
  | n `mod` 4 == 3 = (n-15) `div` 4 + 2
  where
    l = length $ split n

readInts :: IO [Int]
readInts = fmap (map read.words) getLine

readLines :: Int -> IO [Int]
readLines 0 = return []
readLines n = do
   x <- fmap read getLine
   rest <- readLines (n-1)
   return $ x : rest

readSomeNumberOfLines :: IO [Int]
readSomeNumberOfLines = do
   n <- fmap read getLine
   readLines n

main = do
  queries <- readSomeNumberOfLines
  putStrLn $ intercalate "\n" $ map (show . solve) queries

import Data.List
import Data.Char
import Control.Exception
import Control.Monad

readVal :: Read a => IO a
readVal = (return . read)  =<< getWord_ True
 where
  delimiter = (`elem` " \n")
  getWord_ :: Bool -> IO String
  getWord_ first = do
   c <- catch getChar ((\msg -> return ' ') :: IOException -> IO Char)
   if delimiter c
    then
     if first
      then getWord_ True
      else return ""
    else do
     xs <- getWord_ False
     return $ c : xs

solve' num n
	| n < 0 = -1
	| mod n 2 == 1 = solve' (num+1) (n-5)
	| mod n 4 == 0 = num + (div n 4)
	| otherwise = solve' (num+1) (n-6)

solve = solve' 0

subtask = print =<< fmap solve readVal

main = readVal >>= (flip replicateM_ subtask)

import Data.List
import Data.Char
import Control.Exception
import Control.Monad

readVal :: Read a => IO a
readVal = (return . read)  =<< getWord_ True
 where
  delimiter = (`elem` " \n")
  getWord_ :: Bool -> IO String
  getWord_ first = do
   c <- catch getChar ((\msg -> return ' ') :: IOException -> IO Char)
   if delimiter c
    then
     if first
      then getWord_ True
      else return ""
    else do
     xs <- getWord_ False
     return $ c : xs

solve' num n
	| n < 0 = -1
	| mod n 2 == 1 = solve' (num+1) (n-1)
	| mod n 4 == 0 = num + (div n 4)
	| otherwise = solve' (num+1) (n-6)

solve = solve' 0

subtask = print =<< fmap solve readVal

main = readVal >>= (flip replicateM_ subtask)

import Data.List
import Data.Char
import Control.Exception
import Control.Monad

readVal :: Read a => IO a
readVal = (return . read)  =<< getWord_ True
 where
  delimiter = (`elem` " \n")
  getWord_ :: Bool -> IO String
  getWord_ first = do
   c <- catch getChar ((\msg -> return ' ') :: IOException -> IO Char)
   if delimiter c
    then
     if first
      then getWord_ True
      else return ""
    else do
     xs <- getWord_ False
     return $ c : xs

solve' num n
	| n < 0 = -1
	| mod n 2 == 1 = solve' (num+1) (n+1)
	| mod n 4 == 0 = num + (div n 4)
	| otherwise = solve' (num+1) (n-6)

solve = solve' 0

subtask = print =<< fmap solve readVal

main = readVal >>= (flip replicateM_ subtask)


module Main (main) where
import Data.List (sort)

main :: IO ()
main = do
        l1 <- getLine
        l2 <- getLine
        putStrLn . output . solve . input l1 $ l2

-- | input
input :: String -> String -> (Int, [Int])
input l1 l2 = (read l1, map read . words $ l2)

-- | solution
solve :: (Int,[Int]) -> Bool
solve (n,as) = head t2 /= (head . tail $ t2)
        where
              t2 = drop (n - 1) . sort $ as

-- | output
output :: Bool -> String
output ok = if ok then "YES" else "NO"

import Text.Printf (printf)
import Data.List

-- This function should return a list [area, volume].
ansstr :: Bool -> String
ansstr True = "YES"
ansstr False = "NO"

--Complete this function--

--Input/Output.
main :: IO ()
main = getContents >>=
  (putStrLn). ansstr.(\[[n],xs] -> let sx = sort xs in sx !! n /= sx !! (n - 1)). map (map read. words). lines

import Data.List

main = do
  n <- fmap (read :: String -> Integer) getLine
  elems <- getLine >>= readArray
  putStrLn $ if solve elems then "YES" else "NO"

readArray :: String -> IO [Integer]
readArray as = return $ map (read :: String -> Integer) $ words as

solve :: [Integer] -> Bool
solve xs = all id $ zipWith (<) as bs where
  (as, bs) = divide $ sort xs
  divide ls = (take n ls, reverse $ drop n ls) where
    n = length ls `div` 2

main = do
	getLine
	line <- getLine
	putStrLn $ f line
	--print $ midGreater' [1,2,3,4]

qs [] = []
qs (p:xs) = qs lo ++ [p] ++ qs hi
	where
		lo = [x | x <- xs, x <= p]
		hi = [x | x <- xs, x > p]

if' :: Bool -> a -> a -> a
if' True a _ = a
if' False _ a = a

midGreater :: [Int] -> [Int] -> Bool
midGreater [_, _] (a:b:_) = a < b
midGreater (_:_:xs) (_:ys) = midGreater xs ys
midGreater _ _ = False

midGreater' x = midGreater x x

f x = if' (midGreater' $ qs zs) "YES" "NO"
	where
		zs = map read $ words x :: [Int]

-- Educational Codeforces Round 27
-- http://codeforces.com/contest/845/problem/A

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

getInt = read <$> getLine :: IO Int
getInts = (map read . words) <$> getLine :: IO [Int]

main = do
    n <- getInt
    xs <- sort <$> getInts
    let (small,large) = (take n xs, drop n xs)
    if head large > head (reverse small)
    then putStrLn "YES"
    else putStrLn "NO"

{-# 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.List

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

app = do
  n <- poi
  xs <- replicateM (2 * n) poi
  return $ if all (uncurry (<)) $ uncurry (liftM2 (,)) $ splitAt n $ sort xs then "YES" else "NO"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

import Control.Applicative
import Data.List

solve :: [Int] -> String
solve xs
  | m > n = "YES"
  | otherwise = "NO"
  where m = foldr1 min team1
        n = foldr1 max team2
        team1 = drop half sorted
        team2 = take half sorted
        half = length xs `div` 2
        sorted = sort xs

main = do
  getLine >> getLine >>= putStrLn.solve.map read.words

import Data.List

read_strings = do
  line <- getLine
  return (words $ line)

read_ints = do
  l <- read_strings
  return (map read l :: [Int])

main = do
  n <- readLn
  arr' <- read_ints

  let arr = sort arr'
  if (arr !! n) == (arr !! (n - 1))
    then putStr("NO")
    else putStr("YES")

import Data.List
solve x
	|maximum a<minimum b="YES"
	|otherwise = "NO"
	where
		n=div (length x) 2
		xx=sort x
		a=take n xx
		b=drop n xx

extract (x:y:_)= map (\n->read n::Int) (take (2*(read x::Int))$words y)

main=interact$solve.extract.lines

import qualified Data.Char as C
import qualified Data.List as L

readIntList :: String -> [Int]
readIntList s = loop s []
  where loop [] rs = reverse rs
        loop ss rs = loop ss_3 ((read ss_2) : rs)
          where ss_1 = dropWhile (C.isSpace) ss
                (ss_2, ss_3) = L.span (not . C.isSpace) ss_1

main =
  do
    n_str <- getLine
    let n = (read n_str) :: Int
    rs_str <- getLine
    let rs = readIntList rs_str
    let (f, s) = L.splitAt n (L.sort rs)
    let f_l = last f
    let s_h = head s
    if f_l < s_h
    then putStrLn "YES"
    else putStrLn "NO"

{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import Data.List (sort)

main = do
    (read -> n) <- getLine
    (drop (n - 1) . sort . map (read :: String -> Int) . words -> (x:y:_)) <- getLine
    putStrLn $ if x == y then "NO" else "YES"

-- 845A

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sort)

toInt = fst . fromJust . B.readInt

main = B.interact $ program . (map . map) toInt . map B.words . B.lines

program ([n]:xs:_) = f . drop (n-1) $ sort xs

f (a:b:_) = if a < b
           then "YES\n"
           else "NO\n"

import Data.List

main = do
  n <- fmap (read :: String -> Integer) getLine
  elems <- getLine >>= readArray
  putStrLn $ if solve elems then "YES" else "NO"

readArray :: String -> IO [Integer]
readArray as = return $ map (read :: String -> Integer) $ words as

solve :: [Integer] -> Bool
solve xs = all id $ zipWith (<) as bs where
  (as, bs) = divide $ sort xs
  divide ls = (take n ls, drop n ls) where
    n = length ls `div` 2

{-# 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.List

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

app = do
  n <- poi
  xs <- replicateM (2 * n) poi
  return $ if all (uncurry (<)) $uncurry zip $ splitAt n $ sort xs then "YES" else "NO"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

import Text.Printf (printf)
import Data.List

-- This function should return a list [area, volume].
ansstr :: Bool -> String
ansstr True = "YES"
ansstr False = "NO"

--Complete this function--

--Input/Output.
main :: IO ()
main = getContents >>=
  (putStrLn). ansstr.(\[[n],xs] -> let sx = sort xs in xs !! n /= xs !! (n - 1)). map (map read. words). lines


import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  n <- readLn
  xs <- map read.words <$> getLine
  forM_ (solve xs n) (putStrLn . unwords . map show)

solve :: [Int] -> Int -> [[Int]]
solve xs n = take (n-1) $ toLs (map snd e) ++ toLs (map snd o)
  where
    (e,o) = partition (even.fst) (zip xs [1..])

toLs :: [Int] -> [[Int]]
toLs [] = []
toLs [_] = []
toLs (x:y:ys) = [x,y]:toLs ys

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  putStr $ unlines . map (\(a, b) -> show a ++ ' ' : show b) $ solve as

solve as
  | null odds = listPairs $ snd <$> tail (tail evens)
  | odd (length odds) = listPairs $ snd <$> tail odds ++ tail evens
  | otherwise = listPairs $ snd <$> tail (tail odds) ++ evens
  where
    (odds, evens) = partition (odd . fst) (zip as [1 ..])

listPairs [] = []
listPairs [_] = undefined
listPairs (a : b : t) = (a, b) : listPairs t

module Main where
import Data.List (partition)

solve :: [Integer] -> [(Integer, Integer)]
solve a = let (xs, ys) = partition (even . snd) (zip [1..] a)
              odds = length ys
          in if odds `mod` 2 == 1
             then solve' (map fst (tail xs)) (map fst (tail ys))
             else if odds >= 2
                  then solve' (map fst xs) (map fst (tail (tail ys)))
                  else solve' (map fst (tail (tail xs))) (map fst ys)

solve' :: [Integer] -> [Integer] -> [(Integer, Integer)]
solve' (x0:x1:xs) ys = (x0, x1) : solve' xs ys
solve' [] (y0:y1:ys) = (y0, y1) : solve' [] ys
solve' [] [] = []

solveCase :: Int-> IO ()
solveCase i = do _ <- getLine
                 a <- map read <$> words <$> getLine
                 putStr $ unlines $ map (\ (x, y) -> (show x) ++ " " ++ (show y)) $ solve a

main :: IO [()]
main = do t <- read <$> getLine
          mapM solveCase [1..t]

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  n <- readLn
  xs <- map read.words <$> getLine
  forM_ (solve xs n) (putStrLn . unwords . map show)

solve :: [Int] -> Int -> [[Int]]
solve xs n = take (n-1) $ toLs e ++ toLs o
  where
    (e,o) = partition even xs

toLs :: [Int] -> [[Int]]
toLs [] = []
toLs [_] = []
toLs (x:y:ys) = [x,y]:toLs ys


import Control.Monad
import Data.List
f pos c | x10 > r+h1 = (1 + num,0)
        | x21 >h1 = (1 + num,h1) --right
        | otherwise = (num,0)  -- not
  where (x10,h1,x21) = head pos
        num = fst c
        r = snd c
iterateh' f [] l = l
iterateh' f h l  = iterateh' f (tail h) $!(f h l)
makeTriple h n| n == 2 = []
              | otherwise = (x10,h1,x21):makeTriple t0 (n-1)
  where preA = head h
        t0 = tail h
        a = head t0
        t1 = tail t0
        nextA = head t1
        x1 = fst a
        x0 = fst preA
        x2 = fst nextA
        h1 = snd a
        x10 = x1 - x0
        x21 = x2 - x1
toTup a = ((w !! 0),(w !! 1))
  where w = [read n::Int| n <-(words a)]
doit (a,b,c) (d,e,f) = (a,e,f)
main = do
  w0 <- getLine
  let n= read w0::Int
  w1 <- getContents
  let s = lines w1
  let a = map toTup s
  if n == 1 then print 1 else print $ fst $ iterateh' f (makeTriple a n) (2,0)

{-# LANGUAGE BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad

data Tree = Tree {
    coord :: {-# UNPACK #-} !Int
  , height :: {-# UNPACK #-} !Int
  } deriving (Show, Eq)

main :: IO ()
main = do
    n <- fmap read getLine
    trees <- replicateM n $ do
        [x, h] <- map read . words <$> getLine
        return $ Tree x h
    print $ solve trees

solve :: [Tree] -> Int
solve [] = 0
solve [_] = 1
solve (Tree firstPoint _ : rest) = go 1 firstPoint rest
  where
    go !felled _ [_] = felled + 1
    go !felled pointToLeft (Tree x1 h1 : ts@(~(Tree x2 _) : _))
        | x1 - h1 > pointToLeft = go (felled + 1) x1 ts
        | x1 + h1 < x2 = go (felled + 1) (x1 + h1) ts
        | otherwise = go felled x1 ts

import Control.Applicative
import Data.List
import Data.Ord
import Control.Monad
import Debug.Trace

main = do
    n <- read <$> getLine
    xhs <- forM [1..n] $ \_ -> do
        [xi, hi] <- map read . words <$> getLine
        return (xi, hi)
    let st = (\(x, h) -> x-h-1) . head $ xhs
    putStrLn . show $ sol st xhs

sol :: Int -> -- last covering point
       [(Int, Int)] -> -- tree list to consider
       Int
sol _ [(x, h)] = 1
sol lcp ((x, h):xs@((nx, _):_))
    | lcp < x-h = 1 + sol x xs
    | x+h < nx = 1 + sol (x+h) xs
    | otherwise = sol x xs

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

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

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

to64 x = fromIntegral x :: Int64
solve = (\(_, _, l, r, s) -> max l $ max r s) . foldl' (\(!x', !h', !l', !r', !s') (!x, !h) -> let s = mcon (x > x' + h') r' (max l' s') in (x, h, 1 + mcon (x - h > x' + h') r' (mcon (x - h > x') (max l' s') (-1)), 1 + s, s)) (minBound, 0, 0 :: Int, 0 :: Int, 0 :: Int)

mcon True x = max x
mcon False _ = id

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1@(Tree _ _) t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1
chopLeft t1 _ = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1@(Tree _ _) t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1
chopRight t1 _ = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopped:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

main = interact $ show . solve . pairs . map read . tail . words
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []
solve ts = go ([(-10^10,undefined)] ++ ts ++ [(10^10,undefined)]) 0 where
  go [_,_] a = a
  go ((prev,_):ts@((cur,h):ts'@((next,_):_))) a
    | prev < cur-h = go ((cur,undefined) : ts') $! a+1
    | next > cur+h = go ((cur+h,undefined) : ts') $! a+1
    | otherwise = go ts a

import Data.Array

solve [(_, _)] = 1
solve ns = 1 + go lb' rb' 1
  where (lb', rb') = ds ! 1
        end = length ns - 1
        go lb rb n
          | n == end = 1
          | h < lb = 1 + go lb2 rb2 (n+1)
          | h < rb = 1 + go (lb2-h) rb2 (n+1)
          | otherwise = go lb2 rb2 (n+1)
          where h = hs ! n
                (lb2, rb2) = ds ! (n+1)
        hs = listArray (0, end) [h | (_, h) <- ns]
        ds = listArray (0, end-1) ((0,0): twobounds xs)
        xs = [i | (i, _) <- ns]

twobounds xs = zip ys (tail ys)
  where ys = zipWith (-) (tail xs) xs

toTuple [] = []
toTuple (x:xs:xss) = (x, xs) : toTuple xss

main = do
    getLine
    ns <- fmap (toTuple . map read . words) getContents :: IO [(Int, Int)]
    print $ solve ns

import Data.Array

solve [_, _] = 1
solve ns = 1 + go lb' rb' 1
  where (lb', rb') = ds ! 1
        end = l `div` 2 - 1
        l = length ns
        go lb rb n
          | n == end = 1
          | h < lb = 1 + go lb2 rb2 (n+1)
          | h < rb = 1 + go (lb2-h) rb2 (n+1)
          | otherwise = go lb2 rb2 (n+1)
          where h = hs' ! n
                (lb2, rb2) = ds ! (n+1)
        ys = listArray (0, l-1) ns
        (hs, is) = ([ys ! j | j <- [1,3..(l-1)]], [ys ! k | k <- [0,2..(l-2)]])
        hs' = listArray (0, end) hs
        ds = listArray (0, end-1) ((0,0): twobounds is)

twobounds xs = zip ys (tail ys)
  where ys = zipWith (-) (tail xs) xs

toTuple [] = []
toTuple (x:xs:xss) = (x, xs) : toTuple xss

main = do
    getLine
    ns <- fmap (map read . words) getContents :: IO [Int]
    print $ solve ns

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1@(Tree _ _) t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1
chopLeft t1 _ = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1@(Tree _ _) t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1
chopRight t1 _ = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopped:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopped:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 > (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 < (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 t1:ts) False

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	--mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 >= (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 <= (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Data.Array.IO

data Tree = Tree Int Int | TreeLeft Int Int | TreeRight Int Int
	deriving (Eq, Show)

getTreeCoord :: Tree -> Int
getTreeCoord (Tree x _) = x
getTreeCoord (TreeLeft x _) = x
getTreeCoord (TreeRight x _) = x

getTreeHeight :: Tree -> Int
getTreeHeight (Tree _ h) = h
getTreeHeight (TreeLeft _ h) = h
getTreeHeight (TreeRight _ h) = h

getTreeSegment :: Tree -> (Int,Int)
getTreeSegment (Tree x h) = (x,x)
getTreeSegment (TreeLeft x h) = (x - h, x)
getTreeSegment (TreeRight x h) = (x, x + h)

isChopped :: Tree -> Bool
isChopped (Tree _ _) = False
isChopped _ = True

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

getTrees :: Int -> IO [Tree]
getTrees n = fmap (map mapFunc) $ getLines n
	where
		mapFunc :: String -> Tree
		mapFunc tree_str =
			let
				tree = words tree_str
			in
				Tree (read $ tree !! 0) (read $ tree !! 1)

main = do
	n <- fmap read getLine :: IO Int
	trees <- getTrees n

	let
		chopped_trees = chopTrees trees True
		chopped = sum [1 | x <- chopped_trees, isChopped x]

	mapM_ putStrLn $ map show $ chopped_trees
	putStrLn $ show chopped

chopLeft :: Tree -> Tree -> Tree
chopLeft t1 t2
	| getTreeCoord t1 - getTreeHeight t1 >= (snd $ getTreeSegment t2) || t1 == t2 =
		TreeLeft (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopRight :: Tree -> Tree -> Tree
chopRight t1 t2
	| getTreeCoord t1 + getTreeHeight t1 <= (fst $ getTreeSegment t2) || t1 == t2 =
		TreeRight (getTreeCoord t1) (getTreeHeight t1)
	| otherwise = t1

chopTrees :: [Tree] -> Bool -> [Tree]
chopTrees [] _ = []
chopTrees (t:[]) _ =
	[chopRight t t]
chopTrees (t1:t2:ts) True =
	chopLeft t1 t1:
	chopTrees (chopLeft t2 t1:ts) False
chopTrees (t1:t2:ts) False =
	chopRight t1 t2:
	chopTrees (chopLeft t2 chopped:ts) False
	where
		chopped = chopRight t1 t2

import Control.Applicative
import Data.List
import Data.Ord
import Control.Monad
import Debug.Trace

main = do
    n <- read <$> getLine
    xhs <- forM [1..n] $ \_ -> do
        [xi, hi] <- map read . words <$> getLine
        return (xi, hi)
    let st = (\(x, h) -> x-h-1) . head $ xhs
    putStrLn . show $ sol st xhs

sol :: Int -> -- last covering point
       [(Int, Int)] -> -- tree list to consider
       Int
sol _ [(x, h)] = 1
sol lcp ((x, h):xs@((nx, _):_))
    | lcp < x-h = 1 + sol x xs
    | x+h < nx = 1 + sol (x+h) xs
    | otherwise = sol lcp xs


import Data.List
import Control.Monad
maxN = 53::Int

fct :: Int->Integer
fct x = if x <= 1 then 1 else (toInteger x) * (fct $ x - 1)

inter ls = zipWith (*) ls $ map fct $ [-1..(length ls)]

good :: Int->[Integer]
good 0 = [1]
good n = (foldl (+) 0 $ inter ls): ls where ls = good $ n - 1

rec :: [(Int, Int)]->Int->Integer->[Int]
rec [(a, _)] _ _ = [a]
rec ls w k = (fst key) : rec (uno ++ ((elm, snd key) : dos)) (w + 1) (mod k mdl)
 where
  (one, (elm,_):two) = break ((w==) . snd) ls
  mdl = fct ((length ls) - 2)
  key = (one++two) !! (fromIntegral (quot k mdl))
  uno = fl one; dos = fl two
  fl = filter (key/=)

-- This is just a wrapper. The real magic happens in rec.
perm :: Int->Integer->[Int]
perm 1 _ = [1]
perm n k = (n: rec ((1, n) : zip x x) 2 k) where x = [2..(n-1)]

solve :: Int->Integer->[Integer]->[Int]
solve 0 _ _ = []
solve n k (t:tm) = if k >= t then [-1] else
 (perm sz $ quot kl vl)++(map (sz+) $ solve (n - sz) (mod kl vl) (drop (sz - 1) tm))
 where
  (sm,_) = break (k<) $ scanl (+) 0 $ inter tm
  sz = length sm
  kl = k - (last sm)
  vl = tm !! (sz - 1)

fnc n k = solve n k (good n)
caso str = intercalate " " $ map show (solve sn (k - 1) (good sn))
 where
  [n, k] = map (\x->read x::Integer) $ words str
  sn = fromIntegral n

main=do
 fl<-getLine
 let t = read fl::Int
 lsta <- (replicateM t getLine)
 let rsps = map caso lsta
 mapM putStrLn rsps

import Data.List
import Control.Monad
maxN = 53

fct x = if x <= 1 then 1 else (toInteger x) * (fct $ x - 1)

inter ls = zipWith (*) ls $ map fct $ [-1..(length ls)]

good 0 = [1]
good n = (foldl (+) 0 $ inter ls): ls where ls = good $ n - 1

rec [(a, _)] _ _ = [a]
rec ls w k = (fst key) : rec (uno ++ ((elm, snd key) : dos)) (w + 1) (mod k mdl)
 where
  (one, (elm,_):two) = break ((w==) . snd) ls
  mdl = fct ((length ls) - 2)
  key = (one++two) !! (fromIntegral (quot k mdl))
  uno = fl one; dos = fl two
  fl = filter (key/=)

perm 1 _ = [1]
perm n k = (n: rec ((1, n) : zip x x) 2 k) where x = [2..(n-1)]

solve 0 _ _ = []
solve n k (t:tm) = if k >= t then [-1] else
 (perm sz $ quot kl vl)++(map (sz+) $ solve (n - sz) (mod kl vl) (drop (sz - 1) tm))
 where
  (sm,_) = break (k<) $ scanl (+) 0 $ inter tm
  sz = length sm
  kl = k - (last sm)
  vl = tm !! (sz - 1)

caso str = intercalate " " $ map show (solve sn (k - 1) (good sn))
 where
  [n, k] = map (\x->read x::Integer) $ words str
  sn = fromIntegral n

main=do
 fl<-getLine
 let t = read fl::Int
 lsta <- (replicateM t getLine)
 let rsps = map caso lsta
 mapM putStrLn rsps


main = getLine >>= print . solve . read

solve :: Integer -> Integer
solve n = (multi_cnk n 5) * (multi_cnk n 3)

multi_cnk n k = cnk (n + k - 1) k

fact n = product [1..n]

cnk n k | k > n = 0
        | otherwise = product [n,n-1..(n - k + 1)] `div` fact k

import Control.Monad
main = do
    a <- liftM read getLine
    putStrLn $ show $ (choose (a+4) (a-1)) * (choose (a+2) (a-1))
choose n k = (product [(n-k+1)..n]) `div` (product [1..k])

import Control.Applicative
import Data.Array

fac = listArray (0,550)  (1:( [product [1..i]| i<-[1..550]]))

c n r = div (fac!n) ((fac!(n-r))*(fac!r))

main= do
	n<- read  <$>getLine::IO Integer
	print $  (  c (n+4) (n-1) )* (c (n+2) (n-1))

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

solve :: Integer -> Integer
solve n = n * (n + 1) * (n + 2) * n * (n + 1) * (n + 2) * (n + 3) * (n + 4) `div` (1 * 2 * 3 * 1 * 2 * 3 * 4 * 5)

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

import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    a <- (toInteger.fst.fromJust.C.readInt) <$> C.getLine
    let b = (a+2) * (a+1) `div` 2 * (a) `div` 3
    let c = (a+4) * (a+3) `div` 2 * (a+2) `div` 3 * (a+1) `div`4 *(a)`div`5
    print $ b*c

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

import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    a <- (toInteger.fst.fromJust.C.readInt) <$> C.getLine
    let b = (a+2) * (a+1) `div` 2 * (a) `div` 3
    let c = (a+4) * (a+3) `div` 2 * (a+2) `div` 3 * (a+1) `div`4 *(a)`div`5
    print $ b+c


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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    _ <- getInts
    as <- getInts
    [d] <- getInts
    let (u, _, v) = foldl' acc (0, 0, 0) $ map (subtract d) as
        acc (x, m, y) a
          | m + a >= 0 && x > y = (x + 1, min a (m + a), y')
          | otherwise = (y + 1, a, y')
          where y' = max x y
    return $ intDec (max u v) <> charUtf8 '\n'
  hPutBuilder stdout output

{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import qualified Data.List as DL
import Data.Bool
import System.IO hiding (getLine,print)
import Prelude hiding (getLine)
import Data.Char

recurse _ _ _ ans [] = ans
recurse tot isFirst peaktot ans (x:xs)
  | isFirst = recurse (tot+x) False 0 (ans+1) xs
  | tot+x < peaktot = recurse 0 True minBound ans xs
  | otherwise = recurse (tot+x) False (max tot peaktot) (ans+1) xs

solve :: IO ()
solve = do
  ~[n] <- readv
  xs'{-'-} <- readv
  ~[y] <- readv
  let
    xs = subtract y <$> xs'{-'-}
    ans = recurse 0 True minBound 0 xs
  printv [ans]

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x| x <- xs] <> DBB.char8 '\n'

readv :: IO [Int]
readv = map (maybe 0 fst . DBC.readInt) <$> (DBC.words <$> DBC.getLine)

getLine :: IO [Char]
getLine = DL.dropWhileEnd isSpace . DBC.unpack <$> DBC.getLine

main :: IO ()
main = do
  ~[nTc] <- readv
  CM.replicateM_ nTc solve

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.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
--import Data.Array.Unboxed

data S = S !Int !Int !Int !Int

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    ~[x] <- getInts 1
    let
      step :: S -> Int -> S
      step (S p2 p1 wait count) v = let
        oof2 = v + p1      < x + x     && wait >= 2
        oof3 = v + p1 + p2 < x + x + x && wait >= 3
        in  if  oof2 || oof3
        then  S p1 v 1 (count + 1)
        else  S p1 v (wait + 1) count
      S _ _ _ toSkip = foldl' step (S 0 0 1 0) a
    pure $ putInts [n - toSkip]

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.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 (replicateM_)

solve :: Int -> Int -> Int
solve n k
  | n < k       = k - n
  | even (n-k)  = 0
  | otherwise   = 1

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, k] <- map read . words <$> getLine
    print $ solve n k

import Control.Monad

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, k] <- map read . words <$> getLine
    if n >= k then
      if even (n - k) then
        putStrLn "0"
      else
        putStrLn "1"
    else
      putStrLn $ show (k - n)

module Main where

    solve :: IO ()
    solve = do
        s <- getLine
        let [n, k] = map (\x -> read x :: Integer) $ words s
        print $ if n < k then
            k - n
        else
            (n - k) `mod` 2

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        s <- getLine
        iter (read s :: Integer)

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> Int
solve (x:xs)
    | n == k = 0
    | n < k = k - n
    | otherwise = mod (n-k) 2
    where
        n = x
        k = head xs

deal :: IO()
deal = do
    x <- map read . words <$> getLine
    putStrLn $ show $ solve x

main :: IO()
main = getLine >>= flip replicateM_ deal . read

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

testCase :: IO a -> IO ()
testCase f = do
  t <- read <$> getLine
  replicateM_ t f

main = testCase $ do
  [a, b] <- map read . words <$> getLine
  print $ if a >= b then (a - b) `mod` 2 else b - a

module Main where

import Control.Monad

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, k] <- fmap read . words <$> getLine
    print $ solve n k

solve :: Int -> Int -> Int
solve a k
  | k > abs a = abs $ k - abs a
  | a `mod` 2 /= k `mod` 2 = 1
  | otherwise = 0

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> Int
solve (x:xs)
    | a == b = 0
    | b == 0 = mod a 2
    | otherwise = abs (a-b)
    where
        a = x
        b = head xs

deal :: IO()
deal = do
    x <- map read . words <$> getLine
    putStrLn $ show $ solve x

main :: IO()
main = getLine >>= flip replicateM_ deal . read


import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve :: String -> String
solve =
    let mapper x
          | x `mod` 2 == 0 = x-1
          | otherwise = x
    in intercalate " " . map show . map mapper . tail . map fastRead . words

rule n
  | n `mod` 2 == 1 = n
  | otherwise      = n - 1

main = do
  trash <- getLine
  input <- getLine
  doOutput $ map (rule . read) $ words input

doOutput (x : []) = putStr $ show x
doOutput (x : xs) = (putStr $ show x ++ " ") >> doOutput xs

module Main (main) where

--ghc 7.10

main :: IO ()
main = getLine >> getInts >>= (out . solve)

getInts :: IO [Int]
getInts = fmap (map read . words) getLine

out :: [Int] -> IO ()
out = putStrLn . seri

solve :: [Int] -> [Int]
solve = map chng

chng :: Int -> Int
chng n = if even n then pred n else n

seri :: [Int] -> String
seri = unwords . map show

f::Integer->String
f x
  |x `mod` 2==0 =show (x-1)
  |otherwise =show x

main = do
       e<-getLine
       e2<-getLine
       let xs=map read (words e2)::[Integer]
       putStrLn $ unwords $  map f xs

import Control.Monad

main = readInput >>= putStrLn . calc

readInput :: IO [String]
readInput = liftM2 getSnd getLine getLine
  where getSnd _ a = words a

calc :: [String] -> String
calc ns = foldr go "" ns
  where go numStr ans = " " ++ (show final) ++ ans
          where num = read numStr
                final = if num `rem` 2 == 0 then num - 1
        		        else num

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')
import Data.Bits

readInt :: String -> Int
readInt = Prelude.read

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

solve :: [Int] -> [Int]
solve = map (\x -> x - ((x + 1) .&. 1))

main :: IO ()
main = do
    n <- readInt <$> getLine
    arr <- (map readInt . words) <$> getLine
    let answer = solve arr
    forM_ answer $ printf "%d "
    printf "\n"

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
    let as_numbers = map fastRead $ words input
        n:xs = as_numbers
        answer = map mapper xs
        mapper x
          | x `mod` 2 == 0 = x-1
          | otherwise = x
    in intercalate " " . map show $ answer

import Control.Applicative
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C

process a | even a  = a-1
          | otherwise = a

main::IO ()
main=do
   getLine
   x <-  (map (fromIntegral.fst.fromJust.C.readInteger)) <$>     C.words <$> C.getLine::IO [Int]
   putStrLn $ intercalate " " $ map show $  map process x

import Data.Bits
main = interact $ unwords . map (show . succ . ((.&.) (complement 1 :: Int)) . pred . read) . tail . words

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

main= do
		a<- read <$> getLine ::IO Int
		b<- map read <$> words <$> getLine ::IO [Int]
		putStrLn $ intercalate " " $ map show $  map (\z-> if even z then z-1 else z) b

--ghc 7.10

adjReplacement :: (Integral a) => [a] -> [a]
adjReplacement = map (\x -> if even x then x-1 else x)

main = do
    line1 <- getLine
    line2 <- getLine
    let a = map read . words $ line2 :: [Int]
    putStrLn . unwords . map show . adjReplacement $ a

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

readInts :: ByteString -> [Int]
readInts bs = map (\bsWord -> let Just (int, _) = C.readInt bsWord in int) $ C.words bs

main :: IO ()
main = do
  _ <- getLine
  bs <- C.getContents
  let array = readInts bs
  forM_ array (\el ->
                  if el `mod` 2 == 0
                  then putStr $ show (el - 1) ++ " "
                  else putStr $ show el ++ " ")

import Data.List
import qualified Data.ByteString as B8

main = do
        _ <- getLine
        xstr <- getLine
        let xs =  map read $ words xstr :: [Int]
        putStrLn . unwords $ map (\x -> show $ if odd x then x else x - 1) xs

{-# LANGUAGE TypeApplications #-}
import Data.Bits
main = interact $ unwords . map (show . (xor @Int 1) . read) . tail . words

import Data.Bits
main = interact $ unwords . map (show . ((.&.) (complement 1 :: Int)) . read) . tail . words


import Data.List

readInt = fmap (\x -> read x :: Int) getLine

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

main :: IO ()
main = do
    let multipleTests = True

    if multipleTests then do
        line <- getLine
        let [t] = convertLine line
        mapM_ solveAndPrint [1..t]
    else do
        let t = 1
        mapM_ solveAndPrint [1..t]

-- Aici citeste datele si paseaza-le catre solve
solveAndPrint :: Int -> IO ()
solveAndPrint _ = do
    line <- getLine
    -- putStrLn line
    let [n, x] = convertLine line :: [Int]
    putStrLn $ show $ findFloor n x

findFloor :: Int -> Int -> Int
findFloor n x
    | n <= 2 = 1
    | otherwise = (n - 3) `div` x + 2

import Control.Arrow ( (>>>) )

main :: IO ()
main = interact $
  lines >>> drop 1
  >>> map (words >>> map read >>> solve >>> show)
  >>> unlines

solve :: [Int] -> Int
solve [n, x]
  | n <= 2 = 1
  | otherwise = 2 + div (n - 3) x

test :: String -> String
test s =
    let (n:x:[]) = map read $ words s :: [Int] in
    if n <= 2 then
        "1\n"
    else
        (show $ 2 + (n - 3) `div` x) ++ "\n"

solve :: String -> String
solve s =
    let ans = map test $ lines s in
    foldr1 (++) ans

main = do
    n <- getLine
    interact solve

import Control.Monad
import Data.Char

getList :: (Read t) => IO [t]
getList = getLine >>= return . (map read) . words

getOne :: (Read t) => IO t
getOne = getLine >>= return . read

main :: IO ()
main = do
  t <- getOne
  -- let t = 1
  replicateM_ t solve

solve :: IO ()
solve = do
  [n, x] <- getList
  print $ countAns n x

countAns :: Integral t => t -> t -> t
countAns n x
  | n <= 2 = 1
  | otherwise = ((n - 3) `div` x) + 2

calc :: Int -> Int -> Int
calc n x
    | n `mod` x == 0 = n `div` x
    | otherwise = n `div` x + 1

solve :: String -> String
solve str
    | n <= 2 = show 1
    | otherwise = show $ calc (n-2) x + 1
    where xs = map read $ words str
          n = head xs
          x = last xs

main = interact $ unlines . map solve . tail . lines

getResult :: [Int] -> Int
getResult a | head a == 1 = 1
            | otherwise = (div ((head a) - 3) (last a)) + 2

convertList :: [String] -> [Int]
convertList [] = []
convertList a = [read (head a) :: Int] ++ convertList (tail a)

solveb :: String -> Int
solveb nString = getResult (convertList (words nString));

solve :: Int -> IO ()
solve 0 = do
     putStr ""
solve t = do
    nString <- getLine
    putStrLn ((show (solveb nString)) :: String)
    solve (t - 1)

main = do
    teste <- getLine
    let t = read teste :: Int
    solve t
    putStr ""

solve :: Int -> Int -> Int
solve n x = if (n < 3) then 1 else div (n - 3) x + 2

queries :: Int -> IO ()
queries 0 = return ()
queries t = do
    line <- getLine
    let list = words line
    let n = read (head list) :: Int
    let x = read (head (tail list)) :: Int
    let ans = solve n x
    putStrLn ((show ans) :: String)
    queries (t - 1)

main = do
    t1 <- getLine
    let t = read t1 :: Int
    queries t

module Main where

import Control.Monad (replicateM_)

-- n -> x -> floor_number
findFloorNumber :: Int -> Int -> Int
findFloorNumber n x | n <= 2    = 1
                    | otherwise = ((n - 3) `div` x) + 2

readCaseInput :: IO (Int, Int)
readCaseInput = do
    numbers <- words <$> getLine
    let n = read (head numbers) :: Int
    let x = read (last numbers) :: Int
    pure (n, x)

solveCase :: IO ()
solveCase = do
    (n, x) <- readCaseInput
    let solution = findFloorNumber n x
    print solution

readT :: IO Int
readT = do
    line <- getLine
    pure (read line :: Int)

main :: IO ()
main = do
    t <- readT
    replicateM_ t solveCase

-- vim: set ts=4 expandtab sw=4:

import Control.Monad

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, x] <- map read . words <$> getLine
    print $ if  n <= 2
      then  1 :: Int
      else  1 + ceilDiv (n - 2) x

{-# LANGUAGE TypeApplications #-}

main :: IO ()
main = do
  getLine -- discard
  input <- map ((\[x, y] -> (x, y)) . map (read @Int) . words) . lines <$> getContents
  mapM_ (print . uncurry f) input

f :: Int -> Int -> Int
f target step = case step of
                  1 -> max (target - 1) 1
                  _ -> ((target - 3) `div` step) + 2

import Data.List
import Control.Monad
import Data.Maybe

readNumber :: IO Int
readNumber = fmap read getLine

readPair :: IO (Int, Int)
readPair = fmap (unpackList . map read . words) getLine
  where unpackList list = (head list, last list)

doStuff :: Int -> IO Int
doStuff _ = do
  (n, x) <- readPair
  pure $ f n x

checkCondition :: Int -> Int -> Int -> Bool
checkCondition n x floorNumber =
  (n >= (floorNumber - 2) * x + 3) && (n <= (floorNumber - 1) * x + 2)

f :: Int -> Int -> Int
f n x
  | n < 3 = 1
  | otherwise = fromJust $ find (checkCondition n x) [2..]

main = do
  n <- readNumber
  results <- forM [1..n] doStuff
  forM_ results (putStrLn . show)

solve :: Int -> Int -> Int
solve n x =  (quot (n - 2)  x) + 1

queries :: Int -> IO ()
queries 0 = return ()
queries t = do
    line <- getLine
    let list = words line
    let n = read (head list) :: Int
    let x = read (head (tail list)) :: Int
    let ans = solve n x
    putStrLn ((show ans) :: String)
    queries (t - 1)

main = do
    t1 <- getLine
    let t = read t1 :: Int
    queries t

solve :: Int -> Int -> Int
solve n x = 0

queries :: Int -> IO ()
queries 0 = return ()
queries t = do
    line <- getLine
    let list = words line
    let n = read (head list) :: Int
    let x = read (head (tail list)) :: Int
    let ans = solve n x
    putStrLn ((show ans) :: String)
    queries (t - 1)

main = do
    t1 <- getLine
    let t = read t1 :: Int
    queries t

getResult :: [Int] -> Int
getResult a = (div ((head a) - 3) (last a)) + 2

convertList :: [String] -> [Int]
convertList [] = []
convertList a = [read (head a) :: Int] ++ convertList (tail a)

solveb :: String -> Int
solveb nString = getResult (convertList (words nString));

solve :: Int -> IO ()
solve 0 = do
     putStr ""
solve t = do
    nString <- getLine
    putStrLn ((show (solveb nString)) :: String)
    solve (t - 1)

main = do
    teste <- getLine
    let t = read teste :: Int
    solve t
    putStr ""

getResult :: [Int] -> Int
getResult a | head a == 1 = 0
            | otherwise = (div ((head a) - 3) (last a)) + 2

convertList :: [String] -> [Int]
convertList [] = []
convertList a = [read (head a) :: Int] ++ convertList (tail a)

solveb :: String -> Int
solveb nString = getResult (convertList (words nString));

solve :: Int -> IO ()
solve 0 = do
     putStr ""
solve t = do
    nString <- getLine
    putStrLn ((show (solveb nString)) :: String)
    solve (t - 1)

main = do
    teste <- getLine
    let t = read teste :: Int
    solve t
    putStr ""

{-# LANGUAGE TypeApplications #-}

main :: IO ()
main = do
  getLine -- discard
  input <- map ((\[x, y] -> (x, y)) . map (read @Int) . words) . lines <$> getContents
  mapM_ (print . uncurry f) input

f :: Int -> Int -> Int
f target step = ((target - 3) `div` step) + 2