Levko has an array that consists of integers: a1, a2, ... , an. But he doesn’t like this array at all.Levko thinks that the beauty of the array a directly depends on value c(a), which can be calculated by the formula:  The less value c(a) is, the more beautiful the array is.It’s time to change the world and Levko is going to change his array for the better. To be exact, Levko wants to change the values of at most k array elements (it is allowed to replace the values by any integers). Of course, the changes should make the array as beautiful as possible.Help Levko and calculate what minimum number c(a) he can reach.

The first line contains two integers n and k (1 ≤ k ≤ n ≤ 2000). The second line contains space-separated integers a1, a2, ... , an ( - 109 ≤ ai ≤ 109).

A single number — the minimum value of c(a) Levko can get.

NoteIn the first sample Levko can change the second and fourth elements and get array: 4, 4, 4, 4, 4.In the third sample he can get array: 1, 2, 3, 4, 5, 6.

{-# 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)
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)
{-# 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 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

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


The main server of Gomble company received a log of one top-secret process, the name of which can't be revealed. The log was written in the following format: «[date:time]: message», where for each «[date:time]» value existed not more than 10 lines. All the files were encoded in a very complicated manner, and only one programmer — Alex — managed to decode them. The code was so complicated that Alex needed four weeks to decode it. Right after the decoding process was finished, all the files were deleted. But after the files deletion, Alex noticed that he saved the recordings in format «[time]: message». So, information about the dates was lost. However, as the lines were added into the log in chronological order, it's not difficult to say if the recordings could appear during one day or not. It is possible also to find the minimum amount of days during which the log was written.So, to make up for his mistake Alex has to find the minimum amount of days covered by the log. Note that Alex doesn't have to find the minimum amount of days between the beginning and the end of the logging, he has to find the minimum amount of dates in which records could be done. (See Sample test 2 for further clarifications).We should remind you that the process made not more than 10 recordings in a minute. Consider that a midnight belongs to coming day.

The first input line contains number n (1 ≤ n ≤ 100). The following n lines contain recordings in format «[time]: message», where time is given in format «hh:mm x.m.». For hh two-digit numbers from 01 to 12 are used, for mm two-digit numbers from 00 to 59 are used, and x is either character «a» or character «p». A message is a non-empty sequence of Latin letters and/or spaces, it doesn't start or end with a space. The length of each message doesn't exceed 20.

Output one number — the minimum amount of days covered by the log.

5
[05:00 a.m.]: Server is started
[05:00 a.m.]: Rescan initialized
[01:13 p.m.]: Request processed
[01:10 p.m.]: Request processed
[11:40 p.m.]: Rescan completed

3
[09:00 a.m.]: User logged in
[08:00 a.m.]: User logged in
[07:00 a.m.]: User logged in

NoteFormally the 12-hour time format is described at:   http://en.wikipedia.org/wiki/12-hour_clock.  The problem authors recommend you to look through these descriptions before you start with the problem.

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


Dr. Evil is interested in math and functions, so he gave Mahmoud and Ehab array a of length n and array b of length m. He introduced a function f(j) which is defined for integers j, which satisfy 0 ≤ j ≤ m - n. Suppose, ci = ai - bi + j. Then f(j) = |c1 - c2 + c3 - c4... cn|. More formally, . Dr. Evil wants Mahmoud and Ehab to calculate the minimum value of this function over all valid j. They found it a bit easy, so Dr. Evil made their task harder. He will give them q update queries. During each update they should add an integer xi to all elements in a in range [li;ri] i.e. they should add xi to ali, ali + 1, ... , ari and then they should calculate the minimum value of f(j) for all valid j.Please help Mahmoud and Ehab.

The first line contains three integers n, m and q (1 ≤ n ≤ m ≤ 105, 1 ≤ q ≤ 105) — number of elements in a, number of elements in b and number of queries, respectively. The second line contains n integers a1, a2, ..., an. ( - 109 ≤ ai ≤ 109) — elements of a. The third line contains m integers b1, b2, ..., bm. ( - 109 ≤ bi ≤ 109) — elements of b. Then q lines follow describing the queries. Each of them contains three integers li ri xi (1 ≤ li ≤ ri ≤ n,  - 109 ≤ x ≤ 109) — range to be updated and added value.

The first line should contain the minimum value of the function f before any update. Then output q lines, the i-th of them should contain the minimum value of the function f after performing the i-th update .

NoteFor the first example before any updates it's optimal to choose j = 0, f(0) = |(1 - 1) - (2 - 2) + (3 - 3) - (4 - 4) + (5 - 5)| = |0| = 0.After the first update a becomes {11, 2, 3, 4, 5} and it's optimal to choose j = 1, f(1) = |(11 - 2) - (2 - 3) + (3 - 4) - (4 - 5) + (5 - 6) = |9| = 9.After the second update a becomes {2, 2, 3, 4, 5} and it's optimal to choose j = 1, f(1) = |(2 - 2) - (2 - 3) + (3 - 4) - (4 - 5) + (5 - 6)| = |0| = 0.After the third update a becomes {1, 1, 2, 3, 4} and it's optimal to choose j = 0, f(0) = |(1 - 1) - (1 - 2) + (2 - 3) - (3 - 4) + (4 - 5)| = |0| = 0.

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

main = B.interact exec2
exec = B.pack . show . map (maybe undefined fst . B.readInt) . B.words
exec2 x = let
  input = map (maybe undefined fst . B.readInteger) . B.words $ x
  n:m:q:input2 = input
  (a,input3) = splitAt (fromInteger n) input2
  (b,input4) = splitAt (fromInteger m) input3
  suma = sum $ zipWith (*) a (cycle [1, -1])
  fsb = sum $ take (fromInteger n) $ zipWith (*) b (cycle [1, -1])
  offs = zipWith (if odd n then (+) else (-)) b $ drop (fromInteger n) b
  sumsb = fsb : zipWith (+) (map negate sumsb) offs
  arr = listArray (0, m-n) $ sort sumsb
  in B.pack $ solve suma (m-n) arr ([1, 1, 0] ++ input4)

solve suma k sumsb [] = []
solve suma k sumsb (l:r:x:input) = let
  s = if odd(r - l) then 0 else if odd(l) then x else -x
  newsuma = suma + s
  idx = binarySearch sumsb newsuma 0 k
  ans = if idx == 0 then abs (newsuma - (sumsb ! idx)) else min (abs (newsuma - sumsb ! idx)) (abs (newsuma - sumsb ! (idx - 1)))
  in show ans ++ "\n" ++ solve newsuma k sumsb input

binarySearch haystack needle lo hi
  | hi == lo	= mid
  | pivot >= needle	= binarySearch haystack needle lo mid
  | otherwise	= binarySearch haystack needle (mid+1) hi
  where
    mid	= lo + (hi-lo) `div` 2
    pivot	= haystack!mid

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

main = B.interact exec2
exec = B.pack . show . map (maybe undefined fst . B.readInt) . B.words
exec2 x = let
  input = map (maybe undefined fst . B.readInt) . B.words $ x
  n:m:q:input2 = input
  (a,input3) = splitAt n input2
  (b,input4) = splitAt m input3
  suma = sum $ zipWith (*) a (cycle [1, -1])
  fsb = sum $ take n $ zipWith (*) a (cycle [1, -1])
  offs = zipWith (if odd n then (+) else (-)) b $ drop n b
  sumsb = fsb : zipWith (+) (map negate sumsb) offs
  arr = listArray (0, m-n) $ sort sumsb
  in B.pack $ solve suma (m-n) arr ([1, 1, 0] ++ input4)

solve suma k sumsb [] = []
solve suma k sumsb (l:r:x:input) = let
  s = if odd(r - l) then 0 else if odd(l) then x else -x
  newsuma = suma + s
  idx = binarySearch sumsb newsuma 0 k
  ans = if idx == 0 then idx else min (abs (newsuma - (sumsb ! idx))) (abs (newsuma - sumsb ! (idx - 1)))
  in show ans ++ "\n" ++ solve newsuma k sumsb input

binarySearch haystack needle lo hi
  | hi == lo	= mid
  | pivot >= needle	= binarySearch haystack needle lo mid
  | otherwise	= binarySearch haystack needle (mid+1) hi
  where
    mid	= lo + (hi-lo) `div` 2
    pivot	= haystack!mid

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

main = B.interact exec2
exec = B.pack . show . map (maybe undefined fst . B.readInt) . B.words
exec2 x = let
  input = map (maybe undefined fst . B.readInt) . B.words $ x
  n:m:q:input2 = input
  (a,input3) = splitAt n input2
  (b,input4) = splitAt m input3
  suma = sum $ zipWith (*) a (cycle [1, -1])
  fsb = sum $ take n $ zipWith (*) b (cycle [1, -1])
  offs = zipWith (if odd n then (+) else (-)) b $ drop n b
  sumsb = fsb : zipWith (+) (map negate sumsb) offs
  arr = listArray (0, m-n) $ sort sumsb
  in B.pack $ solve suma (m-n) arr ([1, 1, 0] ++ input4)

solve suma k sumsb [] = []
solve suma k sumsb (l:r:x:input) = let
  s = if odd(r - l) then 0 else if odd(l) then x else -x
  newsuma = suma + s
  idx = binarySearch sumsb newsuma 0 k
  ans = if idx == 0 then abs (newsuma - (sumsb ! idx)) else min (abs (newsuma - (sumsb ! idx))) (abs (newsuma - sumsb ! (idx - 1)))
  in show ans ++ "\n" ++ solve newsuma k sumsb input

binarySearch haystack needle lo hi
  | hi == lo	= mid
  | pivot >= needle	= binarySearch haystack needle lo mid
  | otherwise	= binarySearch haystack needle (mid+1) hi
  where
    mid	= lo + (hi-lo) `div` 2
    pivot	= haystack!mid


Salem gave you $$$n$$$ sticks with integer positive lengths $$$a_1, a_2, \ldots, a_n$$$.For every stick, you can change its length to any other positive integer length (that is, either shrink or stretch it). The cost of changing the stick's length from $$$a$$$ to $$$b$$$ is $$$|a - b|$$$, where $$$|x|$$$ means the absolute value of $$$x$$$.A stick length $$$a_i$$$ is called almost good for some integer $$$t$$$ if $$$|a_i - t| \le 1$$$.Salem asks you to change the lengths of some sticks (possibly all or none), such that all sticks' lengths are almost good for some positive integer $$$t$$$ and the total cost of changing is minimum possible. The value of $$$t$$$ is not fixed in advance and you can choose it as any positive integer. As an answer, print the value of $$$t$$$ and the minimum cost. If there are multiple optimal choices for $$$t$$$, print any of them.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 1000$$$) — the number of sticks. The second line contains $$$n$$$ integers $$$a_i$$$ ($$$1 \le a_i \le 100$$$) — the lengths of the sticks.

