You are playing a computer game, where you lead a party of $$$m$$$ soldiers. Each soldier is characterised by his agility $$$a_i$$$.The level you are trying to get through can be represented as a straight line segment from point $$$0$$$ (where you and your squad is initially located) to point $$$n + 1$$$ (where the boss is located).The level is filled with $$$k$$$ traps. Each trap is represented by three numbers $$$l_i$$$, $$$r_i$$$ and $$$d_i$$$. $$$l_i$$$ is the location of the trap, and $$$d_i$$$ is the danger level of the trap: whenever a soldier with agility lower than $$$d_i$$$ steps on a trap (that is, moves to the point $$$l_i$$$), he gets instantly killed. Fortunately, you can disarm traps: if you move to the point $$$r_i$$$, you disarm this trap, and it no longer poses any danger to your soldiers. Traps don't affect you, only your soldiers.You have $$$t$$$ seconds to complete the level — that is, to bring some soldiers from your squad to the boss. Before the level starts, you choose which soldiers will be coming with you, and which soldiers won't be. After that, you have to bring all of the chosen soldiers to the boss. To do so, you may perform the following actions:  if your location is $$$x$$$, you may move to $$$x + 1$$$ or $$$x - 1$$$. This action consumes one second;  if your location is $$$x$$$ and the location of your squad is $$$x$$$, you may move to $$$x + 1$$$ or to $$$x - 1$$$ with your squad in one second. You may not perform this action if it puts some soldier in danger (i. e. the point your squad is moving into contains a non-disarmed trap with $$$d_i$$$ greater than agility of some soldier from the squad). This action consumes one second;  if your location is $$$x$$$ and there is a trap $$$i$$$ with $$$r_i = x$$$, you may disarm this trap. This action is done instantly (it consumes no time). Note that after each action both your coordinate and the coordinate of your squad should be integers.You have to choose the maximum number of soldiers such that they all can be brought from the point $$$0$$$ to the point $$$n + 1$$$ (where the boss waits) in no more than $$$t$$$ seconds.

The first line contains four integers $$$m$$$, $$$n$$$, $$$k$$$ and $$$t$$$ ($$$1 \le m, n, k, t \le 2 \cdot 10^5$$$, $$$n < t$$$) — the number of soldiers, the number of integer points between the squad and the boss, the number of traps and the maximum number of seconds you may spend to bring the squad to the boss, respectively. The second line contains $$$m$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_m$$$ ($$$1 \le a_i \le 2 \cdot 10^5$$$), where $$$a_i$$$ is the agility of the $$$i$$$-th soldier. Then $$$k$$$ lines follow, containing the descriptions of traps. Each line contains three numbers $$$l_i$$$, $$$r_i$$$ and $$$d_i$$$ ($$$1 \le l_i \le r_i \le n$$$, $$$1 \le d_i \le 2 \cdot 10^5$$$) — the location of the trap, the location where the trap can be disarmed, and its danger level, respectively.

Print one integer — the maximum number of soldiers you may choose so that you may bring them all to the boss in no more than $$$t$$$ seconds.

NoteIn the first example you may take soldiers with agility $$$3$$$, $$$4$$$ and $$$5$$$ with you. The course of action is as follows:  go to $$$2$$$ without your squad;  disarm the trap $$$2$$$;  go to $$$3$$$ without your squad;  disartm the trap $$$3$$$;  go to $$$0$$$ without your squad;  go to $$$7$$$ with your squad. The whole plan can be executed in $$$13$$$ seconds.

import Data.List
import Control.Monad

rd arg = map read $ words arg :: [Int]

eval :: [(Int, Int, Int)]->Int
eval [] = 0
eval [(a,b,_)] = (b - a) * 2
eval ((a,b,_):(c,d,_):xs) = if b >= c then eval ((a,max b d,0):xs) else (b-a) * 2 + (eval ((c,d,0):xs))

bs :: [Int]->Int->Int->[(Int, Int, Int)]->Int->Int
bs lst le ri trp t = if le + 1 == ri then le else if eval (filter (\(_,_,e)->(pt<e)) trp)<=t
then bs lst mi ri trp t else bs lst le mi trp t where mi = quot (le+ri) 2;pt=(lst!!(mi-1))

main=do
 st1<-getLine
 st2<-getLine
 let (m, n, k, t) = (\[m,n,k,t]->(m,n,k,t)) $ rd st1
 let sld = rd st2
 isl <- replicateM k getLine
 let trp = map ((\[a,b,c]->(a-1,b,c)) . rd) isl
 print $ bs (reverse (sort sld)) 0 (m+1) (sort trp) (t-n-1)

import Data.List
import Control.Monad
w arg=map read$words arg::[Int]
o[]=0
o[(a,b,_)]=(b-a)*2
o((a,b,_):(c,d,_):x)=if b>=c then o((a,max b d,0):x)else(b-a)*2+(o((c,d,0):x))
b p l r y t=if l+1==r then l else if o (filter (\(_,_,e)->(k<e)) y)<=t
then b p m r y t else b p l m y t where m=quot (l+r) 2;k=(p!!(m-1))
main=do
 p<-getLine;q<-getLine;let (m,n,k,t)=(\[m,n,k,t]->(m,n,k,t))$w p;
 let s=w q
 i<-replicateM k getLine;let y=map ((\[a,b,c]->(a-1,b,c)).w) i
 print $b (reverse (sort s)) 0 (m+1) (sort y) (t-n-1)


A group of $$$n$$$ alpinists has just reached the foot of the mountain. The initial difficulty of climbing this mountain can be described as an integer $$$d$$$.Each alpinist can be described by two integers $$$s$$$ and $$$a$$$, where $$$s$$$ is his skill of climbing mountains and $$$a$$$ is his neatness.An alpinist of skill level $$$s$$$ is able to climb a mountain of difficulty $$$p$$$ only if $$$p \leq s$$$. As an alpinist climbs a mountain, they affect the path and thus may change mountain difficulty. Specifically, if an alpinist of neatness $$$a$$$ climbs a mountain of difficulty $$$p$$$ the difficulty of this mountain becomes $$$\max(p, a)$$$. Alpinists will climb the mountain one by one. And before the start, they wonder, what is the maximum number of alpinists who will be able to climb the mountain if they choose the right order. As you are the only person in the group who does programming, you are to answer the question.Note that after the order is chosen, each alpinist who can climb the mountain, must climb the mountain at that time.

The first line contains two integers $$$n$$$ and $$$d$$$ ($$$1 \leq n \leq 500\,000$$$; $$$0 \leq d \leq 10^9$$$) — the number of alpinists and the initial difficulty of the mountain. Each of the next $$$n$$$ lines contains two integers $$$s_i$$$ and $$$a_i$$$ ($$$0 \leq s_i, a_i \leq 10^9$$$) that define the skill of climbing and the neatness of the $$$i$$$-th alpinist.

