Everyone knows that long ago on the territory of present-day Berland there lived Bindian tribes. Their capital was surrounded by n hills, forming a circle. On each hill there was a watchman, who watched the neighbourhood day and night.In case of any danger the watchman could make a fire on the hill. One watchman could see the signal of another watchman, if on the circle arc connecting the two hills there was no hill higher than any of the two. As for any two hills there are two different circle arcs connecting them, the signal was seen if the above mentioned condition was satisfied on at least one of the arcs. For example, for any two neighbouring watchmen it is true that the signal of one will be seen by the other.An important characteristics of this watch system was the amount of pairs of watchmen able to see each other's signals. You are to find this amount by the given heights of the hills.

The first line of the input data contains an integer number n (3 ≤ n ≤ 106), n — the amount of hills around the capital. The second line contains n numbers — heights of the hills in clockwise order. All height numbers are integer and lie between 1 and 109.

{-# LANGUAGE BangPatterns #-}
module Main where

import Data.Int (Int64)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  n:hs <- ints
  print $ solve n hs

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

count2 :: Integer -> Integer
count2 n = n * (n - 1) `div` 2

solve :: Int -> [Int] -> Integer
solve n xs = iter 0 [] $ map (`Acc` 1) hs
  where
    maxH = maximum xs
    hs = take n $ dropWhile (/= maxH) (cycle xs)

data Acc = Acc !Int !Int deriving (Show)

iter :: Integer -> [Acc] -> [Acc] -> Integer
iter c acc hs
    | null hs = count c $ map (\(Acc _ cc) -> fromIntegral cc) acc
    | null acc = iter c [h] (tail hs)
    | hx > hy  = iter c (h : acc) (tail hs)
    | hx == hy = iter c (Acc hx (cx + cy) : as) (tail hs)
    | otherwise = iter (c + 2 * ccx + count2 ccx) as hs
  where
    h = head hs
    Acc hx cx = head acc
    Acc hy cy = h
    as = tail acc
    ccx = fromIntegral cx

count :: Integer -> [Integer] -> Integer
count c [x, 1] = c + x + count2 x
count c [x] = c + count2 x
count c (x:xs) = count (c + 2 * x + count2 x) xs

{-# LANGUAGE BangPatterns #-}
module Main where

import Data.Int (Int64)

main :: IO ()
main = interact $ show . solve . readHills

readHills :: String -> (Int, [Int])
readHills input = (n, hs) where n:hs = map read $ words input

count2 :: Int64 -> Int64
count2 n = n * (n - 1) `div` 2

solve :: (Int, [Int]) -> Int64
solve (n, xs) = iter 0 [] $ map (`Acc` 1) hs
  where
    maxH = maximum xs
    hs = take n $ dropWhile (/= maxH) (cycle xs)

data Acc = Acc !Int !Int64 deriving (Show)

iter :: Int64 -> [Acc] -> [Acc] -> Int64
iter !c acc hs
    | null hs = count c $ map (\(Acc _ cc) -> cc) acc
    | null acc = iter c [h] (tail hs)
    | hx > hy  = iter c (h : acc) (tail hs)
    | hx == hy = iter c (Acc hx (cx + cy) : as) (tail hs)
    | otherwise = iter (c + 2 * cx + count2 cx) as hs
  where
    h = head hs
    Acc hx cx = head acc
    Acc hy cy = h
    as = tail acc

count :: Int64 -> [Int64] -> Int64
count !c [x, 1] = c + x + count2 x
count !c [x] = c + count2 x
count !c (x:xs) = count (c + 2 * x + count2 x) xs

{-# LANGUAGE BangPatterns #-}
module Main where

import Data.Int (Int64)

main :: IO ()
main = interact $ show . solve . readHills

readHills :: String -> (Int, [Int])
readHills input = (n, hs) where n:hs = map read $ words input

count2 :: Integer -> Integer
count2 n = n * (n - 1) `div` 2

solve :: (Int, [Int]) -> Integer
solve (n, xs) = iter 0 [] $ map (`Acc` 1) hs
  where
    maxH = maximum xs
    hs = take n $ dropWhile (/= maxH) (cycle xs)

data Acc = Acc !Int !Int deriving (Show)

iter :: Integer -> [Acc] -> [Acc] -> Integer
iter c acc hs
    | null hs = count c $ map (\(Acc _ cc) -> fromIntegral cc) acc
    | null acc = iter c [h] (tail hs)
    | hx > hy  = iter c (h : acc) (tail hs)
    | hx == hy = iter c (Acc hx (cx + cy) : as) (tail hs)
    | otherwise = iter (c + 2 * ccx + count2 ccx) as hs
  where
    h = head hs
    Acc hx cx = head acc
    Acc hy cy = h
    as = tail acc
    ccx = fromIntegral cx

count :: Integer -> [Integer] -> Integer
count !c [x, 1] = c + x + count2 x
count !c [x] = c + count2 x
count !c (x:xs) = count (c + 2 * x + count2 x) xs

{-# LANGUAGE BangPatterns #-}
module Main where

import Data.Int (Int64)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  n:hs <- ints
  print $ solve n hs

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

count2 :: Integer -> Integer
count2 n = n * (n - 1) `div` 2

solve :: Int -> [Int] -> Integer
solve n xs = iter 0 [] $ map (`Acc` 1) hs
  where
    maxH = maximum xs
    hs = take n $ dropWhile (/= maxH) (cycle xs)

data Acc = Acc Int Int deriving (Show)

iter :: Integer -> [Acc] -> [Acc] -> Integer
iter c acc hs
    | null hs = count c $ map (\(Acc _ cc) -> fromIntegral cc) acc
    | null acc = iter c [h] (tail hs)
    | hx > hy  = iter c (h : acc) (tail hs)
    | hx == hy = iter c (Acc hx (cx + cy) : as) (tail hs)
    | otherwise = iter (c + 2 * ccx + count2 ccx) as hs
  where
    h = head hs
    Acc hx cx = head acc
    Acc hy cy = h
    as = tail acc
    ccx = fromIntegral cx

count :: Integer -> [Integer] -> Integer
count c [x, 1] = c + x + count2 x
count c [x] = c + count2 x
count c (x:xs) = count (c + 2 * x + count2 x) xs

{-# LANGUAGE BangPatterns #-}
module Main where

import Data.Int (Int64)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  n:hs <- ints
  print $ solve n hs

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

count2 :: Integer -> Integer
count2 n = n * (n - 1) `div` 2

solve :: Int -> [Int] -> Integer
solve n xs = iter 0 [] $ map (`Acc` 1) hs
  where
    maxH = maximum xs
    hs = take n $ dropWhile (/= maxH) (cycle xs)

data Acc = Acc !Int !Int deriving (Show)

iter :: Integer -> [Acc] -> [Acc] -> Integer
iter !c acc hs
    | null hs = count c $ map (\(Acc _ cc) -> fromIntegral cc) acc
    | null acc = iter c [h] (tail hs)
    | hx > hy  = iter c (h : acc) (tail hs)
    | hx == hy = iter c (Acc hx (cx + cy) : as) (tail hs)
    | otherwise = iter (c + 2 * ccx + count2 ccx) as hs
  where
    h = head hs
    Acc hx cx = head acc
    Acc hy cy = h
    as = tail acc
    ccx = fromIntegral cx

count :: Integer -> [Integer] -> Integer
count !c [x, 1] = c + x + count2 x
count !c [x] = c + count2 x
count !c (x:xs) = count (c + 2 * x + count2 x) xs

{-# LANGUAGE BangPatterns #-}
module Main where

import Data.Int (Int64)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  n:hs <- ints
  print $ solve n hs

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

count2 :: Integer -> Integer
count2 n = n * (n - 1) `div` 2

solve :: Int -> [Int] -> Integer
solve n xs = iter 0 [] $ map (`Acc` 1) hs
  where
    maxH = maximum xs
    hs = take n $ dropWhile (/= maxH) (cycle xs)

data Acc = Acc !Int !Int deriving (Show)

iter :: Integer -> [Acc] -> [Acc] -> Integer
iter c acc hs
    | null hs = count c $ map (\(Acc _ cc) -> fromIntegral cc) acc
    | null acc = iter c [h] (tail hs)
    | hx > hy  = iter c (h : acc) (tail hs)
    | hx == hy = iter c (Acc hx (cx + cy) : as) (tail hs)
    | otherwise = iter (c + 2 * ccx + count2 ccx) as hs
  where
    h = head hs
    Acc hx cx = head acc
    Acc hy cy = h
    as = tail acc
    ccx = fromIntegral cx

count :: Integer -> [Integer] -> Integer
count !c [x, 1] = c + x + count2 x
count !c [x] = c + count2 x
count !c (x:xs) = count (c + 2 * x + count2 x) xs

module Main where

import Data.Int (Int64)

main :: IO ()
main = interact $ show . solve . readHills

readHills :: String -> (Int, [Int])
readHills input = (n, hs) where n:hs = map read $ words input

count2 :: Integer -> Integer
count2 n = n * (n - 1) `div` 2

solve :: (Int, [Int]) -> Integer
solve (n, xs) = iter 0 [] $ map (`Acc` 1) hs
  where
    maxH = maximum xs
    hs = take n $ dropWhile (/= maxH) (cycle xs)

data Acc = Acc !Int !Int deriving (Show)

iter :: Integer -> [Acc] -> [Acc] -> Integer
iter c acc hs
    | null hs = count c $ map (\(Acc _ cc) -> fromIntegral cc) acc
    | null acc = iter c [h] (tail hs)
    | hx > hy  = iter c (h : acc) (tail hs)
    | hx == hy = iter c (Acc hx (cx + cy) : as) (tail hs)
    | otherwise = iter (c + 2 * ccx + count2 ccx) as hs
  where
    h = head hs
    Acc hx cx = head acc
    Acc hy cy = h
    as = tail acc
    ccx = fromIntegral cx

count :: Integer -> [Integer] -> Integer
count c [x, 1] = c + x + count2 x
count c [x] = c + count2 x
count c (x:xs) = count (c + 2 * x + count2 x) xs

{-# LANGUAGE BangPatterns #-}
module Main where

import Data.Int (Int64)

main :: IO ()
main = interact $ show . solve . readHills

readHills :: String -> (Int, [Int])
readHills input = (n, hs) where n:hs = map read $ words input

count2 :: Integer -> Integer
count2 n = n * (n - 1) `div` 2

solve :: (Int, [Int]) -> Integer
solve (n, xs) = iter 0 [] $ map (`Acc` 1) hs
  where
    maxH = maximum xs
    hs = take n $ dropWhile (/= maxH) (cycle xs)

data Acc = Acc !Int !Int deriving (Show)

iter :: Integer -> [Acc] -> [Acc] -> Integer
iter !c acc hs
    | null hs = count c $ map (\(Acc _ cc) -> fromIntegral cc) acc
    | null acc = iter c [h] (tail hs)
    | hx > hy  = iter c (h : acc) (tail hs)
    | hx == hy = iter c (Acc hx (cx + cy) : as) (tail hs)
    | otherwise = iter (c + 2 * ccx + count2 ccx) as hs
  where
    h = head hs
    Acc hx cx = head acc
    Acc hy cy = h
    as = tail acc
    ccx = fromIntegral cx

count :: Integer -> [Integer] -> Integer
count c [x, 1] = c + x + count2 x
count c [x] = c + count2 x
count c (x:xs) = count (c + 2 * x + count2 x) xs

-- not FINISHED
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List
import Data.Tuple
import Data.Function
import qualified Data.ByteString.Char8 as BS
--import qualified Data.ByteString.Lazy.Char8 as BS

readInt :: BS.ByteString -> Int
readInt x =
    case BS.readInt x of Just (i,_) -> i
                         Nothing    -> error "Unparsable Int"
readLineOfInts l = map readInt (BS.split ' ' l)

chooseTwo n = n * (n - 1) `div` 2

f :: Integer -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)] -> Integer
-- f a xs ys zs = p
-- f 0 [] [] zs computes the number of pairs of hills that can see each other
-- hills can see each other when no hill on either of the circle arcs between
-- them is higher than either of them
-- the circle of hills is represented by the list
--   rev xs ++ rev ys ++ zs
-- where a pair (h, k) denotes k neighbouring hills all of the same height h,
-- the list xs are the leftmost ascending hills (in reverse order)
-- the list ys is a following segment of descending hills (in reverse order, ending with one larger than in xs, so ys=[]->xs=[])
-- and the list zs are the remaining hills
-- a is the accumulator for the number of pairs
f a [] [] (z:zs) = f a [] [z] zs
f a [] ys    []  = fDescending a ys
-- if we end up with an ascending prefix, we wrap it around to the end and do another pass (only happens once)
f a xs ys    []  = f a [] ys (reverse xs)
f a xs ((hy,ky):ys) ((hz,kz):zs) = case hy `compare` hz of
    GT -> f a xs ((hz,kz):(hy,ky):ys) zs
    EQ -> f a xs ((hy,ky+kz):ys) zs
    LT -> if ys == []
          then f a ((hy,ky):xs) [(hz,kz)] zs
          else f b xs ys ((hz,kz):zs) where b = a + chooseTwo (toInteger ky) + (toInteger ky) * 2
        -- large hill to the left of y, small hill y, large hill z

fDescending :: Integer -> [(Int, Int)] -> Integer
-- f a ys = p
-- ys is a list of descending hills in REVERSE order, so actually the last element in ys corresponds to the largest hills
fDescending a [(hy,ky)] = a + chooseTwo (toInteger ky)
fDescending a [(hy,ky),(hw,1)] = a + chooseTwo (toInteger ky) + (toInteger ky)
fDescending a ((hy,ky):ys) = fDescending b ys where b = a + chooseTwo (toInteger ky) + 2 * (toInteger ky)

fff = (f 0 [] []) . (map (\h -> (h, 1)))

main :: IO ()
main = do
    [ln,lhills] <- fmap BS.lines BS.getContents
    let n = readInt ln
    let hills = readLineOfInts lhills
    print $ fff hills

module Main where

import Data.List (unfoldr)

main :: IO ()
main = interact $ show . solve . readHills

type I = Int

readHills :: String -> [I]
readHills = tail . map read . words

count2 :: I -> I
count2 n = n * (n - 1) `div` 2

solve :: [I] -> I
solve xs = count 0 $ unfoldr step xs

count :: I -> [I] -> I
count c [x, 1] = c + x + count2 x
count c [x] = c + count2 x
count c (x:xs) = count (c + 2 * x + count2 x) xs

step :: [I] -> Maybe (I, [I])
step [] = Nothing
step hs = Just (length ms, ls ++ rs)
  where
    ml = minimum hs
    (ls, rems) = span (/= ml) hs
    (ms, rs) = span (== ml) rems

module Main where

import Data.Int (Int64)
import Data.List (unfoldr)

main :: IO ()
main = interact $ show . solve . readHills

readHills :: String -> [Int]
readHills = tail . map read . words

count2 :: Int -> Int
count2 n = n * (n - 1) `div` 2

solve :: [Int] -> Int64
solve xs = count 0 $ unfoldr step xs

count :: Int64 -> [Int] -> Int64
count c [x, 1] = c +  fromIntegral (x + count2 x)
count c [x] = c +  fromIntegral (count2 x)
count c (x:xs) = count (c +  fromIntegral (2 * x + count2 x)) xs

step :: [Int] -> Maybe (Int, [Int])
step [] = Nothing
step hs = Just (length ms, ls ++ rs)
  where
    ml = minimum hs
    (ls, rems) = span (/= ml) hs
    (ms, rs) = span (== ml) rems

{-# LANGUAGE BangPatterns #-}
module Main where

import Data.Int (Int64)

main :: IO ()
main = interact $ show . solve . readHills

readHills :: String -> (Int, [Int])
readHills input = (n, hs) where n:hs = map read $ words input

count2 :: Int64 -> Int64
count2 n = n * (n - 1) `div` 2

solve :: (Int, [Int]) -> Int64
solve (n, xs) = iter 0 [] $ map (`Acc` 1) hs
  where
    maxH = maximum xs
    hs = take n $ dropWhile (/= maxH) (cycle xs)

data Acc = Acc !Int !Int64

iter :: Int64 -> [Acc] -> [Acc] -> Int64
iter !c acc [] = count c $ map (\(Acc _ cc) -> cc) acc
iter !c [] (h:hs) = iter c [h] hs
iter !c acc@(Acc hx cx:as) hss@(Acc hy cy:hs)
  | hx < hy  = iter c (Acc hy cy : acc) hs
  | hx == hy = iter c (Acc hx (cx + cy) : as) hs
  | otherwise = iter (c + 2 * cx + count2 cx) as hss

count :: Int64 -> [Int64] -> Int64
count !c [x, 1] = c + x + count2 x
count !c [x] = c + count2 x
count !c (x:xs) = count (c + 2 * x + count2 x) xs

-- not FINISHED
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List
import Data.Tuple
import Data.Function
import qualified Data.ByteString.Char8 as BS
--import qualified Data.ByteString.Lazy.Char8 as BS

readInt :: BS.ByteString -> Int
readInt x =
    case BS.readInt x of Just (i,_) -> i
                         Nothing    -> error "Unparsable Int"
readLineOfInts l = map readInt (BS.split ' ' l)

chooseTwo n = n * (n - 1) `div` 2

f :: Int -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)] -> Int
-- f a xs ys zs = p
-- f 0 [] [] zs computes the number of pairs of hills that can see each other
-- hills can see each other when no hill on either of the circle arcs between
-- them is higher than either of them
-- the circle of hills is represented by the list
--   rev xs ++ rev ys ++ zs
-- where a pair (h, k) denotes k neighbouring hills all of the same height h,
-- the list xs are the leftmost ascending hills (in reverse order)
-- the list ys is a following segment of descending hills (in reverse order, ending with one larger than in xs, so ys=[]->xs=[])
-- and the list zs are the remaining hills
-- a is the accumulator for the number of pairs
f a [] [] (z:zs) = f a [] [z] zs
f a [] ys    []  = fDescending a ys
-- if we end up with an ascending prefix, we wrap it around to the end and do another pass (only happens once)
f a xs ys    []  = f a [] ys (reverse xs)
f a xs ((hy,ky):ys) ((hz,kz):zs) = case hy `compare` hz of
    LT -> f a xs ((hz,kz):(hy,ky):ys) zs
    EQ -> f a xs ((hy,ky+kz):ys) zs
    GT -> if ys == []
          then f a ((hy,ky):xs) [(hz,kz)] zs
          else f b xs ys ((hz,kz):zs) where b = a + chooseTwo ky + ky * 2
        -- large hill to the left of y, small hill y, large hill z

fDescending :: Int -> [(Int, Int)] -> Int
-- f a ys = p
-- ys is a list of descending hills in REVERSE order, so actually the last element in ys corresponds to the largest hills
fDescending a [(hy,ky)] = a + chooseTwo ky
fDescending a [(hy,ky),(hw,1)] = a + chooseTwo ky + ky
fDescending a ((hy,ky):ys) = fDescending b ys where b = a + chooseTwo ky + 2 * ky

fff = (f 0 [] []) . (map (\h -> (h, 1)))

ff 5 [4136, 1826, 4136, 1826, 1826] = let
        x = (minBound, maxBound) :: (Int, Int)
    in show (fff [4136, 1826, 4136, 1826, 1826])
ff n hills = show $ fff hills

main :: IO ()
main = do
    [ln,lhills] <- fmap BS.lines BS.getContents
    let n = readInt ln
    let hills = take n $ readLineOfInts lhills
    putStrLn $ ff n hills

-- not FINISHED
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List
import Data.Tuple
import Data.Function
import qualified Data.ByteString.Char8 as BS
--import qualified Data.ByteString.Lazy.Char8 as BS

readInt :: BS.ByteString -> Int
readInt x =
    case BS.readInt x of Just (i,_) -> i
                         Nothing    -> error "Unparsable Int"
readLineOfInts l = map readInt (BS.split ' ' l)

chooseTwo n = n * (n - 1) `div` 2

f :: Int -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)] -> Int
-- f a xs ys zs = p
-- f 0 [] [] zs computes the number of pairs of hills that can see each other
-- hills can see each other when no hill on either of the circle arcs between
-- them is higher than either of them
-- the circle of hills is represented by the list
--   rev xs ++ rev ys ++ zs
-- where a pair (h, k) denotes k neighbouring hills all of the same height h,
-- the list xs are the leftmost ascending hills (in reverse order)
-- the list ys is a following segment of descending hills (in reverse order, ending with one larger than in xs, so ys=[]->xs=[])
-- and the list zs are the remaining hills
-- a is the accumulator for the number of pairs
f a [] [] (z:zs) = f a [] [z] zs
f a [] ys    []  = fDescending a ys
-- if we end up with an ascending prefix, we wrap it around to the end and do another pass (only happens once)
f a xs ys    []  = f a [] ys (reverse xs)
f a xs ((hy,ky):ys) ((hz,kz):zs) = case hy `compare` hz of
    LT -> f a xs ((hz,kz):(hy,ky):ys) zs
    EQ -> f a xs ((hy,ky+kz):ys) zs
    GT -> if ys == []
          then f a ((hy,ky):xs) [(hz,kz)] zs
          else f b xs ys ((hz,kz):zs) where b = a + chooseTwo ky + ky * 2
        -- large hill to the left of y, small hill y, large hill z

fDescending :: Int -> [(Int, Int)] -> Int
-- f a ys = p
-- ys is a list of descending hills in REVERSE order, so actually the last element in ys corresponds to the largest hills
fDescending a [(hy,ky)] = a + chooseTwo ky
fDescending a [(hy,ky),(hw,1)] = a + chooseTwo ky + ky
fDescending a ((hy,ky):ys) = fDescending b ys where b = a + chooseTwo ky + 2 * ky

ff = (f 0 [] []) . (map (\h -> (h, 1)))

main :: IO ()
main = do
    [ln,lhills] <- fmap BS.lines BS.getContents
    let n = readInt ln
    let hills = take n $ readLineOfInts lhills
    let x = (minBound, maxBound) :: (Int, Int)
    print $ ff hills

-- not FINISHED
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List
import Data.Tuple
import Data.Function
import qualified Data.ByteString.Char8 as BS
--import qualified Data.ByteString.Lazy.Char8 as BS

readInt :: BS.ByteString -> Int
readInt x =
    case BS.readInt x of Just (i,_) -> i
                         Nothing    -> error "Unparsable Int"
readLineOfInts l = map readInt (BS.split ' ' l)

chooseTwo n = n * (n - 1) `div` 2

f :: Int -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)] -> Int
-- f a xs ys zs = p
-- f 0 [] [] zs computes the number of pairs of hills that can see each other
-- hills can see each other when no hill on either of the circle arcs between
-- them is higher than either of them
-- the circle of hills is represented by the list
--   rev xs ++ rev ys ++ zs
-- where a pair (h, k) denotes k neighbouring hills all of the same height h,
-- the list xs are the leftmost ascending hills (in reverse order)
-- the list ys is a following segment of descending hills (in reverse order, ending with one larger than in xs, so ys=[]->xs=[])
-- and the list zs are the remaining hills
-- a is the accumulator for the number of pairs
f a [] [] (z:zs) = f a [] [z] zs
f a [] ys    []  = fDescending a ys
-- if we end up with an ascending prefix, we wrap it around to the end and do another pass (only happens once)
f a xs ys    []  = f a [] ys (reverse xs)
f a xs ((hy,ky):ys) ((hz,kz):zs) = case hy `compare` hz of
    GT -> f a xs ((hz,kz):(hy,ky):ys) zs
    EQ -> f a xs ((hy,ky+kz):ys) zs
    LT -> if ys == []
          then f a ((hy,ky):xs) [(hz,kz)] zs
          else f b xs ys ((hz,kz):zs) where b = a + chooseTwo ky + ky * 2
        -- large hill to the left of y, small hill y, large hill z
{-
0 rev[] rev[] [3,1 2,1 3,1 2,1 2,1]
0 rev[] rev[3,1] [2,1 3,1 2,1 2,1]
0 rev[] rev[3,1 2,1] [3,1 2,1 2,1]
2 rev[] rev[3,1] [3,1 2,1 2,1]
2 rev[] rev[3,2] [2,1 2,1]
2 rev[] rev[3,2 2,1] [2,1]
2 rev[] rev[3,2 2,2] []
fDesc 2 rev[3,2 2,2]
fDesc 7 rev[3,2]
7 + 1 = 8

-}

