You are given a circular array with n elements. The elements are numbered from some element with values from 1 to n in clockwise order. The i-th cell contains the value ai. The robot Simba is in cell s.Each moment of time the robot is in some of the n cells (at the begin he is in s). In one turn the robot can write out the number written in current cell or move to the adjacent cell in clockwise or counterclockwise direction. To write out the number from the cell Simba doesn't spend any time, but to move to adjacent cell Simba spends one unit of time.Simba wants to write the number from each cell one time, so the numbers will be written in a non decreasing order. Find the least number of time units to write out all numbers.

The first line contains two integers n and s (1 ≤ s ≤ n ≤ 2000) — the number of cells in the circular array and the starting position of Simba. The second line contains n integers ai ( - 109 ≤ ai ≤ 109) — the number written in the i-th cell. The numbers are given for cells in order from 1 to n. Some of numbers ai can be equal.

In the first line print the number t — the least number of time units. Each of the next n lines should contain the direction of robot movement and the number of cells to move in that direction. After that movement the robot writes out the number from the cell in which it turns out. The direction and the number of cells should be printed in the form of +x in case of clockwise movement and -x in case of counterclockwise movement to x cells (0 ≤ x ≤ n - 1). Note that the sum of absolute values of x should be equal to t.

import Control.Applicative ((<$>))
import Data.List (groupBy, sort, unfoldr)
import Data.Function (on)

data Zipper a = Zipper { zleft :: Zipper a, zhead :: a, zright :: Zipper a }

zipper :: [a] -> Zipper a
zipper xs =
    let (first,last) = go last xs first in first
  where
    go :: Zipper a -> [a] -> Zipper a -> (Zipper a, Zipper a)
    go prev []     next = (next,prev)
    go prev (x:xs) next =
      let
        this = Zipper prev x rest
        (rest,last) = go this xs next
      in (this,last)

data Result = Result { rcount :: Int, rz :: [Int], rp :: Maybe Result }

instance Eq Result where
  (==) = (==) `on` rcount
instance Ord Result where
  (<=) = (<=) `on` rcount