Print one integer equal to the maximum number of alpinists who can climb the mountain if they choose the right order to do so.

NoteIn the first example, alpinists $$$2$$$ and $$$3$$$ can climb the mountain if they go in this order. There is no other way to achieve the answer of $$$2$$$.In the second example, alpinist $$$1$$$ is not able to climb because of the initial difficulty of the mountain, while alpinists $$$2$$$ and $$$3$$$ can go up in any order.In the third example, the mountain can be climbed by alpinists $$$5$$$, $$$3$$$ and $$$4$$$ in this particular order. There is no other way to achieve optimal answer.

{-# LANGUAGE ScopedTypeVariables #-}

-- Original solution: https://codeforces.com/contest/1601/submission/133414420

import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.IO
import Data.Bool
import Data.Maybe
import Data.Ord
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    [n, d] <- readInts
    ps :: Array Int (Int, Int) <- fmap (listArray (0, n-1)) $ replicateM n $ do
        ~[s, a] <- readInts
        pure (s, a)
    let [mx, mn] = map (listArray (0, n-1) . (<$> elems ps) . uncurry) [max, min] :: [UArray Int Int]

    idx :: IOUArray Int Int <- newArray_ (0, n - 1)
    forM_ [0 .. n-1] $ \i -> writeArray idx i i
    mergeSort idx n $ comparing (mx!) <> comparing (mn!)
    idxs <- getElems idx

    let f (ans, d) (s, a) = if s >= d then (ans + 1, max d a) else (ans, d)
    print $ fst $ foldl' f (0 :: Int, d) $ map (ps!) idxs

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

-- merge sorts a mutable array indexed (0, n-1), in-place
mergeSort :: forall a e m. (MArray a e m) => a Int e -> Int -> (e -> e -> Ordering) -> m ()
mergeSort a n cmp = do
    b :: a Int e <- newArray_ (0, n - 1)
    let merge l r e = foldM_ f (l, r) [l .. e-1] where
            f (i, j) k
                | i >= r = takej
                | j >= e = takei
                | otherwise = bool takej takei . (<= EQ) =<< (cmp <$> readArray a i <*> readArray a j)
              where
                takei = (i + 1, j) <$ (writeArray b k =<< readArray a i)
                takej = (i, j + 1) <$ (writeArray b k =<< readArray a j)
    forM_ (takeWhile (<n) $ iterate (*2) 1) $ \w -> do
        forM_ [0, 2*w .. n-1] $ \i -> merge i ((i + w) `min` n) ((i + 2*w) `min` n)
        forM_ [0 .. n-1] $ \i -> readArray b i >>= writeArray a i


Recently, your friend discovered one special operation on an integer array $$$a$$$:   Choose two indices $$$i$$$ and $$$j$$$ ($$$i \neq j$$$);  Set $$$a_i = a_j = |a_i - a_j|$$$. After playing with this operation for a while, he came to the next conclusion:   For every array $$$a$$$ of $$$n$$$ integers, where $$$1 \le a_i \le 10^9$$$, you can find a pair of indices $$$(i, j)$$$ such that the total sum of $$$a$$$ will decrease after performing the operation. This statement sounds fishy to you, so you want to find a counterexample for a given integer $$$n$$$. Can you find such counterexample and prove him wrong?In other words, find an array $$$a$$$ consisting of $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) such that for all pairs of indices $$$(i, j)$$$ performing the operation won't decrease the total sum (it will increase or not change the sum).

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first and only line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 1000$$$) — the length of array $$$a$$$.

For each test case, if there is no counterexample array $$$a$$$ of size $$$n$$$, print NO. Otherwise, print YES followed by the array $$$a$$$ itself ($$$1 \le a_i \le 10^9$$$). If there are multiple counterexamples, print any.

NoteIn the first test case, the only possible pairs of indices are $$$(1, 2)$$$ and $$$(2, 1)$$$.If you perform the operation on indices $$$(1, 2)$$$ (or $$$(2, 1)$$$), you'll get $$$a_1 = a_2 = |1 - 337| = 336$$$, or array $$$[336, 336]$$$. In both cases, the total sum increases, so this array $$$a$$$ is a counterexample.

module Main where
import Data.Functor ((<&>))
import Control.Monad (forM, replicateM, replicateM_)
import Data.Foldable (traverse_)
import GHC.Float.RealFracMethods (ceilingDoubleInt, floorDoubleInt)
import Data.List (group, sort)
import Data.Ratio ((%))
import Prelude hiding (floor)
import Control.Monad (forM_, replicateM_)
import Data.Function ((&))

readInts :: IO [Int]
readInts = getLine <&> words <&> fmap read

readString :: IO String
readString = getLine

toDoubles :: (Functor f, Integral a) => f a -> f Double
toDoubles xs = (\x -> fromIntegral x :: Double) <$> xs

toDouble :: (Integral a) => a -> Double
toDouble = fromIntegral

ceil :: Double -> Int
ceil = ceilingDoubleInt

floor :: Double -> Int
floor = floorDoubleInt

{-
(a2 - a1) * 2 >= a1 + a2
2 * a2 - 2 * a1 >= a1 + a2
a2 >= 3 * a1
a2 = 3 * a1
-}

main :: IO ()
main = do
  t:_ <- readInts
  replicateM_ t $ do
    n:_ <- readInts
    let
      m = floor (logBase 3 1e9) + 1
      ans = zipWith (flip (**)) [0..] (replicate m 3) <&> toInteger . floor
    if n <= m
      then do
        putStrLn "YES"
        forM_ (take n ans) (\x -> do {putStr $ show x; putStr " "})
      else putStr "NO"
    putStr "\n"

import Data.List
import Control.Monad

main = do
    testCases <- readLn
    let a   = (1::Int) : map (*3) a
        max = length (takeWhile (<=10^9) a)
      in replicateM testCases (readLn >>= \x ->
        if x > max then putStrLn "NO"
        else do
            putStrLn "YES"
            putStrLn $ intercalate " " (map show (take x a))
        )

module Main where

import           Control.Monad
import           Data.List

main :: IO ()
main = do
    let l = takeWhile (<= 10^9) $ iterate (*3) 1
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        if n > length l
        then
            putStrLn "NO"
        else
            putStrLn $ ("YES\n" <>) . unwords . map show . take n $ l

module Main where
import Data.Functor ((<&>))
import Control.Monad (forM, replicateM, replicateM_)
import Data.Foldable (traverse_)
import GHC.Float.RealFracMethods (ceilingDoubleInt, floorDoubleInt)
import Data.List (group, sort)
import Data.Ratio ((%))
import Prelude hiding (floor)
import Control.Monad (forM_, replicateM_)
import Data.Function ((&))

readInts :: IO [Int]
readInts = getLine <&> words <&> fmap read

readString :: IO String
readString = getLine

toDoubles :: (Functor f, Integral a) => f a -> f Double
toDoubles xs = (\x -> fromIntegral x :: Double) <$> xs

