Jett is tired after destroying the town and she wants to have a rest. She likes high places, that's why for having a rest she wants to get high and she decided to craft staircases.A staircase is a squared figure that consists of square cells. Each staircase consists of an arbitrary number of stairs. If a staircase has $$$n$$$ stairs, then it is made of $$$n$$$ columns, the first column is $$$1$$$ cell high, the second column is $$$2$$$ cells high, $$$\ldots$$$, the $$$n$$$-th column if $$$n$$$ cells high. The lowest cells of all stairs must be in the same row.A staircase with $$$n$$$ stairs is called nice, if it may be covered by $$$n$$$ disjoint squares made of cells. All squares should fully consist of cells of a staircase. This is how a nice covered staircase with $$$7$$$ stairs looks like:  Find out the maximal number of different nice staircases, that can be built, using no more than $$$x$$$ cells, in total. No cell can be used more than once.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 1000)$$$  — the number of test cases. The description of each test case contains a single integer $$$x$$$ $$$(1 \le x \le 10^{18})$$$  — the number of cells for building staircases.

For each test case output a single integer  — the number of different nice staircases, that can be built, using not more than $$$x$$$ cells, in total.

NoteIn the first test case, it is possible to build only one staircase, that consists of $$$1$$$ stair. It's nice. That's why the answer is $$$1$$$.In the second test case, it is possible to build two different nice staircases: one consists of $$$1$$$ stair, and another consists of $$$3$$$ stairs. This will cost $$$7$$$ cells. In this case, there is one cell left, but it is not possible to use it for building any nice staircases, that have not been built yet. That's why the answer is $$$2$$$.In the third test case, it is possible to build only one of two nice staircases: with $$$1$$$ stair or with $$$3$$$ stairs. In the first case, there will be $$$5$$$ cells left, that may be used only to build a staircase with $$$2$$$ stairs. This staircase is not nice, and Jett only builds nice staircases. That's why in this case the answer is $$$1$$$. If Jett builds a staircase with $$$3$$$ stairs, then there are no more cells left, so the answer is $$$1$$$ again.

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

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  print $ solve 1 n

solve 100 _ = 0
solve _ 0 = 0
solve p n
  | c <= n = 1 + solve (succ p) (n - c)
  | otherwise = solve (succ p) n
  where
    d = 2 ^ p - 1
    c = (d * (d + 1)) `div` 2

import Control.Monad
main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

routine :: IO ()
routine = do
  n <- readLn
  print $ solve n

solve :: Integer -> Integer
solve n = (\x -> x-1) $ snd $ head $ filter (\x ->fst x>n) $ zip liste2 [1..]

f :: Integer -> Integer
f n = ((2^n)-1)*(2^(n-1))

liste :: [Integer]
liste = map f [1..]

liste2 :: [Integer]
liste2 = scanl1 (+) liste

import Data.List
import Data.Int
import Data.Char
import Control.Monad
import Data.Bits

readArray :: IO [Int64]
readArray = do
    line <- getLine
    return $ map (read::String->Int64) $ words line

readInt :: IO Int64
readInt = do
    line <- getLine
    return $ (read::String->Int64) $ line

f :: Int64 -> Int64 -> Int64
f curPower xLeft =
  let s = (curPower) * (curPower - 1) `div` 2 in
  if s > xLeft then 0 else 1 + f (curPower * 2) (xLeft - s)

solve :: IO ()
solve = do
    n <- readInt
    print $ f 2 n

main :: IO ()
main = do
    t <- readInt
    forM_ [0..t-1] $ (\i -> solve)

import Control.Monad

size :: Integer -> Integer
size n = div (n * (n+1)) 2

nices :: [Integer]
nices = iterate (\x -> 2*x + 1) 1

solve :: Integer -> Integer
solve = go 0 nices  where
  go k (tar:tars) tot = case  tot - size tar  of
    v | v < 0  -> k
      | True   -> go (k+1) tars v
  go _ _ _ = error "nices is finite???"

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    x <- read <$> getLine
    print $ solve x

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

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  print $ solve 100 n

solve 0 _ = 0
solve _ 0 = 0
solve p n
  | c <= n = 1 + solve (pred p) (n - c)
  | otherwise = solve (pred p) n
  where
    d = 2 ^ p - 1
    c = (d * (d + 1)) `div` 2

import Data.List
import Data.Char
import Control.Monad
import Data.Bits

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

readInt :: IO Int
readInt = do
    line <- getLine
    return $ (read::String->Int) $ line

f :: Int -> Int -> Int
f curPower xLeft =
  let s = (curPower) * (curPower - 1) `div` 2 in
  if s > xLeft then 0 else 1 + f (curPower * 2) (xLeft - s)

solve :: IO ()
solve = do
    n <- readInt
    print $ f 2 n

main :: IO ()
main = do
    t <- readInt
    forM_ [0..t-1] $ (\i -> solve)


It is so boring in the summer holiday, isn't it? So Alice and Bob have invented a new game to play. The rules are as follows. First, they get a set of n distinct integers. And then they take turns to make the following moves. During each move, either Alice or Bob (the player whose turn is the current) can choose two distinct integers x and y from the set, such that the set doesn't contain their absolute difference |x - y|. Then this player adds integer |x - y| to the set (so, the size of the set increases by one).If the current player has no valid move, he (or she) loses the game. The question is who will finally win the game if both players play optimally. Remember that Alice always moves first.

The first line contains an integer n (2 ≤ n ≤ 100) — the initial number of elements in the set. The second line contains n distinct space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109) — the elements of the set.

Print a single line with the winner's name. If Alice wins print "Alice", otherwise print "Bob" (without quotes).

NoteConsider the first test sample. Alice moves first, and the only move she can do is to choose 2 and 3, then to add 1 to the set. Next Bob moves, there is no valid move anymore, so the winner is Alice.

import Control.Monad

main = do
  n <- liftM read getLine :: IO Int
  xs <- liftM (map read . words) getLine :: IO [Int]
  let moves = maximum xs `div` foldl1 gcd xs - n
  putStrLn (if moves `mod` 2 == 1 then "Alice" else "Bob")

import Control.Monad

main = do
	n <- readLn :: IO Int
	a <- (map read . words) `liftM` getLine :: IO [Int]
	putStrLn$ ["Bob", "Alice"]!!(mod (div (foldr1 max a) (foldr1 gcd a) - n) 2)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    n <- readLine
    l <- readsLine
    putStrLn $ if solve n l then "Alice" else "Bob"

solve :: Int -> [Int] -> Bool
solve n l = odd (a - length l)
    where
    d = foldl1 gcd l
    m = maximum l
    a = m `div` d

import Control.Monad (liftM)
import Data.Array ((!), bounds, listArray)
import Data.List (intercalate)
import Prelude hiding (reads)

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

solve :: [Int] -> String
solve xs
  | odd (max' `div` gcd' - n)  =  "Alice"
  | otherwise  =  "Bob"
  where
    n  =  length xs
    max'  =  maximum xs
    gcd'  =  foldl1 gcd xs

prints :: Show a => [a] -> IO ()
prints  =  putStrLn . intercalate " " . map show

main :: IO ()
main  =  getLine >> reads >>= putStrLn . solve

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  as <- fmap ((fmap read) . words) getLine :: IO [Int]
  let d = foldr1 gcd as
  let r = even $ (div (maximum as) d)-n
  putStr $ if r then "Bob" else "Alice"

module Main where

import Control.Applicative
import Data.List

data Person = Alice | Bob deriving (Eq, Show)

main = do
    n <- read <$> getLine
    ns <- map read <$> words <$> getLine
    print $ solve n ns--solve n [] ns

solve :: Int -> [Int] -> Person
solve n xs =
    let g = foldl1 (\a b -> gcd a b) xs
    in if odd (maximum (map (`div`g) xs) - n)
       then Alice
       else Bob

gcd_ :: Int -> Int -> Int
gcd_ x y = if y == 0 then x else gcd y (x `rem` y)

main = do
  n <- readLn :: IO Int
  line <- getLine
  let
    a = map (read :: String -> Int) $ words line
    d = foldl1 gcd_ a
    m = maximum $ map (\x -> x `div` d) a
    in putStrLn $ if (n - m) `rem` 2 /= 0 then "Alice" else "Bob"

---------------------Import--------------------------- {{{
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char
import Data.Ratio                                   -- x = 5%6
import Data.Bits                                    -- (.&.), (.|.), shiftL...
import Text.Printf                                  -- printf "%0.6f" (1.0)
import qualified Data.ByteString.Char8 as BS-- }}}

---------------------Input---------------------------- {{{
getInteger = (\(Just (x,_)) -> x). BS.readInteger
getInt = (\(Just (x,_)) -> x). BS.readInt

getIntArray = readIntArray
getIntegerArray = readIntegerArray

readIntArray input =
  case x of
    Just (a, xs) -> a : readIntArray xs
    Nothing -> []
  where
   x = BS.readInt. BS.dropWhile isSpace $ input

readIntegerArray input =
  case x of
    Nothing -> []
    Just (y, ys) -> y : readIntegerArray ys
  where
    x = BS.readInteger. BS.dropWhile isSpace $ input
------------------------------------------------------ }}}

main :: IO ()
main = BS.getContents >>= putStrLn. (["Bob", "Alice"]!!). fromIntegral .(`mod` 2).solve. tail. readIntegerArray
  where
  solve xs = (maximum xs ) `div` g - fromIntegral (length xs)
    where
      g = gcd' xs
      gcd' :: [Integer] -> Integer
      gcd' (a:as) = foldl' (gcd) a as

gcdOfList :: [Int]->Int
gcdOfList x = case x of [] -> 0
                        (x : xs) -> gcd x (gcdOfList xs)

solve :: String->Int->String
solve s n =
  if rem ( (div ma g) - n) 2 == 0 then "Bob" else "Alice"
  where a = map (read :: String->Int) (words s)
        ma = maximum a
        g = gcdOfList a

main = do
  n <- getLine
  s <- getLine
  putStrLn $ solve s ((read :: String->Int)  n)

