You are standing at the point $$$0$$$ on a coordinate line. Your goal is to reach the point $$$n$$$. In one minute, you can move by $$$2$$$ or by $$$3$$$ to the left or to the right (i. e., if your current coordinate is $$$x$$$, it can become $$$x-3$$$, $$$x-2$$$, $$$x+2$$$ or $$$x+3$$$). Note that the new coordinate can become negative.Your task is to find the minimum number of minutes required to get from the point $$$0$$$ to the point $$$n$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ lines describing the test cases follow. The $$$i$$$-th of these lines contains one integer $$$n$$$ ($$$1 \le n \le 10^9$$$) — the goal of the $$$i$$$-th test case.

For each test case, print one integer — the minimum number of minutes required to get from the point $$$0$$$ to the point $$$n$$$ for the corresponding test case.

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ solve
solve = read <$> getLine >>= \x -> print $
    if x == 1 then 2 else
        let (a, r) = x `divMod` 3 in
            if r == 0 then a else 1+a

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ solve
solve = read <$> getLine >>= \x -> print $
    if x == 1 then 2 else
        let (a, r) = x `divMod` 3 in
            (if r == 0 then id else (1+)) a

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ solve
solve = read <$> getLine >>= \x -> print $
    if x == 1 then 2
    else x `div` 3 + case x `mod` 3 of
        0 -> 0
        1 -> 1
        2 -> 1

{-
 Whatever you do, work heartily, as for the Lord and not for men,
 knowing that from the Lord you will receive the inheritance as your reward.
 You are serving the Lord Christ.
   - Colossians 3:23-24
-}

module Main
       ( main )
       where

import Control.Monad

minutesTo :: Int -> Int
minutesTo x
   | x == 1    = 2
   | rem == 0  = quot
   | otherwise = quot + 1
   where (quot, rem) = x `quotRem` 3

main :: IO ()
main = do
  line <- getLine
  let testCases = read line

  replicateM_ testCases $ do
    line <- getLine
    let n = read line
    print $ minutesTo n

module Main where
import Control.Monad
import Data.List
y::Bool->Bool->Int
y True True=2
y False False=0
y True False=1
y False True=1
solve::Int->Int
solve x= d+(y ((x`rem`3)/=0) (x==1))
    where d=x`div`3

main = do
  line<-getLine
  let nTerm=read line::Int
  replicateM_ nTerm$do
    line<-getLine
    let n=read line::Int
    print$solve n

{-
 Whatever you do, work heartily, as for the Lord and not for men,
 knowing that from the Lord you will receive the inheritance as your reward.
 You are serving the Lord Christ.
   - Colossians 3:23-24
-}

module Main
       ( main )
       where

import Control.Monad

minutesTo :: Int -> Int
minutesTo x
   | x == 1         = 2
   | x `mod` 3 == 0 = x `div` 3
   | otherwise      = x `div` 2

main :: IO ()
main = do
  line <- getLine
  let testCases = read line

  replicateM_ testCases $ do
    line <- getLine
    let n = read line
    print $ minutesTo n


There are $$$n$$$ students numerated from $$$1$$$ to $$$n$$$. The level of the $$$i$$$-th student is $$$a_i$$$. You need to split the students into stable groups. A group of students is called stable, if in the sorted array of their levels no two neighboring elements differ by more than $$$x$$$.For example, if $$$x = 4$$$, then the group with levels $$$[1, 10, 8, 4, 4]$$$ is stable (because $$$4 - 1 \le x$$$, $$$4 - 4 \le x$$$, $$$8 - 4 \le x$$$, $$$10 - 8 \le x$$$), while the group with levels $$$[2, 10, 10, 7]$$$ is not stable ($$$7 - 2 = 5 > x$$$).Apart from the $$$n$$$ given students, teachers can invite at most $$$k$$$ additional students with arbitrary levels (at teachers' choice). Find the minimum number of stable groups teachers can form from all students (including the newly invited).For example, if there are two students with levels $$$1$$$ and $$$5$$$; $$$x = 2$$$; and $$$k \ge 1$$$, then you can invite a new student with level $$$3$$$ and put all the students in one stable group.

The first line contains three integers $$$n$$$, $$$k$$$, $$$x$$$ ($$$1 \le n \le 200\,000$$$, $$$0 \le k \le 10^{18}$$$, $$$1 \le x \le 10^{18}$$$) — the initial number of students, the number of students you can additionally invite, and the maximum allowed level difference. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^{18}$$$) — the students levels.

In the only line print a single integer: the minimum number of stable groups you can split the students into.

NoteIn the first example you can invite two students with levels $$$2$$$ and $$$11$$$. Then you can split the students into two stable groups:   $$$[1, 1, 2, 5, 8, 11, 12, 13]$$$,  $$$[20, 22]$$$. In the second example you are not allowed to invite new students, so you need $$$3$$$ groups:   $$$[1, 1, 5, 5, 20, 20]$$$  $$$[60, 70, 70, 70, 80, 90]$$$  $$$[420]$$$

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

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

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

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

solve :: IO ()
solve = do
  [n, k, x] <- readInts :: IO [Int64]
  ys <- readInts :: IO [Int64]
  let diffs = filter (>x) $ map snd $ drop 2 $ scanl (\(bef, diff) x -> (x, x-bef)) (0, 0) $ sort ys
      xs = sort diffs
      res = foldl (\(r, cnt) y -> if ceil y x <= r then (r-ceil y x, cnt) else (r, cnt+1)) (k, 1::Int) xs
    in print $ snd res
    where ceil x r = div (x-1) r

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

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

--parseInt = f . Char8.readInt where f (Just (i, _)) = i
--readInts = map parseInt . Char8.words <$> Char8.getLine

main = do
  let t = 1
  replicateM_ t $ solve

{-# LANGUAGE ScopedTypeVariables #-}

import qualified Data.ByteString.Char8 as C
import Data.Int (Int)
import Data.List (sort)
import Debug.Trace

readMultipleFromLine :: IO [Int]
readMultipleFromLine = map parse . C.words <$> C.getLine
  where
    parse s = let Just (n, _) = C.readInt s in n

joints :: Int -> [Int] -> [Int]
joints x a = [j - i | (i, j) <- zip a $ tail a, j - i > x]

uniteCount :: Int -> Int -> [Int] -> Int
uniteCount _ _ [] = 0
uniteCount x k a =
  let need = head a `div` x - (if head a `mod` x == 0 then 1 else 0)
   in if need <= k
        then uniteCount x (k - need) $ tail a
        else length a

main = do
  [n, k, x] :: [Int] <- readMultipleFromLine
  a :: [Int] <- readMultipleFromLine
  print $ 1 + uniteCount x k (sort $ joints x $ sort a)

{-# LANGUAGE ScopedTypeVariables #-}

import qualified Data.ByteString.Char8 as C
import Data.Int (Int)
import Data.List (sort)
import Debug.Trace

readMultipleFromLine :: IO [Int]
readMultipleFromLine = map parse . C.words <$> C.getLine
  where
    parse s = let Just (n, _) = C.readInt s in n

joints :: Int -> [Int] -> [Int]
joints x a = [j - i | (i, j) <- zip a $ tail a, j - i > x]

computeExtraNeed :: Int -> Int -> Int
computeExtraNeed ai x = ai `div` x - (if ai `mod` x == 0 then 1 else 0)

countRemainingJoint :: Int -> (Int, Int) -> Int -> (Int, Int)
countRemainingJoint x (k, acc) ai =
  let need = computeExtraNeed ai x
   in if k > 0 && need <= k
        then (k - need, acc)
        else (k, acc + 1)

uniteCount :: Int -> Int -> [Int] -> Int
uniteCount x k a = snd $ foldl (countRemainingJoint x) (k, 0) a

main = do
  [n, k, x] :: [Int] <- readMultipleFromLine
  a :: [Int] <- readMultipleFromLine
  print $ 1 + uniteCount x k (sort $ joints x $ sort a)

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

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

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

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

solve :: IO ()
solve = do
  [n, k, x] <- readInts :: IO [Int64]
  ys <- readInts :: IO [Int64]
  print [n, k, x]
  print ys
  let diffs = filter (>x) $ map snd $ drop 2 $ scanl (\(bef, diff) x -> (x, x-bef)) (0, 0) $ sort ys
      xs = sort diffs
      res = foldl (\(r, cnt) y -> if ceil y x <= r then (r-ceil y x, cnt) else (r, cnt+1)) (k, 1::Int) xs
    in print $ snd res
    where ceil x r = div (x-1) r

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

readInts :: IO [Int64]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) <$> Bs.getLine

--parseInt = f . Char8.readInt where f (Just (i, _)) = i
--readInts = map parseInt . Char8.words <$> Char8.getLine

main = do
  let t = 1
  replicateM_ t $ solve

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

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

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

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

solve :: IO ()
solve = do
  [n, k, x] <- readInts :: IO [Int64]
  ys <- readInts :: IO [Int64]
  let diffs = filter (>x) $ map snd $ drop 2 $ scanl (\(bef, diff) x -> (x, x-bef)) (0, 0) $ sort ys
      xs = sort diffs
      res = foldl (\(r, cnt) y -> if ceil y x <= r then (r-ceil y x, cnt) else (r, cnt+1)) (k, 1::Int) xs
    in print $ snd res
    where ceil x r = div (x-1) r

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

readInts :: IO [Int64]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) <$> Bs.getLine

--parseInt = f . Char8.readInt where f (Just (i, _)) = i
--readInts = map parseInt . Char8.words <$> Char8.getLine

main = do
  let t = 1
  replicateM_ t $ solve

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

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

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

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char8
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  s1 <- readInts
  s2 <- readInts
  let [n, k, x] = map fromIntegral s1 :: [Int64]
      ys = map fromIntegral s2 :: [Int64]
      diffs = filter (>x) $ map snd $ drop 2 $ scanl (\(bef, diff) x -> (x, x-bef)) (0, 0) $ sort ys
      xs = sort diffs
      res = foldl (\(r, cnt) y -> if ceil y x <= r then (r-ceil y x, cnt) else (r, cnt+1)) (k, 1::Int) xs
    in print $ snd res
    where ceil x r = div (x-1) r

parseInt = f . Char8.readInt where f (Just (i, _)) = i
readInts = map parseInt . Char8.words <$> Char8.getLine