toDouble :: (Integral a) => a -> Double
toDouble = fromIntegral

ceil :: Double -> Int
ceil = ceilingDoubleInt

floor :: Double -> Int
floor = floorDoubleInt

{-
(a2 - a1) * 2 >= a1 + a2
2 * a2 - 2 * a1 >= a1 + a2
a2 >= 3 * a1
a2 = 3 * a1
-}

main :: IO ()
main = do
  t:_ <- readInts
  replicateM_ t $ do
    n:_ <- readInts
    let
      m = floor (logBase 3 1e9)
      ans = zipWith (flip (**)) [0..] (replicate m 3) <&> toInteger . floor
    if n <= m + 1
      then do
        putStrLn "YES"
        forM_ (take n ans) (\x -> do {putStr $ show x; putStr " "})
      else putStr "NO"
    putStr "\n"

module Main where
import Data.Functor ((<&>))
import Control.Monad (forM, replicateM, replicateM_)
import Data.Foldable (traverse_)
import GHC.Float.RealFracMethods (ceilingDoubleInt, floorDoubleInt)
import Data.List (group, sort)
import Data.Ratio ((%))
import Prelude hiding (floor)
import Control.Monad (forM_, replicateM_)

readInts :: IO [Int]
readInts = getLine <&> words <&> fmap read

readString :: IO String
readString = getLine

toDoubles :: (Functor f, Integral a) => f a -> f Double
toDoubles xs = (\x -> fromIntegral x :: Double) <$> xs

toDouble :: (Integral a) => a -> Double
toDouble = fromIntegral

ceil :: Double -> Int
ceil = ceilingDoubleInt

floor :: Double -> Int
floor = floorDoubleInt

main :: IO ()
main = do
  t:_ <- readInts
  replicateM_ t $ do
    n:_ <- readInts
    let
      m = 29
      ans = zipWith (flip (**)) [0..] (replicate m 2) <&> toInteger . floor
    if n <= m
      then do
        putStrLn "YES"
        forM_ (take n ans) (\x -> do {putStr $ show x; putStr " "})
      else putStr "NO"
    putStr "\n"

import Data.List
import Control.Monad

main = do
    testCases <- readLn
    let max = 10^9
        a   = (1::Int) : map (*3) a
      in replicateM testCases (readLn >>= \x ->
        if x >= 18 then putStrLn "NO"
        else do
            putStrLn "YES"
            putStrLn $ intercalate " " (map show (take x a))
        )

import Data.List
import Control.Monad

main = do
    testCases <- readLn
    let max = 10^9
        a   = (1::Int) : map (*3) a
      in replicateM testCases (readLn >>= \x ->
        if x > 18 then putStrLn "NO"
        else do
            putStrLn "YES"
            putStrLn $ intercalate " " (map show (take x a))
        )


Codeforces user' handle color depends on his rating — it is red if his rating is greater or equal to 2400; it is orange if his rating is less than 2400 but greater or equal to 2200, etc. Each time participant takes part in a rated contest, his rating is changed depending on his performance.Anton wants the color of his handle to become red. He considers his performance in the rated contest to be good if he outscored some participant, whose handle was colored red before the contest and his rating has increased after it.Anton has written a program that analyses contest results and determines whether he performed good or not. Are you able to do the same?

The first line of the input contains a single integer n (1 ≤ n ≤ 100) — the number of participants Anton has outscored in this contest . The next n lines describe participants results: the i-th of them consists of a participant handle namei and two integers beforei and afteri ( - 4000 ≤ beforei, afteri ≤ 4000) — participant's rating before and after the contest, respectively. Each handle is a non-empty string, consisting of no more than 10 characters, which might be lowercase and uppercase English letters, digits, characters «_» and «-» characters. It is guaranteed that all handles are distinct.

Print «YES» (quotes for clarity), if Anton has performed good in the contest and «NO» (quotes for clarity) otherwise.

3
Burunduk1 2526 2537
BudAlNik 2084 2214
subscriber 2833 2749

3
Applejack 2400 2400
Fluttershy 2390 2431
Pinkie_Pie -2500 -2450

NoteIn the first sample, Anton has outscored user with handle Burunduk1, whose handle was colored red before the contest and his rating has increased after the contest.In the second sample, Applejack's rating has not increased after the contest, while both Fluttershy's and Pinkie_Pie's handles were not colored red before the contest.

