module Main where
import Data.List as L
import Data.ByteString.Lazy as B
import Data.ByteString.Lazy.Char8 as C
main :: IO ()
main = do
    _ <- readLn :: IO Integer
    cs <- B.getContents
    let ls = C.lines cs
        lineToTup l =
            let ws = C.words l
                readDatInt = (\ (Just (i,_)) -> i) . C.readInt
                [a,b] = Prelude.map readDatInt ws
            in (a,b)
        events = Prelude.map lineToTup ls
        eventsbystart = L.sortBy (\(a,_) (b,_) -> compare a b) $ events
        (_,ans) = Prelude.foldl (\ (m,c) (_,b) -> (max m b, c + if b < m then 1 else 0)) (snd $ Prelude.head eventsbystart,0::Integer) (Prelude.tail eventsbystart)
        -- eventsbystartl = F.toList eventsbystart
    print ans

{-# OPTIONS_GHC -O2 #-}

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

import Control.Monad
import Control.Applicative

solve :: [(Int, Int)] -> Int
solve events = snd $ foldl' f (0, 0) es
  where es = map snd $ sort events
        f (right, ans) y | y < right = (right, ans + 1)
                         | otherwise = (y, ans)

toPair [x, y] = (x, y)

main = do _:xs <- map (toPair . map (fst .fromJust . BS.readInt) . BS.words) . BS.lines <$> BS.getContents
          print $ solve xs

import Data.List(sort,foldl')
import Control.Applicative
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do n <- read <$> getLine
          xs <- map ((\ [x,y] -> (x,y)).map read'.B.words) <$> B.lines <$> B.getContents
          print $ solve n xs

read' s = let Just (n,s') = B.readInt s
          in n

solve :: Int -> [(Int,Int)] -> Int
solve _ xs = snd $ foldl' f (y,0) ys
   where (y:ys) = map snd $ sort xs

f :: (Int,Int) -> Int -> (Int,Int)
f (m,i) n
  | m > n     = (m,succ i)
  | otherwise = (n,i)

{-# OPTIONS_GHC -O2 #-}

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

import Control.Monad
import Control.Applicative

solve :: [(Int, Int)] -> Int
solve events = snd $ foldl' f (0, 0) es
  where es = map snd $ sort events
        f (right, ans) y | y < right = (right, ans + 1)
                         | otherwise = (y, ans)

main = BS.interact $ BS.pack . show . solve . map parseEvent . tail .  BS.lines
  where parseEvent line = let [x, y] = map BS.readInt $ BS.words line
                          in (fst $ fromJust x, fst $ fromJust y)

import Control.Applicative
import Data.List (foldl', sort)
import qualified Data.ByteString.Char8 as S

main :: IO ()
main = do
  _:xs <- map (\x -> let [a, b] = S.words x in (S.readInt a, S.readInt b)) . S.lines <$> S.getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Foreign
import Foreign.C

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_i  :: CString -> Ptr CInt -> IO CInt

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_ii :: CString -> Ptr CInt -> Ptr CInt -> IO CInt

main :: IO ()
main = do
  alloca              $ \(a   :: Ptr CInt) -> do
  alloca              $ \(b   :: Ptr CInt) -> do
  withCString "%d"    $ \(i   :: CString)  -> do
  withCString "%d%d"  $ \(ii  :: CString)  -> do
    c_scanf_i i a
    n   <- peek a
    xs  <- replicateM (fromIntegral n) $ do
      c_scanf_ii ii a b
      (,) <$> peek a <*> peek b
    let y : ys = map snd $ sort xs
    print $ solve 0 y ys
 where
  solve !acc _   []        = acc
  solve !acc x'  (x : xs)
    | x < x'          = solve (1 + acc) x' xs
    | otherwise       = solve acc       x  xs

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Foreign
import Foreign.C

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_i  :: CString -> Ptr CInt -> IO CInt

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_ii :: CString -> Ptr CInt -> Ptr CInt -> IO CInt

main :: IO ()
main = do
  alloca              $ \(a   :: Ptr CInt) -> do
  alloca              $ \(b   :: Ptr CInt) -> do
  withCString "%d"    $ \(i   :: CString)  -> do
  withCString "%d%d"  $ \(ii  :: CString)  -> do
    c_scanf_i i a
    n   <- peek a
    xs  <- replicateM (fromIntegral n) $ do
      c_scanf_ii ii a b
      (,) <$> peek a <*> peek b
    let y : ys = map snd $ sort xs
    print $ snd $ foldl f (y, 0) ys
 where
  f (!y, !acc) x
    | x < y          = (y, 1 + acc)
    | otherwise      = (x, acc)

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  _:xs <- map parse . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)
    parse x = let [a, b] = words x
                  !c = read a :: Int
                  !d = read b :: Int
              in (c, d)

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

readInt = fst . fromJust . C.readInt
readIntList = map readInt . C.words

listToTuple [a, b] = (a, b)

f (m, r) (_, b)
   | m > b     = (m, r+1)
   | otherwise = (b, r)

main = do
   input <- fmap (map (C.takeWhile (/='\r')) . C.lines) $ C.hGetContents stdin
   let n  = readInt $ head input
       ab = map (listToTuple . readIntList) (take n $ tail input)
   print . snd $ foldl' f (0, 0) (sort ab)

-- vim: set expandtab:

{-# LANGUAGE BangPatterns #-}

import Control.Monad (replicateM)
import Data.List (sort,foldl')
import Data.Ord (comparing)

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

main = do
  n <- fmap read getLine
  pairs <- replicateM n $ do
             (a:b:_) <- fmap (parseInts 2) BS.getLine
             return (a,b)
  let _ = pairs :: [(Int,Int)]
  let sorted = sort pairs

  let go :: (Int,Int) -> (Int,Int) -> (Int,Int)
      go (!c,m) (a,b) = case compare m b of
                              GT -> (c+1,m)
                              EQ -> (c,m)
                              LT -> (c,b)
  let (answer,_) = foldl' go (0,0) sorted
  print answer

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    replicateM n ((,) <$> readInt <*> readInt)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve xs = length [undefined | (a, b) <- zip rights maxr, a < b]
  where
    rights = map snd (sort xs)
    maxr = scanl max 0 rights

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  n <- getLine
  xs <- (map parse) . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

parse :: String -> (Int, Int)
parse x = let [a, b] = words x
              !c = read a :: Int
              !d = read b :: Int
              in (c, d)

import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  _:xs <- map parse . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

parse :: String -> (Int, Int)
parse x = let [a, b] = words x
              !c = read a :: Int
              !d = read b :: Int
              in (c, d)

import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  n <- getLine
  xs <- map parse . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

parse :: String -> (Int, Int)
parse x = let [a, b] = words x
              !c = read a :: Int
              !d = read b :: Int
              in (c, d)

import Control.Monad (replicateM)
import Data.List (sortBy)
import Data.Ord (comparing)
import Data.Array

contains :: (Int,Int) -> (Int,Int) -> Bool
contains (a,b) (c,d) = a < b && c < d

(-->) = flip fmap

main = do
  n <- getLine --> read
  pairs <- replicateM n $ do
             (a:b:_) <- getLine --> words --> map read
             return (a,b)
  let _ = pairs :: [(Int,Int)]
  let sorted = sortBy (comparing fst) pairs
  let arr = listArray (1,n) sorted
  -- count the number of pairs which are contained in some other (earlier) pair
  let isContained :: Int -> Bool
      isContained j =
        let cd = arr ! j in any (\i -> contains (arr ! i) cd) [1..j-1]
  let count = length $ filter isContained [2..n]
  print count

import Control.Applicative
import Data.List

main :: IO ()
main = do
  _:(_,b):xs <- map (\x -> let [a, b] = words x in (read a :: Int, read b :: Int)) . lines <$> getContents
  print $ fst $ foldl' f (0,b) $ map snd $ sort xs
  where
    f (acc,prev) b
      | prev > b = (acc+1, prev)
      | otherwise = (acc, b)

import Control.Applicative
import Data.List

main :: IO ()
main = do
  _:(_,b):xs <- map (\x -> let [a, b] = words x in (read a :: Int, read b :: Int)) . lines <$> getContents
  print $ fst $ foldl' f (0,b) $ map snd xs
  where
    f (acc,prev) b
      | prev > b = (acc+1, prev)
      | otherwise = (acc, b)

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

main :: IO ()
main = do n <- read <$> getLine
          xs <- forM [1..n] (\_ -> (\ [x,y] -> (x, negate y)) <$> map read <$> words <$> getLine)
          print $ solve n xs

solve :: Int -> [(Int,Int)] -> Int
solve _ xs = length $ filter (<y) ys
   where (y:ys) = map (negate.snd.head) $ groupBy (\ (i,_) (j,_) -> i == j) $ sort xs


{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

solve :: IO ()
solve = do
  ~[x,y] <- readv
  if odd (x+y) then putStrLn ("-1 -1") else printv [x`div`2, (y+1)`div`2]

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x <> DBB.char8 ' ' | x <- xs] <> DBB.char8 '\n'

readv :: IO [Int]
readv = map (maybe 0 fst . DBC.readInt) <$> (DBC.words <$> DBC.getLine)

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ nTc solve

import Control.Monad (replicateM)

main = do
  x <- getLine
  let nLines :: Int
      nLines = read x
  lines <- replicateM nLines getLine
  let res = map solve lines
  putStr $ unlines res

solve line = do
  let arr = [read x :: Int | x <- words line]
  let (x : y : _) = arr
  if (x + y) `mod` 2 == 1
    then "-1 -1"
    else unwords $ map show [floor $ fromIntegral x / 2, floor $ fromIntegral (y + 1) / 2]

f[x,y] =
 case (mod x 2, mod y 2) of
  (0, 0) -> [div x 2, div y 2]
  (0, 1) -> [-1, -1]
  (1, 0) -> [-1, -1]
  (1, 1) -> [div x 2, 1 + (div y 2)]

main=interact$unlines.map(unwords.map show.f.map read.words).tail.lines

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
        [x, y] = map read $ words input
        output = case findPointC (x, y) of
            Just (cx, cy) -> unwords $ map show [cx, cy]
            Nothing -> "-1 -1"

findPointC :: (Integer, Integer) -> Maybe (Integer, Integer)
findPointC (x, y)
    | odd (abs(x) + abs(y)) = Nothing
    | otherwise = Just (x `div` 2, (y + 1) `div` 2)

import Control.Monad (replicateM)

main = do
  x <- getLine
  let nLines :: Int
      nLines = read x
  lines <- replicateM nLines getLine
  let res = map solve lines
  putStr $ unlines res

solve line = do
  let arr = [read x :: Int | x <- words line]
  let (x : y : _) = arr
  unwords $ map show [floor $ fromIntegral x / 2, floor $ fromIntegral (y + 1) / 2]

import Control.Monad (replicateM)

main = do
  x <- getLine
  let nLines :: Int
      nLines = read x
  lines <- replicateM nLines getLine
  let res = map solve lines
  putStr $ unlines res

solve line = do
  let arr = [read x :: Int | x <- words line]
  let (x : y : _) = arr
  unwords $ map show [fromIntegral x / 2, fromIntegral y / 2]


import Data.List
import GHC.Exts

main = interact solve

solve str =
    let wd = lines str
        crosswords = sort [makeCrossword p | p <- permutations wd, good p]
    in if null crosswords
       then "Impossible\n"
       else unlines (head  crosswords) ++ "\n"

good p = head (p!!0) == head (p!!1) &&
         last (p!!0) == head (p!!2) &&
         last (p!!1) == head (p!!3) &&
         last (p!!3) == head (p!!4) &&
         last (p!!2) == head (p!!5) &&
         last (p!!5) == last (p!!4) &&
         l!!1 > 2 && l!!0 > 2 && l!!4 > 2 && l!!5 > 2 &&
         l!!3 == l!!0 + l!!5 - 1 &&
         l!!2 == l!!1 + l!!4 - 1 &&
         p!!3!!(l!!0 - 1) == p!!2!!(l!!1 - 1)
      where
         l = map length p

makeCrossword p = (p!!0 ++ right):
        map first (zip (init . tail $ p!!1) (init . tail $ p!!2)) ++
        [p!!3] ++
        map second (zip (init . drop (length (p!!1)) $ p!!2) (init . tail $ p!!4)) ++
        [left ++ p!!5]
    where first (a, b) = a:tail left ++ b:right
          second (a, b) = left ++ a:tail right ++ [b]
          right = replicate ( length (p!!5) - 1 ) '.'
          left = replicate ( length (p!!0) - 1 ) '.'

import Control.Monad
import Data.List
import Control.Arrow
import Data.Array

main :: IO ()
main = do
    xs <- replicateM 6 getLine
    --mapM_ print . filter valid . perms $ xs
    let sols = sortOn snd . filter (valid . fst) . map (id &&& crossword) . perms $ xs
    putStrLn $ if null sols then "Impossible" else snd . head $ sols

perms :: Eq a => [a] -> [[a]]
perms [] = [[]]
perms xs = [x:y | x <- xs, y<- perms (delete x xs)]

crossword :: [String] -> String
crossword [a,b,c,d,e,f] =
    unlines [[as!(i, j)|i<-[1..length e]]| j<-[1..length b]]
    where
        as :: Array (Int, Int) Char -- (x, y)
        as = accumArray (const id) '.' ((1,1), (length e, length b))
            $  zip [(i,1)|i<-[1..]] a
            ++ zip [(length a, i)|i<-[1..]] b
            ++ zip [(i,length b)|i<-[length a..]] c
            ++ zip [(length e,i)|i<-[length f..]] d
            ++ zip [(i,length f)|i<-[1..]] e
            ++ zip [(1,i)|i<-[1..]] f
crossword _ = ""

valid :: [String] -> Bool
valid [a, b, c, d, e, f] =
    last a == head b
    && last b == head c
    && last c == last d
    && last e == head d
    && last f == head e
    && head a == head f
    && length e == length a + length c - 1
    && length b == length d + length f - 1
    && b !! (length f - 1) == e !! (length a - 1)
valid _ = False

import Data.List

main = interact (unlines.s.take 6.lines)
s ls = if null cr then ["Impossible"] else minimum cr where
    cr = filter (/=[]) $ map cross $ permutations (zip ls (map length ls))

cross hls =
    if (l!!0+l!!2-1)==(l!!1) && (l!!3+l!!5-1)==(l!!4) &&
       head (h!!0)==head (h!!3) && last (h!!0)==head (h!!4) &&
       head (h!!1)==last (h!!3) && ((h!!1)!!(l!!0-1))==((h!!4)!!(l!!3-1)) && last (h!!1)==head (h!!5) &&
       head (h!!2)==last (h!!4) && last (h!!2)==last (h!!5)
    then make (h, l)
    else []
    where
        h = map fst hls
        l = map snd hls

make (h, l) = (map (++rm) ((h!!0):v1)) ++ [h!!1] ++ (map (lm++) (v2++[h!!2]))
    where
        v1 = zipWith (\a b -> (a:ls)++[b]) ((init.tail)(h!!3)) ((take (l!!3-2).tail)(h!!4))
        v2 = zipWith (\a b -> (a:rs)++[b]) ((init.drop (l!!3))(h!!4)) ((init.tail)(h!!5))
        rm = replicate ((l!!2)-1) '.'
        rs = tail rm
        lm = replicate ((l!!0)-1) '.'
        ls = tail lm

import Data.List
import GHC.Exts

main = interact solve

solve str =
    let wd = lines str
        crosswords = sort [makeCrossword p | p <- permutations wd, good p]
    in if null crosswords
       then "Impossible\n"
       else unlines (head  crosswords) ++ "\n"

good p = head (p!!0) == head (p!!1) &&
         last (p!!0) == head (p!!2) &&
         last (p!!1) == head (p!!3) &&
         last (p!!3) == head (p!!4) &&
         last (p!!2) == head (p!!5) &&
         last (p!!5) == last (p!!4) &&
         l!!1 > 2 && l!!0 > 2 && l!!4 > 2 && l!!5 > 2 &&
         l!!3 == l!!0 + l!!5 - 1 &&
         l!!2 == l!!1 + l!!4 - 1 &&
         p!!3!!(l!!0 - 1) == p!!2!!(l!!1 - 1)
      where
         l = map length p

makeCrossword p = (p!!0 ++ right):
        map first (zip (init . tail $ p!!1) (init . tail $ p!!2)) ++
        [p!!3] ++
        map second (zip (tail . drop (length (p!!1)) $ p!!2) (init . tail $ p!!4)) ++
        [left ++ p!!5]
    where first (a, b) = a:tail left ++ b:right
          second (a, b) = left ++ a:tail right ++ [b]
          right = replicate ( length (p!!5) - 1 ) '.'
          left = replicate ( length (p!!0) - 1 ) '.'

import Data.List
import GHC.Exts

main = interact solve

solve str =
    let wd = lines str
        crosswords = sort [makeCrossword p | p <- permutations wd, good p]
    in if null crosswords
       then "Impossible"
       else unlines . head $ crosswords

good p = head (p!!0) == head (p!!1) &&
         last (p!!0) == head (p!!2) &&
         last (p!!1) == head (p!!3) &&
         last (p!!3) == head (p!!4) &&
         last (p!!2) == head (p!!5) &&
         last (p!!5) == last (p!!4) &&
         l!!1 > 2 && l!!0 > 2 && l!!4 > 2 && l!!5 > 2 &&
         l!!3 == l!!0 + l!!5 - 1 &&
         l!!2 == l!!1 + l!!4 - 1 &&
         p!!3!!(l!!0 - 1) == p!!2!!(l!!1 - 1)
      where
         l = map length p

makeCrossword p = (p!!0 ++ right):
        map first (zip (init . tail $ p!!1) (init . tail $ p!!2)) ++
        [p!!3] ++
        map second (zip (tail . drop (length (p!!1)) $ p!!2) (init . tail $ p!!4)) ++
        [left ++ p!!5]
    where first (a, b) = a:tail left ++ b:right
          second (a, b) = left ++ a:tail right ++ [b]
          right = replicate ( length (p!!5) - 1 ) '.'
          left = replicate ( length (p!!0) - 1 ) '.'


import Data.Array.IArray
import Text.Printf

intersect :: (Integer, Integer) -> (Integer, Integer) -> Integer
intersect (a, b) (c, d) = max 0 ans
	where ans = min b d - max a c

ones :: [(Integer, Integer)]
ones = [(10^x, 2*10^x) | x <- [0..19]]

prob1 :: (Integer, Integer) -> Double
prob1 (a,b) = count1 / total
    where count1 = fromIntegral $ sum $ map (intersect (a, b+1)) ones
          total  = fromIntegral (b - a + 1)

dp :: Array Int Double -> Int -> Double
dp probs k = f' n k
    where
        n = length $ indices probs

        arr :: Array (Int,Int) Double
        arr = listArray ((0, 0), (n, k)) $
               [f n' k' | n' <- [0..n], k' <- [0..k]]
        f' = curry (arr !)

        f :: Int -> Int -> Double
        f n' k'
         | n' == 0 && k' == 0   = 1
         | n' == 0              = 0
         | otherwise =
               p1     * f' (n'-1) (max (k'-1) 0) +
               (1-p1) * f' (n'-1) k'

               where p1 = probs ! n'

readInterval :: Int -> IO [(Integer, Integer)]
readInterval 0 = return $ []
readInterval l = do
    [a, b] <- (map read . words) `fmap` getLine
    ret <- readInterval (l-1)
    return $ (a,b) : ret

main = do
    n <- read `fmap` getLine
    intervals <- readInterval n
    k <- read `fmap` getLine
    let k' = ceiling $ fromIntegral n * k / 100

    let probs = listArray (1,n) [prob1 x | x <- intervals]

    let ans = dp probs k'

    printf "%.12f\n" ans

import Control.Monad

getA = fmap (map read . words) getLine

cnt n = let (m:t) = reverse $ takeWhile (<=n) $ iterate (*10) 1 in sum t + min m (n - m)

gao [] = [1.0]
gao ([l,r]:t) = zipWith (\i j -> p * i + (1 - p) * j) (0:a) (a++[0]) where
	u = r + 1
	p = fromInteger (cnt u - cnt l) / fromInteger (u - l)
	a = gao t

main = do
	[n] <- getA
	a <- replicateM (fromInteger n) getA
	[k] <- getA
	putStrLn $ show $ sum $ drop (fromInteger $ div (n * k + 99) 100) $ gao a

import Data.Array
import Control.Applicative
import Control.Monad

-- import Control.DeepSeq

-- import Test.QuickCheck

-- import Debug.Trace

-- debug = flip trace

-- testnBWO :: Gen Bool
-- testnBWO = do
--   l <- choose (1, 10^18)
--   u <- choose (l, 10^18)
--   let nBWO' = length . filter beginWithOne
--   return $ nBWO l u == fi (nBWO' [l..u])

-- testnBWO2 :: Gen Prop
-- testnBWO2 = do
--   l <- choose (1, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print l) $ nBWO l l == fi (nBWO' [l])

-- testnBWO3 :: Gen Prop
-- testnBWO3 = do
--   l <- choose (1, 10)
--   u <- choose (l, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print (l, u)) $ nBWO l u == fi (nBWO' [l..u])

-- testLeast :: Gen Bool
-- testLeast = do
--   n <- choose (1, 100) :: Gen Int
--   p <- choose (1, 100) :: Gen Int
--   return $ ceiling (fi n * fi p / 100.0) == ceiling (fi n * fi p / 100.0 - eps)

-- test1 :: Gen Bool
-- test1 = do
--   n <- choose (1, 1000)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [1,1]
--   return $ prob n input p == 1

-- test0 :: Gen Bool
-- test0 = do
--   n <- choose (1, 1000)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [2,2]
--   return $ prob n input p == 0

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO 1 u
  | u < 10 = 1
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 10 ^ li
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li..ui - 1])
  in  middl `seq` tailP - headM + middl
      -- `debug` (show l ++ " " ++ show u ++ " " ++ show headM ++ " " ++ show middl ++ " " ++ show tailP)

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  arrOld `seq`
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ ind `seq` prob `seq` (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Integer]
getInts = map read . words <$> getLine

prob n lines p =
  let least = ceiling (fi n * fi p / 100.0 - eps)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
  in prob

main = do
  -- verboseCheck test1
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  print (prob n lines p)

import Data.Array
import Control.Applicative
import Control.Monad

-- import Test.QuickCheck

-- import Debug.Trace

-- debug = flip trace

-- testnBWO :: Gen Bool
-- testnBWO = do
--   l <- choose (1, 1^18)
--   u <- choose (l, 1^18)
--   let nBWO' = length . filter beginWithOne
--   return $ nBWO l u == fi (nBWO' [l..u])

-- testnBWO2 :: Gen Prop
-- testnBWO2 = do
--   l <- choose (1, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print l) $ nBWO l l == fi (nBWO' [l])

-- testnBWO3 :: Gen Prop
-- testnBWO3 = do
--   l <- choose (1, 10)
--   u <- choose (l, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print (l, u)) $ nBWO l u == fi (nBWO' [l..u])

-- testLeast :: Gen Bool
-- testLeast = do
--   n <- choose (1, 100) :: Gen Int
--   p <- choose (1, 100) :: Gen Int
--   return $ ceiling (fi n * fi p / 100.0) == ceiling (fi n * fi p / 100.0 - eps)

-- test1 :: Gen Bool
-- test1 = do
--   n <- choose (1, 100)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [1,1]
--   return $ prob n input p == 1

-- test0 :: Gen Bool
-- test0 = do
--   n <- choose (1, 100)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [2,2]
--   return $ prob n input p == 0

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO 1 u
  | u < 10 = 1
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 10 ^ li
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li..ui - 1])
  in  middl `seq` tailP - headM + middl
      -- `debug` (show l ++ " " ++ show u ++ " " ++ show headM ++ " " ++ show middl ++ " " ++ show tailP)

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Integer]
getInts = map read . words <$> getLine

prob n lines p =
  let least = ceiling (fi n * fi p / 100.0 - eps)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
  in prob

main = do
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  print (prob n lines p)

import Data.Array
import Control.Applicative
import Control.Monad

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 0
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li + 1..ui - 1])
  in  middl `seq` tailP - headM + middl

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Integer]
getInts = map read . words <$> getLine

main = do
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  let least = ceiling (fi n * fi p / 100.0)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
      difference [n, m] = abs (n - m)
      full  = sum $ map difference lines
  print prob

import Data.Array
import Control.Applicative
import Control.Monad

-- import Test.QuickCheck

-- testnBWO :: Gen Bool
-- testnBWO = do
--   l <- choose (1, 1^18)
--   u <- choose (l, 1^18)
--   let nBWO' = length . filter beginWithOne
--   return $ nBWO l u == fi (nBWO' [l..u])

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 0
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li + 1..ui - 1])
  in  middl `seq` tailP - headM + middl

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Integer]
getInts = map read . words <$> getLine

main = do
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  let least = ceiling (fi n * fi p / 100.0 - eps)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
      difference [n, m] = abs (n - m)
      full  = sum $ map difference lines
  print prob


{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust, fromMaybe, isJust)

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

type Input = [Int]
type Output = Int

input :: Scanner Input
input = numberOf int

output :: Output -> C.ByteString
output = showB

solve :: Input -> Output
solve xs
  | isJust a && isJust b = min (fromJust a) (fromJust b)
  | isJust a = fromJust a
  | otherwise = fromMaybe (-1) b
  where
    n = length xs
    ixs = [i | (v, i) <- zip xs [0..n], odd v]
    a = compute ixs [0, 2 .. n - 1]
    b = compute ixs [1, 3 .. n - 1]

compute ixs ts
  | length ixs /= length ts = Nothing
  | otherwise = Just . sum . map abs $ zipWith (-) ixs ts

count :: Eq a => a -> [a] -> Int
count v = length . filter (== v)

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

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

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List
import Data.Int

interleave :: [t] -> [t] -> [t]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  replicateM_ t $ do
    [n] <- getInts 1
    a <- getInts n
    let
      eIxs = [i | (i, ai) <- zip [1..] a, even ai]
      oIxs = [i | (i, ai) <- zip [1..] a, odd ai]
      efst = interleave eIxs oIxs
      ofst = interleave oIxs eIxs
      opts = case  length eIxs - length oIxs  of
        -1 -> [ofst]
        0 -> [efst, ofst]
        1 -> [efst]
        _ -> []
      cost = foldl' (\x (i, tar) -> x + abs (i - tar)) 0
      ans = if  null opts
        then  0-1
        else  minimum [cost $ zip opt [1..] | opt <- opts] `div` 2
    putInt64s [ans]

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> SIO ()
putInt64s vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< int64Dec
  in  lift $ B.hPutBuilder stdout $ case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.int64Dec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List

interleave :: [t] -> [t] -> [t]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  replicateM_ t $ do
    [n] <- getInts 1
    a <- getInts n
    let
      eIxs = [i | (i, ai) <- zip [1..] a, even ai]
      oIxs = [i | (i, ai) <- zip [1..] a, odd ai]
      efst = interleave eIxs oIxs
      ofst = interleave oIxs eIxs
      opts = case  length eIxs - length oIxs  of
        -1 -> [ofst]
        0 -> [efst, ofst]
        1 -> [efst]
        _ -> []
      cost = foldl' (\x (i, tar) -> x + abs (i - tar)) 0
      ans = if  null opts
        then  0-1
        else  minimum [cost $ zip opt [1..] | opt <- opts] `div` 2
    putInts [ans]

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded sepPrim xs <> B.char7 '\n'


{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Array.Unboxed
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve n m ps (l, r, x) = (x - l) == (length $ filter (< (ps!x)) [ps!i | i <- [l..r]])

main = do
  n:m:_ <- readInts <$> B.getLine
  ps :: UArray Int Int <- listArray (1, n) . readInts <$> B.getLine
  lrxs <- map (\(l:r:x:_) -> (l, r, x)) <$> replicateM m (readInts <$> B.getLine)
  putStrLn $ unlines . map (\lrx -> if solve n m ps lrx then "Yes" else "No") $ lrxs

import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List

readInt :: B.ByteString -> Int
readInt = fst . fromJust . B.readInt

main :: IO ()
main = do
  [n, m] <- liftM (map readInt . B.words) B.getLine
  p      <- liftM (map readInt . take n . B.words) B.getLine :: IO [Int]
  let process :: Int -> IO ()
      process 0 = return ()
      process m = do
        [l, r, x] <- liftM (map readInt . B.words) B.getLine
        let slice = filter (< p !! (x - 1)) $ (take (r - l + 1) . drop (l - 1)) p
        putStrLn $ if length slice == (x - l) then "Yes" else "No"
        process (m - 1)
  process m

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

readInt :: B.ByteString -> Int
readInt = fst . fromJust . B.readInt

solve :: Int -> Int -> [Int] -> IO ()
solve 0 _ _ = return ()
solve m n a = do
    [l, r, x] <- liftM (map readInt . B.words) B.getLine
    let sp = filter (< (a !! (x - 1))) (take (r - l + 1) $ drop (l - 1) a)
    putStrLn $ if length sp /= x - l then "No" else "Yes"
    solve (m - 1) n a

main :: IO ()
main = do
    [n, m] <- liftM (map readInt . B.words) B.getLine
    a <- liftM (map readInt . take n . B.words) B.getLine
    -- return ()
--     s <- B.getLine
--     p <- B.getLine
--     let [n, m] = map read (words s) :: [Int]
--     let a = map read (words p) :: [Int]
    solve m n a

{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Array.Unboxed
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve n m ps (l, r, x)
  | odd (r - l + 1) = (==) <$> fst <*> snd $ foldl' (\(s, b) a -> case compare (ps!x) a of
      LT -> (s + 1, b)
      GT -> (s, b + 1)
      otherwise -> (s, b)) (0, 0) [ps!i | i <- [l..r]]
  | otherwise = False

main = do
  n:m:_ <- readInts <$> B.getLine
  ps :: UArray Int Int <- listArray (1, n) . readInts <$> B.getLine
  lrxs <- map (\(l:r:x:_) -> (l, r, x)) <$> replicateM m (readInts <$> B.getLine)
  putStrLn $ unlines . map (\lrx -> if solve n m ps lrx then "Yes" else "No") $ lrxs


module Main where

import Control.Monad (replicateM_, replicateM)
import Data.Maybe (maybe, catMaybes)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B

solve :: [(Int, Int)] -> Int
solve rs = 2 * (maximum (map (snd . rotate) rs) +
                sum (map (fst . rotate) rs))
  where rotate (x, y)
          | x <= y    = (x, y)
          | otherwise = (y, x)

readSlice :: IO (Maybe (Int, Int))
readSlice = do
  vs <- map readInt . B.words <$> B.getLine
  case vs of [x, y] -> pure (Just (x, y))
             _      -> pure Nothing

handleProblem :: IO ()
handleProblem = do
  numberSlices <- readInt <$> B.getLine
  slices <- catMaybes <$> replicateM numberSlices readSlice
  print $ solve slices

main :: IO ()
main = do
  numberProblems <- readInt <$> B.getLine
  replicateM_ numberProblems handleProblem

readInt :: B.ByteString -> Int
readInt v = maybe 0 fst $ B.readInt v

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve xs = 2 * (maxv + mins)
  where maxv = maximum $ map (\(a, b) -> max a b) xs
        mins = sum $ map (\(a, b) -> min a b) xs

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n] <- getInts
    xs <- forM [1..n] $ \_ -> do
      [a, b] <- getInts
      return (a, b)
    print $ solve xs


import Control.Monad

solve :: IO ()
solve = do
    s <- getLine
    let s' = dropWhile (=='1') $ reverse $ dropWhile (=='1') s
        ans | '0' `elem` s' && '1' `elem` s' = 2
            | '0' `elem` s'                  = 1
            | otherwise                      = 0
    print ans

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

import Control.Monad
import Data.List

calc :: String -> Int
calc "10" = 1
calc "01" = 1
calc "0" = 1
calc "1" = 0
calc ('0':'0':xs) = calc ('0':xs)
calc ('1':xs) = calc xs
calc ('0':xs) =
  if elem '0' xs then 2
  else 1

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    print $ calc line

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

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

solve :: String -> Int
solve = min 2 . length . filter (== '0') . map head . group

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[s] <- getNext 1
    let
      s1 = P.dropWhile (== '1') s
      (c, s2) = P.span (== '0') s1
      s3 = P.dropWhile (== '1') s2
    pure . putInts . pure $ if  P.null c
      then  0
      else  if  P.null s3
      then  1
      else  2

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import Control.Monad
import Data.List

calc :: String -> Int
calc s =
  let cz = foldl (\x y -> if y=='0' then x+1 else x) 0 s
      l = length s
  in
    if cz==0 then 0
    else if cz==1 then 1
    else if cz==l then 1
    else 2

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    print $ calc line


{-# OPTIONS_GHC -O2 #-}
main = do
  n <- readLn
  if even n
     then print $ -1
     else do
       putStrLn . unwords $ map show [0..n-1]
       putStrLn . unwords $ map show [0..n-1]
       putStrLn . unwords $ map show [ (i+i)`rem`n | i<-[0..n-1]]

{-#LANGUAGE OverloadedStrings#-}
module Main where

import Data.List

main :: IO ()
main = ( readLn :: IO Int ) >>= solve >>= putStrLn

solve :: Int -> IO String
solve n
    | even n = pure "-1"
    | otherwise =
        pure . intercalate "\n" $ fin
    where
        l1 = [0..n-1]
        l2 = map ( flip mod n . (*2) ) l1
        a = showL l1
        b = showL l2
        fin = [ a,a,b ]

showL :: [Int] -> String
showL = intercalate " " . map show

{-#LANGUAGE OverloadedStrings#-}
module Main where

import Data.List

main :: IO ()
main = ( readLn :: IO Int ) >>= solve >>= putStrLn

solve :: Int -> IO String
solve n
    | even n = pure "-1"
    | otherwise =
        pure . intercalate "\n" $ map showL l3
    where
        l :: [Int]
        l = [0..n-1]
        l3 = [ l, l,  map (flip mod n . (*2)) l ]

showL :: [Int] -> String
showL = intercalate " " . map show

solve 1 = "0\n0\n0"
solve n
  | n `mod` 2 == 0 = "-1"
  | otherwise =
    let
      a = [0..n-1]
      b = [(2 * x) `mod` (n) | x <- a]
      f = unwords . map show
    in
      unlines [f a, f a, f b]

main = do
  n <- fmap read getLine
  putStrLn $ solve n

main = interact (format . solve . read)
format Nothing         = "-1"
format (Just (as,bs,cs)) = unlines (map (unwords . (map show)) [as,bs,cs])
solve n | even n    = Nothing
        | otherwise = Just ([0..n-1],[0..n-1],[0,2..n-1]++[1,3..n-1])

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

main = do
  n <- readLn :: IO Int
  if n `mod` 2 /= 0
     then mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]
     else print $ -1

f n = [(x+x) `mod` n | x <- [0..n-1]]

main :: IO()
main = interact work

work :: String -> String
work input = unlines . map unwords . map (map show) . solve $ n
    where n = read input :: Int

solve :: Int -> [[Int]]
solve n = if n `mod` 2 == 0
          then [[-1]]
          else [a, a, [i * 2 `mod` n | i <- a]]
    where a = [0..n - 1]

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

main = do
  n <- readLn :: IO Int
  if ff n
     then mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]
     else print $ -1

ff n = length(a) /= 0 && n > 2
  where
    a = filter (\x -> n `mod` x == 0 && odd x) [2..n-1]

f n = [(x+x) `mod` n | x <- [0..n-1]]

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

main = do
  n <- readLn :: IO Int
  if ff n || n <= 2
     then print $ -1
     else mapM_ (print) [[0..n-1], [0..n-1], f n]

ff n = any (\x -> n `mod` x == 0) [2..n-1]
f n = [(x+x) `mod` n | x <- [0..n-1]]

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

main = do
  n <- readLn :: IO Int
  if ff n && n > 2
     then mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]
     else print $ -1

ff n = length(a) == 0 || head(a)*head(a) == n
  where
    a = filter (\x -> n `mod` x == 0) [2..n-1]

f n = [(x+x) `mod` n | x <- [0..n-1]]

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

main = do
  n <- readLn :: IO Int
  if ff n || n <= 2
     then print $ -1
     else mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]