main = do
  let t = 1
  replicateM_ t $ solve

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

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

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

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char8
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  [n, k, x] <- readInts
  ys <- readInts
  let diffs = filter (>x) $ map snd $ drop 2 $ scanl (\(bef, diff) x -> (x, x-bef)) (0, 0) $ sort ys
      xs = sort diffs
      res = foldl (\(r, cnt) y -> if ceil y x <= r then (r-ceil y x, cnt) else (r, cnt+1)) (k, 1::Int) xs
    in print $ snd res
    where ceil x r = div (x-1) r

parseInt = f . Char8.readInt where f (Just (i, _)) = i
readInts = map parseInt . Char8.words <$> Char8.getLine

main = do
  let t = 1
  replicateM_ t $ solve

{-# LANGUAGE ScopedTypeVariables #-}

import Data.List (sort)
import GHC.Natural (intToNatural)
import Numeric.Natural (Natural)

readMultipleFromLine = fmap (map read . words) getLine

joints :: Natural -> [Natural] -> [Natural]
joints x a = [j - i | (i, j) <- zip a $ tail a, j - i > x]

uniteCount :: Natural -> Natural -> [Natural] -> Natural
uniteCount _ _ [] = 0
uniteCount x k a =
  let need = head a `div` x - (if head a `mod` x == 0 then 1 else 0)
   in if need <= k
        then uniteCount x (k - need) $ tail a
        else intToNatural $ length a + 1

main = do
  [n, k, x] :: [Natural] <- readMultipleFromLine
  a :: [Natural] <- readMultipleFromLine
  print $ uniteCount x k $ sort $ joints x $ sort a


It's a walking tour day in SIS.Winter, so $$$t$$$ groups of students are visiting Torzhok. Streets of Torzhok are so narrow that students have to go in a row one after another.Initially, some students are angry. Let's describe a group of students by a string of capital letters "A" and "P":   "A" corresponds to an angry student  "P" corresponds to a patient student Such string describes the row from the last to the first student.Every minute every angry student throws a snowball at the next student. Formally, if an angry student corresponds to the character with index $$$i$$$ in the string describing a group then they will throw a snowball at the student that corresponds to the character with index $$$i+1$$$ (students are given from the last to the first student). If the target student was not angry yet, they become angry. Even if the first (the rightmost in the string) student is angry, they don't throw a snowball since there is no one in front of them.Let's look at the first example test. The row initially looks like this: PPAP. Then, after a minute the only single angry student will throw a snowball at the student in front of them, and they also become angry: PPAA. After that, no more students will become angry.Your task is to help SIS.Winter teachers to determine the last moment a student becomes angry for every group.

The first line contains a single integer $$$t$$$ — the number of groups of students ($$$1 \le t \le 100$$$). The following $$$2t$$$ lines contain descriptions of groups of students. The description of the group starts with an integer $$$k_i$$$ ($$$1 \le k_i \le 100$$$) — the number of students in the group, followed by a string $$$s_i$$$, consisting of $$$k_i$$$ letters "A" and "P", which describes the $$$i$$$-th group of students.

For every group output single integer — the last moment a student becomes angry.

NoteIn the first test, after $$$1$$$ minute the state of students becomes PPAA. After that, no new angry students will appear.In the second tets, state of students in the first group is:   after $$$1$$$ minute — AAPAAPPAAPPP  after $$$2$$$ minutes — AAAAAAPAAAPP  after $$$3$$$ minutes — AAAAAAAAAAAP  after $$$4$$$ minutes all $$$12$$$ students are angry In the second group after $$$1$$$ minute, all students are angry.

main = getLine >> getContents >>= output.lines

output (_:s:t) = (print $ f $ (== 'A') <$> s) >> output t
output _ = return ()

f (True:t) = max (length $ takeWhile not t) (f $ dropWhile not t)
f (_:t) = f t
f _ = 0

import Control.Monad
import Data.List (group)

maximumOr :: Ord a => a -> [a] -> a
maximumOr def [] = def
maximumOr _ xs = maximum xs

solve :: String -> Int
solve = maximumOr 0
      . map length
      . filter ((== 'P') . head)
      . group
      . dropWhile (/= 'A')

main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    getLine
    print . solve =<< getLine

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Text as T

onecase = do
		getLine
		a<-T.pack <$> getLine
		print $ maximum $ map T.length $ T.split (=='A') $ T.dropWhile (=='P') a

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

import Data.List (group)

process :: [Char] -> Int
process = maximum . map (\x -> if head x == 'A' then 0 else length x) . group . dropWhile (=='P') . (++"A")

readInt :: String -> Int
readInt = read

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

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

solve :: String -> Int
solve [] = 0
solve ('P':queue) = solve queue
solve ('A':queue) = max pAhead (solve nextQueue)
  where pAhead = length $ takeWhile (== 'P') queue
        nextQueue = dropWhile (== 'P') queue

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:as:rest) = [(n, as)] ++ groupByTwo rest

parse :: (String, String) -> String
parse (n, as) = show $ solve as

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

solve [] = (0, 0)
solve (x:s) | x == 'P' = (a + 1, b)
            | x == 'A' = (0, max a b)
    where (a, b) = solve s

go n = do
    k <- getLine
    a <- getLine
    putStrLn $ show $ snd $ solve a
    if n > 1 then do
        go $ n - 1
    else
        return ()

main = do
    s <- getLine
    let n = read s
    go n


You are given $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$. Find the maximum value of $$$max(a_l, a_{l + 1}, \ldots, a_r) \cdot min(a_l, a_{l + 1}, \ldots, a_r)$$$ over all pairs $$$(l, r)$$$ of integers for which $$$1 \le l < r \le n$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10\,000$$$)  — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \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^6$$$). It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$3 \cdot 10^5$$$.

For each test case, print a single integer  — the maximum possible value of the product from the statement.

import Control.Monad
import Data.List
readInts = fmap (map read.words) getLine :: IO [Integer]

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let z = zipWith (*) (tail a) (init a)
    print $ maximum z

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