{-# LANGUAGE NPlusKPatterns #-}
module Main where

getInt :: IO Int
getInt = fmap read getLine

getWords :: IO [String]
getWords = fmap words getLine

type Contestant = (String, Int, Int)

getContestant :: IO Contestant
getContestant = do
    [name, before, after] <- getWords
    return (name, read before, read after)

main :: IO ()
main = do
    n <- getInt
    cts <- doMany n getContestant
    putStrLn $ showFlag $ any witness cts

doMany :: Int -> IO a -> IO [a]
doMany 0 _ = return []
doMany (n + 1) act = do
    a <- act
    as <- doMany n act
    return (a : as)

witness :: Contestant -> Bool
witness (_, before, after) = before >= 2400 && after > before

doManyTill :: Int -> IO a -> (a -> Bool) -> IO Bool
doManyTill 0 _ _ = return False
doManyTill (n + 1) act p = do
    a <- act
    if p a
        then return True
        else doManyTill n act p

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

main :: IO()
main = output . solve . tail . words =<< getContents

output :: Bool -> IO()
output True = putStrLn "YES"
output False = putStrLn "NO"

solve :: [String] -> Bool
solve [] = False
solve (s:sa:sb:x) = let a = read sa
                        b = read sb
                    in (a >= 2400 && b > a) || solve x

{-# 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 <- readLn
  ls <- replicateM n $ map read . tail . words <$> getLine

  let b = any (\[a, b] -> a >= 2400 && b > a) ls

  putStrLn $ if b then "YES" else "NO"

module Main where

main = do
  w <- getLine
  w0 <- getContents
  let pool = [niceForm x | x <- (lines w0)]
  let r = solution pool
  if elem True r
  then putStrLn "YES"
  else putStrLn "NO"

niceForm :: String -> (Int,Int)
niceForm w = (n0,n1)
  where [n0,n1] = map read (tail $ words w)

solution :: [(Int,Int)] -> [Bool]
solution [] = []
solution (x:xs) = (((fst x) >= 2400) && ((snd x) > (fst x))) : solution xs

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
--import qualified Data.Map as M
---import qualified Data.Vector as V
--import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  t <- fmap read getLine
  inp <- forM [1..t] $ \_ -> fmap words getLine
  if solve inp then putStrLn "YES" else putStrLn "NO"

solve :: [[String]] -> Bool
solve = any f
    where
      f [_, x, y] = read y > (read x :: Int) && read x >= 2400

main = do
  n <- getLine
  d <- sequence $ replicate (read n) getLine
  let a = map (map read . tail . words) d
  putStrLn $ if foldl (\acc [x, y] -> if 2400 <= x && x < y then True else acc
                      ) False a then "YES" else "NO"

import Data.List

f::String->Bool
f x=let (n:a:b:[])=words x
        a2=read a::Int
        b2=read b::Int
    in if a2>=2400 && b2>a2 then True else False

main=do
     e1<-getLine
     es<-getContents
     let xs=lines es
     putStrLn $ if any f xs then "YES" else "NO"

main = interact solve

solve input = answer
    where
    n_s:inputw = words input

    n::Int
    n = read n_s

    scores::[(Int,Int)]
    scores = by_two $ map read $ last_two_by_three inputw

    highers = filter (\(x,y) -> (y > x) && x >= 2400) scores

    answer
        | one_or_more highers = "YES"
        | otherwise = "NO"

last_two_by_three [] = []
last_two_by_three (x:y:z:xs) = y:z:(last_two_by_three xs)

by_two [] = []
by_two (x:y:xs) = (x,y):(by_two xs)

one_or_more [] = False
one_or_more (x:xs) = True

main = interact $ format . any qualifies . tail . lines
qualifies l = a >= 2400 && a < b where [a,b] = map read (tail (words l))
format True = "YES"
format False = "NO"

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

main = do n <- readLn
          ls <- map ((map read) . tail . words) <$> replicateM n getLine
          putStrLn $ solve ls

solve [] = "NO"
solve ([b, a]:ls) = if 2400 <= b && b < a
                    then "YES"
                    else solve ls

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

main = do
  n <- readLn
  [ns, bs, as] <- transpose . map words <$> replicateM n getLine
  putStrLn $ solve ns (map read bs) (map read as)

solve :: [String] -> [Int] -> [Int] -> String
solve [] [] [] = "NO"
solve (n:ns) (b:bs) (a:as) = if 2400 <= b && b < a then "YES" else solve ns bs as

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

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function (on)
import           Data.Array
-- import           Data.Array.Unboxed
-- import           Data.Array.IArray
-- import           Data.Array.ST
-- import           Data.Array.MArray
-- import           Data.Array.Unsafe
import           Data.Ix
import           Data.Maybe
import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntSet (IntSet)
-- import qualified Data.IntSet as S
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as M
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S
-- import           Debug.Trace

main = do
  n <- readInt1 <$> BS.getLine
  ns <- map (readStrIntInt . toTriple . BS.words) <$> replicateM n BS.getLine
  putStrLn $ solve ns

readStrIntInt :: (BS.ByteString, BS.ByteString, BS.ByteString) -> (BS.ByteString, Int, Int)
readStrIntInt = applyTriple id (fst . fromJust . BS.readInt) (fst . fromJust . BS.readInt)

solve :: [(BS.ByteString,Int,Int)] -> String
solve ns = if any p ns then "YES" else "NO" where
  p = \(_,before,after) -> before>=2400 && before<after

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

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

readInt641 :: BS.ByteString -> Int64
readInt641 = fromIntegral . fst . fromJust . BS.readInteger

readInt642 :: BS.ByteString -> (Int64,Int64)
readInt642 = toTuple . readInt64N

readInt643 :: BS.ByteString -> (Int64,Int64,Int64)
readInt643 = toTriple . readInt64N

readInt64N :: BS.ByteString -> [Int64]
readInt64N =  map readInt641 . BS.words

readInteger1 :: BS.ByteString -> Integer
readInteger1 = fst . fromJust . BS.readInteger

readInteger2 :: BS.ByteString -> (Integer,Integer)
readInteger2 = toTuple . readIntegerN

readInteger3 :: BS.ByteString -> (Integer,Integer,Integer)
readInteger3 = toTriple . readIntegerN

readIntegerN :: BS.ByteString -> [Integer]
readIntegerN =  map readInteger1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

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

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

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

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)

import Control.Applicative
import Data.List

main = do
	getLine
	y<- filter (\z-> head z < head (tail z)) . filter (\z-> head z >=2400) . map (map read ). map tail. map words. lines <$> getContents ::IO [[Int]]
	putStrLn $ if y ==[] then "NO" else "YES"

process :: [(Int, Int)] -> Bool
process = any (\(s,t) -> s >= 2400 && s < t)

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    xs' <- fmap (map (map readInt.tail.words).lines) getContents
    let xs = map (\[s,t] -> (s,t)) xs'
    if process xs
        then putStrLn "YES"
        else putStrLn "NO"

main = interact $ (\b -> if b then "YES" else "NO") . not . null . filter (\[r1, r2] -> r1 >= 2400 && r2 > r1) . map (map read . tail . words) . tail . lines

module Main where

main = do
  w <- getLine
  w0 <- getContents
  let pool = [niceForm x | x <- (lines w0)]
  let r = solution pool
  if elem True r
  then print "YES"
  else print "NO"

niceForm :: String -> (Int,Int)
niceForm w = (n0,n1)
  where [n0,n1] = map read (tail $ words w)

solution :: [(Int,Int)] -> [Bool]
solution [] = []
solution (x:xs) = (((fst x) >= 2400) && ((snd x) > (fst x))) : solution xs


Polycarpus has a sequence, consisting of n non-negative integers: a1, a2, ..., an.Let's define function f(l, r) (l, r are integer, 1 ≤ l ≤ r ≤ n) for sequence a as an operation of bitwise OR of all the sequence elements with indexes from l to r. Formally: f(l, r) = al | al + 1 | ...  | ar. Polycarpus took a piece of paper and wrote out the values of function f(l, r) for all l, r (l, r are integer, 1 ≤ l ≤ r ≤ n). Now he wants to know, how many distinct values he's got in the end. Help Polycarpus, count the number of distinct values of function f(l, r) for the given sequence a.Expression x | y means applying the operation of bitwise OR to numbers x and y. This operation exists in all modern programming languages, for example, in language C++ and Java it is marked as "|", in Pascal — as "or".

The first line contains integer n (1 ≤ n ≤ 105) — the number of elements of sequence a. The second line contains n space-separated integers a1, a2, ..., an (0 ≤ ai ≤ 106) — the elements of sequence a.

Print a single integer — the number of distinct values of function f(l, r) for the given sequence a. Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use cin, cout streams or the %I64d specifier.

NoteIn the first test case Polycarpus will have 6 numbers written on the paper: f(1, 1) = 1, f(1, 2) = 3, f(1, 3) = 3, f(2, 2) = 2, f(2, 3) = 2, f(3, 3) = 0. There are exactly 4 distinct numbers among them: 0, 1, 2, 3.

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE BangPatterns #-}

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

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

for :: Int -> Int -> (Int -> ST s ()) -> ST s ()
for !m !n f=when(m<n)$f m>>for(m+1)n f
rep :: Int -> (Int -> ST s ()) -> ST s ()
rep !n f=for 0 n f

main = do
  n <- readLn :: IO Int
  arr <- listArray(0,n-1).map readInt.B.words <$> B.getLine
  print $ solve n arr

solve :: Int -> UArray Int Int -> Int
solve n arr = length $ filter (unsafeAt isMember) [0..2^20-1]
   where
     !isMember = runSTUArray $ do
       isMem <- newArray (0,2^20-1) False :: ST s (STUArray s Int Bool)
       prev  <- newArray (0,19)     (-1)  :: ST s (STUArray s Int Int)
       rep n $ \i-> do
         let !x=unsafeAt arr i
         ins <- fmap(scanr((.|.).unsafeAt arr)x.sort.catMaybes).forM [0..19] $ \b-> do
           key <- unsafeRead prev b
           if key<0 then return Nothing else return $ Just key
         forM_ ins $ \j-> do
           unsafeWrite isMem j True
         rep 20 $ \b-> do
           when (testBit x b) $ unsafeWrite prev b i
       return isMem


Emuskald is a well-known illusionist. One of his trademark tricks involves a set of magical boxes. The essence of the trick is in packing the boxes inside other boxes.From the top view each magical box looks like a square with side length equal to 2k (k is an integer, k ≥ 0) units. A magical box v can be put inside a magical box u, if side length of v is strictly less than the side length of u. In particular, Emuskald can put 4 boxes of side length 2k - 1 into one box of side length 2k, or as in the following figure:  Emuskald is about to go on tour performing around the world, and needs to pack his magical boxes for the trip. He has decided that the best way to pack them would be inside another magical box, but magical boxes are quite expensive to make. Help him find the smallest magical box that can fit all his boxes.

The first line of input contains an integer n (1 ≤ n ≤ 105), the number of different sizes of boxes Emuskald has. Each of following n lines contains two integers ki and ai (0 ≤ ki ≤ 109, 1 ≤ ai ≤ 109), which means that Emuskald has ai boxes with side length 2ki. It is guaranteed that all of ki are distinct.

Output a single integer p, such that the smallest magical box that can contain all of Emuskald’s boxes has side length 2p.

NotePicture explanation. If we have 3 boxes with side length 2 and 5 boxes with side length 1, then we can put all these boxes inside a box with side length 4, for example, as shown in the picture.In the second test case, we can put all four small boxes into a box with side length 2.

module Main (main) where

import Control.Monad (liftM, replicateM)

data Box = Box { side :: Int
               , number :: Int }
           deriving (Show)

readBox :: String -> Box
readBox line = Box { side = s, number = n }
  where (s:n:_) = map read $ words line

getMinSide :: Box -> Int
getMinSide (Box s n) = if n == 1
                       then (s + 1)
                       else getMinSide' s n
  where getMinSide' s n
          | n == 1    = s
          | otherwise = getMinSide' (s + 1) (div (n + 3) 4)

main = do
  n <- liftM read getLine
  boxes <- replicateM n $ liftM readBox getLine
  let answer = maximum $ map getMinSide boxes
  print answer

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

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 <- readLn
  ls <- replicateM n getInts

  let
    f [k, a] = fromIntegral k + v
      where
        v :: Int64 = ceiling $ if a == 1 then 1 else logBase 4 (fromIntegral a :: Double)
  print $ maximum $ map f ls

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

reads :: Read a => IO (a, a)
reads  =  liftM (pack . map read . words) getLine
  where
    pack [a, b]  =  (a, b)

solve :: [(Int, Int)] -> Int
solve  =  maximum . map solve'
  where
    solve' (a, b)  =  (+) a $ max 1 $ length $ takeWhile (< b) [2^(2*x) | x <- [0..]]

main :: IO ()
main  =  do
    n   <-  readLn
    xs  <-  replicateM n reads
    print $ solve xs

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

main = do
	input <- C.getContents
	let
		(n:xs)  = map (fst.fromJust.C.readInt) $ C.words input
		toTuple [] = []
		toTuple (a:b:rest) = (a,b) : (toTuple rest)
		boxes = toTuple xs
	print $ solve $ sortBy (\(a,b) (c,d) -> a `compare` c) boxes

solve :: [(Int,Int)] -> Int
solve ((a,b):[]) = a + max 1 (div_four b)
		where
			div_four x
				| x == 1 = 0
				| otherwise = 1 + div_four (((x-1) `div` 4)+1)

solve ((a,b):(c,d):rest) = solve ((c, cnt) : rest )
		where
			 cnt = max d (div_four (c-a) b)
			 div_four ti x
					| x == 1 || ti == 0 = x
					| otherwise = div_four (ti-1) (((x-1) `div` 4)+1)

import qualified Data.ByteString.Char8 as B
import qualified Data.List as L
import qualified Data.Set as S
import Data.Maybe
import Data.Int
import Control.Monad

readInt :: B.ByteString -> Int
readInt = fromMaybe 0 . fmap fst . B.readInt

main :: IO ()
main = do
    n <- B.getLine >>= return .readInt
    l <- replicateM n (B.getLine >>= return . map readInt . B.words)
    print $ solve n l

solve :: Int ->[[Int]] -> Int
solve n l = binarySearch judge 0 maxBound
    where
        judge :: Int -> Bool
        judge n = and $ fmap (contain n) l
        contain :: Int -> [Int] -> Bool
        contain n [k,a]
            | k >= n    = False
            | otherwise = contain1 n k a
        contain1 n k a
            | k > n  = False
            | a > 4 && a `mod` 4 == 0 = contain1 n (k+1) (a `div` 4)
            | a > 4 = contain1 n (k+1) (a `div` 4 + 1)
            | otherwise = k < n || a == 1

binarySearch :: (Int -> Bool) -> Int -> Int -> Int
binarySearch judge = sub
    where
        sub a b
            |b == a+1  = b
            |judge m   = sub a m
            |otherwise = sub m b
            where
                m = (a+b) `div` 2

{-# LANGUAGE BangPatterns #-}
import Data.List

toPair :: Read a => [String] -> (a, a)
toPair [a, b] = (read a, read b)

solve :: [(Int, Int)] -> Int
solve a' = solve' a where
    a = sort a'
    solve' !((k, a):[]) = if a <= 4
        then k + 1
        else solve' $ (k + 1, (a + 3) `div` 4):[]
    solve' !((k, a1):(k2, a2):xs) = if k + 1 == k2
        then solve' $ (k2, max ((a1 + 3) `div` 4) a2):xs
        else if a1 >= 4
            then solve' $ (k + 1, (a1 + 3) `div` 4):(k2, a2):xs
            else solve' $ (k2, a2):xs

main = do
    n <- read `fmap` getLine
    a <- sequence $ take n $ repeat $ toPair `fmap` words `fmap` getLine
    print $ solve a

module Main (main) where

import Control.Monad (liftM, replicateM)

data Box = Box { side :: Int
               , number :: Int }
           deriving (Show)

readBox :: String -> Box
readBox line = Box { side = s, number = n }
  where (s:n:_) = map read $ words line

getMinSide :: Box -> Int
getMinSide (Box s n) = getMinSide' s n
  where getMinSide' s n | n == 1    = s
                        | otherwise = getMinSide' (s + 1) (div (n + 3) 4)

main = do
  n <- liftM read getLine
  boxes <- replicateM n $ liftM readBox getLine
  let answer = maximum $ map getMinSide boxes
  print answer

module Main (main) where

import Control.Monad (liftM, replicateM)

data Box = Box { side :: Int
               , number :: Int }
           deriving (Show)

readBox :: String -> Box
readBox line = Box { side = s, number = n }
  where (s:n:_) = map read $ words line

getMinSide :: Box -> Int
getMinSide (Box s n) = if n == 1
                       then s
                       else getMinSide' s n
  where getMinSide' s n
          | n == 1    = s
          | otherwise = getMinSide' (s + 1) (div (n + 3) 4)

main = do
  n <- liftM read getLine
  boxes <- replicateM n $ liftM readBox getLine
  let answer = maximum $ map getMinSide boxes
  print answer

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

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 <- readLn
  ls <- replicateM n getInts

  print $ maximum $ map (\[k, a] -> k + ceiling (if a == 0 then 1 else logBase 4 (fromIntegral a))) ls

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

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 <- readLn
  ls <- replicateM n getInts

  print $ maximum $ map (\[k, a] -> k + ceiling (if a == 1 then 1 else logBase 4 (fromIntegral a))) ls

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

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 <- readLn
  ls <- replicateM n getInts

  let
    f [k, a] = fromIntegral k + v
      where
        v :: Int32 = ceiling $ if a == 1 then 1 else logBase 4 (fromIntegral a :: Float)
  print $ maximum $ map f ls

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

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 <- readLn
  ls <- replicateM n getInts

  print $ maximum $ map (\[k, a] -> k + ceiling (logBase 4 (fromIntegral a))) ls

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

main = do
	input <- C.getContents
	let
		(n:xs)  = map (fst.fromJust.C.readInt) $ C.words input
		toTuple [] = []
		toTuple (a:b:rest) = (a,b) : (toTuple rest)
		boxes = toTuple xs
	print $ solve $ sortBy (\(a,b) (c,d) -> a `compare` c) boxes

solve :: [(Int,Int)] -> Int
solve ((a,b):[]) = a + (div_four b)
		where
			div_four x
				| x == 1 = 0
				| otherwise = 1 + div_four (((x-1) `div` 4)+1)

solve ((a,b):(c,d):rest) = solve ((c, cnt) : rest )
		where
			 cnt = max d (div_four (c-a) b)
			 div_four ti x
					| x == 1 || ti == 0 = x
					| otherwise = div_four (ti-1) (((x-1) `div` 4)+1)

import qualified Data.ByteString.Char8 as B
import qualified Data.List as L
import qualified Data.Set as S
import Data.Maybe
import Data.Int
import Control.Monad

readInt :: B.ByteString -> Int
readInt = fromMaybe 0 . fmap fst . B.readInt

main :: IO ()
main = do
    n <- B.getLine >>= return .readInt
    l <- replicateM n (B.getLine >>= return . map readInt . B.words)
    print $ solve n l

solve :: Int ->[[Int]] -> Int
solve n l =
    if n == 1 && l == [[0,0]] then
        0
    else
        binarySearch judge 0 maxBound
    where
        judge :: Int -> Bool
        judge n = and $ fmap (contain n) l
        contain :: Int -> [Int] -> Bool
        contain n [k,a]
            | k > n = False
            | a > 4 && a `mod` 4 == 0 = contain n [k+1,a `div` 4]
            | a > 4 = contain n [k+1,a `div` 4 + 1]
            | otherwise = k < n || a == 1

binarySearch :: (Int -> Bool) -> Int -> Int -> Int
binarySearch judge = sub
    where
        sub a b
            |b == a+1  = b
            |judge m   = sub a m
            |otherwise = sub m b
            where
                m = (a+b) `div` 2

import Data.List

toPair :: Read a => [String] -> (a, a)
toPair [a, b] = (read a, read b)

solve :: [(Int, Int)] -> Int
solve a' = solve' a where
    a = sort a'
    solve' ((k, a):[]) = if a == 1
        then k
        else solve' $ (k + 1, (a + 3) `div` 4):[]
    solve' ((k, a1):(k2, a2):xs) = if k + 1 == k2
        then solve' $ (k2, max ((a1 + 3) `div` 4) a2):xs
        else if a1 >= 4
            then solve' $ (k + 1, (a1 + 3) `div` 4):(k2, a2):xs
            else solve' $ (k2, a2):xs

main = do
    n <- read `fmap` getLine
    a <- sequence $ take n $ repeat $ toPair `fmap` words `fmap` getLine
    print $ solve a

import Data.List

toPair :: Read a => [String] -> (a, a)
toPair [a, b] = (read a, read b)

solve :: [(Int, Int)] -> Int
solve a' = solve' a where
    a = sort a'
    solve' ((k, a):[]) = if a == 1
        then k
        else solve' $ (k + 1, (a + 3) `div` 4):[]
    solve' ((k, a1):(k2, a2):xs) = if k + 1 == k2
        then solve' $ (k2, max ((a1 + 3) `div` 4) a2):xs
        else solve' $ (k + 1, (a1 + 3) `div` 4):(k2, a2):xs

main = do
    n <- read `fmap` getLine
    a <- sequence $ take n $ repeat $ toPair `fmap` words `fmap` getLine
    print $ solve a


Ksenia has an array $$$a$$$ consisting of $$$n$$$ positive integers $$$a_1, a_2, \ldots, a_n$$$. In one operation she can do the following:   choose three distinct indices $$$i$$$, $$$j$$$, $$$k$$$, and then  change all of $$$a_i, a_j, a_k$$$ to $$$a_i \oplus a_j \oplus a_k$$$ simultaneously, where $$$\oplus$$$ denotes the bitwise XOR operation. She wants to make all $$$a_i$$$ equal in at most $$$n$$$ operations, or to determine that it is impossible to do so. She wouldn't ask for your help, but please, help her!

The first line contains one integer $$$n$$$ ($$$3 \leq n \leq 10^5$$$) — the length of $$$a$$$. The second line contains $$$n$$$ integers, $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — elements of $$$a$$$.

Print YES or NO in the first line depending on whether it is possible to make all elements equal in at most $$$n$$$ operations. If it is possible, print an integer $$$m$$$ ($$$0 \leq m \leq n$$$), which denotes the number of operations you do. In each of the next $$$m$$$ lines, print three distinct integers $$$i, j, k$$$, representing one operation.  If there are many such operation sequences possible, print any. Note that you do not have to minimize the number of operations.

NoteIn the first example, the array becomes $$$[4 \oplus 1 \oplus 7, 2, 4 \oplus 1 \oplus 7, 4 \oplus 1 \oplus 7, 2] = [2, 2, 2, 2, 2]$$$.

import Control.Arrow ((>>>))
import Data.Bits

main :: IO ()
main = interact $ words >>> drop 1 >>> map read >>> solve >>> showAns
  where
    showAns Nothing = "NO"
    showAns (Just xs) =
      unlines ("YES" : show (length xs) : map (unwords . map show) xs)

solve :: [Int] -> Maybe [[Int]]
solve xs
  | odd n = Just (extra ++ [[1, 2, 3]] ++ extra)
  | foldl1 xor xs /= 0 = Nothing
  | otherwise = solve (tail xs)
  where
    n = length xs
    extra = (3 :) <$> chunksOf 2 [4 .. n]

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf n xs =
  let (ls, xs') = splitAt n xs
   in ls : chunksOf n xs'


Bob came to a cash & carry store, put n items into his trolley, and went to the checkout counter to pay. Each item is described by its price ci and time ti in seconds that a checkout assistant spends on this item. While the checkout assistant is occupied with some item, Bob can steal some other items from his trolley. To steal one item Bob needs exactly 1 second. What is the minimum amount of money that Bob will have to pay to the checkout assistant? Remember, please, that it is Bob, who determines the order of items for the checkout assistant.

The first input line contains number n (1 ≤ n ≤ 2000). In each of the following n lines each item is described by a pair of numbers ti, ci (0 ≤ ti ≤ 2000, 1 ≤ ci ≤ 109). If ti is 0, Bob won't be able to steal anything, while the checkout assistant is occupied with item i.

Output one number — answer to the problem: what is the minimum amount of money that Bob will have to pay.

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

import Debug.Trace

solve n arr (j, (t, c)) = do
  next <- newArray (-n, n) (-1)
  mapM_ (\key -> readArray arr key >>= expand next key) [-n..n]
  return next
    where
      min2 a b = minimum [a, b]
      expand next key (-1) = return ()
      expand next key val
          | key >= (n - j) = modArr next (key-1) val
          | otherwise = do modArr next (key-1) val
                           modArr next (min2 n (key+t)) $ val+c
      modArr :: IOArray Int Integer -> Int -> Integer -> IO ()
      modArr a2 ix v1 =
          do v2 <- readArray a2 ix
             writeArray a2 ix $ if v2 == -1 then v1 else min2 v1 v2

main = do
  n <- readLn
  ds <- replicateM n $ do
          [t, c] <- words <$> getLine
          return (read t, read c)
  arr <- newArray (-n, n) (-1) :: IO (IOArray Int Integer)
  writeArray arr 0 0
  arr' <- foldM (solve n) arr $ zip [0..] ds
  assocs <- getAssocs arr'
  print $ minimum $ map snd $
        filter (\(key, val) -> key >= 0 && val /= (-1)) assocs

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

import Debug.Trace

solve n arr (j, (t, c)) = do
  next <- newArray (-n, n) (-1)
  mapM_ (\key -> readArray arr key >>= expand next key) [-n..n]
  return next
    where
      min2 a b = minimum [a, b]
      expand next key (-1) = return ()
      expand next key val
          | key >= (n - j) = modArr next (key-1) val
          | otherwise = do modArr next (key-1) val
                           modArr next (min2 (n-j-1) (key+t)) $ val+c
      modArr :: IOUArray Int Int -> Int -> Int -> IO ()
      modArr a2 ix v1 =
          do v2 <- readArray a2 ix
             writeArray a2 ix $ if v2 == -1 then v1 else min2 v1 v2

main = do
  n <- readLn
  ds <- replicateM n $ do
          [t, c] <- words <$> getLine
          return (read t, read c)
  arr <- newArray (-n, n) (-1) :: IO (IOUArray Int Int)
  writeArray arr 0 0
  arr' <- foldM (solve n) arr $ zip [0..] ds
  assocs <- getAssocs arr'
  print $ minimum $ map snd $
        filter (\(key, val) -> key >= 0 && val /= (-1)) assocs

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

import Debug.Trace

solve n arr (j, (t, c)) = do
  next <- newArray (-n, n) (-1)
  mapM_ (\key -> readArray arr key >>= expand next key) [-n..n]
  return next
    where
      min2 a b = minimum [a, b]
      expand next key (-1) = return ()
      expand next key val
          | key >= (n - j) = mapArr arr next (key-1) val
          | otherwise = do mapArr arr next (key-1) val
                           mapArr arr next (min2 n (key+t)) $ val+c
      mapArr :: IOUArray Int Int -> IOUArray Int Int -> Int -> Int -> IO ()
      mapArr a1 a2 ix v1 =
          do v2 <- readArray a2 ix
             writeArray a2 ix $ if v2 == -1 then v1 else min2 v1 v2

main = do
  n <- readLn
  ds <- replicateM n $ do
          [t, c] <- words <$> getLine
          return (read t, read c)
  arr <- newArray (-n, n) (-1) :: IO (IOUArray Int Int)
  writeArray arr 0 0
  arr' <- foldM (solve n) arr $ zip [0..] ds
  assocs <- getAssocs arr'
  print $ minimum $ map snd $ filter (\(key, val) -> key >= 0 && val /= (-1)) assocs


According to the regulations of Berland's army, a reconnaissance unit should consist of exactly two soldiers. Since these two soldiers shouldn't differ much, their heights can differ by at most d centimeters. Captain Bob has n soldiers in his detachment. Their heights are a1, a2, ..., an centimeters. Some soldiers are of the same height. Bob wants to know, how many ways exist to form a reconnaissance unit of two soldiers from his detachment.Ways (1, 2) and (2, 1) should be regarded as different.

The first line contains two integers n and d (1 ≤ n ≤ 1000, 1 ≤ d ≤ 109) — amount of soldiers in Bob's detachment and the maximum allowed height difference respectively. The second line contains n space-separated integers — heights of all the soldiers in Bob's detachment. These numbers don't exceed 109.

Output one number — amount of ways to form a reconnaissance unit of two soldiers, whose height difference doesn't exceed d.

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

main = do
	[n, d] <- getA
	a <- getA
	putStr $ show $ sum [1 | i <- a, j <- a, abs(i-j) <= d] - n

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

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let [n, d] = map (fst . fromJust . C.readInt) . C.words $ head input
	let as = map (fst . fromJust . C.readInt) . C.words $ head $ tail input
	let ass = array (0, n-1) [ (i, as !! i) | i <- [0..n-1] ]
	print $ 2 * (length $ filter (\(x,y) -> abs (x-y) <= d) [ (ass ! i, ass ! j) | i <- [0..n-1], j <- [i+1..n-1] ])

pairnum heights diff = sum (map length (pairs heights []))
    where pairs [] _    = []
          pairs (x:t) h = (filter (\n -> (abs (x - n)) <= diff) (t ++ h)) : (pairs t (x:h))

main :: IO ()
main = do
  [_, max_diff] <- fmap (map read . words) getLine
  heights <- fmap (map read . words) getLine
  print (pairnum heights max_diff)

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

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, d] <- getInts
  xs <- getInts

  print $ length [(x, y) | x <- xs, y <- xs, abs (x-y) <= d] - n

import Array
import Monad (liftM)

solve :: Int -> Array Int Int -> Int
solve d array  =  2 * length [(i,j) | i <- [1..n], j <- [i+1..n], abs (array ! i - array ! j) <= d]
  where
    n  =  snd $ bounds array

main :: IO ()
main  =  do
    [n, d]  <-  liftM (map read . words) getLine
    xs  <-  liftM (map read . words) getLine
    print $ solve d $ listArray (1,n) xs

import Data.List

f::Integer->[(Integer,Integer)]->[(Integer,Integer)]->Integer
f _ _ []=0
f d xs2@((p1,x):xs) ys2@((p2,y):ys)
    |y-x<=d=(p2-p1)*2 + f d xs2 ys
    |otherwise=f d xs ys2

main =do
      e<-getLine
      es<-getLine
      let (n:d:[])=map read (words e)::[Integer]
          xs=map read (words es)::[Integer]
          ys=zip [1..n] (sort xs)
      print $ f d ys ys

import Data.List
import Data.Char
import Control.Monad
main = do
  [n, d] <- fmap (map read . words) getLine
  a <- fmap (map read . words) getLine
  let k = length([1 | i <- a, j <- a, abs(i - j) <= d]) - n
      in print k

import Data.List
import Data.Char
import Control.Monad
main = do
  [n, d] <- fmap (map read . words) getLine
  a <- fmap (map read . words) getLine
  let k = [1 | i <- a, j <- a, abs(i - j) <= d]
      count = length(k) - length(a)
      in print count

import Prelude
import List
import Char

main = interact func

func = q1.lines

q1::[String]->String
q1 (a:b:xs) = (solve ((toInt.head.tail.words) a) ((map toInt.words) b))
              ++ "\n" ++ (q1 xs)
q1 []       = ""

toInt::String->Int
toInt = read
--toInt = foldl step 0
--    where step a b = a*10+(digitToInt b)

solve::Int->[Int]->String
solve a b = show (left a b)

left::Int->[Int]->Int
left a (b:xs) = (right a b xs)*2 + (left a xs)
left _ []     = 0

right a b (c:xs) | (abs (b-c)) <= a = 1 + (right a b xs)
                 | otherwise        = right a b xs
right _ _ []                        = 0

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

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

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
      -- readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : d : _ <- readData
  xs <- take n <$> readData
  let answer = sum $ do
        (i, x) <- zip [1 .. ] xs
        (j, y) <- zip [1 .. ] xs
        guard $ i /= j
        guard $ abs (x - y) <= d
        return (1 :: Int)
  printf "%d\n" $ answer

main = interact (ans)
dif x = read(last (words (head (lines x))))::Int
hei x = zip (map (read::String -> Int) (words (last(lines x)))) [1..]
pair x = [(y,z)|y<-hei x,z<-hei x,y/=z,fst y-fst z<= dif x,fst z-fst y<= dif x]
ans x = show(length(pair x))

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

process m k x = (+ (-1)) $ length $ filter (<=x+m) $ filter (>=x-m) k

main = do
		[n,m]<- map read <$> words <$> getLine ::IO [Int]
		k<-sort <$> map read <$> words <$>getLine ::IO [Int]
		print $ sum $ map (process m k) k

module Main (
    main
) where

parse :: String -> (Int, Int, [Int])
parse str = (n, d, hs)
    where lns = lines str
          [n,d] = map read $ words $ head lns
          hs = map read $ words $ lns !! 1

solve :: (Int, Int, [Int]) -> Int
solve (n, d, hs) = length [(i,j) | i <- hs, j <- hs, abs (i - j) <= d ] - n

output :: Int -> String
output n = show n

main = interact $ output . solve . parse

process :: Integral a => a -> [a] -> a
process d xs = sum [if abs(i-j) <= d then 1 else 0 | i <- xs, j <- xs] - fromIntegral(length xs)

readInt :: String -> Integer
readInt = read

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

pairnum heights diff = sum (map length (pairs [] heights diff))
    where pairs [] _ _    = []
          pairs (x:t) h d = (filter (\n -> abs (x - n) <= d) (t ++ h)) : (pairs t (x:h) d)

main :: IO ()
main = do
  [_, max_diff] <- fmap (map read . words) getLine
  heights <- fmap (map read . words) getLine
  print (pairnum heights max_diff)

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

main = do
		[n,m]<- map read <$> words <$> getLine ::IO [Int]
		k<-sort <$> map read <$> words <$>getLine ::IO [Int]
		let z= length $ filter (<=m) $ zipWith (subtract) k (tail k)
		print $ z+z


You are given an array $$$a_1, a_2 \dots a_n$$$. Calculate the number of tuples $$$(i, j, k, l)$$$ such that:   $$$1 \le i < j < k < l \le n$$$;  $$$a_i = a_k$$$ and $$$a_j = a_l$$$;

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$4 \le n \le 3000$$$) — the size of the array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$) — the array $$$a$$$. It's guaranteed that the sum of $$$n$$$ in one test doesn't exceed $$$3000$$$.