module Main where

import Control.Applicative
import Data.List

data Person = Alice | Bob deriving (Eq, Show)

main = do
    n <- read <$> getLine
    ns <- map read <$> words <$> getLine
    print $ solve' n ns--solve n [] ns

solve' :: Int -> [Int] -> Person
solve' n xs =
    let g = foldl1 (\a b -> gcd a b) xs
    in if odd (maximum (map (`div`g) xs) - n)
       then Alice
       else Bob

solve :: Int -> [Int] -> [Int] -> Person
solve n xs [] = if odd $ (length xs - n)
                then Alice
                else Bob
solve n xs ys =
    let newXs = ys ++ xs
        newYs = (nub $ concat $ map (\y -> nub $ filter (/=0) $ map (\x -> abs (x-y) ) newXs) ys ) \\ newXs
    in  solve n newXs newYs

import Data.List

ans xs= let l=m`div`g-(length xs) in if odd l then "Alice" else "Bob"
    where g=foldl1 gcd xs
          m=maximum xs
main = do
    m<-getLine
    n<-getLine
    let input = map read$ words n
    putStrLn $ ans input

gcdlist :: [Int] -> Int
gcdlist (x : y : xs) = gcdlist ((gcd x y) : xs)
gcdlist (x : []) = x

main = do
	rawn <- getLine
	rawinput <- getLine
	let n = read rawn :: Int
	let input = map read (words rawinput) :: [Int]
	putStr $ if (odd ((div (maximum input) (gcdlist input)) - n)) then "Alice" else "Bob"

module Main where

import Control.Applicative
import Data.List

data Person = Alice | Bob deriving (Eq, Show)

main = do
    n <- read <$> getLine
    ns <- map read <$> words <$> getLine
    print $ solve' n ns--solve n [] ns

solve' :: Int -> [Int] -> Person
solve' n xs = if odd (maximum xs - n)
              then Alice
              else Bob

solve :: Int -> [Int] -> [Int] -> Person
solve n xs [] = if odd $ (length xs - n)
                then Alice
                else Bob
solve n xs ys =
    let newXs = ys ++ xs
        newYs = (nub $ concat $ map (\y -> nub $ filter (/=0) $ map (\x -> abs (x-y) ) newXs) ys ) \\ newXs
    in  solve n newXs newYs

import Data.List

ans xs= let l=m-(length xs) in if odd l then "Alice" else "Bob"
    where m=maximum xs
main = do
    m<-getLine
    n<-getLine
    let input = map (\x->read x::Int) $ words n
    putStrLn $ ans input

gcdlist :: [Int] -> Int
gcdlist (x : y : xs) = gcdlist ((gcd x y) : xs)
gcdlist (x : []) = x

main = do
	rawn <- getLine
	rawinput <- getLine
	let n = read rawn :: Int
	let input = map read (words rawinput) :: [Int]
	putStr $ if (odd ((div (maximum input) (gcdlist input)) - n)) then "Bob" else "Alice"

import Data.List

getdelts :: [Int] -> [Int]
getdelts a = [abs (x - y) | x <- a, y <- a]

main = do
	n <- getLine
	numbers <- getLine
	putStr $ (if (odd (length $ group $ sort $ getdelts (map read (words numbers) :: [Int]))) then "Bob" else "Alice")

import Data.List

getdelts :: [Int] -> [Int]
getdelts a = [abs (x - y) | x <- a, y <- a, x /= y]

main = do
	n <- getLine
	numbers <- getLine
	putStr $ (if (odd (length $ group $ sort $ getdelts (map read (words numbers) :: [Int]))) then "Alice" else "Bob")


You are given n segments on a line. There are no ends of some segments that coincide. For each segment find the number of segments it contains.

The first line contains a single integer n (1 ≤ n ≤ 2·105) — the number of segments on a line. Each of the next n lines contains two integers li and ri ( - 109 ≤ li < ri ≤ 109) — the coordinates of the left and the right ends of the i-th segment. It is guaranteed that there are no ends of some segments that coincide.

Print n lines. The j-th of them should contain the only integer aj — the number of segments contained in the j-th segment.

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.ST.Safe (STUArray)
import Data.Array (array, elems)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (getBounds, readArray, writeArray, newArray)
import Data.Bits
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Data.List (sort)
import Data.Array.Unboxed (UArray)
import Prelude hiding (words, lines, getLine, getContents)

type Fenwick s = STUArray s Int Int

fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
  l <- snd <$> getBounds f

  mapM (\i -> readArray f i >>= \v -> writeArray f i (v+d)) $
    takeWhile (<= l) $ iterate (\i -> i .|. (i+1)) i

query f i = sum <$> (mapM (readArray f) $ takeWhile (>= 0) $ iterate (\i -> (i .&. (i+1))-1) i)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  ss <- replicateM n ((\[a, b] -> (a, b)) <$> readInts)

  let
    rs = listArray (1, n) $ sort $ map snd ss :: UArray Int Int
    ss' = sort $ zip ss [1..]

    lookup x = lookup' 1 n
      where
        lookup' l r
          | v == x = m
          | v < x = lookup' (m+1) r
          | otherwise = lookup' l m
          where
            m = (l+r) `div` 2
            v = rs ! m

    cs = runST $ do
      t <- fenwick n

      let
        count [] = return []
        count (((l, r), i):ss) = do
          let j = lookup r
          c <- query t (j-1)
          update t j 1
          cs <- count ss
          return ((i, c):cs)

      count $ reverse ss'

  putStr . unlines . map show . elems $ array (1, n) cs

{-# tle 39 #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (array, elems)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)
import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l + r) `div` 2

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

data T = T !Int !Int !Int
instance Ord T where (T a _ _) <= (T b _ _) = a >= b
instance Eq T where (T a _ _) == (T b _ _) = a == b