{-# LANGUAGE LambdaCase #-}

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

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = show . solve <$> numberOf integer

solve :: [Integer] -> Integer
solve xs = maximum [min u v * max u v | (u, v) <- zip xs (tail xs)]

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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


Another programming contest is over. You got hold of the contest's final results table. The table has the following data. For each team we are shown two numbers: the number of problems and the total penalty time. However, for no team we are shown its final place.You know the rules of comparing the results of two given teams very well. Let's say that team a solved pa problems with total penalty time ta and team b solved pb problems with total penalty time tb. Team a gets a higher place than team b in the end, if it either solved more problems on the contest, or solved the same number of problems but in less total time. In other words, team a gets a higher place than team b in the final results' table if either pa > pb, or pa = pb and ta < tb. It is considered that the teams that solve the same number of problems with the same penalty time share all corresponding places. More formally, let's say there is a group of x teams that solved the same number of problems with the same penalty time. Let's also say that y teams performed better than the teams from this group. In this case all teams from the group share places y + 1, y + 2, ..., y + x. The teams that performed worse than the teams from this group, get their places in the results table starting from the y + x + 1-th place.Your task is to count what number of teams from the given list shared the k-th place.

The first line contains two integers n and k (1 ≤ k ≤ n ≤ 50). Then n lines contain the description of the teams: the i-th line contains two integers pi and ti (1 ≤ pi, ti ≤ 50) — the number of solved problems and the total penalty time of the i-th team, correspondingly. All numbers in the lines are separated by spaces.

In the only line print the sought number of teams that got the k-th place in the final results' table.

NoteThe final results' table for the first sample is:   1-3 places — 4 solved problems, the penalty time equals 10  4 place — 3 solved problems, the penalty time equals 20  5-6 places — 2 solved problems, the penalty time equals 1  7 place — 1 solved problem, the penalty time equals 10 The table shows that the second place is shared by the teams that solved 4 problems with penalty time 10. There are 3 such teams.The final table for the second sample is:  1 place — 5 solved problems, the penalty time equals 3  2-5 places — 3 solved problems, the penalty time equals 1 The table shows that the fourth place is shared by the teams that solved 3 problems with penalty time 1. There are 4 such teams.

import Data.List
q k l=fst$head$dropWhile(\(a,b) -> a+b<k)$zip l (scanl (+) 0 l)
s([_,k]:t)=q k.map length.group.sort$map(\[a,b]->(-a,b))t
main=interact$show.s.map(map read.words).lines

import Data.List
s([_,k]:t)=[q|x<-map length.group.sort$map(\[a,b]->(-a,b))t,q<-replicate x x]!!(k-1)
main=interact$show.s.map(map read.words).lines

import Data.List

parse :: String -> [(Int, Int)]
parse stuff =
    map parse_line (lines stuff)
    where parse_line l = t2 $ map (read::String->Int) (words l)
          t2 [a, b] = (a, b)
          t2 _ = error "unexpected input"

solve :: [(Int, Int)] -> Int
solve ((_, k):teams) = findKth k sorted
    where
      sorted = group . (sortBy cmp) $ teams
cmp (a, b) (c, d)
    | a == c     = compare b d
    | otherwise  = compare c a
findKth _ [] = 0
findKth k (x:xs)
    | length x >= k = length x
    | otherwise     = findKth (k - length x) xs
      -- findKth _ _ = 0

main = do
  stuff <- getContents
  print . solve $ parse stuff

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Text.Printf
import Debug.Trace
import Data.List
import qualified Data.ByteString.Char8 as B
import qualified Data.Char as C

atoi :: B.ByteString -> Int
atoi = B.foldl' (\a c -> a*10 + C.ord c - C.ord '0') 0

solve :: Int -> [(Int, Int)] -> Int
solve k ps = length $ filter (== p) ps
  where p = (sort ps) !! (k-1)

main = do
    [n, k] <- map atoi . B.words <$> B.getLine
    ps <- replicateM n $ do
        [x, y] <- map atoi . B.words <$> B.getLine
        return (-x, y)
    putStrLn . show $ solve k ps

import Data.List
import Control.Applicative
readi = read::String->Int
getParams = map readi . words <$> getLine
getDesc = zip' . map readi . words <$> getContents
  where zip' [] = []
        zip' (x:y:xs) = (x,y):zip' xs
rsort = sortBy (\(a,a') (b, b') -> if a == b then compare a' b'
                                   else compare b a)
solve k (x:xs)
  | y <= 0 = length x
  | otherwise = solve y xs
  where y = k - (length x)
main=do
  [_,k] <- getParams
  rsorted <- rsort <$> getDesc
  putStrLn $ show ((solve k).group $ rsorted)

module Main where

import Data.Maybe
import Data.Array
import Data.List
import Data.Char

import Data.Time.Calendar

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

solve :: [[Int]] -> Int
solve ([_, k] : raw_results) = length winners where
    winners = filter (== winResult) sortedResults
    winResult = sortedResults !! (k - 1)

    sortedResults = reverse $ sortBy comp results

    results = map (\[a, b] -> (a, b)) raw_results

comp :: (Int, Int) -> (Int, Int) -> Ordering
comp (a, b) (c, d)
    | a == c && b == d = EQ
    | a > c || a == c && b < d = GT
    | otherwise = LT

import Data.List
inputTeam1 = [(4,10),(4,10),(4,10),(3,20),(2,1),(2,1),(1,10)]
inputTeam2 = [(3,1),(3,1),(5,3),(3,1),(3,1)]
inputTeam3 = "7 2\n4 10\n4 10\n4 10\n3 20\n2 1\n1 10\n"
inputTeam4 = "5 4\n3 1\n 3 1\n5 3\n3 1\n3 1\n"
main = do
	x <- getContents
	putStrLn (show (j x))
f (x,y) = x*(-100)+y
g x = sort $ map f x
h x y = count ((!!) (g x) (y-1)) (g x)
i :: String -> [Int]
i x = map read $ words x
j x = h (k (tail (tail (i x)))) (head (tail (i x)))
k [] = []
k (x:y:zs) = (x,y):k zs
count _ [] = 0
count y (x:xs) = if y==x then 1 + count y xs
						 else count y xs

import IO
import Data.List

main = print . solve =<< parse stdin

solve (n, k, pts) = length $ filter (==score) pts
   where
      score = sort pts !! (k-1)

parse h = do
   [n, k] <- readIntList h
   pts <- mapM (fmap f . readIntList) $ replicate n h
   return (n, k, pts)
   where
      f [a,b] = (-a, b)

-- lib
readIntList = fmap (map read . words) . hGetLine

-- vim: set expandtab:

import List

{-
import HUnit

testOneTeam :: Test
testOneTeam  =  Test "TestOneTeam" $
    assertEq 1 (solve 1 [(1,1)])

testInput :: Test
testInput  =  TestList "TestInput"
    [Test "1" $
        assertEq 3 (solve 2 [(4,10),(4,10),(4,10),(3,20),(2,1),(2,1),(1,10)]),
     Test "2" $
        assertEq 4 (solve 4 [(3,1),(3,1),(5,2),(3,1),(3,1)])
    ]

tests :: Test
tests  =  TestList "Testing ... "
    [testOneTeam,
     testInput
    ]

test :: IO ()
test  =  run tests

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

-}

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

readPair :: Read a => IO (a, a)
readPair  =  do
    [x, y]  <-  Main.reads
    return (x, y)

solve :: Int -> [(Int, Int)] -> Int
solve k xs  =  length (filter (== xk) xs)
  where
    xk  =  (sortBy compareTeam xs) !! (k-1)
    compareTeam (pa, ta) (pb, tb)
      | pa > pb  =  LT
      | pa < pb  =  GT
      | ta < tb  =  LT
      | ta > tb  =  GT
      | otherwise  =  EQ

main :: IO ()
main  =  do
    [n, k] <- Main.reads
    rankList <- mapM (const readPair) [1..n]
    print $ solve k rankList

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

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

data Team = Team Int Int deriving Eq

instance Ord Team where
    Team a b `compare` Team c d
        | a == c    = compare b d
        | otherwise = compare c a

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

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

solve (k, teams) = length [team | team <- teams, team == kth]
  where
    sorted = sort teams

    kth = sorted !! (k-1)

-- {{{ A minimal State Monad
class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

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

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

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

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

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

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

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

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

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

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

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

state = State
-- }}}

import Data.List
import Data.Ord
import Data.Monoid
import Control.Monad
import Control.Monad.Instances
main = do
  [n,k] <- liftM (map read . words) getLine
  rs <- liftM ( map length . group .
                sortBy (liftM2 mappend (comparing (negate . (!!0)))
                                       (comparing (!!1))) ) $
        replicateM n $
        liftM (map read . words) getLine
  print $ solve rs k
solve (n:ns) i | i <= n    = n
               | otherwise = solve ns (i-n)

import Data.List

main=interact$show.solve.map ((\[x,y]->(-x,y)).map read.words).lines

solve :: [(Int,Int)] -> Int
solve ((_,k):pts) = length.head.filter (((p,t)==).head).group $ xs
   where (p,t) = xs !! (k-1)
         xs = sort pts

module Main where

import Prelude hiding (lookup)
import Data.Array (listArray, (!))
import Data.Map (Map, fromList, lookup)
import Data.List (sortBy, group)
import Control.Monad (replicateM)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

readNumbers :: IO [Int]
readNumbers =
 (fromJust
  . fmap (map fst)
  . sequence
  . map BS.readInt
  . BS.words) `fmap` BS.getLine

flipOrdering LT = GT
flipOrdering EQ = EQ
flipOrdering GT = LT

calcScoreGroupings :: [(Int, Int)] -> Map (Int, Int) Int
calcScoreGroupings =
  fromList .
  map (\groups -> (head groups, length groups)) .
  group

main :: IO ()
main = do
  (n:k:_) <- readNumbers
  -- negative to keep reverse ordering
  -- lower problems means lower score
  -- lower timing means greater score
  scoreList0 <- fmap (sortBy (\(i1, t1) (i2, t2) ->
                               compare (-i1 * 1000 + t1)
                                       (-i2 * 1000 + t2)) .
                      map (\(a:b:_) -> (a,b)))
                     (replicateM n readNumbers)

  let scoreGroupings = calcScoreGroupings scoreList0
      scoreListArray = listArray (1, n) scoreList0

  print (fromJust
         (lookup (scoreListArray ! k)
                  scoreGroupings))

import Data.List

parse :: String -> [(Int, Int)]
parse stuff =
    map parse_line (lines stuff)
    where parse_line l = t2 $ map (read::String->Int) (words l)
          t2 [a, b] = (a, b)
          t2 _ = error "unexpected input"

solve :: [(Int, Int)] -> Int
solve ((_, k):teams) = findKth k sorted
    where
      sorted = reverse . group . sort $ teams
      findKth _ [] = 0
      findKth k (x:xs)
          | length x >= k = length x
          | otherwise     = findKth (k - length x) xs
      -- findKth _ _ = 0

main = do
  stuff <- getContents
  print . solve $ parse stuff

import Data.List

parse :: String -> [(Int, Int)]
parse stuff =
    map parse_line (lines stuff)
    where parse_line l = t2 $ map (read::String->Int) (words l)
          t2 [a, b] = (a, b)
          t2 _ = error "unexpected input"

solve :: [(Int, Int)] -> Int
solve ((_, k):teams) = findKth k sorted
    where
      sorted = reverse . group . sort $ teams
      findKth _ [] = 0
      findKth k (x:xs)
          | length x > k = length x
          | otherwise     = findKth (k - length x) xs
      -- findKth _ _ = 0

main = do
  stuff <- getContents
  print . solve $ parse stuff

import Data.List
import Control.Applicative
readi = read::String->Int
getParams = map readi . words <$> getLine
getDesc = zip' . map readi . words <$> getContents
  where zip' [] = []
        zip' (x:y:xs) = (x,y):zip' xs
sort' = sortBy (\(a,b) (a', b') -> if a == b then compare b a
                                   else compare a' b')
solve k (x:xs)
  | y <= 0 = length x
  | otherwise = solve y xs
  where y = k - (length x)
main=do
  [_,k] <- getParams
  rsorted <- sort' <$> getDesc
  putStrLn $ show ((solve k).group $ rsorted)

import Data.List
import Control.Applicative
readi = read::String->Int
getParams = map readi . words <$> getLine
getDesc = zip' . map readi . words <$> getContents
  where zip' [] = []
        zip' (x:y:xs) = (x,y):zip' xs
solve k (x:xs)
  | y <= 0 = length x
  | otherwise = solve y xs
  where y = k - (length x)
main=do
  [_,k] <- getParams
  sorted <- sort <$> getDesc
  putStrLn $ show ((solve k).reverse.group $ sorted)

module Main where

import Prelude hiding (lookup)
import Data.Array (listArray, (!))
import Data.Map (Map, fromList, lookup)
import Data.List (sortBy, group)
import Control.Monad (replicateM)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

readNumbers :: IO [Int]
readNumbers =
 (fromJust
  . fmap (map fst)
  . sequence
  . map BS.readInt
  . BS.words) `fmap` BS.getLine

flipOrdering LT = GT
flipOrdering EQ = EQ
flipOrdering GT = LT

calcScoreGroupings :: [(Int, Int)] -> Map (Int, Int) Int
calcScoreGroupings =
  fromList .
  map (\groups -> (head groups, length groups)) .
  group

main :: IO ()
main = do
  (n:k:_) <- readNumbers
  scoreList0 <- fmap (sortBy (\a b -> flipOrdering $ compare a b) .
                      map (\(a:b:_) -> (a,b)))
                     (replicateM n readNumbers)

  let scoreGroupings = calcScoreGroupings scoreList0
      scoreListArray = listArray (1, n) scoreList0

  print (fromJust (lookup (scoreListArray ! k) scoreGroupings))

import Data.List
s([_,k]:t)=[q|x<-map length.group.sort$map(\[a,b]->(-a,b))t,q<-replicate x x]!!(k+1)
main=interact$show.s.map(map read.words).lines


Having written another programming contest, three Rabbits decided to grab some lunch. The coach gave the team exactly k time units for the lunch break.The Rabbits have a list of n restaurants to lunch in: the i-th restaurant is characterized by two integers fi and ti. Value ti shows the time the Rabbits need to lunch in the i-th restaurant. If time ti exceeds the time k that the coach has given for the lunch break, then the Rabbits' joy from lunching in this restaurant will equal fi - (ti - k). Otherwise, the Rabbits get exactly fi units of joy.Your task is to find the value of the maximum joy the Rabbits can get from the lunch, depending on the restaurant. The Rabbits must choose exactly one restaurant to lunch in. Note that the joy value isn't necessarily a positive value.

The first line contains two space-separated integers — n (1 ≤ n ≤ 104) and k (1 ≤ k ≤ 109) — the number of restaurants in the Rabbits' list and the time the coach has given them to lunch, correspondingly. Each of the next n lines contains two space-separated integers — fi (1 ≤ fi ≤ 109) and ti (1 ≤ ti ≤ 109) — the characteristics of the i-th restaurant.