Print the value of $$$t$$$ and the minimum possible cost. If there are multiple optimal choices for $$$t$$$, print any of them.

NoteIn the first example, we can change $$$1$$$ into $$$2$$$ and $$$10$$$ into $$$4$$$ with cost $$$|1 - 2| + |10 - 4| = 1 + 6 = 7$$$ and the resulting lengths $$$[2, 4, 4]$$$ are almost good for $$$t = 3$$$.In the second example, the sticks lengths are already almost good for $$$t = 2$$$, so we don't have to do anything.

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

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


There are n people taking dancing lessons. Every person is characterized by his/her dancing skill ai. At the beginning of the lesson they line up from left to right. While there is at least one couple of a boy and a girl in the line, the following process is repeated: the boy and girl who stand next to each other, having the minimal difference in dancing skills start to dance. If there are several such couples, the one first from the left starts to dance. After a couple leaves to dance, the line closes again, i.e. as a result the line is always continuous. The difference in dancing skills is understood as the absolute value of difference of ai variable. Your task is to find out what pairs and in what order will start dancing.

The first line contains an integer n (1 ≤ n ≤ 2·105) — the number of people. The next line contains n symbols B or G without spaces. B stands for a boy, G stands for a girl. The third line contains n space-separated integers ai (1 ≤ ai ≤ 107) — the dancing skill. People are specified from left to right in the order in which they lined up.

