DZY has a sequence a, consisting of n integers.We'll call a sequence ai, ai + 1, ..., aj (1 ≤ i ≤ j ≤ n) a subsegment of the sequence a. The value (j - i + 1) denotes the length of the subsegment.Your task is to find the longest subsegment of a, such that it is possible to change at most one number (change one number to any integer you want) from the subsegment to make the subsegment strictly increasing.You only need to output the length of the subsegment you find.

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

In a single line print the answer to the problem — the maximum length of the required subsegment.

NoteYou can choose subsegment a2, a3, a4, a5, a6 and change its 3rd element (that is a4) to 4.

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

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  show `fmap` solve n `fmap` replicateM n poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve 1 _ = 1
solve 2 _ = 2
solve n xs = min n $ max (maximum $ map (+1) es) (maximum (zipWith4 (\e x y s -> if y > x + 1 then e + s + 1 else 0) es xs (drop 2 xs) (drop 2 ss)))
  where
    es = scanl (\l (a, b) -> if a < b then l + 1 else 1) (1 :: Int) $ zip xs (tail xs :: [Int])
    ss = concatMap reverse $ groupBy (<) es

{-
_ 7 1 2 3

<= 1
a[i] < a[i + 2]
[1,1,2,1,2,3]
[1,2,1,3,2,1]
-}

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  as <- getInts :: IO [Int]

  let
    xs = scanl (\v (a, b) -> if a < b then v + 1 else 1) 1 $ zip as $ tail as
    ys = scanr (\(a, b) v -> if a < b then v + 1 else 1) 1 $ zip as $ tail as

  print $ maximum $ zipWith3 (\a b f -> if f then a + 1 + b else max (a+1) (b+1)) (0:xs) (tail ys ++ [0]) (zipWith (\a b -> a + 1 < b) (0:as) (tail as ++ [2*10^9]))

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  as <- getInts :: IO [Int]

  let
    xs = scanl (\v (a, b) -> if a < b then v + 1 else 1) 1 $ zip as $ tail as
    ys = scanr (\(a, b) v -> if a < b then v + 1 else 1) 1 $ zip as $ tail as

  print $ maximum $ zipWith3 (\a b f -> if f then a + 1 + b else max (a+1) (b+1)) (0:xs) (tail ys ++ [0]) (zipWith (\a b -> a + 1 < b) (0:as) (tail as ++ [2*10^9]))

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

spl (x:y:z)
  | x < y = let (a:as) = spl (y:z) in (x:a):as
  | otherwise = [x] : spl (y:z)
spl [x] = [[x]]
spl [] = []

main :: IO ()
main = do
  _ <- getLine
  ns <- spl <$> getInts
  -- print ns

  let ans = foldl' max 0 $ map length ns ++ zipWith f ns (tail ns)

      f [_] ys = length ys + 1
      f xs [_] = length xs + 1
      f xs ys@(y1:y2:_)
        | y2 - last xs >= 2 = length xs + length ys
        | y1 - last (init xs) >= 2 = length xs + length ys
        | otherwise = max (length xs) (length ys) + 1

  print ans

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Sequence ((<|),(|>),(><),ViewL(..),ViewR(..))
import qualified Data.Sequence as Seq
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  getLine
  xs <- map readInt.B.words <$> B.getLine
  print $ solve xs

