While doing some spring cleaning, Daniel found an old calculator that he loves so much. However, it seems like it is broken. When he tries to compute $$$1 + 3$$$ using the calculator, he gets $$$2$$$ instead of $$$4$$$. But when he tries computing $$$1 + 4$$$, he gets the correct answer, $$$5$$$. Puzzled by this mystery, he opened up his calculator and found the answer to the riddle: the full adders became half adders! So, when he tries to compute the sum $$$a + b$$$ using the calculator, he instead gets the xorsum $$$a \oplus b$$$ (read the definition by the link: https://en.wikipedia.org/wiki/Exclusive_or).As he saw earlier, the calculator sometimes gives the correct answer. And so, he wonders, given integers $$$l$$$ and $$$r$$$, how many pairs of integers $$$(a, b)$$$ satisfy the following conditions: $$$$$$a + b = a \oplus b$$$$$$ $$$$$$l \leq a \leq r$$$$$$ $$$$$$l \leq b \leq r$$$$$$However, Daniel the Barman is going to the bar and will return in two hours. He tells you to solve the problem before he returns, or else you will have to enjoy being blocked.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of testcases. Then, $$$t$$$ lines follow, each containing two space-separated integers $$$l$$$ and $$$r$$$ ($$$0 \le l \le r \le 10^9$$$).

Print $$$t$$$ integers, the $$$i$$$-th integer should be the answer to the $$$i$$$-th testcase.

m :: Int->Int->Integer
m 2 2 = 3;
m 2 x | x == 0 = 2 | x == 1 = 1
m x 2 = m 2 x
m 1 1 = 0
m _ _ = 1

z :: [Int]->[Int]->Integer
z a b = foldl (\x y->x*y) 1 (zipWith m a b)

slv :: [[Int]]->Integer
slv xs = foldl (\x y->x+y) 0 [z x ye | x <- xs, ye <- xs]

bi :: Int->Int->[Int]
bi 0 _ = []
bi n x = (mod x 2: bi (n-1) (quot x 2))

mk :: Int->Int->Int->[[Int]]
mk _ _ 1 = []
mk _ _ 0 = []
mk f n x = if (x `mod` 2) == f then ((replicate n 2)++[1-f]++(bi (30-n-1) (quot x 2))):ls else ls where ls = mk f (n + 1) (quot x 2)

cn :: Int->Int->Int->[[Int]]
cn 30 _ _ = []
cn pt le ri = if le < 2^pt && 2^(pt+1) <= ri then ((replicate pt 2)++[1]++(replicate (30-pt-1) 0)):ls else ls where ls = cn (pt+1) le ri

wr :: [Int]->Integer
wr (0:0:_) = 1
wr (0:ri:x) = (wr (1:ri:x)) + (toInteger ri) * 2 + 1
wr (le:ri:_) = slv((cn 0 (le-1) (ri+1))++(mk 0 0 (le-1))++(mk 1 0 (ri+1)))

rdd :: String->[Int]
rdd = map read . words

main = do
 t <- getLine
 semi <- sequence (replicate ((read t)::Int) getLine)
 mapM_ print (map (wr . rdd) semi)

m 2 2 =3
m 2 x |x==0=2|x==1=1
m x 2 =m 2 x
m 1 1 =0
m _ _ =1
z a b = foldl (\x y->x*y) 1 (zipWith m a b)
slv xs = foldl (\x y->x+y) 0 [z x ye | x <- xs, ye <- xs]
bi 0 _ = []
bi n x = (mod x 2: bi (n-1) (quot x 2))
mk _ _ 1 = []
mk _ _ 0 = []
mk f n x = if (x `mod` 2) == f then ((replicate n 2)++[1-f]++(bi (30-n-1) (quot x 2))):ls else ls where ls = mk f (n + 1) (quot x 2)
cn 30 _ _ = []
cn pt le ri = if le < 2^pt && 2^(pt+1) <= ri then ((replicate pt 2)++[1]++(replicate (30-pt-1) 0)):ls else ls where ls = cn (pt+1) le ri
wr (0:0:_) = 1
wr (0:ri:x) = (wr (1:ri:x)) + (toInteger ri) * 2 + 1
wr (le:ri:_) = slv((cn 0 (le-1) (ri+1))++(mk 0 0 (le-1))++(mk 1 0 (ri+1)))
rdd = map read . words
main = do
 t <- getLine
 semi <- sequence (replicate ((read t)::Int) getLine)
 mapM_ print (map (wr . rdd) semi)

m 2 2=3
m 2 x|x==0=2|x==1=1
m x 2=m 2 x
m 1 1=0
m _ _=1
l=getLine
k=replicate
q=quot
o=foldl
z a b=o(\x y->x*y)1(zipWith m a b)
s u=o(\x y->x+y)0[z x y|x<-u,y<-u]
b 0 _=[]
b n x=mod x 2:b(n-1)(q x 2)
c _ _ 1=[]
c _ _ 0=[]
c f n x=if(x`mod`2)==f then((k n 2)++[1-f]++(b(30-n-1)(q x 2))):ls else ls where ls=c f(n+1)(q x 2)
e 30 _ _=[]
e pt l r=if l<2^pt&&2^(pt+1)<=r then((k pt 2)++[1]++(k(30-pt-1)0)):ls else ls where ls=e(pt+1)l r
w(0:0:_)=1
w(0:ri:x)=(w(1:ri:x))+(toInteger ri)*2+1
w(le:ri:_)=s((e 0(le-1)(ri+1))++(c 0 0(le-1))++(c 1 0(ri+1)))
r=map read.words
main=do
 t<-l
 semi<-sequence(k((read t)::Int)l)
 mapM_ print(map(w.r)semi)

m :: Int->Int->Integer
m 2 2 = 3;
m 2 x | x == 0 = 2 | x == 1 = 1
m x 2 = m 2 x
m 1 1 = 0
m _ _ = 1

z :: [Int]->[Int]->Integer
z a b = foldl (\x y->x*y) 1 (zipWith m a b)

slv :: [[Int]]->Integer
slv xs = foldl (\x y->x+y) 0 [z x ye | x <- xs, ye <- xs]

bi :: Int->Int->[Int]
bi 0 _ = []
bi n x = (mod x 2: bi (n-1) (quot x 2))

mk :: Int->Int->Int->[[Int]]
mk _ _ 1 = []
mk _ _ 0 = []
mk f n x = if (x `mod` 2) == f then ((replicate n 2)++[1-f]++(bi (30-n-1) (quot x 2))):ls else ls where ls = mk f (n + 1) (quot x 2)

cn :: Int->Int->Int->[[Int]]
cn 30 _ _ = []
cn pt le ri = if le < 2^pt && 2^(pt+1) <= ri then ((replicate pt 2)++[1]++(replicate (30-pt-1) 0)):ls else ls where ls = cn (pt+1) le ri

wr :: [Int]->Integer
wr (0:0:_) = 1
wr (0:ri:x) = (wr (1:ri:x)) + (toInteger ri) * 2 - 1
wr (le:ri:_) = slv((cn 0 (le-1) (ri+1))++(mk 0 0 (le-1))++(mk 1 0 (ri+1)))

rdd :: String->[Int]
rdd = map read . words

main = do
 t <- getLine
 semi <- sequence (replicate ((read t)::Int) getLine)
 mapM_ print (map (wr . rdd) semi)


A student's life is fraught with complications. Some Berland University students know this only too well. Having studied for two years, they contracted strong antipathy towards the chairperson of some department. Indeed, the person in question wasn't the kindest of ladies to begin with: prone to reforming groups, banning automatic passes and other mean deeds. At last the students decided that she just can't get away with all this anymore...The students pulled some strings on the higher levels and learned that the next University directors' meeting is going to discuss n orders about the chairperson and accept exactly p of them. There are two values assigned to each order: ai is the number of the chairperson's hairs that turn grey if she obeys the order and bi — the displeasement of the directors if the order isn't obeyed. The students may make the directors pass any p orders chosen by them. The students know that the chairperson will obey exactly k out of these p orders. She will pick the orders to obey in the way that minimizes first, the directors' displeasement and second, the number of hairs on her head that turn grey.The students want to choose p orders in the way that maximizes the number of hairs on the chairperson's head that turn grey. If there are multiple ways to accept the orders, then the students are keen on maximizing the directors' displeasement with the chairperson's actions. Help them.

The first line contains three integers n (1 ≤ n ≤ 105), p (1 ≤ p ≤ n), k (1 ≤ k ≤ p) — the number of orders the directors are going to discuss, the number of orders to pass and the number of orders to be obeyed by the chairperson, correspondingly. Each of the following n lines contains two integers ai and bi (1 ≤ ai, bi ≤ 109), describing the corresponding order.

Print in an arbitrary order p distinct integers — the numbers of the orders to accept so that the students could carry out the revenge. The orders are indexed from 1 to n in the order they occur in the input. If there are multiple solutions, you can print any of them.

NoteIn the first sample one of optimal solutions is to pass orders 1, 2, 3. In this case the chairperson obeys orders number 1 and 2. She gets 10 new grey hairs in the head and the directors' displeasement will equal 3. Note that the same result can be achieved with order 4 instead of order 3.In the second sample, the chairperson can obey all the orders, so the best strategy for the students is to pick the orders with the maximum sum of ai values. The chairperson gets 58 new gray hairs and the directors' displeasement will equal 0.

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

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

import Data.List
import Data.Monoid
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
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

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,p,k] <- map readInt . B.words <$> B.getLine
    l <- replicateM n (parse <$> B.getLine)
    putStrLn $ unwords $ map show $ solve n p k l

parse s = let [a,b] = map readInt $ B.words $ s in (a,b)

cmp1 (a,b) (c,d) = compare c a `mappend` compare d b
cmp2 (a,b) (c,d) = compare b d `mappend` compare c a

newtype Order = Order { unOrder :: ((Int,Int),Int) } deriving (Eq)
instance Ord Order where
    compare (Order (a,b)) (Order (c,d)) = cmp2 a c `mappend` compare b d
instance Show Order where
    show (Order a) = show a

insert' a s = S.insert (Order a) s
member' a s = S.member (Order a) s
delete' a s = S.delete (Order a) s