Print the resulting number of couples k. Then print k lines containing two numerals each — the numbers of people forming the couple. The people are numbered with integers from 1 to n from left to right. When a couple leaves to dance you shouldn't renumber the people. The numbers in one couple should be sorted in the increasing order. Print the couples in the order in which they leave to dance.

import Array
import Data.IntMap
import qualified Data.IntMap as IntMap
import Data.Set as Set
main = interact solve
solve input = output where
  [num0,gen0,skl0] = lines input
  num = read num0 :: Int
  gen = array (1,num) $ zip [1..num] gen0
  skl = array (1,num) $ zip [1..num] (Prelude.map (read::String->Int) $ words skl0)
  output = unlines $ (show $ length a):a where a = answer difs pn
  difs = Set.fromList $
    Prelude.filter ((/=99999999).fst) [(dif i (i+1),i)|i<-[1..num]]
  dif i j
    | i<1 || j>num                   = 99999999
    | gen Array.! i == gen Array.! j = 99999999
    | otherwise                      = abs(skl Array.! i-skl Array.! j)
  pn = IntMap.fromList [(i,(i-1,i+1))|i<-[1..num]]
  answer x y = if Set.null x then [] else (show i ++ " " ++ show n):(answer (f x) (g y))
    where
      (d,i) = Set.findMin x
      (p,n) = y IntMap.! i
      (pp,_) = y IntMap.! p
      (_,nn) = y IntMap.! n
      (_,nnn) = y IntMap.! nn
      newd = dif p nn
      pd = dif p i
      nd = dif n nn
      f0 = Set.delete (nd,n) . Set.delete (d,i)
      f | p==0           = f0
        | newd==99999999 = Set.delete (pd,p) . f0
        | otherwise      = Set.insert (newd,p) . Set.delete (pd,p) . f0
      g0 = IntMap.delete n . IntMap.delete i
      g1 | p==0      = g0
         | otherwise = IntMap.insert p (pp,nn) . g0
      g | nn==num+1 = g1
        | otherwise = IntMap.insert nn (p,nnn) . g1