In a single line print a single integer — the maximum joy value that the Rabbits will get from the lunch.

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

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

main :: IO ()
main = do
  (_:k:a) <- map (fst . fromJust . C.readInt) <$> C.words <$> C.getContents
  print $ maximum $ [f - max 0 (t - k) | (f, t) <- pairs a]

{-# 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, k] <- getInts
  os <- replicateM n getInts

  print $ maximum $ map (\[f, t] -> if t >= k then f - (t-k) else f) os

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

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

solve :: Int -> [[Int]] -> Int
solve k xs  =  maximum $ map (\[f, t] -> if t > k then f - (t - k) else f) xs

main :: IO ()
main  =  do
    [n, k]  <-  reads
    xs  <-  replicateM n reads
    print $ solve k xs

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

process::Integer->Integer->[[String]]->String
process x n [] = (show x) ++ " " ++ (show n)
process x n ((a:b:[]):cs) | a=="+" = process (x+bb) n cs
                          | bb<= x = process (x-bb) n cs
                          | otherwise = process x (n+1) cs
      where bb = read b ::Integer

main = do
   [a,k]<-map read <$> words <$> getLine ::IO [Int]
   d<- map (map read) <$> map words <$> lines <$> getContents ::IO [[Int]]
   print $ maximum $ map (\[z1,z2]-> z1 - (if z2>k then z2-k else 0)) d

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

main = do
  [n, k] <- getList
  a <- replicateM n getList
  let b = map (\[f, t] -> if t > k then f-(t-k) else f) a
  print $ maximum b
  where
    getList = fmap (map read . words) getLine

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

solve :: [[Integer]] -> Integer
solve ([_, k] : fts) = maximum [ f - max 0 (t - k) | [ f, t ] <- fts ]
solve _ = undefined

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

solve :: [[Integer]] -> Integer
solve ([_, k] : fts) = maximum [ if t > k then f - (t - k) else f | [ f, t ] <- fts ]
solve _ = undefined

main = interact $ show . solve . parse . map read . tail . words
parse (n:xs) = (n,pairs xs) where
  pairs (a:b:xs) = (a,b) : pairs xs
  pairs [] = []
solve (k,ps) = maximum $ map g ps where
  g (f,t) = f - max 0 (t-k)

import Control.Monad
main = do
    s <- getLine
    let [n, k] = map read $ words s
    restaurants <- forM [1..n] (\_ -> do
        s_i <- getLine
        let [f, t] = map read $ words s_i
        return (f, t))
    print . maximum . satisfactions k $ restaurants

satisfactions :: Int -> [(Int, Int)] -> [Int]
satisfactions k = foldl (\acc (f, t) -> (if t > k then (f - (t - k)) else f) : acc) []

main=interact$show.f.map read.words
f :: [Integer] -> Integer
f(n:k:fts) = maximum $ g fts
   where
     g (f:t:xs) = if t > k then (f - (t - k)) : g xs
                           else f : g xs
     g _ = []

module Main where

satisfaction :: Int -> [Int] -> Int
{- satisfaction TimeLimit RestaurantParams -}
satisfaction limit params = let [sat, time] = params
                            in
                            if time > limit then sat - time + limit else sat

main = do
  paramStr <- getLine
  restaurantsStr <- getContents
  let [_, timeLimit] = map read $ words paramStr
      restaurants = (map (map read . words)) $ lines restaurantsStr
  print $ maximum $ map (satisfaction timeLimit) restaurants

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

main= do
	[n,m]<- map read .words <$> getLine::IO [Int]
	s<- map (map read). map words. lines <$> getContents ::IO [[Int]]
	print $ maximum $ map (\[a, b]-> if b<=m then a else a+m-b) s

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

main :: IO ()
main = do
	line1 <- getLine
	content <- getContents
	let
		[n, k] = map (\x -> read x :: Integer). words $ line1
		arr =  map (\[x, y] -> (read x :: Integer, read y :: Integer) ). map words. lines $ content
		solve [] = []
		solve ((f, t): xs)
		 | t > k = (f - t + k) : solve (xs)
		 | otherwise = f : solve (xs)
--	print content
--	print arr
	print $ maximum. solve $ arr

import qualified Data.ByteString.Char8 as B

readInt bs = case B.readInt bs of Just (n,_) -> n
main = B.getContents >>= putStr . show . solve . map readInt . B.words

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

solve (n:k:fts) = maximum . map eat . pairs $ fts
    where
        eat (f, t)
            | t > k = f - (t - k)
            | otherwise = f

module Main where

solve :: [Int] -> Int
solve (_ : timeLimit : restaurants) = maximum $ map pleasure (makePairs restaurants)
    where pleasure (rating, realTime) = rating - max 0 (realTime - timeLimit)
          makePairs [] = []
          makePairs (x:y:ys) = (x, y) : (makePairs ys)

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

import Data.List
import Control.Applicative
import Data.Function
main = do
    [n,k] <- map read . words <$> getLine
    rs <- partition (\[f,t] -> t <= k) . map (map read . words) . take n . lines <$> getContents
    case fst rs of
        [] -> print $ maximum $ map (\[f,t] -> f + k - t) $ snd $ rs
        lst -> case snd rs of
                [] -> print $ maximum $ map head $ lst
                lst' -> print$max (maximum $ map head $ lst) $ (maximum $ map (\[f,t] -> f + k - t) $ snd $ rs)

import Data.List
import Control.Applicative
import Data.Function
main = do
    [n,k] <- map read . words <$> getLine
    rs <- partition (\[f,t] -> t <= k) . map (map read . words) . take n . lines <$> getContents
    case fst rs of
        [] -> print $ maximum $ map (\[f,t] -> f + k - t) $ snd $ rs
        lst -> print $ maximum $ map head $ lst

import Data.List
import Control.Applicative
import Data.Function
main = do
    [n,k] <- map read . words <$> getLine
    rs <- partition (\[f,t] -> t <= k) . map (map read . words) . take n . lines <$> getContents
    case fst rs of
        [] -> print $ minimum $ map (\[f,t] -> f + k - t) $ snd $ rs
        lst -> print $ maximum $ map head $ lst


Little Dima has two sequences of points with integer coordinates: sequence (a1, 1), (a2, 2), ..., (an, n) and sequence (b1, 1), (b2, 2), ..., (bn, n).Now Dima wants to count the number of distinct sequences of points of length 2·n that can be assembled from these sequences, such that the x-coordinates of points in the assembled sequence will not decrease. Help him with that. Note that each element of the initial sequences should be used exactly once in the assembled sequence.Dima considers two assembled sequences (p1, q1), (p2, q2), ..., (p2·n, q2·n) and (x1, y1), (x2, y2), ..., (x2·n, y2·n) distinct, if there is such i (1 ≤ i ≤ 2·n), that (pi, qi) ≠ (xi, yi).As the answer can be rather large, print the remainder from dividing the answer by number m.

The first line contains integer n (1 ≤ n ≤ 105). The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 109). The third line contains n integers b1, b2, ..., bn (1 ≤ bi ≤ 109). The numbers in the lines are separated by spaces. The last line contains integer m (2 ≤ m ≤ 109 + 7).

In the single line print the remainder after dividing the answer to the problem by number m.

NoteIn the first sample you can get only one sequence: (1, 1), (2, 1). In the second sample you can get such sequences : (1, 1), (2, 2), (2, 1), (3, 2); (1, 1), (2, 1), (2, 2), (3, 2). Thus, the answer is 2.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Function
import Data.List
readInt bs = case B.readInt bs of Just (n,_) -> n
main = do
  n <- readLn :: IO Int
  xs <- fmap ((`zip`[1..]).map readInt.B.words)B.getLine
  ys <- fmap ((`zip`[1..]).map readInt.B.words)B.getLine
  m <- readLn
  print $ solve m $ map(map snd) $ groupBy ((==)`on`fst) $ sort $ xs ++ ys

solve :: Integer -> [[Int]] -> Integer
solve m iss = productMod $ map (len 0 0) iss
   where
     productMod xs = foldl' (\x y->x*y`rem`m) 1 xs
     len !cnt !l (x:y:xs)
       | x==y = len (cnt+1) (l+2) xs
       | otherwise = len cnt (l+1) (y:xs)
     len cnt l [x] = productMod (div2 cnt [1..l+1])
     len cnt l [] = productMod (div2 cnt [1..l])
     div2 0 xs = xs
     div2 !cnt (x:y:xs) = x : y`quot`2 : div2 (cnt-1) xs


Ashish has $$$n$$$ elements arranged in a line. These elements are represented by two integers $$$a_i$$$ — the value of the element and $$$b_i$$$ — the type of the element (there are only two possible types: $$$0$$$ and $$$1$$$). He wants to sort the elements in non-decreasing values of $$$a_i$$$.He can perform the following operation any number of times:  Select any two elements $$$i$$$ and $$$j$$$ such that $$$b_i \ne b_j$$$ and swap them. That is, he can only swap two elements of different types in one move. Tell him if he can sort the elements in non-decreasing values of $$$a_i$$$ after performing any number of operations.

The first line contains one integer $$$t$$$ $$$(1 \le t \le 100)$$$ — the number of test cases. The description of the test cases follows. The first line of each test case contains one integer $$$n$$$ $$$(1 \le n \le 500)$$$ — the size of the arrays. The second line contains $$$n$$$ integers $$$a_i$$$ $$$(1 \le a_i \le 10^5)$$$  — the value of the $$$i$$$-th element. The third line containts $$$n$$$ integers $$$b_i$$$ $$$(b_i \in \{0, 1\})$$$  — the type of the $$$i$$$-th element.

For each test case, print "Yes" or "No" (without quotes) depending on whether it is possible to sort elements in non-decreasing order of their value. You may print each letter in any case (upper or lower).

NoteFor the first case: The elements are already in sorted order.For the second case: Ashish may first swap elements at positions $$$1$$$ and $$$2$$$, then swap elements at positions $$$2$$$ and $$$3$$$.For the third case: The elements are already in sorted order.For the fourth case: No swap operations may be performed as there is no pair of elements $$$i$$$ and $$$j$$$ such that $$$b_i \ne b_j$$$. The elements cannot be sorted.For the fifth case: Ashish may swap elements at positions $$$3$$$ and $$$4$$$, then elements at positions $$$1$$$ and $$$2$$$.