fDescending :: Int -> [(Int, Int)] -> Int
-- f a ys = p
-- ys is a list of descending hills in REVERSE order, so actually the last element in ys corresponds to the largest hills
fDescending a [(hy,ky)] = a + chooseTwo ky
fDescending a [(hy,ky),(hw,1)] = a + chooseTwo ky + ky
fDescending a ((hy,ky):ys) = fDescending b ys where b = a + chooseTwo ky + 2 * ky

fff = (f 0 [] []) . (map (\h -> (h, 1)))

ff 5 [4136, 1826, 4136, 1826, 1826] = let
        x = (minBound, maxBound) :: (Int, Int)
    in show (fff [4136, 1826, 4136, 1826, 1826])
ff n hills = show $ fff hills

main :: IO ()
main = do
    [ln,lhills] <- fmap BS.lines BS.getContents
    let n = readInt ln
    let hills = readLineOfInts lhills
    print $ fff hills

-- not FINISHED
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List
import Data.Tuple
import Data.Function
import qualified Data.ByteString.Char8 as BS
--import qualified Data.ByteString.Lazy.Char8 as BS

readInt :: BS.ByteString -> Int
readInt x =
    case BS.readInt x of Just (i,_) -> i
                         Nothing    -> error "Unparsable Int"
readLineOfInts l = map readInt (BS.split ' ' l)