solve n p k l = map (snd.unOrder)$ loop init s2 (drop k l1)
    where
    l1 = sortBy (\(a,b) (c,d) -> cmp1 a c) (zip l [1..])
    s2 = (S.fromList $ map Order (zip l [1..])) S.\\ init
    init = S.fromList $ map Order (take k l1)
    loop !s1 !s2 l1 | d >= p - k = S.toList s1 ++
                                   (take (p-k) $ reverse $ S.toList s21)
                    | otherwise  = let s1' = insert' hd $ S.delete o s1
                                       s2' = S.insert o $ delete' hd s2
                                   in {-traceShow ("swap "++show hd++show o) $-}
                                      loop s1' s2' l1'
        where
        o = S.findMin s1
        (hd:l1') = l1
        (s21,s22) = S.split o s2
        d =  S.size s21

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

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

import Data.List
import Data.Monoid
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
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

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,p,k] <- map readInt . B.words <$> B.getLine
    l <- replicateM n (parse <$> B.getLine)
    putStrLn $ unwords $ map show $ solve2 n p k l

parse s = let [a,b] = map readInt $ B.words $ s in (a,b)

cmp1 (a,b) (c,d) = compare c a `mappend` compare d b
cmp2 (a,b) (c,d) = compare b d `mappend` compare c a

newtype Order = Order { unOrder :: ((Int,Int),Int) } deriving (Eq)
instance Ord Order where
    compare (Order (a,b)) (Order (c,d)) = cmp2 a c `mappend` compare b d
instance Show Order where
    show (Order a) = show a

insert' a s = S.insert (Order a) s
member' a s = S.member (Order a) s
delete' a s = S.delete (Order a) s