{-# LANGUAGE BlockArguments #-}

import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.List

main = do
  [t] <- getInts
  replicateM_ t do
    [n] <- getInts
    a <- getInts
    b <- getInts
    let result = sorted a || (elem 0 b && elem 1 b)
    putStrLn if result then "Yes" else "No"
    where
    sorted xs = all id  $ zipWith (<=) xs (tail xs)

getInts :: IO [Int]
getInts = go <$> BS.getLine
  where
    go s = case BS.readInt s of
      Nothing -> []
      Just (x, s') -> x : go (BS.drop 1 s')

import Control.Monad
import Data.List

main :: IO()
main = do
  [t] <- readInts
  replicateM_ t setup

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

isType :: Int -> (Int, Int) -> Bool
isType t x = t == (snd x)

setup :: IO()
setup = do
  [n] <- readInts
  a <- readInts
  b <- readInts
  let c = zip a b
  let zeros = filter (isType 0) c
  let ones = filter (isType 1) c
  putStrLn (if solve a zeros ones then "Yes" else "No")

solve :: [Int] -> [(Int, Int)] -> [(Int, Int)] -> Bool
solve a zeros ones
  | length zeros > 0 && length ones > 0 = True
  | otherwise = a == (sort a)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

(|>) = flip ($)

main = do
  input <- getContents
  let _:vals = read <$> split input :: [Int]
      res = vals |> unfoldr (\case
        []  -> Nothing
        n:rest0   ->
          let (subInput, rest1) = splitAt (2*n) rest0
              (vals, types) = splitAt n subInput
              isSorted = all (uncurry (<=)) adjPairs where
                adjPairs = zip vals $ tail vals
              hasBoth = hasZero && hasOne where
                hasZero = any (== 0) types
                hasOne = any (== 1) types
              subRes = if hasBoth || isSorted then "Yes" else "No"
          in Just (subRes, rest1)
        )
  sequence_ $ putStrLn <$> res


Polycarp was dismantling his attic and found an old floppy drive on it. A round disc was inserted into the drive with $$$n$$$ integers written on it.Polycarp wrote the numbers from the disk into the $$$a$$$ array. It turned out that the drive works according to the following algorithm:   the drive takes one positive number $$$x$$$ as input and puts a pointer to the first element of the $$$a$$$ array;  after that, the drive starts rotating the disk, every second moving the pointer to the next element, counting the sum of all the elements that have been under the pointer. Since the disk is round, in the $$$a$$$ array, the last element is again followed by the first one;  as soon as the sum is at least $$$x$$$, the drive will shut down. Polycarp wants to learn more about the operation of the drive, but he has absolutely no free time. So he asked you $$$m$$$ questions. To answer the $$$i$$$-th of them, you need to find how many seconds the drive will work if you give it $$$x_i$$$ as input. Please note that in some cases the drive can work infinitely.For example, if $$$n=3, m=3$$$, $$$a=[1, -3, 4]$$$ and $$$x=[1, 5, 2]$$$, then the answers to the questions are as follows:   the answer to the first query is $$$0$$$ because the drive initially points to the first item and the initial sum is $$$1$$$.  the answer to the second query is $$$6$$$, the drive will spin the disk completely twice and the amount becomes $$$1+(-3)+4+1+(-3)+4+1=5$$$.  the answer to the third query is $$$2$$$, the amount is $$$1+(-3)+4=2$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case consists of two positive integers $$$n$$$, $$$m$$$ ($$$1 \le n, m \le 2 \cdot 10^5$$$) — the number of numbers on the disk and the number of asked questions. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$). The third line of each test case contains $$$m$$$ positive integers $$$x_1, x_2, \ldots, x_m$$$ ($$$1 \le x \le 10^9$$$). It is guaranteed that the sums of $$$n$$$ and $$$m$$$ over all test cases do not exceed $$$2 \cdot 10^5$$$.

Print $$$m$$$ numbers on a separate line for each test case. The $$$i$$$-th number is:    $$$-1$$$ if the drive will run infinitely;  the number of seconds the drive will run, otherwise.

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Exception (assert)
import Control.Monad
import Control.Monad.State
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Bits
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = do
  ~[n, m] <- popInts
  as <- popIntegers
  xs <- popIntegers
  return $ B.unwords $ map bshow $ solve n m as xs

solve n m as0 xs = map calc xs
  where
    a0 = head as0
    as = tail as0 ++ [a0]

    (csum, cmax, cmap) = foldl' foldf (0, 0, Map.empty) $ zip [0..] as

    foldf (s, mx, mp) (i, a) =
      let s' = s + a in
        if s' > mx
        then (s', s', Map.insert s' i mp)
        else (s', mx, mp)

    calc x | x <= a0 = 0
           | x <= a0 + cmax = 1 + calcSteps (x - a0)
           | csum <= 0 = -1
           | otherwise =
               let c = (x - a0 - cmax + csum - 1) `quot` csum in
                 1 + c * (fromIntegral n) + calcSteps (x - a0 - c * csum)

    calcSteps x = snd $ Map.findMin $ Map.dropWhileAntitone (< x) cmap

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.Int
import qualified Data.Map.Strict as M

type SIO = StateT P.ByteString IO

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, _m] <- readInts
    a <- readInts
    let
      sa = tail $ scanl (\x y -> x + fromIntegral y) 0 a
      cycleIncr = last sa
      possibleStops = M.fromAscList $ do
        (i, val, score) <- zip3 [0..] sa $ scanl max minBound sa
        [(val, i) | val > score]
      highestStop = fst $ M.findMax possibleStops
      n64 = fromIntegral n
    x <- map fromIntegral <$> readInts
    putInt64s $ flip map x $ \xi -> case  M.lookupGE xi possibleStops  of
      Just (_, i) -> i
      Nothing -> if  cycleIncr <= 0
        then  0 - 1
        else  let
        wastedCycles = ceilDiv (xi - highestStop) cycleIncr
        nxi = xi - wastedCycles * cycleIncr
        in  case  M.lookupGE nxi possibleStops  of
        Just (_, i) -> wastedCycles * n64 + i
        Nothing     -> error "some arithmetic overflow or mistake?"

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]

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


For the given integer $$$n$$$ ($$$n > 2$$$) let's write down all the strings of length $$$n$$$ which contain $$$n-2$$$ letters 'a' and two letters 'b' in lexicographical (alphabetical) order.Recall that the string $$$s$$$ of length $$$n$$$ is lexicographically less than string $$$t$$$ of length $$$n$$$, if there exists such $$$i$$$ ($$$1 \le i \le n$$$), that $$$s_i < t_i$$$, and for any $$$j$$$ ($$$1 \le j < i$$$) $$$s_j = t_j$$$. The lexicographic comparison of strings is implemented by the operator < in modern programming languages.For example, if $$$n=5$$$ the strings are (the order does matter):  aaabb  aabab  aabba  abaab  ababa  abbaa  baaab  baaba  babaa  bbaaa It is easy to show that such a list of strings will contain exactly $$$\frac{n \cdot (n-1)}{2}$$$ strings.You are given $$$n$$$ ($$$n > 2$$$) and $$$k$$$ ($$$1 \le k \le \frac{n \cdot (n-1)}{2}$$$). Print the $$$k$$$-th string from the list.

The input contains one or more test cases. The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the test. Then $$$t$$$ test cases follow. Each test case is written on the the separate line containing two integers $$$n$$$ and $$$k$$$ ($$$3 \le n \le 10^5, 1 \le k \le \min(2\cdot10^9, \frac{n \cdot (n-1)}{2})$$$. The sum of values $$$n$$$ over all test cases in the test doesn't exceed $$$10^5$$$.

For each test case print the $$$k$$$-th string from the list of all described above strings of length $$$n$$$. Strings in the list are sorted lexicographically (alphabetically).

aaabb
aabab
baaba
bbaaa
abb
bab
aaaaabaaaaabaaaaaaaa

import Control.Arrow

main = interact $
  lines >>> drop 1
  >>> map ((words >>> map read) >>> solve)
  >>> unlines

solve :: [Integer] -> String
solve [n, k] = reverse $ foldl1 (++) $ map copy
  [(j - 1, 'a'), (1, 'b'), (i - j - 1, 'a'), (1, 'b'), (n - i, 'a')]
  where
    copy (n, c)
      | n <= 0 = ""
      | otherwise = take (fromIntegral n) $ repeat c
    c2 v = (v * (v - 1)) `div` 2
    getfirst len rank
      | c2 len < rank = max len $ getfirst (len + 1) rank
      | otherwise = 0
    i = (getfirst 0 k) + 1
    j = k - (c2 (i - 1))

module Main where

import Control.Monad
import Data.List

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, k] <- getIntList
        putStrLn . reverse . get n $ f n k

f :: Int -> Int -> (Int, Int)
f n k =
    let p = head . filter (\x -> k <= cal x) $ [1 .. n - 1]
        q = k - cal (p - 1) - 1
    in (q, p)

cal :: Int -> Int
cal x = case x `mod` 2 of
    0 -> x `div` 2 * (x + 1)
    1 -> (x + 1) `div` 2 * x

get :: Int -> (Int, Int) -> String
get n (p, q) = (replicate p 'a')
               ++ "b"
               ++ (replicate (q - p - 1) 'a')
               ++ "b"
               ++ (replicate (n - q - 1) 'a')

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

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

main = readLn >>= flip replicateM_ solveIO

solveIO = do
    [n,k] <- getList
    putStrLn $ solve n k

solve :: Integer -> Integer -> String
solve 2 _ = "bb"
solve n k | k <= (n-1)*(n-2) `div` 2 = 'a' : solve (n-1) k
          | otherwise = let p = k - (n-1)*(n-2) `div` 2 - 1; q = n - 2 - p
                in "b" ++ genericReplicate q 'a' ++ "b" ++ genericReplicate p 'a'

import Data.Maybe
import Control.Monad

work :: IO ()
work = do
  [n, k] <- map read . words <$> getLine
  let a = head $ filter (\x -> (1 + x) * x `div` 2 >= k) [1 .. ]
      b = k - (a - 1) * a `div` 2 - 1
  putStrLn [let i = n - j in if i == a || i == b then 'b' else 'a' | j <- [1 .. n]]

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

import Control.Monad

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        [n, k] <- map read . words <$> getLine
        let i1' = getidx 1 k
        let i2 = k - div (i1'*(i1'-1)) 2
        let i1 = i1' + 1
        putStrLn $
            replicate (fromInteger $ n - i1) 'a' ++
            "b" ++
            replicate (fromInteger $ i1 - i2 - 1) 'a' ++
            "b" ++
            replicate (fromInteger $ i2 - 1) 'a'