You are given a tree with $$$n$$$ vertices numbered from $$$1$$$ to $$$n$$$. The height of the $$$i$$$-th vertex is $$$h_i$$$. You can place any number of towers into vertices, for each tower you can choose which vertex to put it in, as well as choose its efficiency. Setting up a tower with efficiency $$$e$$$ costs $$$e$$$ coins, where $$$e > 0$$$.It is considered that a vertex $$$x$$$ gets a signal if for some pair of towers at the vertices $$$u$$$ and $$$v$$$ ($$$u \neq v$$$, but it is allowed that $$$x = u$$$ or $$$x = v$$$) with efficiencies $$$e_u$$$ and $$$e_v$$$, respectively, it is satisfied that $$$\min(e_u, e_v) \geq h_x$$$ and $$$x$$$ lies on the path between $$$u$$$ and $$$v$$$.Find the minimum number of coins required to set up towers so that you can get a signal at all vertices.

The first line contains an integer $$$n$$$ ($$$2 \le n \le 200\,000$$$) — the number of vertices in the tree. The second line contains $$$n$$$ integers $$$h_i$$$ ($$$1 \le h_i \le 10^9$$$) — the heights of the vertices. Each of the next $$$n - 1$$$ lines contain a pair of numbers $$$v_i, u_i$$$ ($$$1 \le v_i, u_i \le n$$$) — an edge of the tree. It is guaranteed that the given edges form a tree.

Print one integer — the minimum required number of coins.

NoteIn the first test case it's optimal to install two towers with efficiencies $$$2$$$ at vertices $$$1$$$ and $$$3$$$.In the second test case it's optimal to install a tower with efficiency $$$1$$$ at vertex $$$1$$$ and two towers with efficiencies $$$3$$$ at vertices $$$2$$$ and $$$5$$$.In the third test case it's optimal to install two towers with efficiencies $$$6$$$ at vertices $$$1$$$ and $$$2$$$.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import Data.Ord (comparing)
import Data.Foldable (toList)
import Data.Graph
import Data.Tree
import qualified Data.ByteString.Char8 as C

simpleGraph bnds es = buildG bnds (go es) where
    go [] = []
    go ((u,v):es) = (u,v):(v,u):go es

thd (_,_,z) = z

main = do
    ~[n] <- readInts
    h :: UArray Int Int <- listArray (1,n) <$> readInts
    g <- simpleGraph (1,n) <$> replicateM (n-1) (do
        ~[u,v] <- readInts
        return (u,v))
    let root = maximumBy (comparing (h!)) [1..n]
        getmx (_,y,_) = y
        solve (Node u vs) = Node (u,mxu,d) vsn where
            vsn = map solve vs
            hs = map (getmx . rootLabel) vsn
            !mxu = maximum ((h!u):hs)
            !d = max 0 (h!u - maximum (0:hs))
        tree = solve $ head $ dfs g [root]
        ans = x + y where
            x = sum $ map thd $ toList tree
            hs = reverse $ sort $ (0:) $ map (getmx . rootLabel) (subForest tree)
            y = max 0 (h!root - hs!!1)
    print ans

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