ff n = any (\x -> n `mod` x == 0) [2..n-1]
f n = [(x+x) `mod` n | x <- [0..n-1]]

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

main = do
  n <- readLn :: IO Int
  if ff n && n > 2
     then mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]
     else print $ -1

ff n = length(a) /= 0
  where
    a = filter (\x -> n `mod` x == 0 && odd x) [2..n]

f n = [(x+x) `mod` n | x <- [0..n-1]]

solve 1 = "0"
solve n
  | n `mod` 2 == 0 = "-1"
  | otherwise =
    let
      a = [0..n-1]
      b = [(2 * x) `mod` (n) | x <- a]
      f = unwords . map show
    in
      unlines [f a, f a, f b]

main = do
  n <- fmap read getLine
  putStrLn $ solve n


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

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
import Debug.Trace

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

data TC = TC {n :: Int, xs :: [Integer]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< integer
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | length xs' >= 6 = all (== 0) xs'
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i < j, j < k]
    where
      xs' = filter (/= 0) xs ++ replicate (min 2 $ count 0 xs) 0
      ys = zip xs' [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

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

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: Int -> [Int] -> Bool
solve n as = solve' $ L.sort as
    where
        solve' :: [Int] -> Bool
        solve' as
            | L.length (L.filter (< 0) as) > 3 = False
            | L.length (L.filter (> 0) as) > 3 = False
            | L.length (L.filter (== 0) as) > 2 = let
                    zerosCount = L.length (L.filter (== 0) as)
                    noZeros = L.filter (/= 0) as
                in
                    solve' . L.sort $ noZeros ++ L.replicate (min 2 zerosCount) 0
            | otherwise = solve'' as

        solve'' :: [Int] -> Bool
        solve'' as = L.and $ do
            let l = L.length as
            i <- [0 .. l - 1]
            j <- [i + 1 .. l - 1]
            k <- [j + 1 .. l - 1]
            let s = (as L.!! i) + (as L.!! j) + (as L.!! k)

            return $ s `L.elem` as

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    replicateM_ n $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = solve n as
        putsYesNo answer

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

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
import Debug.Trace

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