chooseTwo n = n * (n - 1) `div` 2

f :: Int -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)] -> Int
-- f a xs ys zs = p
-- f 0 [] [] zs computes the number of pairs of hills that can see each other
-- hills can see each other when no hill on either of the circle arcs between
-- them is higher than either of them
-- the circle of hills is represented by the list
--   rev xs ++ rev ys ++ zs
-- where a pair (h, k) denotes k neighbouring hills all of the same height h,
-- the list xs are the leftmost ascending hills (in reverse order)
-- the list ys is a following segment of descending hills (in reverse order, ending with one larger than in xs, so ys=[]->xs=[])
-- and the list zs are the remaining hills
-- a is the accumulator for the number of pairs
f a [] [] (z:zs) = f a [] [z] zs
f a [] ys    []  = fDescending a ys
-- if we end up with an ascending prefix, we wrap it around to the end and do another pass (only happens once)
f a xs ys    []  = f a [] ys (reverse xs)
f a xs ((hy,ky):ys) ((hz,kz):zs) = case hy `compare` hz of
    LT -> f a xs ((hz,kz):(hy,ky):ys) zs
    EQ -> f a xs ((hy,ky+kz):ys) zs
    GT -> if ys == []
          then f a ((hy,ky):xs) [(hz,kz)] zs
          else f b xs ys ((hz,kz):zs) where b = a + chooseTwo ky + ky * 2
        -- large hill to the left of y, small hill y, large hill z

fDescending :: Int -> [(Int, Int)] -> Int
-- f a ys = p
-- ys is a list of descending hills in REVERSE order, so actually the last element in ys corresponds to the largest hills
fDescending a [(hy,ky)] = a + chooseTwo ky
fDescending a [(hy,ky),(hw,1)] = a + chooseTwo ky + ky
fDescending a ((hy,ky):ys) = fDescending b ys where b = a + chooseTwo ky + 2 * ky

fff = (f 0 [] []) . (map (\h -> (h, 1)))

ff 5 [4136, 1826, 4136, 1826, 1826] = let
        x = (minBound, maxBound) :: (Int, Int)
    in show x ++ " " ++ show (fff [4136, 1826, 4136, 1826, 1826])
ff n hills = show $ fff hills

main :: IO ()
main = do
    [ln,lhills] <- fmap BS.lines BS.getContents
    let n = readInt ln
    let hills = take n $ readLineOfInts lhills
    putStrLn $ ff n hills

-- not FINISHED
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List
import Data.Tuple
import Data.Function
import qualified Data.ByteString.Char8 as BS
--import qualified Data.ByteString.Lazy.Char8 as BS

readInt :: BS.ByteString -> Int
readInt x =
    case BS.readInt x of Just (i,_) -> i
                         Nothing    -> error "Unparsable Int"
readLineOfInts l = map readInt (BS.split ' ' l)

chooseTwo n = n * (n - 1) `div` 2

f :: Integer -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)] -> Integer
-- f a xs ys zs = p
-- f 0 [] [] zs computes the number of pairs of hills that can see each other
-- hills can see each other when no hill on either of the circle arcs between
-- them is higher than either of them
-- the circle of hills is represented by the list
--   rev xs ++ rev ys ++ zs
-- where a pair (h, k) denotes k neighbouring hills all of the same height h,
-- the list xs are the leftmost ascending hills (in reverse order)
-- the list ys is a following segment of descending hills (in reverse order, ending with one larger than in xs, so ys=[]->xs=[])
-- and the list zs are the remaining hills
-- a is the accumulator for the number of pairs
f a [] [] (z:zs) = f a [] [z] zs
f a [] ys    []  = fDescending a ys
-- if we end up with an ascending prefix, we wrap it around to the end and do another pass (only happens once)
f a xs ys    []  = f a [] ys (reverse xs)
f a xs ((hy,ky):ys) ((hz,kz):zs) = case hy `compare` hz of
    GT -> f a xs ((hz,kz):(hy,ky):ys) zs
    EQ -> f a xs ((hy,ky+kz):ys) zs
    LT -> if ys == []
          then f a ((hy,ky):xs) [(hz,kz)] zs
          else f b xs ys ((hz,kz):zs) where b = a + chooseTwo (toInteger ky) + (toInteger ky) * 2
        -- large hill to the left of y, small hill y, large hill z
{-
0 rev[] rev[] [3,1 2,1 3,1 2,1 2,1]
0 rev[] rev[3,1] [2,1 3,1 2,1 2,1]
0 rev[] rev[3,1 2,1] [3,1 2,1 2,1]
2 rev[] rev[3,1] [3,1 2,1 2,1]
2 rev[] rev[3,2] [2,1 2,1]
2 rev[] rev[3,2 2,1] [2,1]
2 rev[] rev[3,2 2,2] []
fDesc 2 rev[3,2 2,2]
fDesc 7 rev[3,2]
7 + 1 = 8

-}

fDescending :: Integer -> [(Int, Int)] -> Integer
-- f a ys = p
-- ys is a list of descending hills in REVERSE order, so actually the last element in ys corresponds to the largest hills
fDescending a [(hy,ky)] = a + chooseTwo (toInteger ky)
fDescending a [(hy,ky),(hw,1)] = a + chooseTwo (toInteger ky) + (toInteger ky)
fDescending a ((hy,ky):ys) = fDescending b ys where b = a + chooseTwo (toInteger ky) + 2 * (toInteger ky)

fff = (f 0 [] []) . (map (\h -> (h, 1)))

main :: IO ()
main = do
    [ln,lhills] <- fmap BS.lines BS.getContents
    let n = readInt ln
    let hills = readLineOfInts lhills
    let x = (minBound, maxBound) :: (Int, Int)
    print x
    print $ fff hills

-- not FINISHED
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List
import Data.Tuple
import Data.Function
import qualified Data.ByteString.Char8 as BS
--import qualified Data.ByteString.Lazy.Char8 as BS

readInt :: BS.ByteString -> Int
readInt x =
    case BS.readInt x of Just (i,_) -> i
                         Nothing    -> error "Unparsable Int"
readLineOfInts l = map readInt (BS.split ' ' l)

chooseTwo n = n * (n - 1) `div` 2

f :: Int -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)] -> Int
-- f a xs ys zs = p
-- f 0 [] [] zs computes the number of pairs of hills that can see each other
-- hills can see each other when no hill on either of the circle arcs between
-- them is higher than either of them
-- the circle of hills is represented by the list
--   rev xs ++ rev ys ++ zs
-- where a pair (h, k) denotes k neighbouring hills all of the same height h,
-- the list xs are the leftmost ascending hills (in reverse order)
-- the list ys is a following segment of descending hills (in reverse order, ending with one larger than in xs, so ys=[]->xs=[])
-- and the list zs are the remaining hills
-- a is the accumulator for the number of pairs
f a [] [] (z:zs) = f a [] [z] zs
f a [] ys    []  = fDescending a ys
-- if we end up with an ascending prefix, we wrap it around to the end and do another pass (only happens once)
f a xs ys    []  = f a [] ys (reverse xs)
f a xs ((hy,ky):ys) ((hz,kz):zs) = case hy `compare` hz of
    LT -> f a xs ((hz,kz):(hy,ky):ys) zs
    EQ -> f a xs ((hy,ky+kz):ys) zs
    GT -> if ys == []
          then f a ((hy,ky):xs) [(hz,kz)] zs
          else f b xs ys ((hz,kz):zs) where b = a + chooseTwo ky + ky * 2
        -- large hill to the left of y, small hill y, large hill z

fDescending :: Int -> [(Int, Int)] -> Int
-- f a ys = p
-- ys is a list of descending hills in REVERSE order, so actually the last element in ys corresponds to the largest hills
fDescending a [(hy,ky)] = a + chooseTwo ky
fDescending a [(hy,ky),(hw,1)] = a + chooseTwo ky + ky
fDescending a ((hy,ky):ys) = fDescending b ys where b = a + chooseTwo ky + 2 * ky

ff = (f 0 [] []) . (map (\h -> (h, 1)))

main :: IO ()
main = do
    [ln,lhills] <- fmap BS.lines BS.getContents
    let n = readInt ln
    let hills = readLineOfInts lhills
    let x = (minBound, maxBound) :: (Int, Int)
    print $ ff hills


Kefa decided to make some money doing business on the Internet for exactly n days. He knows that on the i-th day (1 ≤ i ≤ n) he makes ai money. Kefa loves progress, that's why he wants to know the length of the maximum non-decreasing subsegment in sequence ai. Let us remind you that the subsegment of the sequence is its continuous fragment. A subsegment of numbers is called non-decreasing if all numbers in it follow in the non-decreasing order.Help Kefa cope with this task!

The first line contains integer n (1 ≤ n ≤ 105). The second line contains n integers a1,  a2,  ...,  an (1 ≤ ai ≤ 109).

Print a single integer — the length of the maximum non-decreasing subsegment of sequence a.

NoteIn the first test the maximum non-decreasing subsegment is the numbers from the third to the fifth one.In the second test the maximum non-decreasing subsegment is the numbers from the first to the third one.

import Data.List

parse :: String -> Int
parse x = read x :: Int

comb :: (Int,Int,Int) -> Int -> (Int,Int,Int)
comb (ans, stride, last) cur
    | cur < last = (ans, 1, cur)
    | otherwise = (max ans (stride+1), stride+1, cur)

getans (ans, _, _) = ans

solve :: [Int] -> Int
solve xs = getans (foldl comb (1,0,-1) xs)

run :: String -> String
run xs = show $ solve $ map parse $ tail $ words xs

main = interact run

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

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

main = do
	n <- readInt
	(a:as) <- readInts

	print $ succ $ maximum $ ( 0 : ) $ map length $ filter ( ( == 1 ) . head ) $ group $ conv a as

conv _ [] = []
conv p (a:as)
	| p <= a = 1 : conv a as
	| otherwise = 0 : conv a as

removeFromFront :: Int -> [Int] -> [Int]
removeFromFront a [] = []
removeFromFront a (h:t)
	|(h >= a) = (removeFromFront h t)
	|otherwise = (h:t)

longestSubsegment :: [Int] -> Int
longestSubsegment [] = 0
longestSubsegment t = max (length t - length removed) (longestSubsegment removed)
	where removed = removeFromFront 0 t

long :: Int -> Int -> [Int] -> Int
long last acc [] = acc
long last acc (h:t)
	|last <= h = long h (acc+1) t
	|otherwise = max acc (long h 1 t)

main = do
	n <- fmap (map (read::String -> Int).words) getLine
	seq <- fmap (map read.words) getLine
	print $ (long 0 0 seq)

import Control.Monad

search [x] cur m = m
search (x:y:xs) cur m
  | y >= x = search (y:xs) cur' (max cur' m)
  | otherwise = search (y:xs) 0 m
  where
    cur' = cur+1

main = do
  n <- readLn :: IO Int
  aa <- getLine
  let xs = map read $ words aa :: [Int]
  print $ 1 + search xs 0 0

module Main (main)
    where

readInts :: String -> [Int]
readInts = map read . words

main :: IO ()
main = print . solve . readInts =<< (getLine >> getLine)
    where solve (x:xs) = go 0 1 x xs
          go m t _ [] = max m t
          go m t last (x:xs)
            | x >= last = go m (t + 1) x xs
            | otherwise = go (max m t) 1 x xs

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

main = do  print . (solve 1).(2000000000:).tail =<< map (fst . fromJust . B.readInt) . B.words <$> B.getContents
solve :: Int->[Int]->Int
solve acc (a:b:[]) = if b>=a then acc+1 else acc
solve acc (a:xs@(b:_)) | a>b = max acc $ solve 1 xs
                       | otherwise = solve (acc+1) xs

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

solve :: [Int] -> Int
solve a = solve' a 0 0