solve :: [Int] -> Int
solve xs = go 0 $ splitBy (>=) xs
   where
     go !res (xs:[y]:xss) = go (max res $ length xs + 1) ([y]:xss)
     go !res ([x]:ys:xss) = go (max res $ length ys + 1) (ys:xss)
     go !res (xs:(y:y':ys):xss) = case reverse xs of
        (x:x':xs') | x' + 1 < y || x + 1 < y' -> go (max res $ length xs + length ys + 2) ((y:y':ys):xss)
                   | otherwise -> go (max res $ length xs `max` (length ys + 2) + 1) ((y:y':ys):xss)
     go !res [xs] = max res $ length xs

splitBy :: (a -> a -> Bool) -> [a] -> [[a]]
splitBy p xs = foldr f [] xs
   where
     f x (yys@(y:_):yss)
       | p x y = [x]:yys:yss
       | otherwise = (x:yys):yss
     f x [] = [[x]]

readInt x = read x :: Int
main = interact $ show . solve' . map readInt . words

solve' (_:xs) = if length xs < 3 then length xs else solve xs
solve xs =
	maximum $ zipWith f ([(0,0)] ++ init ls) (tail rs ++ [(0,0)])
	where
		ls = incLengths xs
		rs = map (\x -> (-fst x,snd x)) (reverse $ incLengths $ map negate $ reverse xs)
		f a b = if (fst a + 2 <= fst b) then (1 + snd a + snd b) else (1 + max (snd a) (snd b))

incLengths (x:xs) = scanl f (x,1) xs
	where f a x = if fst a < x then (x,snd a+1) else (x,1)

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

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

getnums :: Num a => IO [a]
getnums = map (fromIntegral . fst) . mapMaybe BS.readInteger . BS.words <$> BS.getLine

getstr = getLine

solveCont :: Int -> [Int] -> Int -> [Int]
solveCont _ [] _ = []
solveCont prev (a:as) pvc
  | prev < a = (pvc + 1) : (solveCont a as (pvc + 1))
  | otherwise = 1 : (solveCont a as 1)

solveCont' :: Int -> [Int] -> Int -> [Int]
solveCont' _ [] _ = []
solveCont' prev (a:as) pvc
  | prev > a = (pvc + 1) : (solveCont' a as (pvc + 1))
  | otherwise = 1 : (solveCont' a as 1)

solve (f1:f2:f3:fs) (b1:b2:b3:bs) (a1:a2:a3:as)
  | a3 - a1 >= 2 = max (f1 + b3 + 1) nxt
  | otherwise = maximum [f1 + 1, f2, b3 + 1, b2, nxt]
  where nxt = solve (f2:f3:fs) (b2:b3:bs) (a2:a3:as)
solve (f1:f2:fs) (b1:b2:bs) (a1:a2:as) =
  maximum [f1 + 1, f2, b2 + 1, b1]

solve2 (f1:f2:fs) (b1:b2:bs) =
  maximum [f1 + 1, f2, b1, b2 + 1]

main = do
  n <- getint
  as <- getints
  if n == 1
    then do putStrLn "1"
    else do let fwdLen = solveCont (-1) as 0
                bckLen = reverse $ solveCont' (1000000001) (reverse as) 0
            putStrLn (show (max (solve fwdLen bckLen as) (solve2 fwdLen bckLen)))

maxTo = scanl (\(c,n) x-> if x > n then (c+1, x) else (1, x)) (0,-1)
maxFrom = reverse . scanl (\(c,n) x-> if x < n then (c+1, x) else (1, x)) (0,10^9+5) . reverse
s(_:l)=maximum$zipWith f mxt (tail mxf) where
  mxt = maxTo l
  mxf = maxFrom l
  f (c1,a) (c2,b) | a < b-1 = c1+c2+1
    | otherwise = max (c1+1) (c2+1)
main=interact$show.s.map read.words

import Data.Maybe
import Data.List
import Data.Function
import qualified Data.IntSet as IS
import Text.Printf (printf)

subseqs :: [Int] -> [[Int]]
subseqs [] = []
subseqs (x : xs) = go [x] xs
  where
    go acc [] = [reverse acc]
    go acc (x : xs)
      | head acc < x = go (x : acc) xs
      | otherwise    = (reverse acc) : go [x] xs

solve :: [Int] -> Int
solve as = go 0 (map (\s -> (s, reverse s, length s)) $ subseqs as)
  where
    spans _ [] = []
    spans p xs =
      case span p xs of
        ([], []) -> []
        ([], (x : xs')) -> [x] : spans p xs'
        (s, xs')  -> s : spans p xs'

    go best [] = best
    go best [(_, _, l)] = max best l
    go best ((s, z, l) : (x@(s', _, l')) : xs) =
      go (maximum [best,
                   case z of
                     (_ : t : _) | t + 1 < head s' -> l + l'
                     _ -> l' + 1,
                   case s' of
                     (_ : h : _) | head z + 1 < h -> l + l'
                     _ -> l + 1]) (x : xs)

main :: IO ()
main = do
  _ <- getLine
  as <- fmap (map read . words) getLine
  print $ solve as

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

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  show `fmap` solve `fmap` replicateM n poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve xs = max (maximum es) (maximum (zipWith4 (\e x y s -> if y > x + 1 then e + s + 1 else 0) (1:es) (minBound:xs) (tail xs) (tail ss)))
  where
    es = scanl (\l (a, b) -> if a < b then l + 1 else 1) (1 :: Int) $ zip xs (tail xs :: [Int])
    ss = concatMap reverse $ groupBy (<) es

{-
_ 7 1 2 3

<= 1
a[i] < a[i + 2]
[1,1,2,1,2,3]
[1,2,1,3,2,1]
-}

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

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  show `fmap` solve `fmap` replicateM n poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve [_] = 1
solve [_, _] = 2
solve xs = max (maximum $ head ss:map (+1) (tail ss)) (maximum (zipWith4 (\e x y s -> if y > x + 1 then e + s + 1 else 0) es xs (drop 2 xs) (drop 2 ss)))
  where
    es = scanl (\l (a, b) -> if a < b then l + 1 else 1) (1 :: Int) $ zip xs (tail xs :: [Int])
    ss = concatMap reverse $ groupBy (<) es

{-
_ 7 1 2 3

<= 1
a[i] < a[i + 2]
[1,1,2,1,2,3]
[1,2,1,3,2,1]
-}

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  as <- getInts :: IO [Int]

  let
    xs = scanl (\v (a, b) -> if a <= b then v + 1 else 1) 1 $ zip as $ tail as
    ys = scanr (\(a, b) v -> if a <= b then v + 1 else 1) 1 $ zip as $ tail as

  print $ maximum $ zipWith3 (\a b f -> if f then a + 1 + b else max (a+1) (b+1)) (0:xs) (tail ys ++ [0]) (zipWith (<=) (0:as) (tail as ++ [2*10^9]))

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

getInts = fmap (map read . words) getLine
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  as <- getInts :: IO [Int]

  let
    xs = scanl (\v (a, b) -> if a <= b then v + 1 else 1) 1 $ zip as $ tail as
    ys = scanr (\(a, b) v -> if a <= b then v + 1 else 1) 1 $ zip as $ tail as

  print $ maximum $ zipWith (\a b -> a + 1 + b) (0:xs) (tail ys ++ [0])

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  _ <- getLine
  ns <- getInts
  let ss = groupBy (<) ns
      ans = foldl' max 0 $ map length ss ++ zipWith f ss (tail ss)
      f xs ys
        | length ys == 1 = length xs + 1
        | length xs == 1 = length ys + 1
        | (ys !! 1) - last xs >= 2 = length xs + length ys
        | otherwise = max (length xs) (length ys) + 1
  print ans

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  _ <- getLine
  ns <- getInts
  let ss = map length $ groupBy (<) ns
      ans = foldl' max 0 $ ss ++ zipWith (+) ss (tail ss)
  print ans

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  _ <- getLine
  ns <- getInts
  let ss = map length $ groupBy (<) ns
      ans = foldl' max 0 $ zipWith (+) ss (tail ss)
  print ans

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  _ <- getLine
  ns <- groupBy (<) <$> getInts

  let ans = foldl' max 0 $ map length ns ++ zipWith f ns (tail ns)

      f [_] ys = length ys + 1
      f xs [_] = length xs + 1
      f xs ys@(_:y2:_)
        | y2 - head xs >= 2 = length xs + length ys
        | otherwise = max (length xs) (length ys) + 1

  print ans

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  _ <- getLine
  ns <- groupBy (<) <$> getInts

  let ans = foldl' max 0 $ map length ns ++ zipWith f ns (tail ns)

      f [_] ys = length ys + 1
      f xs [_] = length xs + 1
      f xs ys@(_:y2:_)
        | y2 - last xs >= 2 = length xs + length ys
        | otherwise = max (length xs) (length ys) + 1

  print ans

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  _ <- getLine
  ns <- groupBy (<) <$> getInts

  let ans = foldl' max 0 $ map length ns ++ zipWith f ns (tail ns)

      f [_] ys = length ys + 1
      f xs [_] = length xs + 1
      f xs ys@(y1:y2:_)
        | y2 - last xs >= 2 = length xs + length ys
        | y1 - last (init xs) >= 2 = length xs + length ys
        | otherwise = max (length xs) (length ys) + 1

  print ans

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Sequence ((<|),(|>),(><),ViewL(..),ViewR(..))
import qualified Data.Sequence as Seq
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  getLine
  xs <- map readInt.B.words <$> B.getLine
  print $ solve xs

solve :: [Int] -> Int
solve xs = go 0 $ splitBy (>=) xs
   where
     go !res (xs:[y]:xss) = go (max res $ length xs + 1) ([y]:xss)
     go !res ([x]:ys:xss) = go (max res $ length ys + 1) (ys:xss)
     go !res (xs:(y:y':ys):xss) = case reverse xs of
        (x:x':xs') | x' + 1 < y || x + 1 < y' -> go (max res $ length xs + length ys + 2) ((y:y':ys):xss)
                   | otherwise -> go (max res $ length xs `max` (length ys + 2 ) + 1) ([y]:xss)
     go !res [xs] = max res $ length xs

splitBy :: (a -> a -> Bool) -> [a] -> [[a]]
splitBy p xs = foldr f [] xs
   where
     f x (yys@(y:_):yss)
       | p x y = [x]:yys:yss
       | otherwise = (x:yys):yss
     f x [] = [[x]]

main=interact$show.f.map read.words
f(p:n:xs)=go [] 1 xs
   where
     go used i (x:xs)
       | h <- mod x p, elem h used = i
       | otherwise = go (mod x p:used) (i+1) xs
     go _ _ _ = -1

readInt x = read x :: Int
main = interact $ show . solve' . map readInt . words

solve' (_:xs) = if length xs < 3 then length xs else solve xs
solve xs =
	maximum $ zipWith f (init $ init ls) (tail $ tail rs)
	where
		ls = incLengths xs
		rs = map (\x -> (-fst x,snd x)) (reverse $ incLengths $ map negate $ reverse xs)
		f a b = if (fst a + 2 <= fst b) then (1 + snd a + snd b) else 2

incLengths (x:xs) = scanl f (x,1) xs
	where f a x = if fst a < x then (x,snd a+1) else (x,1)

readInt x = read x :: Int
main = interact $ show . solve' . map readInt . words

solve' (_:xs) = if length xs < 3 then length xs else solve xs
solve xs =
	maximum $ zipWith f ([(0,0)] ++ init ls) (tail rs ++ [(0,0)])
	where
		ls = incLengths xs
		rs = map (\x -> (-fst x,snd x)) (reverse $ incLengths $ map negate $ reverse xs)
		f a b = if (fst a + 2 <= fst b) then (1 + snd a + snd b) else 2

incLengths (x:xs) = scanl f (x,1) xs
	where f a x = if fst a < x then (x,snd a+1) else (x,1)

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

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

getnums :: Num a => IO [a]
getnums = map (fromIntegral . fst) . mapMaybe BS.readInteger . BS.words <$> BS.getLine

getstr = getLine

solveCont :: Int -> [Int] -> Int -> [Int]
solveCont _ [] _ = []
solveCont prev (a:as) pvc
  | prev < a = (pvc + 1) : (solveCont a as (pvc + 1))
  | otherwise = 1 : (solveCont a as 1)

solveCont' :: Int -> [Int] -> Int -> [Int]
solveCont' _ [] _ = []
solveCont' prev (a:as) pvc
  | prev > a = (pvc + 1) : (solveCont' a as (pvc + 1))
  | otherwise = 1 : (solveCont' a as 1)

solve (f1:f2:f3:fs) (b1:b2:b3:bs) (a1:a2:a3:as)
  | a3 - a1 >= 2 = max (f1 + b3 + 1) nxt
  | otherwise = maximum [f1 + 1, f2, b3 + 1, b2, nxt]
  where nxt = solve (f2:f3:fs) (b2:b3:bs) (a2:a3:as)
solve (f1:f2:fs) (b1:b2:bs) (a1:a2:as) =
  maximum [f1 + 1, f2, b2 + 1, b1]

main = do
  n <- getint
  as <- getints
  if n == 1
    then do putStrLn "1"
    else do let fwdLen = solveCont (-1) as 0
                bckLen = reverse $ solveCont' (1000000001) (reverse as) 0
            putStrLn (show (solve fwdLen bckLen as))

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

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

getnums :: Num a => IO [a]
getnums = map (fromIntegral . fst) . mapMaybe BS.readInteger . BS.words <$> BS.getLine

getstr = getLine

solveCont :: Int -> [Int] -> Int -> [Int]
solveCont _ [] _ = []
solveCont prev (a:as) pvc
  | prev < a = (pvc + 1) : (solveCont a as (pvc + 1))
  | otherwise = 1 : (solveCont a as 1)

solveCont' :: Int -> [Int] -> Int -> [Int]
solveCont' _ [] _ = []
solveCont' prev (a:as) pvc
  | prev > a = (pvc + 1) : (solveCont' a as (pvc + 1))
  | otherwise = 1 : (solveCont' a as 1)

solve (f1:f2:f3:fs) (b1:b2:b3:bs) (a1:a2:a3:as)
  | a3 - a1 >= 2 = max (f1 + b3 + 1) nxt
  | otherwise = maximum [f1 + 1, f2, b3 + 1, b2, nxt]
  where nxt = solve (f2:f3:fs) (b2:b3:bs) (a2:a3:as)
solve (f1:f2:fs) (b1:b2:bs) (a1:a2:as) =
  maximum [f1 + 1, f2, b2 + 1, b1]

solve2 (f1:f2:fs) (b1:b2:bs) =
  maximum [f1, f2 + 1, b1, b2 + 1]

main = do
  n <- getint
  as <- getints
  if n == 1
    then do putStrLn "1"
    else do let fwdLen = solveCont (-1) as 0
                bckLen = reverse $ solveCont' (1000000001) (reverse as) 0
            putStrLn (show (max (solve fwdLen bckLen as) (solve2 fwdLen bckLen)))

maxTo = scanl (\(c,n) x-> if x > n then (c+1, x) else (1, x)) (0,-1)
maxFrom = reverse . scanl (\(c,n) x-> if x < n then (c+1, x) else (1, x)) (0,10^9+5) . reverse
s(_:l)=maximum$zipWith f mxt (tail mxf) where
  mxt = maxTo l
  mxf = maxFrom l
  f (c1,a) (c2,b) | a < b-1 = c1+c2+1
    | otherwise = 1
main=interact$show.s.map read.words


Alice and Bob are playing a game on a matrix, consisting of $$$2$$$ rows and $$$m$$$ columns. The cell in the $$$i$$$-th row in the $$$j$$$-th column contains $$$a_{i, j}$$$ coins in it.Initially, both Alice and Bob are standing in a cell $$$(1, 1)$$$. They are going to perform a sequence of moves to reach a cell $$$(2, m)$$$.The possible moves are:   Move right — from some cell $$$(x, y)$$$ to $$$(x, y + 1)$$$;  Move down — from some cell $$$(x, y)$$$ to $$$(x + 1, y)$$$. First, Alice makes all her moves until she reaches $$$(2, m)$$$. She collects the coins in all cells she visit (including the starting cell).When Alice finishes, Bob starts his journey. He also performs the moves to reach $$$(2, m)$$$ and collects the coins in all cells that he visited, but Alice didn't.The score of the game is the total number of coins Bob collects.Alice wants to minimize the score. Bob wants to maximize the score. What will the score of the game be if both players play optimally?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. Then the descriptions of $$$t$$$ testcases follow. The first line of the testcase contains a single integer $$$m$$$ ($$$1 \le m \le 10^5$$$) — the number of columns of the matrix. The $$$i$$$-th of the next $$$2$$$ lines contain $$$m$$$ integers $$$a_{i,1}, a_{i,2}, \dots, a_{i,m}$$$ ($$$1 \le a_{i,j} \le 10^4$$$) — the number of coins in the cell in the $$$i$$$-th row in the $$$j$$$-th column of the matrix. The sum of $$$m$$$ over all testcases doesn't exceed $$$10^5$$$.

For each testcase print a single integer — the score of the game if both players play optimally.

NoteThe paths for the testcases are shown on the following pictures. Alice's path is depicted in red and Bob's path is depicted in blue.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}

module Main where

import Control.Monad
import Data.Bifunctor
import Data.Functor
import Data.List
import Data.Ord
import Debug.Trace

readNumbers :: (Integral b, Read b) => IO [b]
readNumbers = fmap read . words <$> getLine

{-# WARNING todo "'todo' remains in code" #-}
{-# INLINEABLE todo #-}
todo :: a
todo = error "Not implemented"

main :: IO [()]
main = do
  [t] <- readNumbers
  replicateM t $ do
    [m] <- readNumbers
    a1s <- readNumbers
    a2s <- readNumbers
    print $ minimum $ zip (init $ scanl (+) 0 a2s) (tail $ scanr (+) 0 a1s) <&> uncurry max

-- max (sum (take i a2s)) (sum (drop (i + 1) a1s))

import Control.Monad
import Data.List
readInts = fmap (map read.words) getLine :: IO [Integer]

printResult = do
    m <- readLn :: IO Integer
    a <- readInts
    b <- readInts
    let
        c = scanl (+) 0 $ reverse $ tail a
        d = reverse $ scanl (+) 0 $ init b
        z = zipWith max c d
        r = minimum z
    print r

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

{-# LANGUAGE Strict #-}
{-# LANGUAGE LambdaCase #-}
import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)
import Debug.Trace (trace)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = do
  m <- int
  as <- m >< int
  bs <- m >< int
  return . show $ solve as bs

solve :: [Int] -> [Int] -> Int
solve [_] _ = 0
solve as bs = minimum $ zipWith max (tail $ scanr (+) 0 as) (scanl (+) 0 bs)

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

import Control.Monad
import Data.Array

solve :: IO ()
solve = do
    m <- readLn :: IO Int
    a0 <- readMany :: IO [Int]
    a1 <- readMany :: IO [Int]
    let s0 = listArray (0, m) $ scanl (+) 0 a0
        s1 = listArray (0, m) $ scanl (+) 0 a1
        f i = max (s0!m - s0!i) (s1!(i - 1))
    print $ minimum $ map f [1..m]

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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


You and your friends live in $$$n$$$ houses. Each house is located on a 2D plane, in a point with integer coordinates. There might be different houses located in the same point. The mayor of the city is asking you for places for the building of the Eastern exhibition. You have to find the number of places (points with integer coordinates), so that the summary distance from all the houses to the exhibition is minimal. The exhibition can be built in the same point as some house. The distance between two points $$$(x_1, y_1)$$$ and $$$(x_2, y_2)$$$ is $$$|x_1 - x_2| + |y_1 - y_2|$$$, where $$$|x|$$$ is the absolute value of $$$x$$$.

First line contains a single integer $$$t$$$ $$$(1 \leq t \leq 1000)$$$ — the number of test cases. The first line of each test case contains a single integer $$$n$$$ $$$(1 \leq n \leq 1000)$$$. Next $$$n$$$ lines describe the positions of the houses $$$(x_i, y_i)$$$ $$$(0 \leq x_i, y_i \leq 10^9)$$$. It's guaranteed that the sum of all $$$n$$$ does not exceed $$$1000$$$.

For each test case output a single integer - the number of different positions for the exhibition. The exhibition can be built in the same point as some house.

NoteHere are the images for the example test cases. Blue dots stand for the houses, green — possible positions for the exhibition.First test case.Second test case. Third test case. Fourth test case. Fifth test case. Sixth test case. Here both houses are located at $$$(0, 0)$$$.

import Control.Monad
import Data.List

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

readInts :: IO [Integer]
readInts = readArray

readInt :: IO Integer
readInt = readLn

medlength :: [Integer] -> Integer
medlength l = if length l `mod` 2 == 1 then 1 else
    case drop (length l `div` 2 - 1) ls of
        x:y:xs -> y - x + 1
    where ls = sort l

solve :: ([Integer], [Integer]) -> Integer
solve (a, b) = medlength a * medlength b

readPair :: IO (Integer, Integer)
readPair = do
    x:y:[] <- readInts
    return (x, y)

reassoc :: [(a, b)] -> ([a], [b])
reassoc = foldl (\(xs, ys) (x, y) -> (x:xs, y:ys)) ([], [])

readInput :: IO ([Integer], [Integer])
readInput = fmap reassoc $ readLn >>= flip replicateM readPair

solveCase :: IO Integer
solveCase = fmap solve readInput

main :: IO ()
main = readLn >>= flip replicateM_ (solveCase >>= print)

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

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

import Data.Int

medianCount :: [Int] -> Int
medianCount x = let
  n = length x
  sx = sort x
  [lv, rv] = map (sx !!) [div (n-1) 2, div n 2]
  in  rv - lv + 1

(*!) :: Int -> Int -> Int64
x *! y = fromIntegral x * fromIntegral y

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    [x, y] <- transpose <$> replicateM n readInts
    putInt64s [medianCount x *! medianCount y]

type SIO = StateT P.ByteString IO

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

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

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

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

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

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

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

run1 = do
  n <- popInt
  ps <- map (\[x, y] -> (x, y)) <$> replicateM n popIntegers
  return $ bshow (solve n ps)

map2 f (a, b) = (f a, f b)

solve :: Int -> [(Integer, Integer)] -> Integer
solve n ps =
  let xs = sort $ map fst ps
      ys = sort $ map snd ps in
    case n `rem` 2 of
      0 -> (\(cx, cy) -> cx * cy) $
           map2 ((\[a, b] -> b - a + 1) . take 2 . drop ((n `quot` 2) - 1)) $
           (xs, ys)
      1 -> 1


A very brave explorer Petya once decided to explore Paris catacombs. Since Petya is not really experienced, his exploration is just walking through the catacombs.Catacombs consist of several rooms and bidirectional passages between some pairs of them. Some passages can connect a room to itself and since the passages are built on different depths they do not intersect each other. Every minute Petya arbitrary chooses a passage from the room he is currently in and then reaches the room on the other end of the passage in exactly one minute. When he enters a room at minute i, he makes a note in his logbook with number ti:   If Petya has visited this room before, he writes down the minute he was in this room last time;  Otherwise, Petya writes down an arbitrary non-negative integer strictly less than current minute i. Initially, Petya was in one of the rooms at minute 0, he didn't write down number t0.At some point during his wandering Petya got tired, threw out his logbook and went home. Vasya found his logbook and now he is curious: what is the minimum possible number of rooms in Paris catacombs according to Petya's logbook?

The first line contains a single integer n (1 ≤ n ≤ 2·105) — then number of notes in Petya's logbook. The second line contains n non-negative integers t1, t2, ..., tn (0 ≤ ti < i) — notes in the logbook.

In the only line print a single integer — the minimum possible number of rooms in Paris catacombs.

NoteIn the first sample, sequence of rooms Petya visited could be, for example 1 → 1 → 2, 1 → 2 → 1 or 1 → 2 → 3. The minimum possible number of rooms is 2.In the second sample, the sequence could be 1 → 2 → 3 → 1 → 2 → 1.

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.IntSet as S
import Data.List
import Data.Function
main = B.interact exec
exec = B.pack . show . fst . foldl (\(!t, !s) x -> let s' = S.insert x s in (t + fromEnum (S.member x s), s')) (1, S.empty) . map (maybe undefined fst . B.readInt) . tail . B.words

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.IntSet as S
import Data.List
import Data.Function
main = B.interact exec
exec = B.pack . show . (\(_, t, _) -> t) . foldl (\(!p, !t, !s) x -> let s' = S.insert x s in (x, t + fromEnum (x == p || S.notMember x s), s')) (-1, 0, S.empty) . map (maybe undefined fst . B.readInt) . tail . B.words


On an $$$8 \times 8$$$ grid, some horizontal rows have been painted red, and some vertical columns have been painted blue, in some order. The stripes are drawn sequentially, one after the other. When the stripe is drawn, it repaints all the cells through which it passes.Determine which color was used last.  The red stripe was painted after the blue one, so the answer is R.

The first line of the input contains a single integer $$$t$$$ ($$$1 \leq t \leq 4000$$$) — the number of test cases. The description of test cases follows. There is an empty line before each test case. Each test case consists of $$$8$$$ lines, each containing $$$8$$$ characters. Each of these characters is either 'R', 'B', or '.', denoting a red square, a blue square, and an unpainted square, respectively. It is guaranteed that the given field is obtained from a colorless one by drawing horizontal red rows and vertical blue columns. At least one stripe is painted.

For each test case, output 'R' if a red stripe was painted last, and 'B' if a blue stripe was painted last (without quotes).

NoteThe first test case is pictured in the statement.In the second test case, the first blue column is painted first, then the first and last red rows, and finally the last blue column. Since a blue stripe is painted last, the answer is B.

import Control.Monad (forM, forM_)
import Data.List (nub, transpose)

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

main = do
  n <- readLn :: IO Int
  forM_
    [1 .. n]
    ( \_ -> do
        _ <- getLine
        ans <- forM [1 .. 8] (\_ -> do getLine)
        putStrLn $
          if any ((== True) . all (== 'R')) ans
            then "R"
            else "B"
    )

import Data.List

solve :: [String] -> String
solve [] = "B"
solve (a:xs) = if a == replicate 8 'R' then "R" else solve xs

testCase = do
    n <- getLine
    grid <- repeatDo 8 getLine
    putStrLn $ solve grid

repeatDo 0 m = return []

repeatDo n m = do
  x1 <- m
  x2 <- repeatDo (n - 1) m
  return (x1 : x2)

main = do
    n <- read `fmap` getLine :: IO Int
    repeatDo n testCase

import Control.Monad (forM, forM_)
import Data.List (nub, transpose)

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

main = do
  n <- readLn :: IO Int
  forM_
    [1 .. n]
    ( \_ -> do
        _ <- getLine
        ans <- forM [1 .. 8] (\_ -> do getLine)
        print ans
        putStrLn $
          if any ((== True) . all (== 'R')) ans
            then "R"
            else "B"
    )

import Control.Monad (forM, forM_)
import Data.List (nub, transpose)

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

main = do
  n <- readLn :: IO Int
  forM_
    [1 .. n]
    ( \_ -> do
        ans <- forM [1 .. 8] (\_ -> do getLine)
        putStrLn $
          if any ((== True) . all (== 'R')) ans
            then "R"
            else "B"
    )


You are given an array of positive integers. While there are at least two equal elements, we will perform the following operation. We choose the smallest value $$$x$$$ that occurs in the array $$$2$$$ or more times. Take the first two occurrences of $$$x$$$ in this array (the two leftmost occurrences). Remove the left of these two occurrences, and the right one is replaced by the sum of this two values (that is, $$$2 \cdot x$$$).Determine how the array will look after described operations are performed.For example, consider the given array looks like $$$[3, 4, 1, 2, 2, 1, 1]$$$. It will be changed in the following way: $$$[3, 4, 1, 2, 2, 1, 1]~\rightarrow~[3, 4, 2, 2, 2, 1]~\rightarrow~[3, 4, 4, 2, 1]~\rightarrow~[3, 8, 2, 1]$$$.If the given array is look like $$$[1, 1, 3, 1, 1]$$$ it will be changed in the following way: $$$[1, 1, 3, 1, 1]~\rightarrow~[2, 3, 1, 1]~\rightarrow~[2, 3, 2]~\rightarrow~[3, 4]$$$.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 150\,000$$$) — the number of elements in the array. The second line contains a sequence from $$$n$$$ elements $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^{9}$$$) — the elements of the array.

In the first line print an integer $$$k$$$ — the number of elements in the array after all the performed operations. In the second line print $$$k$$$ integers — the elements of the array after all the performed operations.

NoteThe first two examples were considered in the statement.In the third example all integers in the given array are distinct, so it will not change.

{-# LANGUAGE BangPatterns, ViewPatterns #-}
import qualified Data.Set as S
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import Data.Int
import Data.List
import Data.Ord
import Control.Applicative

main = interact exec
exec = (\xs -> show (length xs) ++ "\n" ++ unwords (map show xs)) . (\(n:xs) -> f (read n) (map read xs :: [Int64])) . words
f n = map fst . sortBy (comparing (IS.findMin . snd)) . M.assocs . (g <*> (S.fromAscList . M.keys)) . M.fromListWith IS.union . flip zip (map IS.singleton [n, n - 1..]) . reverse

g (!m) (!xs)
  | Just (x, h (M.delete x m) x (IS.toList $ m M.! x) -> (m', xs')) <- S.minView xs = g m' xs'
  | otherwise = m

h m _ [] xs = (m, xs)
h m x [j] xs = (M.insert x (IS.singleton j) m, xs)
h (!m) x (_:j:is) (!xs) = h (M.alter (Just . maybe (IS.singleton j) (IS.insert j)) (2 * x) m) x is (S.insert (2 * x) xs)

import Control.Applicative
import Data.Int
import Data.List (groupBy, sort)
import qualified Data.Map as M
import qualified Data.Set as S

main = do
  _ <- readLn :: IO Int
  xs <- readLs :: IO [Int64]
  let res = solve xs
  print $ length res
  putStrLn $ unwords . map show $ res

solve = map snd . sort . solve' [] . prepare
  where prepare = M.fromList . map (\xs -> let (x:_, ys) = unzip xs in (x, S.fromAscList ys)) .
          groupBy (\x y -> fst x == fst y) . sort . flip zip [0..]
        solve' acc m | M.null m = reverse acc
        solve' acc m = let ((x, is), m') = M.deleteFindMin m
                       in  case S.size is of
                             0 -> solve' acc m'
                             1 -> solve' ((S.findMin is, x) : acc) m'
                             n -> let (i, is') = S.deleteFindMin $ snd $ S.deleteFindMin is
                                  in  solve' acc $ M.insert x is' $
                                        M.insertWith (const $ S.insert i) (2*x) (S.singleton i) m'

readLs = map read . words <$> getLine

{-# LANGUAGE BangPatterns, ViewPatterns #-}
import qualified Data.IntMap.Strict as M
import qualified Data.IntSet as S
import Data.List
import Data.Ord
import Control.Applicative

main = interact exec
exec = (\xs -> show (length xs) ++ "\n" ++ unwords (map show xs)) . (\(n:xs) -> f (n :: Int) xs) . map read . words
f n = map fst . sortBy (comparing (S.findMin . snd)) . M.assocs . (g <*> (S.fromAscList . M.keys)) . M.fromListWith S.union . flip zip (map S.singleton [n, n - 1..]) . reverse

g (!m) (!xs)
  | Just (x, h (M.delete x m) x (S.toList $ m M.! x) -> (m', xs')) <- S.minView xs = g m' xs'
  | otherwise = m

h m _ [] xs = (m, xs)
h m x [j] xs = (M.insert x (S.singleton j) m, xs)
h (!m) x (_:j:is) (!xs) = h (M.alter (Just . maybe (S.singleton j) (S.insert j)) (2 * x) m) x is (S.insert (2 * x) xs)


You're given an array $$$a$$$ of length $$$n$$$. You can perform the following operations on it:  choose an index $$$i$$$ $$$(1 \le i \le n)$$$, an integer $$$x$$$ $$$(0 \le x \le 10^6)$$$, and replace $$$a_j$$$ with $$$a_j+x$$$ for all $$$(1 \le j \le i)$$$, which means add $$$x$$$ to all the elements in the prefix ending at $$$i$$$.  choose an index $$$i$$$ $$$(1 \le i \le n)$$$, an integer $$$x$$$ $$$(1 \le x \le 10^6)$$$, and replace $$$a_j$$$ with $$$a_j \% x$$$ for all $$$(1 \le j \le i)$$$, which means replace every element in the prefix ending at $$$i$$$ with the remainder after dividing it by $$$x$$$. Can you make the array strictly increasing in no more than $$$n+1$$$ operations?

The first line contains an integer $$$n$$$ $$$(1 \le n \le 2000)$$$, the number of elements in the array $$$a$$$. The second line contains $$$n$$$ space-separated integers $$$a_1$$$, $$$a_2$$$, $$$\dots$$$, $$$a_n$$$ $$$(0 \le a_i \le 10^5)$$$, the elements of the array $$$a$$$.

On the first line, print the number of operations you wish to perform. On the next lines, you should print the operations. To print an adding operation, use the format "$$$1$$$ $$$i$$$ $$$x$$$"; to print a modding operation, use the format "$$$2$$$ $$$i$$$ $$$x$$$". If $$$i$$$ or $$$x$$$ don't satisfy the limitations above, or you use more than $$$n+1$$$ operations, you'll get wrong answer verdict.

NoteIn the first sample, the array is already increasing so we don't need any operations.In the second sample:In the first step: the array becomes $$$[8,6,3]$$$.In the second step: the array becomes $$$[0,2,3]$$$.

import Data.List
import qualified Data.Map.Strict as Map

toint s = (read s) :: Int

m = 200001

doit [] n s = []
doit (x:xs) n s =
  let t = x+s in -- t+k=n
  let w = mod (n-t+m) m in
  if w == 0 then
    doit xs (n-1) s
  else
    (n,w):(doit xs (n-1) (s+w))

printit [] = ""
printit ((a,b):xs) =
  "1 "++show(a)++" "++show(b)++"\n"++(printit xs)

solve::String -> String
solve ss =
  let n:aa = map toint $ words ss in
  let a = reverse $ take n aa in
  let r = doit a n 0 in
  show(length r + 1)++"\n"++(printit r)++"2 "++show(n)++" "++show(m)++"\n"

main = do
  interact $ solve

{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
{-
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord

showTriple :: (Int,Int,Int) -> String
showTriple (x,y,z)
  = shows x $ (' ' :) $ shows y $ (' ' :) $ show z

printTriple :: (Int,Int,Int) -> IO ()
printTriple = putStrLn . showTriple

main :: IO ()
main = do
  n <- read <$> getLine
  getLine
  print $ n+1
  printTriple (2,n,1)
  printTriple (1,n,2*n)
  mapM_ printTriple $ [(2,j,2*n-j) | j <- [1..n-1]]

{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
{-
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord

showTriple :: (Int,Int,Int) -> String
showTriple (x,y,z)
  = shows x $ (' ' :) $ shows y $ (' ' :) $ show z

printTriple :: (Int,Int,Int) -> IO ()
printTriple = putStrLn . showTriple

main :: IO ()
main = do
  n <- read <$> getLine
  getLine
  printTriple (2,n,1)
  printTriple (1,n,2*n)
  mapM_ printTriple $ [(1,j,2*n-j) | j <- [1..n-1]]

{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
{-
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord

showTriple :: (Int,Int,Int) -> String
showTriple (x,y,z)
  = shows x $ (' ' :) $ shows y $ (' ' :) $ show z

printTriple :: (Int,Int,Int) -> IO ()
printTriple = putStrLn . showTriple

main :: IO ()
main = do
  n <- read <$> getLine
  getLine
  print $ n+1
  printTriple (2,n,1)
  printTriple (1,n,2*n)
  mapM_ printTriple $ [(1,j,2*n-j) | j <- [1..n-1]]

{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
{-
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord

showTriple :: (Int,Int,Int) -> String
showTriple (x,y,z)
  = shows x $ (' ' :) $ shows y $ (' ' :) $ show z

printTriple :: (Int,Int,Int) -> IO ()
printTriple = print . showTriple

main :: IO ()
main = do
  n <- read <$> getLine
  getLine
  printTriple (2,n,1)
  printTriple (1,n,2*n)
  mapM_ printTriple $ [(1,j,2*n-j) | j <- [1..n-1]]


Bob programmed a robot to navigate through a 2d maze.The maze has some obstacles. Empty cells are denoted by the character '.', where obstacles are denoted by '#'.There is a single robot in the maze. Its start position is denoted with the character 'S'. This position has no obstacle in it. There is also a single exit in the maze. Its position is denoted with the character 'E'. This position has no obstacle in it.The robot can only move up, left, right, or down.When Bob programmed the robot, he wrote down a string of digits consisting of the digits 0 to 3, inclusive. He intended for each digit to correspond to a distinct direction, and the robot would follow the directions in order to reach the exit. Unfortunately, he forgot to actually assign the directions to digits.The robot will choose some random mapping of digits to distinct directions. The robot will map distinct digits to distinct directions. The robot will then follow the instructions according to the given string in order and chosen mapping. If an instruction would lead the robot to go off the edge of the maze or hit an obstacle, the robot will crash and break down. If the robot reaches the exit at any point, then the robot will stop following any further instructions.Bob is having trouble debugging his robot, so he would like to determine the number of mappings of digits to directions that would lead the robot to the exit.

The first line of input will contain two integers n and m (2 ≤ n, m ≤ 50), denoting the dimensions of the maze. The next n lines will contain exactly m characters each, denoting the maze. Each character of the maze will be '.', '#', 'S', or 'E'. There will be exactly one 'S' and exactly one 'E' in the maze. The last line will contain a single string s (1 ≤ |s| ≤ 100) — the instructions given to the robot. Each character of s is a digit from 0 to 3.

Print a single integer, the number of mappings of digits to directions that will lead the robot to the exit.

NoteFor the first sample, the only valid mapping is , where D is down, L is left, U is up, R is right.

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Array
import Data.List
import Data.Char

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  g <- replicateM n pop
  s <- pop
  return $ show $ solve n m g s
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n m g0 cs0 =  length $ filter ((\(~(l, r)) -> (all (\(i, j) -> i >= 0 && j >= 0 && i < n && j < m && at i j /= '#') l) && not (null r)) . span (/= e)) $ map (\p -> go s $ map (p!!) cs) $ permutations "LRUD"
  where
  cs = map digitToInt $ B.unpack cs0
  g = listArray (0, n - 1) g0 :: Array Int B.ByteString
  at i j = (g!i) `B.index` j
  s = head [(i, j) | i <- [0..n - 1], j <- [0..m - 1], at i j == 'S']
  e = head [(i, j) | i <- [0..n - 1], j <- [0..m - 1], at i j == 'E']

go :: (Int, Int) -> String -> [(Int, Int)]
go = scanl (\(i, j) c -> case c of { 'L' -> (i, j - 1); 'R' -> (i, j + 1); 'U' -> (i - 1, j); 'D' -> (i + 1, j); })


Haiku is a genre of Japanese traditional poetry.A haiku poem consists of 17 syllables split into three phrases, containing 5, 7 and 5 syllables correspondingly (the first phrase should contain exactly 5 syllables, the second phrase should contain exactly 7 syllables, and the third phrase should contain exactly 5 syllables). A haiku masterpiece contains a description of a moment in those three phrases. Every word is important in a small poem, which is why haiku are rich with symbols. Each word has a special meaning, a special role. The main principle of haiku is to say much using a few words.To simplify the matter, in the given problem we will consider that the number of syllable in the phrase is equal to the number of vowel letters there. Only the following letters are regarded as vowel letters: "a", "e", "i", "o" and "u".Three phases from a certain poem are given. Determine whether it is haiku or not.

The input data consists of three lines. The length of each line is between 1 and 100, inclusive. The i-th line contains the i-th phrase of the poem. Each phrase consists of one or more words, which are separated by one or more spaces. A word is a non-empty sequence of lowercase Latin letters. Leading and/or trailing spaces in phrases are allowed. Every phrase has at least one non-space character. See the example for clarification.

Print "YES" (without the quotes) if the poem is a haiku. Otherwise, print "NO" (also without the quotes).

on  codeforces
beta round is running
   a rustling of keys

how many gallons
of edo s rain did you drink
                                cuckoo

import Text.Printf
import List

main = solve

isVowel c = if Nothing == find (==c) "aeiou" then False else True

getVowels = do
  line <- getLine
  return (filter isVowel line)

solve = do
  x <- getVowels
  y <- getVowels
  z <- getVowels
  putStrLn (if ((length x == 5) && (length y == 7) && (length z == 5)) then "YES" else "NO")

main = do cs <- getContents
          putStrLn $ ck $ lines cs

ck :: [String] -> String
ck [x, y, z]
  | length (filter bowel x) /= 5 = "NO"
  | length (filter bowel y) /= 7 = "NO"
  | length (filter bowel z) /= 5 = "NO"
  | otherwise                    = "YES"

ck [x, y, z, xs] = ck [x, y, z]

bowel :: Char -> Bool
bowel x
 | x == 'a' = True
 | x == 'i' = True
 | x == 'u' = True
 | x == 'e' = True
 | x == 'o' = True
 | otherwise = False

import Data.List (intersect)
syllables :: String -> Int
syllables s = length $ s `intersect` "aeuio"
main = do
  l1 <- getLine
  l2 <- getLine
  l3 <- getLine
  putStr $ if map (syllables) [l1,l2,l3] == [5,7,5]
    then "YES"
    else "NO"

vowel = "aeiouAEIOU"

countVowel :: String -> Int
countVowel line = length $ filter (\c -> c `elem` vowel) line

haiku :: [String] -> String
haiku lines = if [5, 7, 5] == (map countVowel lines) then "YES" else "NO"

main = do
    lines <- sequence (map (\n -> getLine) [1..3])
    putStrLn (haiku lines)

main=getContents>>=(putStr.p.lines)
p x|map(length.filter(`elem`"aeoui"))x==[5,7,5]="YES"
p _="NO"

main = interact $ ifte "YES" "NO" . (== [5,7,5]) . map (length . filter (`elem` "aeiou")) . lines
ifte t e c = if c then t else e

main = do
    s1 <- getLine
    s2 <- getLine
    s3 <- getLine
    putStrLn $ if wowels s1 == 5 && wowels s2 == 7 && wowels s3 == 5 then "YES" else "NO"
wowels s = length $ filter wowel s
wowel ch = ch `elem` ['a', 'e', 'i', 'o', 'u']

import Prelude
import List
import Char

main = interact q

q = func.lines

func::[String]->String
func = solve

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve::[String]->String
solve (a:b:c:[]) | a' && b' && c' = "YES"
                 | otherwise      = "NO"
      where
        a' = count a == 5
        b' = count b == 7
        c' = count c == 5

count::String->Int
count [] = 0
count (s:xs) | s `elem` "aeiou" = 1 + count xs
             | otherwise        = count xs

import Data.List

is :: Char -> Bool
is 'a' = True
is 'e' = True
is 'i' = True
is 'o' = True
is 'u' = True
is  x  = False

count :: String -> Int
count xs = sum [ 1 | x <- xs , is x ]

main :: IO()
main = do
        a <- getLine
        b <- getLine
        c <- getLine
        if [ count a, count b , count c] == [5,7,5]
         then putStrLn "YES"
         else putStrLn "NO"

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, UndecidableInstances, ImplicitParams, ExplicitForAll #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  ss <- replicateM 3 getLine
  let isVowel c | c `elem ` "aeiou" = True
                | otherwise         = False
  case map (length . filter isVowel) ss of
    [5, 7, 5] -> putStrLn "YES"
    _         -> putStrLn "NO"

main = interact $ isVowelHaiku . take 3 . lines

isVowelHaiku :: [String] -> String
isVowelHaiku xs = if vowelLines xs == [5,7,5] then "YES" else "NO"

vowelLines :: [String] -> [Int]
vowelLines = map (length . filter (`elem` "aeiou"))

main = do
    l <- mapM (\_ -> do
        l' <- getLine
        return $ length $ filter(`elem` "aieou") l') [1..3]
    putStrLn (if l == [5, 7, 5] then "YES" else "NO")

import Control.Monad

sy = length . filter (`elem` "aeiou")

main = do
    [a,b,c] <- replicateM 3 getLine
    putStrLn $ if sy a == 5 && sy b == 7 && sy c == 5 then "YES" else "NO"

main = interact $ (\x->if x==[5,7,5] then "YES\n" else "NO\n"). map (length . filter (`elem` "aeiou")) . lines

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

main = do
		n<-map length <$> map  (filter (\z->elem z "aeiou") ) <$> replicateM 3 getLine
		putStrLn $ if n==[5,7,5] then "YES" else "NO"

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

-- input = lines <$> readFile "input.txt"
input = lines <$> getContents

countVowel text = length xs
    where
      xs = intersect text vowel
vowel = "aeiou"

solve :: [String] -> String
solve xs = if ys == [5,7,5] then "YES" else "NO"
    where ys = map countVowel $ xs

main :: IO ()
main = do { ns <- input
          ; printf "%s" . solve $ ns
          }

import Data.List

count pred = length . (filter pred)

solve x =
    case map (count (flip elem "aeiou")) x of
      (5:7:5:_) -> True
      _ -> False

prepare True = "YES"
prepare False = "NO"

main = do
  stuff <- getContents
  putStrLn . prepare . solve . lines $ stuff

isVowel :: Char -> Bool
isVowel c = c `elem` "aAeEiIoOuU"

vowelsInPhrase :: String -> Int
vowelsInPhrase xs = sum [1 | x <- xs, isVowel x]

isHaiku :: [String] -> Bool
isHaiku phrases = pv == [5, 7, 5]
			where
				pv = [vowelsInPhrase p | p <- phrases]

--haven't written Haskell for sometime, so my
--solution is kinda weird

main :: IO ()
main = do
		line1 <- getLine
		line2 <- getLine
		line3 <- getLine

		if(isHaiku [line1, line2, line3]) then putStrLn "YES" else putStrLn "NO"

main = do cs <- getContents
          putStrLn $ ck $ lines cs

ck :: [String] -> String
ck [x, y, z]
  | length (filter bowel x) /= 5 = "NO"
  | length (filter bowel y) /= 7 = "NO"
  | length (filter bowel z) /= 5 = "NO"
  | otherwise                    = "TRUE"

ck [x, y, z, xs] = ck [x, y, z]

bowel :: Char -> Bool
bowel x
 | x == 'a' = True
 | x == 'i' = True
 | x == 'u' = True
 | x == 'e' = True
 | x == 'o' = True
 | otherwise = False

import Data.List (intersect)
syllables :: String -> Int
syllables s = length $ s `intersect` "aeuio"
main = do
  l1 <- getLine
  l2 <- getLine
  l3 <- getLine
  print $ if map (syllables) [l1,l2,l3] == [7,5,7]
    then "YES"
    else "NO"

main = do
    l <- mapM (\_ -> do
        l' <- getLine
        return $ length $ filter(`elem` "aieou") l') [1..3]
    print (if l == [5, 7, 5] then "YES" else "NO")

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

-- input = lines <$> readFile "input.txt"
input = lines <$> getContents

countVowel text = length xs
    where
      xs = intersect text vowel
vowel = "aeiou"

solve xs = if ys == [5,7,5] then "YES" else "NO"
    where ys = map countVowel $ xs

main :: IO ()
main = do { ns <- input
          ; print . solve $ ns
          }

import Data.List

count pred = length . (filter pred)

solve x =
    case map (count (flip elem "aeiou")) x of
      (5:7:5:_) -> True
      _ -> False

main = do
  stuff <- getContents
  print . solve . lines $ stuff

isVowel :: Char -> Bool
isVowel c = c `elem` "aAeEiIoOuU"

vowelsInPhrase :: String -> Int
vowelsInPhrase xs = sum [1 | x <- xs, isVowel x]

isHaiku :: String -> Bool
isHaiku s = pv == [5, 7, 5]
			where
				phrases = lines s
				pv = [vowelsInPhrase p | p <- phrases]

--haven't written Haskell for sometime, so my
--solution is kinda weird

main :: IO ()
main = do
		line1 <- getLine
		line2 <- getLine
		line3 <- getLine

		let haiku = line1 ++ line2 ++ line3

		if(isHaiku haiku) then putStrLn "YES" else putStrLn "NO"

isVowel :: Char -> Bool
isVowel c = c `elem` "aAeEiIoOuU"

vowelsInPhrase :: String -> Int
vowelsInPhrase xs = sum [1 | x <- xs, isVowel x]

isHaiku :: String -> Bool
isHaiku s = sum [vowelsInPhrase p | p <- phrases] == 17
			where
				phrases = lines s

--haven't written Haskell for sometime, so my
--solution is kinda weird

main :: IO ()
main = do
		line1 <- getLine
		line2 <- getLine
		line3 <- getLine

		let haiku = line1 ++ line2 ++ line3

		if(isHaiku haiku) then putStrLn "YES" else putStrLn "NO"


You are storing an integer array of length $$$m$$$ in a database. To maintain internal integrity and protect data, the database stores $$$n$$$ copies of this array.Unfortunately, the recent incident may have altered the stored information in every copy in the database.It's believed, that the incident altered at most two elements in every copy. You need to recover the original array based on the current state of the database.In case there are multiple ways to restore the array, report any. If there is no array that differs from every copy in no more than two positions, report that as well.

The first line contains integers $$$n$$$ and $$$m$$$ ($$$2 \le n$$$; $$$1 \le m$$$; $$$n \cdot m \le 250\,000$$$) — the number of copies and the size of the array. Each of the following $$$n$$$ lines describes one of the currently stored copies in the database, it consists of $$$m$$$ integers $$$s_{i, 1}, s_{i, 2}, \dots, s_{i, m}$$$ ($$$1 \le s_{i, j} \le 10^9$$$).

If there is an array consistent with all given copies, print "Yes" and then the array itself. The array must have length $$$m$$$ and contain integers between $$$1$$$ and $$$10^9$$$ only. Otherwise, print "No". If there are multiple possible arrays, print any of them.

NoteIn the first example, the array $$$[1, 10, 1, 100]$$$ differs from first and second copies in just one position, and from the third copy in two positions.In the second example, array $$$[1, 1, 1, 1, 1, 1, 1]$$$ is the same as the first copy and differs from all other copies in at most two positions.In the third example, there is no array differing in at most two positions from every database's copy.

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

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

import Data.Array.Unboxed
import Data.Function

diffs :: UArray Int Int -> UArray Int Int -> [(Int, Int)]
diffs a1 a2 = [kv | kv@(i, a2i) <- assocs a2, a2i /= a1 ! i]

mesh :: Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
mesh k ps qs = let
  ws = groupBy ((==) `on` fst) $ sort $ ps ++ qs
  -- I repurposed this function, but missed a necessary change
  indirectMismatch = [() | (_, v1) : (_, v2) : _ <- ws, v1 /= v2]
  directMismatch = [() | [_] <- ws]
  in  length directMismatch + length indirectMismatch <= k

solve :: [UArray Int Int] -> Int -> Int -> Maybe [(Int, Int)]
solve [] _ _ = Just []
solve [_] _ _ = Just []
solve s k k0 = let
  issues = map (diffs (head s)) $ tail s
  worstIssue = maximumBy (compare `on` length) issues
  in  case  length worstIssue  of
  v | v > k + k0  -> Nothing
    | v == k + k0 -> let
        okv = do
          try <- subsequences worstIssue
          [try | length try <= k && all (mesh k0 try) issues]
        in  case  okv  of
        [] -> Nothing
        ans : _ -> Just ans
    | v <= k0    -> Just []
    | otherwise -> let
        okv = do
          try <- worstIssue
          let  s1 : stail = s
          [try : ans | Just ans <- [solve (s1 // [try] : stail) (k-1) k0]]
        in  case  okv  of
        [] -> Nothing
        ans : _ -> Just ans

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m] <- readInts
  s <- replicateM n $ listArray (1, m) <$> readInts
  case  solve s 2 2  of
    Nothing -> lift $ P.putStrLn $ P.pack "No"
    Just a -> do
      lift $ P.putStrLn $ P.pack "Yes"
      putInts $ elems $ accum (\_ v -> v) (head s) a

type SIO = StateT P.ByteString IO

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

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

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

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

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

import Data.Array.Unboxed
import Data.Function

diffs :: UArray Int Int -> UArray Int Int -> [(Int, Int)]
diffs a1 a2 = [kv | kv@(i, a2i) <- assocs a2, a2i /= a1 ! i]

mesh :: Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
mesh k ps qs = let
  ws = groupBy ((==) `on` fst) $ sort $ ps ++ qs
  compatible = and [v1 == v2 && null vs | (_, v1) : (_, v2) : vs <- ws]
  numMismatched = length [() | [_] <- ws]
  in  compatible && numMismatched <= k

solve :: [UArray Int Int] -> Int -> Maybe [(Int, Int)]
solve [] _ = Just []
solve [_] _ = Just []
solve s k = let
  issues = map (diffs (head s)) $ s
  worstIssue = maximumBy (compare `on` length) issues
  in  case  length worstIssue  of
  v | v > 2*k  -> Nothing
    | v == 2*k -> let
        okv = [try | try <- subsequences worstIssue, all (mesh k try) issues]
        in  case  okv  of
        [] -> Nothing
        ans : _ -> Just ans
    | v <= k    -> Just []
    | otherwise -> let
        okv = do
          try <- worstIssue
          let  s1 : stail = s
          [try : ans | Just ans <- [solve (s1 // [try] : stail) (k-1)]]
        in  case  okv  of
        [] -> Nothing
        ans : _ -> Just ans

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m] <- readInts
  s <- replicateM n $ listArray (1, m) <$> readInts
  case  solve s 2  of
    Nothing -> lift $ P.putStrLn $ P.pack "No"
    Just a -> do
      lift $ P.putStrLn $ P.pack "Yes"
      putInts $ elems $ accum (\_ v -> v) (head s) a

type SIO = StateT P.ByteString IO

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

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

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

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

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

import Data.Array.Unboxed
import Data.Function

diffs :: UArray Int Int -> UArray Int Int -> [(Int, Int)]
diffs a1 a2 = [kv | kv@(i, a2i) <- assocs a2, a2i /= a1 ! i]

mesh :: Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
mesh k ps qs = let
  ws = groupBy ((==) `on` fst) $ sort $ ps ++ qs
  compatible = and [v1 == v2 && null vs | (_, v1) : (_, v2) : vs <- ws]
  numMismatched = length [() | [_] <- ws]
  in  compatible && numMismatched <= k

solve :: [UArray Int Int] -> Int -> Maybe [(Int, Int)]
solve [] _ = Just []
solve [_] _ = Just []
solve s k = let
  issues = map (diffs (head s)) $ tail s
  worstIssue = maximumBy (compare `on` length) issues
  in  case  length worstIssue  of
  v | v > 2*k  -> Nothing
    | v == 2*k -> let
        okv = [try | try <- subsequences worstIssue, all (mesh k try) issues]
        in  case  okv  of
        [] -> Nothing
        ans : _ -> Just ans
    | v <= k    -> Just []
    | otherwise -> let
        okv = do
          try <- worstIssue
          let  s1 : stail = s
          [try : ans | Just ans <- [solve (s1 // [try] : stail) (k-1)]]
        in  case  okv  of
        [] -> Nothing
        ans : _ -> Just ans

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m] <- readInts
  s <- replicateM n $ listArray (1, m) <$> readInts
  case  solve s 2  of
    Nothing -> lift $ P.putStrLn $ P.pack "No"
    Just a -> do
      lift $ P.putStrLn $ P.pack "Yes"
      putInts $ elems $ accum (\_ v -> v) (head s) a

type SIO = StateT P.ByteString IO

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

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

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


Sean is trying to save a large file to a USB flash drive. He has n USB flash drives with capacities equal to a1, a2, ..., an megabytes. The file size is equal to m megabytes. Find the minimum number of USB flash drives needed to write Sean's file, if he can split the file between drives.

The first line contains positive integer n (1 ≤ n ≤ 100) — the number of USB flash drives. The second line contains positive integer m (1 ≤ m ≤ 105) — the size of Sean's file. Each of the next n lines contains positive integer ai (1 ≤ ai ≤ 1000) — the sizes of USB flash drives in megabytes. It is guaranteed that the answer exists, i. e. the sum of all ai is not less than m.

Print the minimum number of USB flash drives to write Sean's file, if he can split the file between drives.

NoteIn the first example Sean needs only two USB flash drives — the first and the third.In the second example Sean needs all three USB flash drives.In the third example Sean needs only one USB flash drive and he can use any available USB flash drive — the first or the second.

import Data.List
main = do
   c1<- ( getContents )
   let c = lines c1
   let n = head c
   let m = head (tail c)
   let f = drop 2 c
   print ( (calcf (read m) (reverse (sort (map read  f))) 1))

calcf m f i = if (sum (take i f)) >= m then i
              else calcf m f (i+1)

import Data.List (sort)

main = do
  getLine
  [m] <- (map read . words) `fmap` getLine
  as <- (sort . map read . lines) `fmap` getContents

  print . (+1) . length . takeWhile (< m) $ scanl1 (+) (reverse as)

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L

getInt :: IO Int
getInt = (read . T.unpack . T.strip . T.pack) <$> getLine

main :: IO ()
main = do
    (n, m) <- (,) <$> getInt <*> getInt
    items <- L.sort <$> forM [0 .. n - 1] (const getInt)
    let (_, res) = foldr (\x (s, cnt) -> (s + x, if s < m then cnt + 1 else cnt)) (0, 0) items
    putStrLn $ show res

import Control.Applicative
import Data.List

readNum :: (Num n, Read n) => IO n
readNum = read <$> getLine

solve n m []     = 0
solve n m (x:xs) = if (m-x) <= 0 then n - length xs
                   else solve n (m-x) xs

main = do
    n <- readNum
    m <- readNum
    sizes <- sequence $ replicate n readNum
    putStrLn $ show $ solve n m (sortBy (flip compare) sizes)

import Data.List

readNum :: (Num n, Read n) => IO n
readNum = do
        line <- getLine
        return $ read line

solve n m []     = 0
solve n m (x:xs) = if (m-x) <= 0 then n - length xs
                   else solve n (m-x) xs

main = do
    n <- readNum
    m <- readNum
    sizes <- sequence $ replicate n readNum
    putStrLn $ show $ solve n m (sortBy (flip compare) sizes)

import Control.Applicative ((<$>))
import Data.List

readInt :: String -> Int
readInt = read

solve :: [Int] -> Int -> Int -> Int
solve (c:cs) space num =
 if c >= space
   then num
   else solve cs (space - c) (num + 1)
solve _ _ num = num

main = do
  _ <- getLine
  numStr <- readInt <$> getLine
  cards <- map readInt . lines <$> getContents
  print $ solve (sortBy (flip compare) cards) numStr 1

{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Char (intToDigit, digitToInt)
import Control.Monad (replicateM)

import Data.List (sortBy)

parseInt :: ByteString -> Int
parseInt s
  | BS.head s == '-' = negate (go 0 (BS.tail s))
  | otherwise = go 0 s
  where
    go i s
      | BS.null s = i
      | otherwise = go (i*10 + digitToInt (BS.head s)) (BS.tail s)

printInt :: Int -> ByteString
printInt i
  | i < 10 = BS.singleton (intToDigit i)
  | otherwise = BS.snoc (printInt (i `quot` 10)) (intToDigit (i `rem` 10))

darnit :: ByteString -> ByteString
darnit s
  | BS.last s == '\r' = BS.init s
  | otherwise = s

main :: IO ()
main = do
  n <- fmap (parseInt . darnit) BS.getLine
  m <- fmap (parseInt . darnit) BS.getLine
  as <- replicateM n (fmap (parseInt . darnit) BS.getLine)
  let drives = (+1) . length . takeWhile (< m) . scanl1 (+) . sortBy (flip compare) $ as
  BS.putStrLn (printInt drives)

import Control.Applicative
import Data.List

solve :: Int -> [Int] -> Int
solve n vals =
  fst $ head $ filter (\x -> snd x >= n) $ partialSums
  where
    sorted = reverse $ sort $ vals
    partialSums = zip [1..] $ scanl1 (+) sorted

main = do
  getLine
  m <- read <$> getLine
  vals <- map read . lines <$> getContents
  putStrLn $ show $ solve m vals

import Data.List
main = interact $ show . solve . map read . tail . words
solve (m:as) = length $ takeWhile (< m) $ scanl (+) 0 $ reverse $ sort as

import Data.List

main = getContents >>= print . solve . map read . tail . words

solve (m:as) = head [ x | x <- [1..], m <= sum (take x (sortBy (flip compare) as))]

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

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

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

solve :: Int -> U.Vector Int -> Int
solve m vec = fst.U.head.U.dropWhile((<m).snd).U.indexed.U.scanl(+)0.U.reverse $ radixSort32 vec

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

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

main :: IO ()
main = do
    n <- inputInt
    m <- inputInt
    a <- replicateM n inputInt
    print . length . takeWhile (< m) . scanl (+) 0 . reverse $ sort a

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

onecase = do
		[s,a,b,c]<-map read <$> words <$> getLine ::IO [Integer]
		let x = div s c
		print $ x + (div x a)*b

main = do
		n<-read<$> getLine ::IO Int
		s<-read<$> getLine ::IO Int
		a<-scanl1 (+) <$> reverse <$> sort <$> map read <$>replicateM n getLine ::IO [Int]
		print $ 1+ length (takeWhile (<s) a)

import Data.List

readNum :: (Num n, Read n) => IO n
readNum = do
        line <- getLine
        return $ read line

ans :: Int -> [Int] -> Int
ans n x =  succ . length . takeWhile (<n) . scanl1 (+) . reverse . sort $ x

main = do
  n <- readNum
  m <- readNum
  sizes <- sequence $ replicate n readNum
  print $ ans m sizes

import Data.List (sort)

--process :: Int -> [Int] -> Int
process m = (1+).length.dropWhile (>=m).scanr1 (+).sort

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    m <- fmap readInt getLine
    a <- fmap (map readInt.words) getContents
    print $ process m a

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L

getInt :: IO Int
getInt = (read . T.unpack . T.strip . T.pack) <$> getLine

main :: IO ()
main = do
    (n, m) <- (,) <$> getInt <*> getInt
    items <- L.sort <$> forM [0 .. n - 1] (const getInt)
    putStrLn $ show items
    let (_, cnt) = foldr (\x (s, cnt) -> let s' = s + x in (s', if s' < m then cnt + 1 else cnt)) (0, 0) items
    putStrLn $ show cnt

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L

getInt :: IO Int
getInt = (read . T.unpack . T.strip . T.pack) <$> getLine

main :: IO ()
main = do
    (n, m) <- (,) <$> getInt <*> getInt
    items <- L.sort <$> forM [0 .. n - 1] (const getInt)
    let (_, cnt) = foldr (\x (s, cnt) -> let s' = s + x in (s, if s' < m then cnt + 1 else cnt)) (0, 0) items
    putStrLn $ show cnt

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L

getInt :: IO Int
getInt = (read . T.unpack . T.strip . T.pack) <$> getLine

main :: IO ()
main = do
    (n, m) <- (,) <$> getInt <*> getInt
    items <- L.sort <$> forM [0 .. n - 1] (const getInt)
    let (_, cnt) = foldr (\x (s, cnt) -> let s' = s + x in (s', if s' < m then cnt + 1 else cnt)) (0, 0) items
    putStrLn $ show cnt


A telephone number is a sequence of exactly 11 digits, where the first digit is 8. For example, the sequence 80011223388 is a telephone number, but the sequences 70011223388 and 80000011223388 are not.You are given a string $$$s$$$ of length $$$n$$$, consisting of digits.In one operation you can delete any character from string $$$s$$$. For example, it is possible to obtain strings 112, 111 or 121 from string 1121.You need to determine whether there is such a sequence of operations (possibly empty), after which the string $$$s$$$ becomes a telephone number.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 100$$$) — the length of string $$$s$$$. The second line of each test case contains the string $$$s$$$ ($$$|s| = n$$$) consisting of digits.

For each test print one line. If there is a sequence of operations, after which $$$s$$$ becomes a telephone number, print YES. Otherwise, print NO.

NoteIn the first test case you need to delete the first and the third digits. Then the string 7818005553535 becomes 88005553535.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = readInt >>= flip replicateM solve

solve = do
	n <- readInt
	s <- getLine
	let
		rest = dropWhile ( /= '8' ) s
	putStrLn $ if length rest >= 11 then "YES" else "NO"

import Data.Function
solve = (\x -> if x then "YES" else "NO") . (>=11) . length . snd .  break (=='8')
main = interact $  unlines . fix (\f xs -> if null xs then [] else let (x:y:ys) = xs in solve y : f ys) . tail .lines

main = getContents >>= putStr . solve . tail . words

solve [] = []
solve (_:x:xs)
    | (length $ dropWhile (/='8') x) >= 11 = "YES\n" ++ solve xs
    | otherwise = "NO\n" ++ solve xs

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

second :: [a] -> [a]
second [] = []
second (a:b:c) = b : second c

solve :: String -> Bool
solve = (>=11)
      . length
      . dropWhile (/='8')

yesno :: Bool -> String
yesno b = if b then "YES" else "NO"

main :: IO ()
main = do
    n <- readInt
    s <- replicateM (2 * n) getLine
    mapM_ putStrLn $ map (yesno . solve) $ second s

import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    s <- getLine
    putStrLn $ if n >= 11 && any (== '8') (drop 10 (reverse s))
                  then "YES" else "NO"

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

check c s | c==11 && head s =='8' = True
          | c<11 = False
	  | (length $ take 1 $ filter (=='8') $ take (c-11) s)==1 = True
          | head ( drop (c-11) s)=='8' = True
	  | otherwise = False

onecase = do
		c<- read <$> getLine ::IO Int
		s<- getLine
		putStrLn $ if check c s then "YES" else "NO"

main = do
		n<- read <$> getLine ::IO Int
		replicateM_ n onecase

--ghc 7.10

isTelephoneNumberable :: String -> Bool
isTelephoneNumberable str
    | n > 0 = elem '8' . take n $ str
    | otherwise = False
    where
        n = length str - 10

showBool :: Bool -> String
showBool True = "YES"
showBool False = "NO"

process :: Int -> IO ()
process 0 = return ()
process t = do
    nStr <- getLine
    phoneNo <- getLine
    putStrLn . showBool . isTelephoneNumberable $ phoneNo
    process (t-1)

main = do
    tStr <- getLine
    let t = read tStr :: Int
    process t

module Main where

import Data.Array
import Control.Monad
import Data.Function
import Data.List

main :: IO ()
main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    c <- read <$> getLine
    xs <- getLine
    putStrLn $ f c xs

f :: Int -> String -> String
f c xs =
  let
    pos = findIndex (=='8') $ xs
  in case pos of
    Nothing -> "NO"
    Just x -> if (c -x) >= 11 then "YES" else "NO"

import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    n <- getLine
    s <- getLine
    putStrLn $ if length n >= 11 && any (== '8') (drop 10 (reverse n))
                  then "YES" else "NO"

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

onecase = do
		c<- read <$> getLine ::IO Int
		s<- getLine
		putStrLn $ if 1==(length $ take 1 $ filter (=='8') $ take (c-11) s) then "YES" else "NO"

main = do
		n<- read <$> getLine ::IO Int
		replicateM_ n onecase

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

onecase = do
		c<- read <$> getLine ::IO Int
		s<- getLine
		putStrLn $ if (c==11 && head s =='8') then "YES" else if 1==(length $ take 1 $ filter (=='8') $ take (c-11) s) then "YES" else "NO"

main = do
		n<- read <$> getLine ::IO Int
		replicateM_ n onecase

module Main where

import Data.Array
import Control.Monad
import Data.Function
import Data.List

main :: IO ()
main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    c <- read <$> getLine
    xs <- getLine
    print $ f c xs

f :: Int -> String -> String
f c xs =
  let
    pos = findIndex (=='8') $ xs
  in case pos of
    Nothing -> "NO"
    Just x -> if (c -x) >= 10 then "YES" else "NO"

module Main where

import Data.Array
import Control.Monad
import Data.Function
import Data.List

main :: IO ()
main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    c <- read <$> getLine
    xs <- getLine
    print $ f c xs

f :: Int -> String -> String
f c xs =
  let
    pos = findIndex (=='8') $ xs
  in case pos of
    Nothing -> "NO"
    Just x -> if (c -x) >= 11 then "YES" else "NO"