The little girl loves the problems on array queries very much.One day she came across a rather well-known problem: you've got an array of $$$n$$$ elements (the elements of the array are indexed starting from 1); also, there are $$$q$$$ queries, each one is defined by a pair of integers $$$l_i$$$, $$$r_i$$$ $$$(1 \le l_i \le r_i \le n)$$$. You need to find for each query the sum of elements of the array with indexes from $$$l_i$$$ to $$$r_i$$$, inclusive.The little girl found the problem rather boring. She decided to reorder the array elements before replying to the queries in a way that makes the sum of query replies maximum possible. Your task is to find the value of this maximum sum.

The first line contains two space-separated integers $$$n$$$ ($$$1 \le n \le 2\cdot10^5$$$) and $$$q$$$ ($$$1 \le q \le 2\cdot10^5$$$) — the number of elements in the array and the number of queries, correspondingly. The next line contains $$$n$$$ space-separated integers $$$a_i$$$ ($$$1 \le a_i \le 2\cdot10^5$$$) — the array elements. Each of the following $$$q$$$ lines contains two space-separated integers $$$l_i$$$ and $$$r_i$$$ ($$$1 \le l_i \le r_i \le n$$$) — the $$$i$$$-th query.

In a single line print, a single integer — the maximum sum of query replies after the array elements are reordered. Please, do not use the %lld specifier to read or write 64-bit integers in C++. It is preferred to use the cin, cout streams or the %I64d specifier.

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

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

main :: IO ()
main = do
  (n:_:t) <- map (fst . fromJust . C.readInt) <$> C.words <$> C.getContents
  let (a, q) = splitAt n t
      (l, r) = unzip $ pairs q
      x = accumArray (+) 0 (0, n) $
        zip (map pred l) (repeat 1) ++ zip r (repeat $ -1)
      y = scanl1 (+) $ init $ elems x
      f = map fromIntegral . sort
      z = sum $ zipWith (*) (f a) (f y)
  print $ (z :: Int64)

{-# OPTIONS_GHC -O2 -funbox-strict-fields -cpp #-}
{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import Control.Monad
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.Function
import Data.List
import Data.IORef

#if __GLASGOW_HASKELL__ < 706
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}
#endif

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,q] <- map read.words <$> getLine
  (as,lrs) <- splitAt n.map readInt.B.words <$> B.getContents
  segtree <- mkSegTree 0 (n-1) (listArray (0,n-1) $ repeat 0)
  let go st (l:r:rest) = update (l-1) (r-1) 1 st >> go st rest
      go _ _ = return ()
  go segtree lrs
  xs <- fromSegTree 0 (n-1) segtree
  print $ sum $ zipWith ((*)`on`toInteger) (sortBy (flip compare) xs) (sortBy (flip compare) as)

data SegTree = Node !Int !Int !(IORef Int) !(IORef Int) !SegTree !SegTree
             | Leaf !Int !(IORef Int)

fromSegTree :: Int -> Int -> SegTree -> IO [Int]
fromSegTree l r segtree = go id [l..r]
   where
     go ans (x:xs) = do
       !qxx <- query x x segtree
       go (ans.(qxx:)) xs
     go ans _ = return $ ans []

mkSegTree :: Int -> Int -> UArray Int Int -> IO SegTree
mkSegTree l r arr
  | l<r = do
      let !m = (l+r) `quot` 2
      lt <- mkSegTree l m arr
      rt <- mkSegTree (m+1) r arr
      let get (Node _ _ _ bref _ _) = readIORef bref
          get (Leaf _ ref) = readIORef ref
      xy <- (+) <$> get lt <*> get rt
      aref <- newIORef 0
      bref <- newIORef $! xy
      return $! Node l r aref bref lt rt
  | otherwise = do
      ref <- newIORef $! unsafeAt arr l
      return $! Leaf l ref

update :: Int -> Int -> Int -> SegTree -> IO ()
update kl kr x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)

query :: Int -> Int -> SegTree -> IO Int
query kl kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0

{-# OPTIONS_GHC -O2 -funbox-strict-fields -cpp #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.IORef

#if __GLASGOW_HASKELL__ < 706
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}
#endif

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,q] <- map read.words <$> getLine
  (as,lrs) <- splitAt n.map readInt.B.words <$> B.getContents
  segtree <- mkSegTree 0 (n-1) (listArray (0,n-1) $ repeat 0)
  let go st (l:r:rest) = update (l-1) (r-1) 1 st >> go st rest
      go _ _ = return ()
  go segtree lrs
  cnts <- fromSegTree 0 (n-1) segtree
  print $ solve as cnts

solve :: [Int] -> [Int] -> Integer
solve as cnts = go 0 (sortBy (flip compare) as) (sortBy (flip compare) cnts)
   where
     go !acc (x:xs) (y:ys) = go (toInteger x * toInteger y + acc) xs ys
     go acc _ _ = acc

data SegTree = Node !Int !Int !(IORef Int) !(IORef Int) !SegTree !SegTree
             | Leaf !Int !(IORef Int)

fromSegTree :: Int -> Int -> SegTree -> IO [Int]
fromSegTree l r segtree = mapM (\i -> query i i segtree) [l..r]

mkSegTree :: Int -> Int -> UArray Int Int -> IO SegTree
mkSegTree l r arr
  | l<r = do
      let !m = (l+r) `quot` 2
      lt <- mkSegTree l m arr
      rt <- mkSegTree (m+1) r arr
      let get (Node _ _ _ bref _ _) = readIORef bref
          get (Leaf _ ref) = readIORef ref
      xy <- (+) <$> get lt <*> get rt
      aref <- newIORef 0
      bref <- newIORef $! xy
      return $! Node l r aref bref lt rt
  | otherwise = do
      ref <- newIORef $! unsafeAt arr l
      return $! Leaf l ref

update :: Int -> Int -> Int -> SegTree -> IO ()
update kl kr x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)

query :: Int -> Int -> SegTree -> IO Int
query kl kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.List

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,q] <- map read.words <$> getLine
  (as,lrs) <- splitAt n.map readInt.B.words <$> B.getContents
  print $ solve as $ imos n lrs

solve :: [Int] -> [Integer] -> Integer
solve as cnts = go 0 (sort as) (sort cnts)
   where
     go !acc (x:xs) (y:ys) = go (toInteger x * y + acc) xs ys
     go acc _ _ = acc

imos :: Int -> [Int] -> [Integer]
imos n lrs = scanl1 (+) $ map (toInteger.unsafeAt cnt) [0..n-1]
   where
     cnt :: UArray Int Int
     !cnt = unsafeAccumArray (+) 0 (0,n) $ go lrs
     go (l:r:lrs) = (l-1,1):(r,-1):go lrs
     go _ = []

{-# OPTIONS_GHC -O2 -funbox-strict-fields -cpp #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.IORef

#if __GLASGOW_HASKELL__ < 706
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}
#endif

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,q] <- map read.words <$> getLine
  (as,lrs) <- splitAt n.map readInt.B.words <$> B.getContents
  segtree <- mkSegTree 0 (n-1) 0
  let go st (l:r:rest) = update (l-1) (r-1) 1 st >> go st rest
      go _ _ = return ()
  go segtree lrs
  cnts <- fromSegTree 0 (n-1) segtree
  print $ solve as cnts

solve :: [Int] -> [Int] -> Integer
solve as cnts = go 0 (radixSortRev as) (radixSortRev cnts)
   where
     go !acc (x:xs) (y:ys) = go (toInteger x * toInteger y + acc) xs ys
     go acc _ _ = acc

data SegTree = Node !Int !Int !(IORef Int) !(IORef Int) !SegTree !SegTree
             | Leaf !Int !(IORef Int)

fromSegTree :: Int -> Int -> SegTree -> IO [Int]
fromSegTree kl kr segtree = mapM f [kl..kr]
   where
     f key = go 0 segtree
      where
        go !acc (Node l r aref _ lt rt) = do
          if 2*key <= l+r
             then do
               a <- readIORef aref
               go (acc+a) lt
             else do
               a <- readIORef aref
               go (acc+a) rt
        go !acc (Leaf _ ref) = do
          r <- readIORef ref
          return $! acc+r

mkSegTree :: Int -> Int -> Int -> IO SegTree
mkSegTree !kl !kr !x0 = go kl kr
   where
     go !l !r
       | l<r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           aref <- newIORef x0
           bref <- newIORef x0
           return $! Node l r aref bref lt rt
       | otherwise = do
           !ref <- newIORef x0
           return $! Leaf l ref

update :: Int -> Int -> Int -> SegTree -> IO ()
update !kl !kr !x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)

radixSortRev :: [Int] -> [Int]
radixSortRev xs = runST $ do

  let !mask = 0xffff
      !n = length xs

  arr <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0   :: ST s (STUArray s Int Int)

  forM_ (map (mask.&.) xs) $ \mx -> do
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    !j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  forM_ [0..mask] $ \i-> do
    unsafeWrite count i 0

  forM_ (map ((mask.&.).(`unsafeShiftR`16)) xs) $ \mx -> do
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead tmp i
    let !mi = (xi`unsafeShiftR`16).&.mask
    !j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  forM [n-1,n-2..0] $ \i-> do
    unsafeRead arr i

{-# OPTIONS_GHC -O2 -funbox-strict-fields -cpp #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.IORef

#if __GLASGOW_HASKELL__ < 706
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}
#endif

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,q] <- map read.words <$> getLine
  (as,lrs) <- splitAt n.map readInt.B.words <$> B.getContents
  segtree <- mkSegTree 0 (n-1) (listArray (0,n-1) $ repeat 0)
  let go st (l:r:rest) = update (l-1) (r-1) 1 st >> go st rest
      go _ _ = return ()
  go segtree lrs
  cnts <- fromSegTree 0 (n-1) segtree
  print $ solve as cnts

solve :: [Int] -> [Int] -> Integer
solve as cnts = go 0 (reverse $ radixSort as) (reverse $ radixSort cnts)
   where
     go !acc (x:xs) (y:ys) = go (toInteger x * toInteger y + acc) xs ys
     go acc _ _ = acc

data SegTree = Node !Int !Int !(IORef Int) !(IORef Int) !SegTree !SegTree
             | Leaf !Int !(IORef Int)

fromSegTree :: Int -> Int -> SegTree -> IO [Int]
fromSegTree l r segtree = mapM (\i -> query i i segtree) [l..r]

mkSegTree :: Int -> Int -> UArray Int Int -> IO SegTree
mkSegTree l r arr
  | l<r = do
      let !m = (l+r) `quot` 2
      lt <- mkSegTree l m arr
      rt <- mkSegTree (m+1) r arr
      let get (Node _ _ _ bref _ _) = readIORef bref
          get (Leaf _ ref) = readIORef ref
      xy <- (+) <$> get lt <*> get rt
      aref <- newIORef 0
      bref <- newIORef $! xy
      return $! Node l r aref bref lt rt
  | otherwise = do
      ref <- newIORef $! unsafeAt arr l
      return $! Leaf l ref

update :: Int -> Int -> Int -> SegTree -> IO ()
update kl kr x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)