Let T be arbitrary binary tree — tree, every vertex of which has no more than two children. Given tree is rooted, so there exists only one vertex which doesn't have a parent — it's the root of a tree. Every vertex has an integer number written on it. Following algorithm is run on every value from the tree T:  Set pointer to the root of a tree.  Return success if the value in the current vertex is equal to the number you are looking for  Go to the left child of the vertex if the value in the current vertex is greater than the number you are looking for  Go to the right child of the vertex if the value in the current vertex is less than the number you are looking for  Return fail if you try to go to the vertex that doesn't exist Here is the pseudo-code of the described algorithm: bool find(TreeNode t, int x) {    if (t == null)        return false;    if (t.value == x)        return true;    if (x < t.value)        return find(t.left, x);    else        return find(t.right, x);}find(root, x);The described algorithm works correctly if the tree is binary search tree (i.e. for each node the values of left subtree are less than the value in the node, the values of right subtree are greater than the value in the node). But it can return invalid result if tree is not a binary search tree.Since the given tree is not necessarily a binary search tree, not all numbers can be found this way. Your task is to calculate, how many times the search will fail being running on every value from the tree.If the tree has multiple vertices with the same values on them then you should run algorithm on every one of them separately.

First line contains integer number n (1 ≤ n ≤ 105) — number of vertices in the tree. Each of the next n lines contains 3 numbers v, l, r (0 ≤ v ≤ 109) — value on current vertex, index of the left child of the vertex and index of the right child of the vertex, respectively. If some child doesn't exist then number  - 1 is set instead. Note that different vertices of the tree may contain the same values.

Print number of times when search algorithm will fail.

NoteIn the example the root of the tree in vertex 2. Search of numbers 5 and 15 will return fail because on the first step algorithm will choose the subtree which doesn't contain numbers you are looking for.