main = do
  [n] <- readInts
  rs <- replicateM n readInts

  let
    rs' = sort $ zipWith (\[l, r] i -> T l r i) rs [1..]

    count [] _ = []
    count ((T l r i):rs) set = (i, c):(count rs (r `Set.insert` set))
      where
        c = Set.size . fst $ r `Set.split` set

  putStr . unlines . map show . elems . array (1, n) $ count (rs') (Set.empty)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (array, elems)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)
import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

data T = T Int Int Int
instance Ord T where (T a _ _) <= (T b _ _) = a >= b
instance Eq T where (T a _ _) == (T b _ _) = a == b

main = do
  [n] <- readInts
  rs <- replicateM n readInts
  gen <- newStdGen

  let
    rs' = qsort gen $ zipWith (\[l, r] i -> T l r i) rs [1..]

    count [] _ = []
    count ((T l r i):rs) set = (i, c):(count rs (r `Set.insert` set))
      where
        c = Set.size . fst $ r `Set.split` set

  putStr . unlines . map show . elems . array (1, n) $ count (rs') Set.empty

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.ST.Safe (STUArray)
import Data.Array (array, elems)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (getBounds, readArray, writeArray, newArray)
import Data.Bits
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Data.List (sort)
import Data.Array.Unboxed (UArray)
import Prelude hiding (words, lines, getLine, getContents)

type Fenwick s = STUArray s Int Int

fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
  l <- snd <$> getBounds f

  let
    update' i
      | i <= l = do
        readArray f i >>= \v -> writeArray f i (v+d)
        update' (i .|. (i+1))
      | otherwise = return ()

  update' i

query f i = do
  let
    query' (-1) s = return s
    query' i s = do
      v <- readArray f i
      query' ((i .&. (i+1)) - 1) (s + v)

  query' i 0

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  ss <- replicateM n ((\[a, b] -> (a, b)) <$> readInts)

  let
    rs = listArray (1, n) $ sort $ map snd ss :: UArray Int Int
    ss' = sort $ zip ss [1..]

    lookup x = lookup' 1 n
      where
        lookup' l r
          | v == x = m
          | v < x = lookup' (m+1) r
          | otherwise = lookup' l m
          where
            m = (l+r) `div` 2
            v = rs ! m

    cs = runST $ do
      t <- fenwick n

      let
        count [] = return []
        count (((l, r), i):ss) = do
          let j = lookup r
          c <- query t (j-1)
          update t j 1
          cs <- count ss
          return ((i, c):cs)

      count $ reverse ss'

  putStr . unlines . map show . elems $ array (1, n) cs

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (array, elems)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)
import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

data T = T !Int !Int !Int
instance Ord T where (T a _ _) <= (T b _ _) = a >= b
instance Eq T where (T a _ _) == (T b _ _) = a == b

main = do
  [n] <- readInts
  rs <- replicateM n readInts
  gen <- newStdGen

  let
    rs' = sort $ zipWith (\[l, r] i -> T l r i) rs [1..]

    count [] _ = []
    count ((T l r i):rs) set = (i, c):(count rs (r `Set.insert` set))
      where
        c = Set.size . fst $ r `Set.split` set

  putStr . unlines . map show . elems . array (1, n) $ count (rs') Set.empty

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (array, elems)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)
import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

data T = T !Int !Int !Int
instance Ord T where (T a _ _) <= (T b _ _) = a >= b
instance Eq T where (T a _ _) == (T b _ _) = a == b

main = do
  [n] <- readInts
  rs <- replicateM n readInts
  gen <- newStdGen

  let
    rs' = qsort gen $ zipWith (\[l, r] i -> T l r i) rs [1..]

    count [] _ = []
    count ((T l r i):rs) set = (i, c):(count rs (r `Set.insert` set))
      where
        c = Set.size . fst $ r `Set.split` set

  putStr . unlines . map show . elems . array (1, n) $ count (rs') (Set.empty)

{-# tle 39 #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (array, elems)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)
import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l + r) `div` 2

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

data T = T !Int !Int !Int
instance Ord T where (T a _ _) <= (T b _ _) = a >= b
instance Eq T where (T a _ _) == (T b _ _) = a == b

main = do
  [n] <- readInts
  rs <- replicateM n readInts
  gen <- newStdGen

  let
    rs' = qsort gen $ zipWith (\[l, r] i -> T l r i) rs [1..]

    count [] _ = []
    count ((T l r i):rs) set = (i, c):(count rs (r `Set.insert` set))
      where
        c = Set.size . fst $ r `Set.split` set

  putStr . unlines . map show . elems . array (1, n) $ count (rs') (Set.empty)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (array, elems)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  rs <- replicateM n ((\[a, b] -> (a, b)) <$> readInts)

  let
    rs' = sort $ zip rs [1..]

    count [] _ = []
    count (((l, r),i):rs) set = (c - 1):(count rs (r `Set.delete` set))
      where
        c = Set.size . fst $ (r+1) `Set.split` set

  putStr . unlines . map show . elems . array (1, n) $ zip [1..] (count rs' (Set.fromList $ map snd rs))

{-# tle 39 #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (array, elems)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.List (sortBy)
import Prelude hiding (words, lines, getLine, getContents)
import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l + r) `div` 2

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n] <- readInts
  rs <- replicateM n ((\[a, b] -> (a, b)) <$> readInts)

  let
    rs' = sortBy (comparing (\a -> - fst (fst a))) $ zip rs [1..]

    count [] _ = []
    count (((l, r),i):rs) set = (i, c):(count rs (r `Set.insert` set))
      where
        c = Set.size . fst $ r `Set.split` set

  putStr . unlines . map show . elems . array (1, n) $ count (reverse rs') (Set.empty)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (array, elems)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)
import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

data T = T Int Int Int
instance Ord T where (T a _ _) <= (T b _ _) = a >= b
instance Eq T where (T a _ _) == (T b _ _) = a == b

main = do
  [n] <- readInts
  rs <- replicateM n readInts
  gen <- newStdGen

  let
    rs' = sort $ zipWith (\[l, r] i -> (l, r, i)) rs [1..]

    count [] _ = []
    count ((l, r, i):rs) set = (i, c):(count rs (r `Set.insert` set))
      where
        c = Set.size . fst $ r `Set.split` set

  putStr . unlines . map show . elems . array (1, n) $ count (rs') Set.empty

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (array, elems)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)
import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

data T = T Int Int Int
instance Ord T where (T a _ _) <= (T b _ _) = a >= b
instance Eq T where (T a _ _) == (T b _ _) = a == b

main = do
  [n] <- readInts
  rs <- replicateM n readInts
  gen <- newStdGen

  let
    rs' = qsort gen $ zipWith (\[l, r] i -> (l, r, i)) rs [1..]

    count [] _ = []
    count ((l, r, i):rs) set = (i, c):(count rs (r `Set.insert` set))
      where
        c = Set.size . fst $ r `Set.split` set

  putStr . unlines . map show . elems . array (1, n) $ count (rs') Set.empty


One day Jeff got hold of an integer sequence a1, a2, ..., an of length n. The boy immediately decided to analyze the sequence. For that, he needs to find all values of x, for which these conditions hold:  x occurs in sequence a.  Consider all positions of numbers x in the sequence a (such i, that ai = x). These numbers, sorted in the increasing order, must form an arithmetic progression. Help Jeff, find all x that meet the problem conditions.

The first line contains integer n (1 ≤ n ≤ 105). The next line contains integers a1, a2, ..., an (1 ≤ ai ≤ 105). The numbers are separated by spaces.

In the first line print integer t — the number of valid x. On each of the next t lines print two integers x and px, where x is current suitable value, px is the common difference between numbers in the progression (if x occurs exactly once in the sequence, px must equal 0). Print the pairs in the order of increasing x.

NoteIn the first test 2 occurs exactly once in the sequence, ergo p2 = 0.

import Data.List
import Text.Printf
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative

translate n ([x]) = (n,0)
translate n x = if x==take (length x) [x!!0,x!!1..] then (n, (x!!0 - x!!1)) else (n, -1)

solve :: [Int] -> [(Int, Int)]
solve ls = [(key,d) | (key,d) <- map (\(key, xs) -> (translate key xs)) $ M.assocs ls', d /= -1]
  where
    ls' = M.fromListWith (++) $ zip ls $ map (\a -> [a]) [1..]

main = do
  getLine
  xs <- map (fromJust . fmap fst . B.readInt) . B.words <$> B.getLine
  let ans = solve xs
  print $ length ans
  mapM_ (\(a,b)->printf "%d %d\n" a b) ans

import Data.List
import Text.Printf
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative

papa x = x == take (length x) [x!!0,x!!1..]

translate n ([x]) = (n,0)
translate n x = if papa x then (n, (x!!0 - x!!1)) else (n, -1)

solve :: [Int] -> [(Int, Int)]
solve ls = [(key,d) | (key,d) <- map (\(key, xs) -> (translate key xs)) $ M.assocs $ he, d /= -1]
  where
    he = M.fromListWith (++) $ zip ls $ map (\a -> [a]) [1..]

main = do
  getLine
  xs <- map (fromJust . fmap fst .B.readInt) . B.words <$> B.getLine
  let ans = solve xs
  print $ length ans
  mapM_ (\(a,b)->printf "%d %d\n" a b) ans

import Data.List
import Text.Printf
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative

translate n ([x]) = (n,0)
translate n x = if x==take (length x) [x!!0,x!!1..] then (n, (x!!0 - x!!1)) else (n, -1)

solve :: [Int] -> [(Int, Int)]
solve ls = filter (\(key,d) -> d /= -1) $ map (\(key, xs) -> (translate key xs)) $ M.assocs ls'
  where
    ls' = M.fromListWith (++) $ zip ls $ map (\a -> [a]) [1..]

main = do
  getLine
  xs <- map (fromJust . fmap fst . B.readInt) . B.words <$> B.getLine
  let ans = solve xs
  print $ length ans
  mapM_ (\(a,b)->printf "%d %d\n" a b) ans

import Data.List
import Text.Printf
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative

papa x = x == take (length x) [x!!0,x!!1..]

translate n ([x]) = (n,0)
translate n x = if papa x then (n, (x!!0 - x!!1)) else (n, -1)

solve :: [Int] -> [(Int, Int)]
solve ls = [(key,d) | (key,d) <- map (\(key, xs) -> (translate key xs)) $ M.assocs ls', d /= -1]
  where
    ls' = M.fromListWith (++) $ zip ls $ map (\a -> [a]) [1..]

main = do
  getLine
  xs <- map (fromJust . fmap fst .B.readInt) . B.words <$> B.getLine
  let ans = solve xs
  print $ length ans
  mapM_ (\(a,b)->printf "%d %d\n" a b) ans

import Data.List
import Text.Printf
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative

papa x = x == take (length x) [x!!0,x!!1..]

translate n ([x]) = (n,0)
translate n x = if papa x then (n, (x!!1 - x!!0)) else (n, 1)

solve :: [Int] -> [(Int, Int)]
solve ls = ans
  where
    he= M.fromListWith (++) $ zip ls $ map (\a -> [a]) [1..]
    ans = [(key,d) | (key,d) <- map (\(key, xs) -> (translate key xs)) $ M.assocs $ he, d /= 1]

main = do
  getLine
  xs <- map (fromJust . fmap fst .B.readInt) . B.words <$> B.getLine
  --solve xs
  let ans = solve xs
  print $ length ans
  mapM_ (\(a,b)->printf "%d %d\n" a ((-1)*b)) ans

import Data.Array
import Data.List

solve :: [Int] -> [(Int, Int)]
solve x = (unbox . assocs . countDiff) x
        where
            unbox [] = []
            unbox (x:xs) =
                    (case x of
                        (pos, (Just diff, Just last)) ->
                            [(pos, diff)]
                        _ -> []
                    ) ++ unbox xs

countDiff :: [Int] -> Array Int (Maybe Int, Maybe Int)
countDiff list =
        accumArray  updateDiff
                    (Just 0, Nothing)
                    (minimum list, maximum list)
                    (getStartingValues list 0)
            where
                updateDiff (Just 0, Nothing) newVal =
                        (Just 0, Just newVal)

                updateDiff (Just 0, Just lastVal) newVal =
                        (Just (newVal - lastVal), Just newVal)

                updateDiff (diff, _lastVal) newVal =
                        case _lastVal of
                            Just lastVal ->
                                if diff == Just (newVal - lastVal) then
                                    (diff, Just newVal)
                                else
                                    (Nothing, Nothing)

                            Nothing      -> (Nothing, Nothing)

                getStartingValues [] _ = []
                getStartingValues (x:xs) pos =
                        (x, pos) : (getStartingValues xs (pos + 1))

output :: [(Int, Int)] -> String
output list = (show $ length list) ++ "\n" ++ (result list)
        where
            result = unlines . (map (\(a, b) -> (show a) ++ " " ++ (show b))) . sort

main = interact $ output . solve . (map read) . tail . words

import Data.Array
import Data.List

solve :: [Int] -> [(Int, Int)]
solve x = (unbox . assocs . countDiff) x
        where
            unbox [] = []
            unbox (x:xs) =
                    (case x of
                        (pos, (Just diff, Just last)) ->
                            [(pos, diff)]
                        _ -> []
                    ) ++ unbox xs

countDiff :: [Int] -> Array Int (Maybe Int, Maybe Int)
countDiff list =
        accumArray  updateDiff
                    (Just 0, Nothing)
                    (minimum list, maximum list)
                    (reverse $ getStartingValues list 0 [])
            where
                updateDiff (Just 0, Nothing) newVal =
                        (Just 0, Just newVal)

                updateDiff (Just 0, Just lastVal) newVal =
                        (Just (newVal - lastVal), Just newVal)

                updateDiff (diff, _lastVal) newVal =
                        case _lastVal of
                            Just lastVal ->
                                if diff == Just (newVal - lastVal) then
                                    (diff, Just newVal)
                                else
                                    (Nothing, Nothing)

                            Nothing      -> (Nothing, Nothing)

                getStartingValues [] _ acc = acc
                getStartingValues (x:xs) pos acc =
                        getStartingValues xs (pos + 1) ((x, pos) : acc)

output :: [(Int, Int)] -> String
output list = (show $ length list) ++ "\n" ++ (result list)
        where
            result = unlines . (map (\(a, b) -> (show a) ++ " " ++ (show b))) . sort

main = interact $ output . solve . (map read) . tail . words

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

main = do
    n <- readLn
    l <- map (fromJust . fmap fst .B.readInt) . B.words <$> B.getLine
    let res = solve n l
    print (length res)
    forM_ res $ \(x,d) -> printf "%d %d\n" x d

solve :: Int -> [Int] -> [(Int,Int)]
solve n l = [ (x,d) | (x,(d,p)) <- M.assocs $ foldl' f M.empty l', d /= -1]
    where
    l' = zip l [1..]
    f m (x,i) | M.notMember x m = M.insert x (0,i) m
              | otherwise =
        case m M.! x of
            (-1,_) -> m
            (0,p)  -> M.insert x (i-p,i) m
            (d,p) | d == i - p -> M.insert x (d,i) m
                  | otherwise  -> M.insert x (-1,i) m

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

main = do
    n <- readLn
    l <- map (fromJust . fmap fst .B.readInt) . B.words <$> B.getLine
    let res = solve n l
    print (length res)
    forM_ res $ \(x,d) -> printf "%d %d\n" x d

solve :: Int -> [Int] -> [(Int,Int)]
solve n l = [ (x,d) | (x,(d,p)) <- M.assocs $ foldl' f M.empty l', d /= -1]
    where
    l' = zip l [1..]
    f m (x,i) | M.notMember x m = M.insert x (0,i) m
              | otherwise =
        case m M.! x of
            (-1,_) -> m
            (0,p)  -> M.insert x (i-p,i) m
            (d,p) | d == i - p -> M.insert x (d,i) m
                  | otherwise  -> M.insert x (-1,i) m

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (nub)
import Data.IntMap (assocs, fromListWith, map)
import qualified Data.IntMap as Map
import Data.Maybe (catMaybes)
import Prelude hiding (reads)

reads :: Num a => IO [a]
reads  =  liftM (Prelude.map read . words) getLine
  where
    read ('-':s)  =  (-1) * read s
    read s  =  read' 0 s
    read' a ""  =  a
    read' a (c:s)  =  read' (10 * a + fromIntegral (ord c - ord '0')) s

solve :: [Int] -> [(Int, Int)]
solve as  =  catMaybes $ Prelude.map liftFromSnd $ assocs $ Map.map getStep intMap
  where
    intMap  =  fromListWith (++) $ zip as $ Prelude.map (\x -> [x]) [1..]
    getStep [_]  =  Just 0
    getStep xs  =  case nub (zipWith (-) xs (tail xs)) of
        [d]  ->  Just d
        _  ->  Nothing

printAns :: [(Int, Int)] -> IO ()
printAns ans  =  do
    print $ length ans
    mapM_ print' ans
  where
    print' (a, b)  =  putStrLn $ concat [show a, " ", show b]

liftFromSnd :: (a, Maybe b) -> Maybe (a, b)
liftFromSnd (a, b)  =  b >>= return . (tuple a)
  where
    tuple a b  =  (a, b)

main :: IO ()
main  =  do
    getLine
    as  <-  reads
    printAns $ solve as

import Data.List
import Text.Printf
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative

papa x = x == take (length x) [x!!0,x!!1..]

translate n ([x]) = (n,0)
translate n x = if papa x then (n, (x!!1 - x!!0)) else (n, -1)

solve :: [Int] -> [(Int, Int)]
solve ls = ans
  where
    he= M.fromListWith (++) $ zip ls $ map (\a -> [a]) [1..]
    ans = [(key,d) | (key,d) <- map (\(key, xs) -> (translate key xs)) $ M.assocs $ he, d /= -1]

main = do
  getLine
  xs <- map (fromJust . fmap fst .B.readInt) . B.words <$> B.getLine
  --solve xs
  let ans = solve xs
  print $ length ans
  mapM_ (\(a,b)->printf "%d %d\n" a ((-1)*b)) ans

import Data.Array
import Data.List

solve :: [Int] -> [(Int, Int)]
solve x = (unbox . assocs . countDiff) x
        where
            unbox [] = []
            unbox (x:xs) =
                    (case x of
                        (pos, (Just diff, Just last)) ->
                            [(pos, diff)]
                        _ -> []
                    ) ++ unbox xs

countDiff :: [Int] -> Array Int (Maybe Int, Maybe Int)
countDiff list =
        accumArray  updateDiff
                    (Just 0, Nothing)
                    (minimum list, maximum list)
                    (getStartingValues list 0 [])
            where
                updateDiff (Just 0, Nothing) newVal =
                        (Just 0, Just newVal)

                updateDiff (Just 0, Just lastVal) newVal =
                        (Just (newVal - lastVal), Just newVal)

                updateDiff (diff, _lastVal) newVal =
                        case _lastVal of
                            Just lastVal ->
                                if diff == Just (newVal - lastVal) then
                                    (diff, Just newVal)
                                else
                                    (Nothing, Nothing)

                            Nothing      -> (Nothing, Nothing)

                getStartingValues [] _ acc = acc
                getStartingValues (x:xs) pos acc =
                        getStartingValues xs (pos + 1) ((x, pos) : acc)

output :: [(Int, Int)] -> String
output list = (show $ length list) ++ "\n" ++ (result list)
        where
            result = unlines . (map (\(a, b) -> (show a) ++ " " ++ (show b))) . sort

main = interact $ output . solve . (map read) . tail . words

import Data.Array
import Data.List

solve :: [Int] -> [(Int, Int)]
solve x = (unbox . assocs . countDiff) x
        where
            unbox [] = []
            unbox (x:xs) =
                    (case x of
                        (pos, (Just diff, Just last)) ->
                            [(pos, diff)]
                        _ -> []
                    ) ++ unbox xs

countDiff :: [Int] -> Array Int (Maybe Int, Maybe Int)
countDiff list =
        accumArray  updateDiff
                    (Just 0, Nothing)
                    (minimum list, maximum list)
                    (getStartingValues list 0)
            where
                updateDiff (Just 0, Nothing) newVal =
                        (Just 0, Just newVal)

                updateDiff (Just 0, Just lastVal) newVal =
                        (Just (newVal - lastVal), Just newVal)

                updateDiff (diff, _lastVal) newVal =
                        case _lastVal of
                            Just lastVal ->
                                if diff == Just (newVal - lastVal) then
                                    (diff, Just newVal)
                                else
                                    (Nothing, Nothing)

                            Nothing      -> (Nothing, Nothing)

                getStartingValues [] _ = []
                getStartingValues (x:xs) pos =
                        (x, pos) : (getStartingValues xs (pos + 1))

output :: [(Int, Int)] -> String
output =
        unlines . (map (\(a, b) -> (show a) ++ " " ++ (show b))) . sort

main = interact $ output . solve . (map read) . tail . words


Your friend Mishka and you attend a calculus lecture. Lecture lasts n minutes. Lecturer tells ai theorems during the i-th minute.Mishka is really interested in calculus, though it is so hard to stay awake for all the time of lecture. You are given an array t of Mishka's behavior. If Mishka is asleep during the i-th minute of the lecture then ti will be equal to 0, otherwise it will be equal to 1. When Mishka is awake he writes down all the theorems he is being told — ai during the i-th minute. Otherwise he writes nothing.You know some secret technique to keep Mishka awake for k minutes straight. However you can use it only once. You can start using it at the beginning of any minute between 1 and n - k + 1. If you use it on some minute i then Mishka will be awake during minutes j such that  and will write down all the theorems lecturer tells.You task is to calculate the maximum number of theorems Mishka will be able to write down if you use your technique only once to wake him up.

The first line of the input contains two integer numbers n and k (1 ≤ k ≤ n ≤ 105) — the duration of the lecture in minutes and the number of minutes you can keep Mishka awake. The second line of the input contains n integer numbers a1, a2, ... an (1 ≤ ai ≤ 104) — the number of theorems lecturer tells during the i-th minute. The third line of the input contains n integer numbers t1, t2, ... tn (0 ≤ ti ≤ 1) — type of Mishka's behavior at the i-th minute of the lecture.

Print only one integer — the maximum number of theorems Mishka will be able to write down if you use your technique only once to wake him up.

NoteIn the sample case the better way is to use the secret technique at the beginning of the third minute. Then the number of theorems Mishka will be able to write down will be equal to 16.

{-# OPTIONS_GHC -O2 #-}
import Control.Applicative
import Data.List
getList = fmap ((map read).words) getLine
-- g is guaranteed number of theorems
g a t = sum (zipWith (\x y -> if y == 0 then 0 else x ) a t)
-- u is unreachable theorems
u a t k = maximum (scanl (\x y -> (fst y)-(snd y)+x ) 0 list)
  where unreach = (zipWith (\x y -> if y == 0 then x else 0 ) a t)
        list = zip unreach ((replicate k 0) ++ unreach)
main = do
  [n,k] <- getList
  a <- getList
  t <- getList
  putStrLn $ show ((g a t) + (u a t k))


This is an interactive problem. Remember to flush your output while communicating with the testing program. You may use fflush(stdout) in C++, system.out.flush() in Java, stdout.flush() in Python or flush(output) in Pascal to flush the output. If you use some other programming language, consult its documentation. You may also refer to the guide on interactive problems: https://codeforces.com/blog/entry/45307.The jury picked an integer $$$x$$$ not less than $$$0$$$ and not greater than $$$2^{14} - 1$$$. You have to guess this integer.To do so, you may ask no more than $$$2$$$ queries. Each query should consist of $$$100$$$ integer numbers $$$a_1$$$, $$$a_2$$$, ..., $$$a_{100}$$$ (each integer should be not less than $$$0$$$ and not greater than $$$2^{14} - 1$$$). In response to your query, the jury will pick one integer $$$i$$$ ($$$1 \le i \le 100$$$) and tell you the value of $$$a_i \oplus x$$$ (the bitwise XOR of $$$a_i$$$ and $$$x$$$). There is an additional constraint on the queries: all $$$200$$$ integers you use in the queries should be distinct.It is guaranteed that the value of $$$x$$$ is fixed beforehand in each test, but the choice of $$$i$$$ in every query may depend on the integers you send.

To give the answer, your program should print one line $$$!$$$ $$$x$$$ with a line break in the end. After that, it should flush the output and terminate gracefully.

NoteThe example of interaction is not correct — you should sumbit exactly $$$100$$$ integers in each query. Everything else is correct.Hacks are forbidden in this problem.

{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}

import Text.Printf
import System.IO
import Data.List
import Data.Functor
import Data.Bifunctor (bimap)
import Data.Function
import Data.Maybe
import Data.Int
import Data.Bits
import Data.Tree
import Data.Array.Unboxed
import Data.Array.IArray
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad
import Control.Monad.State.Strict
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

readB8Int :: B8.ByteString -> Int
readB8Int = fst . fromJust . B8.readInt

bitSplit :: Int
bitSplit = 7

generateQuery :: Int -> [Int]
generateQuery 1 = take 100 [0..]
generateQuery 2 = take 100 $ map (* (2 ^ bitSplit)) [1..]

performQuery :: [Int] -> IO Int
performQuery elements = do
    putStrLn $ "? " ++ intercalate " " (map show elements)
    hFlush stdout
    answer <- readB8Int <$> B8.getLine
    return answer

submitAnswer :: Int -> IO ()
submitAnswer answer = do
    printf "! %d\n" answer
    hFlush stdout

main :: IO ()
main = do
    firstAnswer <- performQuery $ generateQuery 1
    secondAnswer <- performQuery $ generateQuery 2
    let queryMask = 2 ^ bitSplit - 1
    let answer = (firstAnswer .&. complement queryMask) .|. (secondAnswer .&. queryMask)
    submitAnswer answer

import Data.List
import Data.Bits
import System.IO

main = do
  hSetBuffering stdout LineBuffering
  let q0 = [1..100] :: [Int]
  putStrLn $ unwords $ "?" : map show q0
  hFlush stdout
  r0 <- readLn
  let q1 = map (*128) q0
  putStrLn $ unwords $ "?" : map show q1
  hFlush stdout
  r1 <- readLn
  let a = r0 `xor` r1
      a0 = a .&. 127
      r = r0 `xor` a0 :: Int
  putStrLn $ "! " ++ show r
  hFlush stdout

{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}

import Text.Printf
import System.IO
import Data.List
import Data.Functor
import Data.Bifunctor (bimap)
import Data.Function
import Data.Maybe
import Data.Int
import Data.Bits
import Data.Tree
import Data.Array.Unboxed
import Data.Array.IArray
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad
import Control.Monad.State.Strict
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

readB8Int :: B8.ByteString -> Int
readB8Int = fst . fromJust . B8.readInt

bitSplit :: Int
bitSplit = 8

generateQuery :: Int -> [Int]
generateQuery 1 = take 100 [0..]
generateQuery 2 = take 100 $ map (* (2 ^ bitSplit)) [1..]

performQuery :: [Int] -> IO Int
performQuery elements = do
    putStrLn $ "? " ++ intercalate " " (map show elements)
    hFlush stdout
    answer <- readB8Int <$> B8.getLine
    return answer

submitAnswer :: Int -> IO ()
submitAnswer answer = do
    printf "! %d\n" answer
    hFlush stdout

main :: IO ()
main = do
    firstAnswer <- performQuery $ generateQuery 1
    secondAnswer <- performQuery $ generateQuery 2
    let queryMask = 2 ^ bitSplit - 1
    let answer = (firstAnswer .&. complement queryMask) .|. (secondAnswer .&. queryMask)
    submitAnswer answer

import Data.List
import Data.Bits
import System.IO

main = do
  hSetBuffering stdout LineBuffering
  let q0 = [0..99] :: [Int]
  putStrLn $ unwords $ "?" : map show q0
  r0 <- readLn
  let q1 = [128..227] :: [Int]
  putStrLn $ unwords $ "?" : map show q1
  r1 <- readLn
  let a = r0 `xor` r1
      a0 = a .&. 127
      r = r0 `xor` a0 :: Int
  putStrLn $ "! " ++ show r

import Data.List
import Data.Bits
import System.IO

main = do
  hSetBuffering stdout LineBuffering
  let q0 = [0..99] :: [Int]
  putStrLn $ unwords $ "?" : map show q0
  hFlush stdout
  r0 <- readLn
  let q1 = map (*128) q0
  putStrLn $ unwords $ "?" : map show q1
  hFlush stdout
  r1 <- readLn
  let a = r0 `xor` r1
      a0 = a .&. 127
      r = r0 `xor` a0 :: Int
  putStrLn $ "! " ++ show r
  hFlush stdout

import Data.List
import Data.Bits
import System.IO

main = do
  hSetBuffering stdout LineBuffering
  let q0 = [0..99] :: [Int]
  putStrLn $ unwords $ "?" : map show q0
  r0 <- readLn
  let q1 = map (*128) q0
  putStrLn $ unwords $ "?" : map show q1
  r1 <- readLn
  let a = r0 `xor` r1
      a0 = a .&. 127
      r = r0 `xor` a0 :: Int
  putStrLn $ "! " ++ show r


Little Petya likes points a lot. Recently his mom has presented him n points lying on the line OX. Now Petya is wondering in how many ways he can choose three distinct points so that the distance between the two farthest of them doesn't exceed d.Note that the order of the points inside the group of three chosen points doesn't matter.

The first line contains two integers: n and d (1 ≤ n ≤ 105; 1 ≤ d ≤ 109). The next line contains n integers x1, x2, ..., xn, their absolute value doesn't exceed 109 — the x-coordinates of the points that Petya has got. It is guaranteed that the coordinates of the points in the input strictly increase.

Print a single integer — the number of groups of three points, where the distance between two farthest points doesn't exceed d. Please do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

NoteIn the first sample any group of three points meets our conditions.In the seconds sample only 2 groups of three points meet our conditions: {-3, -2, -1} and {-2, -1, 0}.In the third sample only one group does: {1, 10, 20}.

main = interact $ show . solve . map read . words
solve :: [Integer] -> Integer
solve (n : d : xs) = f ys ys
    where   ys = zip xs [1..]

            f [] _ = 0
            f ((x, px) : xs) [(y, py)]
                | y - x <= d = choose (py - px) + f xs [(y, py)]
                | otherwise  = f xs [(y, py)]
            f ((x, px) : xs) ((y, py) : (z, pz) : ys)
                | z - x > d  = f xs ((y , py) : (z, pz) : ys) +
                        if y - x <= d then choose (py - px)
                                    else 0
                | otherwise  = f ((x, px) : xs) ((z, pz) : ys)

            choose n
                | n < 2     = 0
                | otherwise = div (n * (n - 1)) 2

import Control.Monad (liftM)
import Data.Array ((!), listArray)
import Prelude hiding (reads)

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

solve :: Int -> Int -> [Int] -> Integer
solve n d xs  =  solve' (1,1)
  where
    a  =  listArray (1, n) xs
    solve' (i, j)
      | j == n  =  f (j - i)
      | otherwise  =  f (j - i) + solve'' (i, j + 1)
    solve'' (i, j)
      | a ! j - a ! i > d  =  solve'' (i + 1, j)
      | otherwise  =  solve' (i, j)
    f :: Int -> Integer
    f n  =  (n' * (n' - 1)) `div` 2
      where
        n'  =  fromIntegral n

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

{-# LANGUAGE BangPatterns #-}

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

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

bSearch :: (Int -> Bool) -> Int -> Int -> Int
bSearch p !low !high
  | high<=low = low
  | p mid     = bSearch p mid high
  | otherwise = bSearch p low (mid-1)
   where
     mid = quot (low+high+1) 2

main = B.getContents >>= print.solve.map readInt.B.words

solve :: [Int] -> Integer
solve (n:d:rest) = sum $ map step [0..n-3]
   where
     arr = listArray (0,n-1) rest :: UArray Int Int
     step i = (toInteger $ j-i)*(toInteger $ j-i-1)`div`2
      where
        !aid = unsafeAt arr i + d
        j = bSearch ((<=aid).unsafeAt arr) i (n-1)

main = interact $ show . solve . map read . words
solve :: [Int] -> Int
solve (n : d : xs) = f ys ys
    where   ys = zip xs [1..]

            f [] _ = 0
            f ((x, px) : xs) [(y, py)]
                | y - x <= d = choose (py - px) + f xs [(y, py)]
                | otherwise  = f xs [(y, py)]
            f ((x, px) : xs) ((y, py) : (z, pz) : ys)
                | z - x > d  = f xs ((y , py) : (z, pz) : ys) +
                        if y - x <= d then choose (py - px)
                                    else 0
                | otherwise  = f ((x, px) : xs) ((z, pz) : ys)

            choose n
                | n < 2     = 0
                | otherwise = div (n * (n - 1)) 2

main = interact $ show . solve . map read . words
solve :: [Int] -> Int
solve (n : d : xs) = f ys ys
    where   ys = zip xs [1..]

            f [] _ = 0
            f ((x, px) : xs) [(y, py)]
                | y - x <= d = choose (py - px) + f xs [(y, py)]
                | otherwise  = f xs [(y, py)]
            f ((x, px) : xs) ((y, py) : (z, pz) : ys)
                | z - x > d  = f xs ((z, pz) : ys) +
                        if y - x <= d then choose (py - px)
                                    else 0
                | otherwise  = f ((x, px) : xs) ((z, pz) : ys)

            choose n
                | n < 2     = 0
                | otherwise = div (n * (n - 1)) 2

import Control.Monad (liftM)
import Data.Array ((!), listArray)
import Prelude hiding (reads)

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

solve :: Int -> Int -> [Int] -> Int
solve n d xs  =  solve' (1,1)
  where
    a  =  listArray (1, n) xs
    solve' (i,j)
      | i == n  =  0
      | j == n && a ! j - a ! i <= d  =  f (j - i + 1)
      | j == n  =  solve' (i + 1, j)
      | a ! j - a ! i <= d && a ! (j + 1) - a ! i <= d  =  solve' (i, j+1)
      | a ! j - a ! i <= d  =  f (j - i + 1) + solve' (i + 1, j + 1)
      | otherwise  =  solve' (i + 1, j)
    f n
      | n < 3  =  0
      | otherwise  =  div (n' * (n' - 1) * (n' - 2)) 6
      where
        n'  =  fromIntegral n

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

import Control.Monad (liftM)
import Data.Array ((!), listArray)
import Prelude hiding (reads)

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

solve :: Int -> Int -> [Int] -> Int
solve n d xs  =  solve' (1,1)
  where
    a  =  listArray (1, n) xs
    solve' (i,j)
      | i == n  =  0
      | j == n && a ! j - a ! i <= d  =  f (j - i + 1)
      | j == n  =  solve' (i + 1, j)
      | a ! j - a ! i <= d && a ! (j + 1) - a ! i <= d  =  solve' (i, j+1)
      | a ! j - a ! i <= d  =  f (j - i + 1) + solve' (i, j + 1)
      | otherwise  =  solve' (i + 1, j)
    f n
      | n < 3  =  0
      | otherwise  =  div (n' * (n' - 1) * (n' - 2)) 6
      where
        n'  =  fromIntegral n

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


Polycarp has a checkered sheet of paper of size n × m. Polycarp painted some of cells with black, the others remained white. Inspired by Malevich's "Black Square", Polycarp wants to paint minimum possible number of white cells with black so that all black cells form a square.You are to determine the minimum possible number of cells needed to be painted black so that the black cells form a black square with sides parallel to the painting's sides. All the cells that do not belong to the square should be white. The square's side should have positive length.

The first line contains two integers n and m (1 ≤ n, m ≤ 100) — the sizes of the sheet. The next n lines contain m letters 'B' or 'W' each — the description of initial cells' colors. If a letter is 'B', then the corresponding cell is painted black, otherwise it is painted white.

Print the minimum number of cells needed to be painted black so that the black cells form a black square with sides parallel to the painting's sides. All the cells that do not belong to the square should be white. If it is impossible, print -1.

NoteIn the first example it is needed to paint 5 cells — (2, 2), (2, 3), (3, 2), (3, 3) and (4, 2). Then there will be a square with side equal to three, and the upper left corner in (2, 2).In the second example all the cells are painted black and form a rectangle, so it's impossible to get a square.In the third example all cells are colored white, so it's sufficient to color any cell black.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.Array.Unboxed

main = do
  [n, m] <- fmap readInts B.getLine
  g <- replicateM n getLine
  print $ solve n m g

solve n m g'
  | all (== 'W') $ elems g = 1
  | s >= n || s >= m = -1
  | otherwise = length $ filter (== 'W') $ map (g!) $ range ((r1', c1'), (r2', c2'))
  where
    g = listArray ((1, 1), (n, m)) $ concat g' :: UArray (Int, Int) Char
    (r1, c1, r2, c2) = foldl (\(!r1_, !c1_, !r2_, !c2_) (r, c) -> (min r1_ r, min c1_ c, max r2_ r, max c2_ c)) (n, m, 1, 1) $ map fst $ filter ((== 'B') . snd) $ assocs g
    s = max (abs $ r2 - r1) (abs $ c2 - c1)
    (r1', c1') = (max 1 (r2 - s), max 1 (c2 - s))
    (r2', c2') = (min n (r1' + s), min m (c1' + s))

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.Array.Unboxed

main = do
  [n, m] <- fmap readInts B.getLine
  g <- replicateM n getLine
  print $ solve n m g

solve n m g'
  | all (== 'W') $ elems g = 1
  | s > n || s > m = -1
  | otherwise = length $ filter (== 'W') $ map (g!) $ range ((r1', c1'), (r2', c2'))
  where
    g = listArray ((1, 1), (n, m)) $ concat g' :: UArray (Int, Int) Char
    (r1, c1, r2, c2) = foldl (\(!r1_, !c1_, !r2_, !c2_) (r, c) -> (min r1_ r, min c1_ c, max r2_ r, max c2_ c)) (n, m, 1, 1) $ map fst $ filter ((== 'B') . snd) $ assocs g
    s = max (abs $ r2 - r1) (abs $ c2 - c1)
    (r1', c1') = (max 1 (r2 - s), max 1 (c2 - s))
    (r2', c2') = (min n (r1' + s), min m (c1' + s))

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words


Vasya tries to break in a safe. He knows that a code consists of n numbers, and every number is a 0 or a 1. Vasya has made m attempts to enter the code. After each attempt the system told him in how many position stand the right numbers. It is not said in which positions the wrong numbers stand. Vasya has been so unlucky that he hasn’t entered the code where would be more than 5 correct numbers. Now Vasya is completely bewildered: he thinks there’s a mistake in the system and it is self-contradictory. Help Vasya — calculate how many possible code variants are left that do not contradict the previous system responses.

The first input line contains two integers n and m (6 ≤ n ≤ 35, 1 ≤ m ≤ 10) which represent the number of numbers in the code and the number of attempts made by Vasya. Then follow m lines, each containing space-separated si and ci which correspondingly indicate Vasya’s attempt (a line containing n numbers which are 0 or 1) and the system’s response (an integer from 0 to 5 inclusively).

Print the single number which indicates how many possible code variants that do not contradict the m system responses are left.

import List
main = interact solve
solve input = output where
  inputs = lines input
  [n,m] = map (read::String->Int) $ words $ head inputs
  scs = [(read y::Int,x)|[x,y] <- map words $ tail inputs]
  output = show $ answer scs
answer :: [(Int,String)] -> Int
answer xs = if c<0 then answer (cas '0' xs) + answer (cas '1' xs) else c
  where c = check xs
cas _ [] = []
cas x ((y,z):xs) = (if head z == x then y-1 else y,tail z):(cas x xs)
check xs
  | x<0 || z>length y = 0
  | null y            = 1
  | otherwise         = -1
  where sxs = sort xs
        (x,y) = head sxs
        (z,_) = last sxs

import Data.List

main = interact $ show . solve.parse.lines

parse = map (\str -> (head (words str), read (last (words str)))) . tail

solve :: [(String, Int)] -> Int
solve xs@(("", _):_)  | all ((==0).snd) xs = 1
                      | otherwise         = 0
solve xs | any ((<0).snd) xs  = 0
         | otherwise          = f '0' + f '1'
         where  match a b  | a == b = 1
                match _ _          = 0
                f c = solve (map (\(s, n) -> (tail s, n - match (head s) c)) xs)


Vasya’s elder brother Petya loves playing computer games. In one of his favourite computer games Petya reached the final level where a fight with the boss take place.While playing the game Petya found spell scrolls and now he is about to use them. Let’s describe the way fighting goes on this level:1) The boss has two parameters: max — the initial amount of health and reg — regeneration rate per second.2) Every scroll also has two parameters: powi — spell power measured in percents — the maximal amount of health counted off the initial one, which allows to use the scroll (i.e. if the boss has more than powi percent of health the scroll cannot be used); and dmgi the damage per second inflicted upon the boss if the scroll is used. As soon as a scroll is used it disappears and another spell is cast upon the boss that inflicts dmgi of damage per second upon him until the end of the game.During the battle the actions per second are performed in the following order: first the boss gets the damage from all the spells cast upon him, then he regenerates reg of health (at the same time he can’t have more than max of health), then the player may use another scroll (no more than one per second).The boss is considered to be defeated if at the end of a second he has nonpositive ( ≤ 0) amount of health.Help Petya to determine whether he can win with the set of scrolls available to him and if he can, determine the minimal number of seconds he needs to do it.

The first line contains three integers N, max and reg (1 ≤ N, max, reg ≤ 1000) –– the amount of scrolls and the parameters of the boss. The next N lines contain two integers powi and dmgi each — the parameters of the i-th scroll (0 ≤ powi ≤ 100, 1 ≤ dmgi ≤ 2000).

In case Petya can’t complete this level, output in the single line NO. Otherwise, output on the first line YES. On the second line output the minimal time after which the boss can be defeated and the number of used scrolls. In the next lines for each used scroll output space-separated number of seconds passed from the start of the battle to the moment the scroll was used and the number of the scroll. Scrolls are numbered starting from 1 in the input order. The first scroll is considered to be available to be used after 0 seconds. Output scrolls in the order they were used. It is not allowed to use scrolls after the boss is defeated.

import Data.List
import Data.Maybe

main = interact f

f ss = case result of
         Nothing -> "NO"
         Just (t,x) -> (++) "YES\n" $ unlines $ map (unwords . map show) $ [t, length x]:(map (take 2) x)
  where
    ([n,max,reg]:l) = map (map (read :: String -> Int)) $ map words $ lines ss
    ls = sortBy (\[_,i,_] [_,j,_] -> compare j i) $ zipWith (:) [1..] l
    result = g 0 max max [] max reg ls

g time hp prevHP hist maxHP reg ls
  | hp <= 0 = Just (time, reverse hist)
  | otherwise =
      if (not canAttack && hp >= prevHP)
      then Nothing
      else g (time+1) newHP hp newHist maxHP reg newList
  where
    (possible, unpossible) = break (\[i,pow,dmg] -> pow*maxHP < hp*100) ls
    canAttack = possible /= []
    use = maximumBy (\[_,_,dmg1] [_,_,dmg2] -> compare dmg1 dmg2) possible
    (newL, newR) = break (== use) possible
    (newList,newHist) = if canAttack
                        then (newL++(tail newR)++unpossible, ((time:use):hist))
                        else (ls, hist)
    damage = sum $ map (head . drop 3) newHist
    newHP = min maxHP $ hp - damage + reg

import Control.Monad
import Data.List
import Data.Function

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

sndTpl (a,b,c) = b

go max hp dhp l ans sec
	| hp <= 0 = (sec, reverse ans)
	| otherwise = if null l' then last else go max (up $ dhp-d) (dhp-d) l'' ((sec,i):ans) (sec+1)
		where
			l' = [(p,d,i) | (p,d,i) <- l, hp*100 <= p * max]
			el@(p,d,i) = maximumBy (compare `on` sndTpl) l'
			l'' = delete el l
			last
				| dhp < 0 = go max (up dhp) dhp l ans (sec+1)
				| otherwise = (-1,[])
			up dx = min (hp+dx) max

solve n max reg pd = go max max reg pd' [] 0
	where
		pd' = [(p,d,i) | ([p,d],i) <- zip pd [1..n]]

pprint (sec,l) = yn ++ lprint
	where
		yn = if null l then ["NO"] else ["YES", show sec ++ " " ++ show (length l)]
		lprint = [show s ++ " " ++ show i | (s,i) <- l]

main = do
	[n,max,reg] <- ri
	pd <- forM [1..n] (\_ -> ri)
	let ans = solve n max reg pd
	putStrLn $ intercalate "\n" (pprint ans)

import Data.List
import Data.Maybe

main = interact f

f ss = case result of
         Nothing -> "NO"
         Just (t,x) -> (++) "YES\n" $ unlines $ map (unwords . map show) $ [t, length x]:(map (take 2) x)
  where
    ([n,max,reg]:l) = map (map (read :: String -> Int)) $ map words $ lines ss
    ls = sortBy (\[_,i,_] [_,j,_] -> compare i j) $ zipWith (:) [1..] l
    result = g 0 max max [] max reg ls

g time hp prevHP hist maxHP reg ls
  | hp <= 0 = Just (time, reverse hist)
  | otherwise =
      if (not canAttack && hp >= prevHP)
      then Nothing
      else g (time+1) newHP hp newHist maxHP reg newList
  where
    (possible, unpossible) = break (\[i,pow,dmg] -> pow*maxHP < hp*100) ls
    canAttack = possible /= []
    use = maximumBy (\[_,_,dmg1] [_,_,dmg2] -> compare dmg1 dmg2) possible
    (newL, newR) = break (== use) possible
    (newList,newHist) = if canAttack
                        then (newL++(tail newR)++unpossible, ((time:use):hist))
                        else (ls, hist)
    damage = sum $ map (head . drop 3) newHist
    newHP = min maxHP $ hp - damage + reg

import Data.List
import Data.Maybe

main = interact f

f ss = case result of
         Nothing -> "NO"
         Just (t,x) -> unlines $ map (unwords . map show) $ [t, length x]:(map (take 2) x)
  where
    ([n,max,reg]:l) = map (map (read :: String -> Int)) $ map words $ lines ss
    ls = sortBy (\[i,_,_] [j,_,_] -> compare i j) $ zipWith (:) [1..] l
    result = g 0 max max [] max reg ls

g time hp prevHP hist maxHP reg ls
  | hp <= 0 = Just (time, reverse hist)
  | otherwise =
      if (not canAttack && hp >= prevHP)
      then Nothing
      else g (time+1) newHP hp newHist maxHP reg newList
  where
    (possible, unpossible) = break (\[i,pow,dmg] -> pow*maxHP < hp*100) ls
    canAttack = possible /= []
    use = maximumBy (\[_,_,dmg1] [_,_,dmg2] -> compare dmg1 dmg2) possible
    (newL, newR) = break (== use) possible
    (newList,newHist) = if canAttack
                        then (newL++(tail newR)++unpossible, ((time:use):hist))
                        else (ls, hist)
    damage = sum $ map (head . drop 3) newHist
    newHP = min maxHP $ hp - damage + reg

import Data.List
import Data.Maybe

main = interact f

f ss = case result of
         Nothing -> "NO"
         Just (t,x) -> unlines $ map (unwords . map show) $ [t, length x]:(map (take 2) x)
  where
    ([n,max,reg]:l) = map (map (read :: String -> Int)) $ map words $ lines ss
    ls = sortBy (\[i,_,_] [j,_,_] -> compare i j) $ zipWith (:) [1..] l
    result = g 0 max max [] max reg ls

g time hp prevHP hist maxHP reg ls
  | hp <= 0 = Just (time, reverse hist)
  | otherwise =
      if (not canAttack && hp >= prevHP)
      then Nothing
      else g (time+1) newHP hp newHist maxHP reg newList
  where
    (possible, unpossible) = break (\[i,pow,dmg] -> pow < hp) ls
    canAttack = possible /= []
    use = maximumBy (\[_,_,dmg1] [_,_,dmg2] -> compare dmg1 dmg2) possible
    (newL, newR) = break (== use) possible
    (newList,newHist) = if canAttack
                        then (newL++(tail newR)++unpossible, ((time:use):hist))
                        else (ls, hist)
    damage = sum $ map (head . drop 3) newHist
    newHP = min maxHP $ hp - damage + reg

import Data.List
import Data.Maybe

main = interact f

f ss = case result of
         Nothing -> "NO"
         Just (t,x) -> (++) "YES\n" $ unlines $ map (unwords . map show) $ [t, length x]:(map (take 2) x)
  where
    ([n,max,reg]:l) = map (map (read :: String -> Int)) $ map words $ lines ss
    ls = sortBy (\[i,_,_] [j,_,_] -> compare i j) $ zipWith (:) [1..] l
    result = g 0 max max [] max reg ls

g time hp prevHP hist maxHP reg ls
  | hp <= 0 = Just (time, reverse hist)
  | otherwise =
      if (not canAttack && hp >= prevHP)
      then Nothing
      else g (time+1) newHP hp newHist maxHP reg newList
  where
    (possible, unpossible) = break (\[i,pow,dmg] -> pow*maxHP < hp*100) ls
    canAttack = possible /= []
    use = maximumBy (\[_,_,dmg1] [_,_,dmg2] -> compare dmg1 dmg2) possible
    (newL, newR) = break (== use) possible
    (newList,newHist) = if canAttack
                        then (newL++(tail newR)++unpossible, ((time:use):hist))
                        else (ls, hist)
    damage = sum $ map (head . drop 3) newHist
    newHP = min maxHP $ hp - damage + reg

import Control.Monad
import Data.List

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

go max hp dhp l@((p,d,i):ls) ans sec
	| hp <= 0 = (sec, reverse ans)
	| hp * 100 <= p * max = go max (up $ dhp-d) (dhp-d) ls ((sec,i):ans) (sec+1)
	| dhp < 0 = go max (up dhp) dhp l ans (sec+1)
	| otherwise = (-1,[])
	where
		up dx = min (hp+dx) max

solve n max reg pd = go max max reg pd' [] 0
	where
		pd' = reverse $ (0,0,0) : (sort $ [(p,d,i) | ([p,d],i) <- zip pd [1..n]])

pprint (sec,l) = yn ++ lprint
	where
		yn = if null l then ["NO"] else ["YES", show sec ++ " " ++ show (length l)]
		lprint = [show s ++ " " ++ show i | (s,i) <- l]

main = do
	[n,max,reg] <- ri
	pd <- forM [1..n] (\_ -> ri)
	let ans = solve n max reg pd
	putStrLn $ intercalate "\n" (pprint ans)


This is an interactive problem.Vasya and Petya are going to play the following game: Petya has some positive integer number $$$a$$$. After that Vasya should guess this number using the following questions. He can say a pair of non-negative integer numbers $$$(x, y)$$$. Petya will answer him:   "x", if $$$(x \bmod a) \geq (y \bmod a)$$$.  "y", if $$$(x \bmod a) < (y \bmod a)$$$. We define $$$(x \bmod a)$$$ as a remainder of division $$$x$$$ by $$$a$$$.Vasya should guess the number $$$a$$$ using no more, than 60 questions.It's guaranteed that Petya has a number, that satisfies the inequality $$$1 \leq a \leq 10^9$$$.Help Vasya playing this game and write a program, that will guess the number $$$a$$$.

NoteIn the first test, you should play $$$3$$$ games with Petya's numbers $$$1$$$, $$$2$$$ and $$$3$$$.In the first game, Petya will answer "x" (without quotes) to any question, because $$$(x \bmod 1) = 0$$$ for any integer $$$x$$$. In the second game, if you will ask pair $$$(0, 0)$$$, the answer will be "x" (without quotes), because $$$(0 \bmod 2) \geq (0 \bmod 2)$$$. But if you will ask pair $$$(2, 5)$$$, the answer will be "y" (without quotes), because $$$(2 \bmod 2) < (5 \bmod 2)$$$, because $$$(2 \bmod 2) = 0$$$ and $$$(5 \bmod 2) = 1$$$.

-- Codeforces Round #534 Div.2 (D), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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

main :: IO ()
main = do
  comm <- getLine
  case comm of
    "start" -> do res <- doQueries
                  putStrLn $ "! " ++ show res
                  hFlush stdout
                  main
    "mistake" -> exitFailure
    "end" -> exitSuccess

doQueries :: IO Int
doQueries = do
  is0 <- checkLt 0 1
  if not is0
    then
      return 1
    else do
      (l,u) <- searchMag 1 2
      binSearch l u
  where
    searchMag !l !u | u >= 10^9 = return (l,u)
                    | otherwise = do
                        ans <- checkLt l u
                        if ans
                          then searchMag u (u `shiftL` 1)
                          else return (l,u)
    binSearch lt geq
      | geq - lt <= 1 = return geq
      | otherwise = do ans <- checkLt lt mid
                       if ans then binSearch mid geq else binSearch lt mid
      where
        mid = (lt + geq) `shiftR` 1

checkLt :: Int -> Int -> IO Bool
checkLt x y = do
  putStrLn $ ("? " ++) $ shows x $ ' ' : show y
  hFlush stdout
  waitAns
  where waitAns = do ans:_ <- getLine
                     case ans of
                       'y' -> return True
                       'x' -> return False
                       'e' -> exitFailure
                       _   -> waitAns

-- Codeforces Round #534 Div.2 (D), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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

main :: IO ()
main = do
  comm <- getLine
  case comm of
    "start" -> do res <- doQueries
                  putStrLn $ "! " ++ show res
                  hFlush stdout
                  main
    "mistake" -> exitFailure
    "end" -> exitSuccess

doQueries :: IO Int
doQueries = do
  is0 <- checkLt 0 1
  if not is0
    then
      return 1
    else do
      (l,u) <- searchMag 1 3
      binSearch l u
  where
    searchMag !l !u | u >= 10^9 = return (l,u)
                    | otherwise = do
                        ans <- checkLt l u
                        if ans
                          then searchMag u (u `shiftL` 1 + 1)
                          else return (l,u)
    binSearch lt geq
      | geq - lt <= 1 = return geq
      | otherwise = do ans <- checkLt lt mid
                       if ans then binSearch mid geq else binSearch lt mid
      where
        mid = fromIntegral $
          (fromIntegral lt + fromIntegral geq :: Word) `shiftR` 1

checkLt :: Int -> Int -> IO Bool
checkLt x y = do
  putStrLn $ ("? " ++) $ shows x $ ' ' : show y
  hFlush stdout
  waitAns
  where waitAns = do ans:_ <- getLine
                     case ans of
                       'y' -> return True
                       'x' -> return False
                       'e' -> exitFailure
                       _   -> waitAns

-- Codeforces Round #534 Div.2 (D), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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

main :: IO ()
main = do
  comm <- getLine
  case comm of
    "start" -> do res <- doQueries
                  putStrLn $ "! " ++ show res
                  hFlush stdout
                  main
    "mistake" -> exitFailure
    "end" -> exitSuccess

doQueries :: IO Int
doQueries = do
  is0 <- checkLt 0 1
  if not is0
    then
      return 1
    else do
      (l,u) <- searchMag 1 2
      binSearch l u
  where
    db = (`shiftL` 1)
    searchMag !l !u | u >= 10^9 = return (l,u)
                    | otherwise = do
                        ans <- checkLt l u
                        if ans then searchMag (db l) (db u) else return (l,u)
    binSearch lt geq
      | geq - lt <= 1 = return geq
      | otherwise = do ans <- checkLt lt mid
                       if ans then binSearch mid geq else binSearch lt mid
      where
        mid = (lt + geq) `shiftR` 1

checkLt :: Int -> Int -> IO Bool
checkLt x y = do
  putStrLn $ ("? " ++) $ shows x $ ' ' : show y
  hFlush stdout
  waitAns
  where waitAns = do ans:_ <- getLine
                     case ans of
                       'y' -> return True
                       'x' -> return False
                       'e' -> exitFailure
                       _   -> waitAns

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import System.IO

main = do
  s <- getLine
  when (s == "start") play

play = do
  lower <- findLower 1
  v <- search (lower `div` 2) lower
  if v == 1
    then do
      response <- query (0, 1)
      if response == "x" then answer 1 else answer 2
    else do
      response <- query (1, 2 * v - 1)
      if response == "x" then answer $ 2 * v - 1 else answer $ 2 * v
  main

findLower v = do
  response <- query (v, 2 * v)
  if response == "x" then return v else findLower (2 * v)

search l r = do
  if l == r - 1
    then return r
    else do
      let m = (l + r) `div` 2
      response <- query (m, 2 * m)
      if response == "x" then search l m else search m r

query (x, y) = do
  putStrLn $ "? " ++ show x ++ " " ++ show y
  hFlush stdout
  getLine

answer v = do
  putStrLn $ "! " ++ show v
  hFlush stdout

-- Codeforces Round #534 Div.2 (D), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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

main :: IO ()
main = do
  comm <- getLine
  case comm of
    "start" -> do res <- doQueries
                  putStrLn $ "! " ++ show res
                  hFlush stdout
                  main
    "mistake" -> exitFailure
    "end" -> exitSuccess

doQueries :: IO Int
doQueries = do
  is0 <- checkLt 0 1
  if not is0
    then
      return 1
    else do
      (l,u) <- searchMag 1 2
      binSearch l u
  where
    searchMag !l !u | u >= 10^9 = return (l,u)
                    | otherwise = do
                        ans <- checkLt l u
                        if ans
                          then searchMag u (u `shiftL` 1 + 1)
                          else return (l,u)
    binSearch lt geq
      | geq - lt <= 1 = return geq
      | otherwise = do ans <- checkLt lt mid
                       if ans then binSearch mid geq else binSearch lt mid
      where
        mid = (lt + geq) `shiftR` 1

checkLt :: Int -> Int -> IO Bool
checkLt x y = do
  putStrLn $ ("? " ++) $ shows x $ ' ' : show y
  hFlush stdout
  waitAns
  where waitAns = do ans:_ <- getLine
                     case ans of
                       'y' -> return True
                       'x' -> return False
                       'e' -> exitFailure
                       _   -> waitAns

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import System.IO

main = do
  s <- getLine
  when (s == "start") play

play = do
  lower <- findLower 1
  v <- search (lower `div` 2) lower
  if v == 1
    then do
      response <- query (1, 0)
      if response == "x" then answer 1 else answer 2
    else do
      response <- query (1, 2 * v - 1)
      if response == "x" then answer $ 2 * v - 1 else answer $ 2 * v
  main

findLower v = do
  response <- query (v, 2 * v)
  if response == "x" then return v else findLower (2 * v)

search l r = do
  if l == r - 1
    then return r
    else do
      let m = (l + r) `div` 2
      response <- query (m, 2 * m)
      if response == "x" then search l m else search m r

query (x, y) = do
  putStrLn $ "? " ++ show x ++ " " ++ show y
  hFlush stdout
  getLine

answer v = do
  putStrLn $ "! " ++ show v
  hFlush stdout


You are given a sequence a1, a2, ..., an of one-dimensional segments numbered 1 through n. Your task is to find two distinct indices i and j such that segment ai lies within segment aj.Segment [l1, r1] lies within segment [l2, r2] iff l1 ≥ l2 and r1 ≤ r2.Print indices i and j. If there are multiple answers, print any of them. If no answer exists, print -1 -1.

The first line contains one integer n (1 ≤ n ≤ 3·105) — the number of segments. Each of the next n lines contains two integers li and ri (1 ≤ li ≤ ri ≤ 109) — the i-th segment.

Print two distinct indices i and j such that segment ai lies within segment aj. If there are multiple answers, print any of them. If no answer exists, print -1 -1.

NoteIn the first example the following pairs are considered correct:  (2, 1), (3, 1), (4, 1), (5, 1) — not even touching borders;  (3, 2), (4, 2), (3, 5), (4, 5) — touch one border;  (5, 2), (2, 5) — match exactly.

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.IntMap as M
import Data.Function
import Data.List
import Data.Maybe
import Data.Ord

main = do
  getLine
  input <- B.getContents
  let as = map ((\[x,y]->x`seq`y`seq`(x,y)) . map readInt . B.words) $ B.lines input
  putStrLn $ (\(x,y)-> show x++" " ++ show y) (solve as)

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

type ISegment = (Int,(Int,Int))

solve :: [(Int,Int)] -> (Int,Int)
solve as =
  case take 1 (rdups ++ ldups) of
    [(i1,(x1,y1)):(i2,(x2,y2)):dups] -> if (x1 <= x2 && y2 <= y1) then (i2,i1) else (i1,i2)
    []                               -> head $ catMaybes $ (map fst (scanl f (Nothing, map head ls) (map head rs))) ++ [Just (-1,-1)]
  where
    rdups, rs :: [[ISegment]]
    (rdups,rs) = partition ((1<).length) $ groupBy ((==)`on`(fst.snd)) $ sortBy (comparing (fst.snd)) $ zip [1..] as

    ldups, ls :: [[ISegment]]
    (ldups,ls) = partition ((1<).length) $ groupBy ((==)`on`(snd.snd)) $ sortBy (comparing (snd.snd)) $ zip [1..] as

    f :: (Maybe (Int,Int), [ISegment]) -> ISegment -> (Maybe (Int,Int), [ISegment])
    f (_,ts) (i,(x,y)) =
      let (cands,rests) = span ((<=y).snd.snd) ts
      in case filter ((/=i).fst) cands  of
           []               -> (Nothing, rests)
           ((i2,(x2,y2)):_) -> (Just (i2,i), rests)

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.IntMap as M
import Data.Function
import Data.List
import Data.Maybe
import Data.Ord

main = do
  getLine
  input <- B.getContents
  let as = map ((\[x,y]->x`seq`y`seq`(x,y)) . map readInt . B.words) $ B.lines input
  putStrLn $ (\(x,y)-> show x++" " ++ show y) (solve as)

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

type ISegment = (Int,(Int,Int))

solve :: [(Int,Int)] -> (Int,Int)
solve as =
  case take 1 (rdups ++ ldups) of
    [(i1,(x1,y1)):(i2,(x2,y2)):dups] -> if (x1 <= x2 && y2 <= y1) then (i2,i1) else (i1,i2)
    []                               -> head $ catMaybes $ (map fst (scanl f (Nothing,lm) (map head rs))) ++ [Just (-1,-1)]
  where
    rdups, rs :: [[ISegment]]
    (rdups,rs) = partition ((<1).length) $ groupBy ((==)`on`(fst.snd)) $ sortBy (comparing (fst.snd)) $ zip [1..] as

    ldups, ls :: [[ISegment]]
    (ldups,ls) = partition ((<1).length) $ groupBy ((==)`on`(snd.snd)) $ sortBy (comparing (snd.snd)) $ zip [1..] as

    lm :: M.IntMap (Int,Int)
    lm = M.fromList[(y,(i,x)) | (i,(x,y))<- map head ls]

    f :: (Maybe (Int,Int), M.IntMap (Int,Int)) -> ISegment -> (Maybe (Int,Int), M.IntMap (Int,Int))
    f (_,m) (i,(x,y)) =
      let cands = catMaybes [M.lookupLT y m, M.lookupLE y m]
      in case filter ((/=i).fst.snd) cands  of
           []               -> (Nothing, (foldr M.delete m (map fst cands)))
           ((ym,(im,xm)):_) -> (Just (im,i), m)