query :: Int -> Int -> SegTree -> IO Int
query kl kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0

radixSort :: [Int] -> [Int]
radixSort xs = elems $ runSTUArray $ do

  let !mask = 0xffff
      !n = length xs

  arr <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0   :: ST s (STUArray s Int Int)

  forM_ xs $ \x-> do
    let !mx = x.&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  forM_ [0..mask] $ \i-> do
    unsafeWrite count i 0

  forM_ xs $ \x-> do
    let !mx = (x`shiftR`16).&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead tmp i
    let !mi = (xi`shiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  return arr

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.List

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,_] <- map read.words <$> getLine
  (as,lrs) <- splitAt n.map readInt.B.words <$> B.getContents
  print $ solve as $ imos n lrs

solve :: [Int] -> [Int] -> Integer
solve as cnts = go 0 (radixSort as) (radixSort cnts)
   where
     go !acc (x:xs) (y:ys) = go (toInteger x * toInteger y + acc) xs ys
     go acc _ _ = acc

imos :: Int -> [Int] -> [Int]
imos n lrs = scanl1 (+) $ map (unsafeAt cnt) [0..n-1]
   where
     !cnt = unsafeAccumArray (+) 0 (0,n) $ go lrs :: UArray Int Int
     go (l:r:lrs) = (l-1,1):(r,-1):go lrs
     go _ = []

radixSort :: [Int] -> [Int]
radixSort xs = runST $ do

  let !mask = 0xffff
      !n = length xs

  arr <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0   :: ST s (STUArray s Int Int)

  forM_ xs $ \x-> do
    let !mx = x.&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  forM_ [0..mask] $ \i-> do
    unsafeWrite count i 0

  forM_ xs $ \x-> do
    let !mx = (x`shiftR`16).&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead tmp i
    let !mi = (xi`shiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  getElems arr


In a strategic computer game "Settlers II" one has to build defense structures to expand and protect the territory. Let's take one of these buildings. At the moment the defense structure accommodates exactly n soldiers. Within this task we can assume that the number of soldiers in the defense structure won't either increase or decrease.Every soldier has a rank — some natural number from 1 to k. 1 stands for a private and k stands for a general. The higher the rank of the soldier is, the better he fights. Therefore, the player profits from having the soldiers of the highest possible rank.To increase the ranks of soldiers they need to train. But the soldiers won't train for free, and each training session requires one golden coin. On each training session all the n soldiers are present.At the end of each training session the soldiers' ranks increase as follows. First all the soldiers are divided into groups with the same rank, so that the least possible number of groups is formed. Then, within each of the groups where the soldiers below the rank k are present, exactly one soldier increases his rank by one.You know the ranks of all n soldiers at the moment. Determine the number of golden coins that are needed to increase the ranks of all the soldiers to the rank k.

The first line contains two integers n and k (1 ≤ n, k ≤ 100). They represent the number of soldiers and the number of different ranks correspondingly. The second line contains n numbers in the non-decreasing order. The i-th of them, ai, represents the rank of the i-th soldier in the defense building (1 ≤ i ≤ n, 1 ≤ ai ≤ k).

Print a single integer — the number of golden coins needed to raise all the soldiers to the maximal rank.

NoteIn the first example the ranks will be raised in the following manner:1 2 2 3  →  2 2 3 4  →  2 3 4 4  →  3 4 4 4  →  4 4 4 4Thus totals to 4 training sessions that require 4 golden coins.

module Main where

import Control.Monad

main = do
    [n, k] <- ( map read . words ) `liftM` getLine
    as <- ( map read . words ) `liftM` getLine

    let (_, count) = until ( (==k) . head . fst ) (\(as, count) ->
                let (as', _) = foldr (\a (res, last) ->
                            ( ( if a == last then a else a+1 ) : res, a )
                        ) ([], k) as
                in (as', count+1)
            ) (as, 0)

    putStrLn $ show count

main = do
	[n,k] <- getLine >>= return . map read . words :: IO [Int]
	lst <- getLine >>= return . map read . words :: IO [Int]
	let low x = length $ filter ((>=) x) lst
	(putStrLn . show . foldl max 0) [ (k - i) + (low i - 1) | i <- [1..k-1], low i > 0 ]

import List

next :: Int -> [Int] -> [Int]
next _ [] = []
next m [a] = if a < m then [a+1] else [a]
next m (a:b:as) = if a < b then (a+1):(next m (b:as)) else a:(next m (b:as))

solve :: Int -> [Int] -> Int
solve m as = length (takeWhile (\x -> head x < m) (iterate (next m) as))

main = do
  line <- getLine
  let [n, m] = map read (words line)
  line <- getLine
  let as = map read (words line)
  print (solve m as)

import List

notOver k xs = any (<k) xs
levelUp = concatMap (\(x:xs) -> (x + 1):xs).group.sort
solve (k:xs) = length $ takeWhile (notOver k) $ iterate levelUp xs

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

import Prelude
import List
import Char
import Data.Ord
import Data.List

main = interact q

q = func.map words.lines

func::[[String]]->String
func x = toString $ solve a b
    where
      a = toInt (x!!0!!1)
      b = map toInt (x!!1)

toInt::String->Int
toInt = read
toString::Int->String
toString=show

solve::Int->[Int]->Int
solve k x = if le == 0 then 0 else (+1) $ solve k x4
    where
      x' = filter ((< k).head) $ group x
      le = length x'
      x1 = concat $ filter ((>= k).head) $ group x
      x2 = concat $ map tail x'
      x3 = map ((+1).head) x'
      x4 = sort $ concat [x1,x2,x3]

import Data.List
main = do
    [n, k] <- (map read . words) `fmap` getLine :: IO [Int]
    l <- (map read . words) `fmap` getLine :: IO [Int]
    let f l = concat $ map (\l'@(s:ss) -> reverse $ if s < k then (s+1):ss else l') $ group l
        f1 i l | all (==k) l = i
               | otherwise = f1 (i+1) $ f l
    print $ f1 0 l

main = do
	[n,k] <- getLine >>= return . map read . words :: IO [Int]
	lst <- getLine >>= return . map read . words :: IO [Int]
	let low x = length $ filter ((>=) x) lst
	(putStrLn . show . foldl max 0) [ (k - i) + (low i - 1) | i <- [1..k], low i > 0 ]

main = do
	[n,k] <- getLine >>= return . map read . words :: IO [Int]
	lst <- getLine >>= return . map read . words :: IO [Int]
	let low x = length $ filter ((>=) x) lst
	(putStrLn . show . foldl max 0) [ (k - i) + (low i - 1) | i <- [1..k] ]


Recall that the sequence $$$b$$$ is a a subsequence of the sequence $$$a$$$ if $$$b$$$ can be derived from $$$a$$$ by removing zero or more elements without changing the order of the remaining elements. For example, if $$$a=[1, 2, 1, 3, 1, 2, 1]$$$, then possible subsequences are: $$$[1, 1, 1, 1]$$$, $$$[3]$$$ and $$$[1, 2, 1, 3, 1, 2, 1]$$$, but not $$$[3, 2, 3]$$$ and $$$[1, 1, 1, 1, 2]$$$.You are given a sequence $$$a$$$ consisting of $$$n$$$ positive and negative elements (there is no zeros in the sequence).Your task is to choose maximum by size (length) alternating subsequence of the given sequence (i.e. the sign of each next element is the opposite from the sign of the current element, like positive-negative-positive and so on or negative-positive-negative and so on). Among all such subsequences, you have to choose one which has the maximum sum of elements.In other words, if the maximum length of alternating subsequence is $$$k$$$ then your task is to find the maximum sum of elements of some alternating subsequence of length $$$k$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of elements in $$$a$$$. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$-10^9 \le a_i \le 10^9, a_i \ne 0$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$ ($$$\sum n \le 2 \cdot 10^5$$$).

For each test case, print the answer — the maximum sum of the maximum by size (length) alternating subsequence of $$$a$$$.

NoteIn the first test case of the example, one of the possible answers is $$$[1, 2, \underline{3}, \underline{-1}, -2]$$$.In the second test case of the example, one of the possible answers is $$$[-1, -2, \underline{-1}, -3]$$$.In the third test case of the example, one of the possible answers is $$$[\underline{-2}, 8, 3, \underline{8}, \underline{-4}, -15, \underline{5}, \underline{-2}, -3, \underline{1}]$$$.In the fourth test case of the example, one of the possible answers is $$$[\underline{1}, \underline{-1000000000}, \underline{1}, \underline{-1000000000}, \underline{1}, \underline{-1000000000}]$$$.

import Control.Monad

type Test = [Integer]

getTests :: Integer -> IO [Test]
getTests count = replicateM (fromIntegral count) getTest

getTest :: IO Test
getTest = do
    n <- getLine
    line <- getLine
    let list = map read (words line)
    return list

processTest :: Test -> Integer
processTest test = quantifyResult ([head test] ++ (tail test) ++ [-lastElement]) (head test) 0
    where lastElement = head $ reverse test

quantifyResult :: Test -> Integer -> Integer -> Integer
quantifyResult [x] maxElement result = result
quantifyResult (first:rest) maxElement result = if first*(head rest) > 0
                                                then quantifyResult rest (max maxElement (head rest)) result
                                                else quantifyResult rest (head rest) (result + maxElement)

printResult :: Integer -> IO ()
printResult result = print result

main :: IO ()
main = do
    count <- getLine
    tests <- getTests $ read count
    let results = map processTest tests
    mapM_ printResult results

module Main where

import Control.Monad
import Data.List

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        getLine
        a <- getIntList
        print $ f 0 0 a

pos :: Integer -> Bool
pos = (>0)

f :: Integer -> Integer -> [Integer] -> Integer
f v s [] = s + v
f 0 s (x:xs) = f x s xs
f v s (x:xs)
    | pos v == pos x = f (max x v) s xs
    | otherwise = f x (v + s) xs

module Main where

import Control.Monad
import Data.List

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        getLine
        a <- getIntList
        print $ f a

f :: [Integer] -> Integer
f = sum . map maximum . groupBy (\x y -> (x > 0) == (y > 0))

import Data.List
import Control.Monad

main = readLn >>= flip replicateM_ test

test = do
    getLine
    as <- map read . words <$> getLine
    print $ sum $ maximum <$> groupBy (\a b -> (a < 0) == (b < 0)) as

import           Control.Applicative
readArray :: IO [Integer]
readArray = do
  arrLine <- getLine
  return (map read (words arrLine) :: [Integer])

getSplitIdxs :: [(Integer, Integer, Int)] -> [Int]
getSplitIdxs [] = []
getSplitIdxs ((x, y, idx) : xs) | signum x /= signum y = idx : getSplitIdxs xs
                                | otherwise            = getSplitIdxs xs

getDifferences :: [Int] -> [Int]
getDifferences (x : xs) = x : ([ b - a | (b, a) <- zip xs (x : xs) ])
getDifferences []       = []

partition :: [Integer] -> [Int] -> [[Integer]]
partition []   []           = []
partition nums []           = [nums]
partition nums (cut : cuts) = take cut nums : partition (drop cut nums) cuts

solveCase :: IO ()
solveCase = do
  _   <- getLine
  arr <- readArray
  let zipped =
        getZipList $ (,,) <$> ZipList (drop 1 arr) <*> ZipList arr <*> ZipList
          [1 ..]
  let splitIdxs = getSplitIdxs zipped
  let diffs     = getDifferences splitIdxs
  let parts     = partition arr diffs
  putStrLn $ show (sum $ map maximum parts)

main :: IO ()
main = do
  tline <- getLine
  let ts = read tline :: Int
  sequence_ [ solveCase | _ <- [1 .. ts] ]

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  _ <- getLine
  ns <- (map read.words) <$> getLine
  print $ solve ns

solve :: [Integer] -> Integer
solve ns = sum $ map maximum $ groupBy (\x y -> (x>0) == (y>0)) ns

import Control.Monad (replicateM_)
import Data.List (groupBy)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

main :: IO ()
main = readLn >>= flip replicateM_ solveIO

solveIO :: IO ()
solveIO = getLine >> getList >>= print . solve

solve :: [Integer] -> Integer
solve = sum . map maximum . groupBy (\a b -> signum a == signum b)

data Mode = Pos | Neg

isPos :: Integer -> Bool
isPos n = n > 0

isNeg :: Integer -> Bool
isNeg n = n < 0

solve :: [Integer] -> Mode -> [Integer] -> [Integer]
solve [] _ ans = ans
solve numbers Pos ans = solve others Neg (m:ans)
  where (positives, others) = break isNeg numbers
        m = maximum positives
solve numbers Neg ans = solve others Pos (m:ans)
  where (negatives, others) = break isPos numbers
        m = maximum negatives

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (a:b:xs) = (a,b):groupByTwo xs

solve' :: [Integer] -> Integer
solve' (x:xs)
  | x > 0 = sum $ solve (x:xs) Pos []
  | otherwise = sum $ solve (x:xs) Neg []

parse :: (String, String) -> String
parse (_, arr) = show $ solve' numbers
  where numbers = map (\x -> read x :: Integer) $ words arr

main :: IO ()
main = interact (unlines . map parse .groupByTwo. tail . lines)

module Main where

import Control.Monad
import Data.List

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        getLine
        a <- getIntList
        print $ f a

f :: [Int] -> Int
f = sum . map maximum . groupBy (\x y -> (x > 0) == (y > 0))

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  _ <- getLine
  ns <- (map read.words) <$> getLine
  print $ solve ns

solve :: [Int] -> Int
solve ns = sum $ map maximum $ groupBy (\x y -> (x>0) == (y>0)) ns

import Control.Monad (replicateM_)
import Data.List (groupBy)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

main :: IO ()
main = readLn >>= flip replicateM_ solveIO

solveIO :: IO ()
solveIO = getLine >> getList >>= print . solve

solve :: [Int] -> Int
solve = sum . map maximum . groupBy (\a b -> signum a == signum b)


Let's define logical OR as an operation on two logical values (i. e. values that belong to the set {0, 1}) that is equal to 1 if either or both of the logical values is set to 1, otherwise it is 0. We can define logical OR of three or more logical values in the same manner: where  is equal to 1 if some ai = 1, otherwise it is equal to 0.Nam has a matrix A consisting of m rows and n columns. The rows are numbered from 1 to m, columns are numbered from 1 to n. Element at row i (1 ≤ i ≤ m) and column j (1 ≤ j ≤ n) is denoted as Aij. All elements of A are either 0 or 1. From matrix A, Nam creates another matrix B of the same size using formula:.(Bij is OR of all elements in row i and column j of matrix A)Nam gives you matrix B and challenges you to guess matrix A. Although Nam is smart, he could probably make a mistake while calculating matrix B, since size of A can be large.

The first line contains two integer m and n (1 ≤ m, n ≤ 100), number of rows and number of columns of matrices respectively. The next m lines each contain n integers separated by spaces describing rows of matrix B (each element of B is either 0 or 1).

In the first line, print "NO" if Nam has made a mistake when calculating B, otherwise print "YES". If the first line is "YES", then also print m rows consisting of n integers representing matrix A that can produce given matrix B. If there are several solutions print any one.

import Control.Applicative ((<$>), (<*>))
import Data.List (transpose)
import Data.Maybe (listToMaybe)

main :: IO ()
main = printSolution =<< solve <$> (toTuple . map read . words <$> getLine)
                               <*> (map (map read . words) . lines <$> getContents)

solve :: (Int, Int) -> [[Int]] -> Maybe [[Int]]
solve (n, m) xss = listToMaybe [ cross (&&) n m is js | cross (||) n m is js == xss, not (null is) == not (null js) ]
  where (is, js) = (indices xss, indices (transpose xss))

indices :: [[Int]] -> [Int]
indices xss = [ i | (i, xs) <- zip [0..] xss, all (==1) xs ]

cross :: (Bool -> Bool -> Bool) -> Int -> Int -> [Int] -> [Int] -> [[Int]]
cross f n m is js = [ [ fromEnum ((i `elem` is) `f` (j `elem` js)) | j <- [0..m-1] ] | i <- [0..n-1] ]

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

printSolution :: Maybe [[Int]] -> IO ()
printSolution Nothing = putStrLn "NO"
printSolution (Just xss) = putStrLn "YES" >> mapM_ (putStrLn . unwords . map show) xss

import Data.List (transpose)
import Data.Maybe (listToMaybe)

main :: IO ()
main = printSolution . solve . map (map read . words) . lines =<< getContents

solve :: [[Int]] -> Maybe [[Int]]
solve ([n, m] : xss) = listToMaybe [ cross (&&) n m is js | cross (||) n m is js == xss, null is == null js ]
  where (is, js) = (indices xss, indices (transpose xss))

indices :: [[Int]] -> [Int]
indices xss = [ i | (i, xs) <- zip [0..] xss, all (==1) xs ]

cross :: (Bool -> Bool -> Bool) -> Int -> Int -> [Int] -> [Int] -> [[Int]]
cross f n m is js = [ [ fromEnum ((i `elem` is) `f` (j `elem` js)) | j <- [0..m-1] ] | i <- [0..n-1] ]

printSolution :: Maybe [[Int]] -> IO ()
printSolution Nothing = putStrLn "NO"
printSolution (Just xss) = putStrLn "YES" >> mapM_ (putStrLn . unwords . map show) xss

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = map(take n).takeWhile(not.null).iterate(drop n)

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine
  mat <- map readInt.B.words <$> B.getContents
  case solve n m $ listArray((0,0),(n-1,m-1))mat of
    Nothing -> putStrLn "NO"
    Just res -> do
      putStrLn "YES"
      let xss = chunksOf m $ elems res
      putStr.unlines.map(unwords.map show) $ xss

solve :: Int -> Int -> UArray (Int,Int) Int -> Maybe (UArray (Int,Int) Int)
solve n m matB
  | calc n m matA == matB = Just matA
  | otherwise = Nothing
   where
    !matA = runSTUArray $ do
       mat <- newArray ((0,0),(n-1,m-1)) (-1) :: ST s (STUArray s (Int,Int) Int)
       let idx i j = i*m+j
       rep n $ \i-> do
         rep m $ \j-> do
           let bij = unsafeAt matB $ idx i j
           when (bij == 0) $ do
             rep n $ \k -> do
               unsafeWrite mat (idx k j) 0
             rep m $ \k -> do
               unsafeWrite mat (idx i k) 0
       rep n $ \i-> do
         rep m $ \j-> do
            aij <- unsafeRead mat $ idx i j
            when (aij<0) $ do
              unsafeWrite mat (idx i j) 1
       return mat

calc :: Int -> Int -> UArray (Int,Int) Int -> UArray (Int,Int) Int
calc n m mat = listArray ((0,0),(n-1,m-1)) [f i j|i<-[0..n-1],j<-[0..m-1]]
   where
     f i j
       | and [unsafeAt mat (i*m+k)==0|k<-[0..m-1]]
         && and [unsafeAt mat (k*m+j)==0|k<-[0..n-1]] = 0
       | otherwise = 1

import Control.Applicative ((<$>), (<*>))
import Data.List (transpose)
import Data.Maybe (listToMaybe)

main :: IO ()
main = printSolution =<< solve <$> (toTuple . map read . words <$> getLine)
                               <*> (map (map read . words) . lines <$> getContents)

solve :: (Int, Int) -> [[Int]] -> Maybe [[Int]]
solve (n, m) xss = listToMaybe [ cross (&&) n m is js | cross (||) n m is js == xss, not (null is), not (null js) ]
  where (is, js) = (indices xss, indices (transpose xss))

indices :: [[Int]] -> [Int]
indices xss = [ i | (i, xs) <- zip [0..] xss, all (==1) xs ]

cross :: (Bool -> Bool -> Bool) -> Int -> Int -> [Int] -> [Int] -> [[Int]]
cross f n m is js = [ [ fromEnum ((i `elem` is) `f` (j `elem` js)) | j <- [0..m-1] ] | i <- [0..n-1] ]

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

printSolution :: Maybe [[Int]] -> IO ()
printSolution Nothing = putStrLn "NO"
printSolution (Just xss) = putStrLn "YES" >> mapM_ (putStrLn . unwords . map show) xss

import Control.Applicative ((<$>), (<*>))
import Data.List (transpose)
import Data.Maybe (listToMaybe)

main :: IO ()
main = printSolution =<< solve <$> (toTuple . map read . words <$> getLine)
                               <*> (map (map read . words) . lines <$> getContents)

solve :: (Int, Int) -> [[Int]] -> Maybe [[Int]]
solve (n, m) xss = listToMaybe [ cross (&&) n m is js | cross (||) n m is js == xss ]
  where (is, js) = (indices xss, indices (transpose xss))

indices :: [[Int]] -> [Int]
indices xss = [ i | (i, xs) <- zip [0..] xss, all (==1) xs ]

cross :: (Bool -> Bool -> Bool) -> Int -> Int -> [Int] -> [Int] -> [[Int]]
cross f n m is js = [ [ fromEnum ((i `elem` is) `f` (j `elem` js)) | j <- [0..m-1] ] | i <- [0..n-1] ]

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

printSolution :: Maybe [[Int]] -> IO ()
printSolution Nothing = putStrLn "NO"
printSolution (Just xss) = putStrLn "YES" >> mapM_ (putStrLn . unwords . map show) xss


You need to find a binary tree of size n that satisfies a given set of c constraints. Suppose that the nodes of the unknown binary tree are labeled using a pre-order traversal starting with 1. For the i-th constraint you are given two labels, ai and bi and a direction, left or right. In case of left direction, bi is an element of the subtree rooted at ai's left child. Similarly in the case of right direction bi is an element of the subtree rooted at ai's right child.

The first line of input contains two integers n and c. The next c lines contain 2 integers ai, bi (1 ≤ ai, bi ≤ n) and either "LEFT" or "RIGHT" denoting whether b is in the subtree rooted at ai's left child or in the subtree rooted at ai's right child. The problem consists of multiple subproblems. The subproblems have different constraints on the input. You will get some score for the correct submission of the subproblem. The description of the subproblems follows.   In subproblem D1 (9 points), the constraints 1 ≤ n ≤ 100, 1 ≤ c ≤ 50 will hold.  In subproblem D2 (8 points), the constraints 1 ≤ n ≤ 1000000, 1 ≤ c ≤ 100000 will hold.

Output will be on a single line. Any binary tree that satisfies the constraints will be accepted. The tree's nodes should be printed out as n space separated labels representing an in-order traversal, using the pre-order numbers as labels of vertices. If there are no trees that satisfy the constraints, print "IMPOSSIBLE" (without quotes).

NoteConsider the first sample test. We need to find a tree with 3 nodes that satisfies the following two constraints. The node labeled 2 with pre-order traversal should be in the left subtree of the node labeled 1 with pre-order traversal; the node labeled 3 with pre-order traversal should be in the right subtree of the node labeled 1. There is only one tree with three nodes that satisfies these constraints and its in-order traversal is (2, 1, 3).Pre-order is the "root – left subtree – right subtree" order. In-order is the "left subtree – root – right subtree" order.For other information regarding in-order and pre-order, see http://en.wikipedia.org/wiki/Tree_traversal.

import Data.List
import Data.Function
import Data.Maybe

data BinTree a = Empty | Node a (BinTree a) (BinTree a) deriving (Show, Eq)
type Restriction = (Int, Int, String)

getVal :: BinTree a -> a
getVal (Node x l r) = x

buildTree :: Int -> Int -> BinTree Int
buildTree l r
	| l == r - 1 	= Node 0 Empty Empty
	| otherwise		= Node 0 (buildTree l m) (buildTree m r) where
		m = (l + r) `div` 2

updateTree :: BinTree Int -> Int -> Int -> Int -> Int -> (Int -> Int -> Int) -> BinTree Int
updateTree (Node x lt rt) l r k v f
	| l == r - 1	= Node v Empty Empty
	| k < m 		= let ut = updateTree lt l m k v f in Node (f (getVal ut) (getVal rt)) (ut) (rt)
	| k >= m 		= let ut = updateTree rt m r k v f in Node (f (getVal lt) (getVal ut)) (lt) (ut) where
		m = (l + r) `div` 2

getSegm	:: BinTree Int -> Int -> Int -> Int -> Int -> (Int -> Int -> Int) -> Int
getSegm (Node x left right) l r lt rt f
	| l == lt && r == rt 	= x
	| rt <= m				= getSegm left 	l m lt rt f
	| lt >= m 				= getSegm right m r lt rt f
	| otherwise				= f (getSegm left l m lt m f) (getSegm right m r m rt f) where
		m = (l + r) `div` 2

getMaxNode' :: [[Restriction]] -> Int -> BinTree Int
getMaxNode' ls x = tree where
	len = length ls
	tree' = buildTree 0 len
	tree = foldr (\x tr -> updateTree tr 0 len x (f x) max) tree' [0..(len - 1)]
	f :: Int -> Int
	f v
		| k == -1	= v
		| otherwise	= maximum $ [k, (getSegm tree 0 len (v + 1) (k + 1) max)] where
			k 	= maximum $ -1 : (map (\(a,b,c) -> b) (ls !! v))

getMaxNode :: [[Restriction]] -> Int -> Int
getMaxNode ls x = (map f [0..] !! x) where
	len = length ls
	tree'' = getMaxNode' ls x
	f :: Int -> Int
	f v
		| k == -1 	= -1
		| otherwise	= maximum $[k, (getSegm tree'' 0 len (v + 1) (k + 1) max)] where
			k = maximum $ -1 : (map (\(a,b,c) -> b) $ filter (\(a,b,c) -> c == "LEFT") (ls !! v))

getMinNode :: [[Restriction]] -> Int -> Int
getMinNode ls x = (map f [0..] !! x) where
	len = length ls
	f :: Int -> Int
	f v = minimum $ 1000000000 : (map (\(a,b,c) -> b) $ filter (\(a,b,c) -> c == "RIGHT") (ls !! v))

groupRestrictions :: Int -> [Restriction] -> [[Restriction]]
groupRestrictions ts ls = f 0 ls'' [] where
	ls'		= map (\(a,b,c) -> (a-1, b-1, c)) ls
	ls'' 	= groupBy (\(a,_,_) (b,_,_) -> a == b) $ sort ls'
	f val [] accum
		| ts == val = accum
		| otherwise	= f (val+1) [] (accum ++ [[]])
	f val (x:xs) accum
		| ts == val 					= accum
		| val == (\(x,_,_)->x)(head x)	= f	(val+1) xs (accum ++ [x])
		| otherwise						= f (val+1) (x:xs) (accum ++ [[]])

getAnswer :: [[Restriction]] -> [Int] -> Maybe [Int]
getAnswer _ [] = Just []
getAnswer ls (x:xs)
	| l >= r = Nothing
	| (isNothing left) || (isNothing right) = Nothing
	| otherwise	= Just $ (fromJust left) ++ [x] ++ (fromJust right) where
		l = getMaxNode ls x
		r = getMinNode ls x
		left = getAnswer ls [y | y <- xs, y <= l]
		right = getAnswer ls [y | y <- xs, y > l]

getAnswer' :: [Restriction] -> Int -> String
getAnswer' ls len
	| any (\(a,b,c) -> a >= b) ls 	= "IMPOSSIBLE"
	| isNothing ans					= "IMPOSSIBLE"
	| otherwise						= intercalate " " $ map (\x -> show (x + 1)) (fromJust ans) where
		ans = getAnswer (groupRestrictions len ls) [0..(len-1)]

formRestList :: [Restriction] -> [String] -> [Restriction]
formRestList accum [] = accum
formRestList accum (x:y:z:ls) = formRestList ((read x::Int, read y::Int, z):accum) ls

main :: IO()
main = do
	[a,b] <- fmap (map read . words) getLine
	contents <- getContents
	let x = (getAnswer' (formRestList [] (words contents)) a)
	putStrLn x

import Data.List
import Data.Function
import Data.Maybe

data BinTree a = Node a [BinTree a] [BinTree a] deriving (Show, Eq)
type Restriction = (Int, Int, String)

checkRestrictions :: [Restriction] -> Bool
checkRestrictions = all (\(a,b,c) -> a < b)

fst' :: (a,b,c) -> a
fst' (a,_,_) = a

vv :: BinTree a -> a
vv (Node x l r) = x

ll :: BinTree a -> [BinTree a]
ll (Node x l r) = l

rr :: BinTree a -> [BinTree a]
rr (Node x l r) = r

rightMap :: (a -> b) -> [a] -> [b]
rightMap _ [] = []
rightMap f ls = (rightMap f (init ls)) ++ [f (last ls)]

getMinNode :: BinTree Int -> Int
getMinNode (Node x l r) = (map f [0..] !! x) where
	f v
		| l == [] && r == [] 	= v
		| otherwise				= minimum [vv optTree, getMinNode optTree] where
			optTree = minimumBy (compare `on` vv) (l ++ r)

getMaxNode :: BinTree Int -> Int
getMaxNode (Node x l r) = (map f [0..] !! x) where
	f v
		| l == [] && r == [] 	= v
		| otherwise				= maximum [vv optTree, getMaxNode optTree] where
			optTree = maximumBy (compare `on` vv) (l ++ r)

getRestTree :: [[Restriction]] -> Int -> Int -> (BinTree Int)
getRestTree ls treeSize = (map f [0..] !!) where
	f :: Int -> BinTree Int
	f v = Node v [getRestTree ls treeSize v | v <- leftChilds] [getRestTree ls treeSize v | v <- rightChilds]	where
		leftChilds = map (\(a,b,c) -> b) $ filter (\(a,b,c) -> c == "LEFT") (ls !! v)
		rightChilds = map (\(a,b,c) -> b) $ filter (\(a,b,c) -> c == "RIGHT") (ls !! v)

getRestTrees :: Int -> [Restriction] -> [BinTree Int]
getRestTrees treeSize restList = map (\x -> getRestTree (restList') treeSize x) [0..(treeSize-1)] where
	nyaRestList		= map (\(a,b,c) -> (a-1, b-1, c)) restList
	groupedRestList = groupBy (\(a,_,_) (b,_,_) -> a == b) $ sort nyaRestList
	formRestList tsz val [] accum
		| tsz == val 	= accum
		| otherwise	 	= formRestList tsz (val+1) [] (accum ++ [[]])
	formRestList tsz val (x:xs) accum
		| tsz == val 				= accum
		| val == fst' (head x)		= formRestList 	tsz (val+1) xs (accum ++ [x])
		| otherwise					= formRestList	tsz (val+1) (x:xs) (accum ++ [[]])
	restList' = formRestList treeSize 0 groupedRestList []

getResultTree :: [Int] -> [BinTree Int] -> Maybe (BinTree Int)
getResultTree (x:xs) rest
	| l >= r					= Nothing
	| left == [] && right == [] = Just (Node x [] [])
	| right == [] 				= let yy = getResultTree left rest in if isNothing yy then Nothing else Just (Node x [fromJust yy] [])
	| left == []				= let yy = getResultTree right rest in if isNothing yy then Nothing else Just (Node x [] [fromJust yy])
	| otherwise					= let aa = getResultTree left rest; bb = getResultTree right rest in if ((isNothing aa) || (isNothing bb)) then Nothing else Just (Node x [fromJust aa] [fromJust bb]) where
		l = maximum ([-1] ++ (map getMaxNode (ll (rest!!x))))
		r = minimum ([1000000000] ++ (map getMinNode (rr (rest!!x))))
		left  = [y | y <- xs, y <= l]
		right = [y | y <- xs, y >  l]

getAnswer :: Int -> [Restriction] -> Maybe (BinTree Int)
getAnswer ts ls
	| any (\(a,b,c) -> a > b) ls 	= Nothing
	| otherwise						= getResultTree [0..(ts-1)] (getRestTrees ts ls)

sovsemGetAnswer :: Int -> [Restriction] -> String
sovsemGetAnswer x ls
	| isNothing ans = "IMPOSSIBLE"
	| otherwise		= intercalate " " (map (\x -> show (x+1)) $ symmetricAns (fromJust ans)) where
		ans = getAnswer x ls
		symmetricAns :: BinTree Int -> [Int]
		symmetricAns (Node x [l] [r]) = symmetricAns l ++ [x] ++ symmetricAns r
		symmetricAns (Node x [l] []) = symmetricAns l ++ [x]
		symmetricAns (Node x [] [r]) = [x] ++ symmetricAns r
		symmetricAns (Node x [] []) = [x]

formRestList :: [Restriction] -> [String] -> [Restriction]
formRestList accum [] = accum
formRestList accum (x:y:z:ls) = formRestList ((read x::Int, read y::Int, z):accum) ls

main :: IO()
main = do
	[a,b] <- fmap (map read . words) getLine
	contents <- getContents
	let x = sovsemGetAnswer (a) (formRestList [] (words contents))
	putStrLn x

import Data.List
import Data.Function
import Data.Maybe

data BinTree a = Node a [BinTree a] [BinTree a] deriving (Show, Eq)
type Restriction = (Int, Int, String)

checkRestrictions :: [Restriction] -> Bool
checkRestrictions = all (\(a,b,c) -> a < b)

fst' :: (a,b,c) -> a
fst' (a,_,_) = a

vv :: BinTree a -> a
vv (Node x l r) = x

ll :: BinTree a -> [BinTree a]
ll (Node x l r) = l

rr :: BinTree a -> [BinTree a]
rr (Node x l r) = r

rightMap :: (a -> b) -> [a] -> [b]
rightMap _ [] = []
rightMap f ls = (rightMap f (init ls)) ++ [f (last ls)]

getMinNode :: BinTree Int -> Int
getMinNode (Node x l r) = (map f [0..] !! x) where
	f v
		| l == [] && r == [] 	= v
		| otherwise				= minimum [v, vv optTree, getMinNode optTree] where
			optTree = minimumBy (compare `on` vv) (l ++ r)

getMaxNode :: BinTree Int -> Int
getMaxNode (Node x l r) = (map f [0..] !! x) where
	f v
		| l == [] && r == [] 	= v
		| otherwise				= maximum [v, vv optTree, getMaxNode optTree] where
			optTree = maximumBy (compare `on` vv) (l ++ r)

getRestTree :: [[Restriction]] -> Int -> Int -> (BinTree Int)
getRestTree ls treeSize = (map f [0..] !!) where
	f :: Int -> BinTree Int
	f v = Node v [getRestTree ls treeSize v | v <- leftChilds] [getRestTree ls treeSize v | v <- rightChilds]	where
		leftChilds = map (\(a,b,c) -> b) $ filter (\(a,b,c) -> c == "LEFT") (ls !! v)
		rightChilds = map (\(a,b,c) -> b) $ filter (\(a,b,c) -> c == "RIGHT") (ls !! v)

getRestTrees :: Int -> [Restriction] -> [BinTree Int]
getRestTrees treeSize restList = map (\x -> getRestTree (restList') treeSize x) [0..(treeSize-1)] where
	nyaRestList		= map (\(a,b,c) -> (a-1, b-1, c)) restList
	groupedRestList = groupBy (\(a,_,_) (b,_,_) -> a == b) $ sort nyaRestList
	formRestList tsz val [] accum
		| tsz == val 	= accum
		| otherwise	 	= formRestList tsz (val+1) [] (accum ++ [[]])
	formRestList tsz val (x:xs) accum
		| tsz == val 				= accum
		| val == fst' (head x)		= formRestList 	tsz (val+1) xs (accum ++ [x])
		| otherwise					= formRestList	tsz (val+1) (x:xs) (accum ++ [[]])
	restList' = formRestList treeSize 0 groupedRestList []

getResultTree :: [Int] -> [BinTree Int] -> Maybe (BinTree Int)
getResultTree (x:xs) rest
	| l >= r					= Nothing
	| left == [] && right == [] = Just (Node x [] [])
	| right == [] 				= let yy = getResultTree left rest in if isNothing yy then Nothing else Just (Node x [fromJust yy] [])
	| left == []				= let yy = getResultTree right rest in if isNothing yy then Nothing else Just (Node x [] [fromJust yy])
	| otherwise					= let aa = getResultTree left rest; bb = getResultTree right rest in if ((isNothing aa) || (isNothing bb)) then Nothing else Just (Node x [fromJust aa] [fromJust bb]) where
		l = maximum ([-1] ++ (map getMaxNode (ll (rest!!x))))
		r = minimum ([1000000000] ++ (map getMinNode (rr (rest!!x))))
		left  = [y | y <- xs, y <= l]
		right = [y | y <- xs, y >  l]

getAnswer :: Int -> [Restriction] -> Maybe (BinTree Int)
getAnswer ts ls
	| any (\(a,b,c) -> a > b) ls 	= Nothing
	| otherwise						= getResultTree [0..(ts-1)] (getRestTrees ts ls)

sovsemGetAnswer :: Int -> [Restriction] -> String
sovsemGetAnswer x ls
	| isNothing ans = "IMPOSSIBLE"
	| otherwise		= intercalate " " (map (\x -> show (x+1)) $ symmetricAns (fromJust ans)) where
		ans = getAnswer x ls
		symmetricAns :: BinTree Int -> [Int]
		symmetricAns (Node x [l] [r]) = symmetricAns l ++ [x] ++ symmetricAns r
		symmetricAns (Node x [l] []) = symmetricAns l ++ [x]
		symmetricAns (Node x [] [r]) = [x] ++ symmetricAns r
		symmetricAns (Node x [] []) = [x]

formRestList :: [Restriction] -> [String] -> [Restriction]
formRestList accum [] = accum
formRestList accum (x:y:z:ls) = formRestList ((read x::Int, read y::Int, z):accum) ls

main :: IO()
main = do
	[a,b] <- fmap (map read . words) getLine
	contents <- getContents
	let x = sovsemGetAnswer (a) (formRestList [] (words contents))
	putStrLn x

import Data.List
import Data.Function
import Data.Maybe

data BinTree a = Empty | Node a (BinTree a) (BinTree a) deriving (Show, Eq)
type Restriction = (Int, Int, String)

getVal :: BinTree a -> a
getVal (Node x l r) = x

buildTree :: Int -> Int -> BinTree Int
buildTree l r
	| l == r - 1 	= Node 0 Empty Empty
	| otherwise		= Node 0 (buildTree l m) (buildTree m r) where
		m = (l + r) `div` 2

updateTree :: BinTree Int -> Int -> Int -> Int -> Int -> (Int -> Int -> Int) -> BinTree Int
updateTree (Node x lt rt) l r k v f
	| l == r - 1	= Node v Empty Empty
	| k < m 		= let ut = updateTree lt l m k v f in Node (f (getVal ut) (getVal rt)) (ut) (rt)
	| k >= m 		= let ut = updateTree rt m r k v f in Node (f (getVal lt) (getVal ut)) (lt) (ut) where
		m = (l + r) `div` 2

getSegm	:: BinTree Int -> Int -> Int -> Int -> Int -> (Int -> Int -> Int) -> Int
getSegm (Node x left right) l r lt rt f
	| l == lt && r == rt 	= x
	| rt <= m				= getSegm left 	l m lt rt f
	| lt >= m 				= getSegm right m r lt rt f
	| otherwise				= f (getSegm left l m lt m f) (getSegm right m r m rt f) where
		m = (l + r) `div` 2

getMaxNode' :: [[Restriction]] -> Int -> BinTree Int
getMaxNode' ls x = tree where
	len = length ls
	tree' = buildTree 0 len
	tree = foldr (\x tr -> updateTree tr 0 len x (f x) max) tree' [0..(len - 1)]
	f :: Int -> Int
	f v
		| k == -1	= v
		| otherwise	= maximum $ [k, (getSegm tree 0 len (v + 1) (k + 1) max)] where
			k 	= maximum $ -1 : (map (\(a,b,c) -> b) (ls !! v))

getMaxNode :: [[Restriction]] -> Int -> Int
getMaxNode ls x = (map f [0..] !! x) where
	len = length ls
	tree'' = getMaxNode' ls x
	f :: Int -> Int
	f v
		| k == -1 	= -1
		| otherwise	= maximum $[k, (getSegm tree'' 0 len (v + 1) (k + 1) max)] where
			k = maximum $ -1 : (map (\(a,b,c) -> b) $ filter (\(a,b,c) -> c == "LEFT") (ls !! v))

getMinNode' :: [[Restriction]] -> Int -> BinTree Int
getMinNode' ls x = tree where
	len = length ls
	tree' = buildTree 0 len
	tree = foldr (\x tr -> updateTree tr 0 len x (f x) min) tree' [0..(len - 1)]
	f :: Int -> Int
	f v
		| k == 1000000000	= v
		| otherwise			= minimum $ [k, (getSegm tree 0 len (v) (k) min)] where
			k = minimum $ 1000000000 : (map (\(a,b,c) -> b) (ls !! v))

getMinNode :: [[Restriction]] -> Int -> Int
getMinNode ls x = (map f [0..] !! x) where
	len = length ls
	tree'' = getMinNode' ls x
	f :: Int -> Int
	f v
		| k == 1000000000 	= 1000000000
		| otherwise			= minimum $ [k, (getSegm tree'' 0 len (v) (k) min)] where
			k = minimum $ 1000000000 : (map (\(a,b,c) -> b) $ filter (\(a,b,c) -> c == "RIGHT") (ls !! v))

groupRestrictions :: Int -> [Restriction] -> [[Restriction]]
groupRestrictions ts ls = f 0 ls'' [] where
	ls'		= map (\(a,b,c) -> (a-1, b-1, c)) ls
	ls'' 	= groupBy (\(a,_,_) (b,_,_) -> a == b) $ sort ls'
	f val [] accum
		| ts == val = accum
		| otherwise	= f (val+1) [] (accum ++ [[]])
	f val (x:xs) accum
		| ts == val 					= accum
		| val == (\(x,_,_)->x)(head x)	= f	(val+1) xs (accum ++ [x])
		| otherwise						= f (val+1) (x:xs) (accum ++ [[]])

getAnswer :: [[Restriction]] -> [Int] -> Maybe [Int]
getAnswer _ [] = Just []
getAnswer ls (x:xs)
	| (isNothing left) || (isNothing right) = Nothing
	| otherwise	= Just $ (fromJust left) ++ [x] ++ (fromJust right) where
		l = getMaxNode ls x
		left = getAnswer ls [y | y <- xs, y <= l]
		right = getAnswer ls [y | y <- xs, y > l]

getAnswer' :: [Restriction] -> Int -> String
getAnswer' ls len
	| any (\(a,b,c) -> a >= b) ls 	= "IMPOSSIBLE"
	| isNothing ans					= "IMPOSSIBLE"
	| otherwise						= intercalate " " $ map (\x -> show (x + 1)) (fromJust ans) where
		ans = getAnswer (groupRestrictions len ls) [0..(len-1)]

formRestList :: [Restriction] -> [String] -> [Restriction]
formRestList accum [] = accum
formRestList accum (x:y:z:ls) = formRestList ((read x::Int, read y::Int, z):accum) ls

main :: IO()
main = do
	[a,b] <- fmap (map read . words) getLine
	contents <- getContents
	let x = (getAnswer' (formRestList [] (words contents)) a)
	putStrLn x


While Mahmoud and Ehab were practicing for IOI, they found a problem which name was Longest common subsequence. They solved it, and then Ehab challenged Mahmoud with another problem.Given two strings a and b, find the length of their longest uncommon subsequence, which is the longest string that is a subsequence of one of them and not a subsequence of the other.A subsequence of some string is a sequence of characters that appears in the same order in the string, The appearances don't have to be consecutive, for example, strings "ac", "bc", "abc" and "a" are subsequences of string "abc" while strings "abbc" and "acb" are not. The empty string is a subsequence of any string. Any string is a subsequence of itself.

The first line contains string a, and the second line — string b. Both of these strings are non-empty and consist of lowercase letters of English alphabet. The length of each string is not bigger than 105 characters.

If there's no uncommon subsequence, print "-1". Otherwise print the length of the longest uncommon subsequence of a and b.

NoteIn the first example: you can choose "defgh" from string b as it is the longest subsequence of string b that doesn't appear as a subsequence of string a.

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

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

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

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

main = do
	[ s, t ] <- lines <$> getContents
	print $ which (-1) ( max ( length s ) ( length t ) ) $ s == t

main = interact $ show . solve . words

solve [a, b] = if a == b then -1 else max (length a) (length b)

main = do
        str1 <- getLine
        str2 <- getLine
        print (if str1 /= str2 then (max (length str1) (length str2)) else -1)

{-#  LANGUAGE NegativeLiterals #-}
import Data.List
import Data.Function
main = interact $  show . (\[x,y] -> if x == y then -1 else length $ maximumBy (compare `on` length) [x,y]) . lines

main :: IO ()
main = interact foo

foo :: String -> String
foo inp =
    let (a:b:_) = lines inp
    in if a == b
        then "-1"
        else show $ max (length a) (length b)

main = interact $ show . solve . lines
solve [a,b] | length a == length b = if a == b then -1 else length a
            | otherwise = max (length a) (length b)

main = do
    s1 <- getLine
    s2 <- getLine
    if s1 == s2
        then print (-1)
    else print $ max (length s1) (length s2)

main = interact $ printAns. solve. readInp

readInp = lines
solve (a:b:_)
	| a /= b = max (length a) (length b)
	| otherwise = -1
printAns = show

main = do
    a_ <- getLine
    b_ <- getLine
    let
	lenA = length a_
	lenB = length b_
    print $ if a_/=b_
	then max lenA lenB
	else -1

main = do
    a <- getLine
    b <- getLine
    print $ if a == b then -1 else max (length a) (length b)

main = do
        str1 <- getLine
        str2 <- getLine
        putStrLn (if str1 /= str2 then (if (length str1) > (length str2) then str1 else str2) else "-1")

import Data.List
import Data.Function
main = interact $  (\[x,y] -> if x == y then "-1" else maximumBy (compare `on` length) [x,y]) . lines


Mishka received a gift of multicolored pencils for his birthday! Unfortunately he lives in a monochrome world, where everything is of the same color and only saturation differs. This pack can be represented as a sequence a1, a2, ..., an of n integer numbers — saturation of the color of each pencil. Now Mishka wants to put all the mess in the pack in order. He has an infinite number of empty boxes to do this. He would like to fill some boxes in such a way that:  Each pencil belongs to exactly one box;  Each non-empty box has at least k pencils in it;  If pencils i and j belong to the same box, then |ai - aj| ≤ d, where |x| means absolute value of x. Note that the opposite is optional, there can be pencils i and j such that |ai - aj| ≤ d and they belong to different boxes. Help Mishka to determine if it's possible to distribute all the pencils into boxes. Print "YES" if there exists such a distribution. Otherwise print "NO".

The first line contains three integer numbers n, k and d (1 ≤ k ≤ n ≤ 5·105, 0 ≤ d ≤ 109) — the number of pencils, minimal size of any non-empty box and maximal difference in saturation between any pair of pencils in the same box, respectively. The second line contains n integer numbers a1, a2, ..., an (1 ≤ ai ≤ 109) — saturation of color of each pencil.

Print "YES" if it's possible to distribute all the pencils into boxes and satisfy all the conditions. Otherwise print "NO".

NoteIn the first example it is possible to distribute pencils into 2 boxes with 3 pencils in each with any distribution. And you also can put all the pencils into the same box, difference of any pair in it won't exceed 10.In the second example you can split pencils of saturations [4, 5, 3, 4] into 2 boxes of size 2 and put the remaining ones into another box.

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.List as L (sort)
import qualified Data.Char as C (isSpace)
import qualified Data.Bits as B (testBit)

readInt = fst . M.fromJust . C.readInt

-- Binary Indexed Tree (BIT)
bitL = 20 :: Int
data BIT = Empty | Node {-# UNPACK #-} !Int !BIT !BIT
create :: BIT
create = cre bitL where
    cre 0 = Empty
    cre k = let crp = cre (k - 1) in Node 0 crp crp
insert :: Int -> BIT -> BIT
insert i bit = ins bit (bitL - 1) where
    ins Empty _ = Empty
    ins (Node y l r) !j | i `B.testBit` j = Node y (ins l (j - 1)) r
                        | otherwise = Node (y + 1) l (ins r (j - 1))
query :: Int -> BIT -> Int
query i bit = que bit (bitL - 1) 0 where
    que Empty _ x = x
    que (Node y l r) !j !x | i `B.testBit` j = que l (j - 1) (x + y)
                           | otherwise = que r (j - 1) x

main = do
    (map readInt . C.words -> [n, k, d]) <- B.getLine
    (L.sort . map readInt . C.words -> xs) <- B.getLine
    let f [] pp n rs | pp == [] = rs | otherwise = f [] (tail pp) n (n:rs)
        f xx@(x:xs) pp@(p:ps) i rs | abs (x - p) <= d = f xs pp (i + 1) rs | otherwise = f xx ps i (i:rs)
        g bit [] [] _ = query 1 bit
        g bit (x:xs) (p:ps) i = g nbit xs ps (i - 1) where
            nbit = if p - i >= k && query (p + 1) bit - query (i + k) bit /= 0 then insert i bit else bit
    putStrLn $ if g (insert n create) (reverse xs) (f xs xs 0 []) (n - 1) == 1 then "YES" else "NO"


In the pet store on sale there are:  $$$a$$$ packs of dog food;  $$$b$$$ packs of cat food;  $$$c$$$ packs of universal food (such food is suitable for both dogs and cats). Polycarp has $$$x$$$ dogs and $$$y$$$ cats. Is it possible that he will be able to buy food for all his animals in the store? Each of his dogs and each of his cats should receive one pack of suitable food for it.

The first line of input contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the input. Then $$$t$$$ lines are given, each containing a description of one test case. Each description consists of five integers $$$a, b, c, x$$$ and $$$y$$$ ($$$0 \le a,b,c,x,y \le 10^8$$$).

For each test case in a separate line, output:   YES, if suitable food can be bought for each of $$$x$$$ dogs and for each of $$$y$$$ cats;  NO else.  You can output YES and NO in any case (for example, strings yEs, yes, Yes and YES will be recognized as a positive response).

module Main where

import Control.Monad (replicateM_)

getNumbers :: IO [Int]
getNumbers = do
  map read . words <$> getLine

solution :: IO ()
solution = do
  [a, b, c, x, y] <- getNumbers
  let a_ = max 0 (x - a)
      b_ = max 0 (y - b)
      ans = if a_ + b_ <= c then "Yes" else "No"
  putStrLn ans

main :: IO ()
main = do
  [t] <- getNumbers
  replicateM_ t solution

module Main where

getNumbers :: IO [Int]
getNumbers = do
  line <- getLine
  return $ map read $ words line

solution :: () -> IO ()
solution _ = do
  [a, b, c, x, y] <- getNumbers
  let a_ = max 0 $ (x - a)
      b_ = max 0 $ (y - b)
      ans = if a_ + b_ <= c then "Yes" else "No"
  putStrLn ans

main :: IO ()
main = do
  [t] <- getNumbers

  mapM_ solution $ replicate t ()

type Task = [TestCase]
type TestCase = (Int, Int, Int, Int, Int)

readInt :: String -> Int
readInt = read

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

parseInput :: String -> Task
parseInput contents = let input = tail . map (map readInt . words) . lines $ contents in
                      let parseTestCase (a:b:c:x:y:[]) = (a, b, c, x, y) in
                      map parseTestCase input

solve :: Task -> [Bool]
solve = map solveTestCase
    where solveTestCase (a, b, c, x, y) = x <= a + c && y <= b + c && x + y <= a + b + c

formatOutput :: [Bool] -> String
formatOutput = unlines . map showBool

main = getContents >>= (putStr . formatOutput . solve . parseInput)


Ashish has a binary string $$$s$$$ of length $$$n$$$ that he wants to sort in non-decreasing order.He can perform the following operation:   Choose a subsequence of any length such that its elements are in non-increasing order. Formally, choose any $$$k$$$ such that $$$1 \leq k \leq n$$$ and any sequence of $$$k$$$ indices $$$1 \le i_1 \lt i_2 \lt \ldots \lt i_k \le n$$$ such that $$$s_{i_1} \ge s_{i_2} \ge \ldots \ge s_{i_k}$$$.  Reverse this subsequence in-place. Formally, swap $$$s_{i_1}$$$ with $$$s_{i_k}$$$, swap $$$s_{i_2}$$$ with $$$s_{i_{k-1}}$$$, $$$\ldots$$$ and swap $$$s_{i_{\lfloor k/2 \rfloor}}$$$ with $$$s_{i_{\lceil k/2 \rceil + 1}}$$$ (Here $$$\lfloor x \rfloor$$$ denotes the largest integer not exceeding $$$x$$$, and $$$\lceil x \rceil$$$ denotes the smallest integer not less than $$$x$$$) Find the minimum number of operations required to sort the string in non-decreasing order. It can be proven that it is always possible to sort the given binary string in at most $$$n$$$ operations.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 1000)$$$  — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ $$$(1 \le n \le 1000)$$$  — the length of the binary string $$$s$$$. The second line of each test case contains a binary string $$$s$$$ of length $$$n$$$ containing only $$$0$$$s and $$$1$$$s. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$1000$$$.

For each test case output the following:   The minimum number of operations $$$m$$$ in the first line ($$$0 \le m \le n$$$).  Each of the following $$$m$$$ lines should be of the form: $$$k$$$ $$$i_1$$$ $$$i_2$$$ ... $$$i_{k}$$$, where $$$k$$$ is the length and $$$i_1 \lt i_2 \lt ... \lt i_{k}$$$ are the indices of the chosen subsequence. For them the conditions from the statement must hold.

NoteIn the first test case, the binary string is already sorted in non-decreasing order.In the second test case, we can perform the following operation:   $$$k = 4:$$$ choose the indices $$$\{1, 3, 4, 5\}$$$$$$\underline{1}$$$ $$$0$$$ $$$\underline{1}$$$ $$$\underline{0}$$$ $$$\underline{0}$$$ $$$\rightarrow $$$ $$$\underline{0}$$$ $$$0$$$ $$$\underline{0}$$$ $$$\underline{1}$$$ $$$\underline{1}$$$ In the third test case, we can perform the following operation:  $$$k = 3:$$$ choose the indices $$$\{3, 5, 6\}$$$$$$0$$$ $$$0$$$ $$$\underline{1}$$$ $$$0$$$ $$$\underline{0}$$$ $$$\underline{0}$$$ $$$\rightarrow $$$ $$$0$$$ $$$0$$$ $$$\underline{0}$$$ $$$0$$$ $$$\underline{0}$$$ $$$\underline{1}$$$

import Control.Monad (replicateM_)
import Data.List

solve :: IO ()
solve = do
  m <- read <$> getLine
  bs <- getLine
  let
    m0 = length $ filter (=='0') bs
    cs = replicate m0 '0' ++ replicate (m-m0) '1'
    ds = zip [1..] $ zipWith (/=) bs cs
    es = [i | (i,j)<-ds, j==True]
  print $ if null es then 0 else 1
  if null es then return () else putStrLn $ intercalate " " $ fmap show $ (length es) : es

main :: IO ()
main = do
  n <- read <$> getLine
  replicateM_ n solve

import Control.Monad
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    s <- takeWhile (not . isSpace) . C.unpack <$> C.getLine
    let cnt0 = length $ filter (=='0') s
        ans = [i | (i, x, y) <- zip3 [1..] s $ replicate cnt0 '0' ++ repeat '1', x /= y]
    if null ans
        then print 0
        else print 1 >> putStrLn (unwords $ map show $ length ans : ans)

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool

main :: IO ()
-- main = C.interact $ runScanner input >>> solve >>> output
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC { n :: Int, s :: String }

input :: Scanner TC
input = do
  n <- int
  s <- str
  return TC {..}

type Output = [[Int]]

output :: Output -> C.ByteString
output ops = C.pack . unlines $ show (length ops) : map showl ops
  where
    showl xs = unwords . map show $ length xs : xs

solve :: TC -> Output
solve TC {..}
  | null bs0 = []
  | otherwise = [bs1 ++ bs0]
  where
    c0 = count '0' s
    bs0 = [i | (c, i) <- zip s [1..], c == '0', i > c0]
    bs1 = [i | (c, i) <- zip s [1..], c == '1', i <= c0]

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show

import Control.Monad (replicateM_)
import Data.List

solve :: IO ()
solve = do
  m <- read <$> getLine
  bs <- getLine
  let
    m0 = length $ filter (=='0') bs
    cs = replicate m0 '0' ++ replicate (m-m0) '1'
    ds = zip [1..] $ zipWith (/=) bs cs
    es = [i | (i,j)<-ds, j==True]
  print $ if null es then 0 else 1
  putStrLn $ intercalate " " $ fmap show $ (length es) : es

main :: IO ()
main = do
  n <- read <$> getLine
  replicateM_ n solve

import Control.Monad (replicateM_)
import Data.List

solve :: IO ()
solve = do
  m <- read <$> getLine
  bs <- getLine
  let
    m0 = length $ filter (=='0') bs
    cs = replicate m0 '0' ++ replicate (m-m0) '1'
    ds = zip [1..] $ zipWith (/=) bs cs
    es = [i | (i,j)<-ds, j==True]
  print $ if null es then 0 else 1
  print $ intercalate " " $ fmap show $ (length es) : es

main :: IO ()
main = do
  n <- read <$> getLine
  replicateM_ n solve

import Control.Monad
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    s <- takeWhile (not . isSpace) . C.unpack <$> C.getLine
    let cnt0 = length $ filter (=='0') s
        ans = [i | (i, x, y) <- zip3 [1..] s $ replicate cnt0 '0' ++ repeat '1', x /= y]
    if null ans
        then print 0
        else print 1 >> putStrLn (unwords $ map show ans)

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts


A string $$$s$$$ of length $$$n$$$, consisting of lowercase letters of the English alphabet, is given.You must choose some number $$$k$$$ between $$$0$$$ and $$$n$$$. Then, you select $$$k$$$ characters of $$$s$$$ and permute them however you want. In this process, the positions of the other $$$n-k$$$ characters remain unchanged. You have to perform this operation exactly once.For example, if $$$s=\texttt{"andrea"}$$$, you can choose the $$$k=4$$$ characters $$$\texttt{"a_d_ea"}$$$ and permute them into $$$\texttt{"d_e_aa"}$$$ so that after the operation the string becomes $$$\texttt{"dneraa"}$$$.Determine the minimum $$$k$$$ so that it is possible to sort $$$s$$$ alphabetically (that is, after the operation its characters appear in alphabetical order).

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 40$$$) — the length of the string. The second line of each test case contains the string $$$s$$$. It is guaranteed that $$$s$$$ contains only lowercase letters of the English alphabet.

For each test case, output the minimum $$$k$$$ that allows you to obtain a string sorted alphabetically, through the operation described above.

NoteIn the first test case, we can choose the $$$k=2$$$ characters $$$\texttt{"_ol"}$$$ and rearrange them as $$$\texttt{"_lo"}$$$ (so the resulting string is $$$\texttt{"llo"}$$$). It is not possible to sort the string choosing strictly less than $$$2$$$ characters.In the second test case, one possible way to sort $$$s$$$ is to consider the $$$k=6$$$ characters $$$\texttt{"_o__force_"}$$$ and rearrange them as $$$\texttt{"_c__efoor_"}$$$ (so the resulting string is $$$\texttt{"ccdeefoors"}$$$). One can show that it is not possible to sort the string choosing strictly less than $$$6$$$ characters.In the third test case, string $$$s$$$ is already sorted (so we can choose $$$k=0$$$ characters).In the fourth test case, we can choose all $$$k=4$$$ characters $$$\texttt{"dcba"}$$$ and reverse the whole string (so the resulting string is $$$\texttt{"abcd"}$$$).

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    s <- getLine
    print $ length $ filter id $ zipWith (/=) s (sort s)

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

import Control.Monad
import Data.List

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

solve = do
    s <- getLine
    s <- getLine
    let t = sort s
    print $ sum $ zipWith (\x y -> if x /= y then 1 else 0) t s

main = do
    [t] <- readIntLine
    replicateM t solve
    return ()

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

-- main :: IO [()]
main = do
    n <- read <$> getLine
    replicateM n $ do
        y <- read <$> getLine
        x <- getLine
        print $ y - solve x

solve :: [Char] -> Int
solve x = foldr (\(i,j) acc -> if i == j then acc + 1 else acc) 0 (zip x (sort x))

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified Data.Ratio as Rat

import Data.List as L
import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  s <- getLine
  let res = zipWith (\a b -> a == b) s $ sort s
      sol = length $ filter (==False) res
    in print sol

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

----------------------------------------------------------------------------------------
readrows :: (Integral b) => b -> IO [String]
readrows 0 = return []
readrows n = do
  row <- getLine
  l <- readrows $ n-1
  return (row : l)

readintrows :: (Integral a, Integral b) => b -> IO [[a]]
readintrows 0 = return []
readintrows n = do
  row <- readInts
  l <- readintrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs

import Control.Monad
import Data.List

printResult = do
    n <- getLine
    s <- getLine
    let ss = sort s
    print $ sum $ zipWith (\x y->if x /= y then 1 else 0) ss s

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

import Control.Arrow ((>>>))
import Data.List (sort)

main :: IO ()
main = interact $ words >>> drop 1 >>> chunksOf 2 >>> map (last >>> solve >>> show) >>> unlines

solve :: String -> Int
solve s = length . filter not $ zipWith (==) s (sort s)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

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

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    s <- P.unpack <$> readLine
    putInts [length [() | (c, v) <- zip s (sort s), c /= v]]

type SIO = StateT P.ByteString IO

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

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

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


Now Serval is a junior high school student in Japari Middle School, and he is still thrilled on math as before. As a talented boy in mathematics, he likes to play with numbers. This time, he wants to play with numbers on a rooted tree.A tree is a connected graph without cycles. A rooted tree has a special vertex called the root. A parent of a node $$$v$$$ is the last different from $$$v$$$ vertex on the path from the root to the vertex $$$v$$$. Children of vertex $$$v$$$ are all nodes for which $$$v$$$ is the parent. A vertex is a leaf if it has no children.The rooted tree Serval owns has $$$n$$$ nodes, node $$$1$$$ is the root. Serval will write some numbers into all nodes of the tree. However, there are some restrictions. Each of the nodes except leaves has an operation $$$\max$$$ or $$$\min$$$ written in it, indicating that the number in this node should be equal to the maximum or minimum of all the numbers in its sons, respectively. Assume that there are $$$k$$$ leaves in the tree. Serval wants to put integers $$$1, 2, \ldots, k$$$ to the $$$k$$$ leaves (each number should be used exactly once). He loves large numbers, so he wants to maximize the number in the root. As his best friend, can you help him?

The first line contains an integer $$$n$$$ ($$$2 \leq n \leq 3\cdot 10^5$$$), the size of the tree. The second line contains $$$n$$$ integers, the $$$i$$$-th of them represents the operation in the node $$$i$$$. $$$0$$$ represents $$$\min$$$ and $$$1$$$ represents $$$\max$$$. If the node is a leaf, there is still a number of $$$0$$$ or $$$1$$$, but you can ignore it. The third line contains $$$n-1$$$ integers $$$f_2, f_3, \ldots, f_n$$$ ($$$1 \leq f_i \leq i-1$$$), where $$$f_i$$$ represents the parent of the node $$$i$$$.

Output one integer — the maximum possible number in the root of the tree.

NotePictures below explain the examples. The numbers written in the middle of the nodes are their indices, and the numbers written on the top are the numbers written in the nodes.In the first example, no matter how you arrange the numbers, the answer is $$$1$$$.  In the second example, no matter how you arrange the numbers, the answer is $$$4$$$.  In the third example, one of the best solution to achieve $$$4$$$ is to arrange $$$4$$$ and $$$5$$$ to nodes $$$4$$$ and $$$5$$$.  In the fourth example, the best solution is to arrange $$$5$$$ to node $$$5$$$.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

main :: IO ()
main = do
  n <- readInt <$> getLine
  isMax <- A.listArray (1,n) . map (==1) .
    unfoldr (runStateT rIntS) <$> BS.getLine :: IO (UArray Int Bool)
  parents <- unfoldr (runStateT rIntS) <$> BS.getLine
  let children = A.accumArray (flip (:)) [] (1,n) $ zip parents [2..]
       :: Array Int [Int]
  print $ (+1) $ uncurry (-) $ search isMax children 1

search :: UArray Int Bool -> Array Int [Int] -> Int -> (Int, Int)
search isMax children cur
  | null (children A.! cur) = (1,1)
  | isMax A.! cur = (leaves,) $! minimum rescnt
  | otherwise = (leaves,) $! sum rescnt
  where (resleaves, rescnt)
          = unzip $ map (search isMax children) $ children A.! cur
        !leaves = sum resleaves

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N


There are n cities situated along the main road of Berland. Cities are represented by their coordinates — integer numbers a1, a2, ..., an. All coordinates are pairwise distinct.It is possible to get from one city to another only by bus. But all buses and roads are very old, so the Minister of Transport decided to build a new bus route. The Minister doesn't want to spend large amounts of money — he wants to choose two cities in such a way that the distance between them is minimal possible. The distance between two cities is equal to the absolute value of the difference between their coordinates.It is possible that there are multiple pairs of cities with minimal possible distance, so the Minister wants to know the quantity of such pairs. Your task is to write a program that will calculate the minimal possible distance between two pairs of cities and the quantity of pairs which have this distance.

The first line contains one integer number n (2 ≤ n ≤ 2·105). The second line contains n integer numbers a1, a2, ..., an ( - 109 ≤ ai ≤ 109). All numbers ai are pairwise distinct.

Print two integer numbers — the minimal distance and the quantity of pairs with this distance.

NoteIn the first example the distance between the first city and the fourth city is |4 - 6| = 2, and it is the only pair with this distance.

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

main :: IO ()
main = putStrLn . unwords . map show . solve . tail . map (fst . fromJust . C.readInt) . C.words =<< B.getContents

solve :: [Int] -> [Int]
solve a = solve' [maxBound :: Int, 0] (sort a)

solve' :: [Int] -> [Int] -> [Int]
solve' result [] = result
solve' result [a] = result
solve' [d, c] (a:b:x) | b - a < d = solve' [b - a, 1] (b:x)
                      | b - a == d = solve' [d, c + 1] (b:x)
                      | otherwise = solve' [d, c] (b:x)

{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

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

nextInt :: ByteString -> Int
nextInt = fst . fromJust . C.readInt

solve :: [Int] -> String
solve xs =
    let ds = sort $ zipWith (-) (tail xs) xs
        h = head ds
        len = length $ takeWhile (== h) ds
    in  show h ++ " " ++ show len

main = do
    (sort . tail . map nextInt . C.words -> xs) <- B.getContents
    putStrLn $ solve xs

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

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

nextInt :: ByteString -> Int
nextInt = fst . fromJust . C.readInt

solve :: [Int] -> String
solve xs =
    let ds = sort $ zipWith (-) (tail xs) xs
        h = head ds
        len = length $ takeWhile (== h) ds
    in  unwords $ map show [h, len]

main = do
    (sort . tail . map nextInt . C.words -> xs) <- B.getContents
    putStrLn $ solve xs

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

import Control.Monad (forM_, forM)
import Data.List (sort)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

readint = fst. fromJust . C.readInt

main = do
    (readint -> n) <- B.getLine
    (sort . map readint . C.words -> xs) <- B.getLine
    let ds = sort $ zipWith (-) (tail xs) xs
    putStrLn $ show (head ds) ++ " " ++ show (length $ takeWhile (== (head ds)) ds)


It is a simplified version of problem F2. The difference between them is the constraints (F1: $$$k \le 2$$$, F2: $$$k \le 10$$$).You are given an integer $$$n$$$. Find the minimum integer $$$x$$$ such that $$$x \ge n$$$ and the number $$$x$$$ is $$$k$$$-beautiful.A number is called $$$k$$$-beautiful if its decimal representation having no leading zeroes contains no more than $$$k$$$ different digits. E.g. if $$$k = 2$$$, the numbers $$$3434443$$$, $$$55550$$$, $$$777$$$ and $$$21$$$ are $$$k$$$-beautiful whereas the numbers $$$120$$$, $$$445435$$$ and $$$998244353$$$ are not.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of one line containing two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 10^9$$$, $$$1 \le k \le 2$$$).

For each test case output on a separate line $$$x$$$ — the minimum $$$k$$$-beautiful integer such that $$$x \ge n$$$.

import Data.List (group, sort)

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [n, k] = map read $ words input
        result = findFirstKBeautifulNumber n (fromIntegral k)
        output = show result

findFirstKBeautifulNumber :: Integer -> KParameter -> Integer
findFirstKBeautifulNumber start k
    | isKBeautiful start k = start
    | start `mod` 10 /= 0 = findFirstKBeautifulNumber (start + 1) k
    | otherwise = result_if_start_ends_with_zero
    where
        result_if_start_ends_with_zero = result_for_short_version * 10 + last_digit
        result_for_short_version = findFirstKBeautifulNumber (start `div` 10) k
        can_add_new_digit = measureK result_for_short_version < k
        last_digit = if can_add_new_digit then 0 else read [minimum (show result_for_short_version)]

isKBeautiful :: Integer -> KParameter -> Bool
isKBeautiful number k = measureK number <= k

type KParameter = Int
measureK :: Integer -> KParameter
measureK = length . group . sort . show


Vasya, like many others, likes to participate in a variety of sweepstakes and lotteries. Now he collects wrappings from a famous chocolate bar "Jupiter". According to the sweepstake rules, each wrapping has an integer written on it — the number of points that the participant adds to his score as he buys the bar. After a participant earns a certain number of points, he can come to the prize distribution center and exchange the points for prizes. When somebody takes a prize, the prize's cost is simply subtracted from the number of his points.Vasya didn't only bought the bars, he also kept a record of how many points each wrapping cost. Also, he remembers that he always stucks to the greedy strategy — as soon as he could take at least one prize, he went to the prize distribution centre and exchanged the points for prizes. Moreover, if he could choose between multiple prizes, he chose the most expensive one. If after an exchange Vasya had enough points left to get at least one more prize, then he continued to exchange points.The sweepstake has the following prizes (the prizes are sorted by increasing of their cost):   a mug (costs a points),  a towel (costs b points),  a bag (costs c points),  a bicycle (costs d points),  a car (costs e points). Now Vasya wants to recollect what prizes he has received. You know sequence p1, p2, ..., pn, where pi is the number of points Vasya got for the i-th bar. The sequence of points is given in the chronological order. You also know numbers a, b, c, d, e. Your task is to find, how many prizes Vasya received, what prizes they are and how many points he's got left after all operations are completed.

The first line contains a single integer n (1 ≤ n ≤ 50) — the number of chocolate bar wrappings that brought points to Vasya. The second line contains space-separated integers p1, p2, ..., pn (1 ≤ pi ≤ 109). The third line contains 5 integers a, b, c, d, e (1 ≤ a < b < c < d < e ≤ 109) — the prizes' costs.

Print on the first line 5 integers, separated by a space — the number of mugs, towels, bags, bicycles and cars that Vasya has got, respectively. On the second line print a single integer — the number of points Vasya will have left after all operations of exchange are completed. 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.

NoteIn the first sample Vasya gets 3 points after eating the first chocolate bar. Then he exchanges 2 points and gets a mug. Vasya wins a bag after eating the second chocolate bar. Then he wins a towel after eating the third chocolate bar. After all chocolate bars 3 - 2 + 10 - 10 + 4 - 4 = 1 points remains.

main = do
  getLine
  p <- fmap (map read . words) getLine
  q <- fmap (reverse . map read . words) getLine
  let (x, y) = foldl (gao q) (repeat 0, 0) p
  putStrLn $ unwords $ map show $ reverse x ++ [y]

gao q (c, s) t = let (x, y) = go q c [] (s+t) in (reverse x, y)

go [] _ x y = (x, y)
go (a:as) (b:bs) x y = let c = y `div` a in go as bs (b+c:x) (y `mod` a)

import Prelude hiding (Int ())

type Int  =  Integer
type Fiver  =  (Int, Int, Int, Int, Int)

solve :: Fiver -> [Int] -> (Fiver, Int)
solve (a,b,c,d,e) xs  =  solve' xs ((0, 0, 0, 0, 0), 0)
  where
    solve' [] acc  =  acc
    solve' (x:xs) ((a',b',c',d',e'), y)
      | xy >= e  =  solve' ((xy `mod` e) : xs) ((a', b', c', d', e' + xy `div` e), 0)
      | xy >= d  =  solve' ((xy `mod` d) : xs) ((a', b', c', d' + xy `div` d, e'), 0)
      | xy >= c  =  solve' ((xy `mod` c) : xs) ((a', b', c' + xy `div` c, d', e'), 0)
      | xy >= b  =  solve' ((xy `mod` b) : xs) ((a', b' + xy `div` b, c', d', e'), 0)
      | xy >= a  =  solve' ((xy `mod` a) : xs) ((a' + xy `div` a, b', c', d', e'), 0)
      | otherwise  =  solve' xs ((a',b',c',d',e'), xy)
      where
        xy  =  x + y