{-# LANGUAGE BangPatterns #-}
import Data.List
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import qualified Data.ByteString.Char8 as B
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.Maybe

readTuple = do
  [x,y,z] <- (map (fst . fromJust . B.readInt)) . B.words <$> B.getLine
  return (x,y,z)

makeArray !n = listArray (1,n)

setdelete !x s = if x < 0 then s else Set.delete x s

getRootAndFreq [] s f = (Set.findMin s, f)
getRootAndFreq ((!x,!l,!r):xlrs) s f = getRootAndFreq xlrs (setdelete l $ setdelete r s) (Map.insertWith (+) x 1 f)

iprocess (!l,!r) = if l <= r then Just (l,r) else Nothing

splitInterval !x (Just (!l,!r)) = (iprocess (l, (min (x-1) r) ), iprocess ( (max (x+1) l),r))
splitInterval _ Nothing = (Nothing, Nothing)

isInInterval !x (Just (!l,!r)) = l <= x && x <= r
isInInterval !x Nothing = False

solve vxlr !bnd ssf !root
 | root < 0 = ssf
 | isNothing bnd = ssf
 | otherwise =
    let (rx,rl,rr) = vxlr ! root
        gud = (isInInterval rx bnd) || (Set.member rx ssf)
        nset = if gud then (Set.insert rx ssf) else ssf
        (il,ir) = splitInterval rx bnd
        ssfl = (solve vxlr il nset rl) in
        (solve vxlr ir ssfl rr)

countBadVals _ [] = 0
countBadVals s ((x,c):xcs) = (+) (if x `Set.notMember` s then c else 0) $ countBadVals s xcs

main = do
  n <- readLn::IO Int
  v <- replicateM n $ readTuple
  let vxlr = makeArray n v
      (root, frq) = getRootAndFreq v (Set.fromAscList [1..n]) Map.empty
      gudVals = solve vxlr (Just ((-1),1000000010)) Set.empty root
  print $ countBadVals gudVals (Map.toList frq)

{-# LANGUAGE BangPatterns #-}
import Data.List
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import qualified Data.ByteString.Char8 as B
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.Maybe

readTuple = do
  [x,y,z] <- (map (fst . fromJust . B.readInt)) . B.words <$> B.getLine
  return (x,y,z)

makeArray !n = listArray (1,n)

setdelete !x s = if x < 0 then s else Set.delete x s

getRoot [] s = Set.findMin s
getRoot ((_,!l,!r):xlrs) s = getRoot xlrs (setdelete l $ setdelete r s)

iprocess (!l,!r) = if l <= r then Just (l,r) else Nothing

splitInterval !x (Just (!l,!r)) = (iprocess (l, (min (x-1) r) ), iprocess ( (max (x+1) l),r))
splitInterval _ Nothing = (Nothing, Nothing)

isInInterval !x (Just (!l,!r)) = l <= x && x <= r
isInInterval !x Nothing = False

solve vxlr !bnd ssf !root
 | root < 0 = 0
 | isNothing bnd = 0
 | otherwise =
    let (rx,rl,rr) = vxlr ! root
        gud = (isInInterval rx bnd) || (Set.member rx ssf)
        nset = if gud then (Set.insert rx ssf) else ssf
        ndelta = if gud then 1 else 0
        (il,ir) = splitInterval rx bnd in
        ndelta + (solve vxlr il nset rl) + (solve vxlr ir nset rr)

main = do
  n <- readLn::IO Int
  v <- replicateM n $ readTuple
  let vxlr = makeArray n v
      root = getRoot v (Set.fromAscList [1..n])
  print $ (-) n $ solve vxlr (Just ((-1),1000000010)) Set.empty root


You are given several queries. In the i-th query you are given a single positive integer ni. You are to represent ni as a sum of maximum possible number of composite summands and print this maximum number, or print -1, if there are no such splittings.An integer greater than 1 is composite, if it is not prime, i.e. if it has positive divisors not equal to 1 and the integer itself.

The first line contains single integer q (1 ≤ q ≤ 105) — the number of queries. q lines follow. The (i + 1)-th line contains single integer ni (1 ≤ ni ≤ 109) — the i-th query.

For each query print the maximum possible number of summands in a valid splitting to composite summands, or -1, if there are no such splittings.

Note12 = 4 + 4 + 4 = 4 + 8 = 6 + 6 = 12, but the first splitting has the maximum possible number of summands.8 = 4 + 4, 6 can't be split into several composite summands.1, 2, 3 are less than any composite number, so they do not have valid splittings.

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)


You are given a binary string (i. e. a string consisting of characters 0 and/or 1) $$$s$$$ of length $$$n$$$. You can perform the following operation with the string $$$s$$$ at most once: choose a substring (a contiguous subsequence) of $$$s$$$ having exactly $$$k$$$ characters 1 in it, and shuffle it (reorder the characters in the substring as you wish).Calculate the number of different strings which can be obtained from $$$s$$$ by performing this operation at most once.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le n \le 5000$$$; $$$0 \le k \le n$$$). The second line contains the string $$$s$$$ of length $$$n$$$, consisting of characters 0 and/or 1.

Print one integer — the number of different strings which can be obtained from $$$s$$$ by performing the described operation at most once. Since the answer can be large, output it modulo $$$998244353$$$.

NoteSome strings you can obtain in the first example:  to obtain 0110110, you can take the substring from the $$$1$$$-st character to the $$$4$$$-th character, which is 1100, and reorder its characters to get 0110;  to obtain 1111000, you can take the substring from the $$$3$$$-rd character to the $$$7$$$-th character, which is 00110, and reorder its characters to get 11000;  to obtain 1100101, you can take the substring from the $$$5$$$-th character to the $$$7$$$-th character, which is 110, and reorder its characters to get 101. In the second example, $$$k = 0$$$ so you can only choose the substrings consisting only of 0 characters. Reordering them doesn't change the string at all, so the only string you can obtain is 10010.

{-# 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
import Debug.Trace
import Data.Array.Base (UArray)
import Data.Array.ST.Safe
import Data.Array

solve :: IO ()
solve = do
  ~[n,k] <- readv
  bs <- fmap digitToInt <$> getLine
  let
    presum = DL.scanl'{-'-} (+) 0 bs
    tuples = DL.zip4 bs [1..] presum $ tail presum
    e x y = fromEnum x + fromEnum y
    pairs xs = [(x,y)|(x:rest)<-DL.tails xs,y<-rest]
    fac = factorial (n+1)
    ifac = invFactorial fac
    choosef = choose fac ifac
    params = [(i2-i1-1,p2-pp1-2+e b1 b2) | ((b1,i1,pp1,p1),(b2,i2,pp2,p2))<-pairs tuples, p2-pp1<=k]
    values = [choosef nn rr | (nn,rr)<-params]
    ans = DL.foldl'{-'-} ((modp.).(+)) 1 values
  printv [if last presum < k then 1 else ans]