data TC = TC {n :: Int, xs :: [Integer]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< integer
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | n' >= 6 = all (== 0) xs'
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i < j, j < k]
    where
      nxs = filter (/= 0) xs
      zc = count 0 xs
      xs' = nxs ++ replicate zc 0
      n' = length xs'
      ys = zip xs' [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

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

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

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
import Debug.Trace

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

data TC = TC {n :: Int, xs :: [Integer]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< integer
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | n >= 8 = all (== 0) xs
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i < j, j < k]
    where
      ys = zip xs [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

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

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

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
import Debug.Trace

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

data TC = TC {n :: Int, xs :: [Int]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | n >= 8 = all (== 0) xs
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i /= j, i /= k, j /= k]
    where
      ys = zip xs [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

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

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

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
import Debug.Trace

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

data TC = TC {n :: Int, xs :: [Int]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | n >= 6 = all (== 0) xs
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i /= j, i /= k, j /= k]
    where
      ys = zip xs [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- 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
import Control.Monad.State
import Data.Array
import Data.Maybe
import Data.Bits
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.Char as C

data Info = Empty !Int
          | NonEmpty !Int !Int !Int
          deriving Show

instance Semigroup Info where
    Empty m1          <> Empty m2          = Empty (m1 `xor` m2)
    Empty m1          <> NonEmpty l2 m2 r2 = NonEmpty (m1 `xor` l2) m2 r2
    NonEmpty l1 m1 r1 <> Empty m2          = NonEmpty l1 m1 (r1 `xor` m2)
    NonEmpty l1 m1 r1 <> NonEmpty l2 m2 r2
        | r1 `xor` l2 == 1 = NonEmpty l1 (m1 + m2) r2
        | m1 > m2          = NonEmpty l1 (m1 - m2) (r2 `xor` 1)
        | m1 < m2          = NonEmpty (l1 `xor` 1) (m2 - m1) r2
        | otherwise        = Empty (l1 `xor` r2)

instance Monoid Info where
    mempty = Empty 0

charToInfo :: Char -> Info
charToInfo c
    | c == '(' || c == ')' = Empty 1
    | c == '[' || c == ']' = NonEmpty 0 1 0
    | otherwise            = error "!"

cost :: Info -> Int
cost (Empty _)        = 0
cost (NonEmpty _ m _) = m

solve :: IO ()
solve = do
    s <- C.unpack . C.takeWhile (not . isSpace) <$> C.getLine
    ~[q] <- readInts
    qrys <- replicateM q readInts
    let infoST = fromListST (1, length s) $ map charToInfo s
        doQry ~[l, r] = cost $ foldRangeST l r infoST
    putStr $ unlines $ map (show . doQry) qrys

--------------------------------------------------------------------------------

data SegTree a = SegTree !(Int, Int, Int) !(SegNode a) deriving Show
data SegNode a = SLeaf !a | SBin !a !(SegNode a) !(SegNode a) deriving Show

buildST :: Monoid a => (Int, Int) -> (Int -> SegNode a) -> SegTree a
buildST (l, r) f
    | n < -1    = error "invalid range"
    | n == -1   = SegTree (l, r, 0) $ SLeaf mempty
    | otherwise = SegTree (l, r, bit ht) $ f ht
  where
    n = r - l
    ht = finiteBitSize n - countLeadingZeros n

makeSN :: Semigroup a => SegNode a -> SegNode a -> SegNode a
makeSN lt rt = SBin (getx lt <> getx rt) lt rt where
    getx (SLeaf x) = x
    getx (SBin x _ _) = x

fromListST :: Monoid a => (Int, Int) -> [a] -> SegTree a
fromListST bnds xs = buildST bnds (flip evalState xs . go) where
    pop = state go where
        go []     = (mempty, [])
        go (x:xs) = (x,      xs)
    go j | j == 0 = SLeaf <$> pop
    go j = makeSN <$> go (j - 1) <*> go (j - 1)

foldRangeST :: Monoid a => Int -> Int -> SegTree a -> a
foldRangeST ql qr _ | ql > qr + 1 = error "invalid range"
foldRangeST ql qr (SegTree (l, _, p) root) = go root l (l + p - 1) mempty where
    go _ l r acc | r < ql || qr < l = acc
    go (SLeaf x) _ _ acc = acc <> x
    go (SBin x lt rt) l r acc
        | ql <= l && r <= qr = acc <> x
        | otherwise          = go rt (m + 1) r $! go lt l m acc
        where m = (l + r) `div` 2

--------------------------------------------------------------------------------

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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

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

data Info = Empty !Bool
          | NonEmpty !Bool !Int !Bool
          deriving Show

instance Semigroup Info where
    Empty m1          <> Empty m2          = Empty (m1 /= m2)
    Empty m1          <> NonEmpty l2 m2 r2 = NonEmpty (m1 /= l2) m2 r2
    NonEmpty l1 m1 r1 <> Empty m2          = NonEmpty l1 m1 (r1 /= m2)
    NonEmpty l1 m1 r1 <> NonEmpty l2 m2 r2
        | r1 /= l2  = NonEmpty l1 (m1 + m2) r2
        | m1 > m2   = NonEmpty l1 (m1 - m2) (not r2)
        | m1 < m2   = NonEmpty (not l1) (m2 - m1) r2
        | otherwise = Empty (l1 /= r2)

instance Monoid Info where
    mempty = Empty False

charToInfo :: Char -> Info
charToInfo c
    | c == '(' || c == ')' = Empty True
    | c == '[' || c == ']' = NonEmpty False 1 False
    | otherwise            = error "!"

cost :: Info -> Int
cost (Empty _)        = 0
cost (NonEmpty _ m _) = m

solve :: IO ()
solve = do
    s <- C.unpack . C.takeWhile (not . isSpace) <$> C.getLine
    ~[q] <- readInts
    qrys <- replicateM q readInts
    let infoST = fromListST (1, length s) $ map charToInfo s
        doQry ~[l, r] = cost $ foldRangeST l r infoST
    putStr $ unlines $ map (show . doQry) qrys

--------------------------------------------------------------------------------

data SegTree a = SegTree !(Int, Int, Int) !(SegNode a) deriving Show
data SegNode a = SLeaf !a | SBin !a !(SegNode a) !(SegNode a) deriving Show

buildST :: Monoid a => (Int, Int) -> (Int -> SegNode a) -> SegTree a
buildST (l, r) f
    | n < -1    = error "invalid range"
    | n == -1   = SegTree (l, r, 0) $ SLeaf mempty
    | otherwise = SegTree (l, r, bit ht) $ f ht
  where
    n = r - l
    ht = finiteBitSize n - countLeadingZeros n

makeSN :: Semigroup a => SegNode a -> SegNode a -> SegNode a
makeSN lt rt = SBin (getx lt <> getx rt) lt rt where
    getx (SLeaf x) = x
    getx (SBin x _ _) = x

fromListST :: Monoid a => (Int, Int) -> [a] -> SegTree a
fromListST bnds xs = buildST bnds (flip evalState xs . go) where
    pop = state go where
        go []     = (mempty, [])
        go (x:xs) = (x,      xs)
    go j | j == 0 = SLeaf <$> pop
    go j = makeSN <$> go (j - 1) <*> go (j - 1)

foldRangeST :: Monoid a => Int -> Int -> SegTree a -> a
foldRangeST ql qr _ | ql > qr + 1 = error "invalid range"
foldRangeST ql qr (SegTree (l, _, p) root) = go root l (l + p - 1) mempty where
    go _ l r acc | r < ql || qr < l = acc
    go (SLeaf x) _ _ acc = acc <> x
    go (SBin x lt rt) l r acc
        | ql <= l && r <= qr = acc <> x
        | otherwise          = go rt (m + 1) r $! go lt l m acc
        where m = (l + r) `div` 2

--------------------------------------------------------------------------------

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

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

import Control.Monad
import Control.Monad.State
import Data.Array
import Data.Foldable
import Data.Maybe
import Data.Bits
import Data.Char
import qualified Data.ByteString.Char8 as C

data Info = Empty !Int
          | NonEmpty !Int !Int !Int deriving Show

instance Semigroup Info where
    Empty m1          <> Empty m2          = Empty (m1 `xor` m2)
    Empty m1          <> NonEmpty l2 m2 r2 = NonEmpty (m1 `xor` l2) m2 r2
    NonEmpty l1 m1 r1 <> Empty m2          = NonEmpty l1 m1 (r1 `xor` m2)
    NonEmpty l1 m1 r1 <> NonEmpty l2 m2 r2
        | r1 `xor` l2 == 1   = NonEmpty l1 (m1 + m2) r2
        | m1 == 1 && m2 == 1 = Empty (l1 `xor` r2)
        | otherwise          = NonEmpty l1 (m1 + m2 - 2) r2

charToInfo :: Char -> Info
charToInfo '(' = Empty 1
charToInfo ')' = Empty 1
charToInfo '[' = NonEmpty 0 1 0
charToInfo ']' = NonEmpty 0 1 0
charToInfo _   = error "!"

cost :: Info -> Int
cost (Empty _)        = 0
cost (NonEmpty _ m _) = m

solve :: IO ()
solve = do
    s <- C.unpack . C.takeWhile (not . isSpace) <$> C.getLine
    ~[q] <- readInts
    qrys <- replicateM q readInts
    let infoSP = fromListSP (1, length s) $ map charToInfo s
        doQry ~[l, r] = cost $ querySP l r infoSP
    putStr $ unlines $ map (show . doQry) qrys

--------------------------------------------------------------------------------

type SparseTable a = Array Int (Array Int a)

fromArraySP :: Semigroup a => Array Int a -> SparseTable a
fromArraySP a = if l > h + 1 then error "invalid range" else t where
    (l, h) = bounds a
    n = h - l + 1
    k = finiteBitSize n - countLeadingZeros n - 1
    t = fArray (0, k) f
    f j | j == 0    = a
        | otherwise = fArray (l, h - 2 * hf + 1) g
        where hf = 1 `shiftL` (j - 1)
              p = t!(j - 1)
              g i = p!i <> p!(i + hf)

fromListSP :: Semigroup a => (Int, Int) -> [a] -> SparseTable a
fromListSP bnds xs = fromArraySP $ listArray bnds xs

querySP :: Semigroup a => Int -> Int -> SparseTable a -> a
querySP l r _ | l > r = error "invalid range"
querySP l r t = go l where
    r' = r + 1
    go l | l' == r'  = t!j!l
         | otherwise = t!j!l <> go l'
         where j = countTrailingZeros $ r' - l
               l' = l + 1 `shiftL` j

--------------------------------------------------------------------------------

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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


import Data.List (sort)

(-->) = flip fmap

main = do
  (n:m:_) <- getLine --> words --> map read
  as <- getLine --> words --> map read :: IO [Int]
  let ans = negate $ sum $ takeWhile (< 0) $ take m $ sort as
  print ans

import List
getA = fmap (map read . words) getLine
main = do
	[n, m] <- getA
	a <- getA
	putStr $ show $ negate $ sum $ take m $ sort $ filter (<0) a

import Data.List

main = do
	[n, m] <- getLine >>= return . map read . words :: IO [Int]
	tvs <- getLine >>= return . map read . words :: IO [Int]
	(putStrLn . show . sum . take m . reverse . sort . filter (>0) . map (*(-1))) tvs

import List
main = do
    s <- getLine
    let [n, m] = map read (words s)
    s <- getLine
    let ans = sum $ take m [if x > 0 then 0 else x | x <- sort (map read (words s))]
    print (-ans)

import List

readAs :: IO [Int]
readAs = do
  line <- getLine
  return (map (read::String->Int) (words line))

solve :: Int -> [Int] -> Int
solve 0 _ = 0
solve _ [] = 0
solve m (a:as)
  | a < 0 = (-a) + solve (m - 1) as
  | otherwise = 0

main = do
  [n, m] <- readAs
  as <- readAs
  print (solve m (sort as))

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

import Data.List
import Data.Function

main = do
  [n, m] <- map read . words <$> getLine
  tvs'   <- map read . words <$> getLine
  let tvs = takeWhile (< 0) . sort $ tvs'
      earn = sum $ if length tvs > m then take m tvs else tvs
  print (- earn)

import Data.List (sort)

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

solve :: [Int] -> Int
solve (m:as) = negate $ sum $ take m $ sort $ map (min 0) as
solve _ = undefined

import Data.List
main = do
  [n,m] <- fmap (map read . words) getLine
  print . negate . sum . take m . sort . filter (< 0) . map read . words =<< getLine

import Prelude
import List
import Char

main = interact q

q = func.map (map toInt.words).lines

func::[[Int]]->String
func (a:b:xs) = (solve (last a) b )++ func xs
func []       = ""

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

solve::Int->[Int]->String
solve a b = toString solve'
            where
              list = takeWhile (<0) (sort b)
              solve' | a < (length list) = - (sum (take a list))
                     | otherwise         = - (sum list)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
-- import qualified Data.ByteString.Char8 as BS
import Text.Printf

{-# SPECIALIZE for_ :: Char -> Char -> (Char -> IO ()) -> IO () #-}
{-# SPECIALIZE for_ :: Int -> Int -> (Int -> IO ()) -> IO () #-}
for_ :: (Monad m, Ord a, Enum a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
      -- readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : m : _ <- readData
  xs <- takeWhile (< 0) . take m . sort <$> readData
  printf "%d\n" $ negate (sum xs)

import Data.List

solve ns n = (*) (-1) $ sum $ filter (<= 0) $ take n (sort ns)

main = do
    n <- fmap (last . map read . words) getLine :: IO Int
    ns <- fmap (map read . words) getLine :: IO [Int]
    print $ solve ns n

import Data.List

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

get m num = 0 - (sum . take m . sort . filter (<0) $ num)

main = do
    [n, m] <- getnum
    num <- getnum
    print $ get m num

import List
main = interact (ans)
ans theInput = show a0 where
  [[n,m],a] = map ( map (read::String->Int)) $ map words $ lines theInput
  a0 = (-1) * (sum $ take m (takeWhile (< 0) (sort a)))

import List
main = interact (ans)
ans theInput = show a1 where
  theLines = lines theInput
  line0 = words $ head theLines
  n = read (line0 !! 0) ::Int
  m = read (line0 !! 1) ::Int
  a0 = takeWhile (< 0) (sort $ map (read::String->Int) (words (theLines !! 1)))
  a1 = (-1) * (sum $ take m a0)

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

main=do
	 [n,m]<- map read.words <$> getLine ::IO [Int]
	 r<-   take m .sort. filter (<0) . map (fst.fromJust.C.readInt). C.words <$> C.getLine:: IO [Int]
	 print $ (-(sum r))

import Data.List (sort)

process :: Int -> [Int] -> Int
process m = negate.sum.takeWhile (<0).take m.sort

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,m] <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    print $ process m as

import Data.List
import Control.Applicative

solve :: Int -> [Int] -> Int
solve n = ((-1) * ) . sum . take n . sort . filter (<0)

main = do
  [m, n] <- map read . words <$> getLine
  tvs <- map read . words <$> getLine
  print (solve n tvs)

import Data.List

main = do
	[n, m] <- getLine >>= return . map read . words :: IO [Int]
	tvs <- getLine >>= return . map read . words :: IO [Int]
	(putStrLn . show . sum . take m . sort . filter (>0) . map (*(-1))) tvs

main = do
  [n,m] <- fmap (map read . words) getLine
  print . sum . map read . take m . words =<< getLine

import Prelude
import List
import Char

main = interact q

q = func.map (map toInt.words).lines

func::[[Int]]->String
func (a:b:xs) = (solve (last a) b )++ func xs
func []       = ""

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

solve::Int->[Int]->String
solve a b = toString solve'
            where
              list = takeWhile (<0) (sort b)
              solve' | a < (length list) = sum (take a list)
                     | otherwise         = sum list

import Prelude
import List
import Char

main = interact q

q = func.map (map toInt.words).lines

func::[[Int]]->String
func (a:b:xs) = (solve (last a) b )++ func xs
func []       = ""

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

solve::Int->[Int]->String
solve a b = toString (solve' b)
            where
              solve' = (0-).sum.take a.rsort

rsort = sort

import Data.List

solve ns n = (*) (-1) $ sum $ filter (>= 0) $ take n (sort ns)

main = do
    n <- fmap (last . map read . words) getLine :: IO Int
    ns <- fmap (map read . words) getLine :: IO [Int]
    print $ solve ns n

import Data.List

solve ns n = (*) (-1) $ sum $ take n (sort ns)

main = do
    n <- fmap (last . map read . words) getLine :: IO Int
    ns <- fmap (map read . words) getLine :: IO [Int]
    print $ solve ns n

import Data.List
import Control.Applicative

solve :: Int -> [Int] -> Int
solve n = ((-1) * ) . sum . take n . reverse . sort . filter (<0)

main = do
  [m, n] <- map read . words <$> getLine
  tvs <- map read . words <$> getLine
  print (solve m tvs)

import Data.List
import Control.Applicative

solve :: Int -> [Int] -> Int
solve n = ((-1) * ) . sum . take n . reverse . sort . filter (<0)

main = do
  [m, n] <- map read . words <$> getLine
  tvs <- map read . words <$> getLine
  print (solve n tvs)


import Control.Monad

main = readLn >>= flip replicateM_ solve

solve :: IO ()
solve = readLn >>= putStrLn . getAns

getAns :: Int -> String
getAns x | x `mod` 2 == 0 = replicate (x `div` 2) '1'
         | otherwise = '7' : replicate (x `div` 2 - 1) '1'

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

process d | d==2 = "1"
          | d==3 = "7"
	  | even d = replicate (div d 2) '1'
	  | otherwise = "7" ++ (replicate ((div d 2)-1) '1')

onecase = do
		d<-read <$> getLine ::IO Int
		putStrLn $ process d

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

process :: Int -> [Char]
process n
    | even n = replicate (n`div`2) '1'
    | otherwise = '7':replicate ((n-3)`div`2) '1'

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    n <- fmap readInt getLine
    putStrLn $ process n
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

readInt :: IO Int
readInt = do
        t <- getLine
        return $ read t

createString :: Int -> String
createString n = (if n `mod` 2 /= 0 then '7' else '1') : replicate ((n-2) `quot` 2) '1'

solve :: Int -> IO ()
solve 0 = return ()
solve t = do
        n <- readInt
        putStrLn $ createString n
        solve (t-1)

main :: IO ()
main = do
        t <- readInt
        solve t

import Control.Monad

greatest :: Int -> String
greatest n = if n `mod` 2 == 0
    then replicate (n `div` 2) '1'
    else '7' : greatest (n - 3)

solve :: IO ()
solve = do
    n <- readLn
    putStrLn $ greatest n

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

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

solve 0 = ""
solve n | odd n = '7':solve (n - 3) | otherwise = '1':solve (n - 2)

main = getLine >> getContents >>= mapM_ (putStrLn.solve).map read.words

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>), (<|), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    n <- get
    putsln $ f2 n

f2 :: Int -> String
f2 n =  if (mod n 2) == 1 then toList $ '7' DSeq.<| DSeq.replicate (div (n - 2) 2) '1'
        else replicate (div n 2) '1'

wordsWhen     :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

repeatNTimes 0 _ = return ()
repeatNTimes n action =
 do
  action
  repeatNTimes (n-1) action

index :: Int -> Int -> Int
index q n = (q - 1) `mod` n

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

    --main cycle
    repeatNTimes t (do
        input2 <- getLine
        let n = read input2 :: Int

        let maxOnes = n `div` 2
        let odd = n `mod` 2 == 1
        let ones = if odd then maxOnes - 1 else maxOnes

        putStr $ if odd then "7" else ""
        repeatNTimes ones (do
          putStr "1"
          )
        putStrLn ""
        )

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    n <- get
    putsln $ f2 n

f2 :: Int -> String
f2 n = if n == 2 then "1" else
       if n == 3 then "7" else
        '1' : f2 (n - 2)

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    n <- get
    putsln $ f2 n

f2 :: Int -> String
f2 n = if n == 2 then "1" else
       if n == 3 then "7" else
       if n == 4 then "11" else
       if n == 5 then "71" else
        '1' : f2 (n - 2)

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

process d | d==2 = "1"
          | d==3 = "7"
	  | even d = replicate (div d 2) '1'
	  | otherwise = "7" ++ (replicate (div d 2) '1')

onecase = do
		d<-read <$> getLine ::IO Int
		putStrLn $ process d

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


main :: IO()

main =
    interact $ unlines . map (show . process . read ). drop 1 . lines

process i
    | mod i 7 == 0 = i
    | otherwise = let base = i - (i `mod` 10) in base + (7 - base `mod` 7);

import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= print . div7
div7 :: Int -> Int
div7 x | mod x 7 == 0 = x
       | otherwise = case filter (\a -> mod a 7 == 0)
                          (map (((div x 10)*10)+) [0..9]) of
                       n:_ -> n
                       _ -> error "Some number in a decade must be divisible by 7."

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM t $ do
        n <- readLn
        putStrLn . show $ solve n
    return ()

solve :: Int -> Int
solve n
  | mod n 7 == 0        = n
  | mod n 7 <= mod n 10 = n - mod n 7
  | otherwise           = n + (7 - mod n 7)

module Main where

import           Control.Monad (replicateM_)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        let r = n `mod` 10
        print $ if n `mod` 7 == 0
                then n
                else head . filter (\x -> x `mod` 7 == 0) $ map ((n - r)+) [0..9]

import Control.Monad (forM_)

solve :: Integral a => a -> a
solve n
    | mod n 7 == 0 = n
    | mod n 7 <= mod n 10 = n - mod n 7
    | otherwise = n + (7 - mod n 7)

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        print $ solve n

{-# LANGUAGE BangPatterns #-}
import Control.Monad
solve :: Int -> Int
solve n = 10 * lead + lst'
  where
    !(lead, lst) = divMod n 10
    r = mod n 7
    lst'
      | r == 0 = lst
      | lst - r >= 1 = lst - r
      | otherwise = lst - r + 7

main :: IO ()
main = do
  n <- readLn
  replicateM_ n $ do
    x <- readLn
    print $ solve x

import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= print . div7
div7 :: Int -> Int
div7 x = case filter (\a -> mod a 7 == 0) (map (((div x 10)*10)+) [0..9]) of
           n:_ -> n
           _ -> error "Some number in a decade must be divisible by 7."

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM t $ do
        n <- readLn
        putStrLn . show $ solve n
    return ()

solve :: Int -> Int
solve n
  | mod n 7 == 0        = n
  | mod n 7 <= mod n 10 = n - mod n 7
  | otherwise           = n + mod n 7

module Main where

import           Control.Monad (replicateM_)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        print $ if n `mod` 10 > 5
                then find pred n
                else find succ n

find :: (Int -> Int) -> Int -> Int
find f n = head . filter (\x -> x `mod` 7 == 0) $ iterate f n