printAns :: (Fiver, Int) -> IO ()
printAns ((a, b, c, d, e), x)  =  putStrLn (unwords (map show [a,b,c,d,e])) >> print x

main :: IO()
main  =  do
    getLine
    xs  <-  getLine >>= return . map read . words
    [a,b,c,d,e]  <-  getLine >>= return . map read . words
    printAns $ solve (a,b,c,d,e) xs

buy money [] = (money, [])
buy money (p:ps) =
    let (nokori, buyed ) = buy money ps
    in (mod nokori p, div nokori p:buyed)

next ps (money, gift) addp =
     let (nokori, ngift) = buy (money+addp) ps
     in (nokori, zipWith (\x y->x+y) gift ngift )

cal getPoints ps = foldl (next ps) (0, [0,0,0,0,0]) getPoints

join c (x:[]) = x
join c (x:xs) = x++(c:join c xs)

main = do
     _ <- getLine
     s <- getLine
     let getPoints = map read $ words s
     s2 <- getLine
     let ps = map read $ words s2
     let (remMoney, gifts) = cal getPoints ps
     putStrLn $ join ' ' $ map show gifts
     print remMoney

{-# LANGUAGE BangPatterns #-}

import Control.Applicative

main = getLine >> do
  ps <- map read.words <$> getLine :: IO [Integer]
  [a,b,c,d,e] <- map read.words <$> getLine :: IO [Integer]
  let solve !point !cnts [] = do
         putStrLn.unwords $ map show cnts
         print point
      solve !point !cnts (x:xs) = solve ra (zipWith (+) cnts [da,db,dc,dd,de]) xs
       where
         (de,re) = (point+x)`divMod`e
         (dd,rd) = re`divMod`d
         (dc,rc) = rd`divMod`c
         (db,rb) = rc`divMod`b
         (da,ra) = rb`divMod`a
  solve 0 [0,0,0,0,0] ps

import Control.Monad

readInt :: String -> Integer
readInt = read

buyItems cash [] = (cash,[])
buyItems cash (c:cs) = (cash',cnt:bought)
  where cnt = cash `div` c
        (cash',bought) = buyItems (cash-cnt*c) cs

addList xs ys = map (\(a,b)->a+b) $ zip xs ys

main = do
  n <- liftM readInt $ getLine
  ps <- liftM (map readInt . words) $ getLine
  cs <- liftM (reverse . map readInt . words) $ getLine
  let (cash, bt) = foldl (f cs) (0,repeat 0) ps
  putStrLn . unwords . map show . reverse $ bt
  putStrLn . show $ cash
  where f cs (cash,bought) p = (cash',addList bt bought)
          where (cash',bt) = (buyItems (cash+p) cs)

import Control.Monad

solve (a,b,c,d,e) xs = solve' 0 [0,0,0,0,0] xs
  where
    costs = [e,d,c,b,a]
    solve' n ys (x:xs) =
      let
        (l, r) = spend (n+x) costs
      in
        solve' l (zipWith (+) r ys) xs
      where
        spend p [] = (p, [])
        spend p (x:xs) =
          let
            cnt = p `div` x
            rem = p - cnt * x
            (l, r) = spend rem xs
          in
            (l, cnt : r)
    solve' n ys [] = (n, ys)

main = do
  n <- liftM read getLine
  xs <- getLine >>= (return.map read.take n.words)
  [a,b,c,d,e] <- getLine >>= (return.map read.take 5.words)
  let (l, r) = solve (a,b,c,d,e) xs :: (Integer, [Integer])
  putStrLn (unwords $ reverse $ map show r)
  putStrLn (show l)