getidx :: Integer -> Integer -> Integer
getidx n k =
    if k <= n then
        n
    else
        getidx (n + 1) (k - n)

convertToString :: Int -> (Int,Int) -> String
convertToString l (b1,b2) = (replicate b1 'a')++"b"++(replicate (b2-b1-1) 'a')++"b"++(replicate (l-b2-1) 'a')

nextString :: Int -> Int -> (Int,Int) -> (Int,Int)
nextString 1 _ found = found
nextString k l (lfirstB,lsecondB) = if (lsecondB-lfirstB)==1
                                       then nextString (k-1) l (lfirstB-1,l-1)
                                       else nextString (k-d) l (lfirstB,lsecondB-d)
                                           where diff = (lsecondB-lfirstB-1)
                                                 d = if diff > (k-1)
                                                        then (k-1)
                                                        else diff

kthString :: [Int] -> String
kthString (n:k:[]) = convertToString n $ nextString k n (n-2,n-1)

main :: IO()
main = do
    interact $ unlines . map (kthString . (map read) . words) . tail . lines

import Data.List
import Data.Word

main :: IO ()
main = do
    getLine
    answers <- map (solve . map read . words) <$> lines <$> getContents :: IO [String]
    mapM_ putStrLn answers

solve :: [Word64] -> String
solve [c,d] = intercalate "b" [genrep a1 'a', genrep a2 'a' , genrep a3 'a' ]
    where
        (a2,a1) = f d' (c-1) 0
        total = c*(c-1) `div` 2
        d' = total - d
        a3 = c - a1 - a2 - 2
        genrep = genericReplicate

f :: Word64 -> Word64 -> Word64 -> (Word64, Word64)
f d c i
    | d < c = (d,i)
    | otherwise = f (d-c) (c-1) (i+1)

import Control.Monad (replicateM_)

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

main = readLn >>= flip replicateM_ solveIO

solveIO = do
    [n,k] <- getList
    putStrLn $ solve n k

solve :: Int -> Int -> String
solve 2 _ = "bb"
solve n k | k <= (n-1)*(n-2) `div` 2 = 'a' : solve (n-1) k
          | otherwise = let p = k - (n-1)*(n-2) `div` 2 - 1; q = n - 2 - p
                in "b" ++ replicate q 'a' ++ "b" ++ replicate p 'a'

import Control.Monad

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        [n, k] <- map read . words <$> getLine
        let i1' = getidx 1 k
        let i2 = k - div (i1'*(i1'-1)) 2
        let i1 = i1' + 1
        putStrLn $
            replicate (n - i1) 'a' ++
            "b" ++
            replicate (i1 - i2 - 1) 'a' ++
            "b" ++
            replicate (i2 - 1) 'a'

getidx n k =
    if k <= n then
        n
    else
        getidx (n + 1) (k - n)


You are given an array of $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$You can apply the following operation an arbitrary number of times:   select an index $$$i$$$ ($$$1 \le i \le n$$$) and replace the value of the element $$$a_i$$$ with the value $$$a_i + (a_i \bmod 10)$$$, where $$$a_i \bmod 10$$$ is the remainder of the integer dividing $$$a_i$$$ by $$$10$$$. For a single index (value $$$i$$$), this operation can be applied multiple times. If the operation is applied repeatedly to the same index, then the current value of $$$a_i$$$ is taken into account each time. For example, if $$$a_i=47$$$ then after the first operation we get $$$a_i=47+7=54$$$, and after the second operation we get $$$a_i=54+4=58$$$.Check if it is possible to make all array elements equal by applying multiple (possibly zero) operations.For example, you have an array $$$[6, 11]$$$.   Let's apply this operation to the first element of the array. Let's replace $$$a_1 = 6$$$ with $$$a_1 + (a_1 \bmod 10) = 6 + (6 \bmod 10) = 6 + 6 = 12$$$. We get the array $$$[12, 11]$$$.  Then apply this operation to the second element of the array. Let's replace $$$a_2 = 11$$$ with $$$a_2 + (a_2 \bmod 10) = 11 + (11 \bmod 10) = 11 + 1 = 12$$$. We get the array $$$[12, 12]$$$. Thus, by applying $$$2$$$ operations, you can make all elements of an array equal.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. What follows is a description of each test case. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the size of the array. The second line of each test case contains $$$n$$$ integers $$$a_i$$$ ($$$0 \le a_i \le 10^9$$$) — array elements. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case print:   YES if it is possible to make all array elements equal;  NO otherwise.  You can print YES and NO in any case (for example, the strings yEs, yes, Yes and YES will be recognized as a positive answer) .

NoteThe first test case is clarified above.In the second test case, it is impossible to make all array elements equal.In the third test case, you need to apply this operation once to all elements equal to $$$5$$$.In the fourth test case, you need to apply this operation to all elements until they become equal to $$$8$$$.In the fifth test case, it is impossible to make all array elements equal.In the sixth test case, you need to apply this operation to all elements until they become equal to $$$102$$$.

import Control.Monad.Cont (forM)
data NumClass = FiveZero | Other deriving (Eq)

main :: IO ()
main = do
    res <- map solveCase <$> parse
    putStr $ unlines $ map output res

parse :: IO [[Int]]
parse = do
    n <- read <$> getLine
    forM [1..n] $ \_ -> do
        _ <- getLine
        map read . words <$> getLine

getClass :: Int -> NumClass
getClass number
    | number `mod` 5 == 0 = FiveZero
    | otherwise = Other

addMod10 :: Int -> Int
addMod10 number = number + number `mod` 10

-- make sure number ends in either 0 or 2 for the two number classes
normalize :: Int -> Int
normalize number
    | number `mod` 10 == 0 || number `mod` 10 == 2 = number
    | otherwise = normalize $ addMod10 number

-- all equal after possible +5 done
checkFiveZeros :: [Int] -> Bool
checkFiveZeros numbers =
    let normalized = map normalize numbers
    in and $ zipWith (==) normalized (tail normalized)

-- all differences are divisible by 20 after normalizing
checkOthers :: [Int] -> Bool
checkOthers numbers =
    let normalized = map normalize numbers
    in and $ zipWith (\a b -> abs(a - b) `mod` 20 == 0) normalized (tail normalized)

sameClass :: [Int] -> Bool
sameClass numbers = and $ zipWith (\a b -> getClass a == getClass b) numbers (tail numbers)

solveCase :: [Int] -> Bool
solveCase numbers
    | not $ sameClass numbers = False
    | getClass (head numbers) == FiveZero = checkFiveZeros numbers
    | otherwise = checkOthers numbers

output :: Bool -> String
output b = if b then "yes" else "no"


There are $$$n$$$ products in the shop. The price of the $$$i$$$-th product is $$$a_i$$$. The owner of the shop wants to equalize the prices of all products. However, he wants to change prices smoothly.In fact, the owner of the shop can change the price of some product $$$i$$$ in such a way that the difference between the old price of this product $$$a_i$$$ and the new price $$$b_i$$$ is at most $$$k$$$. In other words, the condition $$$|a_i - b_i| \le k$$$ should be satisfied ($$$|x|$$$ is the absolute value of $$$x$$$).He can change the price for each product not more than once. Note that he can leave the old prices for some products. The new price $$$b_i$$$ of each product $$$i$$$ should be positive (i.e. $$$b_i > 0$$$ should be satisfied for all $$$i$$$ from $$$1$$$ to $$$n$$$).Your task is to find out the maximum possible equal price $$$B$$$ of all productts with the restriction that for all products the condiion $$$|a_i - B| \le k$$$ should be satisfied (where $$$a_i$$$ is the old price of the product and $$$B$$$ is the same new price of all products) or report that it is impossible to find such price $$$B$$$.Note that the chosen price $$$B$$$ should be integer.You should answer $$$q$$$ independent queries.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 100$$$) — the number of queries. Each query is presented by two lines. The first line of the query contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 100, 1 \le k \le 10^8$$$) — the number of products and the value $$$k$$$. The second line of the query contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^8$$$), where $$$a_i$$$ is the price of the $$$i$$$-th product.

Print $$$q$$$ integers, where the $$$i$$$-th integer is the answer $$$B$$$ on the $$$i$$$-th query. If it is impossible to equalize prices of all given products with restriction that for all products the condition $$$|a_i - B| \le k$$$ should be satisfied (where $$$a_i$$$ is the old price of the product and $$$B$$$ is the new equal price of all products), print -1. Otherwise print the maximum possible equal price of all products.

NoteIn the first example query you can choose the price $$$B=2$$$. It is easy to see that the difference between each old price and each new price $$$B=2$$$ is no more than $$$1$$$.In the second example query you can choose the price $$$B=6$$$ and then all the differences between old and new price $$$B=6$$$ will be no more than $$$2$$$.In the third example query you cannot choose any suitable price $$$B$$$. For any value $$$B$$$ at least one condition out of two will be violated: $$$|1-B| \le 2$$$, $$$|6-B| \le 2$$$.In the fourth example query all values $$$B$$$ between $$$1$$$ and $$$7$$$ are valid. But the maximum is $$$7$$$, so it's the answer.

readInt :: String -> Int
readInt = read

main = interact $ solve . (map ((map readInt) . words)) . tail . lines

solve :: [[Int]] -> String
solve [] = ""
solve ([n, k]:a:rest) = (solveInstance [n, k] a) ++ solve rest

validRange :: (Int, Int) -> Bool
validRange (a, b) = a <= b

maxElem :: (Int, Int) -> Int
maxElem (a, b) | validRange (a, b) = b
               | otherwise = -1

solveInstance :: [Int] -> [Int] -> String
solveInstance [_, k] a =
    let ranges = (map (\x -> (max 1 (x-k), x+k)) a) in
    let range = foldl (\(a, b) (c, d) -> (max a c, min b d)) (head ranges) ranges in
    ((++"\n") . show . maxElem) range

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

output as k =
  let
    small = minimum as
    large = maximum as
  in if large - small > 2 * k
  then print $ -1
  else print $ small + k

inspect 0 = putStr ""
inspect n = do
  line <- getLine
  let _:k:_ = map read $ words line
  line2 <- getLine
  let as = map read $ words line2
  output as k
  inspect $ n - 1

main = do
  line <- getLine
  inspect $ read line

import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    [n,k] <- map read . words <$> getLine
    as <- map read . words <$> getLine
    let m = minimum as
    print $ if maximum as - m > 2*k then -1
            else m + k