solve' :: [Int] -> Int -> Int -> Int
solve' []     _ c = c
solve' (a:ax) l c | a >= l    = solve' ax a (c + 1)
                  | otherwise = max c (solve' ax a 1)

-- Snippet: partitionWith
partitionWith1 eq (a1 : an)
    | not (null an) && eq a1 (head an) = (a1 : r, aLeft)
    | otherwise = ([a1], an)
    where (r, aLeft) = partitionWith1 eq an

partitionWith eq a
    | null a = []
    | otherwise = r : partitionWith eq aLeft
    where (r, aLeft) = partitionWith1 eq a

-- Snippet: readItems
readItems = do
    line <- getLine
    return $ map read $ words line

main = do
    n <- getLine
    a <- readItems :: IO [Int]
    putStrLn $ show $ maximum $ map length $ partitionWith (<=) a

import Data.List
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let z = zip a (tail a)
    print $ 1 + (solve 0 0 z)

solve m c [] = max m c
solve m c ((a,b):l)
 |b>=a = solve m (c+1) l
 |otherwise = solve (max m c) 0 l

solution :: [Int] -> Int -> Int
solution [x] m = m + 1
solution (x:xs) m
    | x <= head xs = solution xs (m+1)
    | otherwise = max (m+1) (solution xs 0)

main :: IO ()
main = do
    k <- getLine
    x <- getLine
    let args = map (\x -> read x :: Int) $ words x
    print $ solution args 0

main = do
    getLine
    as <- fmap (map read . words) getLine :: IO [Int]

    let
        f [a] = (1, 1)
        f (a:b:s) = (m1', m2')
            where
                (m1, m2) = f (b:s)
                m1' = if a <= b then m1+1 else 1
                m2' = max m2 m1'

        (_, m) = f as

    print m

consume_positives [] = 0
consume_positives aa@(a:b)
  | a < 0 = consume_positives b
  | otherwise = max (length c1) (consume_positives c2)
  where (c1,c2) = break (<0) aa

solve a = 1 + consume_positives b
  where b = zipWith (-) (tail a) a

main = interact $ show . solve . map read . words . head . tail . lines

import Debug.Trace (trace)
import Data.List (group)
import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

{-
maxSub []   = 0
maxSub nums = maximum maxLengths
    where orders = zipWith (>=) nums (0:nums)
          grouped = group (trace (show orders) orders)
          onlyTrue = filter (all (== True)) grouped
          maxLengths = map length onlyTrue
-}

maxSub :: [Integer] -> Integer
maxSub [] = 0
maxSub nums = max m c
    where (m, c, _) = foldl fn (0, 0, 0) nums

fn (m, c, p) n = (m', c', n)
    where m' = if n < p then (max m c) else m
          c' = if n < p then 1         else c + 1

main = do
    contents <- C.getContents
    let numbers = (toInts . tail . C.words) contents
    print (maxSub numbers)
    where toInts = map (toInteger . fst . fromJust . C.readInt)

import qualified Data.ByteString.Char8 as BS
import Data.Word(Word32)
import Data.List(foldl')

read' = read . BS.unpack

numNonDec xs = result
  where
    loop (prev, n, final) x = n' `seq` max' `seq` comp' `seq` comp'
      where n' = n + 1
            max' = max n' final
            comp' = if x >= prev then (x, n', max n' final) else (x, 1, final)
    (_,_,result) = foldl' loop (0,0,0) xs

main :: IO ()
main = do
  _ <- BS.getLine
  ns' <- BS.getLine
  let ns = map (read') . BS.words $ ns' :: [Word32]
  print $ numNonDec ns

{-# LANGUAGE BlockArguments #-}

import Control.Arrow
import Data.List

main = do { n <- getLine
          ; x <- getLine
          ; putStrLn $ (words >>> map read >>> solve >>> show) x
          }

count :: (Int,Integer,Int) -> Integer -> (Int,Integer,Int)
count (m,p,a) z = let b = if z >= p then a+1 else 1
                  in (max m b, z, b)

solve :: [Integer] -> Int
solve x = let (n,_,_) = foldl count (0,1000000001,0) x
          in n

answer::Int->[Int]->Int
answer n a = 1 + toNum (toBool n a)
bton::Bool -> Int
bton True = 1
bton False = 0
toNum::[Bool] -> Int
toNum a = toNum0 0 a
toNum0::Int -> [Bool] -> Int
toNum0 n [] = 0
toNum0 n a | head a = max (n+1) (toNum0 (n+1) (tail a))
           | otherwise = toNum0 0 (tail a)
toBool::Int -> [Int] -> [Bool]
toBool n a= toBool0 (head a) (tail a)
toBool0 preNum [] = []
toBool0 preNum a = [preNum <= (head a)] ++ (toBool0 (head a) (tail a))
--main = print $ answer 2 [2,1]
main = do
         w0 <-getLine
         let n = read w0::Int
         w1 <- getLine
         let a = [read n::Int | n <-(words w1)]
         print $ answer n a

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show.solve2.solve.map read.words.head.tail . lines
--solve :: [String]->[Int]
solve2::[(Int,Int)]->Int
solve2 xs = maximum [x| (_,x)<-xs]
solve xs = foldr (f) [] xs  --[2, 3,4,3,0, 5]
  where
    f a [] = [(a,1)]
    f a ((b1,b2):bs) = if b1>=a then (a,b2+1):bs else (a,1):((b1,b2):bs)

import Data.List
import Data.Function

gpBy :: [[Int]] -> [Int] -> [[Int]]
gpBy [] (x:xs) = gpBy [[x]] xs
gpBy acc [] = reverse acc
gpBy (a:acc) [x] = gpBy  (if x>= head a then ((x:a):acc) else [x]:(a:acc)) []
gpBy (a:acc) (x:xs)  =  gpBy (if (x>=head a) then ((x:a):acc) else ([x]:a:acc)) xs

main = do
   getLine
   getLine >>= print . length . maximumBy (compare `on` length) . gpBy [] . map (\x -> read x :: Int) .  words

main=interact$show.f 0 0 0.map read.tail.words
f a b c []=max b c
f a b c (d:e)=if a<=d then f d (b+1) c e else f d 1 (max b c) e

-- Codeforces 580A

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

solve :: [Int] -> Int
solve (n:xs) = (\(ans, _, _) -> ans) $ foldl (\(ans, acc, prev) x -> if x >= prev then ((max ans (acc+1)), acc+1, x) else (ans, 1, x)) (0, 0, 0) xs

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

getIntList :: IO [Int]
getIntList = map fst . mapMaybe C.readInt . C.words <$> C.getLine

main :: IO ()
main = print =<< sol <$> (getLine *> getIntList)

sol :: [Int] -> Int
sol = fst . fst . foldl' f ((0,0),0)
  where
  f ((p,q),b) a = if b>a then ((p,1),a) else ((max p (q+1),q+1),a)

import Control.Monad
import Data.Array
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

incGroup :: Ord a => [a] -> [[a]]
incGroup [] = [[]]
incGroup [x] = [[x]]
incGroup (x:t@(y:_)) = if x <= y then (x : hz) : tz else [x] : z
                where z@(hz:tz) = incGroup t

solve :: [Int] -> Int
solve = maximum . map length . incGroup

main :: IO ()
main = do
        _ <- getLine
        a <- getIntList
        print $ solve a

import Control.Applicative
process [] cl ml _ = max ml cl
process (hl:lis) cl ml le | hl>=le = process lis (cl+1) ml hl
                          | otherwise = process  lis  1  (max ml cl) hl

main=do
      getLine
      a<-(map read <$> words <$> getLine)::IO [Int]
      print $ process (tail a) 1 1 (head a)

import Data.List (group)

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

solve :: [Int] -> Int
solve xs = succ $ maximum $ (0:) $ map length $ filter head $ group $ zipWith (<=) xs (tail xs)

main = interact $ show . maximum . solve 0 0 . map read . tail . words
solve a p (n:ns) | n >= p = solve (a+1) n ns
                 | otherwise = a : solve 1 n ns
solve a _ _ = [a]

import System.IO
import Control.Monad
import Data.List

glwr = fmap (map read . words) getLine

main = do
  hSetBuffering stdout NoBuffering
  solve

solve :: IO ()
solve = do
  n:_ <- glwr
  ls <- glwr
  print $ nonDecProgress n ls

nonDecProgress :: Int -> [Int] -> Int
nonDecProgress n = fst . maximum . foldl nonDec [(0, 0)]

nonDec x@((m, pre):z) y
  | y >= pre = (m+1, y):z
  | 0 < 1 = (1, y):x

-- Vicfred
-- https://codeforces.com/problemset/problem/580/A

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

getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

incGroup :: Ord a => [a] -> [[a]]
incGroup [] = [[]]
incGroup [x] = [[x]]
incGroup (x:t@(y:_)) = if x <= y then (x : hz) : tz else [x] : z
                        where z@(hz:tz) = incGroup t

solve :: [Int] -> Int
solve = maximum . map length . incGroup

main :: IO ()
main = do
    _ <- getLine
    a <- getIntList
    print $ solve a

-- Vicfred
-- https://codeforces.com/contest/580/problem/A

solve :: [Int] -> Int -> Int
solve [x] m = m + 1
solve (x:xs) m
    | x <= head xs = solve xs (m+1)
    | otherwise = max (m+1) (solve xs 0)

main :: IO ()
main = do
    k <- getLine
    x <- getLine
    let args = map (\x -> read x :: Int) $ words x
    print $ solve args 0

import Data.Monoid

main = interact solve >> putChar '\n'

solve :: String -> String
solve rawInput = show maxNonDecreasing
    where input = (map . map) read $ map words $ lines rawInput :: [[Int]]
          inData = last input
          calc (lastMoney, curStreak, maxStreak) x =
            if x >= lastMoney
            then (x, curStreak + 1, (max (curStreak + 1) maxStreak))
            else (x, 1, max curStreak maxStreak)
          (_, _, maxNonDecreasing) = foldl calc (-1, 0, 0) inData

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

main = do  print . (solve 1) . (10^9 :) . tail =<< map (fst . fromJust . B.readInt) . B.words <$> B.getContents
solve :: Int -> [Int] -> Int
solve len (a:b:[]) = if b >= a then len + 1 else len
solve len (a:rest@(b:_)) | a > b = max len $ solve 1 rest
                         | otherwise = solve (len + 1) rest

ma m c l [] = m `max` c
ma m c l (x:xs) = if x >= l
                    then ma (m `max` (c + 1)) (c + 1) x xs
                    else ma m 1 x xs

main = do
    getLine
    t <- getLine
    let a = map (read::String -> Int) $ words t
    putStrLn $ show $ ma 0 0 0 a

ma m c l [] = m `max` c
ma m c l (x:xs) = let t = if x >= l then c + 1 else 1 in ma (m `max` t) t x xs

main = do
    getLine
    t <- getLine
    let a = map (read::String -> Int) $ words t
    putStrLn $ show $ ma 0 0 0 a

import qualified Data.List.Split as Split

problem n a =
  let merge_it (last_element, suffix, best_segment) x =
        if last_element <= x
          then (x, suffix + 1, best_segment)
          else (x, 1, max best_segment suffix)
      (_, suffix, best_segment) =
        foldl merge_it (0, 0, 0) a
  in
  show $ max suffix best_segment

read_int = (read :: String -> Integer)

parse_problem firstLine secondLine =
  let n = read_int firstLine in
  let splitted = Split.splitOn " " secondLine in
  let a = map read_int splitted in
  problem n a

main = do
  firstLine <- getLine
  secondLine <- getLine
  putStrLn $ parse_problem firstLine secondLine

solve :: [Int] -> Int
solve s = maximum . scanl f 1 $ zipWith (<=) s (tail s)
    where f x y = 1 + x * (fromEnum y)
main = getLine >> getLine >>= putStrLn . show . solve . map read . words

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
solve :: [Int] -> Int
solve s = maximum . scanl f 1 $ zipWith (<=) s (tail s)
    where f x y = 1 + x * (fromEnum y)
main = getLine >> B.getLine >>= putStrLn . show . solve . map (fst . fromJust . B.readInt) . B.words

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

maxNotDecreasing :: [Integer] -> Integer
maxNotDecreasing nums@(n:ns) =
  maximum (scanl (\n x -> if x then n + 1 else 0) 0
    (map (uncurry (<=)) (zip nums ns))) + 1

inputIntegerArray :: IO [Integer]
inputIntegerArray = getLine >>=
  \line -> return (map read $ words line)

main :: IO ()
main = getLine >> inputIntegerArray >>= putStrLn . show . maxNotDecreasing

--rollDice :: StdGen -> ((Int, Int), StdGen)
--rollDice gen = ((n,m),g2)
--  where
--    (n, g1) = randomR (1,6) gen
--    (m, g2) = randomR (1,6) g1

--
--newtype State s a = State { runState :: s -> (a, s) }
--
--state :: (s -> (a, s)) -> State s a
--state f = State { runState = f }
--
--instance Functor (State s) where
--  fmap f (State {runState = run})
--    = State {runState = \s -> (f (fst (run s)), snd (run s))}
--
--instance Applicative (State s) where
--  pure a = State {runState = \s -> (a, s)}
--  --runState (s -> ((a -> b), s))   s -> (a, s)     s -> (b, s)
--  (State {runState = runF}) <*> (State {runState = run}) = (State {runState --= \s -> ((fst (runF s)) (fst (run s)), s)})
--
--(>>=) :: State s a -> (a -> State s b) -> State s b
--p >>= k = q where
--    p' = runState p        -- p' :: s -> (a, s)
--    k' = runState . k      -- k' :: a -> s -> (b, s)
--    q' s0 = (y, s2) where  -- q' :: s -> (b, s)
--        (x, s1) = p' s0    -- (x, s1) :: (a, s)
--        (y, s2) = k' x s1  -- (y, s2) :: (b, s)
--    q = state q'

--main :: IO ()
--main = rollDiceIO >>= print

import Data.List

maxNotDecreasing :: [Integer] -> Integer
maxNotDecreasing nums@(n:ns) =
  maximum (scanl (\n x -> if x then n + 1 else 0) 0
    (map (uncurry (<=)) (zip nums ns))) + 1

inputIntegerArray :: IO [Integer]
inputIntegerArray = getLine >>=
  \line -> return (map read $ words line)

main :: IO ()
main = getLine >> inputIntegerArray >>= putStrLn . show . maxNotDecreasing

--import Data.Char
--import Control.Applicative
--import Control.Monad
--import System.Random

--rollDice :: StdGen -> ((Int, Int), StdGen)
--rollDice gen = ((n,m),g2)
--  where
--    (n, g1) = randomR (1,6) gen
--    (m, g2) = randomR (1,6) g1

--
--newtype State s a = State { runState :: s -> (a, s) }
--
--state :: (s -> (a, s)) -> State s a
--state f = State { runState = f }
--
--instance Functor (State s) where
--  fmap f (State {runState = run})
--    = State {runState = \s -> (f (fst (run s)), snd (run s))}
--
--instance Applicative (State s) where
--  pure a = State {runState = \s -> (a, s)}
--  --runState (s -> ((a -> b), s))   s -> (a, s)     s -> (b, s)
--  (State {runState = runF}) <*> (State {runState = run}) = (State {runState --= \s -> ((fst (runF s)) (fst (run s)), s)})
--
--(>>=) :: State s a -> (a -> State s b) -> State s b
--p >>= k = q where
--    p' = runState p        -- p' :: s -> (a, s)
--    k' = runState . k      -- k' :: a -> s -> (b, s)
--    q' s0 = (y, s2) where  -- q' :: s -> (b, s)
--        (x, s1) = p' s0    -- (x, s1) :: (a, s)
--        (y, s2) = k' x s1  -- (y, s2) :: (b, s)
--    q = state q'

--main :: IO ()
--main = rollDiceIO >>= print

import Control.Applicative
import Data.List
import Data.Maybe

process [] _ n mn= max mn n
process (x:xs) a n mn | x>=a = process xs x (n+1) mn
                      | otherwise = process xs x 1 (max mn n)

main= do
	getLine
	x<- map read. words <$> getLine ::IO [Int]
	print $ process (tail x)  (head x) 1 1

{-
Codeforces Round #321 (Div. 2)

Problem 580 A. Kefa and First Steps

@author yamaton
@date 2015-09-22
-}

import Control.Applicative
import Control.Monad
import Text.Printf
import System.IO (hPutStrLn, stderr)

import Data.Ord (comparing)
import Data.Function (on)
import Data.List (maximumBy)
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
-- import qualified Data.Foldable as F
-- import qualified Data.Traversable as T

-- lndcs : Longest Non-decreasing consecutive sequence
lndcs :: [Int] -> Int
lndcs xs = maximum $ scanl f 1 neighbors
  where
    f :: Int -> (Int, Int) -> Int
    f acc (a, b) | a <= b    = acc + 1
                 | otherwise = 1
    neighbors = zip xs (tail xs)

main :: IO ()
main = do
    n <- read <$> getLine :: IO Int
    xs <- (map read . words) <$> getLine :: IO [Int]
    -- ys <- replicateM n getLine
    let result = lndcs xs
    print result
    -- print (length result)
    --
    -- hPutStrLn stderr $ printf "xs = %s" (show xs)
    -- hPutStrLn stderr $ printf "result = %d" result

import Control.Applicative
import Data.Array
import Data.Foldable (maximum)

solve :: Int -> Array Int Integer -> Integer
solve n nums = Data.Foldable.maximum pd
  where -- pd :: Array Int Integer
        pd = listArray (0, n-1) $ work <$> [0..n-1]
        work 0 = 1
        work i = if (nums ! i) >= (nums ! (i-1))
                    then (pd ! (i-1)) + 1
                    else 1

main = do
  n <- read <$> getLine
  nums <- map read . words <$> getLine
  --print nums
  print $ solve n $ listArray (0,n-1) nums

import           Data.List
unfolder :: [Int] -> Maybe (Bool, [Int])
unfolder [] = Nothing
unfolder [a] = Nothing
unfolder [a, b] = Just (a <= b, [b])
unfolder (a:b:rest) = Just (a <= b, b:rest)

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    print =<< maximum . (1:) . map ((1+) . length) . filter or . group . unfoldr unfolder . map (read :: String -> Int) . words <$> getLine

import           Data.List
unfolder :: [Int] -> Maybe (Bool, [Int])
unfolder (a:b:as) = Just (a <= b, b:as)
unfolder _ = Nothing

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    print =<< maximum . (1:) . map ((1+) . length) . filter or . group . unfoldr unfolder . map (read :: String -> Int) . words <$> getLine

module Main where

import Data.Functor

subsequence :: [Int] -> [[Int]]
subsequence []  = []
subsequence [x] = [[x]]
subsequence (x:xs)
  | x <= y = (x:yss):zs
  | otherwise = [x]:zss
    where zss@(yss@(y:_):zs) = subsequence xs

main :: IO ()
main = do
  a <- map (read::String->Int) . words . last . lines <$> getContents
  let ans = maximum . map length . subsequence $ a
  {-print a-}
  print ans

import Data.Char
import Data.List
import Data.Map
import Control.Monad.State

--2 2 1 3 cutted 2 2 1 1 1<3 -> 1 + answer 221
answer ::  [Integer] ->Integer->[Integer]
answer [_] n = [n]
answer (x:y:xs) n | x <= y = answer (y:xs) (n +1)
                  | otherwise = n : answer (y:xs) 1

someFunc :: IO ()
someFunc = getLine >> getLine >>= (\l -> let numbers = read <$> words l in print $ maximum $ answer numbers 1 )

main :: IO ()
main = someFunc

readInt :: String -> Int
readInt = read

incSeg :: [Int] -> [[Int]]
incSeg [] = [[]]
incSeg (x:xs) =
  if (null a || (head a >= x))
     then (x:a):rs
     else [x]:a:rs
       where (a:rs) = incSeg xs

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- (fmap (map readInt . words) getLine)
  print $ maximum $ map length $ incSeg xs
  return ()

type Input = [Int]

parse :: String -> Input
parse = map read . words . (!! 1) . lines

solve :: Input -> Int
solve = snd . go
        where go []       = undefined
              go [_]      = (1, 1)
              go (x : xs) = let (l, m) = go   xs
                                y      = head xs in
                            if x <= y
                            then let l' = l + 1 in (l', max m l')
                            else (1, m)

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

groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy rel []          =  []
groupBy rel (x:xs)      =  (x:ys) : groupBy rel zs
    where (ys,zs) = groupByAux x xs
          groupByAux x0 (x:xs) | rel x0 x = (x:ys, zs)
            where (ys,zs) = groupByAux x xs
          groupByAux y xs = ([], xs)

process :: [Int] -> Int
process = maximum.map length.groupBy (<=)

readInt :: String -> Int
readInt = read

main = do
    n <- fmap readInt getLine
    as <- fmap (map readInt.words) getLine
    print $ process as

import System.IO

read_ints :: String -> [Int]
read_ints ln = map read (words ln) :: [Int]

solve :: [Int] -> [Int]
solve [] = []
solve (x:[]) = [1]
solve (x:xs) = if x < head xs then [1] ++ solve xs
                 else
                   [head y+1] ++ y
                   where y = solve xs
solve2 :: [Int] -> Int
solve2 xs = maximum $ solve xs

main = do
    ln <- getLine
    let [n] = read_ints ln
    ln <- getLine
    let arr = read_ints ln
    let rev = reverse arr
    print $ solve2 rev

module Main where

-- import           Data.List.GroupBy

main :: IO ()
main = interact $ show . f . map read . tail . words

f :: [Integer] -> Int
f = maximum . map length . groupBy (<=)

groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy _ [] = []
groupBy p' (x':xs') = (x' : ys') : zs'
  where
    (ys',zs') = go p' x' xs'
    go p z (x:xs)
      | p z x = (x : ys, zs)
      | otherwise = ([], (x : ys) : zs)
      where (ys,zs) = go p x xs
    go _ _ [] = ([], [])

import Data.Int

maxlength :: [Int64] -> Int
maxlength xs =
    let (l, _, _) = foldl f (0, 0, 0) xs
    in l

f :: (Int, Int, Int64) -> Int64 -> (Int, Int, Int64)
f (mlen, clen, cval) x
    | x >= cval = (max (clen + 1) mlen, clen + 1, x)
    | otherwise = (mlen, 1, x)

solve :: String -> String
solve = show.maxlength.fmap read.tail.words

main :: IO ()
main = interact solve

import           Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import           Data.Int
import           Data.Maybe

maxNonDecreasingLength :: [Integer] -> Int
maxNonDecreasingLength xs =
    let (l, _, _) = foldl f (0, 0, 0) xs
    in l

f :: (Int, Int, Integer) -> Integer -> (Int, Int, Integer)
f (answer, candidate, cval) x
    | x >= cval = (max (candidate + 1) answer, candidate + 1, x)
    | otherwise = (answer, 1, x)

solve :: BS.ByteString -> BS.ByteString
solve = toLazyByteString . intDec . maxNonDecreasingLength . fmap (fst . fromJust . BS.readInteger) . tail . BS.words

main :: IO ()
main = BS.interact solve

main = interact $ show . foo 0 0 . tail . map read . words

foo :: Int -> Int -> [Int] -> Int
foo a b [x] = max a (b + 1)
foo a b (x:xs)
    |x <= head xs = foo a (b + 1) xs
    |otherwise = foo (max a (b + 1)) 0 xs

main = interact $ show . f . map read . words

f :: [Int] -> Int
f (_:l) = foo 0 0 l

foo :: Int -> Int -> [Int] -> Int
foo a _ [] = a
foo a b [x] = max a (b + 1)
foo a b (x:xs)
    |x <= head xs = foo a (b + 1) xs
    |a < b + 1 = foo (b + 1) 0 xs
    |otherwise = foo a 0 xs

import Data.List
f as = let bs = scanl (\s x -> if fst s<=x then(x,snd s+1) else(x,1)) (0,0) as
       in maximum.map snd $ bs
main = interact $ show.f.map read.tail.words

import Data.List

parse :: String -> Int
parse x = read x :: Int

comb :: (Int,Int,Int) -> Int -> (Int,Int,Int)
comb (ans, stride, last) cur
    | cur < last = (max ans stride, 1, cur)
    | otherwise = (max ans stride+1, stride+1, cur)

getans (ans, _, _) = ans

solve :: [Int] -> Int
solve xs = getans (foldl comb (0,0,-1) xs)

run :: String -> String
run xs = show $ solve $ map parse $ tail $ words xs

main = interact run

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

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

main = do
	n <- readInt
	(a:as) <- readInts

	print $ succ $ maximum $ map length $ group $ conv a as

conv _ [] = [ -1 ]
conv p (a:as)
	| p <= a = 1 : conv a as
	| otherwise = 0 : conv a as

import Data.List (group)
import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

maxSub []   = 0
maxSub nums = maximum maxLengths
    where orders = zipWith (>=) nums (0:nums)
          grouped = group orders
          onlyTrue = filter (all (== True)) grouped
          maxLengths = map length onlyTrue

main = do
    contents <- C.getContents
    let numbers = (toInts . tail . C.words) contents
    print (maxSub numbers)
    where toInts = map (toInteger . fst . fromJust . C.readInt)

{-# LANGUAGE BlockArguments #-}

import Control.Arrow
import Data.List

main = do { n <- getLine
          ; x <- getLine
          ; putStrLn $ (words >>> map read >>> solve >>> show) x
          }

count :: (Int,Integer,Int) -> Integer -> (Int,Integer,Int)
count (m,p,a) z | z >= p    = (max m (a+1), z, a+1)
                | otherwise = (m, z, 1)

solve :: [Integer] -> Int
solve x = let (n,_,_) = foldl count (0,1000000001,0) x
          in n

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show.solve2.solve .words.head.tail . lines
--solve :: [String]->[Int]
solve2 xs = maximum [x| (_,x)<-xs]
solve xs = foldr (f) [] xs  --[2, 3,4,3,0, 5]
  where
    f a [] = [(a,1)]
    f a ((b1,b2):bs) = if b1>=a then (a,b2+1):bs else (a,1):((b1,b2):bs)

import Data.List
import Data.Function

gpBy :: [[Int]] -> [Int] -> [[Int]]
gpBy [] (x:xs) = gpBy [[x]] xs
gpBy acc [] = reverse acc
gpBy (a:acc) [x] = gpBy  (if x>= head a then ((x:a):acc) else [x]:(a:acc)) []
gpBy (a:acc) (x:xs)  =  gpBy (if (x>=head a) then ((x:a):acc) else ([x]:a:acc)) xs

main = do
   getLine
   getLine >>= print . length . maximumBy (compare `on` sum) . gpBy [] . map (\x -> read x :: Int) .  words

import Data.List
import Data.Function

main = do
   getLine
   getLine >>= print . length . maximumBy (compare `on` sum) . (groupBy $ \x y->x<y) . map (\x -> read x :: Int) .  words

main=interact$show.f 0 (-1) 0.map read.tail.words
f a b c []=max b c
f a b c (d:e)=if a<=d then f d (b+1) c e else f d 1 (max b c) e

import Control.Applicative
process [] _ ml _ = ml
process (hl:lis) cl ml le | hl<=le = process lis (cl+1) ml hl
                          | otherwise = process  lis  1  (max ml cl) hl

main=do
      getLine
      a<-(map read <$> words <$> getLine)::IO [Int]
      print $ process (tail a) 1 1 (head a)

import Control.Applicative
process [] _ ml _ = ml
process (hl:lis) cl ml le | hl>=le = process lis (cl+1) ml hl
                          | otherwise = process  lis  1  (max ml cl) hl

main=do
      getLine
      a<-(map read <$> words <$> getLine)::IO [Int]
      print $ process (tail a) 1 1 (head a)

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

main = do  print . (solve 1) =<< map (fst . fromJust . B.readInt) . B.words <$> B.getContents
solve :: Int -> [Int] -> Int
solve len (a:b:[]) = if b >= a then len + 1 else len
solve len (a:rest@(b:_)) | a > b = max len $ solve 1 rest
                         | otherwise = solve (len + 1) rest

import Data.List
solve :: [Int] -> Int
solve = maximum . map length . groupBy (<)
main = interact $ show . solve . map read . tail . words

import Data.List
solve :: [Int] -> Int
solve = maximum . map length . groupBy (<=)
main = interact $ show . solve . map read . tail . words

import Data.Char
import Data.List
import Data.Map
import Control.Monad.State

--2 2 1 3 cutted 2 2 1 1 1<3 -> 1 + answer 221
answer ::  [Integer] ->Integer->[Integer]
answer [_] n = [n]
answer (x:y:xs) n | x <= y = answer (y:xs) (n +1)
                  | otherwise = n : answer (y:xs) 1

someFunc :: IO ()
someFunc = getLine >> getLine >>= (\l -> let numbers = read <$> words l in print $  answer numbers 1 )

main :: IO ()
main = someFunc

import Data.Char
import Data.List
import Data.Map
import Control.Monad.State

answer ::  [Integer] -> Integer
answer [_] = 1
answer xs | last cutted < last xs = answer cutted + 1
          | otherwise = answer cutted where cutted = init xs

someFunc :: IO ()
someFunc = getLine >> getLine >>= (\l -> let numbers = read <$> words l in print $ answer numbers)

main :: IO ()
main = someFunc

import Data.Char
import Data.List
import Data.Map
import Control.Monad.State

answer ::  [Integer] -> Integer
answer [_] = 1
answer xs | last cutted <= last xs = answer cutted + 1
          | otherwise = answer cutted where cutted = init xs

someFunc :: IO ()
someFunc = getLine >> getLine >>= (\l -> let numbers = read <$> words l in print $ answer numbers)

main :: IO ()
main = someFunc

module Main where

import           Data.List

main :: IO ()
main = interact $ show . f . map read . tail . words

f :: [Integer] -> Int
f = maximum . map length . groupBy (<=)


Vasya is choosing a laptop. The shop has n laptops to all tastes.Vasya is interested in the following properties: processor speed, ram and hdd. Vasya is a programmer and not a gamer which is why he is not interested in all other properties.If all three properties of a laptop are strictly less than those properties of some other laptop, then the first laptop is considered outdated by Vasya. Among all laptops Vasya does not consider outdated, he chooses the cheapest one.There are very many laptops, which is why Vasya decided to write a program that chooses the suitable laptop. However, Vasya doesn't have his own laptop yet and he asks you to help him.

The first line contains number n (1 ≤ n ≤ 100). Then follow n lines. Each describes a laptop as speed ram hdd cost. Besides,    speed, ram, hdd and cost are integers  1000 ≤ speed ≤ 4200 is the processor's speed in megahertz  256 ≤ ram ≤ 4096 the RAM volume in megabytes  1 ≤ hdd ≤ 500 is the HDD in gigabytes  100 ≤ cost ≤ 1000 is price in tugriks  All laptops have different prices.

Print a single number — the number of a laptop Vasya will choose. The laptops are numbered with positive integers from 1 to n in the order in which they are given in the input data.

NoteIn the third sample Vasya considers the first and fifth laptops outdated as all of their properties cannot match those of the third laptop. The fourth one is the cheapest among the laptops that are left. Thus, Vasya chooses the fourth laptop.

module Main where

import Control.Monad
import Data.List

main = do
    n <- read `liftM` getLine
    comps <- forM [1..n] $ \i -> do
        [a, b, c, cost] <- ( map read . words ) `liftM` getLine :: IO [Int]
        return (i, a, b, c, cost)

    let considered = filter (\(_, a, b, c, _) -> not $ any (\(_, a2, b2, c2, _) -> a < a2 && b < b2 && c < c2) comps) comps
        choose = foldl' (\best@(_, _, _, _, best_cost) this@(_, _, _, _, cost) ->
            if cost < best_cost
                then this
                else best
            ) (0, 0, 0, 0, maxBound) considered
        (chooseI, _, _, _, _) = choose

    --putStrLn $ show considered
    --putStrLn $ show choose
    putStrLn $ show chooseI

import Control.Monad
import Data.List

scaninput:: Int -> IO [[Int]]
scaninput x = forM [1..x] (\y -> do
                             xs <-(fmap ((map read).words)  getLine)
                             return (y:xs))
main::IO ()
main = do
       n <- fmap read getLine
       comps <- scaninput n
       filtered <- return $ filter (\x ->  not $ any (\y -> ((x !! 1)
                                                     < (y !! 1))                                                   && ((x !! 2) < (y !! 2))
                                    && ((x !! 3) < (y !! 3))) comps) comps
       putStrLn $ show $ head.head $ sortBy (\xs ys -> compare (xs !! 4)
                                                        (ys !! 4)) filtered

import Data.List

getLines :: Int -> IO [[Int]]
getLines 0 = return []
getLines n = do x <- getLine >>= return . map read . words; xs <- getLines (n-1); return (x:xs)

ok :: [[Int]] -> [Int] -> Bool
ok x (ya:yb:yc:_) = find (\(za:zb:zc:_) -> ya < za && yb < zb && yc < zc) x == Nothing

main = do
	n <- getLine >>= return . read :: IO Int
	spec <- getLines n
	putStrLn . show . fst $ foldl (\(a, b) (c, d) -> if b < d then (a, b) else (c, d)) (-1, 9999) [( i + 1, spec !! i !! 3) | i <- [0..n-1], ok spec (spec !! i)]

{-(c) gorlum0 [at] gmail.com-}
import qualified Data.ByteString.Char8 as BS
import Data.List
import Debug.Trace (trace)
import Data.Ord (comparing)
import Data.Maybe (fromJust)
import Text.Printf (printf)

readNum = fst . fromJust . BS.readInt
--- debug = flip trace
debug x = trace (show x) x
debug2 msg x = trace (printf "%s: %s" msg $ show x) x

splitEvery _ [] = []
splitEvery n xs = ys : splitEvery n xs'
    where (ys, xs') = splitAt n xs

older (_:xs) (_:ys) = and $ zipWith (<) xs' ys'
    where
    xs' = take 3 xs
    ys' = take 3 ys

obsolete yss xs = or [older xs ys | ys <- yss]

cost xs = last xs

solve xss = head $ minimumBy (comparing cost) xss'
    where xss' = filter (not . obsolete xss) xss

body [] = []
body (n:xs) = solve yss : body xs'
    where
    (ys', xs') = splitAt (n*4) xs
    yss = zipWith (:) [1..] $ splitEvery 4 ys'

main = do
    ws <- BS.words `fmap` BS.getContents
    let xs = map readNum ws
    mapM_ print $ body xs

type NoteBook = (Int, Int, Int, Int)

parseNoteBook :: String -> NoteBook
parseNoteBook s = (x1, x2, x3, x4)
  where
    [x1, x2, x3, x4]  =  map read (words s)

readNoteBook :: IO NoteBook
readNoteBook = getLine >>= return . parseNoteBook

oldest :: NoteBook -> NoteBook -> Bool
oldest (a1, b1, c1, _) (a2, b2, c2, _)
  =  a1 < a2 && b1 < b2 && c1 < c2

solve :: [NoteBook] -> [(Int, NoteBook)]
solve ns = solve_ 1 ns ns
  where
    solve_ :: Int -> [NoteBook] -> [NoteBook] -> [(Int, NoteBook)]
    solve_ _ [] _      =  []
    solve_ i (n:ns) allNs
      | any (oldest n) allNs  =  solveNS
      | otherwise             =  (i, n):solveNS
      where
        solveNS  =  solve_ (i+1) ns allNs

getAns :: [(Int, NoteBook)] -> Int
getAns ((num, (_, _, _, c)):ns) = fst (getAns_ (num, c) ns)
  where
    getAns_ :: (Int, Int) -> [(Int, NoteBook)] -> (Int, Int)
    getAns_ mn [] = mn
    getAns_ (numMin, cMin) ((num, (_, _, _, c)):ns)
      | cMin > c   =  getAns_ (num, c) ns
      | otherwise  =  getAns_ (numMin, cMin) ns

main  =  do
    n <- readLn::(IO Int)
    ns <- sequence (replicate n readNoteBook)
    print (getAns (solve ns))

import Control.Monad
import Data.List
import Data.Ord
main = do
  n <- readLn
  ls <- replicateM n $ liftM (map (read :: String -> Int) . words) getLine
  let ls' = filter (upToDate ls) $ zip [1..] ls
  print $ fst $ minimumBy (comparing ((!!3) . snd)) ls'
upToDate ls (_,(s0:r0:h0:_)) = all (\(s:r:h:_) -> s0 >= s ||
                                                  r0 >= r ||
                                                  h0 >= h) ls

import List

class Scan_ a where scan_ :: String -> a
instance Scan_ Char where scan_ (x:_) = x
class Scan a where scan :: String -> a
instance Scan Int where scan n = read n
instance Scan Char where scan (x:_) = x
instance Scan Float where scan f = read f
instance Scan Double where scan d = read d
instance Scan Integer where scan n = read n
instance (Scan_ a) => Scan [a] where
    scan (x:xs) = (scan_ [x]):(scan xs)
    scan [] = []
class Ans_ a where showans_ :: a -> String
instance Ans_ Char where showans_ x = [x]
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance (Ans_ a) => Ans [a] where
    showans (x:xs) = (showans_ x) ++ (showans xs)
    showans [] = []
instance (Ans a, Ans b) => Ans (a,b) where
    showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where
    showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z

scanValue :: (Scan a) => IO a
scanValue = do n <- getLine
               return (scan n)

scanPair :: (Scan a, Scan b) => IO (a, b)
scanPair = do ns <- getLine
              return (make_pair [n|n<-(words ns)])
                  where
                    make_pair (x:y:_) = (scan x,scan y)
                    make_pair _ = error "Not Pair"

scanTriple :: (Scan a, Scan b, Scan c) => IO (a, b, c)
scanTriple = do ns <- getLine
                return (maketriple [n|n<-(words ns)])
                    where
                      maketriple (x:y:z:_) = (scan x,scan y,scan z)

scanQuatro :: (Scan a, Scan b, Scan c, Scan d) => IO (a, b, c, d)
scanQuatro = do ns <- getLine
                return (makequatro [n|n<-(words ns)])
                    where
                      makequatro (x:y:z:w:_) = (scan x,scan y,scan z,scan w)

scans :: Int -> IO a -> IO [a]
scans 0 _ = return []
scans n io = do x <- io
                xs <- scans (n-1) io
                return (x:xs)

putAnsLn :: (Ans a) => a -> IO ()
putAnsLn ans = putStrLn (showans ans)

putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns (x:xs) = do putAnsLn x
                      putAnsLns xs
putAnsLns [] = return ()

putDebugLn :: (Show a) => a -> IO ()
putDebugLn ans = putStrLn (show ans)

lesser ((_,a,b,c),_) ((_,d,e,f),_) = a<d&&b<e&&c<f

isOutdated l ls = any (\x -> lesser l x) ls

deleteOutdated (x:xs) rest laptops = if isOutdated x laptops then
                                         deleteOutdated xs rest laptops
                                     else
                                         deleteOutdated xs (x:rest) laptops
deleteOutdated [] rest _ = rest

solve n laptops_ = snd (head (sort (deleteOutdated laptops [] laptops) ))
    where
      laptops = (zip laptops_ [1..n])

main = do n <- scanValue::IO Int
          laptops <- scans n (scanQuatro :: IO (Int, Int, Int ,Int))
          putAnsLn (solve n (map (\(a,b,c,d) -> (d,a,b,c)) laptops))

{-(c) gorlum0 [at] gmail.com-}
import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Ord (comparing)
import Data.Maybe (fromJust)

readNum = fst . fromJust . BS.readInt

splitEvery _ [] = []
splitEvery n xs = ys : splitEvery n xs'
    where (ys, xs') = splitAt n xs

older (_:xs) (_:ys) = or [and $ zipWith (<) xs' ys' | (xs', ys') <- zip xss yss]
    where
    -- threes
    xss = [l ++ tail r | i <- [0..3], let (l, r) = splitAt i xs]
    yss = [l ++ tail r | i <- [0..3], let (l, r) = splitAt i ys]

obsolete yss xs = or [older xs ys | ys <- yss]

cost xs = xs!!3

solve xss = head $ minimumBy (comparing cost) xss'
    where xss' = filter (not . obsolete xss) xss

body [] = []
body (n:xs) = solve yss : body xs'
    where
    (ys', xs') = splitAt (n*4) xs
    yss = zipWith (:) [1..] $ splitEvery 4 ys'

main = do
    ws <- BS.words `fmap` BS.getContents
    let xs = map readNum ws
    mapM_ print $ body xs

{-(c) gorlum0 [at] gmail.com-}
import qualified Data.ByteString.Char8 as BS
import Data.List
import Debug.Trace (trace)
import Data.Ord (comparing)
import Data.Maybe (fromJust)
import Text.Printf (printf)

readNum = fst . fromJust . BS.readInt
--- debug = flip trace
debug x = trace (show x) x
debug2 msg x = trace (printf "%s: %s" msg $ show x) x

splitEvery _ [] = []
splitEvery n xs = ys : splitEvery n xs'
    where (ys, xs') = splitAt n xs

older (_:xs) (_:ys) = and $ zipWith (<) xs' ys'
    where
    xs' = take 3 xs
    ys' = take 3 ys

obsolete yss xs = or [older xs ys | ys <- yss]

cost xs = xs!!3

solve xss = head $ minimumBy (comparing cost) xss'
    where xss' = filter (not . obsolete xss) xss

body [] = []
body (n:xs) = solve yss : body xs'
    where
    (ys', xs') = splitAt (n*4) xs
    yss = zipWith (:) [1..] $ splitEvery 4 ys'

main = do
    ws <- BS.words `fmap` BS.getContents
    let xs = map readNum ws
    mapM_ print $ body xs


You are looking at the floor plan of the Summer Informatics School's new building. You were tasked with SIS logistics, so you really care about travel time between different locations: it is important to know how long it would take to get from the lecture room to the canteen, or from the gym to the server room.The building consists of n towers, h floors each, where the towers are labeled from 1 to n, the floors are labeled from 1 to h. There is a passage between any two adjacent towers (two towers i and i + 1 for all i: 1 ≤ i ≤ n - 1) on every floor x, where a ≤ x ≤ b. It takes exactly one minute to walk between any two adjacent floors of a tower, as well as between any two adjacent towers, provided that there is a passage on that floor. It is not permitted to leave the building. The picture illustrates the first example. You have given k pairs of locations (ta, fa), (tb, fb): floor fa of tower ta and floor fb of tower tb. For each pair you need to determine the minimum walking time between these locations.

The first line of the input contains following integers:   n: the number of towers in the building (1 ≤ n ≤ 108),  h: the number of floors in each tower (1 ≤ h ≤ 108),  a and b: the lowest and highest floor where it's possible to move between adjacent towers (1 ≤ a ≤ b ≤ h),  k: total number of queries (1 ≤ k ≤ 104).  Next k lines contain description of the queries. Each description consists of four integers ta, fa, tb, fb (1 ≤ ta, tb ≤ n, 1 ≤ fa, fb ≤ h). This corresponds to a query to find the minimum travel time between fa-th floor of the ta-th tower and fb-th floor of the tb-th tower.

For each query print a single integer: the minimum walking time between the locations in minutes.

module Main where

import           Control.Monad (replicateM_)
import           Data.Functor  ((<$>))

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

dist :: Int -> Int -> Int -> Int -> Int -> Int -> Int
dist a b ta fa tb fb = horzDist + vertDist
  where
    vertDist
      | ta == tb = abs $ fa - fb
      | fa < a = a - fa + (abs $ a - fb)
      | fa > b = fa - b + (abs $ b - fb)
      | otherwise = abs $ fa - fb
    horzDist = abs $ ta - tb

main :: IO ()
main = do
  [n, h, a, b, k] <- getLineInts
  replicateM_ k $ do
    [ta, fa, tb, fb] <- getLineInts
    print $ dist a b ta fa tb fb

f :: Int -> Int -> [Int] -> Int
f a b [ta, fa, tb, fb] | (fa < a) && (fb < a) && (ta != tb) = 2 * a - fa - fb + d
                       | (fa > b) && (fb > b) && (ta != tb) = fa + fb - 2 * b + d
                       | (ta != tb)                         = abs (fa - fb) + d
                       | otherwise                          = abs (fa - fb) + d
                           where d    = abs (ta - tb)
                                 (!=) = (/=)

main = do
    [n, h, a, b, k] <- (map read.words) `fmap` getLine
    ways            <- mapM (\_ -> ((map read.words) `fmap` getLine)) [1..k]
    let ans = map (f a b) ways
    mapM_ (\x -> putStrLn . show $ x) ans

module Main where

import           Control.Monad (replicateM_)
import           Data.Functor  ((<$>))

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

dist :: Int -> Int -> Int -> Int -> Int -> Int -> Int
dist a b ta fa tb fb = horzDist + vertDist
  where
    vertDist
      | ta == tb && fa == fb = 0
      | fa < a = a - fa + (abs $ a - fb)
      | fa > b = fa - b + (abs $ b - fb)
      | otherwise = abs fa - fb
    horzDist = abs $ ta - tb

main :: IO ()
main = do
  [n, h, a, b, k] <- getLineInts
  replicateM_ k $ do
    [ta, fa, tb, fb] <- getLineInts
    print $ dist a b ta fa tb fb

module Main where

import           Control.Monad (replicateM_)
import           Data.Functor  ((<$>))

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

dist :: Int -> Int -> Int -> Int -> Int -> Int -> Int
dist a b ta fa tb fb = horzDist + vertDist
  where
    vertDist
      | ta == tb && fa == fb = 0
      | fa < a = a - fa + (abs $ a - fb)
      | fa > b = fa - b + (abs $ b - fb)
      | otherwise = abs $ fa - fb
    horzDist = abs $ ta - tb

main :: IO ()
main = do
  [n, h, a, b, k] <- getLineInts
  replicateM_ k $ do
    [ta, fa, tb, fb] <- getLineInts
    print $ dist a b ta fa tb fb

module Main where

import           Control.Monad (replicateM_)
import           Data.Functor  ((<$>))

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

dist :: Int -> Int -> Int -> Int -> Int -> Int -> Int
dist a b ta fa tb fb
  | fa < a = a - fa + horDist + (abs $ a - fb)
  | fa > b = fa - b + horDist + (abs $ b - fb)
  | otherwise = horDist + (abs $ fa - fb)
  where
    horDist = abs $ ta - tb

main :: IO ()
main = do
  [n, h, a, b, k] <- getLineInts
  replicateM_ k $ do
    [ta, fa, tb, fb] <- getLineInts
    print $ dist a b ta fa tb fb


Your math teacher gave you the following problem:There are $$$n$$$ segments on the $$$x$$$-axis, $$$[l_1; r_1], [l_2; r_2], \ldots, [l_n; r_n]$$$. The segment $$$[l; r]$$$ includes the bounds, i.e. it is a set of such $$$x$$$ that $$$l \le x \le r$$$. The length of the segment $$$[l; r]$$$ is equal to $$$r - l$$$.Two segments $$$[a; b]$$$ and $$$[c; d]$$$ have a common point (intersect) if there exists $$$x$$$ that $$$a \leq x \leq b$$$ and $$$c \leq x \leq d$$$. For example, $$$[2; 5]$$$ and $$$[3; 10]$$$ have a common point, but $$$[5; 6]$$$ and $$$[1; 4]$$$ don't have.You should add one segment, which has at least one common point with each of the given segments and as short as possible (i.e. has minimal length). The required segment can degenerate to be a point (i.e a segment with length zero). The added segment may or may not be among the given $$$n$$$ segments.In other words, you need to find a segment $$$[a; b]$$$, such that $$$[a; b]$$$ and every $$$[l_i; r_i]$$$ have a common point for each $$$i$$$, and $$$b-a$$$ is minimal.

The first line contains integer number $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 10^{5}$$$) — the number of segments. The following $$$n$$$ lines contain segment descriptions: the $$$i$$$-th of them contains two integers $$$l_i,r_i$$$ ($$$1 \le l_i \le r_i \le 10^{9}$$$). The sum of all values $$$n$$$ over all the test cases in the input doesn't exceed $$$10^5$$$.

For each test case, output one integer — the smallest possible length of the segment which has at least one common point with all given segments.

NoteIn the first test case of the example, we can choose the segment $$$[5;7]$$$ as the answer. It is the shortest segment that has at least one common point with all given segments.

import Control.Monad

main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        a <- sequence $ replicate n getList
        print $ max 0 $ f a

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

f :: [[Int]] -> Int
f [a] = 0
f xs = lmax - rmin
    where lmax = maximum $ map (\a -> a !! 0) xs
          rmin = minimum $ map (\a -> a !! 1) xs

import Control.Monad

main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        a <- sequence $ replicate n getList
        print $ f a

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

f :: [[Int]] -> Int
f [a] = 0
f xs = lmax - rmin
    where lmax = maximum $ map (\a -> a !! 0) xs
          rmin = minimum $ map (\a -> a !! 1) xs


The spring is coming and it means that a lot of fruits appear on the counters. One sunny day little boy Valera decided to go shopping. He made a list of m fruits he wanted to buy. If Valera want to buy more than one fruit of some kind, he includes it into the list several times. When he came to the fruit stall of Ashot, he saw that the seller hadn't distributed price tags to the goods, but put all price tags on the counter. Later Ashot will attach every price tag to some kind of fruits, and Valera will be able to count the total price of all fruits from his list. But Valera wants to know now what can be the smallest total price (in case of the most «lucky» for him distribution of price tags) and the largest total price (in case of the most «unlucky» for him distribution of price tags).

The first line of the input contains two integer number n and m (1 ≤ n, m ≤ 100) — the number of price tags (which is equal to the number of different kinds of fruits that Ashot sells) and the number of items in Valera's list. The second line contains n space-separated positive integer numbers. Each of them doesn't exceed 100 and stands for the price of one fruit of some kind. The following m lines contain names of the fruits from the list. Each name is a non-empty string of small Latin letters which length doesn't exceed 32. It is guaranteed that the number of distinct fruits from the list is less of equal to n. Also it is known that the seller has in stock all fruits that Valera wants to buy.

Print two numbers a and b (a ≤ b) — the minimum and the maximum possible sum which Valera may need to buy all fruits from his list.

6 5
3 5 1 6 8 1
peach
grapefruit
banana
orange
orange

import Data.List (sort, group)
import Text.Printf (printf)

main = do
	dummy <- getLine
	line <- getLine
	contents <- getContents
	uncurry (printf "%d %d\n") $ gao (map read $ words line) (lines contents)

gao x y = (gao' x1 yy, gao' x2 yy) where
	x1 = sort x
	x2 = reverse x1
	yy = reverse $ sort $ map length $ group $ sort y
	gao' x' y' = sum $ zipWith (*) x' y'

import List
import IO

readFruits :: Int -> IO [String]
readFruits 0 = return []
readFruits n = do
    r <- getLine
    rs <- readFruits (n-1)
    return (r:rs)

main = do
    s <- getLine
    let an:bn:xs = (map (read :: (String -> Int)) . words) s
    prices_ <- getLine
    let prices = (sort . map (read :: (String -> Int)) . words) prices_
    fruit_list <- readFruits bn
    let fruits   = sortBy (\a b -> length b `compare` length a) $ group $ sort fruit_list
        min_cost = zipWith (*) prices (map length fruits)
        max_cost = zipWith (*) (reverse prices) (map length fruits)
    putStr $ ( show $ sum min_cost) ++ " "
    putStrLn $ show $ sum max_cost

-- Codeforces 12C
-- Compute the maximum price and minimum price
import qualified Data.Map as Map
import Data.List

countOccurences :: [String] -> [Int]
countOccurences fruits = occurences
    where   pair = zip fruits (take (length fruits) (repeat 1))
            counter = Map.fromListWith (+) pair :: Map.Map String Int
            list = Map.toList counter :: [(String, Int)]
            occurences = map snd list

computeMax :: [Int] -> [Int] -> Int
computeMax prices occurences = sum (zipWith (*) orderedPrices orderedOccurences)
    where orderedPrices = sortBy (flip compare) prices
          orderedOccurences = sortBy (flip compare) occurences

computeMin :: [Int] -> [Int] -> Int
computeMin prices occurences = sum (zipWith (*) orderedPrices orderedOccurences)
    where orderedPrices = sort prices
          orderedOccurences = sortBy (flip compare) occurences

main :: IO ()
main = do
    input <- getLine
    let counter = read ((words input) !! 1) :: Int
    priceStr <- getLine
    let prices = map (read :: String -> Int) (words priceStr)
    objectStr <- getContents
    let objects = take counter (lines objectStr)
    let occurences = countOccurences objects
    let min = computeMin prices occurences
    let max = computeMax prices occurences
    putStrLn $ id ((show min) ++ " " ++ (show max))

import Control.Monad (liftM, replicateM)
import Data.List (sort)
import Data.Map (elems, fromListWith)

getCounts :: [String] -> [Int]
getCounts lines  =  reverse $ sort $ elems $ fromListWith (+) $ zip lines [1,1..]

solve :: [Int] -> [String] -> (Int, Int)
solve as lines  =  (sum $ zipWith (*) (sort as) $ getCounts lines,
    sum $ zipWith (*) (reverse $ sort as) $ getCounts lines)

main :: IO ()
main  =  do
    [n, m]  <-  liftM (map read . words) getLine
    xs  <-  liftM (map read . words) getLine
    lines'  <-  replicateM m getLine
    let (a, b)  =  solve xs lines'
    putStrLn $ concat [show a, " ", show b]

import qualified Data.List as L
import qualified Data.Function as F

parse :: [String] -> ([Int], [Int])
parse (_:h:foo) =
    (L.sort . map read . words $ h, L.sort . map length . L.group . L.sort $ foo)

solve :: ([Int], [Int]) -> String
solve (prices, amounts) =
    -- unwords [show prices, show amounts]
    show minimize ++ " " ++ show maximize
    where
      minimize = sum [x * y | (x, y) <- zip prices (reverse amounts)]
      maximize = sum [x * y | (x, y) <- (zip `F.on` reverse) prices amounts]

main = do
  foo <- getContents
  putStrLn . solve . parse . lines $ foo

import Data.List (sort, group)
import Text.Printf (printf)

main = do
    dummy <- getLine
    line <- getLine
    contents <- getContents
    uncurry (printf "%d %d\n") $ gao (map read $ words line) (lines contents)

gao x y = (gao' x1 yy, gao' x2 yy) where
    x1 = sort x
    x2 = reverse x1
    yy = sort $ map length $ group $ sort y
    gao' x' y' = sum $ zipWith (*) x' y'


Yaroslav has an array, consisting of (2·n - 1) integers. In a single operation Yaroslav can change the sign of exactly n elements in the array. In other words, in one operation Yaroslav can select exactly n array elements, and multiply each of them by -1.Yaroslav is now wondering: what maximum sum of array elements can be obtained if it is allowed to perform any number of described operations?Help Yaroslav.

The first line contains an integer n (2 ≤ n ≤ 100). The second line contains (2·n - 1) integers — the array elements. The array elements do not exceed 1000 in their absolute value.

In a single line print the answer to the problem — the maximum sum that Yaroslav can get.

NoteIn the first sample you do not need to change anything. The sum of elements equals 150.In the second sample you need to change the sign of the first two elements. Then we get the sum of the elements equal to 100.

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

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

solve :: Int -> [Int] -> Int
solve n as
  | odd n  =  sumAbs
  | odd (length (filter (< 0) as))  =  sumAbs - 2 * bad
  | otherwise  =  sumAbs
  where
    sumAbs  =  sum $ map abs as
    bad  =  minimum $ map abs as

main :: IO ()
main  =  do
    n  <-  readLn
    as  <-  reads
    print $ solve n as

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import Data.List

main :: IO ()
main = do
  n <- readLn
  xs <- map read.words <$> getLine
  print $ solve n xs

solve :: Int -> [Int] -> Int
solve n xs
  | elem 0 xs = sum abss
  | even $ length negs = sum abss
  | odd n = sum abss
  | otherwise = sum abss - 2 * minimum abss
   where
     negs = filter (<0) xs
     abss = map abs xs

import Data.List
import Data.Char
import Data.Maybe
import Data.Ord
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Array
import Data.Bits

main = do
  n <- readLn :: IO Int
  a <- getList
  let [neg, pos, zero] = ff a [0,0,0]
      b = sort $ map (abs) a
      k = if n `mod` 2 == 1 then 0 else (neg `mod` 2)
      a1 = take k b
      a2 = drop k b
  print $ (sum a2) - (sum a1)
  where
    ff [] acc = acc
    ff (x:xs) [neg,pos,zero]
      | x < 0 = ff xs [neg+1,pos,zero]
      | x > 0 = ff xs [neg,pos+1,zero]
      | otherwise = ff xs [neg,pos,zero+1]
    getList = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

import Data.List
import Data.Char
import Data.Maybe
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Array
import Data.Bits

main = do
  n <- readLn :: IO Int
  a <- getList
  let [neg, pos, zero] = ff a [0,0,0]
      b = sort $ map (abs) a
      k = if n `mod` 2 == 1 then 0 else (neg `mod` 2)
      a1 = take k b
      a2 = drop k b
  print $ (sum a2) - (sum a1)
  where
    ff [] acc = acc
    ff (x:xs) [neg,pos,zero]
      | x < 0 = ff xs [neg+1,pos,zero]
      | x > 0 = ff xs [neg,pos+1,zero]
      | otherwise = ff xs [neg,pos,zero+1]
    getList = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

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

main :: IO ()
main = print . solve . map (maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Int] -> Int
solve (n : xs)
  | even n && odd m = f $ sort xs
  | otherwise = sum $ map abs xs
  where
  m = length $ filter (< 0) xs
  f (x : y : xs) | x + y < 0 = f xs - x - y
  f xs = sum xs

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

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

solve :: [Int] -> Int
solve as  =  sumAbs - bad
  where
    sumAbs  =  sum $ map abs as
    bad  =  if odd $ length $ filter (<0) as then minimum $ map abs as else 0

main :: IO ()
main  =  do
    getLine
    as  <-  reads
    print $ solve as

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

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

solve :: [Int] -> Int
solve as  =  sumAbs - 2 * bad
  where
    sumAbs  =  sum $ map abs as
    bad  =  if odd $ length $ filter (<0) as then minimum $ map abs as else 0

main :: IO ()
main  =  do
    getLine
    as  <-  reads
    print $ solve as

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import Data.List

main :: IO ()
main = do
  n <- readLn
  xs <- map read.words <$> getLine
  print $ solve n xs

solve :: Int -> [Int] -> Int
solve n xs = go xs
   where
     go xs
       | sum ys < 0 = go $ map negate ys ++ zs
       | otherwise = sum xs
        where
          (ys,zs) = splitAt n $ sort xs

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import Data.List

main :: IO ()
main = do
  n <- readLn
  xs <- map read.words <$> getLine
  print $ solve n xs

solve :: Int -> [Int] -> Int
solve n xs
  | elem 0 xs = sum abss
  | even $ length negs = sum abss
  | otherwise = sum abss - 2 * minimum abss
   where
     negs = filter (<0) xs
     abss = map abs xs

import Data.List
import Data.Char
import Data.Maybe
import Data.Ord
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Array
import Data.Bits

main = do
  n <- readLn :: IO Int
  a <- getList
  let [neg, pos, zero] = ff a [0,0,0]
      b = sortBy (\x y -> abs(x) `compare` abs(y)) a
      k = if n `mod` 2 == 1 then 0 else (neg `mod` 2)
      a1 = take k b
      a2 = drop k b
  print $ (sum a2) - (sum a1)
  where
    ff [] acc = acc
    ff (x:xs) [neg,pos,zero]
      | x < 0 = ff xs [neg+1,pos,zero]
      | x > 0 = ff xs [neg,pos+1,zero]
      | otherwise = ff xs [neg,pos,zero+1]
    getList = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

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

main :: IO ()
main = print . solve . map (maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Int] -> Int
solve (n : xs) = f $ sort xs
  where
  f (x : y : xs) | x + y < 0 = f xs - x - y
  f xs = sum xs

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

main :: IO ()
main = print . solve . map (maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Int] -> Int
solve (n : xs)
  | sa >= 0 = sa + sb
  | otherwise = solve (n : map negate as ++ bs)
  where
  (as, bs) = splitAt n $ sort xs
  sa = sum as
  sb = sum bs


In Berland, $$$n$$$ different types of banknotes are used. Banknotes of the $$$i$$$-th type have denomination $$$10^{a_i}$$$ burles (burles are the currency used in Berland); the denomination of banknotes of the first type is exactly $$$1$$$.Let's denote $$$f(s)$$$ as the minimum number of banknotes required to represent exactly $$$s$$$ burles. For example, if the denominations of banknotes used in Berland are $$$1$$$, $$$10$$$ and $$$100$$$, then $$$f(59) = 14$$$: $$$9$$$ banknotes with denomination of $$$1$$$ burle and $$$5$$$ banknotes with denomination of $$$10$$$ burles can be used to represent exactly $$$9 \cdot 1 + 5 \cdot 10 = 59$$$ burles, and there's no way to do it with fewer banknotes.For a given integer $$$k$$$, find the minimum positive number of burles $$$s$$$ that cannot be represented with $$$k$$$ or fewer banknotes (that is, $$$f(s) > k$$$).

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 10; 1 \le k \le 10^9$$$). The next line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 = a_1 < a_2 < \dots < a_n \le 9$$$).

For each test case, print one integer — the minimum positive number of burles $$$s$$$ that cannot be represented with $$$k$$$ or fewer banknotes.

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Control.Monad as CM
import qualified Data.List as DL
import Data.Bits
import System.IO

recurse k (d:ds) es
  | k < d = (k+1):es
  | otherwise = recurse (k-d) ds (d:es)

solve :: IO ()
solve = do
  ~[n,k] <- readv :: IO [Int]
  as <- readv
  let
    ds = zipWith (\x y->10^(y-x)-1) as (tail as) ++ [k+1]
    nums = recurse k ds []
  putStrLn $ DL.intercalate "" (show <$> nums)

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

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

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Control.Monad as CM
import qualified Data.List as DL
import Data.Bits
import System.IO

recurse k (d:ds) es
  | k < d = (k+1):es
  | otherwise = recurse (k-d) ds (d:es)

solve :: IO ()
solve = do
  ~[n,k] <- readv :: IO [Integer]
  as <- readv
  let
    ds = zipWith (\x y->10^(y-x)-1) as (tail as) ++ [k+1]
    nums = recurse k ds []
  putStrLn $ DL.intercalate "" (show <$> nums)

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

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

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Control.Monad as CM
import qualified Data.List as DL
import Data.Bits
import System.IO

recurse es (d:ds) k
  | k < d = (k+1):es
  | otherwise = recurse (d:es) ds (k-d)

solve :: IO ()
solve = do
  ~[n,k] <- readv :: IO [Integer]
  as <- readv
  let
    ds = zipWith (\x y->10^(y-x)-1) as (tail as) ++ [k+2]
    nums = recurse [] ds k
  putStrLn $ DL.intercalate "" (show <$> nums)

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

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

{-# LANGUAGE BangPatterns #-}
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

prefMins :: Ord t => (a -> t) -> [a] -> [t]
prefMins f li = tail $ scanl' min (f $ head li) $ map f li

sqr x = x*x

pow x n | (n==0) = 1
        | ((mod n 2) == 0) = sqr $ pow x $ div n 2
        | otherwise = x * (pow x (n-1))

gao (a, k) | k == 0 = 0
           | (length a) == 1 = ((pow 10 (head a)) * k)
           | otherwise = ((gao ((tail a), (k - d))) + ((pow 10 (head a)) * d)) where d = (min (k) ((pow 10 ((a !! 1) - (head a))) - 1))

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, k] <- getInts 2
    a <- getInts n
    pure $ putInts [gao (a, k+1)]

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

calc :: Int64 -> Int64 -> [Int64] -> Int64
calc n k pows =
  let lst = map ((flip (-) $ 1) . (10^) . uncurry (-)) $ zip (tail pows) pows
      all = lst ++ [10^10]
      cnts = tail $ map fst $ scanl (\(cnt,k) a ->
                      let newCnt = min k a
                          newK = k - newCnt
                      in
                        (newCnt, newK)) (k,k) all
  in
    foldl (\acc (a,cnt) -> acc + (10^a) * cnt) 0 $ zip pows cnts

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [n,k] = map read $ words line :: [Int64]
    line <- getLine
    let pows = map read $ words line :: [Int64]
    print $ calc n (k+1) pows