For each test case, print the number of described tuples.

NoteIn the first test case, for any four indices $$$i < j < k < l$$$ are valid, so the answer is the number of tuples.In the second test case, there are $$$2$$$ valid tuples:   $$$(1, 2, 4, 6)$$$: $$$a_1 = a_4$$$ and $$$a_2 = a_6$$$;  $$$(1, 3, 4, 6)$$$: $$$a_1 = a_4$$$ and $$$a_3 = a_6$$$.

import Control.Monad
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.STRef
import Data.Int

newSTUArray :: (Int, Int) -> Int -> ST s (STUArray s Int Int)
newSTUArray = newArray

solve :: Int -> [Int] -> Int64
solve n ali = runST $ do
  ws <- newSTUArray (1, n) 0
  forM_ ali $ \a -> do
    currW <- readArray ws a
    writeArray ws a (currW + 1)
  let  tries = scanl (\(prevs, prev) v -> (prev : prevs, v)) ([], 0) ali
  total <- newSTRef 0
  forM_ tries $ \(prevs, val) -> when (val /= 0) $ do
    valW <- readArray ws val
    writeArray ws val (valW - 1)
    inters <- newSTRef 0
    forM_ prevs $ \prev -> when (prev /= 0) $ do
      when (prev == val) $ readSTRef inters >>= modifySTRef' total . (+)
      prevW <- readArray ws prev
      modifySTRef' inters (+ fromIntegral prevW)
  readSTRef total

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    ali <- map read . words <$> getLine
    print $ solve n ali