A long time ago in some far country lived king Copa. After the recent king's reform, he got so large powers that started to keep the books by himself.The total income A of his kingdom during 0-th year is known, as well as the total income B during n-th year (these numbers can be negative — it means that there was a loss in the correspondent year). King wants to show financial stability. To do this, he needs to find common coefficient X — the coefficient of income growth during one year. This coefficient should satisfy the equation:A·Xn = B.Surely, the king is not going to do this job by himself, and demands you to find such number X.It is necessary to point out that the fractional numbers are not used in kingdom's economy. That's why all input numbers as well as coefficient X must be integers. The number X may be zero or negative.

The input contains three integers A, B, n (|A|, |B| ≤ 1000, 1 ≤ n ≤ 10).

Output the required integer coefficient X, or «No solution», if such a coefficient does not exist or it is fractional. If there are several possible solutions, output any of them.

main = do
	[a, b, n] <- fmap (map read . words) getLine
	putStrLn $ last $ "No solution" : [show x | x <- [-1000 .. 1000], a * x ^ n == b]

module Main where

import Control.Monad
import Data.Maybe

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

    putStrLn $ maybe "No solution" show $ do
        if a == 0
            then if b == 0
                then return 1
                else fail ""
            else do
                if b `mod` a == 0
                    then return ()
                    else fail ""

                let b' = abs $ b `div` a
                    sign = b `div` a < 0
                    x = round $ ( fromIntegral b' ) ** ( 1 / fromIntegral n )

                if sign && even n
                    then fail ""
                    else return ()

                if x ^ n == b'
                    then return ()
                    else fail ""

                if sign
                    then return (-x)
                    else return x

import Maybe (listToMaybe)

solve :: Integer -> Integer -> Integer -> Maybe Integer
solve a b n  =  listToMaybe $ [x | x <- [-1000 .. 1000], a * x^n == b]

main :: IO ()
main  =  do
    [a, b, n]  <-  fmap (map read . words) getLine
    putStrLn $ maybe "No solution" show $ solve a b n

findAllBases target exponent = filter (\x -> x ^ exponent == target) [minBound..maxBound]
    where minBound = min (-target) target
          maxBound = max target (-target)

findBase target exponent = if (length solutions == 0) then "No solution" else show (head solutions)
    where solutions = findAllBases target exponent

solve _ 0 _ = "0"
solve 0 _ _ = "No solution"
solve a b n | (mod b a) /= 0 = "No solution"
            | otherwise = findBase (div b a) n

main = do
       inputLine <- getLine
       let tmp = words inputLine
       let a = read (tmp !! 0) :: Int
       let b = read (tmp !! 1) :: Int
       let n = read (tmp !! 2) :: Int
       putStrLn (solve a b n)

import Control.Applicative

solve a b n = map fst $ filter ((==b).snd) [(x, a*(x^n)) | x <- [-1500..1500]]

ints = map read . words <$> getLine

main = do
    [a, b, n] <- ints
    case solve a b n of
        x:xs -> print x
        []   -> putStrLn "No solution"

import Data.Maybe (listToMaybe)
import Control.Applicative ((<|>))

main :: IO ()
main = getContents >>= putStrLn . maybe "No solution" show . (\[ a, b, x ] -> solve a b x) . map read . words

solve :: Integer -> Integer -> Integer -> Maybe Integer
solve a b n = listToMaybe [ 1 | a == 0 && b == 0 ] <|> listToMaybe [ x | a /= 0 && a * x ^ n == b ]
  where x = signum (a * b) * round (exp (log (abs $ fromIntegral $ b `div` a) / fromIntegral n) :: Double)

import Data.Maybe (listToMaybe)

main :: IO ()
main = getContents >>= putStrLn . maybe "No solution" show . (\[ a, b, x ] -> solve a b x) . map read . words

solve :: Integer -> Integer -> Integer -> Maybe Integer
solve a b n = listToMaybe [ x | x <- [-1000..1000], a * x ^ n == b ]

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

main :: IO ()
main = do
  a : b : n :_ <- map read . words <$> getLine
  case [x | x <- [-1000 .. 1000], a * x ^ n == b] of
    x : _ -> print x
    _     -> putStrLn "No solution"

main = interact (ans)
a x = read((words x)!!0)::Integer
b x = read((words x)!!1)::Integer
n x = read((words x)!!2)::Integer
sol x=[y|y<-[1000,999..(-1000)], a x*y^n x==b x]
tmp []="No solution"
tmp xs=show(head xs)
ans x = tmp(sol(x))

import Maybe (listToMaybe)

solve :: Int -> Int -> Int -> Maybe Int
solve a b n  =  listToMaybe $ [x | x <- [-1000 .. 1000], a * x^n == b]

main :: IO ()
main  =  do
    [a, b, n]  <-  fmap (map read . words) getLine
    putStrLn $ maybe "No solution" show $ solve a b n

import Control.Applicative

solve a b n = map fst $ filter ((==b).snd) [(x, a*x^n) | x <- [-1000..1000]]

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

main = do
    [a, b, n] <- ints
    case solve a b n of
        x:xs -> print x
        []   -> putStrLn "No solution"


You are given the strings $$$a$$$ and $$$b$$$, consisting of lowercase Latin letters. You can do any number of the following operations in any order:   if $$$|a| > 0$$$ (the length of the string $$$a$$$ is greater than zero), delete the first character of the string $$$a$$$, that is, replace $$$a$$$ with $$$a_2 a_3 \ldots a_n$$$;  if $$$|a| > 0$$$, delete the last character of the string $$$a$$$, that is, replace $$$a$$$ with $$$a_1 a_2 \ldots a_{n-1}$$$;  if $$$|b| > 0$$$ (the length of the string $$$b$$$ is greater than zero), delete the first character of the string $$$b$$$, that is, replace $$$b$$$ with $$$b_2 b_3 \ldots b_n$$$;  if $$$|b| > 0$$$, delete the last character of the string $$$b$$$, that is, replace $$$b$$$ with $$$b_1 b_2 \ldots b_{n-1}$$$. Note that after each of the operations, the string $$$a$$$ or $$$b$$$ may become empty.For example, if $$$a=$$$"hello" and $$$b=$$$"icpc", then you can apply the following sequence of operations:   delete the first character of the string $$$a$$$ $$$\Rightarrow$$$ $$$a=$$$"ello" and $$$b=$$$"icpc";  delete the first character of the string $$$b$$$ $$$\Rightarrow$$$ $$$a=$$$"ello" and $$$b=$$$"cpc";  delete the first character of the string $$$b$$$ $$$\Rightarrow$$$ $$$a=$$$"ello" and $$$b=$$$"pc";  delete the last character of the string $$$a$$$ $$$\Rightarrow$$$ $$$a=$$$"ell" and $$$b=$$$"pc";  delete the last character of the string $$$b$$$ $$$\Rightarrow$$$ $$$a=$$$"ell" and $$$b=$$$"p". For the given strings $$$a$$$ and $$$b$$$, find the minimum number of operations for which you can make the strings $$$a$$$ and $$$b$$$ equal. Note that empty strings are also equal.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$). Then $$$t$$$ test cases follow. The first line of each test case contains the string $$$a$$$ ($$$1 \le |a| \le 20$$$), consisting of lowercase Latin letters. The second line of each test case contains the string $$$b$$$ ($$$1 \le |b| \le 20$$$), consisting of lowercase Latin letters.

For each test case, output the minimum number of operations that can make the strings $$$a$$$ and $$$b$$$ equal.

5
a
a
abcd
bc
hello
codeforces
hello
helo
dhjakjsnasjhfksafasd
adjsnasjhfksvdafdser

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust, fromMaybe)
import Data.List (inits, tails)

main :: IO ()
main = C.interact $ runScanner (numberOf (C.pack <$> testCase)) >>> C.unlines

testCase :: Scanner String
testCase = show <$> (compute <$> string <*> string)

substrings :: [a] -> [[a]]
substrings = tail . inits <=< tails

compute :: String -> String -> Int
compute a b = length a + length b - 2 * foldl max 0 [length s | s <- substrings a, t <- substrings b, s == t]

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L
import Data.Bits((.&.), (.|.), xor)
import Data.Maybe

data Trie = Trie (M.Map Char Trie)

makeTrieWith :: String -> [String] -> Trie
makeTrieWith alpha str = Trie $ M.fromList $ alpha >>= \a-> case [xs | x:xs <- str , x == a] of
	s@(_:_) -> [(a, makeTrieWith alpha s)]
	[] -> []

lazyTrie str = makeTrieWith "azertyuiopqsdfghjklmwxcvbn" $ suffixes str
suffixes [] = [[]]
suffixes (x:xs) = (x:xs) : suffixes xs

result a b = (length a) + (length b) - 2 * val where
	treeA = lazyTrie a
	treeB = lazyTrie b

	aux0 (Trie t1) (Trie t2) = if null t3 then 0 else 1 + foldr max 0 t3 where
		t3 = M.intersectionWith aux0 t1 t2

	val = aux0 treeA treeB

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		a <- getLine
		b <- getLine
		print $ result a b
		loop $ t - 1
	loop t


You are given a permutation $$$p_1, p_2, \dots, p_n$$$. A permutation of length $$$n$$$ is a sequence such that each integer between $$$1$$$ and $$$n$$$ occurs exactly once in the sequence.Find the number of pairs of indices $$$(l, r)$$$ ($$$1 \le l \le r \le n$$$) such that the value of the median of $$$p_l, p_{l+1}, \dots, p_r$$$ is exactly the given number $$$m$$$.The median of a sequence is the value of the element which is in the middle of the sequence after sorting it in non-decreasing order. If the length of the sequence is even, the left of two middle elements is used.For example, if $$$a=[4, 2, 7, 5]$$$ then its median is $$$4$$$ since after sorting the sequence, it will look like $$$[2, 4, 5, 7]$$$ and the left of two middle elements is equal to $$$4$$$. The median of $$$[7, 1, 2, 9, 6]$$$ equals $$$6$$$ since after sorting, the value $$$6$$$ will be in the middle of the sequence.Write a program to find the number of pairs of indices $$$(l, r)$$$ ($$$1 \le l \le r \le n$$$) such that the value of the median of $$$p_l, p_{l+1}, \dots, p_r$$$ is exactly the given number $$$m$$$.

The first line contains integers $$$n$$$ and $$$m$$$ ($$$1 \le n \le 2\cdot10^5$$$, $$$1 \le m \le n$$$) — the length of the given sequence and the required value of the median. The second line contains a permutation $$$p_1, p_2, \dots, p_n$$$ ($$$1 \le p_i \le n$$$). Each integer between $$$1$$$ and $$$n$$$ occurs in $$$p$$$ exactly once.

