Kefa decided to celebrate his first big salary by going to the restaurant. He lives by an unusual park. The park is a rooted tree consisting of n vertices with the root at vertex 1. Vertex 1 also contains Kefa's house. Unfortunaely for our hero, the park also contains cats. Kefa has already found out what are the vertices with cats in them.The leaf vertices of the park contain restaurants. Kefa wants to choose a restaurant where he will go, but unfortunately he is very afraid of cats, so there is no way he will go to the restaurant if the path from the restaurant to his house contains more than m consecutive vertices with cats. Your task is to help Kefa count the number of restaurants where he can go.

The first line contains two integers, n and m (2 ≤ n ≤ 105, 1 ≤ m ≤ n) — the number of vertices of the tree and the maximum number of consecutive vertices with cats that is still ok for Kefa. The second line contains n integers a1, a2, ..., an, where each ai either equals to 0 (then vertex i has no cat), or equals to 1 (then vertex i has a cat). Next n - 1 lines contains the edges of the tree in the format "xi yi" (without the quotes) (1 ≤ xi, yi ≤ n, xi ≠ yi), where xi and yi are the vertices of the tree, connected by an edge.  It is guaranteed that the given set of edges specifies a tree.

A single integer — the number of distinct leaves of a tree the path to which from Kefa's home contains at most m consecutive vertices with cats.

NoteLet us remind you that a tree is a connected graph on n vertices and n - 1 edge. A rooted tree is a tree with a special vertex called root. In a rooted tree among any two vertices connected by an edge, one vertex is a parent (the one closer to the root), and the other one is a child. A vertex is called a leaf, if it has no children.Note to the first sample test:  The vertices containing cats are marked red. The restaurants are at vertices 2, 3, 4. Kefa can't go only to the restaurant located at vertex 2.Note to the second sample test:  The restaurants are located at vertices 4, 5, 6, 7. Kefa can't go to restaurants 6, 7.

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

dfs
    :: Int
    -> Map.Map Int [Int]
    -> Map.Map Int Bool
    -> Int
    -> Int
    -> Set.Set Int
    -> Int
dfs maxCats edgeMap hasCat nCats node visited
    | node `Set.member` visited = 0
    | nCats' > maxCats = 0
    | all (`Set.member` visited) (edgeMap Map.! node) = 1
    | otherwise = sum
        [ dfs maxCats edgeMap hasCat nCats' n (Set.insert node visited)
        | n <- edgeMap Map.! node
        ]
    where nCats' = if hasCat Map.! node then nCats + 1 else 0

g :: Int -> Int -> [Int] -> [(Int, Int)] -> Int
g n maxCats cats edges =
    let hasCat  = Map.fromAscList $ zip [0 ..] [ v == 1 | v <- cats ]
        edgeMap = Map.fromListWith (++) [ (a, [b]) | (a, b) <- edges ]
    in  dfs maxCats edgeMap hasCat 0 0 Set.empty

f :: [String] -> Int
f (nm : cats : edges) =
    let [n, maxCats] = map read . words $ nm :: [Int]
        cats'        = map read . words $ cats :: [Int]
        edges' :: [(Int, Int)]
        edges'  = map ((\[a, b] -> (a - 1, b - 1)) . (map read . words)) edges
        edges'' = edges' ++ [ (b, a) | (a, b) <- edges' ]
    in  g n maxCats cats' edges''

-- TOOD: Nicer way to extract the lines?
main = interact $ show . f . lines

import Data.Array
dfs cat edges now ccat maxcat pre| isOne nextList && now /= 1 = if catnum <= maxcat then 1 else 0
                                 | otherwise = if catnum > maxcat then 0 else sum [dfs cat edges next catnum maxcat now| next <- nextList,next /= pre]
    where nextList = (edges ! now)
          hascat = (cat ! now)
          catnum = getCat hascat ccat
getCat a b | a == 0 = 0
           | otherwise = (a+b)
isOne (x:xs) = null xs
getTuple s = (a0,a1)
  where [a0,a1] = [read n::Int|n <- (words s)]
main = do
  w0 <- getLine
  let [n,m] = [read n::Int|n <- (words w0)]
  w1 <- getLine
  let hasCat = listArray (1,n) [read n::Int|n <- (words w1)]
  w2 <- getContents
  let e = [getTuple s | s <- (lines w2)]
  let e2 = e ++ (map (\x -> (snd x,fst x)) e)
  let edges = accumArray (flip (:)) [] (1,n) e2
  print $ dfs hasCat edges 1 0 m 0

import Control.Applicative ((<$>))
import Data.Map (empty, (!), fromList, insert, adjust)
import Debug.Trace

-- 580C

solve :: Int -> Int -> [Bool] -> [[Int]] -> Int
solve n m hasCatLst edges =
  countRestaurants 0 m 1
  where
    empty_map = fromList [(i, []) | i <- [1..n]]
    append u v =
      adjust (v:) u . adjust (u:) v
    childrenArr = foldr (\[u, v] -> \mapping -> append u v mapping) empty_map edges
    hasCatArr = fromList $ zip [1..] hasCatLst
    countRestaurants parent m' i
      | m'' >= 0 && leaf = 1
      | leaf = 0
      | m'' < 0 = 0
      | otherwise = sum $ map (countRestaurants i m'') children
      where
        children = filter (/= parent) $ childrenArr ! i
        hasCat = hasCatArr ! i
        leaf = length children == 0
        m'' = if hasCat then m' - 1 else m

main = do
  let f = map read . words <$> getLine
  [n, m] <- f
  hasCatLst <- map toEnum <$> f
  edges <- map (map read . words) . lines <$> getContents
  putStrLn $ show $ solve n m hasCatLst edges

import Data.Array
import Data.Graph
import Control.Monad
main = do
  [n,m] <- map read . words <$> getLine
  cats <- listArray (1,n) . map (toEnum . read) . words <$> getLine
  g <- fmap (buildG (1,n) . concat) $ replicateM (n-1) $ do
    [x,y] <- map read . words <$> getLine
    return [(x,y),(y,x)]
  let [t] = dfs g [1]
      count c (Node n ts) | c' > m = 0
                          | null ts = 1
                          | otherwise = sum (map (count c') ts)
        where c' = if cats!n then c+1 else 0
  print $ count 0 t

import Data.Array
import Data.Char (ord)
import Data.List (groupBy, sortBy)
import Data.Ord (comparing)
import Data.Tuple (swap)

type IntArray a = Array Int a

type Input = (Int, IntArray Int, IntArray [Int])

readInt :: String -> Int
readInt = foldl step 0 where step s a = s * 10 + ord a - 48

readPair :: String -> (Int, Int)
readPair s = (a, b)
    where [a, b] = map readInt . words $ s

parseV :: Int -> String -> IntArray Int
parseV n l = listArray (1, n) a
    where a = map readInt . words $ l

sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))

groupOn :: Ord b => (a -> b) -> [a] -> [[a]]
groupOn k = groupBy f . sortOn k
    where f x y = k x == k y

parseE :: Int -> [String] -> IntArray [Int]
parseE n ls =
    let es = map readPair ls
        gs = groupOn fst (es ++ map swap es)
    in  listArray (1, n) (map (map snd) gs)

parse :: String -> Input
parse contents =
    let (l0 : l1 : ls) = lines contents
        [n, m] = map readInt . words $ l0
    in  (m, parseV n l1, parseE n ls)

