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

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

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

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

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


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 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.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 (<=)


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

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


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

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


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

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'


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

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

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


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

{-# 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 ScopedTypeVariables #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.ST
import Data.Function
import Data.Int
import Data.List
import qualified Data.IntMap as M

-- Using Um_nik's neat approach in O(s log s), s = sum of lengths of the strings

type IntArray = Array Int Int

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- replicateM n getLine
    let sa = reverse $ sort $ map (\x -> (sort x, x)) a
        gs = map snd <$> groupBy ((==) `on` fst) sa
        n64 = fromIntegral n
    print $ 1337 * n64 * (n64 - 1) `div` 2 - sum (map calcSaved gs)

calcSaved :: [String] -> Int64
calcSaved g = saved where
    n = length g
    m = length $ head g
    getLcp s1 s2 = length $ takeWhile id $ zipWith (==) s1 s2
    getNotSorted s = listArray (0, length a - 1) a :: IntArray where
        a = map (+1) (elemIndices True $ zipWith (<) (tail s) s) ++ [m]
    lookup = mkLookup n m g
    calc :: Int -> String -> String -> [(Int, Int)] -> (Int64, [(Int, Int)])
    calc i curs prvs st = (total, st') where
        ns = getNotSorted curs
        st' = (lcp, i - 1) : dropWhile ((>= lcp) . fst) st where lcp = getLcp curs prvs
        calcSt :: (Int, Int) -> (Int, Int) -> Int64
        calcSt (lcp, curi) (_, prvi) = fromIntegral cnt where
            nxt = ns ! binSearchA (> lcp) ns
            ar = lookup!(i, nxt)
            cnt = binSearchA (> curi) ar - binSearchA (> prvi) ar
        total = foldl' f 0 $ zip st' (tail st') where f acc (cur, last) = acc + calcSt cur last
    total = fst $ foldl' f (0, [(-1, -1)]) $ zip3 [1..] (tail g) g where
        f (acc, st) (i, curs, prvs) = (acc + acc', st') where (acc', st') = calc i curs prvs st
    saved = one * 1336 + two * 1335 where
        one = total
        n64 = fromIntegral n
        two = n64 * (n64 - 1) `div` 2 - one

data Trie = Node (M.IntMap Trie) [Int]

emptyT :: Trie
emptyT = Node M.empty []

insertT :: Int -> String -> Trie -> Trie
insertT i [] (Node m is) = Node m (i:is)
insertT i (x:xs) (Node m is) = Node m' (i:is) where
    m' = M.insert o (insertT i xs $ M.findWithDefault emptyT o m) m
    o = fromEnum x

mkLookup :: Int -> Int -> [String] -> Array (Int, Int) IntArray
mkLookup n m g = runSTArray $ do
    a :: STArray s (Int, Int) IntArray <- newArray ((0, 0), (n - 1, m)) undefined
    let go :: Int -> Trie -> ST s ()
        go d (Node m is) = do
            let isa = listArray (0, length is - 1) is
            forM_ is $ \i -> writeArray a (i, d) isa
            forM_ (M.elems m) $ go (d - 1)
    go m $ foldr (uncurry insertT) emptyT $ zip [0..] $ map reverse g
    return a

binSearch :: (Integral i) => (i -> Bool) -> i -> i -> i
binSearch f l h
    | l >= h    = l
    | f m       = binSearch f l m
    | otherwise = binSearch f (m + 1) h
    where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l (r + 1) where (l, r) = bounds a

main :: IO ()
main = solve

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.ST
import Data.Function
import Data.Int
import Data.List
import qualified Data.IntMap as M

-- Using Um_nik's neat approach in O(s log s), s = sum of lengths of the strings

type IntArray = Array Int Int

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- replicateM n getLine
    let sa = reverse $ sort $ map (\x -> (sort x, x)) a
        gs = map snd <$> groupBy ((==) `on` fst) sa
        n64 = fromIntegral n
    print $ 1337 * (n64 * (n64 - 1) `div` 2) - sum (map calcSaved gs)

calcSaved :: [String] -> Int64
calcSaved g = saved where
    n = length g
    m = length $ head g
    getLcp s1 s2 = length $ takeWhile id $ zipWith (==) s1 s2
    lookup = mkLookup n m g
    calc :: Int -> String -> String -> [(Int, Int)] -> (Int64, [(Int, Int)])
    calc i curs prvs st = (total, st') where
        gt = map (+1) $ elemIndices True $ zipWith (<) (tail curs) curs
        gtn = length gt
        gta = listArray (0, gtn - 1) gt :: IntArray
        st' = (lcp, i - 1) : dropWhile ((>= lcp) . fst) st where lcp = getLcp curs prvs
        calcSt :: (Int, Int) -> (Int, Int) -> Int64
        calcSt (l, curi) (_, prvi) = fromIntegral cnt where
            ar = lookup!(i, nxt) where
                j = binSearchA (> l) gta
                nxt = if j < gtn then gta!j else m
            cnt = binSearchA (> curi) ar - binSearchA (> prvi) ar
        total = foldl' f 0 $ zip st' (tail st') where f acc (cur, last) = acc + calcSt cur last
    total = fst $ foldl' f (0, [(-1, -1)]) $ zip3 [1..] (tail g) g where
        f (acc, st) (i, curs, prvs) = (acc + acc', st') where (acc', st') = calc i curs prvs st
    saved = one * 1336 + two * 1335 where
        one = total
        n64 = fromIntegral n
        two = (n64 * (n64 - 1) `div` 2) - one

data Trie = Node (M.IntMap Trie) [Int]

emptyT :: Trie
emptyT = Node M.empty []

insertT :: Int -> String -> Trie -> Trie
insertT i [] (Node m is) = Node m (i:is)
insertT i (x:xs) (Node m is) = Node m' (i:is) where
    m' = M.insert tx (insertT i xs $ M.findWithDefault emptyT tx m) m
    tx = fromEnum x - 97

mkLookup :: Int -> Int -> [String] -> Array (Int, Int) IntArray
mkLookup n m g = runSTArray $ r trie where
    trie = foldr f emptyT $ zip [0..] $ map reverse g where f (i, xs) t = insertT i xs t
    r t = do
        a :: STArray s (Int, Int) IntArray <- newArray ((0, 0), (n - 1, m)) undefined
        let go :: Int -> Trie -> ST s ()
            go d (Node m is) = do
                forM_ is $ \i -> writeArray a (i, d) $ listArray (0, length is - 1) is
                forM_ (M.elems m) $ go (d - 1)
        go m t
        return a

binSearch :: (Integral i) => (i -> Bool) -> i -> i -> i
binSearch f l h
    | l >= h    = l
    | f m       = binSearch f l m
    | otherwise = binSearch f (m + 1) h
    where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l (r + 1) where (l, r) = bounds a

main :: IO ()
main = solve