NoteIn the first example, the suitable pairs of indices are: $$$(1, 3)$$$, $$$(2, 2)$$$, $$$(2, 3)$$$ and $$$(2, 4)$$$.

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

slice from to xs = take (to - from + 1) (drop from xs)

toint s = (read s) :: Integer

agregar x m = Map.insertWith (+) x 1 m
quitar :: Integer -> (Map.Map Integer Integer) -> (Map.Map Integer Integer)
quitar x m = Map.insertWith (+) x (-1) m

doit [] t m = [t]
doit (x:xs) t m =
    if x > m then
        t:(doit xs (t+1) m)
    else
        t:(doit xs (t-1) m)

doit2 [] w = 0
doit2 (x:xs) w =
    (Map.findWithDefault 0 (1-x) w) + (Map.findWithDefault 0 (-x) w) + doit2 xs w

asdasd [] = Map.fromList []
asdasd (x:xs) = agregar x (asdasd xs)

solve::String -> String
solve ss =
    let sss = Prelude.map toint (tail (words ss)) in
    let (m:s) = sss in
    let k = fromJust $ List.elemIndex m s in
    let w = asdasd (doit (slice (k+1) 2222222 s) 0 m) in
    let t = doit (reverse (slice 0 (k-1) s)) 0 m in
    let r = doit2 t w in
    (show r) ++ "\n"

main = do
  interact $ solve


There is a string s, consisting of capital Latin letters. Let's denote its current length as |s|. During one move it is allowed to apply one of the following operations to it:   INSERT pos ch — insert a letter ch in the string s in the position pos (1 ≤ pos ≤ |s| + 1, A ≤ ch ≤ Z). The letter ch becomes the pos-th symbol of the string s, at that the letters shift aside and the length of the string increases by 1.  DELETE pos — delete a character number pos (1 ≤ pos ≤ |s|) from the string s. At that the letters shift together and the length of the string decreases by 1.  REPLACE pos ch — the letter in the position pos of the line s is replaced by ch (1 ≤ pos ≤ |s|, A ≤ ch ≤ Z). At that the length of the string does not change. Your task is to find in which minimal number of moves one can get a t string from an s string. You should also find the sequence of actions leading to the required results.

The first line contains s, the second line contains t. The lines consist only of capital Latin letters, their lengths are positive numbers from 1 to 1000.

In the first line print the number of moves k in the given sequence of operations. The number should be the minimal possible one. Then print k lines containing one operation each. Print the operations in the format, described above. If there are several solutions, print any of them.

10
REPLACE 1 W
REPLACE 2 R
REPLACE 3 O
REPLACE 4 N
REPLACE 5 G
REPLACE 6 A
INSERT 7 N
INSERT 8 S
INSERT 9 W
REPLACE 11 R

import Data.Array

main = do
	a <- getLine
	b <- getLine
	putStrLn $ unlines $ map unwords $ let s = gao a b in [show $ length s] : reverse s

gao a b = dump n m where
	n = length a
	m = length b
	s = listArray (0,n) ('^':a)
	t = listArray (0,m) ('^':b)
	dp = listArray ((0,0),(n,m)) [f i j | i <- [0 .. n], j <- [0 .. m]]
	f 0 0 = (0, '$')
	f i j =
		if s!i == t!j then
			(fst $ dp!(i-1,j-1), 'O')
		else
			minimum [(succ $ fst $ dp!(x,y), z) | (x,y,z) <- [
				(i - 1, j, 'D'),
				(i, j - 1, 'I'),
				(i - 1, j - 1, 'R')], x >= 0, y >= 0]
	dump i j = let x = i - 1; y = j - 1 in case snd $ dp!(i,j) of
		'D' -> ["DELETE", show $ j + 1] : dump x j
		'I' -> ["INSERT", show j, [t!j]] : dump i y
		'R' -> ["REPLACE", show j, [t!j]] : dump x y
		'O' -> dump x y
		'$' -> []

import Data.Array
import Data.List

main = do
	a <- getLine
	b <- getLine
	putStrLn $ unlines $ map unwords $ let s = gao a b in [show $ length s] : reverse s

gao a b = dp!(n,m) where
	n = length a
	m = length b
	dp = listArray ((0,0),(n,m)) [f i j | i <- [0 .. n], j <- [0 .. m]]
	f 0 0 = []
	f i j = let s = [('^':a)!!i]; t = [('^':b)!!j] in
		if s == t then
			dp!(i-1, j-1)
		else
			minimumBy (\u v -> compare (length u) (length v)) [z : dp!(x,y) | (x,y,z) <- [
				(i - 1, j, ["REMOVE", show (j + 1)]),
				(i, j - 1, ["INSERT", show j, t]),
				(i - 1, j - 1, ["REPLACE", show j, t])], x >= 0, y >= 0]


Little X and Little Z are good friends. They always chat online. But both of them have schedules.Little Z has fixed schedule. He always online at any moment of time between a1 and b1, between a2 and b2, ..., between ap and bp (all borders inclusive). But the schedule of Little X is quite strange, it depends on the time when he gets up. If he gets up at time 0, he will be online at any moment of time between c1 and d1, between c2 and d2, ..., between cq and dq (all borders inclusive). But if he gets up at time t, these segments will be shifted by t. They become [ci + t, di + t] (for all i).If at a moment of time, both Little X and Little Z are online simultaneosly, they can chat online happily. You know that Little X can get up at an integer moment of time between l and r (both borders inclusive). Also you know that Little X wants to get up at the moment of time, that is suitable for chatting with Little Z (they must have at least one common moment of time in schedules). How many integer moments of time from the segment [l, r] suit for that?

The first line contains four space-separated integers p, q, l, r (1 ≤  p, q ≤ 50; 0 ≤ l ≤ r ≤ 1000). Each of the next p lines contains two space-separated integers ai, bi (0 ≤ ai < bi ≤ 1000). Each of the next q lines contains two space-separated integers cj, dj (0 ≤ cj < dj ≤ 1000). It's guaranteed that bi < ai + 1 and dj < cj + 1 for all valid i and j.

Output a single integer — the number of moments of time from the segment [l, r] which suit for online conversation.

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . getAns . getIntArray

reAssign :: [Int] -> [(Int, Int)]
reAssign [] = []
reAssign (x:y:xs) = (x,y) : reAssign xs

getAns :: [Int] -> Int
getAns (p:q:l:r:xs) = calSum l r ps qs
		where ps = reAssign ls;
			  qs = reAssign rs;
			  (ls, rs) = splitAt (p * 2) xs

calSum l r ps qs = sum [haveCommon ps $ map (\(a, b) -> (a + t, b + t)) qs | t <- [l .. r]]

overLap :: ((Int, Int), (Int, Int)) -> Bool
overLap ((x1, y1), (x2, y2)) = (x1 >= x2 && x1 <= y2) || (y1 >= x2 && y1 <= y2) || (x2 >= x1 && x2 <= y1) || (y2 >= x1 && y2 <= y1)

haveCommon ps qs = if any overLap [(p, q) | p <- ps, q <- qs] then 1 else 0

import Control.Monad
import Data.List

main = do
  [p, q, l, r] <- fmap (map read . words) getLine
  abs <- replicateM p $ (fmap (map read . words)) getLine
  cds <- replicateM q $ (fmap (map read . words)) getLine

  let
    check x = f (sort abs) (sort cds)
      where
        f [] _ = False
        f _ [] = False
        f ([a, b]:abs) ([c, d]:cds)
          | b < c+x = f abs ([c, d]:cds)
          | d+x < a = f ([a, b]:abs) cds
          | otherwise = True

  print $ length $ filter check [l..r]

main = do
  [p,q,l,r] <- fmap (map read . words) getLine
  z <- mapM g [1..p]
  x <- mapM g [1..q]
  print (solve (l, r) x z)
      where
        g _ = do
          [x,y] <- fmap (map read . words) getLine
          return (x, y)

solve :: (Int, Int) -> [(Int, Int)] -> [(Int, Int)] -> Int
solve (l, r) x z = length . filter f $ [l..r]
    where
      f v = any g x
          where
            g (ci, di) = intersect (ci +v) (di + v) z
      intersect c d z = any h z
          where
            h (a,b) = (c <= a && d >= a) || (c >= a && c <= b)

import Control.Applicative
import Control.Monad

toTuple :: [String] -> (Int,Int)
toTuple [x,y] = (read x, read y)

inInt :: [(Int,Int)] -> [(Int,Int)] -> Bool
inInt xs ys = or [x2 >= y1 && x1 <= y2| (x1,x2) <- xs, (y1,y2) <- ys]

main = do
  [p,q,l,r] <- map read . words <$> getLine
  zs <- map (toTuple . words) <$> replicateM p getLine
  xs <- map (toTuple . words) <$> replicateM q getLine
  print . sum $ [if inInt (map (\(x,y) -> (x+i,y+i)) xs) zs then 1 else 0 | i <- [l..r]]

import Control.Applicative ((<$>), (<*>))

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

solve :: (Int, Int, Int, Int) -> [(Int, Int)] -> Int
solve (p, _, l, r) abcd
  = sum [ fromEnum $ or [ c + t <= b && a <= d + t | (a, b) <- ab, (c, d) <- cd ] | t <- [l..r] ]
  where (ab, cd) = splitAt p abcd

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

toQuadruple :: [a] -> (a, a, a, a)
toQuadruple xs = (head xs, xs !! 1, xs !! 2, xs !! 3)

import Control.Monad (liftM, forM)
import Data.Array (listArray, (!))

for = flip map

trues = repeat True
falses = repeat False

input = do
  ln <- getLine
  return $ map read $ words ln

mor :: [[Bool]] -> [Bool]
mor = foldl1 $ zipWith (||)

main = do
  [p, q, l, r] <- input
  let g n = liftM mor $ forM [1..n] $ \_ -> do
      [a, b] <- input
      return $ (take a falses ++ take (b-a+1) trues ++ take (1001-b) falses)
  ipx <- g p
  iqx <- g q
  let ip = listArray (0, 1001) ipx
  let iq = listArray (0, 1001) iqx
  let li = for [l..r] (\i -> fromEnum $ or $ for [0..1001-i-1] (\j -> ip ! (i+j) && iq ! j))
  putStrLn $ show $ sum li

import Control.Monad (liftM, forM)
import Data.Array

main = do
  return ()