solve :: Input -> Int
solve (m, a, tree) = dfs (-1) 0 1
    where dfs :: Int -> Int -> Int -> Int
          dfs p k v =
              let a' = a ! v
                  k' = if a' == 0 then 0 else k + 1
                  nv = filter (/= p) $ tree ! v in
              if   k' > m
              then 0
              else if   null nv
                   then 1
                   else sum . map (dfs v k') $ nv

main :: IO ()
main = print . solve . parse =<< getContents

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

dfs :: Int -> Map.Map Int [Int] -> Map.Map Int Bool -> Int -> Int -> Int
dfs maxCats edgeMap hasCat nCats node
    | nCats' > maxCats = 0
    | null $ Map.findWithDefault [] node edgeMap = 1
    | otherwise = sum
        [ dfs maxCats edgeMap hasCat nCats' n | n <- edgeMap Map.! node ]
    where nCats' = if hasCat Map.! node then nCats + 1 else 0

g :: Int -> Int -> [Int] -> [(Int, Int)] -> Int
g n maxCats cats edges =
    let hasCat  = Map.fromAscList $ zip [0 ..] [ v == 1 | v <- cats ]
        edgeMap = Map.fromListWith (++) [ (a, [b]) | (a, b) <- edges ]
        root    = Set.elemAt 0 $ Set.difference
            (Set.fromAscList [0 .. n - 1])
            (Set.fromList $ Map.foldr (++) [] edgeMap)
    in  dfs maxCats edgeMap hasCat 0 root

f :: [String] -> Int
f (nm : cats : edges) =
    let [n, maxCats] = map read . words $ nm :: [Int]
        cats'        = map read . words $ cats :: [Int]
        edges' :: [(Int, Int)]
        edges' = map ((\[a, b] -> (a - 1, b - 1)) . (map read . words)) edges
    in  g n maxCats cats' edges'

-- TOOD: Nicer way to extract the lines?
main = interact $ show . f . lines

import Data.Array
dfs cat edges now ccat maxcat | null nextList = if (hascat + ccat) <= maxcat then 1 else 0
                              | otherwise = sum [dfs cat edges next (getCat hascat ccat) maxcat| next <- nextList]
    where nextList = (edges ! now)
          hascat = (cat ! now)
getCat a b | a == 0 = 0
           | otherwise = (a+b)
getTuple s = (a0,a1)
  where [a0,a1] = [read n::Int|n <- (words s)]
main = do
  w0 <- getLine
  let [n,m] = [read n::Int|n <- (words w0)]
  w1 <- getLine
  let hasCat = listArray (1,n) [read n::Int|n <- (words w1)]
  w2 <- getContents
  let e = [getTuple s | s <- (lines w2)]
  let edges = accumArray (flip (:)) [] (1,n) e
  print $ dfs hasCat edges 1 0 m

import Data.Array
dfs cat edges now ccat maxcat pre| isOne nextList && now /= 1 = if (hascat + ccat) <= maxcat then 1 else 0
                                 | otherwise = sum [dfs cat edges next (getCat hascat ccat) maxcat now| next <- nextList,next /= pre]
    where nextList = (edges ! now)
          hascat = (cat ! now)
getCat a b | a == 0 = 0
           | otherwise = (a+b)
isOne (x:xs) = null xs
getTuple s = (a0,a1)
  where [a0,a1] = [read n::Int|n <- (words s)]
main = do
  w0 <- getLine
  let [n,m] = [read n::Int|n <- (words w0)]
  w1 <- getLine
  let hasCat = listArray (1,n) [read n::Int|n <- (words w1)]
  w2 <- getContents
  let e = [getTuple s | s <- (lines w2)]
  let e2 = e ++ (map (\x -> (snd x,fst x)) e)
  let edges = accumArray (flip (:)) [] (1,n) e2
  print $ dfs hasCat edges 1 0 m 0

import Data.Array
dfs cat edges now ccat maxcat pre| null nextList = if (hascat + ccat) <= maxcat then 1 else 0
                                 | otherwise = sum [dfs cat edges next (getCat hascat ccat) maxcat now| next <- nextList,next /= pre]
    where nextList = (edges ! now)
          hascat = (cat ! now)
getCat a b | a == 0 = 0
           | otherwise = (a+b)
getTuple s = (a0,a1)
  where [a0,a1] = [read n::Int|n <- (words s)]
main = do
  w0 <- getLine
  let [n,m] = [read n::Int|n <- (words w0)]
  w1 <- getLine
  let hasCat = listArray (1,n) [read n::Int|n <- (words w1)]
  w2 <- getContents
  let e = [getTuple s | s <- (lines w2)]
  let e2 = e ++ (map (\x -> (snd x,fst x)) e)
  let edges = accumArray (flip (:)) [] (1,n) e
  print $ dfs hasCat edges 1 0 m 0

import Data.Array
dfs cat edges now ccat maxcat pre| isOne nextList = if (hascat + ccat) <= maxcat then 1 else 0
                                 | otherwise = sum [dfs cat edges next (getCat hascat ccat) maxcat now| next <- nextList,next /= pre]
    where nextList = (edges ! now)
          hascat = (cat ! now)
getCat a b | a == 0 = 0
           | otherwise = (a+b)
isOne (x:xs) = null xs
getTuple s = (a0,a1)
  where [a0,a1] = [read n::Int|n <- (words s)]
main = do
  w0 <- getLine
  let [n,m] = [read n::Int|n <- (words w0)]
  w1 <- getLine
  let hasCat = listArray (1,n) [read n::Int|n <- (words w1)]
  w2 <- getContents
  let e = [getTuple s | s <- (lines w2)]
  let e2 = e ++ (map (\x -> (snd x,fst x)) e)
  let edges = accumArray (flip (:)) [] (1,n) e2
  print $ dfs hasCat edges 1 0 m 0

import Control.Applicative
import Data.List
import Data.Array
import Debug.Trace

-- 580C

data TreeNode = TreeNode {
  hasCat :: Bool,
  children :: [Int]
} deriving (Show)

solve :: Int -> Int -> [Bool] -> [[Int]] -> Int
solve n m hasCatLst edges =
  countRestaurants m 1
  where
    track a = trace (show a) a
    edgeGroups = groupBy (\a -> \b -> head a == head b) (sort (map sort edges))

    makeNodes (x:rst) (hasCat:rstHasCat) nextIdx =
      let nodeIdx = head (head x)
          children = map last x
      in
       if nodeIdx == nextIdx then
         (TreeNode {hasCat = hasCat,
                   children = children}):makeNodes rst rstHasCat (nextIdx + 1)
       else
         (TreeNode {hasCat = hasCat,
                    children = []}):makeNodes (x:rst) rstHasCat (nextIdx + 1)

    makeNodes [] (hasCat:rstHasCat) nextIdx =
      (TreeNode {hasCat = hasCat,
                 children = []}):makeNodes [] rstHasCat (nextIdx + 1)
    makeNodes [] [] _ = []

    q = makeNodes edgeGroups hasCatLst 1
    nodes = listArray (1, n)  q

    countRestaurants m' rootIdx
      | m'' >= 0 && children root == [] = 1
      | m'' >= 0 =  sum $ map (countRestaurants m'') (children root)
      | otherwise = 0
      where
        root = nodes ! rootIdx
        m'' = if hasCat root then m' - 1 else m

main = do
  let f = map read . words <$> getLine
  [n, m] <- f
  hasCatLst <- map toEnum <$> f
  edges <- map (map read . words) . lines <$> getContents
  putStrLn $ show $ solve n m hasCatLst edges

import Control.Applicative
import Data.List
import Data.Array
import Debug.Trace

-- 580C

data TreeNode = TreeNode {
  hasCat :: Bool,
  children :: [Int]
} deriving (Show)

solve :: Int -> Int -> [Bool] -> [[Int]] -> Int
solve n m hasCatLst edges =
  countRestaurants m 1
  where
    track a = trace (show a) a
    edgeGroups = groupBy (\a -> \b -> head a == head b) (sort edges)

    makeNodes (x:rst) (hasCat:rstHasCat) nextIdx =
      let nodeIdx = head (head x)
          children = map last x
      in
       if nodeIdx == nextIdx then
         (TreeNode {hasCat = hasCat,
                   children = children}):makeNodes rst rstHasCat (nextIdx + 1)
       else
         (TreeNode {hasCat = hasCat,
                    children = []}):makeNodes (x:rst) rstHasCat (nextIdx + 1)

    makeNodes [] (hasCat:rstHasCat) nextIdx =
      (TreeNode {hasCat = hasCat,
                 children = []}):makeNodes [] rstHasCat (nextIdx + 1)
    makeNodes [] [] _ = []

    q = makeNodes edgeGroups hasCatLst 1
    nodes = listArray (1, n)  q

    countRestaurants m' rootIdx
      | m'' >= 0 && children root == [] = 1
      | m'' >= 0 =  sum $ map (countRestaurants m'') (children root)
      | otherwise = 0
      where
        root = nodes ! rootIdx
        m'' = if hasCat root then m' - 1 else m

main = do
  let f = map read . words <$> getLine
  [n, m] <- f
  hasCatLst <- map toEnum <$> f
  edges <- map (map read . words) . lines <$> getContents
  putStrLn $ show $ solve n m hasCatLst edges

import Data.Array
import Data.Graph
import Control.Monad
main = do
  [n,m] <- map read . words <$> getLine
  cats <- listArray (1,n) . map (toEnum . read) . words <$> getLine
  g <- fmap (buildG (1,n)) $ replicateM (n-1) $ do
    [x,y] <- map read . words <$> getLine
    return (x,y)
  let [t] = dfs g [1]
      count c (Node n ts) | c' > m = 0
                          | null ts = 1
                          | otherwise = sum (map (count c') ts)
        where c' = if cats!n then c+1 else 0
  print $ count 0 t


Eugeny has array a = a1, a2, ..., an, consisting of n integers. Each integer ai equals to -1, or to 1. Also, he has m queries:  Query number i is given as a pair of integers li, ri (1 ≤ li ≤ ri ≤ n).  The response to the query will be integer 1, if the elements of array a can be rearranged so as the sum ali + ali + 1 + ... + ari = 0, otherwise the response to the query will be integer 0. Help Eugeny, answer all his queries.

The first line contains integers n and m (1 ≤ n, m ≤ 2·105). The second line contains n integers a1, a2, ..., an (ai = -1, 1). Next m lines contain Eugene's queries. The i-th line contains integers li, ri (1 ≤ li ≤ ri ≤ n).

Print m integers — the responses to Eugene's queries in the order they occur in the input.

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = mapM_ print . solve . map (map (maybe 0 fst . B.readInt) . B.words) . B.lines =<< B.getContents

solve :: [[Int]] -> [Int]
solve ([n, m] : as : qs) = map f qs
  where
  pos = length $ filter (== 1) as
  neg = n - pos
  f [l, r] = fromEnum $ m == 0 && pos >= d && neg >= d
    where
    (d, m) = (r - l + 1) `quotRem` 2

import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B

main = B.interact $ B.unwords . map showBI . rd . B.lines
rd (nm:a:ql) = go (map (fst . fromJust . B.readInt) (B.words a)) (map (map $ fst . fromJust . B.readInt) . map B.words $ ql)
go a ql = foldr (\(l:r:[]) ans -> (ch l r):ans) [] ql
          where ch l r | (r-l+1)`mod`2 == 1 = 0
                       | otherwise = if (p>=cnt)&&(n>=cnt) then 1 else 0
                                     where cnt = (r-l+1)`div`2
                                           p = length $ filter (>0) a
                                           n = length $ filter (<0) a

showBI :: Int -> B.ByteString
showBI = B.pack . show

import Control.Monad (liftM, replicateM)
import Prelude hiding (read, reads)

read :: String -> Int
read ('-':s)  =  (-1) * read s
read s  =  read' 0 s
  where
    read' a ""  =  a
    read' a (c:s)  =  read' a' s
      where
        a'  =  10*a + fromEnum c - fromEnum '0'

--reads :: Read a => IO [a]
reads :: IO [Int]
reads  =  liftM (map read . words) getLine

solve :: Int -> [Int] -> [[Int]] -> [Int]
solve n as qs  =  map solve' qs
  where
    x  =  length $ filter (== 1) as
    y  =  n - x
    solve' [l,r]
      | odd (r - l + 1)  =  0
      | (r - l + 1) > 2 * min x y  =  0
      | otherwise  =  1

main :: IO ()
main  =  do
    [n, m]  <-  reads
    as  <-  reads
    qs  <-  replicateM m reads
    mapM_ print $ solve n as qs

import Control.Monad (liftM, replicateM)
import Prelude hiding (read, reads)

read :: String -> Int
read ('-':s)  =  (-1) * read s
read s  =  read' 0 s
  where
    read' a ""  =  a
    read' a (c:s)  =  read' a' s
      where
        a'  =  10*a + fromEnum c - fromEnum '0'

--reads :: Read a => IO [a]
reads :: IO [Int]
reads  =  liftM (map read . words) getContents

solve :: Int -> [Int] -> [Int] -> [Int]
solve n as qs  =  solve' qs
  where
    x  =  length $ filter (== 1) as
    y  =  n - x
    solve' (l:r:qs)
      | odd (r - l + 1)  =  0 : solve' qs
      | (r - l + 1) > 2 * min x y  =  0 : solve' qs
      | otherwise  =  1 : solve' qs
    solve' _  =  []

main :: IO ()
main  =  do
    ints  <-  reads
    let [n, m]  =  take 2 ints
    let as  =  take n $ drop 2 ints
    let qs  =  take (2*m) $ drop n $ drop 2 ints
    mapM_ print $ solve n as qs

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

main = do
  [n, m] <- getList
  a <- getList
  let aminus = foldl' (\acc x -> if x < 0 then acc+1 else acc) 0 a
  let aplus = length(a) - aminus
  m <- replicateM m getList
  mapM_ (\x -> print $ f x aminus aplus) m
  where
    f [l, r] aminus aplus = if t `mod` 2 == 0 && t2 <= aminus && t2 <= aplus && t > 0 then 1 else 0
      where
	t = r - l + 1
	t2 = t `div` 2
    getList = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B

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

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  lrs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show $ solve n xs lrs

solve :: Int -> [Int] -> [Int] -> [Int]
solve n xs lrs = go lrs
   where
     !ts = sum[1|1<-xs]
     !fs = n - ts
     go (l:r:rest)
       | even (r-l) = 0 : go rest
       | 2 * min ts fs >= r-l+1 = 1 : go rest
       | otherwise = 0 : go rest
     go _ = []

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

process [] _ _ = do
			putStr ""

process ([b1,b2]:b) a1 a2 = do
				process1 b1 b2 a1 a2
				process b a1 a2

process1 b1 b2 a1 a2 = do
				print $ if even (b2-b1) then 0
						        else if a1> div (b2-b1) 2 && a2 >div (b2-b1) 2 then 1 else 0

main = do
		[ne,nq]<- map read <$> words <$> getLine ::IO [Int]
		a<- words <$> getLine
		let a1= length $ filter (=="1") a
		let a2= (length a) - a1
		b<- map (map read) <$> map words <$> replicateM nq getLine ::IO [[Int]]
		process b a1 a2


Last year Bob earned by selling memory sticks. During each of n days of his work one of the two following events took place:   A customer came to Bob and asked to sell him a 2x MB memory stick. If Bob had such a stick, he sold it and got 2x berllars.  Bob won some programming competition and got a 2x MB memory stick as a prize. Bob could choose whether to present this memory stick to one of his friends, or keep it. Bob never kept more than one memory stick, as he feared to mix up their capacities, and deceive a customer unintentionally. It is also known that for each memory stick capacity there was at most one customer, who wanted to buy that memory stick. Now, knowing all the customers' demands and all the prizes won at programming competitions during the last n days, Bob wants to know, how much money he could have earned, if he had acted optimally.

The first input line contains number n (1 ≤ n ≤ 5000) — amount of Bob's working days. The following n lines contain the description of the days. Line sell x stands for a day when a customer came to Bob to buy a 2x MB memory stick (0 ≤ x ≤ 2000). It's guaranteed that for each x there is not more than one line sell x. Line win x stands for a day when Bob won a 2x MB memory stick (0 ≤ x ≤ 2000).

Output the maximum possible earnings for Bob in berllars, that he would have had if he had known all the events beforehand. Don't forget, please, that Bob can't keep more than one memory stick at a time.

7
win 10
win 5
win 3
sell 5
sell 3
win 10
sell 10

{-# LANGUAGE RankNTypes #-}

import Control.Monad
import Data.List
import Data.Array
import System.IO

import Data.List
import Data.Ord
import Data.Array
import Control.Monad

{-
メモ化
-}
memoise :: forall a b. Ix a => ((a -> b) -> a -> b) -> (a,a) -> a -> b
memoise f r = let mem = listArray r . map (f (mem!)) $ range r in (mem!)

{-
メモ化フィボナッチ
-}
fib :: (Integer -> Integer) -> Integer -> Integer
fib f n | n <= 1 = n
        | True = f (n-1) + f (n-2)

max_memo :: Integer
max_memo = 500

memoFib :: Integer -> Integer
memoFib = memoise fib (0,100000)

{-
パスカルの三角形
-}
pascalTriangle :: Integer -> Integer -> Integer
pascalTriangle = memoise row (0,1000000)
  where
    row memo n = memoise col rng
        where
          rng = (0,n)
          col _ r
            | r == 0 = 1
            | r == n = 1
            | True     = memo (n-1) (r-1) + memo (n-1) r

comb :: Integer -> Integer -> Integer
comb = pascalTriangle

--memoise

toTuple :: [String] -> (String,Integer)
toTuple (a:b:[]) = (a,read b)

eqFst (a,b) (c,d) = a==c

--calc :: Array Int (String, Integer) -> Int -> Integer
calc xs memo k
  | k <= 1                = 0
  | fst (xs ! k) == "win" = y
  | True                  = maximum $ (y : map f [1..k-1])
  where
    y = memo (k-1)
    --y = calc xs (k-1)
    f m | fst (xs ! m) == "sell"   = 0
        | snd (xs!m) /= snd (xs!k) = 0
       -- | m == 1                   = 0
        | True                     = 2 ^ (snd (xs ! m)) + memo (m-1)

memoCalc xs n = memoise (calc xs) (0,n)

main = do
    n <- readLn :: IO Int
    xs' <- replicateM n $ (toTuple . words) `liftM` getLine
    let xs = listArray (1,n) xs'

    print $ memoCalc xs n n

tryX :: Int -> [(String, Int)] -> Integer
tryX (-1) _ = 0
tryX x events = let sells = [j | (j, ("sell", y)) <- eventsWithIds, y == x] in
                    if null sells then tryX (x - 1) events
                    else let j = head sells; wins = [i | (i, ("win", y)) <- take j eventsWithIds, y == x] in
                         if null wins then tryX (x - 1) events
                         else let i = last wins in
                              2 ^ x + tryX (x - 1) (take i events) + tryX (x - 1) (drop (j + 1) events)
                where eventsWithIds = zip [0..] events

solve :: [(String, Int)] -> Integer
solve events = tryX 2000 events

main = do
    contents <- getContents
    let n = read $ head $ lines contents
    let events = map (\s -> let [t, x] = words s in (t, read x)) $ take n $ tail $ lines contents
    putStrLn $ show $ solve events

{-# LANGUAGE RankNTypes #-}

import Control.Monad
import Data.List
import Data.Array
import System.IO

import Data.List
import Data.Ord
import Data.Array
import Control.Monad

{-
メモ化
-}
memoise :: forall a b. Ix a => ((a -> b) -> a -> b) -> (a,a) -> a -> b
memoise f r = let mem = listArray r . map (f (mem!)) $ range r in (mem!)

{-
メモ化フィボナッチ
-}
fib :: (Integer -> Integer) -> Integer -> Integer
fib f n | n <= 1 = n
        | True = f (n-1) + f (n-2)

max_memo :: Integer
max_memo = 500

memoFib :: Integer -> Integer
memoFib = memoise fib (0,100000)

{-
パスカルの三角形
-}
pascalTriangle :: Integer -> Integer -> Integer
pascalTriangle = memoise row (0,1000000)
  where
    row memo n = memoise col rng
        where
          rng = (0,n)
          col _ r
            | r == 0 = 1
            | r == n = 1
            | True     = memo (n-1) (r-1) + memo (n-1) r

comb :: Integer -> Integer -> Integer
comb = pascalTriangle

--memoise

toTuple :: [String] -> (String,Integer)
toTuple (a:b:[]) = (a,read b)

eqFst (a,b) (c,d) = a==c

--calc :: Array Int (String, Integer) -> Int -> Integer
calc xs memo k
  | k <= 1                = 0
  | fst (xs ! k) == "win" = y
  | True                  = maximum $ (y : map f [1..k-1])
  where
    y = memo (k-1)
    --y = calc xs (k-1)
    f m | fst (xs ! m) == "sell"   = 0
        | snd (xs!m) /= snd (xs!k) = 0
        | m == 1                   = 0
        | True                     = 2 ^ (snd (xs ! m)) + memo (m-1)

memoCalc xs n = memoise (calc xs) (1,n)

main = do
    n <- readLn :: IO Int
    xs' <- replicateM n $ (toTuple . words) `liftM` getLine
    let xs = listArray (1,n) xs'

    print $ memoCalc xs n n

tryX :: Int -> [(String, Int)] -> Integer
tryX (-1) _ = 0
tryX x events = let sells = [j | (j, ("sell", y)) <- eventsWithIds, y == x] in
                    if null sells then tryX (x - 1) events
                    else let j = head sells; wins = [i | (i, ("win", y)) <- take j eventsWithIds, y == x] in
                         if null wins then tryX (x - 1) events
                         else let i = last wins in
                              2 ^ x + tryX (x - 1) (take i events ++ drop (j + 1) events)
                where eventsWithIds = zip [0..] events

solve :: [(String, Int)] -> Integer
solve events = tryX 2000 events

main = do
    contents <- getContents
    let n = read $ head $ lines contents
    let events = map (\s -> let [t, x] = words s in (t, read x)) $ take n $ tail $ lines contents
    putStrLn $ show $ solve events

tryX :: Int -> [(String, Int)] -> Integer
tryX (-1) _ = 0
tryX x events = let sells = [j | (j, ("sell", y)) <- eventsWithIds, y == x] in
                    if null sells then tryX (x - 1) events
                    else let j = head sells; wins = [i | (i, ("win", y)) <- take j eventsWithIds, y == x] in
                         if null wins then tryX (x - 1) events
                         else let i = last wins in
                              2 ^ x + tryX (x - 1) (take i events ++ drop (j + 1) events)
                where eventsWithIds = zip [0..] events

solve :: [(String, Int)] -> Integer
solve events = tryX 2000 events

main = do
    contents <- getContents
    let events = map (\s -> let [t, x] = words s in (t, read x)) $ tail $ lines contents
    putStrLn $ show $ solve events


ZS the Coder is coding on a crazy computer. If you don't type in a word for a c consecutive seconds, everything you typed disappear! More formally, if you typed a word at second a and then the next word at second b, then if b - a ≤ c, just the new word is appended to other words on the screen. If b - a > c, then everything on the screen disappears and after that the word you have typed appears on the screen.For example, if c = 5 and you typed words at seconds 1, 3, 8, 14, 19, 20 then at the second 8 there will be 3 words on the screen. After that, everything disappears at the second 13 because nothing was typed. At the seconds 14 and 19 another two words are typed, and finally, at the second 20, one more word is typed, and a total of 3 words remain on the screen.You're given the times when ZS the Coder typed the words. Determine how many words remain on the screen after he finished typing everything.

The first line contains two integers n and c (1 ≤ n ≤ 100 000, 1 ≤ c ≤ 109) — the number of words ZS the Coder typed and the crazy computer delay respectively. The next line contains n integers t1, t2, ..., tn (1 ≤ t1 < t2 < ... < tn ≤ 109), where ti denotes the second when ZS the Coder typed the i-th word.

Print a single positive integer, the number of words that remain on the screen after all n words was typed, in other words, at the second tn.

NoteThe first sample is already explained in the problem statement.For the second sample, after typing the first word at the second 1, it disappears because the next word is typed at the second 3 and 3 - 1 > 1. Similarly, only 1 word will remain at the second 9. Then, a word is typed at the second 10, so there will be two words on the screen, as the old word won't disappear because 10 - 9 ≤ 1.

import Data.Array as A
main = do
    cin <- getContents
    let n:c:a = map read (words cin) :: [Int]
    let b = A.listArray (1, n) a
    let f r i = if b A.! i - b A.! (i-1) > c then 0 else r + 1
    print $ 1 + foldl f 0 [2..n]

process :: Int -> (Int, Int) -> Int -> (Int, Int)
process timeDiff prev curTime =
  let
    prevCnt = fst prev
    prevTime = snd prev
  in if curTime - prevTime <= timeDiff
    then (prevCnt + 1, curTime)
    else (1, curTime)

main :: IO ()
main = do
  s1 <- getLine
  let [n, c] = map read $ words s1
  s2 <- getLine
  let vals = map read $ words s2
  let r = foldl (process c) (0, 0) vals
  putStrLn (show (fst r))

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, c] <- getInts
  ts <- getInts

  print $ (length $ takeWhile id $ reverse $ zipWith (\x y -> y <= x+c) ts (tail ts)) + 1

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  [n, c] <- map read . words <$> getLine
  ts <- map read . words <$> getLine

  print $ (length $ takeWhile id $ reverse $ zipWith (\x y -> y <= x+c) ts (tail ts)) + 1

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = (solve.tail.concat =<< forM [1 .. 2] ( \i -> map (fst.fromJust.C.readInt).C.words <$> C.getLine))
solve (x:xs) = print $ fst $ foldl (\(b1,b2) a-> if a-b2<=x then (b1+1,a) else (1,a)) (0,0) xs

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

main = do
  [a,b]<-map read <$> words <$> getLine ::IO [Int]
  m<-map read <$> words <$> getLine ::IO [Int]
  print $ (+1) $ length $ takeWhile (<=b) $ reverse $ zipWith (-) (tail m) m

main = interact $ show . solve . map read . tail . words
solve (c:ts) = go 0 0 ts where
  go i p (t:ts) | t-p > c = go 1 t ts
                | otherwise = go (i+1) t ts
  go i _ _ = i

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

solve cnt (c:[_]) = cnt + 1
solve cnt (c:t0:t1:ts) = if t1 - t0 <= c
                     then solve (cnt + 1) (c:t1:ts)
                     else solve 0 (c:t1:ts)

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

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

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

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

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  solve :: Int -> Int -> [Int] -> Int
  solve k c (x:y:xs)
    | y - x <= k = solve k (c + 1) (y:xs)
    | otherwise = solve k 1 (y:xs)
  solve _ c (y:xs) = c
  solve _ c [] = c

  main :: IO()
  main = do
    [n, k] <- getLine >>= return . map readInt . words
    xs <- getLine >>= return . map readInt . words
    print $ solve k 1 $ sort xs

module Main where
import Data.List
parseLine line =
    map (\numStr -> read numStr :: Int) $ words line

calculateElapsedSeconds array =
    zipWith (\a b -> a - b) (drop 1 array ++ [last array]) array

solve wordCount maxSeconds array =
    case findIndex (\et -> et > maxSeconds) $ reverse $ calculateElapsedSeconds array of
        Just result -> result
        Nothing -> wordCount

main =
    do
        firstLine <- getLine
        secondLine <- getLine
        let firstLineParsed = parseLine firstLine
        let seconds = parseLine secondLine
        putStrLn $ show $ solve (firstLineParsed!!0) (firstLineParsed!!1) seconds

main = do
    [n,c] <- return . map read . words =<< getLine
    times <- return . map read . words =<< getLine
    let revTm = map negate . reverse $ times
	pass = takeWhile (<=c) . tail $ adjaDiffs revTm
    print $ 1+length pass

adjaDiffs::Num n => [n] -> [n]
adjaDiffs list = zipWith (-) list $ 0:list

import Data.Functor

sol :: Int -> [Int] -> Int
sol c (t1:t2:ts)
  | t1 - t2 > c = 1
  | otherwise   = 1 + sol c (t2:ts)
sol _ (t:[]) = 1

main = do
  c <- (read . head . tail . words) <$> getLine
  ts <- (reverse . fmap read . words) <$> getLine
  putStrLn $ show $ sol c ts

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

process [a,b,c,d] | mod  (b-a) (c+d)>0 = -1
                  | otherwise = div (b-a) (c+d)

main::IO ()
main=do
  	[t,s]<- map read<$>words <$> getLine ::IO [Int]
	a<-  map read<$> words <$>getLine::IO [Int]
	let b = length $ takeWhile (<=s)$ reverse $ zipWith (\x y ->y-x) a (tail a)
	print $ b+1

merge res1 res2 x y len c = if res2 == len && x + c >= y
                          then len + res1
                          else res2
pre_merge c pair = merge (solve c (fst pair)) (solve c (snd pair)) (last (fst pair)) (head (snd pair)) (length (snd pair)) c
solve c t = if length t == 1
               then 1
               else pre_merge c (splitAt (quot (length t) 2) t)
parse str1 str2 = solve (read ((words str1) !! 1) :: Int) ([read x :: Int | x <- (words str2)])
main = do
  line1 <- getLine
  line2 <- getLine
  print (parse line1 line2)

process :: Int -> [Int] -> Int
process c xs = (+1) . length . takeWhile (<=c) $ zipWith (-) xs' (tail xs')
    where xs' = reverse xs

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    line <- getLine
    let [n,c] = map readInt (words line)
    xs <- fmap (map readInt.words) getLine
    print $ process c xs

main :: IO ()
main = do
        _:c:xs <- getReadAll
        print $ solve c xs

solve :: Int -> [Int] -> Int
solve delay = fst . foldl (transition delay) (0, 0)

transition :: Int -> (Int, Int) -> Int -> (Int, Int)
transition delay (oldCount, lastTs)  newTs = (newCount, newTs)
    where newCount = if newTs - lastTs > delay then 1 else oldCount + 1

getReadAll :: (Read a) => IO [a]
getReadAll = fmap (fmap read. words) getContents

solve :: Int -> Int -> Int -> [Int] -> Int
solve n _ _ [] = n
solve n c t (x:xs)
    | x - t <= c = solve (n + 1) c x xs
    | otherwise = solve 1 c x xs

main :: IO ()
main = do
    line <- getLine
    let [n, c] = map read $ words line :: [Int]
    line <- getLine
    let ts = map read $ words line :: [Int]
    print $ solve 0 c 0 ts

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  [n, c] <- map read . words <$> getLine
  ts <- map read . words <$> getLine

  let rs = map length $ filter (id . head) $ group $ zipWith (\x y -> y <= x+c) ts (tail ts)

  print $ if null rs then 1 else maximum rs + 1

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  [n, c] <- map read . words <$> getLine
  ts <- map read . words <$> getLine

  let rs = map length $ filter (id . head) $ group $ zipWith (\x y -> y <= x+c) ts (tail ts)

  print $ if null rs then 1 else last rs + 1

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

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

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

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

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  solve :: Int -> Int -> [Int] -> Int
  solve k c (x:y:xs)
    | y - x <= k = solve k (c + 1) (y:xs)
    | otherwise = solve k 1 (y:xs)
  solve _ c (y:xs) = c
  solve _ c [] = c

  main :: IO()
  main = do
    [n, k] <- getLine >>= return . map readInt . words
    xs <- getLine >>= return . map readInt . words
    print $ solve k 0 xs

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

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

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

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

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  solve :: Int -> Int -> [Int] -> Int
  solve k c (x:y:xs)
    | y - x <= k = solve k (c + 1) (y:xs)
    | otherwise = solve k 1 (y:xs)
  solve _ c (y:xs) = c
  solve _ c [] = c

  main :: IO()
  main = do
    [n, k] <- getLine >>= return . map readInt . words
    xs <- getLine >>= return . map readInt . words
    print $ solve k 0 $ sort xs

module Main where
import Data.List
parseLine line =
    map (\numStr -> read numStr :: Integer) $ words line

calculateElapsedSeconds array =
    zipWith (\a b -> a - b) (drop 1 array ++ [last array]) array

solve maxSeconds array =
    case findIndex (\et -> et > 5) $ reverse (calculateElapsedSeconds array) of
        Just result -> result
        Nothing -> -1

main =
    do
        firstLine <- getLine
        secondLine <- getLine
        let firstLineParsed = parseLine firstLine
        let seconds = parseLine secondLine
        putStrLn $ show $ solve (firstLineParsed!!1) seconds

module Main where
import Data.List
parseLine line =
    map (\numStr -> read numStr :: Integer) $ words line

calculateElapsedSeconds array =
    zipWith (\a b -> a - b) (drop 1 array ++ [last array]) array

solve maxSeconds array =
    case findIndex (\et -> et > maxSeconds) $ reverse elapsedSeconds of
        Just result -> result
        Nothing -> 1
    where
        elapsedSeconds = calculateElapsedSeconds array

main =
    do
        firstLine <- getLine
        secondLine <- getLine
        let firstLineParsed = parseLine firstLine
        let seconds = parseLine secondLine
        putStrLn $ show $ solve (firstLineParsed!!1) seconds

module Main where
import Data.List
parseLine line =
    map (\numStr -> read numStr :: Integer) $ words line

calculateElapsedSeconds array =
    zipWith (\a b -> a - b) (drop 1 array ++ [last array]) array

solve maxSeconds array =
    case findIndex (\et -> et > maxSeconds) $ reverse elapsedSeconds of
        Just result -> result
        Nothing -> -1
    where
        elapsedSeconds = calculateElapsedSeconds array

main =
    do
        firstLine <- getLine
        secondLine <- getLine
        let firstLineParsed = parseLine firstLine
        let seconds = parseLine secondLine
        putStrLn $ show $ solve (firstLineParsed!!1) seconds

solve c t = sum [1 | x <- t, (x + c) >= (last t)]
parse str1 str2 = solve (read ((words str1) !! 1) :: Int) ([read x :: Int | x <- (words str2)])
main = do
  line1 <- getLine
  line2 <- getLine
  print (parse line1 line2)

solve :: Int -> Int -> Int -> [Int] -> Int
solve n _ _ [] = n
solve n c t (x:xs)
    | x - t <= c = solve (n + 1) c x xs
    | otherwise = solve 1 c x xs

main :: IO ()
main = do
    line <- getLine
    let [n, c] = map read $ words line :: [Int]
    line <- getLine
    let ts = map read $ words line :: [Int]
    print $ solve n c (head ts) ts


You are given an array $$$a_1, a_2, \ldots, a_n$$$ consisting of $$$n$$$ positive integers and a positive integer $$$m$$$.You should divide elements of this array into some arrays. You can order the elements in the new arrays as you want.Let's call an array $$$m$$$-divisible if for each two adjacent numbers in the array (two numbers on the positions $$$i$$$ and $$$i+1$$$ are called adjacent for each $$$i$$$) their sum is divisible by $$$m$$$. An array of one element is $$$m$$$-divisible.Find the smallest number of $$$m$$$-divisible arrays that $$$a_1, a_2, \ldots, a_n$$$ is possible to divide into.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 1000)$$$  — the number of test cases. The first line of each test case contains two integers $$$n$$$, $$$m$$$ $$$(1 \le n \le 10^5, 1 \le m \le 10^5)$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ $$$(1 \le a_i \le 10^9)$$$. It is guaranteed that the sum of $$$n$$$ and the sum of $$$m$$$ over all test cases do not exceed $$$10^5$$$.

For each test case print the answer to the problem.

NoteIn the first test case we can divide the elements as follows:  $$$[4, 8]$$$. It is a $$$4$$$-divisible array because $$$4+8$$$ is divisible by $$$4$$$.  $$$[2, 6, 2]$$$. It is a $$$4$$$-divisible array because $$$2+6$$$ and $$$6+2$$$ are divisible by $$$4$$$.  $$$[9]$$$. It is a $$$4$$$-divisible array because it consists of one element.

import Control.Monad
import Data.List
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapS

main = do
    t <- readLn
    replicateM t testcase

testcase :: IO ()
testcase = do
    firstLine <- getLine
    let [_,m] = map read . words $ firstLine
    a <- fmap (map read . words) getLine
    putStrLn $ solve a m

solve :: [Int] -> Int -> String
solve a m =
    if MapS.member 0 counts then
        show $ solution + 1
    else show solution
    where
        modded = map (`mod` m) a
        counts = foldl' (\acc curr -> MapS.insertWith (+) curr 1 acc) MapS.empty modded :: Map.Map Int Int
        mapFoldF :: Int -> Int -> Int -> Int
        mapFoldF k a b
            | k == 0 = b
            | MapS.member (m-k) counts && k < m-k = b
            | otherwise = (b+) . (1+) . max 0 . (subtract 1) . abs . (a-) $ MapS.findWithDefault 0 (m-k `mod` m) counts
        solution = MapS.foldrWithKey mapFoldF 0 counts :: Int

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Char
import Data.List (sort, group)
import Data.Map ((!))
import qualified Data.Map  as M
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace
import System.IO
import Text.Read
import Data.Maybe (fromJust)

getNums :: IO [Int]
getNums = do
  line <- B.getLine
  return $ map ((fst . fromJust) . B.readInt) . B.split ' ' $ line

main :: IO ()
main = do
  t <- readLn :: IO Integer
  forM_ [1 .. t] handleCase

handleCase :: Integer -> IO ()
handleCase c = do
  [n, m] <- getNums
  as <- getNums
  print $ solve m as

solve m as = sum solves
  where
    ams = map (`mod` m) as
    sizes = M.fromList $ map (\xs -> (head xs, length xs)) $ group $ sort ams

    solveForSize i
      | i == 0 = 1
      | i < i' && M.member i' sizes = 0
      | otherwise = max 1 $ abs (curSize - compSize)
      where
        i' = m - i
        curSize = sizes ! i
        compSize = M.findWithDefault 0 i' sizes

    solves = map solveForSize $ M.keys sizes

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

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

import Data.Array.Unboxed

solve :: Int -> [Int] -> Int
solve m li = let
  buckets :: UArray Int Int
  buckets = accumArray (const . (+ 1)) 0 (0, m-1) $ zip (map (`mod` m) li) li
  in  foldl' (+) 0 $ do --'
  (v, ct) <- assocs buckets
  let
    sv = mod (negate v) m
    sct = buckets ! sv
  guard $ (ct, v) >= (sct, sv)
  pure $ if  ct == 0
    then  0
    else  max 1 (ct - sct)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, m] <- readInts
    a <- readInts
    putInts [solve m a]

type SIO = StateT P.ByteString IO

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

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

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

import Control.Monad
import Data.List
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapS

main = do
    t <- readLn
    replicateM t testcase

testcase :: IO ()
testcase = do
    firstLine <- getLine
    let [_,m] = map read . words $ firstLine
    a <- fmap (map read . words) getLine
    putStrLn $ solve a m

solve :: [Int] -> Int -> String
solve a m =
    if MapS.member 0 counts then
        show $ solution + 1
    else show solution
    where
        modded = map (`mod` m) a
        counts = foldl' (\acc curr -> MapS.insertWith (+) curr 1 acc) MapS.empty modded :: Map.Map Int Int
        mapFoldF :: Int -> Int -> Int -> Int
        mapFoldF k a b
            | k == 0 = b
            | MapS.member (m-k) counts && k < m `div` 2 = b
            | otherwise = (b+) . (1+) . max 0 . (subtract 1) . abs . (a-) $ MapS.findWithDefault 0 (m-k `mod` m) counts
        solution = MapS.foldrWithKey mapFoldF 0 counts :: Int


You are given two arrays $$$a$$$ and $$$b$$$ both consisting of $$$n$$$ positive (greater than zero) integers. You are also given an integer $$$k$$$.In one move, you can choose two indices $$$i$$$ and $$$j$$$ ($$$1 \le i, j \le n$$$) and swap $$$a_i$$$ and $$$b_j$$$ (i.e. $$$a_i$$$ becomes $$$b_j$$$ and vice versa). Note that $$$i$$$ and $$$j$$$ can be equal or different (in particular, swap $$$a_2$$$ with $$$b_2$$$ or swap $$$a_3$$$ and $$$b_9$$$ both are acceptable moves).Your task is to find the maximum possible sum you can obtain in the array $$$a$$$ if you can do no more than (i.e. at most) $$$k$$$ such moves (swaps).You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 200$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 30; 0 \le k \le n$$$) — the number of elements in $$$a$$$ and $$$b$$$ and the maximum number of moves you can do. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 30$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. The third line of the test case contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$1 \le b_i \le 30$$$), where $$$b_i$$$ is the $$$i$$$-th element of $$$b$$$.

For each test case, print the answer — the maximum possible sum you can obtain in the array $$$a$$$ if you can do no more than (i.e. at most) $$$k$$$ swaps.

NoteIn the first test case of the example, you can swap $$$a_1 = 1$$$ and $$$b_2 = 4$$$, so $$$a=[4, 2]$$$ and $$$b=[3, 1]$$$.In the second test case of the example, you don't need to swap anything.In the third test case of the example, you can swap $$$a_1 = 1$$$ and $$$b_1 = 10$$$, $$$a_3 = 3$$$ and $$$b_3 = 10$$$ and $$$a_2 = 2$$$ and $$$b_4 = 10$$$, so $$$a=[10, 10, 10, 4, 5]$$$ and $$$b=[1, 9, 3, 2, 9]$$$.In the fourth test case of the example, you cannot swap anything.In the fifth test case of the example, you can swap arrays $$$a$$$ and $$$b$$$, so $$$a=[4, 4, 5, 4]$$$ and $$$b=[1, 2, 2, 1]$$$.

{-# LANGUAGE LambdaCase #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.List

main = interact $
  runScanner (numberOf tc) >>> map (solve >>> show) >>> unlines

tc :: Scanner (Int, [[Int]])
tc = do
  n <- int
  (,) <$> int <*> two (replicateM n int)

solve :: (Int, [[Int]]) -> Int
solve (k, [as, bs]) = sum $ zipWith max (sort as) (take k (reverse (sort bs)) ++ repeat 0)

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

type Scanner = State [String]

runScanner :: Scanner a -> String -> a
runScanner = runScannerWith words

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

str :: Scanner String
str = get >>= \case { s:ss -> put ss >> return s }

int :: Scanner Int
int = read <$> str

integer :: Scanner Integer
integer = read <$> str

double :: Scanner Double
double = read <$> str

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

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

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

import Control.Monad.State
import Control.Monad
import Data.List

fmapfst :: (a -> c) -> (a,b) -> (c,b)
fmapfst f (a,b) = (f a, b)

alg ::  Int -> State ([Int],[Int]) ()
alg n= do
  forM_ [1..n] (\_ -> do
    a' <- fmap (minimum . fst) get
    b' <- fmap (maximum . snd) get
    modify (fmapfst ((b':) . delete a'))
    modify (fmap ((a':) . delete b'))
     )

finAlg_ :: [Int] -> [Int] -> Int -> Int
finAlg_ a b n = sum $ fst $ execState (alg n) (a,b)

finAlg :: [Int] -> [Int] -> Int -> Int
finAlg a b n = maximum $ map (finAlg_ a b)[0..n]

getOnes :: IO ([Int],[Int],Int)
getOnes = do
  (_:n:_) <- fmap ( map read .words) getLine
  a <- fmap ( map read .words) getLine
  b <- fmap ( map read .words) getLine
  return (a,b,n)

main :: IO()
main = do
  x <- fmap read getLine
  ls <- replicateM x getOnes
  mapM_ (print . (\(a,b,n) -> finAlg a b n)) ls

import Control.Monad
import Data.List
import Data.Ord

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

routine :: IO ()
routine = do
    [_,k]<- (map read.words) <$> getLine
    as <- (map read.words) <$> getLine
    bs <- (map read.words) <$> getLine
    print $ solve k as bs

solve :: Int -> [Int] -> [Int] -> Int
solve k as bs = sum $ (drop k ass) ++ (take k $ sortOn Down c)
  where
    ass = sort as
    bss = sortOn Down bs
    c = take k ass ++ take k bss

module Main where
import Data.List

solve [] = []
solve ([_,n] : xs : ys : zss) = (show $ sum $ solve' xs ys ) : solve zss
	where
		solve' xs ys = zipWith max (take n (reverse $ sort ys)) (take n (sort xs))  ++ drop n (sort xs)

main = interact $ unlines . solve . map (map (read :: String -> Int) . words)   . tail . lines

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

onecase = do
		[n,k]<- map read <$> words <$> getLine::IO [Int]
		a<- sort <$> map read <$> words <$> getLine::IO [Int]
		b<- reverse<$> sort <$> map read <$> words <$> getLine::IO [Int]
		let c = sum $ map (\(a,b)-> b-a) $ take k $takeWhile (\(x,y)->y>=x) $ zip a b
		print $ c+ sum a
main = do
	n<- read <$> getLine ::IO Int
	replicateM_ n onecase

import Data.Map as M
import Data.List as L

fun :: [Integer] -> [Integer] -> Integer -> Integer
fun as _  0 = sum as
fun as bs k = if a < b then (b + fun as' bs' (k-1)) else sum as
  where (a:as') = L.sort as
        (b:bs') = reverse $ L.sort bs

partitionBy :: [String] -> [[String]]
partitionBy [] = []
partitionBy (a:b:c:xs) = [[a, b, c]] ++ (partitionBy xs)

solve' :: String -> String -> String -> String
solve' k' as' bs' = show $ fun as bs k
  where k  = head $ tail $ L.map (\x -> read x :: Integer) $ words k'
        as = L.map (\x -> read x :: Integer) $ words as'
        bs = L.map (\x -> read x :: Integer) $ words bs'

solve :: String -> String
solve input = unlines $ [solve' a b c | [a, b, c] <- partitionBy lines']
  where lines' = tail $ lines input

main :: IO()
main = do
  contents <- getContents
  putStr (solve contents)

import Control.Monad.State
import Control.Monad
import Data.List

fmapfst :: (a -> c) -> (a,b) -> (c,b)
fmapfst f (a,b) = (f a, b)

alg ::  Int -> State ([Int],[Int]) ()
alg n= do
  forM_ [1..n] (\_ -> do
    a' <- fmap (minimum . fst) get
    b' <- fmap (maximum . snd) get
    modify (fmapfst ((b':) . delete a'))
    modify (fmap ((a':) . delete b'))
     )

finAlg :: [Int] -> [Int] -> Int -> Int
finAlg a b n = sum $ fst $ execState (alg n) (a,b)

getOnes :: IO ([Int],[Int],Int)
getOnes = do
  (_:n:_) <- fmap ( map read .words) getLine
  a <- fmap ( map read .words) getLine
  b <- fmap ( map read .words) getLine
  return (a,b,n)

main :: IO()
main = do
  x <- fmap read getLine
  ls <- replicateM x getOnes
  mapM_ (print . (\(a,b,n) -> finAlg a b n)) ls

module Main where
import Data.List

solve [] = []
solve ([_,n] : xs : ys : zss) = (show $ sum $ solve' xs ys ) : solve zss
	where
		solve' xs ys = take n (reverse $ sort ys) ++ drop n (sort xs)

main = interact $ unlines . solve . map (map (read :: String -> Int) . words)   . tail . lines

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

onecase = do
		[n,k]<- map read <$> words <$> getLine::IO [Int]
		a<- sort <$> map read <$> words <$> getLine::IO [Int]
		b<- reverse<$> sort <$> map read <$> words <$> getLine::IO [Int]
		let c = sum $ map (\(a,b)-> b-a) $ take k $takeWhile (\(x,y)->x>=y) $ zip a b
		print $ c+ sum a
main = do
	n<- read <$> getLine ::IO Int
	replicateM_ n onecase

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

onecase = do
		[n,k]<- map read <$> words <$> getLine::IO [Int]
		a<- sort <$> map read <$> words <$> getLine::IO [Int]
		b<- reverse<$> sort <$> map read <$> words <$> getLine::IO [Int]
		print $ sum a + sum(take k b)- sum (take k a)

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


You are given two very long integers a, b (leading zeroes are allowed). You should check what number a or b is greater or determine that they are equal.The input size is very large so don't use the reading of symbols one by one. Instead of that use the reading of a whole line or token.As input/output can reach huge size it is recommended to use fast input/output methods: for example, prefer to use scanf/printf instead of cin/cout in C++, prefer to use BufferedReader/PrintWriter instead of Scanner/System.out in Java. Don't use the function input() in Python2 instead of it use the function raw_input().

The first line contains a non-negative integer a. The second line contains a non-negative integer b. The numbers a, b may contain leading zeroes. Each of them contains no more than 106 digits.

Print the symbol "<" if a < b and the symbol ">" if a > b. If the numbers are equal print the symbol "=".

import Control.Applicative ((<$>))
import Data.ByteString.Char8 (readInteger, words, unpack, getLine)
import Data.Maybe (fromJust)
import Prelude hiding (words, getLine)

main = do
  a <- fst . fromJust . readInteger <$> getLine :: IO Integer
  b <- fst . fromJust . readInteger <$> getLine :: IO Integer

  putStrLn $ case compare a b of
             LT -> "<"
             EQ -> "="
             GT -> ">"

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

getInteger :: IO Integer
getInteger = fmap (fst . fromJust) $ fmap C.readInteger C.getLine

main = do
    a <- getInteger
    b <- getInteger
    putStrLn $ case a `compare` b of
                 LT -> "<"
                 EQ -> "="
                 GT -> ">"

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

main = B.getContents >>= (B.putStr . B.pack . compare. map (fst . fromJust . B.readInteger) . B.lines)
    where
        myread x = read x :: Integer
        compare (a:b:xc) = fun (a - b)
            where
                fun x   | x == 0 = "="
                        | x < 0 = "<"
                        | otherwise = ">"

compareNumbers :: String -> String -> String
compareNumbers fst snd =
    let fstLength = length fst
        sndLength = length snd
        deltaLength = fstLength - sndLength
        prefix = replicate (abs deltaLength) '0' in
    if deltaLength < 0 then compareNumbers (prefix ++ fst) snd
    else if deltaLength > 0 then compareNumbers fst (prefix ++ snd)
    else case (compare fst snd) of
        LT -> "<"
        EQ -> "="
        GT -> ">"

main :: IO ()
main = do
    fst <- getLine :: IO String
    snd <- getLine :: IO String
    putStrLn (compareNumbers fst snd)

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input = answer
    where
        (aw:bw:xs) = words input
        raw = reverse aw
        rbw = reverse bw

        answer = amap (go raw rbw)

amap 0 = "="
amap 1 = ">"
amap (-1) = "<"

go:: String -> String -> Int

go [] [] = 0
go (ca:xa) [] = if ca /= '0' then
                        1
                    else
                        go xa []
go [] (cb:xb) = if cb /= '0' then
                        -1
                    else
                        go [] xb

go (ca:xa) (cb:xb) =
    if next == 0 then
        if ca == cb then
            next
        else if ca > cb then
            1
        else
            -1
    else
        next

    where
        next = go xa xb

module Main where

import Data.List
import Data.String
import Data.Maybe
import Data.Either
import Control.Monad
import Control.Applicative
import Control.Arrow

foo :: String -> String -> Bool -> String
foo "" "" _ = "="
foo ('0':xs) ys True = foo xs ys True
foo xs ('0':ys) True = foo xs ys True
foo _ "" _ = ">"
foo "" _ _ = "<"
foo a@(x:xs) b@(y:ys) f = if f && length a /= length b
                          then if length a > length b then ">" else "<"
                          else if x == y
                               then foo xs ys False
                               else if x < y then "<" else ">"

main :: IO()
main = do
    s1 <- getLine
    s2 <- getLine
    putStrLn $ foo s1 s2 True

import Data.Char

solve :: [String] -> String

solve xs
    | a > b = ">"
    | a < b = "<"
    | otherwise = "="
    where a = read (head xs) :: Integer
          b = read (last xs) :: Integer

main = interact $ solve . words

import qualified Data.ByteString.Char8 as B
import Control.Applicative

cmp :: B.ByteString -> B.ByteString -> String
cmp str1 str2 = case compare (B.length str1') (B.length str2') of
                  LT -> "<"
                  GT -> ">"
                  EQ -> case compare str1' str2' of
                          LT -> "<"
                          GT -> ">"
                          EQ -> "="
  where [str1', str2'] = map (B.dropWhile (== '0')) [str1, str2]

main :: IO ()
main = cmp <$> B.getLine <*> B.getLine >>= putStrLn

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

main = do
	[a,b] <- replicateM 2 $ fmap (fst . fromJust . B.readInteger) B.getLine
	putStrLn $ case (compare a b) of
		EQ -> "="
		LT -> "<"
		GT -> ">"

import Control.Applicative
import qualified Data.ByteString as BS

main :: IO ()
main = do
  a <- (BS.dropWhile (== 48)) <$> BS.getLine
  b <- (BS.dropWhile (== 48)) <$> BS.getLine

  putStrLn $ case (compare (BS.length a) (BS.length b), compare a b) of
    (LT, _) -> "<"
    (GT, _) -> ">"
    (_, LT) -> "<"
    (_, GT) -> ">"
    _       -> "="

import Control.Applicative

main :: IO ()
main = do
  a <- (dropWhile (== '0')) <$> getLine
  b <- (dropWhile (== '0')) <$> getLine

  putStrLn $ case (compare (length a) (length b), compare a b) of
    (LT, _) -> "<"
    (GT, _) -> ">"
    (_, LT) -> "<"
    (_, GT) -> ">"
    _       -> "="

check :: String -> String -> String
check a b
  | la < lb = "<"
  | la > lb = ">"
  | otherwise = cmpr ca cb
  where
    ca' = dropWhile (=='0') a
    cb' = dropWhile (=='0') b
    ca = if ca' == [] then "0" else ca'
    cb = if cb' == [] then "0" else cb'
    la = length ca
    lb = length cb
    cmpr [] [] = "="
    cmpr (x:xs) (y:ys)
      | x < y = "<"
      | x > y = ">"
      | otherwise = cmpr xs ys

main :: IO ()
main = do
  a <- getLine
  b <- getLine
  putStrLn $ check a b

import Control.Applicative ((<$>))
import Data.ByteString.Char8 (readInt, words, unpack, getLine)
import Data.Maybe (fromJust)
import Prelude hiding (words, getLine)

readInts = map (fst . fromJust . readInt) . words

main = do
  a <- fst . fromJust . readInt <$> getLine
  b <- fst . fromJust . readInt <$> getLine

  putStrLn $ case compare a b of
             LT -> "<"
             EQ -> "="
             GT -> ">"

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input = answer
    where
        (aw:bw:xs) = words input
        raw = reverse aw
        rbw = reverse bw

        go:: String -> String -> Int
        go [] [] = 0
        go (ca:xa) [] = if ca /= '0' then
                                1
                            else
                                go xa []
        go [] (cb:xb) = if cb /= '0' then
                                -1
                            else
                                go [] xb

        go (ca:xa) (cb:xb) =
            if ca == cb then
                go xa xb
            else if ca > cb then
                1
            else
                -1

        answer = case (go raw rbw)
                    of 0 -> "="
                       1 -> ">"
                       -1 -> "<"


It's the year 4527 and the tanks game that we all know and love still exists. There also exists Great Gena's code, written in 2016. The problem this code solves is: given the number of tanks that go into the battle from each country, find their product. If it is turns to be too large, then the servers might have not enough time to assign tanks into teams and the whole game will collapse!There are exactly n distinct countries in the world and the i-th country added ai tanks to the game. As the developers of the game are perfectionists, the number of tanks from each country is beautiful. A beautiful number, according to the developers, is such number that its decimal representation consists only of digits '1' and '0', moreover it contains at most one digit '1'. However, due to complaints from players, some number of tanks of one country was removed from the game, hence the number of tanks of this country may not remain beautiful.Your task is to write the program that solves exactly the same problem in order to verify Gena's code correctness. Just in case.

The first line of the input contains the number of countries n (1 ≤ n ≤ 100 000). The second line contains n non-negative integers ai without leading zeroes — the number of tanks of the i-th country. It is guaranteed that the second line contains at least n - 1 beautiful numbers and the total length of all these number's representations doesn't exceed 100 000.

Print a single number without leading zeroes — the product of the number of tanks presented by each country.

NoteIn sample 1 numbers 10 and 1 are beautiful, number 5 is not not.In sample 2 number 11 is not beautiful (contains two '1's), all others are beautiful.In sample 3 number 3 is not beautiful, all others are beautiful.

main = interact $  solve "" "1" . tail .  words
solve zero fail [] = fail ++ zero
solve _ "0" _ = "0"
solve zero fail ((h:t):xs) = if h == '1' && all (== '0') t then solve (t ++ zero) fail xs else solve zero (h:t) xs

import Data.Functor
import Data.List

getStrings :: IO [String]
getStrings = tail . words <$> getContents

isBeautiful :: String -> Bool
isBeautiful (c:cs) = c == '1' && and [x == '0' | x <- cs]

solve :: [String] -> String
solve ss = if any (== "0") ss then "0" else r
  where
    start = case find (not . isBeautiful) ss of
        Just s -> s
        Nothing -> "1"
    end = replicate (sum [length s - 1 | s <- filter isBeautiful ss]) '0'
    r = start ++ end

main :: IO ()
main = getStrings >>= putStrLn . solve

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

main = B.getLine >> (B.putStr . B.pack .show . product . map (fst. fromJust . B.readInteger) . B.words =<< B.getLine)

import           Control.Applicative
import           Control.Monad
import           Data.List
import qualified Data.ByteString.Char8 as C

-- myShow = show :: Int -> String
main = do
  _ <- C.getLine
  xs <- C.getLine
  print $ solve xs

solve :: C.ByteString -> Integer
solve = product . map ((\(Just x) -> fst x) . C.readInteger) . C.words

module Main where

import Control.Applicative
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    _ <- C.getLine
    xs <- map ((\(Just x) -> fst x) . C.readInteger) . C.words <$> C.getLine
    putStrLn $ show $ product xs

main = interact $  solve "" "" . tail .  words
solve zero fail [] =  fail ++ zero
solve _ "0" _ = "0"
solve zero fail ((h:t):xs) = if h == '1' && all (== '0') t then solve (t ++ zero) fail xs else solve zero (h:t) xs

import Data.Functor
import Data.List

getStrings :: IO [String]
getStrings = tail . words <$> getContents

isBeautiful :: String -> Bool
isBeautiful (c:cs) = c == '1' && and [x == '0' | x <- cs]

solve :: [String] -> String
solve ss = start ++ end
  where
    start = case find (not . isBeautiful) ss of
        Just s -> s
        Nothing -> "1"
    end = replicate (sum [length s - 1 | s <- filter isBeautiful ss]) '0'

main :: IO ()
main = getStrings >>= putStrLn . solve

import Data.Functor

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

main :: IO ()
main = getInts >>= putStrLn . show . product

import Data.Functor
import Data.List

getStrings :: IO [String]
getStrings = tail . words <$> getContents

isBeautiful :: String -> Bool
isBeautiful (c:cs) = c == '1' && and [x == '0' | x <- cs]

solve :: [String] -> String
solve ss = if head r == '0' then "0" else r
  where
    start = case find (not . isBeautiful) ss of
        Just s -> s
        Nothing -> "1"
    end = replicate (sum [length s - 1 | s <- filter isBeautiful ss]) '0'
    r = start ++ end

main :: IO ()
main = getStrings >>= putStrLn . solve

module Main where

import Control.Applicative

main :: IO ()
main = do
    _ <- getLine
    xs <- (map (\s -> read s::Int) . words) <$> getLine
    putStrLn $ show $ foldr (\x acc -> acc * x) 1 xs

module Main where

import Control.Applicative

main :: IO ()
main = do
    _ <- getLine
    xs <- (map (\s -> read s::Int) . words) <$> getLine
    -- putStrLn $ show $ foldr (\x acc -> acc * x) 1 xs
    putStrLn $ show $ product xs


Most C/C++ programmers know about excellent opportunities that preprocessor #define directives give; but many know as well about the problems that can arise because of their careless use.In this problem we consider the following model of #define constructions (also called macros). Each macro has its name and value. The generic syntax for declaring a macro is the following:#define macro_name macro_valueAfter the macro has been declared, "macro_name" is replaced with "macro_value" each time it is met in the program (only the whole tokens can be replaced; i.e. "macro_name" is replaced only when it is surrounded by spaces or other non-alphabetic symbol). A "macro_value" within our model can only be an arithmetic expression consisting of variables, four arithmetic operations, brackets, and also the names of previously declared macros (in this case replacement is performed sequentially). The process of replacing macros with their values is called substitution.One of the main problems arising while using macros — the situation when as a result of substitution we get an arithmetic expression with the changed order of calculation because of different priorities of the operations.Let's consider the following example. Say, we declared such a #define construction:#define sum x + yand further in the program the expression "2 * sum" is calculated. After macro substitution is performed we get "2 * x + y", instead of intuitively expected "2 * (x + y)".Let's call the situation "suspicious", if after the macro substitution the order of calculation changes, falling outside the bounds of some macro. Thus, your task is to find out by the given set of #define definitions and the given expression if this expression is suspicious or not.Let's speak more formally. We should perform an ordinary macros substitution in the given expression. Moreover, we should perform a "safe" macros substitution in the expression, putting in brackets each macro value; after this, guided by arithmetic rules of brackets expansion, we can omit some of the brackets. If there exist a way to get an expression, absolutely coinciding with the expression that is the result of an ordinary substitution (character-by-character, but ignoring spaces), then this expression and the macros system are called correct, otherwise — suspicious.Note that we consider the "/" operation as the usual mathematical division, not the integer division like in C/C++. That's why, for example, in the expression "a*(b/c)" we can omit brackets to get the expression "a*b/c".

The first line contains the only number n (0 ≤ n ≤ 100) — the amount of #define constructions in the given program. Then there follow n lines, each of them contains just one #define construction. Each construction has the following syntax: #define name expression where   name — the macro name,  expression — the expression with which the given macro will be replaced. An expression is a non-empty string, containing digits,names of variables, names of previously declared macros, round brackets and operational signs +-*/. It is guaranteed that the expression (before and after macros substitution) is a correct arithmetic expression, having no unary operations. The expression contains only non-negative integers, not exceeding 109.  All the names (#define constructions' names and names of their arguments) are strings of case-sensitive Latin characters. It is guaranteed that the name of any variable is different from any #define construction. Then, the last line contains an expression that you are to check. This expression is non-empty and satisfies the same limitations as the expressions in #define constructions. The input lines may contain any number of spaces anywhere, providing these spaces do not break the word "define" or the names of constructions and variables. In particular, there can be any number of spaces before and after the "#" symbol. The length of any line from the input file does not exceed 100 characters.

Output "OK", if the expression is correct according to the above given criterion, otherwise output "Suspicious".

4
#define sum  x + y
#define mul  a * b
#define div  a / b
#define expr sum + mul * div * mul
expr

3
#define SumSafe   (a+b)
#define DivUnsafe  a/b
#define DenominatorUnsafe  a*b
((SumSafe) + DivUnsafe/DivUnsafe + x/DenominatorUnsafe)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (replicateM)
import Control.Applicative (liftA2)
import Data.List (foldl')
import Data.Char (isSpace, isAlpha, isDigit )
import Data.Maybe (fromMaybe)
import Data.Functor ((<&>))

import qualified Data.Map.Strict as M

import qualified Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadP ((<++))

main :: IO ()
main = do
  n <- read <$> getLine
  res <- liftA2 solve (replicateM n getLine) getLine
  putStrLn $ if res == Suspicious then "Suspicious" else "OK"

solve :: [String] -> String -> Priority
solve macros = balanceExp mb
  where
    balanceExp mb = balance mb . parseExpr
    macroDefs = map splitName macros
    mb = foldl' (\acc (name, expr) -> M.insert name (balanceExp acc expr) acc) M.empty macroDefs

balance :: M.Map String Priority -> Expr -> Priority
balance _ ConstNum = Atom
balance mb (Paren p) = if balance mb p == Suspicious then Suspicious else Atom
balance mb (Var x) = fromMaybe Atom $ M.lookup x mb
balance mb (Op op es) = case op of
    '+' -> minP App
    '-' -> condP App
    '*' -> minP Mul
    '/' -> condP Mul
  where
    bs@(bh:bt) = map (balance mb) es
    minP p = if any (< p) bs then Suspicious else p
    condP p = if bh < p || any (<= p) bt then Suspicious else p

data Expr = ConstNum
          | Var String
          | Paren Expr
          | Op Char [Expr]
          deriving (Show)

parseExpr :: String -> Expr
parseExpr input = case parseExpr' input of
  [(parsed, _)] -> parsed

parseExpr' :: String -> [(Expr, String)]
parseExpr' = P.readP_to_S (exprP <* P.eof) . filter (not . isSpace)
  where
    exprP = foldl' opP factorP "/*-+"
    opP p op = P.sepBy1 p (P.char op) <&> \case
      [e] -> e
      exs -> Op op exs
    factorP = parenP <++ constP <++ varP
    varP = Var <$> P.munch1 isAlpha
    constP = ConstNum <$ P.munch1 isDigit
    parenP = Paren <$> P.between (P.char '(') (P.char ')') exprP

data Priority = Suspicious | App | Mul | Atom deriving (Ord, Eq, Show)

splitName :: String -> (String, String)
splitName = head . P.readP_to_S macroNameP
  where
    skipDefine = P.skipSpaces >> P.char '#' >> P.skipSpaces >> P.string "define"
    macroNameP = skipDefine >> P.skipSpaces >> P.munch1 (not . isSpace)

module Main where

import Control.Monad (replicateM)
import Control.Applicative (liftA2, liftA3, (<|>))
import Data.List (foldl')
import Data.Char (isSpace, isAlpha, isDigit )
import Data.Maybe (fromMaybe)

import qualified Data.Map.Strict as M

import qualified Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadP ((<++))

main :: IO ()
main = do
  n <- read <$> getLine
  res <- liftA2 solve (replicateM n getLine) getLine
  putStrLn $ if res == Suspicious then "Suspicious" else "OK"

solve :: [String] -> String -> Priority
solve macros = balanceExp mb
  where
    balanceExp mb = balance mb . parseExpr
    macroDefs = map splitName macros
    mb = foldl' (\acc (name, expr) -> M.insert name (balanceExp acc expr) acc) M.empty macroDefs

balance :: M.Map String Priority -> Expr -> Priority
balance _ ConstNum = P3
balance mb (Paren p) = if balance mb p == Suspicious then Suspicious else P3
balance mb (Var x) = fromMaybe P3 $ M.lookup x mb
balance mb (Op op l r)
  | op == '-' && rb < P2 = Suspicious
  | op == '/' && rb < P3 = Suspicious
  | op == '/' || op == '*' = minP P2
  | op == '-' || op == '+' = minP P1
  where
    lb = balance mb l
    rb = balance mb r
    minP p =  if lb < p || rb < p then Suspicious else p

data Expr = ConstNum
          | Var String
          | Paren Expr
          | Op Char Expr Expr
          deriving (Show)

parseExpr :: String -> Expr
parseExpr input = parsed
  where
    exprP = addsubP <++ termP
    termP = muldivP <++ factorP
    factorP = parenP <++ constP <++ varP
    addsubP = liftA3 (flip Op) termP (P.char '+' <|> P.char '-') exprP
    muldivP = liftA3 (flip Op) factorP (P.char '*' <|> P.char '/') exprP
    varP = Var <$> P.munch1 isAlpha
    constP = ConstNum <$ P.munch1 isDigit
    parenP = Paren <$> P.between (P.char '(') (P.char ')') exprP
    [(parsed, "")] = P.readP_to_S exprP $ filter (not . isSpace) input

data Priority = Suspicious | P1 | P2 | P3 deriving (Ord, Eq, Show)

splitName :: String -> (String, String)
splitName = head . P.readP_to_S macroNameP
  where
    skipDefine = P.skipSpaces >> P.char '#' >> P.skipSpaces >> P.string "define"
    macroNameP = skipDefine >> P.skipSpaces >> P.munch1 (not . isSpace)

module Main where

import Control.Monad (replicateM)
import Control.Applicative (liftA2, liftA3, (<|>))
import Data.List (foldl')
import Data.Char (isSpace, isAlpha, isDigit )
import Data.Maybe (fromMaybe)

import qualified Data.Map.Strict as M

import qualified Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadP ((<++))

main :: IO ()
main = do
  n <- read <$> getLine
  res <- liftA2 solve (replicateM n getLine) getLine
  putStrLn $ if res == Suspicious then "Suspicious" else "OK"

solve :: [String] -> String -> Priority
solve macros = balanceExp mb
  where
    balanceExp mb = balance mb . parseExpr
    macroDefs = map splitName macros
    mb = foldl' (\acc (name, expr) -> M.insert name (balanceExp acc expr) acc) M.empty macroDefs

balance :: M.Map String Priority -> Expr -> Priority
balance _ ConstNum = P3
balance mb (Paren p) = if balance mb p == Suspicious then Suspicious else P3
balance mb (Var x) = fromMaybe P3 $ M.lookup x mb
balance mb (Op op l r)
  | op == '-' && rb < P2 = Suspicious
  | op == '/' && rb < P3 = Suspicious
  | op == '/' || op == '*' = minP P2
  | op == '-' || op == '+' = minP P1
  where
    lb = balance mb l
    rb = balance mb r
    minP p =  if lb < p || rb < p then Suspicious else p

data Expr = ConstNum
          | Var String
          | Paren Expr
          | Op Char Expr Expr
          deriving (Show)

parseExpr :: String -> Expr
parseExpr input = parsed
  where
    [(parsed, "")] = parseExpr' input

parseExpr' :: String -> [(Expr, String)]
parseExpr' = P.readP_to_S exprP . filter (not . isSpace)
  where
    exprP = addsubP <++ termP
    termP = muldivP <++ factorP
    factorP = parenP <++ constP <++ varP
    addsubP = liftA3 (flip Op) termP (P.char '+' <|> P.char '-') exprP
    muldivP = liftA3 (flip Op) factorP (P.char '*' <|> P.char '/') termP
    varP = Var <$> P.munch1 isAlpha
    constP = ConstNum <$ P.munch1 isDigit
    parenP = Paren <$> P.between (P.char '(') (P.char ')') exprP

data Priority = Suspicious | P1 | P2 | P3 deriving (Ord, Eq, Show)

splitName :: String -> (String, String)
splitName = head . P.readP_to_S macroNameP
  where
    skipDefine = P.skipSpaces >> P.char '#' >> P.skipSpaces >> P.string "define"
    macroNameP = skipDefine >> P.skipSpaces >> P.munch1 (not . isSpace)

module Main where

import Control.Monad (replicateM)
import Control.Applicative (liftA2, liftA3, (<|>))
import Data.List (foldl')
import Data.Char (isSpace, isAlpha, isDigit )
import Data.Maybe (fromMaybe)

import qualified Data.Map.Strict as M

import qualified Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadP ((<++))

main :: IO ()
main = do
  n <- read <$> getLine
  res <- liftA2 solve (replicateM n getLine) getLine
  putStrLn $ if res == Suspicious then "Suspicious" else "OK"

solve :: [String] -> String -> Priority
solve macros = balanceExp mb
  where
    balanceExp mb = balance mb . parseExpr
    macroDefs = map splitName macros
    mb = foldl' (\acc (name, expr) -> M.insert name (balanceExp acc expr) acc) M.empty macroDefs

balance :: M.Map String Priority -> Expr -> Priority
balance _ ConstNum = P3
balance mb (Paren p) = if balance mb p == Suspicious then Suspicious else P3
balance mb (Var x) = fromMaybe P3 $ M.lookup x mb
balance mb (Op op l r)
  -- | op == '-' && rb < P2 = Suspicious
  -- | op == '/' && rb < P3 = Suspicious
  | op == '/' || op == '*' = minP P2
  | op == '-' || op == '+' = minP P1
  where
    lb = balance mb l
    rb = balance mb r
    minP p =  if lb < p || rb < p then Suspicious else p

data Expr = ConstNum
          | Var String
          | Paren Expr
          | Op Char Expr Expr
          deriving (Show)

parseExpr :: String -> Expr
parseExpr input = parsed
  where
    exprP = addsubP <++ termP
    termP = muldivP <++ factorP
    factorP = parenP <++ constP <++ varP
    addsubP = liftA3 (flip Op) termP (P.char '+' <|> P.char '-') exprP
    muldivP = liftA3 (flip Op) factorP (P.char '*' <|> P.char '/') exprP
    varP = Var <$> P.munch1 isAlpha
    constP = ConstNum <$ P.munch1 isDigit
    parenP = Paren <$> P.between (P.char '(') (P.char ')') exprP
    [(parsed, "")] = P.readP_to_S exprP $ filter (not . isSpace) input

data Priority = Suspicious | P1 | P2 | P3 deriving (Ord, Eq, Show)

splitName :: String -> (String, String)
splitName = head . P.readP_to_S macroNameP
  where
    skipDefine = P.skipSpaces >> P.char '#' >> P.skipSpaces >> P.string "define"
    macroNameP = skipDefine >> P.skipSpaces >> P.munch1 (not . isSpace)

module Main where

import Control.Monad (replicateM)
import Control.Applicative (liftA2, liftA3, (<|>))
import Data.List (foldl')
import Data.Char (isSpace, isAlpha, isDigit )
import Data.Maybe (fromMaybe)

import qualified Data.Map.Strict as M

import qualified Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadP ((<++))

main :: IO ()
main = do
  n <- read <$> getLine
  res <- liftA2 solve (replicateM n getLine) getLine
  putStrLn $ if res == Suspicious then "Suspicious" else "OK"

solve :: [String] -> String -> Priority
solve macros = balanceExp mb
  where
    balanceExp mb = balance mb . parseExpr
    macroDefs = map splitName macros
    mb = foldl' (\acc (name, expr) -> M.insert name (balanceExp acc expr) acc) M.empty macroDefs

balance :: M.Map String Priority -> Expr -> Priority
balance _ ConstNum = P3
balance mb (Var x) = fromMaybe P3 $ M.lookup x mb
balance mb (Op op l r)
  | op == '-' && rb < P2 = Suspicious
  | op == '/' && rb < P3 = Suspicious
  | op == '/' || op == '*' = minP P2
  | op == '-' || op == '+' = minP P1
  where
    lb = balance mb l
    rb = balance mb r
    minP p =  if lb < p || rb < p then Suspicious else p

data Expr = ConstNum
          | Var String
          | Op Char Expr Expr
          deriving (Show)

parseExpr :: String -> Expr
parseExpr input = parsed
  where
    exprP = addsubP <++ termP
    termP = muldivP <++ factorP
    factorP = parenP <++ constP <++ varP
    addsubP = liftA3 (flip Op) termP (P.char '+' <|> P.char '-') exprP
    muldivP = liftA3 (flip Op) factorP (P.char '*' <|> P.char '/') exprP
    varP = Var <$> P.munch1 isAlpha
    constP = ConstNum <$ P.munch1 isDigit
    parenP = P.between (P.char '(') (P.char ')') exprP
    [(parsed, "")] = P.readP_to_S exprP $ filter (not . isSpace) input

data Priority = Suspicious | P1 | P2 | P3 deriving (Ord, Eq, Show)

splitName :: String -> (String, String)
splitName = head . P.readP_to_S macroNameP
  where
    skipDefine = P.skipSpaces >> P.char '#' >> P.skipSpaces >> P.string "define"
    macroNameP = skipDefine >> P.skipSpaces >> P.munch1 (not . isSpace)

module Main where

import Control.Monad (replicateM)
import Control.Applicative (liftA2, liftA3, (<|>))
import Data.List (foldl')
import Data.Char (isSpace, isAlpha, isDigit )
import Data.Maybe (fromMaybe)

import qualified Data.Map.Strict as M

import qualified Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadP ((<++))

main :: IO ()
main = do
  n <- read <$> getLine
  res <- liftA2 solve (replicateM n getLine) getLine
  putStrLn $ if res == Suspicious then "Suspicious" else "OK"

solve :: [String] -> String -> Priority
solve macros = balanceExp mb
  where
    balanceExp mb = balance mb . parseExpr
    macroDefs = map splitName macros
    mb = foldl' (\acc (name, expr) -> M.insert name (balanceExp acc expr) acc) M.empty macroDefs

balance :: M.Map String Priority -> Expr -> Priority
balance _ ConstNum = Atom
balance mb (Paren p) = if balance mb p == Suspicious then Suspicious else Atom
balance mb (Var x) = fromMaybe Atom $ M.lookup x mb
balance mb (Op op l r) = case op of
    '+' -> minP Sum
    '-' -> minP Sub
    '*' -> minP Mul
    '/' -> minP Div
  where
    lb = balance mb l
    rb = balance mb r
    minP p =  if lb < p || rb < p then Suspicious else p

data Expr = ConstNum
          | Var String
          | Paren Expr
          | Op Char Expr Expr
          deriving (Show)

parseExpr :: String -> Expr
parseExpr input = parsed
  where
    [(parsed, "")] = parseExpr' input

parseExpr' :: String -> [(Expr, String)]
parseExpr' = P.readP_to_S sumP . filter (not . isSpace)
  where
    sumP = liftA3 (flip Op) subP (P.char '+') sumP <++ subP
    subP = liftA3 (flip Op) mulP (P.char '-') subP <++ mulP
    mulP = liftA3 (flip Op) divP (P.char '*') mulP <++ divP
    divP = liftA3 (flip Op) factorP (P.char '/') divP <++ factorP
    factorP = parenP <++ constP <++ varP
    varP = Var <$> P.munch1 isAlpha
    constP = ConstNum <$ P.munch1 isDigit
    parenP = Paren <$> P.between (P.char '(') (P.char ')') sumP

data Priority = Suspicious | Sum | Sub | Mul | Div | Atom deriving (Ord, Eq, Show)

splitName :: String -> (String, String)
splitName = head . P.readP_to_S macroNameP
  where
    skipDefine = P.skipSpaces >> P.char '#' >> P.skipSpaces >> P.string "define"
    macroNameP = skipDefine >> P.skipSpaces >> P.munch1 (not . isSpace)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (replicateM)
import Control.Applicative (liftA2)
import Data.List (foldl')
import Data.Char (isSpace, isAlpha, isDigit )
import Data.Maybe (fromMaybe)
import Data.Functor ((<&>))

import qualified Data.Map.Strict as M

import qualified Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadP ((<++))

main :: IO ()
main = do
  n <- read <$> getLine
  res <- liftA2 solve (replicateM n getLine) getLine
  putStrLn $ if res == Suspicious then "Suspicious" else "OK"

solve :: [String] -> String -> Priority
solve macros = balanceExp mb
  where
    balanceExp mb = balance mb . parseExpr
    macroDefs = map splitName macros
    mb = foldl' (\acc (name, expr) -> M.insert name (balanceExp acc expr) acc) M.empty macroDefs

balance :: M.Map String Priority -> Expr -> Priority
balance _ ConstNum = Atom
balance mb (Paren p) = if balance mb p == Suspicious then Suspicious else Atom
balance mb (Var x) = fromMaybe Atom $ M.lookup x mb
balance mb (Op op es) = case op of
    '+' -> minP Add
    '-' -> condP Sub
    '*' -> minP Mul
    '/' -> condP Div
  where
    bs@(bh:bt) = map (balance mb) es
    minP p = if any (< p) bs then Suspicious else p
    condP p = if bh < p || any (<= p) bt then Suspicious else p

data Expr = ConstNum
          | Var String
          | Paren Expr
          | Op Char [Expr]
          deriving (Show)

parseExpr :: String -> Expr
parseExpr input = case parseExpr' input of
  [(parsed, _)] -> parsed

parseExpr' :: String -> [(Expr, String)]
parseExpr' = P.readP_to_S (exprP <* P.eof) . filter (not . isSpace)
  where
    exprP = foldl' opP factorP "/*-+"
    opP p op = P.sepBy1 p (P.char op) <&> \case
      [e] -> e
      exs -> Op op exs
    factorP = parenP <++ constP <++ varP
    varP = Var <$> P.munch1 isAlpha
    constP = ConstNum <$ P.munch1 isDigit
    parenP = Paren <$> P.between (P.char '(') (P.char ')') exprP

data Priority = Suspicious | Add | Sub | Mul | Div | Atom  deriving (Ord, Eq, Show)

splitName :: String -> (String, String)
splitName = head . P.readP_to_S macroNameP
  where
    skipDefine = P.skipSpaces >> P.char '#' >> P.skipSpaces >> P.string "define"
    macroNameP = skipDefine >> P.skipSpaces >> P.munch1 (not . isSpace)

module Main where

import Control.Monad (replicateM)
import Control.Applicative (liftA2, liftA3, (<|>))
import Data.List (foldl')
import Data.Char (isSpace, isAlpha, isDigit )
import Data.Maybe (fromMaybe)

import qualified Data.Map.Strict as M

import qualified Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadP ((<++))

main :: IO ()
main = do
  n <- read <$> getLine
  res <- liftA2 solve (replicateM n getLine) getLine
  putStrLn $ if res == Suspicious then "Suspicious" else "OK"

solve :: [String] -> String -> Priority
solve macros = balanceExp mb
  where
    balanceExp mb = balance mb . parseExpr
    macroDefs = map splitName macros
    mb = foldl' (\acc (name, expr) -> M.insert name (balanceExp acc expr) acc) M.empty macroDefs

balance :: M.Map String Priority -> Expr -> Priority
balance _ ConstNum = P3
balance mb (Paren p) = if balance mb p == Suspicious then Suspicious else P3
balance mb (Var x) = fromMaybe P3 $ M.lookup x mb
balance mb (Op op l r)
  -- | op == '-' && rb < P2 = Suspicious
  -- | op == '/' && rb < P3 = Suspicious
  | op == '/' || op == '*' = minP P2
  | op == '-' || op == '+' = minP P1
  where
    lb = balance mb l
    rb = balance mb r
    minP p =  if lb < p || rb < p then Suspicious else p

data Expr = ConstNum
          | Var String
          | Paren Expr
          | Op Char Expr Expr
          deriving (Show)

parseExpr :: String -> Expr
parseExpr input = parsed
  where
    [(parsed, "")] = parseExpr' input

parseExpr' :: String -> [(Expr, String)]
parseExpr' = P.readP_to_S exprP . filter (not . isSpace)
  where
    exprP = addsubP <++ termP
    termP = muldivP <++ factorP
    factorP = parenP <++ constP <++ varP
    addsubP = liftA3 (flip Op) termP (P.char '+' <|> P.char '-') exprP
    muldivP = liftA3 (flip Op) factorP (P.char '*' <|> P.char '/') termP
    varP = Var <$> P.munch1 isAlpha
    constP = ConstNum <$ P.munch1 isDigit
    parenP = Paren <$> P.between (P.char '(') (P.char ')') exprP

data Priority = Suspicious | P1 | P2 | P3 deriving (Ord, Eq, Show)

splitName :: String -> (String, String)
splitName = head . P.readP_to_S macroNameP
  where
    skipDefine = P.skipSpaces >> P.char '#' >> P.skipSpaces >> P.string "define"
    macroNameP = skipDefine >> P.skipSpaces >> P.munch1 (not . isSpace)


You got a job as a marketer in a pet shop, and your current task is to boost sales of cat food. One of the strategies is to sell cans of food in packs with discounts. Suppose you decided to sell packs with $$$a$$$ cans in a pack with a discount and some customer wants to buy $$$x$$$ cans of cat food. Then he follows a greedy strategy:   he buys $$$\left\lfloor \frac{x}{a} \right\rfloor$$$ packs with a discount;  then he wants to buy the remaining $$$(x \bmod a)$$$ cans one by one. $$$\left\lfloor \frac{x}{a} \right\rfloor$$$ is $$$x$$$ divided by $$$a$$$ rounded down, $$$x \bmod a$$$ is the remainer of $$$x$$$ divided by $$$a$$$.But customers are greedy in general, so if the customer wants to buy $$$(x \bmod a)$$$ cans one by one and it happens that $$$(x \bmod a) \ge \frac{a}{2}$$$ he decides to buy the whole pack of $$$a$$$ cans (instead of buying $$$(x \bmod a)$$$ cans). It makes you, as a marketer, happy since the customer bought more than he wanted initially.You know that each of the customers that come to your shop can buy any number of cans from $$$l$$$ to $$$r$$$ inclusive. Can you choose such size of pack $$$a$$$ that each customer buys more cans than they wanted initially?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first and only line of each test case contains two integers $$$l$$$ and $$$r$$$ ($$$1 \le l \le r \le 10^9$$$) — the range of the number of cans customers can buy.

For each test case, print YES if you can choose such size of pack $$$a$$$ that each customer buys more cans than they wanted initially. Otherwise, print NO. You can print each character in any case.

NoteIn the first test case, you can take, for example, $$$a = 5$$$ as the size of the pack. Then if a customer wants to buy $$$3$$$ cans, he'll buy $$$5$$$ instead ($$$3 \bmod 5 = 3$$$, $$$\frac{5}{2} = 2.5$$$). The one who wants $$$4$$$ cans will also buy $$$5$$$ cans.In the second test case, there is no way to choose $$$a$$$.In the third test case, you can take, for example, $$$a = 80$$$.

{-# LANGUAGE Safe #-}

import Control.Arrow ((>>>))
import Data.Bool (bool)

main =
  interact $
  lines >>>
  drop 1 >>> map (words >>> map read >>> solve >>> bool "NO" "YES") >>> unlines

solve :: [Int] -> Bool
solve [l, r] = r < 2 * l