sort' = map unOrder . sort . map Order
solve2 n p k l = map (snd) $ e ++ c
    where
    l2 = sort' (zip l [1..])
    (a,b)= splitAt (p-k) l2
    l1 = reverse $ sort $ b
    (c,d)= splitAt k l1
    x = minimum $ map Order c
    e = take (p-k) $ reverse $ a++(takeWhile f $ sort' d)
    f a = Order a `compare` x == LT

solve n p k l = map (snd.unOrder)$ loop init s2 (drop k l1)
    where
    l1 = sortBy (\(a,b) (c,d) -> cmp1 a c) (zip l [1..])
    s2 = (S.fromList $ map Order (zip l [1..])) S.\\ init
    init = S.fromList $ map Order (take k l1)
    loop !s1 !s2 l1 | d >= p - k = S.toList s1 ++
                                   (take (p-k) $ reverse $ S.toList s21)
                    | otherwise  = let s1' = insert' hd $ S.delete o s1
                                       s2' = S.insert o $ delete' hd s2
                                   in {-traceShow ("swap "++show hd++show o) $-}
                                      loop s1' s2' l1'
        where
        o = S.findMin s1
        (hd:l1') = l1
        (s21,s22) = S.split o s2
        d =  S.size s21

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

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

import Data.List
import Data.Monoid
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
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

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,p,k] <- map readInt . B.words <$> B.getLine
    l <- replicateM n (parse <$> B.getLine)
    putStrLn $ unwords $ map show $ solve2 n p k l

parse s = let [a,b] = map readInt $ B.words $ s in (a,b)

cmp1 (a,b) (c,d) = compare c a `mappend` compare d b
cmp2 (a,b) (c,d) = compare b d `mappend` compare c a

newtype Order = Order { unOrder :: ((Int,Int),Int) } deriving (Eq)
instance Ord Order where
    compare (Order (a,b)) (Order (c,d)) = cmp2 a c `mappend` compare b d
instance Show Order where
    show (Order a) = show a

insert' a s = S.insert (Order a) s
member' a s = S.member (Order a) s
delete' a s = S.delete (Order a) s

solve2 n p k l = map (snd) $ take (p-k) a ++ take k l1
    where
    l2 = map unOrder$ sort $ map Order (zip l [1..])
    (a,b) = go l2 undefined k []
    go [] _ 0 acc = (acc,[])
    go (x:xs) k 0 acc | cmp2 (fst x) k == EQ = go xs k 0 (x:acc)
                      | otherwise            = (acc,x:xs)
    go (x:xs) k n acc = go xs (fst x) (n-1) (x:acc)
    l1 = reverse $ sort $ b

solve n p k l = map (snd.unOrder)$ loop init s2 (drop k l1)
    where
    l1 = sortBy (\(a,b) (c,d) -> cmp1 a c) (zip l [1..])
    s2 = (S.fromList $ map Order (zip l [1..])) S.\\ init
    init = S.fromList $ map Order (take k l1)
    loop !s1 !s2 l1 | d >= p - k = S.toList s1 ++
                                   (take (p-k) $ reverse $ S.toList s21)
                    | otherwise  = let s1' = insert' hd $ S.delete o s1
                                       s2' = S.insert o $ delete' hd s2
                                   in {-traceShow ("swap "++show hd++show o) $-}
                                      loop s1' s2' l1'
        where
        o = S.findMin s1
        (hd:l1') = l1
        (s21,s22) = S.split o s2
        d =  S.size s21

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

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

import Data.List
import Data.Monoid
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
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

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,p,k] <- map readInt . B.words <$> B.getLine
    l <- replicateM n (parse <$> B.getLine)
    putStrLn $ unwords $ map show $ solve2 n p k l

parse s = let [a,b] = map readInt $ B.words $ s in (a,b)

cmp1 (a,b) (c,d) = compare c a `mappend` compare d b
cmp2 (a,b) (c,d) = compare b d `mappend` compare c a

newtype Order = Order { unOrder :: ((Int,Int),Int) } deriving (Eq)
instance Ord Order where
    compare (Order (a,b)) (Order (c,d)) = cmp2 a c `mappend` compare b d
instance Show Order where
    show (Order a) = show a

insert' a s = S.insert (Order a) s
member' a s = S.member (Order a) s
delete' a s = S.delete (Order a) s

sort' = map unOrder . sort . map Order
solve2 n p k l = map (snd) $ e ++ c
    where
    l2 = sort' (zip l [1..])
    (a,b)= splitAt (p-k) l2
    l1 = reverse $ sort $ b
    (c,d)= splitAt k b
    x = minimum $ map Order c
    e = take (p-k) $ reverse $ a++(takeWhile f $ sort' d)
    f a = Order a `compare` x == LT

solve n p k l = map (snd.unOrder)$ loop init s2 (drop k l1)
    where
    l1 = sortBy (\(a,b) (c,d) -> cmp1 a c) (zip l [1..])
    s2 = (S.fromList $ map Order (zip l [1..])) S.\\ init
    init = S.fromList $ map Order (take k l1)
    loop !s1 !s2 l1 | d >= p - k = S.toList s1 ++
                                   (take (p-k) $ reverse $ S.toList s21)
                    | otherwise  = let s1' = insert' hd $ S.delete o s1
                                       s2' = S.insert o $ delete' hd s2
                                   in {-traceShow ("swap "++show hd++show o) $-}
                                      loop s1' s2' l1'
        where
        o = S.findMin s1
        (hd:l1') = l1
        (s21,s22) = S.split o s2
        d =  S.size s21

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

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

import Data.List
import Data.Monoid
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
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

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,p,k] <- map readInt . B.words <$> B.getLine
    l <- replicateM n (parse <$> B.getLine)
    putStrLn $ unwords $ map show $ solve2 n p k l

parse s = let [a,b] = map readInt $ B.words $ s in (a,b)

cmp1 (a,b) (c,d) = compare c a `mappend` compare d b
cmp2 (a,b) (c,d) = compare b d `mappend` compare c a

newtype Order = Order { unOrder :: ((Int,Int),Int) } deriving (Eq)
instance Ord Order where
    compare (Order (a,b)) (Order (c,d)) = cmp2 a c `mappend` compare b d
instance Show Order where
    show (Order a) = show a

insert' a s = S.insert (Order a) s
member' a s = S.member (Order a) s
delete' a s = S.delete (Order a) s

solve2 n p k l = map (snd.unOrder) $ a ++ take k (map Order l1)
    where
    l2 = sort $ map Order (zip l [1..])
    (a,b) = splitAt (p-k) l2
    l1 = reverse $ sort $ map unOrder b

solve n p k l = map (snd.unOrder)$ loop init s2 (drop k l1)
    where
    l1 = sortBy (\(a,b) (c,d) -> cmp1 a c) (zip l [1..])
    s2 = (S.fromList $ map Order (zip l [1..])) S.\\ init
    init = S.fromList $ map Order (take k l1)
    loop !s1 !s2 l1 | d >= p - k = S.toList s1 ++
                                   (take (p-k) $ reverse $ S.toList s21)
                    | otherwise  = let s1' = insert' hd $ S.delete o s1
                                       s2' = S.insert o $ delete' hd s2
                                   in {-traceShow ("swap "++show hd++show o) $-}
                                      loop s1' s2' l1'
        where
        o = S.findMin s1
        (hd:l1') = l1
        (s21,s22) = S.split o s2
        d =  S.size s21

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

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

import Data.List
import Data.Monoid
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
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

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,p,k] <- map readInt . B.words <$> B.getLine
    l <- replicateM n (parse <$> B.getLine)
    putStrLn $ unwords $ map show $ solve n p k l

parse s = let [a,b] = map readInt $ B.words $ s in (a,b)

cmp1 (a,b) (c,d) = compare c a `mappend` compare d b
cmp2 (a,b) (c,d) = compare d b `mappend` compare c a

newtype Order = Order { unOrder :: ((Int,Int),Int) } deriving (Eq)
instance Ord Order where
    compare (Order (a,b)) (Order (c,d)) = cmp2 a c `mappend` compare b d
instance Show Order where
    show (Order a) = show a

insert' a s = S.insert (Order a) s
member' a s = S.member (Order a) s
delete' a s = S.delete (Order a) s

solve n p k l = {-traceShow l1 $ traceShow l2 $ -} map (snd.unOrder)$ loop S.empty S.empty l1 l2
    where
    l1 = sortBy (\(a,b) (c,d) -> cmp1 a c) (zip l [1..])
    l2 = S.fromList $ map Order (zip l [1..])
    loop !s1 !s2 l1 l2
        | S.size s1 < k   = let s1' = insert' hd1 s1
                                s2' = insert' hd1 s1
                            in {-trace ("insert1 "++show hd1) $  -}
                                 loop s1' s2' l1' l2
        | S.size s1 >= p  = S.toList s1
        | S.member hd2 s1  = loop s1 s2 l1 l2'
        | Order o > hd2   = {- trace ("insert2 "++show hd2) $  -}
                            loop (S.insert hd2 s1) s2 l1 l2'
        | otherwise       = let s1' = insert' hd1 $ delete' o s1
                                s2' = insert' hd1 $ delete' o s2
                                l2'' = insert' o l2
                            in {- traceShow (compare (Order o) hd2) $
                               trace ("swap "++show o++show hd1++show hd2) $ -}
                            loop s1' s2' l1' l2''
        where
        hd1:l1' = l1
        (hd2,l2') = S.deleteFindMin l2
        o = unOrder $ S.findMin s2

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

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

import Data.List
import Data.Monoid
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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
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

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    [n,p,k] <- map readInt . B.words <$> B.getLine
    l <- replicateM n (parse <$> B.getLine)
    putStrLn $ unwords $ map show $ solve2 n p k l

parse s = let [a,b] = map readInt $ B.words $ s in (a,b)

cmp1 (a,b) (c,d) = compare c a `mappend` compare d b
cmp2 (a,b) (c,d) = compare b d `mappend` compare c a

newtype Order = Order { unOrder :: ((Int,Int),Int) } deriving (Eq)
instance Ord Order where
    compare (Order (a,b)) (Order (c,d)) = cmp2 a c `mappend` compare b d
instance Show Order where
    show (Order a) = show a

insert' a s = S.insert (Order a) s
member' a s = S.member (Order a) s
delete' a s = S.delete (Order a) s

solve2 n p k l = map (snd) $ take (p-k) a ++ take k l1
    where
    l2 = map unOrder$ sort $ map Order (zip l [1..])
    (a,b) = go l2 (0,0) (p-k) []
    go [] _ 0 acc = (acc,[])
    go (x:xs) k 0 acc | cmp2 (fst x) k == EQ = go xs k 0 (x:acc)
                      | otherwise            = (acc,x:xs)
    go (x:xs) k n acc = go xs (fst x) (n-1) (x:acc)
    l1 = reverse $ sort $ b

solve n p k l = map (snd.unOrder)$ loop init s2 (drop k l1)
    where
    l1 = sortBy (\(a,b) (c,d) -> cmp1 a c) (zip l [1..])
    s2 = (S.fromList $ map Order (zip l [1..])) S.\\ init
    init = S.fromList $ map Order (take k l1)
    loop !s1 !s2 l1 | d >= p - k = S.toList s1 ++
                                   (take (p-k) $ reverse $ S.toList s21)
                    | otherwise  = let s1' = insert' hd $ S.delete o s1
                                       s2' = S.insert o $ delete' hd s2
                                   in {-traceShow ("swap "++show hd++show o) $-}
                                      loop s1' s2' l1'
        where
        o = S.findMin s1
        (hd:l1') = l1
        (s21,s22) = S.split o s2
        d =  S.size s21


Fox Ciel and her friends are in a dancing room. There are n boys and m girls here, and they never danced before. There will be some songs, during each song, there must be exactly one boy and one girl are dancing. Besides, there is a special rule:  either the boy in the dancing pair must dance for the first time (so, he didn't dance with anyone before);  or the girl in the dancing pair must dance for the first time. Help Fox Ciel to make a schedule that they can dance as many songs as possible.

The first line contains two integers n and m (1 ≤ n, m ≤ 100) — the number of boys and girls in the dancing room.

In the first line print k — the number of songs during which they can dance. Then in the following k lines, print the indexes of boys and girls dancing during songs chronologically. You can assume that the boys are indexed from 1 to n, and the girls are indexed from 1 to m.

NoteIn test case 1, there are 2 boys and 1 girl. We can have 2 dances: the 1st boy and 1st girl (during the first song), the 2nd boy and 1st girl (during the second song).And in test case 2, we have 2 boys with 2 girls, the answer is 3.

parse :: String -> [Int]
parse = (map read) . words

solve :: [Int] -> [(Int, Int)]
solve [n, m] = (allWithFirst n) ++ (reverseAll $ drop 1 (allWithFirst m))
        where
            allWithFirst x = [(y, 1) | y <- [1 .. x]]
            reverseAll = map (\(x, y) -> (y, x))

output :: [(Int, Int)] -> String
output x = (show $ length x) ++ "\n" ++ outputPairs x

outputPairs [] = "\n"
outputPairs (x:xs) = (show $ fst x) ++ " " ++ (show $ snd x) ++ "\n" ++ outputPairs xs

main = interact $ output . solve . parse

{-# OPTIONS_GHC -O2 -Wall -fno-warn-missing-signatures -fno-warn-type-defaults #-}

main = interact $ sv. head. lines
sv str = unlines $ show (length ls): ls
  where ls = pair ((map read.words) str)
pair [n,m] = let f=zipWith (\x y->show x++" "++show y) in f (repeat 1) [1..m] ++ f [2..n] (repeat m)

readArr :: (Read t) => IO [t]
readArr = fmap ((fmap read) . words) getLine

front2 :: [t] -> (t, t)
front2 (x:y:_) = (x, y)

plprint :: (Show a, Show b) => [(a, b)] -> IO ()
plprint = sequence_ . (fmap (\(a, b) -> putStrLn $ show a ++ " " ++ show b))

psort :: (Ord t) => (t, t) -> (t, t)
psort (x, y)
    | x > y = (y, x)
    | otherwise = (x, y)

main = do
    (n, m) <- (fmap front2) (readArr :: IO [Int])
    let li = [(1, a) | a <- [1..m]] ++ [(a, 1) | a <- [2..n]]
    print $ length li
    plprint li

import Control.Monad (liftM)

solve :: [Int] -> [(Int, Int)]
solve [a, b]  =  [(1, i) | i <- [1..b]] ++ [(i, 1) | i <- [2..a]]

print' :: [(Int, Int)] -> IO ()
print' xs  =  print (length xs) >> mapM_ print'' xs
  where
    print'' (x, y)  =  putStrLn $ concat [show x, " ", show y]

main :: IO ()
main  =  liftM (map read . words) getLine >>= print' . solve

import Control.Applicative

solve :: Int -> Int -> [[Int]]
solve n m =
  [[1, j] | j <- [1..m]] ++ [[i, m] | i <- [2..n]]

main :: IO ()
main = do
  [n, m] <- map read . words <$> getLine
  let solns = solve n m
  putStrLn $ show $ length solns
  putStrLn $ unlines $ map (unwords . map show) $ solns

main=getContents>>=(\[n,m]->(print(n+m-1)>>mapM_(putStrLn.unwords.map show)(f n m))).map read.words
f n m=[[1,k]|k<-[1..m]]++[[k,1]|k<-[2..n]]

main :: IO ()
main = getContents >>= (\[n, m] -> (print (n + m - 1) >> mapM_ (putStrLn . unwords . map show) (solve n m))) . map read . words

solve :: Integer -> Integer -> [[Integer]]
solve n m = [ [ 1, k ] | k <- [1..m] ] ++ [ [ k, m ] | k <- [2..n] ]

main = do
   [n, m] <- fmap (map read . words) getLine
   let pairs = solve n m
   print $ length pairs
   mapM (\(x, y) -> putStrLn $ show x ++ " " ++ show y) pairs

solve :: Int -> Int -> [(Int, Int)]
solve boys girls = (map (\x -> (1, x)) [1..girls]) ++ (map (\x -> (x, 1)) [2..boys])

main = do
   l <- getContents
   let [n, m] = map read (words l) :: [Int]
   putStrLn $ show (m + n - 1)
   let answer = zip [1,1..] [1..m] ++ zip [2..n] [1,1..]
   sequence_ (map printTuple answer)

   where
      printTuple (a, b) = putStrLn $ (show a) ++ " " ++ (show b)

gen :: Int -> Int -> [(Int, Int)]
gen a b = [(i, j) | i <- [1..a], j <- [1..b], i == 1 || j == 1]

fmt :: (Int, Int) -> String
fmt (i,j) = ((show i)++ " " ++ (show j) ++ "\n")

solve :: String -> String
solve input = (show $ length res) ++ "\n" ++ (concat (map fmt res))
  where (a:b:xs) = map read (words input)
        res = gen a b
main = do
  interact solve

import Control.Applicative
import Data.List

del x (a:as) 	| x==a = as
		| otherwise = a: (del x as)

main= do
	[a,b]<- map read. words <$> getLine::IO [Int]
	print $ a+b-1
	putStr $ unlines $ map (\x->  ( show x) ++ " 1" )   [1..a]
	putStrLn $ unlines $ map (\x->  ( show a) ++ " " ++ show x )   [2..b]

import Control.Monad

main :: IO ()
main = do
  m:n:_ <- liftM (map read . words) getLine
  print (m + n - 1)
  mapM_ putStrLn $ (map ((++) "1 " . show) [1..n]) ++ (map (flip (++) " 1" . show) [2..m])

import Data.List

solve n m = xs ++ ys where
    xs = ["1 " ++ show j | j <- [1..m]]
    ys = [show i ++ " " ++ show 1 | i <- [2..n]]

main = do
    line <- getLine
    let [n, m] = map read $ words line :: [Int]
    let xs = solve n m
    print $ length xs
    putStrLn $ intercalate "\n" xs

readArr :: (Read t) => IO [t]
readArr = fmap ((fmap read) . words) getLine

front2 :: [t] -> (t, t)
front2 (x:y:_) = (x, y)

plprint :: (Show a, Show b) => [(a, b)] -> IO ()
plprint = sequence_ . (fmap (\(a, b) -> putStrLn $ show a ++ " " ++ show b))

psort :: (Ord t) => (t, t) -> (t, t)
psort (x, y)
    | x > y = (y, x)
    | otherwise = (x, y)

main = do
    (n, m) <- (fmap front2) (readArr :: IO [Int])
    let li = [(1, a) | a <- [1..n]] ++ [(b, b) | b <- [2..m]]
    print $ length li
    plprint li

readArr :: (Read t) => IO [t]
readArr = fmap ((fmap read) . words) getLine

front2 :: [t] -> (t, t)
front2 (x:y:_) = (x, y)

plprint :: (Show a, Show b) => [(a, b)] -> IO ()
plprint = sequence_ . (fmap (\(a, b) -> putStrLn $ show a ++ " " ++ show b))

psort :: (Ord t) => (t, t) -> (t, t)
psort (x, y)
    | x > y = (y, x)
    | otherwise = (x, y)

main = do
    (n, m) <- (fmap (psort . front2)) (readArr :: IO [Int])
    let li = [(x, y) | x <- [1..n], y <- [1..m], y >= x]
    print $ length li
    plprint li

readArr :: (Read t) => IO [t]
readArr = fmap ((fmap read) . words) getLine

front2 :: [t] -> (t, t)
front2 (x:y:_) = (x, y)

plprint :: (Show a, Show b) => [(a, b)] -> IO ()
plprint = sequence_ . (fmap (\(a, b) -> putStrLn $ show a ++ " " ++ show b))

psort :: (Ord t) => (t, t) -> (t, t)
psort (x, y)
    | x > y = (y, x)
    | otherwise = (x, y)

main = do
    (n, m) <- (fmap front2) (readArr :: IO [Int])
    let li = (if n <= m then (filter $ (\(a, b) -> a <= b))
                       else (filter $ (\(a, b) -> b <= a)) )
                        [(x, y) | x <- [1..n], y <- [1..m]]
    print $ length li
    plprint li

readArr :: (Read t) => IO [t]
readArr = fmap ((fmap read) . words) getLine

front2 :: [t] -> (t, t)
front2 (x:y:_) = (x, y)

plprint :: (Show a, Show b) => [(a, b)] -> IO ()
plprint = sequence_ . (fmap (\(a, b) -> putStrLn $ show a ++ " " ++ show b))

main = do
    (n, m) <- (fmap front2) (readArr :: IO [Int])
    let li = [(x, y) | x <- [1..n], y <- [1..m], y >= x]
    print $ length li
    plprint li

import Control.Monad (liftM)

solve :: [Int] -> [(Int, Int)]
solve [1, 1]  =  [(1, 1)]
solve [a, b]
  | a > b  =  [(div (i+1) 2, div i 2) | i <- [2 .. 2*b + 1]]
  | a < b  =  [(div i 2, div (i+1) 2) | i <- [2 .. 2*a + 1]]
  | a == b  =  [(div i 2, div (i+1) 2) | i <- [2 .. 2*a]]

print' :: [(Int, Int)] -> IO ()
print'  =  mapM_ print''
  where
    print'' (x, y)  =  putStrLn $ concat [show x, " ", show y]

main :: IO ()
main  =  liftM (map read . words) getLine >>= print' . solve

import Control.Monad (liftM)

solve :: [Int] -> [(Int, Int)]
solve [1, 1]  =  [(1, 1)]
solve [a, b]
  | a > b  =  [(div (i+1) 2, div i 2) | i <- [2 .. 2*b + 1]]
  | a < b  =  [(div i 2, div (i+1) 2) | i <- [2 .. 2*a + 1]]
  | a == b  =  [(div i 2, div (i+1) 2) | i <- [2 .. 2*a]]

print' :: [(Int, Int)] -> IO ()
print' xs  =  print (length xs) >> mapM_ print'' xs
  where
    print'' (x, y)  =  putStrLn $ concat [show x, " ", show y]

main :: IO ()
main  =  liftM (map read . words) getLine >>= print' . solve

main :: IO ()
main = getContents >>= (\[n, m] -> (print (n + m - 1) >> mapM_ (putStrLn . unwords . map show) (solve n m))) . map read . words

solve :: Integer -> Integer -> [[Integer]]
solve n m = zipWith ((.(:[])).(:)) (concatMap (replicate 2) [1..n]) (tail $ concatMap (replicate 2) [1..m])

main = do
   [n, m] <- fmap (map read . words) getLine
   let pairs = solve n m
   print $ length pairs
   mapM (\(x, y) -> putStrLn $ show x ++ " " ++ show y) pairs

solve :: Int -> Int -> [(Int, Int)]
solve boys girls = (map (\x -> (1, x)) [1..girls]) ++ (map (\x -> (x, 2)) [2..boys])

main = do
   [n, m] <- fmap (map read . words) getLine
   let pairs = solve n m
   print $ length pairs
   mapM (\(x, y) -> putStrLn $ show x ++ " " ++ show y) pairs

solve :: Int -> Int -> [(Int, Int)]
solve boys girls = map (\x -> (1, x)) [1..girls] ++ map (\x -> (x, 2)) [2..boys]

import Data.List

solve n m = xs ++ ys where
    xs = ["1 " ++ show j | j <- [1..m]]
    ys = [show i ++ " " ++ show j | (i, j) <- zip [2..n] [1..m]]

main = do
    line <- getLine
    let [n, m] = map read $ words line :: [Int]
    let xs = solve n m
    print $ length xs
    putStrLn $ intercalate "\n" xs


A row of $$$n$$$ cells is given, all initially white. Using a stamp, you can stamp any two neighboring cells such that one becomes red and the other becomes blue. A stamp can be rotated, i.e. it can be used in both ways: as $$$\color{blue}{\texttt{B}}\color{red}{\texttt{R}}$$$ and as $$$\color{red}{\texttt{R}}\color{blue}{\texttt{B}}$$$.During use, the stamp must completely fit on the given $$$n$$$ cells (it cannot be partially outside the cells). The stamp can be applied multiple times to the same cell. Each usage of the stamp recolors both cells that are under the stamp.For example, one possible sequence of stamps to make the picture $$$\color{blue}{\texttt{B}}\color{red}{\texttt{R}}\color{blue}{\texttt{B}}\color{blue}{\texttt{B}}\texttt{W}$$$ could be $$$\texttt{WWWWW} \to \texttt{WW}\color{brown}{\underline{\color{red}{\texttt{R}}\color{blue}{\texttt{B}}}}\texttt{W} \to \color{brown}{\underline{\color{blue}{\texttt{B}}\color{red}{\texttt{R}}}}\color{red}{\texttt{R}}\color{blue}{\texttt{B}}\texttt{W} \to \color{blue}{\texttt{B}}\color{brown}{\underline{\color{red}{\texttt{R}}\color{blue}{\texttt{B}}}}\color{blue}{\texttt{B}}\texttt{W}$$$. Here $$$\texttt{W}$$$, $$$\color{red}{\texttt{R}}$$$, and $$$\color{blue}{\texttt{B}}$$$ represent a white, red, or blue cell, respectively, and the cells that the stamp is used on are marked with an underline.Given a final picture, is it possible to make it using the stamp zero or more times?

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the length of the picture. The second line of each test case contains a string $$$s$$$ — the picture you need to make. It is guaranteed that the length of $$$s$$$ is $$$n$$$ and that $$$s$$$ only consists of the characters $$$\texttt{W}$$$, $$$\texttt{R}$$$, and $$$\texttt{B}$$$, representing a white, red, or blue cell, respectively. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

Output $$$t$$$ lines, each of which contains the answer to the corresponding test case. As an answer, output "YES" if it possible to make the picture using the stamp zero or more times, and "NO" otherwise. You can output the answer in any case (for example, the strings "yEs", "yes", "Yes" and "YES" will be recognized as a positive answer).

12
5
BRBBW
1
B
2
WB
2
RW
3
BRB
3
RBB
7
WWWWWWW
9
RBWBWRRBW
10
BRBRBRBRRB
12
BBBRWWRRRWBR
10
BRBRBRBRBW
5
RBWBW

YES
NO
NO
NO
YES
YES
YES
NO
YES
NO
YES
NO

NoteThe first test case is explained in the statement.For the second, third, and fourth test cases, it is not possible to stamp a single cell, so the answer is "NO".For the fifth test case, you can use the stamp as follows: $$$\texttt{WWW} \to \texttt{W}\color{brown}{\underline{\color{red}{\texttt{R}}\color{blue}{\texttt{B}}}} \to \color{brown}{\underline{\color{blue}{\texttt{B}}\color{red}{\texttt{R}}}}\color{blue}{\texttt{B}}$$$.For the sixth test case, you can use the stamp as follows: $$$\texttt{WWW} \to \texttt{W}\color{brown}{\underline{\color{red}{\texttt{R}}\color{blue}{\texttt{B}}}} \to \color{brown}{\underline{\color{red}{\texttt{R}}\color{blue}{\texttt{B}}}}\color{blue}{\texttt{B}}$$$.For the seventh test case, you don't need to use the stamp at all.

import Data.List

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

readInt :: IO Int
readInt = parseInt <$> getLine

readIntArr :: IO [Int]
readIntArr = do
  arr <- words <$> getLine
  pure $ map parseInt arr

calc :: (Int, Int) -> String -> String
calc (a, b) [] = if ((a == 0) /= (b == 0))
  then "NO"
  else "YES"
calc (a, b) (x: xs) = if x == 'W'
  then if ((a == 0) /= (b == 0))
    then "NO"
    else calc (0, 0) xs
  else if (x == 'R')
    then calc (a + 1, b) xs
    else calc (a, b + 1) xs

solve :: IO ()
solve = do
  n <- readInt
  str <- getLine
  putStrLn $ calc (0, 0) str

for :: Int -> IO () -> IO ()
for 0 _ = pure ()
for i f = do
  f
  for (i - 1) f

main :: IO ()
main = do
  n <- readInt
  for n solve


A string is called square if it is some string written twice in a row. For example, the strings "aa", "abcabc", "abab" and "baabaa" are square. But the strings "aaa", "abaaab" and "abcdabc" are not square.For a given string $$$s$$$ determine if it is square.

The first line of input data contains an integer $$$t$$$ ($$$1 \le t \le 100$$$) —the number of test cases. This is followed by $$$t$$$ lines, each containing a description of one test case. The given strings consist only of lowercase Latin letters and have lengths between $$$1$$$ and $$$100$$$ inclusive.

For each test case, output on a separate line:   YES if the string in the corresponding test case is square,  NO otherwise.  You can output YES and NO in any case (for example, strings yEs, yes, Yes and YES will be recognized as a positive response).

10
a
aa
aaa
aaaa
abab
abcabc
abacaba
xxyy
xyyx
xyxy

solve :: String -> Bool
solve s = take (length s `div` 2) s == drop (length s `div` 2) s

testcases :: Int -> IO()
testcases 0 = putStr ""
testcases t = do
  current <- getLine
  putStrLn (if solve current then "YES" else "NO")
  testcases ( t - 1 )

main = do
  t <- getLine
  testcases $ read t

import Control.Monad (forM_)

solve str =
    let len = length str
     in if even len && (take (len `div` 2) str == drop (len `div` 2) str) then "YES" else "NO"

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

import Control.Monad

main :: IO ()
main = do
    t <- readLn :: IO Int
    res <- replicateM t $ do
        s <- getLine
        let len = length s
        if mod len 2 == 1 then return "NO"
        else if take (len `div` 2) s == drop (len `div` 2) s then return "YES" else return "NO"

    putStrLn $ unlines res
    return ()

solve :: String -> Bool
solve s = take (length s `div` 2) s == drop (length s `div` 2) s

testcases :: Int -> IO()
testcases 0 = putStr ""
testcases t = do
  current <- getLine
  print . solve $ current
  testcases ( t - 1 )

main = do
  t <- getLine
  testcases $ read t


After lessons Nastya decided to read a book. The book contains $$$n$$$ chapters, going one after another, so that one page of the book belongs to exactly one chapter and each chapter contains at least one page.Yesterday evening Nastya did not manage to finish reading the book, so she marked the page with number $$$k$$$ as the first page which was not read (i.e. she read all pages from the $$$1$$$-st to the $$$(k-1)$$$-th).The next day Nastya's friend Igor came and asked her, how many chapters remain to be read by Nastya? Nastya is too busy now, so she asks you to compute the number of chapters she has not completely read yet (i.e. the number of chapters she has not started to read or has finished reading somewhere in the middle).

The first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 100$$$) — the number of chapters in the book. There are $$$n$$$ lines then. The $$$i$$$-th of these lines contains two integers $$$l_i$$$, $$$r_i$$$ separated by space ($$$l_1 = 1$$$, $$$l_i \leq r_i$$$) — numbers of the first and the last pages of the $$$i$$$-th chapter. It's guaranteed that $$$l_{i+1} = r_i + 1$$$ for all $$$1 \leq i \leq n-1$$$, and also that every chapter contains at most $$$100$$$ pages. The $$$(n+2)$$$-th line contains a single integer $$$k$$$ ($$$1 \leq k \leq r_n$$$) — the index of the marked page.

Print a single integer — the number of chapters which has not been completely read so far.

NoteIn the first example the book contains $$$11$$$ pages and $$$3$$$ chapters — $$$[1;3]$$$, $$$[4;7]$$$ and $$$[8;11]$$$. Nastya marked the $$$2$$$-nd page, so she finished in the middle of the $$$1$$$-st chapter. So, all chapters has not been read so far, so the answer is $$$3$$$.The book in the second example contains $$$12$$$ pages and $$$3$$$ chapters too, but Nastya finished reading in the middle of the $$$2$$$-nd chapter, so that the answer is $$$2$$$.

import Control.Monad (replicateM)

readWordsLn :: Read a => IO [a]
readWordsLn = map read <$> (words <$> getLine)

readHeadLn :: Read a => IO a
readHeadLn = head <$> readWordsLn

readWordsMultiLn :: Read a => Int -> IO [[a]]
readWordsMultiLn n = replicateM n readWordsLn

main :: IO ()
main = do
  n <- readHeadLn :: IO Int
  chapters <- readWordsMultiLn n :: IO [[Int]]
  page <- readHeadLn :: IO Int
  print (n - solve chapters page)

solve :: [[Int]] -> Int -> Int
solve ((_:x:_):xs) p
  | p > x = solve xs p + 1
  | otherwise = 0

import Control.Monad
main = do
    n <- readLn
    ps <- replicateM n $ ((!!1).(map read).words <$> getLine)
    k <- (readLn::IO Int)
    print . length . filter (>=k) $ ps

module Main where
import Control.Monad
import Data.List

main = do
    n <- (readLn :: IO Int)
    ps <- replicateM n (map (read :: String -> Int) . words <$> getLine)
    let qs = concat $ zipWith (\[a,b] c -> replicate (b-a+1) c) ps [1..]
    k <- (readLn :: IO Int)
    print  $ n - (head $ drop (k-1) qs) + 1

import Control.Monad
main = do
  n <- readLn
  lrs <- replicateM n (map read . words <$> getLine)
  k <- readLn :: IO Int
  print $ length $ dropWhile ((< k) . (!! 1)) lrs

import Control.Monad
import Data.Semigroup

solve :: [[Int]] -> Int -> Int
solve chaps curr = sum $ map (fromEnum . (>= curr) . (!! 1)) chaps

main = do
  numChapters <- read <$> getLine
  bounds <- replicateM numChapters $ do
    fmap read <$> words <$> getLine
  pos <- read <$> getLine
  print $ solve bounds pos
  return ()

main :: IO ()
main = interact $ show . solve . map read . words

listIntoPairList :: [a] -> [(a, a)]
listIntoPairList [] = []
listIntoPairList (x1:x2:xs) = (x1, x2) : listIntoPairList xs

secondLessEq :: Int -> (Int, Int) -> Bool
secondLessEq n (_, r) = n <= r

solve :: [Int] -> Int
solve (chaps:rest) = length . filter (secondLessEq (last rest)) . listIntoPairList . take (2*chaps) $ rest

{-# LANGUAGE Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

tuple2 [] = []
tuple2 (x:y:l) = (x, y) : (tuple2 l)

solve :: [Int] -> Int
solve (n:a) = length $ filter (\(i, j) -> k <= j) d
  where
    (b, (k:c)) = splitAt (2 * n) a
    d = tuple2 b

main :: IO ()
main = print . solve . map ri . C.words =<< C.getContents

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

main = do
	n<-read <$> getLine ::IO Int
	[a,b]<-transpose <$> map (map read) <$> map words <$> replicateM n getLine

	y<-read <$> getLine ::IO Int
	print $ length $ dropWhile (<y) b

--ghc 7.10

countUnfinished :: Int -> [Int] -> Int
countUnfinished p = length . filter (>=p)

main = do
    nStr <- getLine
    let n = read nStr
    cStrs <- sequence . replicate n $ getLine
    let rs = map (read . last . words) cStrs
    pStr <- getLine
    let p = read pStr
    print $ countUnfinished p rs

import Control.Monad
main = do
    n <- readLn
    ps <- replicateM n $ ((!!1).(map read).words <$> getLine)
    k <- (readLn::IO Int)
    print . length . filter (>k) $ ps


Calculate the minimum number of characters you need to change in the string s, so that it contains at least k different letters, or print that it is impossible.String s consists only of lowercase Latin letters, and it is allowed to change characters only to lowercase Latin letters too.

First line of input contains string s, consisting only of lowercase Latin letters (1 ≤ |s| ≤ 1000, |s| denotes the length of s). Second line of input contains integer k (1 ≤ k ≤ 26).

Print single line with a minimum number of necessary changes, or the word «impossible» (without quotes) if it is impossible.

NoteIn the first test case string contains 6 different letters, so we don't need to change anything.In the second test case string contains 4 different letters: {'a', 'h', 'o', 'y'}. To get 5 different letters it is necessary to change one occurrence of 'o' to some letter, which doesn't occur in the string, for example, {'b'}.In the third test case, it is impossible to make 7 different letters because the length of the string is 6.

import Data.List
import System.IO

nrDistinct_ :: (Ord a, Num b) => [a] -> b
nrDistinct :: (Ord a, Num b) => [a] -> b

nrDistinct_ [] = 0
nrDistinct_ [x] = 1
nrDistinct_ (x:x_:xs) = if x == x_ then r else r + 1
    where r = nrDistinct_ (x_:xs)

nrDistinct = nrDistinct_ . sort

main = do
    str <- getLine
    k   <- readLn :: IO Int
    let delta = max 0 $ k - (nrDistinct str)
    if k <= length str then print delta else putStr "impossible"

import Data.List
import Data.Ord

solve x n
	|ll>=n="0"
	|l>=n = show (n-ll)
	|otherwise = "impossible"
	where
		l=length x
		ll=length (nub x)

main=do
	word<-getLine
	n<-getLine
	putStrLn (solve word (read n::Int))

import Data.List

main = do
    str <- getLine
    n <- getLine
    putStrLn $ foo str (read n)

foo :: String -> Int -> String
foo str n =
    let d = length . nub . sort $ str
        tl = length str
    in
        if tl < n
            then "impossible"
            else show $ max 0 $ n - d

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

solve :: String -> Int -> String
solve s n
    | length s < n = "impossible"
    | otherwise    = show (max 0 (n - u))
        where u = (length . map head . group . sort) s

main :: IO ()
main = do
    s <- getLine
    n <- readInt
    putStrLn $ solve s n

import Data.List

solve :: String -> Int -> String
solve xs k
    | length xs < k = "impossible"
    | (length.nub) xs < k = show (k-(length.nub) xs)
    | otherwise = "0"

main = do
    xs <- getLine
    k <- readLn :: IO Int
    (putStrLn.solve xs) k

import Data.List( nub)

main = do
    s_ <- getLine
    k_ <- readLn::IO Int
    let
	len = length s_
	uniq = nub s_
	need = k_ - (length uniq)

    if len < k_
	then putStr "impossible"
	else print (need `max` 0)

-- 844A

import Data.Maybe (fromJust)
import Data.List (group, sort)

unique = length . group . sort

program (s:si:_)
  | i > length s = "impossible"
  | otherwise    = show $ max 0 (i - unique s)
  where i = read si

main = interact $ program . lines

import Data.List
import Data.Ord

solve x n
	|l==n = show (n-(length (nub x)))
	|otherwise = "impossible"
	where
		l=length x

main=do
	word<-getLine
	n<-getLine
	putStrLn (solve word (read n::Int))

import Data.List
import Data.Ord

solve x n
	|l>=n = show (n-(length (nub x)))
	|otherwise = "impossible"
	where
		l=length x

main=do
	word<-getLine
	n<-getLine
	putStrLn (solve word (read n::Int))

-- 844A

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

toInt = fst . fromJust . B.readInt
unique = length . B.group . B.sort

program (s:si:_)
  | i > B.length s = "impossible"
  | otherwise      = show $ max 0 (i - unique s)
  where i = toInt si

main = B.interact $ B.pack . program . B.lines


Many years have passed, and n friends met at a party again. Technologies have leaped forward since the last meeting, cameras with timer appeared and now it is not obligatory for one of the friends to stand with a camera, and, thus, being absent on the photo.Simply speaking, the process of photographing can be described as follows. Each friend occupies a rectangle of pixels on the photo: the i-th of them in a standing state occupies a wi pixels wide and a hi pixels high rectangle. But also, each person can lie down for the photo, and then he will occupy a hi pixels wide and a wi pixels high rectangle.The total photo will have size W × H, where W is the total width of all the people rectangles, and H is the maximum of the heights. The friends want to determine what minimum area the group photo can they obtain if no more than n / 2 of them can lie on the ground (it would be strange if more than n / 2 gentlemen lie on the ground together, isn't it?..)Help them to achieve this goal.

The first line contains integer n (1 ≤ n ≤ 1000) — the number of friends. The next n lines have two integers wi, hi (1 ≤ wi, hi ≤ 1000) each, representing the size of the rectangle, corresponding to the i-th friend.

Print a single integer equal to the minimum possible area of the photo containing all friends if no more than n / 2 of them can lie on the ground.

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (fromJust)
import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.List (sort, group, sortBy)
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace (traceShow)

-- count :: (Eq a, Foldable t) => a -> t a -> Int
count x xs = foldr go 0 xs
    where go i acc = if i == x then acc + 1 else acc

solve :: Int -> [(Int, Int)] -> Int
solve n a = minimum $ map loop xs
    where
    xs = map head . group . sort $ foldr (\(i, j) acc -> i:j:acc) [] a
    a' = sortBy (\(i, j) (u, v) -> (u + j) `compare` (i + v)) a

    loop t
        | any (\(w, h) -> t < w && t < h) a' || n < 2 * cnt = maxBound
        | otherwise = (t *) . sum $ zipWith f a' r'
        where
        -- pass one, only rotate those have to!
        r  = map (\(_, h) -> t < h) a'
        cnt = count True r
        f (w, _) False = w
        f (_, h) True  = h

        -- pass two greedily rotate
        r' = foldr go (const []) (zip a' r) cnt
            where
            go ((w, h), False) f k
                | h < w && w < t + 1 && 2 * (k + 1) < n + 1 = True: f (k + 1)
            go (_, rot) f k = rot: f k

parse :: ByteString -> [Int]
parse line = fst . fromJust . B.readInt <$> B.words line

main = do
    [n] <- parse <$> B.getLine
    a <- fmap (\[i, j] -> (i, j)) . fmap parse <$> replicateM n B.getLine
    print $ solve n a

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (fromJust)
import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.List (sort, group, sortBy)
import qualified Data.ByteString.Char8 as B

count x xs = foldr go 0 xs
    where go i acc = if i == x then acc + 1 else 0

solve :: Int -> [(Int, Int)] -> Int
solve n a = minimum $ map loop xs
    where
    xs = map head . group . sort $ foldr (\(i, j) acc -> i:j:acc) [] a
    a' = reverse $ sortBy (\(i, j) (u, v) -> (u + j) `compare` (i + v)) a

    loop t
        | any (\(w, h) -> t < w && t < h) a' = maxBound
        | n < 2 * cnt                        = maxBound
        | otherwise                          = (t *) . sum $ zipWith f a' r'
        where
        -- pass one, only rotate those have to!
        r  = map (\(w, h) -> t < h) a'
        cnt = count True r
        f (w, _) False = w
        f (_, h) True  = h

        -- pass two greedily rotate
        r'  = foldr go (const []) (zip a' r) cnt
            where
            go ((w, h), True ) f k = True: f k
            go ((w, h), False) f k
                | h < w && w < t + 1 && 2 * (k + 1) < n + 1 = True: f (k + 1)
            go _ f k               = False: f k

parse :: ByteString -> [Int]
parse line = fst . fromJust . B.readInt <$> B.words line

main = do
    [n] <- parse <$> B.getLine
    a <- fmap (\[i, j] -> (i, j)) . fmap parse <$> replicateM n B.getLine
    print $ solve n a

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (fromJust)
import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.List (sort, group, sortBy)
import qualified Data.ByteString.Char8 as B

count x xs = foldr go 0 xs
    where go i acc = if i == x then acc + 1 else 0

solve :: Int -> [(Int, Int)] -> Int
solve n a = minimum $ map loop xs
    where
    xs = map head . group . sort $ foldr (\(i, j) acc -> i:j:acc) [] a
    a' = sortBy (\(i, j) (u, v) -> (u + j) `compare` (i + v)) a

    loop t
        | any (\(w, h) -> t < w && t < h) a' = maxBound
        | n < 2 * cnt                        = maxBound
        | otherwise                          = (t *) . sum $ zipWith f a' r'
        where
        -- pass one, only rotate those have to!
        r  = map (\(w, h) -> t < h) a'
        cnt = count True r
        f (w, _) False = w
        f (_, h) True  = h

        -- pass two greedily rotate
        r'  = foldr go (const []) (zip a' r) cnt
            where
            go ((w, h), True)  f k = True: f k
            go ((w, h), False) f k
                | h < w && w < t + 1 && 2 * (k + 1) < n + 1 = True: f (k + 1)
            go _ f k               = False: f k

parse :: ByteString -> [Int]
parse line = fst . fromJust . B.readInt <$> B.words line

main = do
    [n] <- parse <$> B.getLine
    a <- fmap (\[i, j] -> (i, j)) . fmap parse <$> replicateM n B.getLine
    print $ solve n a


Let's call a binary string $$$T$$$ of length $$$m$$$ indexed from $$$1$$$ to $$$m$$$ paranoid if we can obtain a string of length $$$1$$$ by performing the following two kinds of operations $$$m-1$$$ times in any order : Select any substring of $$$T$$$ that is equal to 01, and then replace it with 1. Select any substring of $$$T$$$ that is equal to 10, and then replace it with 0.For example, if $$$T = $$$ 001, we can select the substring $$$[T_2T_3]$$$ and perform the first operation. So we obtain $$$T = $$$ 01.You are given a binary string $$$S$$$ of length $$$n$$$ indexed from $$$1$$$ to $$$n$$$. Find the number of pairs of integers $$$(l, r)$$$ $$$1 \le l \le r \le n$$$ such that $$$S[l \ldots r]$$$ (the substring of $$$S$$$ from $$$l$$$ to $$$r$$$) is a paranoid string.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the size of $$$S$$$. The second line of each test case contains a binary string $$$S$$$ of $$$n$$$ characters $$$S_1S_2 \ldots S_n$$$. ($$$S_i = $$$ 0 or $$$S_i = $$$ 1 for each $$$1 \le i \le n$$$) It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, output the number of pairs of integers $$$(l, r)$$$ $$$1 \le l \le r \le n$$$ such that $$$S[l \ldots r]$$$ (the substring of $$$S$$$ from $$$l$$$ to $$$r$$$) is a paranoid string.

NoteIn the first sample, $$$S$$$ already has length $$$1$$$ and doesn't need any operations.In the second sample, all substrings of $$$S$$$ are paranoid. For the entire string, it's enough to perform the first operation.In the third sample, all substrings of $$$S$$$ are paranoid except $$$[S_2S_3]$$$, because we can't perform any operations on it, and $$$[S_1S_2S_3]$$$ (the entire string).

module Main where

import Control.Monad (liftM2, replicateM_)
import qualified Data.ByteString.Char8 as C
import Data.Char (digitToInt)
import Data.Maybe (fromJust)
import Data.String

solve :: String -> IO ()
solve xs = putStrLn $ show ans
  where
    intList = digitToInt <$> xs
    (_, ans, _) = foldl f (head intList, 1, 1) (tail intList)
    f (b, valid, n) a
      | a == b = (a, valid + 1, n + 1)
      | otherwise = (a, valid + n + 1, n + 1)

main :: IO ()
main = do
  n <- fst . fromJust . C.readInt . fromString <$> getLine
  replicateM_ n (solve =<< (getLine >> getLine))

module Main where

import Control.Monad (liftM2, replicateM_)
import qualified Data.ByteString.Char8 as C
import Data.Char (digitToInt)
import Data.Maybe (fromJust)
import Data.String

solve :: String -> IO ()
solve xs = do
  putStrLn $ show xs
  putStrLn $ show ans
  where
    intList = digitToInt <$> xs
    (_, ans, _) = foldl f (head intList, 1, 1) (tail intList)
    f (b, valid, n) a
      | a == b = (a, valid + 1, n + 1)
      | otherwise = (a, valid + n + 1, n + 1)

main :: IO ()
main = do
  n <- fst . fromJust . C.readInt . fromString <$> getLine
  replicateM_ n (solve =<< (getLine >> getLine))


Anton is playing a very interesting computer game, but now he is stuck at one of the levels. To pass to the next level he has to prepare n potions.Anton has a special kettle, that can prepare one potions in x seconds. Also, he knows spells of two types that can faster the process of preparing potions.  Spells of this type speed up the preparation time of one potion. There are m spells of this type, the i-th of them costs bi manapoints and changes the preparation time of each potion to ai instead of x.  Spells of this type immediately prepare some number of potions. There are k such spells, the i-th of them costs di manapoints and instantly create ci potions. Anton can use no more than one spell of the first type and no more than one spell of the second type, and the total number of manapoints spent should not exceed s. Consider that all spells are used instantly and right before Anton starts to prepare potions.Anton wants to get to the next level as fast as possible, so he is interested in the minimum number of time he needs to spent in order to prepare at least n potions.

The first line of the input contains three integers n, m, k (1 ≤ n ≤ 2·109, 1 ≤ m, k ≤ 2·105) — the number of potions, Anton has to make, the number of spells of the first type and the number of spells of the second type. The second line of the input contains two integers x and s (2 ≤ x ≤ 2·109, 1 ≤ s ≤ 2·109) — the initial number of seconds required to prepare one potion and the number of manapoints Anton can use. The third line contains m integers ai (1 ≤ ai < x) — the number of seconds it will take to prepare one potion if the i-th spell of the first type is used. The fourth line contains m integers bi (1 ≤ bi ≤ 2·109) — the number of manapoints to use the i-th spell of the first type. There are k integers ci (1 ≤ ci ≤ n) in the fifth line — the number of potions that will be immediately created if the i-th spell of the second type is used. It's guaranteed that ci are not decreasing, i.e. ci ≤ cj if i < j. The sixth line contains k integers di (1 ≤ di ≤ 2·109) — the number of manapoints required to use the i-th spell of the second type. It's guaranteed that di are not decreasing, i.e. di ≤ dj if i < j.

Print one integer — the minimum time one has to spent in order to prepare n potions.

NoteIn the first sample, the optimum answer is to use the second spell of the first type that costs 10 manapoints. Thus, the preparation time of each potion changes to 4 seconds. Also, Anton should use the second spell of the second type to instantly prepare 15 potions spending 80 manapoints. The total number of manapoints used is 10 + 80 = 90, and the preparation time is 4·5 = 20 seconds (15 potions were prepared instantly, and the remaining 5 will take 4 seconds each).In the second sample, Anton can't use any of the spells, so he just prepares 20 potions, spending 10 seconds on each of them and the answer is 20·10 = 200.

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

type IntArray = UA.UArray Int Int

inf = 10^20 :: Integer

binarySearch f arr start end
    | start >= end = end
    | otherwise = if f (arr ! middle) then firstHalf else secondHalf where
        middle = (start + end) `div` 2
        firstHalf = binarySearch f arr start middle
        secondHalf = binarySearch f arr (middle+1) end

getMaxImmPotion cs ds mana = cs ! spellIndex' where
    (lb, hb) = bounds ds
    spellIndex = binarySearch (> mana) ds lb hb
    spellIndex' = until (\si -> (ds ! si) <= mana) (\si -> si-1) spellIndex

process :: Int -> Int -> [Int] -> [Int] -> IntArray -> IntArray -> Integer
process n s as bs cs ds = minimum [ makePotion a b | (a, b) <- zip as bs ] where
    makePotion a b = if secondSpellMana < 0 then inf else totalTime :: Integer where
        potionTime = a
        secondSpellMana = s - b
        manualPotionCnt = max 0 $ n - getMaxImmPotion cs ds secondSpellMana
        totalTime = (fromIntegral potionTime) * (fromIntegral manualPotionCnt)

main = do
    n:m:k:[] <- getInts
    x:s:[] <- getInts
    as <- ((:) x) <$> getInts
    bs <- ((:) 0) <$> getInts
    cs <- (\l -> UA.listArray (0, k) (0:l)) <$> getInts
    ds <- (\l -> UA.listArray (0, k) (0:l)) <$> getInts
    print $ process n s as bs cs ds

-- Codeforces Round #379 (Div. 2)
-- http://codeforces.com/contest/734

-- ID: 734C (Anton and Making Potions)

import Control.Monad
import Data.Array
import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt64s = (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) `fmap` BS.getLine :: IO [Int64]

main = do
    [n, m, k] <- getInt64s
    [x, s] <- getInt64s
    as <- (listArray (0, m-1)) `fmap` getInt64s
    bs <- (listArray (0, m-1)) `fmap` getInt64s
    cs <- (listArray (0, k-1)) `fmap` getInt64s
    ds <- (listArray (0, k-1)) `fmap` getInt64s
    let ub = upperBound ds k s
    let freePotion = cs ! (ub - 1)
    let noFirst = if ub > 0 then (max (n - freePotion) 0) * x else n * x
    let bestUsingFirst = minimum $ map (make as bs cs ds n k s) [0..m-1]
    print $ min noFirst bestUsingFirst

make as bs cs ds n k s i
    | bs ! i > s = maxBound :: Int64
    | otherwise = (max 0 remain) * (as ! i)
    where
        remain = n - (if ub == 0 then 0 else (cs ! (ub - 1)))
        ub = upperBound ds k (s - bs ! i)

upperBound :: Array Int64 Int64 -> Int64 -> Int64 -> Int64
upperBound ary n x = go 0 n where
    go lb ub
        | lb >= ub = ub
        | ary ! mid <= x = go (mid+1) ub
        | ary ! mid > x = go lb mid
        where mid = (lb + ub) `div` 2

import Control.Monad
import Data.Array
import Data.Int
import Data.List
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]
fast_read_Int64 = fmap (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) BS.getLine :: IO [Int64]

bs :: Array Int64 Int64 -> Int64 -> Int64 -> Int64
bs v n x = go 0 n where
    go st dr
        | st>=dr = dr - 1
        | v ! mid <= x = go (mid+1) dr
        | v ! mid > x = go st mid
        where mid = div (st + dr)  2

main = do
    [n,m,k] <- fast_read_Int64
    [x,s] <- fast_read_Int64
    a <- fmap (listArray (0,m-1)) fast_read_Int64
    b <- fmap (listArray (0,m-1)) fast_read_Int64
    c <- fmap (listArray (0,k-1)) fast_read_Int64
    d <- fmap (listArray (0,k-1)) fast_read_Int64
    let fara_1 = bs d k s
    let initial = if fara_1 >= 0 then (max (n - c ! fara_1) 0) * x else n * x

    let f i = g i where
        g i
            | s < b ! i = maxBound :: Int64
            | otherwise = (max 0 (n - maxp)) * (a ! i)
            where
                maxp = if binary_search >=0 then c ! binary_search else 0
                binary_search = bs d k (s- b ! i)

    let _for_ = minimum $ map f [0..m-1]

    print $ min initial _for_

module Main where

import Control.Monad
import Control.Monad.State
import Data.Array
import Prelude
import qualified Data.ByteString.Lazy.Char8 as L

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Int:" ++ (show s)

nextInteger :: Tokenizer Integer
nextInteger = state $ \(s:ss) -> case L.readInteger s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Integer:" ++ (show s)

f :: Integer -> Integer -> Integer -> Array Int Integer -> Array Int Integer -> Integer
f n x s c d | i < 0     = n * x
            | otherwise = (max 0 (n - c!i)) * x
            where i = bs (-1) (rightBoundC + 1)
                  (_, rightBoundC) = bounds c
                  bs l r | r - l == 1 = l
                         | d!m <= s  = bs m r
                         | otherwise  = bs l m
                         where m = (l + r) `div` 2

solve :: Integer -> Integer -> Integer -> Array Int Integer -> Array Int Integer -> Array Int Integer -> Array Int Integer -> Integer
solve n x s a b c d = foldl min (f n x s c d) [a!i + f (n - 1) (a!i) (s - b!i) c d | i <- [0..rightBoundA], s >= b!i]
    where (_, rightBoundA) = bounds a

doit :: Tokenizer Integer
doit = do
    n <- nextInteger
    m <- nextInt
    k <- nextInt
    x <- nextInteger
    s <- nextInteger
    aList <- replicateM m nextInteger
    bList <- replicateM m nextInteger
    cList <- replicateM k nextInteger
    dList <- replicateM k nextInteger
    let a = listArray (0, m - 1) aList
    let b = listArray (0, m - 1) bList
    let c = listArray (0, k - 1) cList
    let d = listArray (0, k - 1) dList
    return $ solve n x s a b c d

main = do
    contents <- L.getContents
    print $ evalState doit (L.words contents)

module Main where

import Control.Monad
import Control.Monad.State
import Data.Array
import Prelude
import qualified Data.ByteString.Lazy.Char8 as L

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Int:" ++ (show s)

nextInteger :: Tokenizer Integer
nextInteger = state $ \(s:ss) -> case L.readInteger s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Integer:" ++ (show s)

f :: Integer -> Integer -> Integer -> Array Int Integer -> Array Int Integer -> Integer
f n x s c d | i < 0     = n * x
            | otherwise = (max 0 (n - c!i)) * x
            where i = bs (-1) ((snd $ bounds c) + 1)
                  bs l r | r - l == 1 = l
                         | d!m <= s  = bs m r
                         | otherwise  = bs l m
                         where m = (l + r) `div` 2

solve :: Integer -> Integer -> Integer -> Array Int Integer -> Array Int Integer -> Array Int Integer -> Array Int Integer -> Integer
solve n x s a b c d = foldl min (f n x s c d) [a!i + f (n - 1) (a!i) (s - b!i) c d | i <- [0..snd $ bounds a], s >= b!i]

doit :: Tokenizer Integer
doit = do
    n <- nextInteger
    m <- nextInt
    k <- nextInt
    x <- nextInteger
    s <- nextInteger
    a <- liftM (listArray (0, m - 1)) $ replicateM m nextInteger
    b <- liftM (listArray (0, m - 1)) $ replicateM m nextInteger
    c <- liftM (listArray (0, k - 1)) $ replicateM k nextInteger
    d <- liftM (listArray (0, k - 1)) $ replicateM k nextInteger
    return $ solve n x s a b c d

main = do
    contents <- L.getContents
    print $ evalState doit (L.words contents)

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

type IntArray = UA.UArray Int Int

inf = 10^20 :: Integer

binarySearch f arr start end
    | start >= end = end
    | otherwise = if f (arr ! middle) then firstHalf else secondHalf where
        middle = (start + end) `div` 2
        firstHalf = binarySearch f arr start middle
        secondHalf = binarySearch f arr (middle+1) end

getMaxImmPotion cs ds mana = cs ! spellIndex' where
    (lb, hb) = bounds ds
    spellIndex = binarySearch (>= mana) ds lb hb
    spellIndex' = if ds ! spellIndex <= mana then spellIndex else spellIndex - 1

process :: Int -> Int -> [Int] -> [Int] -> IntArray -> IntArray -> Integer
process n s as bs cs ds = minimum [ makePotion a b | (a, b) <- zip as bs ] where
    makePotion a b = if secondSpellMana < 0 then inf else totalTime :: Integer where
        potionTime = a
        secondSpellMana = s - b
        manualPotionCnt = max 0 $ n - getMaxImmPotion cs ds secondSpellMana
        totalTime = (fromIntegral potionTime) * (fromIntegral manualPotionCnt)

main = do
    n:m:k:[] <- getInts
    x:s:[] <- getInts
    as <- ((:) x) <$> getInts
    bs <- ((:) 0) <$> getInts
    cs <- (\l -> UA.listArray (0, k) (0:l)) <$> getInts
    ds <- (\l -> UA.listArray (0, k) (0:l)) <$> getInts
    print $ process n s as bs cs ds

-- Codeforces Round #379 (Div. 2)
-- http://codeforces.com/contest/734

-- ID: 734C (Anton and Making Potions)

import Control.Monad
import Data.Array
import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt64s = (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) `fmap` BS.getLine :: IO [Int64]

main = do
    [n, m, k] <- getInt64s
    [x, s] <- getInt64s
    as <- (listArray (0, m-1)) `fmap` getInt64s
    bs <- (listArray (0, m-1)) `fmap` getInt64s
    cs <- (listArray (0, k-1)) `fmap` getInt64s
    ds <- (listArray (0, k-1)) `fmap` getInt64s
    let ub = upperBound ds k s
    let freePotion = cs ! (ub - 1)
    let noFirst = if ub > 0 then (max (n - freePotion) 0) * x else n * x
    let bestUsingFirst = minimum $ map (make as bs cs ds n k s) [0..m-1]
    print $ min noFirst bestUsingFirst

make as bs cs ds n k s i
    | ub == 0 || bs ! i > s = maxBound :: Int64
    | otherwise = (max 0 remain) * (as ! i)
    where
        remain = n - (cs ! (ub - 1))
        ub = upperBound ds k (s - bs ! i)

upperBound :: Array Int64 Int64 -> Int64 -> Int64 -> Int64
upperBound ary n x = go 0 n where
    go lb ub
        | lb >= ub = ub
        | ary ! mid <= x = go (mid+1) ub
        | ary ! mid > x = go lb mid
        where mid = (lb + ub) `div` 2

import Control.Monad
import Data.Array
import Data.Int
import Data.List
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

bs :: Array Int Int -> Int -> Int -> Int
bs v n x = go 0 n where
    go st dr
        | st>=dr = dr - 1
        | v ! mid <= x = go (mid+1) dr
        | v ! mid > x = go st mid
        where mid = div (st + dr)  2

main = do
    [n,m,k] <- fast_read_Int
    [x,s] <- fast_read_Int
    a <- fmap (listArray (0,m-1)) fast_read_Int
    b <- fmap (listArray (0,m-1)) fast_read_Int
    c <- fmap (listArray (0,k-1)) fast_read_Int
    d <- fmap (listArray (0,k-1)) fast_read_Int
    let fara_1 = bs d k s
    let nr_fara_1 = c ! fara_1
    let initial = if fara_1 >= 0 then (max (n - nr_fara_1) 0) * x else n * x

    let f i = g i where
        g i
            | s < b ! i = maxBound :: Int
            | otherwise = (max 0 (n - maxp)) * (a ! i)
            where
                maxp = if binary_search >=0 then c ! binary_search else 0
                binary_search = bs d k (s- b ! i)

    let _for_ = minimum $ map f [0..m-1]

    print $ min initial _for_

import Control.Monad
import Data.Array
import Data.Int
import Data.List
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

bs :: Array Int Int -> Int -> Int -> Int
bs v n x = go 0 n where
    go st dr
        | st>=dr = dr - 1
        | v ! mid <= x = go (mid+1) dr
        | v ! mid > x = go st mid
        where mid = div (st + dr)  2

main = do
    [n,m,k] <- fast_read_Int
    [x,s] <- fast_read_Int
    a <- fmap (listArray (0,m-1)) fast_read_Int
    b <- fmap (listArray (0,m-1)) fast_read_Int
    c <- fmap (listArray (0,k-1)) fast_read_Int
    d <- fmap (listArray (0,k-1)) fast_read_Int
    let fara_1 = bs d k s
    let initial = if fara_1 >= 0 then (max (n - c ! fara_1) 0) * x else n * x

    let f i = g i where
        g i
            | s < b ! i = maxBound :: Int
            | otherwise = (max 0 (n - maxp)) * (a ! i)
            where
                maxp = if binary_search >=0 then c ! binary_search else 0
                binary_search = bs d k (s- b ! i)

    let _for_ = minimum $ map f [0..m-1]

    print $ min initial _for_

module Main where

import Control.Monad
import Control.Monad.State
import Data.Array
import Prelude
import qualified Data.ByteString.Lazy.Char8 as L

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Int:" ++ (show s)

nextInteger :: Tokenizer Integer
nextInteger = state $ \(s:ss) -> case L.readInteger s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Integer:" ++ (show s)

f :: Integer -> Integer -> Integer -> Array Int Integer -> Array Int Integer -> Integer
f n x s c d | i < 0     = n * x
            | otherwise = (max 0 (n - c!i)) * x
            where i = bs (-1) (snd $ bounds c) + 1
                  bs l r | r - l == 1 = l
                         | d!m <= s  = bs m r
                         | otherwise  = bs l m
                         where m = (l + r) `div` 2

solve :: Integer -> Integer -> Integer -> Array Int Integer -> Array Int Integer -> Array Int Integer -> Array Int Integer -> Integer
solve n x s a b c d = foldl min (f n x s c d) [a!i + f (n - 1) (a!i) (s - b!i) c d | i <- [0..snd $ bounds a], s >= b!i]

doit :: Tokenizer Integer
doit = do
    n <- nextInteger
    m <- nextInt
    k <- nextInt
    x <- nextInteger
    s <- nextInteger
    a <- liftM (listArray (0, m - 1)) $ replicateM m nextInteger
    b <- liftM (listArray (0, m - 1)) $ replicateM m nextInteger
    c <- liftM (listArray (0, k - 1)) $ replicateM k nextInteger
    d <- liftM (listArray (0, k - 1)) $ replicateM k nextInteger
    return $ solve n x s a b c d

main = do
    contents <- L.getContents
    print $ evalState doit (L.words contents)


Casimir has a rectangular piece of paper with a checkered field of size $$$n \times m$$$. Initially, all cells of the field are white.Let us denote the cell with coordinates $$$i$$$ vertically and $$$j$$$ horizontally by $$$(i, j)$$$. The upper left cell will be referred to as $$$(1, 1)$$$ and the lower right cell as $$$(n, m)$$$.Casimir draws ticks of different sizes on the field. A tick of size $$$d$$$ ($$$d > 0$$$) with its center in cell $$$(i, j)$$$ is drawn as follows:   First, the center cell $$$(i, j)$$$ is painted black.  Then exactly $$$d$$$ cells on the top-left diagonally to the center and exactly $$$d$$$ cells on the top-right diagonally to the center are also painted black.  That is all the cells with coordinates $$$(i - h, j \pm h)$$$ for all $$$h$$$ between $$$0$$$ and $$$d$$$ are painted. In particular, a tick consists of $$$2d + 1$$$ black cells. An already painted cell will remain black if painted again. Below you can find an example of the $$$4 \times 9$$$ box, with two ticks of sizes $$$2$$$ and $$$3$$$.  You are given a description of a checkered field of size $$$n \times m$$$. Casimir claims that this field came about after he drew some (possibly $$$0$$$) ticks on it. The ticks could be of different sizes, but the size of each tick is at least $$$k$$$ (that is, $$$d \ge k$$$ for all the ticks).Determine whether this field can indeed be obtained by drawing some (possibly none) ticks of sizes $$$d \ge k$$$ or not.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number test cases. The following lines contain the descriptions of the test cases.  The first line of the test case description contains the integers $$$n$$$, $$$m$$$, and $$$k$$$ ($$$1 \le k \le n \le 10$$$; $$$1 \le m \le 19$$$) — the field size and the minimum size of the ticks that Casimir drew. The following $$$n$$$ lines describe the field: each line consists of $$$m$$$ characters either being '.' if the corresponding cell is not yet painted or '*' otherwise.

Print $$$t$$$ lines, each line containing the answer to the corresponding test case. The answer to a test case should be YES if the given field can be obtained by drawing ticks of at least the given size and NO otherwise. You may print every letter in any case you want (so, for example, the strings yEs, yes, Yes, and YES will all be recognized as positive answers).

NoteThe first sample test case consists of two asterisks neither of which can be independent ticks since ticks of size $$$0$$$ don't exist.The second sample test case is already described in the statement (check the picture in the statement). This field can be obtained by drawing ticks of sizes $$$2$$$ and $$$3$$$, as shown in the figure.The field in the third sample test case corresponds to three ticks of size $$$1$$$. Their center cells are marked with $$$\color{blue}{\text{blue}}$$$, $$$\color{red}{\text{red}}$$$ and $$$\color{green}{\text{green}}$$$ colors: *.*.*$$$\color{blue}{\textbf{*}}$$$**.$$$\color{green}{\textbf{*}}\color{red}{\textbf{*}}$$$.....The field in the fourth sample test case could have been obtained by drawing two ticks of sizes $$$1$$$ and $$$2$$$. Their vertices are marked below with $$$\color{blue}{\text{blue}}$$$ and $$$\color{red}{\text{red}}$$$ colors respectively: .....*...*.*.*...$$$\color{red}{\textbf{*}}$$$.*...$$$\color{blue}{\textbf{*}}$$$.The field in the fifth sample test case can not be obtained because $$$k = 2$$$, and the last asterisk in the fourth row from the top with coordinates $$$(4, 5)$$$ can only be a part of a tick of size $$$1$$$.The field in the sixth sample test case can not be obtained because the top left asterisk $$$(1, 1)$$$ can't be an independent tick, since the sizes of the ticks must be positive, and cannot be part of a tick with the center cell in the last row, since it is separated from it by a gap (a point, '.') in $$$(2, 2)$$$.In the seventh sample test case, similarly, the field can not be obtained by the described process because the asterisks with coordinates $$$(1, 2)$$$ (second cell in the first row), $$$(3, 1)$$$ and $$$(3, 3)$$$ (leftmost and rightmost cells in the bottom) can not be parts of any ticks.

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

import qualified Data.ByteString.Char8 as S
import Control.Monad
import Data.Array.Unboxed

-- So ugly... Why?

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m, k] <- getInts 3
    rows <- getNext n
    let
      inp :: Array Int S.ByteString
      inp = listArray (0, n-1) $ map P.toStrict rows
      isOK (r, c) = r >= 0 && 0 <= c && c < m && S.index (inp ! r) c == '*'
      uL (r, c) = (r-1, c-1)
      uR (r, c) = (r-1, c+1)
      goL = takeWhile isOK . iterate uL
      goR = takeWhile isOK . iterate uR
      score pos = let
        vL = length $ goL pos
        vR = length $ goR pos
        in  min vL vR - 1
      bnds = ((0, 0), (n-1, m-1))
      apos :: [(Int, Int)]
      apos = do
        cpos <- range bnds
        let  tarv = score cpos
        guard $ tarv >= k
        cpos
          :  take tarv (iterate uL $ uL cpos)
          ++ take tarv (iterate uR $ uR cpos)
      scores :: UArray (Int, Int) Bool
      scores = accumArray (\_ _ -> True) False bnds $ zip apos $ repeat ()
      isAnswerYes = and $ do
        (r, c) <- range bnds
        pure $ (S.index (inp ! r) c == '*') <= scores ! (r, c)
    pure $ if  isAnswerYes
      then  string7 "YES\n"
      else  string7 "NO\n"

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

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

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

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

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