prime = 998244353
modp :: Int -> Int
modp = (`mod` prime)
pmul = (modp.).(*)

fastPow :: Integral t=>(t->t)->t->t->t
fastPow modf = go where
  go base 0 = 1
  go base p = go (base`times`base) q `times` (base^r) where (q,r)=divMod p 2
  times = (modf.).(*)

modDiv :: Int -> Int -> Int
modDiv x y = modp $ x * inv y where
  inv x = t where t = fastPow modp x (prime - 2)

factorial :: Int -> Array Int Int
factorial maxn =  runSTArray $ do
            arr <- newArray (0,maxn) 1
            CM.forM_ [1..maxn] $ \i -> do
              prev <- readArray arr (i-1)
              writeArray arr i (modp $ prev * i)
            return arr

invFactorial :: Array Int Int -> Array Int Int
invFactorial fac = array (lo,hi) [(i,1`modDiv` (fac!i)) | i<-[lo..hi]] where (lo,hi) = bounds fac

choose :: Array Int Int -> Array Int Int -> Int -> Int -> Int
choose fac ifac n k
      | n < k || k<0 = 0
      | otherwise = (fac ! n) `pmul` (ifac ! (n-k)) `pmul` (ifac ! k)

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x <> DBB.char8 ' ' | 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
  CM.replicateM_  1 solve


Berland annual chess tournament is coming!Organizers have gathered 2·n chess players who should be divided into two teams with n people each. The first team is sponsored by BerOil and the second team is sponsored by BerMobile. Obviously, organizers should guarantee the win for the team of BerOil.Thus, organizers should divide all 2·n players into two teams with n people each in such a way that the first team always wins.Every chess player has its rating ri. It is known that chess player with the greater rating always wins the player with the lower rating. If their ratings are equal then any of the players can win.After teams assignment there will come a drawing to form n pairs of opponents: in each pair there is a player from the first team and a player from the second team. Every chess player should be in exactly one pair. Every pair plays once. The drawing is totally random.Is it possible to divide all 2·n players into two teams with n people each so that the player from the first team in every pair wins regardless of the results of the drawing?

The first line contains one integer n (1 ≤ n ≤ 100). The second line contains 2·n integers a1, a2, ... a2n (1 ≤ ai ≤ 1000).

If it's possible to divide all 2·n players into two teams with n people each so that the player from the first team in every pair wins regardless of the results of the drawing, then print "YES". Otherwise print "NO".

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


Ashish has an array $$$a$$$ of consisting of $$$2n$$$ positive integers. He wants to compress $$$a$$$ into an array $$$b$$$ of size $$$n-1$$$. To do this, he first discards exactly $$$2$$$ (any two) elements from $$$a$$$. He then performs the following operation until there are no elements left in $$$a$$$:   Remove any two elements from $$$a$$$ and append their sum to $$$b$$$. The compressed array $$$b$$$ has to have a special property. The greatest common divisor ($$$\mathrm{gcd}$$$) of all its elements should be greater than $$$1$$$.Recall that the $$$\mathrm{gcd}$$$ of an array of positive integers is the biggest integer that is a divisor of all integers in the array.It can be proven that it is always possible to compress array $$$a$$$ into an array $$$b$$$ of size $$$n-1$$$ such that $$$gcd(b_1, b_2..., b_{n-1}) > 1$$$. Help Ashish find a way to do so.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$2 \leq n \leq 1000$$$). The second line of each test case contains $$$2n$$$ integers $$$a_1, a_2, \ldots, a_{2n}$$$ ($$$1 \leq a_i \leq 1000$$$) — the elements of the array $$$a$$$.

For each test case, output $$$n-1$$$ lines — the operations performed to compress the array $$$a$$$ to the array $$$b$$$. The initial discard of the two elements is not an operation, you don't need to output anything about it. The $$$i$$$-th line should contain two integers, the indices ($$$1$$$ —based) of the two elements from the array $$$a$$$ that are used in the $$$i$$$-th operation. All $$$2n-2$$$ indices should be distinct integers from $$$1$$$ to $$$2n$$$. You don't need to output two initially discarded elements from $$$a$$$. If there are multiple answers, you can find any.

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

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

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