main = do
  [n, s] <- map read . words <$> getLine
  as <- map read . words <$> getLine :: IO [Int]

  let
    gs = map (map snd) . groupBy ((==) `on` fst) . sort $ zip as [1..]

    r@(Result c _ _) = minimum $ foldl next [Result 0 [s] Nothing] gs
      where
        next rs g = map f . take l . iterate zright $ zipper g
          where
            l = length g
            right = map zhead . take l . iterate zright
            left = map zhead . take l . iterate zleft

            f z@(Zipper (Zipper _ prev _) i (Zipper _ next _)) =
                minimum $ map f' rs
              where
                f' r@(Result c (i':_) _) =
                    min
                      (Result (c + d i' prev + dc i prev) (right z) (Just r))
                      (Result (c + d i' next + dcc i next) (left z) (Just r))
                  where
                    d i j = min d' (n-d') where d' = abs $ i-j
                    dc i j = if i <= j then j-i else j+n-i -- clockwise distance
                    dcc i j = dc j i

    restore = zipWith diff is (tail is)
      where
        diff a b
          | d1 < d2 = if a <= b then d1 else -d1
          | otherwise = if a <= b then -d2 else d2
          where
            d1 = abs (b-a)
            d2 = n - d1

        is = concat . reverse $ unfoldr next (Just r)
          where
            next Nothing = Nothing
            next (Just (Result _ l r)) = Just (reverse l, r)

  print c
  putStr . unlines $ map (\a -> if a >= 0 then "+" ++ show a else show a) restore

import Control.Applicative ((<$>))
import Data.List (groupBy, sort, unfoldr)
import Data.Array (listArray, elems, (!))
import Data.Function (on)

data Zipper a = Zipper { zleft :: Zipper a, zhead :: a, zright :: Zipper a }

zipper :: [a] -> Zipper a
zipper xs =
    let (first,last) = go last xs first in first
  where
    go :: Zipper a -> [a] -> Zipper a -> (Zipper a, Zipper a)
    go prev []     next = (next,prev)
    go prev (x:xs) next =
      let
        this = Zipper prev x rest
        (rest,last) = go this xs next
      in (this,last)

data Result = Result { rcount :: Int, rz :: [Int], rp :: Maybe Result }

instance Eq Result where
  (==) = (==) `on` rcount
instance Ord Result where
  (<=) = (<=) `on` rcount

main = do
  [n, s] <- map read . words <$> getLine
  as <- map read . words <$> getLine :: IO [Int]

  let
    vector l = listArray (1, length l) l

    gs = map (map snd) . groupBy ((==) `on` fst) . sort $ zip as [1..]

    r@(Result c _ _) = minimum $ solve $ reverse gs
      where
        zs g = take (length g) . iterate zright $ zipper g

        d i j = min d' (n-d') where d' = abs $ i-j
        dc i j = if i <= j then j-i else j+n-i -- clockwise distance
        dcc i j = dc j i

        right l = map zhead . take l . iterate zright
        left l = map zhead . take l . iterate zleft

        solve [g] = map f $ zs g
          where
            l = length g
            f z@(Zipper (Zipper _ p _) i (Zipper _ n _)) =
              min
                (Result (d s p + dc i p) (right l z) Nothing)
                (Result (d s n + dcc i n) (left l z) Nothing)

        solve (g:gs) = map f $ zs g
          where
            l = length g
            rs = solve gs

            f z@(Zipper (Zipper _ p _) i (Zipper _ n _)) =
                minimum $ map f' rs
              where
                f' r@(Result c (i':_) _) =
                    min
                      (Result (c + d i' p + dc i p) (right l z) (Just r))
                      (Result (c + d i' n + dcc i n) (left l z) (Just r))
                  where

    restore = zipWith diff is $ tail is
      where
        diff a b
          | d1 < d2 = if a <= b then d1 else -d1
          | otherwise = if a <= b then -d2 else d2
          where
            d1 = abs (b-a)
            d2 = n - d1

    is = (s:) . concat $ reverse $ unfoldr next (Just r)
      where
        next Nothing = Nothing
        next (Just (Result _ l r)) = Just (reverse l, r)

  print c
  -- print gs
  -- print is
  putStr $ unlines $ map (\a -> if a >= 0 then "+" ++ show a else show a) $ restore

import Control.Applicative ((<$>))
import Data.List (groupBy, sort, unfoldr)
import Data.Function (on)

data Zipper a = Zipper { zleft :: Zipper a, zhead :: a, zright :: Zipper a }

zipper :: [a] -> Zipper a
zipper xs =
    let (first,last) = go last xs first in first
  where
    go :: Zipper a -> [a] -> Zipper a -> (Zipper a, Zipper a)
    go prev []     next = (next,prev)
    go prev (x:xs) next =
      let
        this = Zipper prev x rest
        (rest,last) = go this xs next
      in (this,last)

data Result = Result { rcount :: Int, rz :: [Int], rp :: Maybe Result }

instance Eq Result where
  (==) = (==) `on` rcount
instance Ord Result where
  (<=) = (<=) `on` rcount

main = do
  [n, s] <- map read . words <$> getLine
  as <- map read . words <$> getLine :: IO [Int]

  let
    gs = map (map snd) . groupBy ((==) `on` fst) . sort $ zip as [1..]

    r@(Result c _ _) = minimum . solve $ reverse gs
      where
        solve [] = [Result 0 [s] Nothing]
        solve (g:gs) = map f . take l . iterate zright $ zipper g
          where
            l = length g
            right = map zhead . take l . iterate zright
            left = map zhead . take l . iterate zleft
            rs = solve gs

            f z@(Zipper (Zipper _ prev _) i (Zipper _ next _)) =
                minimum $ map f' rs
              where
                f' r@(Result c (i':_) _) =
                    min
                      (Result (c + d i' prev + dc i prev) (right z) (Just r))
                      (Result (c + d i' next + dcc i next) (left z) (Just r))
                  where
                    d i j = min d' (n-d') where d' = abs $ i-j
                    dc i j = if i <= j then j-i else j+n-i -- clockwise distance
                    dcc i j = dc j i

    restore = zipWith diff is $ tail is
      where
        diff a b
          | d1 < d2 = if a <= b then d1 else -d1
          | otherwise = if a <= b then -d2 else d2
          where
            d1 = abs (b-a)
            d2 = n - d1

    is = concat $ reverse $ unfoldr next (Just r)
      where
        next Nothing = Nothing
        next (Just (Result _ l r)) = Just (reverse l, r)

  print c
  putStr $ unlines $ map (\a -> if a >= 0 then "+" ++ show a else show a) $ restore

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.List (groupBy, sort, unfoldr)
import Data.Function (on)

data Zipper a = Zipper { zleft :: Zipper a, zhead :: a, zright :: Zipper a }

zipper :: [a] -> Zipper a
zipper xs =
    let (first,last) = go last xs first in first
  where
    go :: Zipper a -> [a] -> Zipper a -> (Zipper a, Zipper a)
    go prev []     next = (next,prev)
    go prev (x:xs) next =
      let
        this = Zipper prev x rest
        (rest,last) = go this xs next
      in (this,last)

data Result = Result { rcount :: Int, rz :: [Int], rp :: Maybe Result }

instance Eq Result where
  (==) = (==) `on` rcount
instance Ord Result where
  (<=) = (<=) `on` rcount

main = do
  [n, s] <- map read . words <$> getLine
  as <- map read . words <$> getLine :: IO [Int]

  let
    gs = map (map snd) . groupBy ((==) `on` fst) . sort $ zip as [1..]

    r@(Result c _ _) = minimum . solve $ reverse gs
      where
        solve [] = [Result 0 [s] Nothing]
        solve (g:gs) = map f . take l . iterate zright $ zipper g
          where
            l = length g
            right = map zhead . take l . iterate zright
            left = map zhead . take l . iterate zleft
            rs = solve gs

            f z@(Zipper (Zipper _ prev _) i (Zipper _ next _)) =
                minimum $ map f' rs
              where
                f' r@(Result c (i':_) _) =
                    min
                      (Result (c + d i' prev + dc i prev) (right z) (Just r))
                      (Result (c + d i' next + dcc i next) (left z) (Just r))
                  where
                    d i j = min d' (n-d') where d' = abs $ i-j
                    dc i j = if i <= j then j-i else j+n-i -- clockwise distance
                    dcc i j = dc j i

    restore = zipWith diff is (tail is)
      where
        diff a b
          | d1 < d2 = if a <= b then d1 else -d1
          | otherwise = if a <= b then -d2 else d2
          where
            d1 = abs (b-a)
            d2 = n - d1

        is = concat . reverse $ unfoldr next (Just r)
          where
            next Nothing = Nothing
            next (Just (Result _ l r)) = Just (reverse l, r)

  print c
  putStr . unlines $ map (\a -> if a >= 0 then "+" ++ show a else show a) restore

import Control.Applicative ((<$>))
import Data.List (groupBy, sort, unfoldr)
import Data.Array (listArray, elems, (!))

main = do
  [n, s] <- map read . words <$> getLine
  as <- map read . words <$> getLine :: IO [Int]

  let
    gs = map (map snd) . groupBy (\a b -> fst a == fst b) . sort $ zip as [1..]
    m = length gs
    a = listArray (1, m) $ map (\l -> listArray (1, length l) l) gs
    ls = listArray (1, m) $ map length gs

    d i j = min a (n-a) where a = abs $ i - j
    dc i j = if i <= j then j-i else j+n-i -- clockwise
    dcc i j = dc j i

    rs = listArray (1, m) $ map c' [1..m]
      where
        c' i = listArray (1, l) [f i j | j <- [1..l]]
          where
            l = ls!i

        f 1 j = min (d s p1 + dc p p1, False, j, 0) (d s p2 + dcc p p2, True, j, 0)
          where
            p = a!1!j

            l = ls!1

            j1 = (j-2+l) `mod` l + 1
            j2 = j `mod` l + 1

            p1 = a!1!j1
            p2 = a!1!j2

        f i j = minimum $ map f [1..ls!(i-1)]
          where
            f j' = min (c + c1, False, j, j') (c + c2, True, j, j')
              where
                (c, _, _, _) = rs!(i-1)!j'

                p' = a!(i-1)!j'

                c1 = d p' p1 + dc p p1
                c2 = d p' p2 + dcc p p2

            p = a!i!j

            l = ls!i

            j1 = (j-2+l) `mod` l + 1
            j2 = j `mod` l + 1

            p1 = a!i!j1
            p2 = a!i!j2

    r@(c, _, _, _) = minimum [rs!m!j | j <- [1..ls ! m]]

    restore = zipWith diff is $ tail is
      where
        diff a b
          | d1 < d2 = if a <= b then d1 else -d1
          | otherwise = if a <= b then -d2 else d2
          where
            d1 = abs (b-a)
            d2 = n - d1

        is = (s:) . concat $ map list un
        un = reverse $ unfoldr next (m, r)
        next (0, _) = Nothing
        next (i, (_, dir, j, j')) = Just ((i, dir, j), (i-1, rs!(i-1)!j'))

        list (i, dir, j) =
            take l (if dir then drop j es else drop (l-j+1) $ reverse es)
          where
            es = es' ++ es' where es' = elems $ a!i
            l = ls!i

  print c
  putStr $ unlines $ map (\a -> if a >= 0 then "+" ++ show a else show a) $ restore

import Control.Applicative ((<$>))
import Data.List (groupBy, sort, unfoldr)
import Data.Function (on)

data Zipper a = Zipper { zleft :: Zipper a, zhead :: a, zright :: Zipper a }

zipper :: [a] -> Zipper a
zipper xs =
    let (first,last) = go last xs first in first
  where
    go :: Zipper a -> [a] -> Zipper a -> (Zipper a, Zipper a)
    go prev []     next = (next,prev)
    go prev (x:xs) next =
      let
        this = Zipper prev x rest
        (rest,last) = go this xs next
      in (this,last)

data Result = Result { rcount :: Int, rz :: [Int], rp :: Maybe Result }

instance Eq Result where
  (==) = (==) `on` rcount
instance Ord Result where
  (<=) = (<=) `on` rcount

main = do
  [n, s] <- map read . words <$> getLine
  as <- map read . words <$> getLine :: IO [Int]

  let
    gs = map (map snd) . groupBy ((==) `on` fst) . sort $ zip as [1..]

    r@(Result c _ _) = minimum $ foldl next r0 gs
      where
        r0 = [Result 0 [s] Nothing]
        next rs g = map f . take l . iterate zright $ zipper g
          where
            l = length g
            right = map zhead . take l . iterate zright
            left = map zhead . take l . iterate zleft

            f z@(Zipper (Zipper _ prev _) i (Zipper _ next _)) =
                minimum $ map f' rs
              where
                f' r@(Result c (i':_) _) =
                    min
                      (Result (c + d i' prev + dc i prev) (right z) (Just r))
                      (Result (c + d i' next + dcc i next) (left z) (Just r))
                  where
                    d i j = min d' (n-d') where d' = abs $ i-j
                    dc i j = if i <= j then j-i else j+n-i -- clockwise distance
                    dcc i j = dc j i

    restore = zipWith diff is (tail is)
      where
        diff a b
          | d1 < d2 = if a <= b then d1 else -d1
          | otherwise = if a <= b then -d2 else d2
          where
            d1 = abs (b-a)
            d2 = n - d1

        is = concat . reverse $ unfoldr next (Just r)
          where
            next Nothing = Nothing
            next (Just (Result _ l r)) = Just (reverse l, r)

  print c
  putStr . unlines $ map (\a -> if a >= 0 then "+" ++ show a else show a) restore


Oleg the bank client checks share prices every day. There are n share prices he is interested in. Today he observed that each second exactly one of these prices decreases by k rubles (note that each second exactly one price changes, but at different seconds different prices can change). Prices can become negative. Oleg found this process interesting, and he asked Igor the financial analyst, what is the minimum time needed for all n prices to become equal, or it is impossible at all? Igor is busy right now, so he asked you to help Oleg. Can you answer this question?

The first line contains two integers n and k (1 ≤ n ≤ 105, 1 ≤ k ≤ 109) — the number of share prices, and the amount of rubles some price decreases each second. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 109) — the initial prices.

Print the only line containing the minimum number of seconds needed for prices to become equal, of «-1» if it is impossible.

NoteConsider the first example. Suppose the third price decreases in the first second and become equal 12 rubles, then the first price decreases and becomes equal 9 rubles, and in the third second the third price decreases again and becomes equal 9 rubles. In this case all prices become equal 9 rubles in 3 seconds.There could be other possibilities, but this minimizes the time needed for all prices to become equal. Thus the answer is 3.In the second example we can notice that parity of first and second price is different and never changes within described process. Thus prices never can become equal.In the third example following scenario can take place: firstly, the second price drops, then the third price, and then fourth price. It happens 999999999 times, and, since in one second only one price can drop, the whole process takes 999999999 * 3 = 2999999997 seconds. We can note that this is the minimum possible time.

{-# LANGUAGE ScopedTypeVariables #-}

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad.State.Strict
import Data.Int
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

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

main :: IO ()
main = do
    [n, k] <- (map readB8Int) <$> B8.words <$> B8.getLine
    (prices :: [Int64]) <- (map $ fromIntegral . readB8Int) <$> B8.words <$> B8.getLine
    let minPrice = foldr1 min prices
    let possible = all (\price -> (price - minPrice) `mod` (fromIntegral k) == 0) prices
    if not possible
        then printf "-1\n"
        else printf "%lld\n" $ foldr1 (+) $ map (\price -> (price - minPrice) `div` (fromIntegral k)) $ prices

import Control.Applicative( (<$>))
main = do
    [n_, k_] <- map read . words <$> getLine
    as_ <- map (read::String->Integer) . words <$> getLine
    let
	min = minimum as_

	quot' a b =
		    let
			(q,r) = a `quotRem` b
		    in
			if r==0 then Just q else Nothing

	maybeSum sm [] = Just sm
	maybeSum sm (Nothing:_) = Nothing
	maybeSum sm ((Just v):rem) = maybeSum (sm+v) rem

    case maybeSum 0 $ map ((`quot'` k_) . subtract min) as_ of
	Just v	-> print v
	Nothing -> print (-1)

import Data.Functor

posMod x y = mod ((mod x y) + y) y

sol :: Integer -> [Integer] -> Integer
sol k a = sum $ map (`div` k) $ map (+ (-m)) $ a where
  m = foldl1 min a

main = do
  [n, k] <- map read <$> words <$> getLine
  a <- map read <$> words <$> getLine
  putStrLn $ show $
    if and $ map (\x -> x `posMod` k == head a `posMod` k) a then sol k a
    else -1

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (ByteString, getLine)
import qualified Data.ByteString.Char8 as C (readInt, words, reverse, dropWhile, unpack)
import qualified Data.Maybe as M (fromJust)
import Data.Char (isSpace)
import Data.Int (Int64)

readInt :: B.ByteString -> Int64
readInt = fromIntegral . fst . M.fromJust . C.readInt

run k (x:xs) ans | x `mod` k /= 0 = []
                 | otherwise = run k xs (x `div` k:ans)
run k [] ans = ans

g [] = -1
g x = sum $ map (\i -> i - mx) x where mx = minimum x

main = do
    (map readInt . C.words -> [n, k]) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    let mxs = minimum xs
    putStrLn $ show $ g (run k (map (\i -> i - mxs) xs) [])

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words, reverse, dropWhile, unpack)
import qualified Data.Maybe as M (fromJust)
import Data.Char (isSpace)

readInt = fst . M.fromJust . C.readInt

run k (x:xs) ans | x `mod` k /= 0 = []
                 | otherwise = run k xs (x `div` k:ans)
run k [] ans = ans

g :: [Int] -> Int
g [] = -1
g x = sum $ map (\i -> i - (minimum x)) x

main = do
    (map readInt . C.words -> [n, k]) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    putStrLn $ show $ g (run k (map (\i -> i - (minimum xs)) xs) [])

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words, reverse, dropWhile, unpack)
import qualified Data.Maybe as M (fromJust)
import Data.Char (isSpace)

readInt = fst . M.fromJust . C.readInt

run k (x:xs) ans | x `mod` k /= 0 = []
                 | otherwise = run k xs (x `div` k:ans)
run k [] ans = ans

g :: [Int] -> Int
g [] = -1
g x = sum $ map (\i -> i - (minimum x)) x

main = do
    (map readInt . C.words -> [n, k]) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    putStrLn $ show $ g (run k xs [])


One day Nikita found the string containing letters "a" and "b" only. Nikita thinks that string is beautiful if it can be cut into 3 strings (possibly empty) without changing the order of the letters, where the 1-st and the 3-rd one contain only letters "a" and the 2-nd contains only letters "b".Nikita wants to make the string beautiful by removing some (possibly none) of its characters, but without changing their order. What is the maximum length of the string he can get?

The first line contains a non-empty string of length not greater than 5 000 containing only lowercase English letters "a" and "b".

Print a single integer — the maximum possible size of beautiful string Nikita can get.

NoteIt the first sample the string is already beautiful.In the second sample he needs to delete one of "b" to make it beautiful.

{-# 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.Array.Unboxed

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

solve s = maximum [as!(i - 1) + bs!(j - 1) - bs!(i - 1) + as!n - as!(j - 1) | i <- [1..n + 1], j <- [i..n + 1]]
  where
  n = length s
  as = listArray (0, n) $ scanl (+) 0 $ map (fromEnum . (== 'a')) s :: UArray Int Int
  bs = listArray (0, n) $ scanl (+) 0 $ map (fromEnum . (== 'b')) s :: UArray Int Int

import Data.List
import Data.Array
import Data.Ord
import Data.Char

res x=solve x [0,0,0] where
	solve [] v = maximum v
	solve (x:xs) [v1,v2,v3]
		|x=='a' 	= solve xs [v1+1,v2,1+(maximum [v1,v2,v3])]
		|otherwise 	= solve xs [v1,1+ (max v1 v2),v3]
main=interact$show.res.head.lines

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
--import qualified Data.HashTable.IO as B
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

help listA listB maxA = g listB listA
    where f = \(b:xb) (a:xa) -> if null xb then b else max (b+maxA-a)     $ f xb xa
          g = \(b:xb) (a:xa) -> if null xa then a else max (a-b+ f xb xa) $ g xb xa

main :: IO ()
main = do
    str <- getLine
    let tableA = scanl (\x y -> if y=='a' then x+1 else x) 0 str
        tableB = scanl (\x y -> if y=='b' then x+1 else x) 0 str
    print $ help tableA tableB $ maximum tableA

--индексиране на памет
-- $! синтаксис
--fmap
{-main :: IO ()
main = do
    print 3
    where gg=H.fromList-}

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
import Data.Bits
import qualified Data.Set as Set
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

readInts64 :: IO [Int64]
readInts64 = fmap (map (foldl' (\x y -> 10*x + (fromInteger . toInteger . digitToInt $ y)) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

help listA listB maxA = g listB listA
    where f = \(b:xb) (a:xa) -> if null xb then b else max (b+maxA-a)     $ f xb xa
          g = \(b:xb) (a:xa) -> if null xa then a else max (a-b+(f xb xa)) $ g xb xa

main :: IO ()
main = do
    str <- getLine
    let tableA = scanl (\x y -> if y=='a' then x+1 else x) 0 str
        tableB = scanl (\x y -> if y=='b' then x+1 else x) 0 str
        m = maximum tableA
    print $ help tableA tableB m

--kind
--по-бавно решение с глобален параметър
--индексиране на памет
--dolna granica na slojnost

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
--import qualified Data.HashTable.IO as B
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

f :: [Int] -> [Int] -> Int -> Int
f [x] _ _= x
f (b:xb) (a:xa) maxA= max (b+maxA-a) $ f xb xa maxA

g :: [Int] -> [Int] -> Int -> Int
g [x] _ _ = x
g (a:xa) (b:xb) maxA = max (a+rec-b) $ g xa xb maxA
    where rec= f xb xa maxA

main :: IO ()
main = do
    str <- getLine
    let tableA = scanl (\x y -> if y=='a' then x+1 else x) 0 str
        maxA = maximum tableA
        tableB = scanl (\x y -> if y=='b' then x+1 else x) 0 str
    print $ g tableA tableB maxA

--индексиране на памет
-- $! синтаксис
--fmap
{-main :: IO ()
main = do
    print 3
    where gg=H.fromList-}

import Data.List
import Data.Char

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

f :: [Int] -> [Int] -> Int -> Int
f [x] _ _= x
f (b:xb) (a:xa) maxA= max (b+maxA-a) $ f xb xa maxA

help :: [Int] -> [Int] -> Int -> Int
help [x] _ _ = x
help (a:xa) (b:xb) maxA = max (a-b + f xb xa maxA) $ help xa xb maxA

{-help listA listB maxA = g listB listA
    where f = \(b:xb) (a:xa) -> if null xb then b else max (b+maxA-a)     $ f xb xa
          g = \(b:xb) (a:xa) -> if null xa then a else max (a-b+(f xb xa)) $ g xb xa
-}

main :: IO ()
main = do
    str <- getLine
    let tableA = scanl (\x y -> if y=='a' then x+1 else x) 0 str
        tableB = scanl (\x y -> if y=='b' then x+1 else x) 0 str
        m = maximum tableA
    print $ help tableA tableB m

{-# 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.Array.Unboxed

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

solve s = maximum [as!(i - 1) + bs!j - bs!i + as!n - as!(j - 1) | i <- [1..n], j <- [i..n]]
  where
  n = length s
  as = listArray (0, n) $ scanl (+) 0 $ map (fromEnum . (== 'a')) s :: UArray Int Int
  bs = listArray (0, n) $ scanl (+) 0 $ map (fromEnum . (== 'b')) s :: UArray Int Int

{-# 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.Array.Unboxed

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

solve s = maximum [as!(i - 1) + bs!(j - 1) - bs!(i - 1) + as!n - as!(j - 1) | i <- [1..n], j <- [i..n]]
  where
  n = length s
  as = listArray (0, n) $ scanl (+) 0 $ map (fromEnum . (== 'a')) s :: UArray Int Int
  bs = listArray (0, n) $ scanl (+) 0 $ map (fromEnum . (== 'b')) s :: UArray Int Int

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
--import qualified Data.HashTable.IO as B
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

createTable :: Char -> [(Char,Int)] -> [(Char,Int)]
createTable element [] = [(element,1)]
createTable element list@((x,y):xs)
    | x /= element = (element,1):list
    | otherwise = (x,y+1):xs

forSplit :: Int -> Int -> [(Char,Int)] -> [([(Char,Int)],[(Char,Int)])]
forSplit i n list
    | i>=n = []
    | otherwise = splitAt i list : forSplit (i+1) n list

compareA (x,x1) (y,y1)
    | x == y = compare x1 y1
    | x == 'a' = GT
    | otherwise = LT

compareB (x,x1) (y,y1)
    | x == y = compare x1 y1
    | x == 'a' = LT
    | otherwise = GT

help :: [(Char,Int)]->((Char,Int),(Char,Int)) -> Int
help _ ((x,_),(y,_))
    | x=='b' || y=='b' =0
help list ((x,x1),(y,y1)) = x1+y1+(if l=='a' then 0 else r)
    where temp1 = dropWhile (/= (x,x1)) list
          temp  = dropWhileEnd (/= (y,y1)) temp1
          (l,r) = maximumBy compareB temp

main :: IO ()
main = do
    str <- getLine
    let table = foldr createTable [] str
        maxA = checkA $ maximumBy compareA table
        maxB = checkB $ maximumBy compareB table
    print $ foldl max (maxA+maxB) . map (help table) . map (\(x,y)->(func x,func y)) $ forSplit 1 (length table) table
    where checkA (a,b) = if a=='a' then b else 0
          checkB (a,b) = if a=='b' then b else 0
          func = maximumBy compareA

--индексиране на памет
-- $! синтаксис
--fmap
{-main :: IO ()
main = do
    print 3
    where gg=H.fromList-}


You invited $$$n$$$ guests to dinner! You plan to arrange one or more circles of chairs. Each chair is going to be either occupied by one guest, or be empty. You can make any number of circles. Your guests happen to be a little bit shy, so the $$$i$$$-th guest wants to have a least $$$l_i$$$ free chairs to the left of his chair, and at least $$$r_i$$$ free chairs to the right. The "left" and "right" directions are chosen assuming all guests are going to be seated towards the center of the circle. Note that when a guest is the only one in his circle, the $$$l_i$$$ chairs to his left and $$$r_i$$$ chairs to his right may overlap.What is smallest total number of chairs you have to use?

First line contains one integer $$$n$$$  — number of guests, ($$$1 \leqslant n \leqslant 10^5$$$).  Next $$$n$$$ lines contain $$$n$$$ pairs of space-separated integers $$$l_i$$$ and $$$r_i$$$ ($$$0 \leqslant l_i, r_i \leqslant 10^9$$$).

Output a single integer — the smallest number of chairs you have to use.

NoteIn the second sample the only optimal answer is to use two circles: a circle with $$$5$$$ chairs accomodating guests $$$1$$$ and $$$2$$$, and another one with $$$10$$$ chairs accomodationg guests $$$3$$$ and $$$4$$$.In the third sample, you have only one circle with one person. The guest should have at least five free chairs to his left, and at least six free chairs to his right to the next person, which is in this case the guest herself. So, overall number of chairs should be at least 6+1=7.

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

readIntBS = fst . fromJust . BS.readInt

main = do
  n <- readLn :: IO Integer
  [l,r] <- transpose . map (map (fromIntegral . readIntBS) . BS.words) . BS.lines <$> BS.getContents :: IO [[Integer]]

  print $ n + sum (zipWith max (sort l) (sort r))

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

readIntBS = fst . fromJust . BS.readInt

main = do
  n <- readLn :: IO Int
  [l,r] <- transpose . map (map readIntBS . BS.words) . BS.lines <$> BS.getContents :: IO [[Int]]

  print $ n + sum (zipWith max (sort l) (sort r))


Eudokimus, a system administrator is in trouble again. As a result of an error in some script, a list of names of very important files has been damaged. Since they were files in the BerFS file system, it is known that each file name has a form "name.ext", where:   name is a string consisting of lowercase Latin letters, its length is from 1 to 8 characters;  ext is a string consisting of lowercase Latin letters, its length is from 1 to 3 characters. For example, "read.me", "example.txt" and "b.cpp" are valid file names and "version.info", "ntldr" and "contestdata.zip" are not.Damage to the list meant that all the file names were recorded one after another, without any separators. So now Eudokimus has a single string.Eudokimus needs to set everything right as soon as possible. He should divide the resulting string into parts so that each part would be a valid file name in BerFS. Since Eudokimus has already proved that he is not good at programming, help him. The resulting file list can contain the same file names.

The input data consists of a single string s, its length is from 1 to 4·105 characters. The string can contain only lowercase Latin letters ('a' - 'z') and periods ('.').

In the first line print "YES" (without the quotes), if it is possible to divide s into parts as required. In this case, the following lines should contain the parts of the required partition, one per line in the order in which they appear in s. The required partition can contain the same file names. If there are multiple solutions, print any of them. If the solution does not exist, then print in a single line "NO" (without the quotes).

import Data.List

between n x m = n <= x && x <= m

candivide ws = let h = head ws
                   l = last ws
                   ws' = init (tail ws)
               in between 1 (length h) 8 &&
                  between 1 (length l) 3 &&
                  all (\x -> between 2 (length x) 11) ws'

divide cs | length cs <= 3 = [take (length cs - 1) cs, drop (length cs - 1) cs]
          | otherwise      = [take 3 cs, drop 3 cs]

concat_words [] = []
concat_words (x:y:xs) = (x ++ "." ++ y) : concat_words xs

find_dot [] = []
find_dot ('.':cs) = split_dot cs

split_dot cs = let (word, rest) = break (== '.') cs
               in word : find_dot rest

main = do s <- getLine
          let a = split_dot s
              h  = head a
              l  = last a
              ws = init (tail a)
          let divided = [h] ++ concatMap divide ws ++ [l]
          let concated = concat_words divided
          if length a < 2 then putStrLn "NO"
                          else if candivide a then do putStrLn "YES"
                                                      mapM_ putStrLn concated
                                              else putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Char
import Data.Maybe

import qualified Data.ByteString.Char8 as B

solve s =
		if not $ length ss >= 2 && (let l = B.length (head ss) in 1 <= l && l <= 8) &&
				(let l = B.length (last ss) in 1 <= l && l <= 3) &&
				all (\l → 2 <= B.length l && B.length l <= 11) (tail (init ss))
			then Nothing
		else
			Just $ recombine ss'

	where
		ss = B.split '.' s
		ss' = [head ss] ++
			(concat $ map (\s → let (a, b) = B.splitAt (min 3 (B.length s - 1)) s in [a, b]) (tail (init ss))) ++
			[last ss]

		recombine [] = []
		recombine xs = ((xs !! 0) `B.append` (B.pack ".") `B.append` (xs !! 1)) : (recombine (tail (tail xs)))

main = do
	s ← B.getLine
	let r = solve $ fst $ B.breakEnd (not . isSpace) s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ B.putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

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

split c s = word : find c rest
	where
		(word, rest) = break (== c) s

		find c [] = []
		find c s = split c $ tail s

between a b c = a <= c && c <= b

solve s =
		if length ss >= 2 &&
				(between 1 8 $ length $ head ss) &&
				(between 1 3 $ length $ last ss) &&
				all (between 2 11 . length) (tail $ init ss)
			then Just $ recombine ss'
			else Nothing

	where
		ss = split '.' s
		ss' = head ss :
			(concatMap (\s → let (a, b) = splitAt (min 3 $ length s - 1) s in [a, b]) $ tail $ init ss) ++
			[last ss]

		recombine [] = []
		recombine (x:y:xs) = (x ++ "." ++ y) : recombine xs

trim = f . f
	where
		f = reverse . dropWhile isSpace

main = do
	s ← trim <$> getLine
	let r = solve s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

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

split c s = word : find c rest
	where
		(word, rest) = break (== c) s

		find c [] = []
		find c s = split c $ tail s

between a b c = a <= c && c <= b

solve s =
		if length ss >= 2 &&
				(between 1 8 $ length $ head ss) &&
				(between 1 3 $ length $ last ss) &&
				all (between 2 11 . length) (tail $ init ss)
			then Just $ recombine ss'
			else Nothing

	where
		ss = split '.' s
		ss' = head ss :
			(concatMap (\s → let (a, b) = splitAt (min 3 $ length s - 1) s in [a, b]) $ tail $ init ss) ++
			[last ss]

		recombine [] = []
		recombine (x:y:xs) = (x ++ "." ++ y) : recombine xs

main = do
	s ← getLine
	let r = solve s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

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

split x xs = split' xs
	where
		split' xs = xs' : if null xs'' then [] else split' $ tail xs''
			where
				(xs', xs'') = break (== x) xs

between a b c = a <= c && c <= b

solve s =
		if length ss >= 2 &&
				(between 1 8 $ length $ head ss) &&
				(between 1 3 $ length $ last ss) &&
				all (between 2 11 . length) (tail $ init ss)
			then Just $ recombine ss'
			else Nothing

	where
		ss = split '.' s
		ss' = head ss :
			(concatMap (\s → let (a, b) = splitAt (min 3 $ length s - 1) s in [a, b]) $ tail $ init ss) ++
			[last ss]

		recombine [] = []
		recombine (x:y:xs) = (x ++ "." ++ y) : recombine xs

main = do
	s ← getLine
	let r = solve s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

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

split x xs = split' xs
	where
		split' xs = xs' : split'' xs''
			where
				(xs', xs'') = break (== x) xs

		split'' [] = []
		split'' xs = split' $ tail xs

between a b c = a <= c && c <= b

solve s =
		if length ss >= 2 &&
				(between 1 8 $ length $ head ss) &&
				(between 1 3 $ length $ last ss) &&
				all (between 2 11 . length) (tail $ init ss)
			then Just $ recombine ss'
			else Nothing

	where
		ss = split '.' s
		ss' = head ss :
			(concatMap (\s → let (a, b) = splitAt (min 3 $ length s - 1) s in [a, b]) $ tail $ init ss) ++
			[last ss]

		recombine [] = []
		recombine (x:y:xs) = (x ++ "." ++ y) : recombine xs

main = do
	s ← getLine
	let r = solve s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Char
import Data.Maybe

import qualified Data.ByteString.Char8 as B

solve s =
		if not $ length ss >= 2 &&
				(let l = B.length (head ss) in 1 <= l && l <= 8) &&
				(let l = B.length (last ss) in 1 <= l && l <= 3) &&
				all (\l → 2 <= B.length l && B.length l <= 11) (tail $ init ss)
			then Nothing
		else
			Just $ recombine ss'

	where
		ss = B.split '.' s
		ss' = head ss :
			(concat $ map (\s → let (a, b) = B.splitAt (min 3 $ B.length s - 1) s in [a, b]) (tail $ init ss)) ++
			[last ss]

		recombine [] = []
		recombine xs = (xs !! 0 `B.append` B.pack "." `B.append` (xs !! 1)) : (recombine $ tail $ tail xs)

trim = f . f
	where
		f = B.reverse . B.dropWhile isSpace

main = do
	s ← trim <$> B.getLine
	let r = solve s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ B.putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

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

split x xs = split' xs
	where
		split' xs = xs' : if null xs'' then [] else split' $ tail xs''
			where
				(xs', xs'') = break (== x) xs

between a b c = a <= c && c <= b

solve s =
		if length ss >= 2 &&
				(between 1 8 $ length $ head ss) &&
				(between 1 3 $ length $ last ss) &&
				all (between 2 11 . length) (tail $ init ss)
			then Just $ join $ [head ss] ++ (concatMap splitJoined $ tail $ init ss) ++ [last ss]
			else Nothing

	where
		ss = split '.' s

		splitJoined s = [a, b]
			where
				(a, b) = splitAt (min 3 $ length s - 1) s

		join [] = []
		join (x:y:xs) = (x ++ "." ++ y) : join xs

main = do
	s ← getLine
	let r = solve s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ putStrLn $ fromJust r
		else
			putStrLn "NO"

maxLengthName  =  8
maxLengthExt  =  3

solve :: String -> Maybe [String]
solve ""  =  Nothing
solve line  =  res >>= return . reverse . (map (\(name, ext) -> name ++ "." ++ ext))
  where
    res  =  f (Just []) "" line
    f :: Maybe [(String, String)] -> String -> String -> Maybe [(String, String)]
    f (Just []) "" ""  =  Nothing
    f (Just []) "" ('.' : _)  =  Nothing
    f (Just []) acc ""  =  Nothing
    f (Just []) acc ('.' : s)  =  f (Just [(acc, "")]) "" s
    f (Just []) acc (c : s)
      | length acc' > maxLengthName  =  Nothing
      | otherwise  =  f (Just []) acc' s
      where
        acc'  =  acc ++ [c]
    f (Just ((n, _):fs)) "" ""  =  Nothing
    f (Just ((n, _):fs)) "" ('.' : _)  =  Nothing
    f (Just ((n, _):fs)) "" (c : s)  =  f (Just ((n, ""):fs)) [c] s
    f (Just ((n, _):fs)) acc ""
      | length acc > maxLengthExt  =  Nothing
      | otherwise  =  Just ((n, acc):fs)
    f (Just ((n, _):fs)) acc ('.' : s)
      | length acc < 2  =  Nothing
      | otherwise  =  f (Just ((n', "") : (n, e') : fs)) "" s
      where
        (e', n')  =  if length acc <= maxLengthExt
                        then splitAt 1 acc
                        else splitAt 3 acc
    f (Just ((n, _):fs)) acc (c : s)
      | length acc' > maxLengthName + maxLengthExt  =  Nothing
      | otherwise  =  f (Just ((n, ""):fs)) acc' s
      where
        acc'  =  acc ++ [c]

printAns :: Maybe [String] -> IO ()
printAns Nothing  =  putStrLn "NO"
printAns (Just fs)  =  putStrLn "YES" >> mapM_ putStrLn fs

main :: IO ()
main  =  getLine >>= printAns . solve

import Data.List

main=interact$solve.parse

solve :: [String] -> String
solve (s:ss)
  | isValid (s:ss) = "YES\n" ++ intercalate "." ( (s: (map part$init ss)) ++ [last ss])
  | otherwise      = "NO\n"
solve _ = "NO\n"

part :: String -> String
part (a:b:c:d:e)=[a,b,c]++"\n"++d:e
part [a,b,c]=[a,b]++"\n"++[c]
part [a,b]=[a]++"\n"++[b]

parse :: String -> [String]
parse = lines.map f
   where f '.'='\n'
         f c = c

isValid :: [String] -> Bool
isValid [] = False
isValid (s:ss) = isValidName s && isValid' ss
isValid' [] = False
isValid' [s] = isValidExt s
isValid' (s:ss) = isValidNameExt s && isValid' ss

isValidName s = let l = length s
                in 1<=l && l<=8
isValidExt s = let l = length s
               in 1<=l && l<=3
isValidNameExt s = let l = length s
                   in 2<=l && l<=11

import Data.List

between n x m = n <= x && x <= m

candivide ws = let h = head ws
                   l = last ws
                   ws' = init (tail ws)
               in between 1 (length h) 8 &&
                  between 1 (length l) 3 &&
                  all (\x -> between 2 x 11) ws'

divide cs | length cs <= 3 = [take (length cs - 1) cs, drop (length cs - 1) cs]
          | otherwise      = [take 3 cs, drop 3 cs]

concat_words [] = []
concat_words (x:y:xs) = (x ++ "." ++ y) : concat_words xs

main = do s <- getLine
          let a = words [ if c == '.' then ' ' else c | c <- s]
              h  = head a
              l  = last a
              ws = init (tail a)
          let divided = [h] ++ concatMap divide ws ++ [l]
          let concated = concat_words divided
          mapM_ putStrLn concated

import Data.List

between n x m = n <= x && x <= m

candivide ws = let h = head ws
                   l = last ws
                   ws' = init (tail ws)
               in between 1 (length h) 8 &&
                  between 1 (length l) 3 &&
                  all (\x -> between 2 (length x) 11) ws'

divide cs | length cs <= 3 = [take (length cs - 1) cs, drop (length cs - 1) cs]
          | otherwise      = [take 3 cs, drop 3 cs]

concat_words [] = []
concat_words (x:y:xs) = (x ++ "." ++ y) : concat_words xs

main = do s <- getLine
          let a = words [ if c == '.' then ' ' else c | c <- s]
              h  = head a
              l  = last a
              ws = init (tail a)
          let divided = [h] ++ concatMap divide ws ++ [l]
          let concated = concat_words divided
          if candivide a then do putStrLn "YES"
                                 mapM_ putStrLn concated
                         else putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Maybe

import qualified Data.ByteString.Char8 as B

solve s =
		if not $ B.length (head ss) <= 8 && B.length (last ss) <= 3 &&
				all (\l → 2 <= B.length l && B.length l <= 11) (tail (init ss))
			then Nothing
		else
			Just $ recombine ss'

	where
		ss = B.split '.' s
		ss' = [head ss] ++
			(concat $ map (\s → let (a, b) = B.splitAt ((min 3 (B.length s - 1)) - 1) s in [a, b]) (tail (init ss))) ++
			[last ss]

		recombine [] = []
		recombine xs = ((xs !! 0) `B.append` (B.pack ".") `B.append` (xs !! 1)) : (recombine (tail (tail xs)))

main = do
	s ← B.getLine
	let r = solve s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ B.putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

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

split c = unfoldr $ \l ->
  if null l
  	then Nothing
	else Just $ second (drop 1) $ break (== c) l

solve s =
		if length ss >= 2 &&
				(let l = length $ head ss in 1 <= l && l <= 8) &&
				(let l = length $ last ss in 1 <= l && l <= 3) &&
				all (\s → let l = length s in 2 <= l && l <= 11) (tail $ init ss)
			then Just $ recombine ss'
			else Nothing

	where
		ss = split '.' s
		ss' = head ss :
			(concat $ map (\s → let (a, b) = splitAt (min 3 $ length s - 1) s in [a, b]) $ tail $ init ss) ++
			[last ss]

		recombine [] = []
		recombine xs = (xs !! 0 ++ "." ++ (xs !! 1)) : (recombine $ tail $ tail xs)

trim = f . f
	where
		f = reverse . dropWhile isSpace

main = do
	s ← trim <$> getLine
	let r = solve s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Char
import Data.Maybe

import qualified Data.ByteString.Char8 as B

solve s =
		if not $ B.length (head ss) <= 8 && B.length (last ss) <= 3 &&
				all (\l → 2 <= B.length l && B.length l <= 11) (tail (init ss))
			then Nothing
		else
			Just $ recombine ss'

	where
		ss = B.split '.' s
		ss' = [head ss] ++
			(concat $ map (\s → let (a, b) = B.splitAt ((min 3 (B.length s - 1)) - 1) s in [a, b]) (tail (init ss))) ++
			[last ss]

		recombine [] = []
		recombine xs = ((xs !! 0) `B.append` (B.pack ".") `B.append` (xs !! 1)) : (recombine (tail (tail xs)))

main = do
	s ← B.getLine
	let r = solve $ fst $ B.breakEnd (not . isSpace) s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ B.putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Maybe

import qualified Data.ByteString.Char8 as B

solve s =
		if not $ B.length (head ss) <= 8 && B.length (last ss) <= 3 &&
				all (\l → 2 <= B.length l && B.length l <= 11) (tail (init ss))
			then Nothing
		else
			Just $ recombine ss'

	where
		ss = B.split '.' s
		ss' = [head ss] ++
			(concat $ map (\s → let (a, b) = B.splitAt (min 8 (B.length s - 1)) s in [a, b]) (tail (init ss))) ++
			[last ss]

		recombine [] = []
		recombine xs = ((xs !! 0) `B.append` (B.pack ".") `B.append` (xs !! 1)) : (recombine (tail (tail xs)))

main = do
	s ← B.getLine
	let r = solve s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ B.putStrLn $ fromJust r
		else
			putStrLn "NO"

{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Char
import Data.Maybe

import qualified Data.ByteString.Char8 as B

solve s =
		if not $ length ss >= 2 && (let l = B.length (head ss) in 1 <= l && l <= 8) &&
				(let l = B.length (last ss) in 1 <= l && l <= 3) &&
				all (\l → 2 <= B.length l && B.length l <= 11) (tail (init ss))
			then Nothing
		else
			Just $ recombine ss'

	where
		ss = B.split '.' s
		ss' = [head ss] ++
			(concat $ map (\s → let (a, b) = B.splitAt ((min 3 (B.length s - 1)) - 1) s in [a, b]) (tail (init ss))) ++
			[last ss]

		recombine [] = []
		recombine xs = ((xs !! 0) `B.append` (B.pack ".") `B.append` (xs !! 1)) : (recombine (tail (tail xs)))

main = do
	s ← B.getLine
	let r = solve $ fst $ B.breakEnd (not . isSpace) s
	if isJust r
		then do
			putStrLn "YES"
			mapM_ B.putStrLn $ fromJust r
		else
			putStrLn "NO"

import Data.List

main=interact$solve.parse

solve :: [String] -> String
solve (s:ss)
  | isValid (s:ss) = "YES\n" ++ intercalate "." ( (s: (map part$init ss)) ++ [last ss])
  | otherwise      = "NO\n"
solve _ = "NO\n"

part :: String -> String
part (a:b:c:d:e)=[a,b,c]++"\n"++d:e
part (a:b:c:d)=[a,b]++"\n"++c:d
part (a:b:c)=[a]++"\n"++b:c

parse :: String -> [String]
parse = words.map f
   where f '.'=' '
         f c = c

isValid :: [String] -> Bool
isValid (s:ss) = isValidName s && isValid' ss
isValid _ = False
isValid' [] = False
isValid' [s] = isValidExt s
isValid' (s:ss) = isValidNameExt s && isValid' ss

isValidName s = let l = length s
                in 1<=l && l<=8
isValidExt s = let l = length s
               in 1<=l && l<=3
isValidNameExt s = let l = length s
                   in 2<=l && l<=11


Little Vasya had n boxes with balls in the room. The boxes stood in a row and were numbered with numbers from 1 to n from left to right.Once Vasya chose one of the boxes, let's assume that its number is i, took all balls out from it (it is guaranteed that this box originally had at least one ball), and began putting balls (one at a time) to the boxes with numbers i + 1, i + 2, i + 3 and so on. If Vasya puts a ball into the box number n, then the next ball goes to box 1, the next one goes to box 2 and so on. He did it until he had no balls left in his hands. It is possible that Vasya puts multiple balls to the same box, and it is also possible that one or more balls will go to the box number i. If i = n, Vasya puts the first ball into the box number 1, then the next ball goes to box 2 and so on. For example, let's suppose that initially Vasya had four boxes, and the first box had 3 balls, the second one had 2, the third one had 5 and the fourth one had 4 balls. Then, if i = 3, then Vasya will take all five balls out of the third box and put them in the boxes with numbers: 4, 1, 2, 3, 4. After all Vasya's actions the balls will lie in the boxes as follows: in the first box there are 4 balls, 3 in the second one, 1 in the third one and 6 in the fourth one.At this point Vasya has completely forgotten the original arrangement of the balls in the boxes, but he knows how they are arranged now, and the number x — the number of the box, where he put the last of the taken out balls.He asks you to help to find the initial arrangement of the balls in the boxes.

The first line of the input contains two integers n and x (2 ≤ n ≤ 105, 1 ≤ x ≤ n), that represent the number of the boxes and the index of the box that got the last ball from Vasya, correspondingly. The second line contains n space-separated integers a1, a2, ..., an, where integer ai (0 ≤ ai ≤ 109, ax ≠ 0) represents the number of balls in the box with index i after Vasya completes all the actions.  Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

Print n integers, where the i-th one represents the number of balls in the box number i before Vasya starts acting. Separate the numbers in the output by spaces. If there are multiple correct solutions, you are allowed to print any of them.

import Data.List
import Data.Maybe
import Data.Int
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  [n, x] <- fmap parse C.getLine
  a <- fmap (map fromIntegral . parse) C.getLine
  let m = minimum a :: Int64
      t = x - 1
      (l, r) = span (<=t) $ elemIndices m a
      s = head $ reverse l ++ reverse r
      b =
        if s <= t
          then [if s < i && i <= t then m + 1 else m | i <- [0 .. n - 1]]
          else [if i <= t || i > s then m + 1 else m | i <- [0 .. n - 1]]
      b' = [e - if i == s then sum b else 0 | (i, e) <- zip [0 ..] b]
  putStrLn $ unwords $ map show $ zipWith (-) a b'
  where
    parse = map (fst . fromJust . C.readInt) . C.words

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

main :: IO ()
main = do
  [n, x] <- fmap parse C.getLine
  a <- fmap parse C.getLine
  let m = minimum a
      t = x - 1
      (l, r) = span (<=t) $ elemIndices m a
      s = head $ reverse l ++ reverse r
      b =
        if s <= t
          then [if s < i && i <= t then m + 1 else m | i <- [0 .. n - 1]]
          else [if i <= t || i > s then m + 1 else m | i <- [0 .. n - 1]]
      b' = [e - if i == s then sum b else 0 | (i, e) <- zip [0 ..] b]
  putStrLn $ unwords $ map show $ zipWith (-) a b'
  where
    parse = map (fst . fromJust . C.readInt) . C.words


«Polygon» is a system which allows to create programming tasks in a simple and professional way. When you add a test to the problem, the corresponding form asks you for the test index. As in most cases it is clear which index the next test will have, the system suggests the default value of the index. It is calculated as the smallest positive integer which is not used as an index for some previously added test.You are to implement this feature. Create a program which determines the default index of the next test, given the indexes of the previously added tests.

The first line contains one integer n (1 ≤ n ≤ 3000) — the amount of previously added tests. The second line contains n distinct integers a1, a2, ..., an (1 ≤ ai ≤ 3000) — indexes of these tests.

Output the required default value for the next test index.

import List
main = getLine >> fmap (map read . words) getLine >>= putStr . show . head . ([1 ..] \\)

import Data.List
main = do getLine >> fmap (map read . words) getLine >>= putStr . show . head . ([1 ..] \\)

import Data.List (sort)

main = do
  n <- getLine
  l <- getLine
  let a = sort $ readInt l
  putStrLn . show $ count a 1

readInt :: String -> [Int]
readInt l = map read (words l)

count :: [Int] -> Int -> Int
count [] y = y
count (x:xs) y = if x == y then count xs (y + 1) else y

import List

solve :: [Int] -> Int
solve xs  =  solve' 1 (sort xs)
  where
    solve' n []  =  n
    solve' n (m:xs)
      | n == m  =  solve' (n+1) xs
      | otherwise  =  n

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

solve :: [Int] -> Int
solve xs = head . filter (\x -> not $ x `elem` xs) $ [1..]
main = getLine >> fmap (map read . words) getLine >>= print . solve

main :: IO()
main = do
  _ <- getLine
  lines <- getLine
  print $ gao $ map read $ words lines

gao :: [Int] -> Int
gao a = if null lst then 1 else succ $ last lst
  where lst = takeWhile (`elem` a) [1..]

import Data.List

main :: IO()
main = do
  _ <- getLine
  lines <- getLine
  print $ gao $ map read $ words lines

gao :: [Int] -> Int
gao a = head $ [1..] \\ a

{-gao :: [Int] -> Int-}
{-gao a = if null lst then 1 else succ $ last lst-}
  {-where lst = takeWhile (`elem` a) [1..]-}

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

main :: IO ()
main = do
  n  <- readLn
  xs <- zip [1 ..] . sort . take n . map read . words <$> getLine
  print . maybe (n + 1) (+ 1) $ findIndex (uncurry (/=)) xs

import List

next c []              = c
next c (x:xs) | c < x  = c
next c (x:xs) | c == x = next (c + 1) xs

main = do
  n <- readInt
  s <- getLine
  putStrLn $ show $ next 1 (sort $ list $ words $ s)

  where
  list []     = []
  list (c:cs) = (read c :: Int) : list cs

  readInt :: IO Int
  readInt = readLn

import List

main = getLine >> getLine >>=
       \s -> putStrLn $ show $ head $ [1..] \\ (sort . map read . words) s

import List

main = do
    n <- (readLn :: IO Int)
    s <- getLine
    putStrLn $ show $ head $ [1..] \\
               (sort $ map (read :: String -> Int) $ words $ s)

import Control.Applicative
import Data.List
import Data.Char
import Data.Array

main= do
	 n<- read <$> getLine ::IO Int
	 s<- map read. words <$> getLine ::IO [Int]
	 let a = accumArray  (||) (False) (1,n) $ zip (filter (<=n) s) (repeat True)
	 print $ 1 + ( length ( takeWhile id ( elems a)))

import Control.Monad(liftM)
import Data.List(sort)

main = do getLine
          nums <- liftM (zip [1..] . sort . map read . words) getLine
          let nums' = dropWhile (uncurry (==)) nums
              ans = if null nums'
                     then
                        length nums + 1
                     else
                        fst (head nums')
          print ans

import Control.Applicative
import Data.List
import Data.Char
import Data.Array

main= do
	 n<- read <$> getLine ::IO Int
	 s<- map read. words <$> getLine ::IO [Int]
	 let a = accumArray  (||) (False) (1,n) $ zip (takeWhile (<=n) s) (repeat True)
	 print $ 1 + ( length ( takeWhile id ( elems a)))


Polycarp has recently created a new level in this cool new game Berlio Maker 85 and uploaded it online. Now players from all over the world can try his level.All levels in this game have two stats to them: the number of plays and the number of clears. So when a player attempts the level, the number of plays increases by $$$1$$$. If he manages to finish the level successfully then the number of clears increases by $$$1$$$ as well. Note that both of the statistics update at the same time (so if the player finishes the level successfully then the number of plays will increase at the same time as the number of clears).Polycarp is very excited about his level, so he keeps peeking at the stats to know how hard his level turns out to be.So he peeked at the stats $$$n$$$ times and wrote down $$$n$$$ pairs of integers — $$$(p_1, c_1), (p_2, c_2), \dots, (p_n, c_n)$$$, where $$$p_i$$$ is the number of plays at the $$$i$$$-th moment of time and $$$c_i$$$ is the number of clears at the same moment of time. The stats are given in chronological order (i.e. the order of given pairs is exactly the same as Polycarp has written down).Between two consecutive moments of time Polycarp peeked at the stats many players (but possibly zero) could attempt the level.Finally, Polycarp wonders if he hasn't messed up any records and all the pairs are correct. If there could exist such a sequence of plays (and clears, respectively) that the stats were exactly as Polycarp has written down, then he considers his records correct.Help him to check the correctness of his records.For your convenience you have to answer multiple independent test cases.

The first line contains a single integer $$$T$$$ $$$(1 \le T \le 500)$$$ — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 100$$$) — the number of moments of time Polycarp peeked at the stats. Each of the next $$$n$$$ lines contains two integers $$$p_i$$$ and $$$c_i$$$ ($$$0 \le p_i, c_i \le 1000$$$) — the number of plays and the number of clears of the level at the $$$i$$$-th moment of time. Note that the stats are given in chronological order.

For each test case print a single line. If there could exist such a sequence of plays (and clears, respectively) that the stats were exactly as Polycarp has written down, then print "YES". Otherwise, print "NO". You can print each letter in any case (upper or lower).

NoteIn the first test case at the third moment of time the number of clears increased but the number of plays did not, that couldn't have happened.The second test case is a nice example of a Super Expert level.In the third test case the number of plays decreased, which is impossible.The fourth test case is probably an auto level with a single jump over the spike.In the fifth test case the number of clears decreased, which is also impossible.Nobody wanted to play the sixth test case; Polycarp's mom attempted it to make him feel better, however, she couldn't clear it.

analyze :: [[Int]] -> Bool
analyze [] = True
analyze (x:y:xs) = px >= cx && pVar >= 0 && cVar >= 0 && cVar <= pVar && analyze (y:xs)
    where
        (px, cx, py, cy) = (head x, x !! 1, head y, y !! 1)
        (pVar, cVar) = (py - px, cy - cx)
analyze (x:xs) = head x >= (x !! 1) && analyze xs

solve :: IO ()
solve = do
    n <- getLine >>= \v -> return (read v :: Int)
    let inps = getLine >>= \v -> return [read n :: Int | n <- (words v)]
    inps' <- sequence (take n $ repeat inps)
    let out = if analyze inps' then "YES" else "NO"
    putStrLn out

main :: IO ()
main = do
    t <- getLine >>= \v -> return (read v :: Int)
    sequence $ take t (repeat solve)
    return ()

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

process1 _ _ [] = True
process1 a b ([c,d]:e) | c<a = False
                       | d<b = False
                       | d>c = False
		       | c-a < d-b = False
	               | otherwise = process1 c d e

process v = process1 0 0 v

onecase = do
		n<- read <$> getLine ::IO Int
		v<- map (map read) <$> map words <$> replicateM n getLine :: IO [[Int]]
		putStrLn $ if process v then "YES" else "NO"

main::IO ()
main=do
  	t<- read <$> getLine ::IO Int
	replicateM_ t onecase

analyze :: [[Int]] -> Bool
analyze [] = True
analyze (x:y:xs) = head x >= (x !! 1) && head x <= head y && x !! 1 <= y !! 1 && analyze (y:xs)
analyze (x:xs) = head x >= (x !! 1) && analyze xs

solve :: IO ()
solve = do
    n <- getLine >>= \v -> return (read v :: Int)
    let inps = getLine >>= \v -> return [read n :: Int | n <- (words v)]
    inps' <- sequence (take n $ repeat inps)
    let out = if analyze inps' then "YES" else "NO"
    putStrLn out

main :: IO ()
main = do
    t <- getLine >>= \v -> return (read v :: Int)
    sequence $ take t (repeat solve)
    return ()

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

process1 _ _ [] = True
process1 a b ([c,d]:e) | c<a = False
                       | d<b = False
                       | d>c = False
	               | otherwise = process1 c d e

process v = process1 0 0 v

onecase = do
		n<- read <$> getLine ::IO Int
		v<- map (map read) <$> map words <$> replicateM n getLine :: IO [[Int]]
		putStrLn $ if process v then "YES" else "NO"

main::IO ()
main=do
  	t<- read <$> getLine ::IO Int
	replicateM_ t onecase


You have a fence consisting of $$$n$$$ vertical boards. The width of each board is $$$1$$$. The height of the $$$i$$$-th board is $$$a_i$$$. You think that the fence is great if there is no pair of adjacent boards having the same height. More formally, the fence is great if and only if for all indices from $$$2$$$ to $$$n$$$, the condition $$$a_{i-1} \neq a_i$$$ holds.Unfortunately, it is possible that now your fence is not great. But you can change it! You can increase the length of the $$$i$$$-th board by $$$1$$$, but you have to pay $$$b_i$$$ rubles for it. The length of each board can be increased any number of times (possibly, zero).Calculate the minimum number of rubles you have to spend to make the fence great again!You have to answer $$$q$$$ independent queries.

The first line contains one integer $$$q$$$ ($$$1 \le q \le 3 \cdot 10^5$$$) — the number of queries. The first line of each query contains one integers $$$n$$$ ($$$1 \le n \le 3 \cdot 10^5$$$) — the number of boards in the fence. The following $$$n$$$ lines of each query contain the descriptions of the boards. The $$$i$$$-th line contains two integers $$$a_i$$$ and $$$b_i$$$ ($$$1 \le a_i, b_i \le 10^9$$$) — the length of the $$$i$$$-th board and the price for increasing it by $$$1$$$, respectively. It is guaranteed that sum of all $$$n$$$ over all queries not exceed $$$3 \cdot 10^5$$$. It is guaranteed that answer to each query will not exceed $$$10^{18}$$$.

For each query print one integer — the minimum number of rubles you have to spend to make the fence great.

NoteIn the first query you have to increase the length of second board by $$$2$$$. So your total costs if $$$2 \cdot b_2 = 2$$$.In the second query you have to increase the length of first board by $$$1$$$ and the length of third board by $$$1$$$. So your total costs if $$$1 \cdot b_1 + 1 \cdot b_3 = 9$$$.In the third query the fence is great initially, so you don't need to spend rubles.

import Control.Monad
import Data.List
import Data.Int

data R = R !Int64 !Int64 !Int64 !Int64

select (R l a b c) x
  | x == l = a
  | x == l + 1 = b
  | otherwise = c

solve :: [(Int64, Int64)] -> Int64
solve a = select (foldl' f i t) (-1)
  where h = head a
        t = tail a
        i = R (fst h) (snd h) 0 0
        f lf (l, p) = R l (min (p + select lf (l + 1)) (2*p + select lf (l + 2)))
                           (min (select lf l) (2*p + select lf (l + 2)))
                           (minimum [select lf l, p + select lf (l + 1), 2*p + select lf (l + 2)])

main = do
  q <- readLn
  replicateM_ q $ do
    n <- readLn
    i <- replicateM n $ do
      [a, b] <- (map read . words) <$> getLine
      return (a, b)
    print $ solve i

import Control.Monad
import Data.List

data R = R !Int !Int !Int !Int

select (R l a b c) x
  | x == l = a
  | x == l + 1 = b
  | otherwise = c

solve :: [(Int, Int)] -> Int
solve a = select (foldl' f i t) (-1)
  where h = head a
        t = tail a
        i = R (fst h) (snd h) 0 0
        f lf (l, p) = R l (min (p + select lf (l + 1)) (2*p + select lf (l + 2)))
                           (min (select lf l) (2*p + select lf (l + 2)))
                           (minimum [select lf l, p + select lf (l + 1), 2*p + select lf (l + 2)])

main = do
  q <- readLn
  replicateM_ q $ do
    n <- readLn
    i <- replicateM n $ do
      [a, b] <- (map read . words) <$> getLine
      return (a, b)
    print $ solve i

import Control.Monad
import Data.List

data R = R !Int !Int !Int !Int

select (R l a b c) x
  | x == l = a
  | x == l + 1 = b
  | otherwise = c

solve :: [(Int, Int)] -> Int
solve a = select (foldl' f i t) (-1)
  where h = head a
        t = tail a
        i = R (fst h) (snd h) 0 0
        f lf (l, p) = R l (min (p + select lf (l + 1)) (2*p + select lf (l + 2)))
                           (min (select lf l) (2*p + select lf (l + 2)))
                           (minimum [select lf l, p + select lf (l + 1), 2*p + select lf (l + 2)])

main = do
  q <- readLn
  replicateM_ q $ do
    n <- readLn
    i <- replicateM n $ do
      [a, b] <- (map read . words) <$> getLine
      return (a, b)
    print "Ok"
    print $ solve i


You are given two integers $$$x$$$ and $$$y$$$. You can perform two types of operations:   Pay $$$a$$$ dollars and increase or decrease any of these integers by $$$1$$$. For example, if $$$x = 0$$$ and $$$y = 7$$$ there are four possible outcomes after this operation:   $$$x = 0$$$, $$$y = 6$$$;  $$$x = 0$$$, $$$y = 8$$$;  $$$x = -1$$$, $$$y = 7$$$;  $$$x = 1$$$, $$$y = 7$$$.   Pay $$$b$$$ dollars and increase or decrease both integers by $$$1$$$. For example, if $$$x = 0$$$ and $$$y = 7$$$ there are two possible outcomes after this operation:   $$$x = -1$$$, $$$y = 6$$$;  $$$x = 1$$$, $$$y = 8$$$.  Your goal is to make both given integers equal zero simultaneously, i.e. $$$x = y = 0$$$. There are no other requirements. In particular, it is possible to move from $$$x=1$$$, $$$y=0$$$ to $$$x=y=0$$$.Calculate the minimum amount of dollars you have to spend on it.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of testcases. The first line of each test case contains two integers $$$x$$$ and $$$y$$$ ($$$0 \le x, y \le 10^9$$$). The second line of each test case contains two integers $$$a$$$ and $$$b$$$ ($$$1 \le a, b \le 10^9$$$).

For each test case print one integer — the minimum amount of dollars you have to spend.

NoteIn the first test case you can perform the following sequence of operations: first, second, first. This way you spend $$$391 + 555 + 391 = 1337$$$ dollars.In the second test case both integers are equal to zero initially, so you dont' have to spend money.

import Control.Monad

type Ints = (Integer, Integer)
type Prices = (Integer, Integer)

data Test = Test (Ints, Ints) deriving (Show)

getData :: Int -> IO [Test]
getData t = replicateM t readTest

readTest :: IO Test
readTest = do
    first <- getLine
    second <- getLine
    let [x, y] = map read (words first)
    let [a, b] = map read (words second)
    return (Test ((x, y), (a, b)))

getAnswer :: [Test] -> [Integer]
getAnswer [] = []
getAnswer (first:rest) = [quantify first] ++ getAnswer rest

quantify :: Test -> Integer
quantify (Test ((x, y), (a, b))) = minimum [less*b + (greater - less)*a, (x + y)*a]
    where less = min x y
          greater = max x y

toIntList :: [Integer] -> [Integer]
toIntList list = list

main :: IO ()
main = do
    t <- getLine
    tests <- getData $ read t
    mapM_ print (getAnswer tests)

module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Integer]
getIntList = map read <$> getStrList

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

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

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [x, y] <- getIntList
        [a, b] <- getIntList
        print $ f x y a b

f :: Integer -> Integer -> Integer -> Integer -> Integer
f x y a b = minimum [(abs x + abs y) * a
                    ,abs (x - y) * a + min (abs x * b) (abs y * b)]

import           Data.List                      ( unfoldr )

-- https://stackoverflow.com/a/12882583/61394
chunks n = takeWhile (not . null) . unfoldr (Just . splitAt n)

f :: Integer -> Integer -> Integer -> Integer -> Integer

-- Rearrange so x' has the smaller absolute value.
f x y a b | x == 0 && y == 0 = 0
          | x == 0           = a * abs y
          | x < 0 && y < 0   = f (-x) (-y) a b
          | abs x > abs y    = f y x a b
          | x > 0 && y > 0   = x * min b (2 * a) + f 0 (y - x) a b
          | otherwise        = a * (abs x + abs y)

main =
  interact
    $ unlines
    . map (show . \(x : y : a : b : _) -> f x y a b)
    . chunks 4
    . tail
    . map read
    . words

import Control.Monad

main = readLn >>= flip replicateM_ test

test = do
    (x:y:_) <- map (abs . read) . words <$> getLine
    (a:b:_) <- map read . words <$> getLine
    print $ min (a * (x + y)) (b * min x y + a * (max x y - min x y))

import qualified Data.List as L

dist_to_zero a b
  | a > b = dist_to_zero b a
  | a <= 0 && 0 <= b = 0
  | 0 <= a = a
  | b <= 0 = b

solve :: [Integer] -> Integer
solve [x,y,a,b] = d2 * (min b (2*a)) + d1 * a
  where d1 = abs (x-y)
        d2 = dist_to_zero x y
solve x = undefined

lines_to_pairs [] = []
lines_to_pairs (x:y:zz) = (unwords [x,y]):(lines_to_pairs zz)

main = interact $ unlines . map show . map solve . map ( map read . words ) . lines_to_pairs . tail . lines

import Control.Monad

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

routine :: IO ()
routine = do
  [x,y] <- (map read.words) <$> getLine
  [a,b] <- (map read.words) <$> getLine
  print $ if 2*a <= b then a*(x+y) else (min x y)*b + (abs (x - y))*a

import Control.Monad

main :: IO ()
main = do
  tt <- read <$> getLine
  replicateM_ tt $ do
    [x, y] <- (map read . words) <$> getLine
    [a, b] <- (map read . words) <$> getLine
    let f t = a * abs (t + x) + a * abs (t + y) + b * abs t
    putStrLn $ show $ minimum [f (-x), f (-y), f 0 :: Integer]

solve :: [Integer] -> Integer
solve (0:0:_) = 0
solve (0:y:a:b:_) = a*y
solve (x:0:a:b:_) = a*x
solve (x:y:a:b:_)
    | b > 2*a =  x*a + y*a
    | b <= 2*a = (min x y)*b + (abs (x - y))*a

test :: (Int) -> IO()
test 0 = return()
test x = do
    l1 <- getLine
    l2 <- getLine
    let t = l1 ++ " " ++ l2
    let arr = map (\a -> read a :: Integer ) $ words t
    let ans = solve arr
    let out = show ans
    putStrLn out
    test (x - 1)

main = do
    t <- getLine
    let x = read t :: Int

    test x

solve1 :: Integer -> Integer -> Integer -> Integer -> Integer
solve1 x y a b
    | b > 2*a           = a * (x +y)
    | otherwise         = b * mn + a * (mx - mn)
    where
        mn = min x y
        mx = max x y

solveTestCases :: Integer -> IO ()
solveTestCases 0 = return ()
solveTestCases n = do
    xy <- getLine
    ab <- getLine
    let
        (x:y:_) = map read $ words xy
        (a:b:_) = map read $ words ab
    print $ solve1 x y a b
    solveTestCases (n-1)

main :: IO ()
main = do
    t <- getLine
    solveTestCases (read t)

import qualified Data.List as L

dist_to_zero a b
  | a > b = dist_to_zero b a
  | a <= 0 && 0 <= b = 0
  | 0 <= a = a
  | b <= 0 = b

solve :: [Int] -> Int
solve [x,y,a,b] = d2 * b + d1 * a
  where d1 = abs (x-y)
        d2 = dist_to_zero x y
solve x = undefined

lines_to_pairs [] = []
lines_to_pairs (x:y:zz) = (unwords [x,y]):(lines_to_pairs zz)

main = interact $ unlines . map show . map solve . map ( map read . words ) . lines_to_pairs . tail . lines

import qualified Data.List as L

dist_to_zero a b
  | a > b = dist_to_zero b a
  | a <= 0 && 0 <= b = 0
  | 0 <= a = a
  | b <= 0 = b

solve :: [Int] -> Int
solve [x,y,a,b] = d2 * (min b (2*a)) + d1 * a
  where d1 = abs (x-y)
        d2 = dist_to_zero x y
solve x = undefined

lines_to_pairs [] = []
lines_to_pairs (x:y:zz) = (unwords [x,y]):(lines_to_pairs zz)

main = interact $ unlines . map show . map solve . map ( map read . words ) . lines_to_pairs . tail . lines

solve :: [Int] -> Int
solve (0:0:_) = 0
solve (0:y:a:b:_) = a*y
solve (x:0:a:b:_) = a*x
solve (x:y:a:b:_)
    | b > 2*a =  x*a + y*a
    | b <= 2*a = (min x y)*b + (abs (x - y))*a

test :: (Int) -> IO()
test 0 = return()
test x = do
    l1 <- getLine
    l2 <- getLine
    let t = l1 ++ " " ++ l2
    let arr = map (\a -> read a :: Int ) $ words t
    let ans = solve arr
    let out = show ans
    putStrLn out
    test (x - 1)

main = do
    t <- getLine
    let x = read t :: Int

    test x

solve1 :: Int -> Int -> Int -> Int -> Int
solve1 x y a b
    | x * y <= 0        = a* (abs x+ abs y)
    | b > 2*a           = a* (abs x + abs y)
    | otherwise         = a* abs (abs x - abs y) + b* min (abs x) (abs y)

solveTestCases :: Int -> IO ()
solveTestCases 0 = return ()
solveTestCases n = do
    xy <- getLine
    ab <- getLine
    let
        (x:y:_) = map read $ words xy
        (a:b:_) = map read $ words ab
    print $ solve1 x y a b
    solveTestCases (n-1)

main :: IO ()
main = do
    t <- getLine
    solveTestCases (read t)

solve1 :: Int -> Int -> Int -> Int -> Int
solve1 x y a b
    | b > 2*a           = a * (x +y)
    | otherwise         = b * mn + a * (mx - mn)
    where
        mn = min x y
        mx = max x y

solveTestCases :: Int -> IO ()
solveTestCases 0 = return ()
solveTestCases n = do
    xy <- getLine
    ab <- getLine
    let
        (x:y:_) = map read $ words xy
        (a:b:_) = map read $ words ab
    print $ solve1 x y a b
    solveTestCases (n-1)

main :: IO ()
main = do
    t <- getLine
    solveTestCases (read t)

solve1 :: Int -> Int -> Int -> Int -> Int
solve1 x y a b
    | b > 2*a           = a* (x + y)
    | otherwise         = a* abs (x - y) + b* min x y

solveTestCases :: Int -> IO ()
solveTestCases 0 = return ()
solveTestCases n = do
    xy <- getLine
    ab <- getLine
    let
        (x:y:_) = map read $ words xy
        (a:b:_) = map read $ words ab
    print $ solve1 x y a b
    solveTestCases (n-1)

main :: IO ()
main = do
    t <- getLine
    solveTestCases (read t)


You have a string $$$s$$$ — a sequence of commands for your toy robot. The robot is placed in some cell of a rectangular grid. He can perform four commands:  'W' — move one cell up;  'S' — move one cell down;  'A' — move one cell left;  'D' — move one cell right. Let $$$Grid(s)$$$ be the grid of minimum possible area such that there is a position in the grid where you can place the robot in such a way that it will not fall from the grid while running the sequence of commands $$$s$$$. For example, if $$$s = \text{DSAWWAW}$$$ then $$$Grid(s)$$$ is the $$$4 \times 3$$$ grid:  you can place the robot in the cell $$$(3, 2)$$$;  the robot performs the command 'D' and moves to $$$(3, 3)$$$;  the robot performs the command 'S' and moves to $$$(4, 3)$$$;  the robot performs the command 'A' and moves to $$$(4, 2)$$$;  the robot performs the command 'W' and moves to $$$(3, 2)$$$;  the robot performs the command 'W' and moves to $$$(2, 2)$$$;  the robot performs the command 'A' and moves to $$$(2, 1)$$$;  the robot performs the command 'W' and moves to $$$(1, 1)$$$.   You have $$$4$$$ extra letters: one 'W', one 'A', one 'S', one 'D'. You'd like to insert at most one of these letters in any position of sequence $$$s$$$ to minimize the area of $$$Grid(s)$$$.What is the minimum area of $$$Grid(s)$$$ you can achieve?

The first line contains one integer $$$T$$$ ($$$1 \le T \le 1000$$$) — the number of queries. Next $$$T$$$ lines contain queries: one per line. This line contains single string $$$s$$$ ($$$1 \le |s| \le 2 \cdot 10^5$$$, $$$s_i \in \{\text{W}, \text{A}, \text{S}, \text{D}\}$$$) — the sequence of commands. It's guaranteed that the total length of $$$s$$$ over all queries doesn't exceed $$$2 \cdot 10^5$$$.

Print $$$T$$$ integers: one per query. For each query print the minimum area of $$$Grid(s)$$$ you can achieve.

NoteIn the first query you have to get string $$$\text{DSAWW}\underline{D}\text{AW}$$$.In second and third queries you can not decrease the area of $$$Grid(s)$$$.

import Control.Monad

data Point = Point Integer Integer
data Direction = W | A | S | D deriving (Enum, Eq, Read)
data Frame = Frame {up :: Integer, down :: Integer, left :: Integer, right :: Integer}
data Journey = Journey {frame :: Frame, stop :: Point}

emptyFrame :: Frame
emptyFrame = Frame {up = 0, down = 0, left = 0, right = 0}

emptyJourney :: Journey
emptyJourney = Journey {frame = emptyFrame, stop = (Point 0 0)}

area :: Frame -> Integer
area (Frame {up = u, down = d, left = l, right = r}) =
    let width = r - l + 1
        height = u - d + 1
    in width * height

movePoint :: Direction -> Point -> Point
movePoint dir (Point x y)
    | dir == W = Point x (y + 1)
    | dir == A = Point (x - 1) y
    | dir == S = Point x (y - 1)
    | dir == D = Point (x + 1) y

invert :: Direction -> Direction
invert dir
    | dir == W = S
    | dir == A = D
    | dir == S = W
    | dir == D = A

enlarge :: Point -> Frame -> Frame
enlarge (Point x y) (Frame {up = u, down = d, left = l, right = r}) =
    Frame {up = max u y, down = min d y, left = min l x, right = max r x}

move :: Direction -> Journey -> Journey
move dir (Journey {frame = f, stop = s}) =
    let newStop = movePoint dir s
        newFrame = enlarge newStop f
    in Journey {frame = newFrame, stop = newStop}

journeys :: [Direction] -> [Journey]
journeys dirs = scanl (\journey dir -> move dir journey) emptyJourney dirs

continuations :: [Direction] -> [Journey]
continuations dirs =
    let goodDirs = map invert dirs
    in scanr (\dir journey -> move dir journey) emptyJourney goodDirs

overallFrame :: Journey -> Journey -> Frame
overallFrame
    (Journey {frame = Frame {up = ju, down = jd, left = jl, right = jr}, stop = (Point jx jy)})
    (Journey {frame = Frame {up = cu, down = cd, left = cl, right = cr}, stop = (Point cx cy)}) =
    let u = max ju (jy + (cu - cy))
        d = min jd (jy - (cy - cd))
        l = min jl (jx - (cx - cl))
        r = max jr (jx + (cr - cx))
    in Frame {up = u, down = d, left = l, right = r}

finalFrame :: Journey -> Direction -> Journey -> Frame
finalFrame j dir c = overallFrame (move dir j) c

bestResult :: Journey -> Journey -> Integer
bestResult j c =
    let possibleAreas = map area [finalFrame j dir c | dir <- [W .. D]]
    in minimum possibleAreas

solve :: String -> Integer
solve s =
    let dirs = map (\ch -> read [ch] :: Direction) s
        js = journeys dirs
        cs = continuations dirs
        defaultArea = area . frame . last $ js
        customArea = minimum $ zipWith (\j c -> bestResult j c) js cs
    in min defaultArea customArea

readAndSolve :: Integer -> IO ()
readAndSolve x = do
    input <- getLine
    putStrLn . show . solve $ input

main = do
    input <- getLine
    let tests = read input :: Integer
    forM [1..tests] readAndSolve

import Control.Monad

data Point = Point Int Int
data Direction = W | A | S | D deriving (Enum, Eq, Read)
data Frame = Frame {up :: Int, down :: Int, left :: Int, right :: Int}
data Journey = Journey {frame :: Frame, stop :: Point}

emptyFrame :: Frame
emptyFrame = Frame {up = 0, down = 0, left = 0, right = 0}

emptyJourney :: Journey
emptyJourney = Journey {frame = emptyFrame, stop = (Point 0 0)}

area :: Frame -> Int
area (Frame {up = u, down = d, left = l, right = r}) =
    let width = r - l + 1
        height = u - d + 1
    in width * height

movePoint :: Direction -> Point -> Point
movePoint dir (Point x y)
    | dir == W = Point x (y + 1)
    | dir == A = Point (x - 1) y
    | dir == S = Point x (y - 1)
    | dir == D = Point (x + 1) y

invert :: Direction -> Direction
invert dir
    | dir == W = S
    | dir == A = D
    | dir == S = W
    | dir == D = A

enlarge :: Point -> Frame -> Frame
enlarge (Point x y) (Frame {up = u, down = d, left = l, right = r}) =
    Frame {up = max u y, down = min d y, left = min l x, right = max r x}

move :: Direction -> Journey -> Journey
move dir (Journey {frame = f, stop = s}) =
    let newStop = movePoint dir s
        newFrame = enlarge newStop f
    in Journey {frame = newFrame, stop = newStop}

journeys :: [Direction] -> [Journey]
journeys dirs = scanl (\journey dir -> move dir journey) emptyJourney dirs

continuations :: [Direction] -> [Journey]
continuations dirs =
    let goodDirs = map invert dirs
    in scanr (\dir journey -> move dir journey) emptyJourney goodDirs

overallFrame :: Journey -> Journey -> Frame
overallFrame
    (Journey {frame = Frame {up = ju, down = jd, left = jl, right = jr}, stop = (Point jx jy)})
    (Journey {frame = Frame {up = cu, down = cd, left = cl, right = cr}, stop = (Point cx cy)}) =
    let u = max ju (jy + (cu - cy))
        d = min jd (jy - (cy - cd))
        l = min jl (jx - (cx - cl))
        r = max jr (jx + (cr - cx))
    in Frame {up = u, down = d, left = l, right = r}

finalFrame :: Journey -> Direction -> Journey -> Frame
finalFrame j dir c = overallFrame (move dir j) c

bestResult :: Journey -> Journey -> Int
bestResult j c =
    let possibleAreas = map area [finalFrame j dir c | dir <- [W .. D]]
    in minimum possibleAreas

solve :: String -> Int
solve s =
    let dirs = map (\ch -> read [ch] :: Direction) s
        js = journeys dirs
        cs = continuations dirs
        defaultArea = area . frame . last $ js
        customArea = minimum $ zipWith (\j c -> bestResult j c) js cs
    in min defaultArea customArea

readAndSolve :: Int -> IO ()
readAndSolve x = do
    input <- getLine
    putStrLn . show . solve $ input

main = do
    input <- getLine
    let tests = read input :: Int
    forM [1..tests] readAndSolve


Jafar has n cans of cola. Each can is described by two integers: remaining volume of cola ai and can's capacity bi (ai  ≤  bi).Jafar has decided to pour all remaining cola into just 2 cans, determine if he can do this or not!

The first line of the input contains one integer n (2 ≤ n ≤ 100 000) — number of cola cans. The second line contains n space-separated integers a1, a2, ..., an (0 ≤ ai ≤ 109) — volume of remaining cola in cans. The third line contains n space-separated integers that b1, b2, ..., bn (ai ≤ bi ≤ 109) — capacities of the cans.

Print "YES" (without quotes) if it is possible to pour all remaining cola in 2 cans. Otherwise print "NO" (without quotes). You can print each letter in any case (upper or lower).

NoteIn the first sample, there are already 2 cans, so the answer is "YES".

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where

import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Data.Bool

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  as <- replicateM n p64
  bs <- replicateM n p64
  return $ bool "NO" "YES" $ solve as bs
  where
  pop = state $ \(x:xs) -> (x, xs)
  p64 = fmap fromIntegral poi
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve as bs = (sum as :: Int64) <= sum (take 2 $ sortBy (flip compare) bs)

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU
{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.List (sort)

readI = fst . fromJust . C.readInteger

main = C.interact $ solve . map (map readI . C.words) . C.lines

solve [_, xs, ys] = if ans then "YES" else "NO"
    where
        capa = sum $ take 2 $ reverse $ sort ys
        ans = sum xs <= capa

import Data.Int
import Data.List

solve :: Int64 -> Int64 -> String
solve a b
  | a <= b    = "YES"
  | otherwise = "NO"

main = do
  n <- getLine
  a <- getLine
  b <- getLine
  let
    a'  = sum $ map read $ words a
    b'  = sum $ take 2 $ reverse $ sort $ map read $ words b
    ans = solve a' b'
  putStrLn ans

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Int
  readInt s = read s :: Int

  readInteger :: String -> Integer
  readInteger s = read s :: Integer

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

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

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- getLine >>= return . map readInteger . words
    ys <- getLine >>= return . map readInteger . words
    let twoMaxCans = sum $ take 2 $ reverse $ sort ys
        allCans = sum xs
    putStrLn $ yesNo $ allCans <= twoMaxCans

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

import Data.List (sort)

main = interact $ solve . map (map read . words) . lines

solve [_, xs, ys] = if ans then "YES" else "NO"
    where
        capa = sum $ take 2 $ reverse $ sort xs
        ans = sum xs <= capa

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU
{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.List (sort)

readI = fst . fromJust . C.readInt

main = C.interact $ solve . map (map readI . C.words) . C.lines

solve [_, xs, ys] = if ans then "YES" else "NO"
    where
        capa = sum $ take 2 $ reverse $ sort ys
        ans = sum xs <= capa

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU
{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.List (sort)

readI = fst . fromJust . C.readInt

main = C.interact $ solve . map (map readI . C.words) . C.lines

solve [_, xs, ys] = if ans then "YES" else "NO"
    where
        capa = sum $ take 2 $ reverse $ sort xs
        ans = sum xs <= capa

import Data.List

solve :: Int -> Int -> String
solve a' b'
  | a' <= b'  = "YES"
  | otherwise = "NO"

main = do
  n <- getLine
  a <- getLine
  b <- getLine
  putStrLn (solve (sum $ map read $ words a) (sum $ take 2 $ reverse $ sort $ map read $ words b))

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Int
  readInt s = read s :: Int

  readInteger :: String -> Integer
  readInteger s = read s :: Integer

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

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

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- getLine >>= return . map readInteger . words
    ys <- getLine >>= return . map readInteger . words
    let twoMaxCans = sum $ take 2 $ reverse $ sort ys
        allCans = sum xs
    putStrLn $ yesNo $ allCans < twoMaxCans


You are given an array $$$a_1, a_2, \dots , a_n$$$. Array is good if for each pair of indexes $$$i < j$$$ the condition $$$j - a_j \ne i - a_i$$$ holds. Can you shuffle this array so that it becomes good? To shuffle an array means to reorder its elements arbitrarily (leaving the initial order is also an option).For example, if $$$a = [1, 1, 3, 5]$$$, then shuffled arrays $$$[1, 3, 5, 1]$$$, $$$[3, 5, 1, 1]$$$ and $$$[5, 3, 1, 1]$$$ are good, but shuffled arrays $$$[3, 1, 5, 1]$$$, $$$[1, 1, 3, 5]$$$ and $$$[1, 1, 5, 3]$$$ aren't.It's guaranteed that it's always possible to shuffle an array to meet this condition.

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 array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots , a_n$$$ ($$$1 \le a_i \le 100$$$).

For each test case print the shuffled version of the array $$$a$$$ which is good.

import Control.Monad

reverseqs :: [Int] -> [Int]
reverseqs [] = []
reverseqs (x:xs) = let greater = reverseqs (filter (>= x) xs)
                       lesser = reverseqs (filter (< x) xs)
                    in greater ++ [x] ++ lesser

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

main = do
    t <- getLine
    let cases = (read t :: Int)
    results <- forM [1..cases] (\t -> do
        integers <- readInts
        array <- readInts
        let final = foldl (\acc x ->  acc ++ (show x) ++ " ") ""  $ reverseqs array
        return final
        )

    mapM putStrLn results

import Data.List
import Control.Monad
import Data.STRef

(|>) x f = f x

main = do
    line <- getLine
    forM_ [1..(read line)] $ \t -> do
        line <- getLine
        line <- getLine
        list <- words line |> map (read :: String -> Int) |> sort |> reverse |> pure
        forM_ list $ \x -> do
            putStr (show x)
            putStr " "
        putStrLn ""

import Data.List
import Control.Monad

bogosort :: (Ord a) => [a] -> [a]
bogosort = reverse . sort

main = do
  i <- getLine
  let t = read i :: Int
  forM_ [1..t] $ \_ -> do
    j <- getLine
    ss <- getLine
    let xx = map (\x -> read x :: Int) $ words ss
    let ret = bogosort xx
    putStrLn (intercalate " " (map show ret))

import Data.List
import Control.Monad

bogosort :: (Ord a) => [a] -> [a]
bogosort = reverse . sort

main = do
  i <- getLine
  let t = read i :: Int
  forM_ [1..t] $ \_ -> do
    j <- getLine
    ss <- getLine
    let xx = words ss
    let ret = bogosort xx
    putStrLn (intercalate " " ret)


Alice and Bob are playing yet another card game. This time the rules are the following. There are $$$n$$$ cards lying in a row in front of them. The $$$i$$$-th card has value $$$a_i$$$. First, Alice chooses a non-empty consecutive segment of cards $$$[l; r]$$$ ($$$l \le r$$$). After that Bob removes a single card $$$j$$$ from that segment $$$(l \le j \le r)$$$. The score of the game is the total value of the remaining cards on the segment $$$(a_l + a_{l + 1} + \dots + a_{j - 1} + a_{j + 1} + \dots + a_{r - 1} + a_r)$$$. In particular, if Alice chooses a segment with just one element, then the score after Bob removes the only card is $$$0$$$.Alice wants to make the score as big as possible. Bob takes such a card that the score is as small as possible.What segment should Alice choose so that the score is maximum possible? Output the maximum score.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of cards. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$-30 \le a_i \le 30$$$) — the values on the cards.

Print a single integer — the final score of the game.

NoteIn the first example Alice chooses a segment $$$[1;5]$$$ — the entire row of cards. Bob removes card $$$3$$$ with the value $$$10$$$ from the segment. Thus, the final score is $$$5 + (-2) + (-1) + 4 = 6$$$.In the second example Alice chooses a segment $$$[1;4]$$$, so that Bob removes either card $$$1$$$ or $$$3$$$ with the value $$$5$$$, making the answer $$$5 + 2 + 3 = 10$$$.In the third example Alice can choose any of the segments of length $$$1$$$: $$$[1;1]$$$, $$$[2;2]$$$ or $$$[3;3]$$$. Bob removes the only card, so the score is $$$0$$$. If Alice chooses some other segment then the answer will be less than $$$0$$$.

import Data.List (unfoldr, foldl') -- '
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Char8 (readInt)

step :: Int -> Int -> Int -> Int
step maxv prev v
  | maxv < v     = minBound
  | otherwise  = v + max (-maxv) prev

mymax :: [Int] -> Int
mymax = foldl' max minBound -- '

solve :: [Int] -> Int
solve li = mymax $ concatMap (\maxv -> scanl (step maxv) minBound li) [-30..30]

parse :: L.ByteString -> [Int]
parse = parseLine . L.dropWhile (== newline) . L.dropWhile (/= newline)  where
  newline = 0x0a
  space = 0x20
  parseLine = unfoldr (readInt . L.dropWhile (== space))

main :: IO ()
main = (putStr . (++ "\n") . show . solve . parse) =<< L.getContents

-- Verdict: TLE.
-- GHC probably isn't reuse the input array or preallocating for step.
-- Probably fixable in Haskell, but not as easy as I'd like it to be.
-- The lack of language-level support for unique refs and
-- pure functions that consume their args hurts at a time like this.

{-# LANGUAGE BangPatterns #-}

--import Data.Array (Array, listArray, elems)
import Data.List (foldl', unfoldr) -- '
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Char8 (readInt)

type Array x = []
listArray :: (x,x) -> [y] -> Array x y
listArray _ = id
elems :: Array x y -> [y]
elems = id

type Arr = Array Int (Int, Int, Int)

startArr :: Arr
startArr = listArray (-30, 30) [(i, minBound, minBound) | i <- [-30 .. 30]]

step :: Arr -> Int -> Arr
step arr v = fmap step1 arr  where
  step1 (!ix, !prev, !best)
    | ix < v     = (ix, minBound, best)
    | otherwise  = seq nv $ seq nbv (ix, nv, nbv)  where
      nv = v + max (-ix) prev
      nbv = max nv best

solve :: [Int] -> Int
solve li = maximum [bv | (_, _, bv) <- elems (foldl' step startArr li)]

parse :: L.ByteString -> [Int]
parse = parseLine . L.dropWhile (== newline) . L.dropWhile (/= newline)  where
  newline = 0x0a
  space = 0x20
  parseLine = unfoldr (readInt . L.dropWhile (== space))

main :: IO ()
main = (putStr . (++ "\n") . show . solve . parse) =<< L.getContents

{-# LANGUAGE BangPatterns #-}

import Data.List (foldl', unfoldr) -- '
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Char8 (readInt)

type Trip = (Int, Int, Int)

step :: Trip -> Int -> Trip
step (!ix, !prev, !best) v
  | ix < v     = (ix, minBound, best)
  | otherwise  = (ix, nv, nbv)  where
    nv = v + max (-ix) prev
    nbv = max nv best

solve1 :: Int -> [Int] -> Trip
solve1 maxv = foldl' step (maxv, minBound, minBound) -- '

solve :: [Int] -> Int
solve li = maximum [bv | (_, _, bv) <- map (`solve1` li) [-30 .. 30]]

parse :: L.ByteString -> [Int]
parse = parseLine . L.dropWhile (== newline) . L.dropWhile (/= newline)  where
  newline = 0x0a
  space = 0x20
  parseLine = unfoldr (readInt . L.dropWhile (== space))

main :: IO ()
main = (putStr . (++ "\n") . show . solve . parse) =<< L.getContents

import Data.List (unfoldr, foldl') -- '
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Char8 (readInt)

step :: Int -> Int -> Int -> Int
step maxv prev v
  | maxv < v     = minBound
  | otherwise  = v + max (-maxv) prev

mymax :: [Int] -> Int
mymax = foldl' max minBound -- '

solve :: [Int] -> Int
solve li = mymax $ concatMap (\maxv -> scanl (step maxv) minBound li) [-30..30]

parse :: L.ByteString -> [Int]
parse = parseLine . L.dropWhile (== newline) . L.dropWhile (/= newline)  where
  newline = 0x0a
  space = 0x20
  parseLine = unfoldr (readInt . L.dropWhile (== space))

main :: IO ()
main = (putStrLn . show . solve . parse) =<< L.getContents

import Data.Array (Array, listArray, assocs)
import Data.List (foldl') -- '

type Arr = Array Int (Int, Int)

startArr :: Arr
startArr = listArray (-30, 30) (replicate 61 (minBound, minBound))

step :: Arr -> Int -> Arr
step arr v = listArray (-30, 30) [step1 i v e | (i, e) <- assocs arr]  where
  step1 ix va (prev, best)
    | ix < va    = (minBound, best)
    | otherwise  = let  nv = va + max 0 prev  in  (nv, max nv best)

solve :: [Int] -> Int
solve li = maximum [bv - i | (i, (_, bv)) <- assocs (foldl' step startArr li)]

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

main :: IO ()
main = interact ((++ "\n") . show . solve . parse)