On the math lesson a teacher asked each pupil to come up with his own lucky numbers. As a fan of number theory Peter chose prime numbers. Bob was more original. He said that number t is his lucky number, if it can be represented as: t = a2 + b2,  where a, b are arbitrary positive integers.Now, the boys decided to find out how many days of the interval [l, r] (l ≤ r) are suitable for pair programming. They decided that the day i (l ≤ i ≤ r) is suitable for pair programming if and only if the number i is lucky for Peter and lucky for Bob at the same time. Help the boys to find the number of such days.

The first line of the input contains integer numbers l, r (1 ≤ l, r ≤ 3·108).

In the only line print the number of days on the segment [l, r], which are lucky for Peter and Bob at the same time.

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

import Data.Array.Base (unsafeRead,unsafeWrite,unsafeAt)
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Control.Applicative
import Control.Monad
import Control.Monad.ST

main = do
  [l,r] <- map read.words <$> getLine
  print $ solve l r

solve :: Int -> Int -> Int
solve l r = go (fromEnum $ l<=2 && 2<=r) $ (l+2)`div`4
   where
     !isPrime = sieve r
     !end = (r-1)`div`4
     go !ans !x
       | end < x = ans
       | unsafeAt isPrime x = go (ans+1) (x+1)
       | otherwise = go ans (x+1)

sieve :: Int -> UArray Int Bool
sieve num = runSTUArray $ do
  isSmallPrime <- newArray (0,isqrt num`div`2) True :: ST s (STUArray s Int Bool)
  isLargePrime <- newArray (0,num`div`4) True
  unsafeWrite isSmallPrime 0 False
  unsafeWrite isLargePrime 0 False
  let !sqrtNum2 = isqrt num`div`2
      !num4 = num`div`4
  forM_ [1..sqrtNum2] $ \i-> do
    isPrime <- unsafeRead isSmallPrime i
    when isPrime $ do
      let !p = i`shiftL`1 + 1
          !pp = i*(p+1)
          !ii = i*(i+1)
      forM_ [pp,pp+p..sqrtNum2] $ \j-> do
        unsafeWrite isSmallPrime j False
      forM_ [ii,ii+p..num4] $ \j-> do
        unsafeWrite isLargePrime j False
  return isLargePrime

isqrt :: Int -> Int
isqrt x = floor.(1e-8+).sqrt $ fromIntegral x

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Data.Char
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.Base (unsafeWrite,unsafeRead,unsafeAt)
import Data.Bits((.|.),xor)
import Monad

class Scan a where scan' :: String -> a
instance Scan Int where scan' = read
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' = read
instance Scan Double where scan' = read
instance Scan Integer where scan' = read
instance Scan String where scan' x = x
instance (Scan a,Scan b) => Scan (a,b) where scan' x = (\(x:y:_) -> (scan' x,scan' y)) (words x)
instance (Scan a,Scan b,Scan c) => Scan (a,b,c) where scan' x = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)) (words x)
instance (Scan a,Scan b,Scan c,Scan d) => Scan (a,b,c,d) where scan' x = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)) (words x)
instance (Scan a,Scan b,Scan c,Scan d,Scan e) => Scan (a,b,c,d,e) where scan' x = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)) (words x)
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance Ans String where showans x = x
instance (Ans a, Ans b) => Ans (a,b) where showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z
scan :: (Scan a) => IO a
scan = getLine>>=(return.scan')
scans :: (Scan a) => Int -> IO [a]
scans n = if n==0 then return [] else scan>>=(\x->scans (n-1)>>=return.(x:))
scanlist :: (Scan a) => IO [a]
scanlist = getLine>>=return.(map scan').words
scanlists :: (Scan a) => Int -> IO [[a]]
scanlists n = if n==0 then return [] else scanlist>>=(\x->scanlists (n-1)>>=return.(x:))
putAnsLn :: (Ans a) => a -> IO ()
putAnsLn = putStrLn.showans
putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns = mapM_ putAnsLn

sieve :: Int -> UArray Int Bool
sieve n = runSTUArray $ do
            t <- newArray (0,n) True
            unsafeWrite t 1 False
            let sqn = (floor.sqrt.fromIntegral) (n::Int)
            mapM_ (\i -> unsafeRead t i >>= (flip when) (mapM_ (\j -> (unsafeWrite t j False)) [i*i,i*(i+2)..n])) [3,5..sqn]
            return t

solve l r = rec beg 0
    where
      sve = sieve r
      beg = case mod l 4 of
              0 -> l+1
              1 -> l
              2 -> l+3
              3 -> l+2
      rec i n |i>r = n + (if l<=2&&r>=2 then 1 else 0)
              |unsafeAt sve i = rec (i+4) (n+1)
              |otherwise = rec (i+4) n

main = do (l,r) <- scan :: IO (Int,Int)
          print (solve l r)

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Data.Char
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.Base (unsafeWrite,unsafeRead,unsafeAt)
import Data.Bits((.|.),xor)
import Monad

class Scan a where scan' :: String -> a
instance Scan Int where scan' = read
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' = read
instance Scan Double where scan' = read
instance Scan Integer where scan' = read
instance Scan String where scan' x = x
instance (Scan a,Scan b) => Scan (a,b) where scan' x = (\(x:y:_) -> (scan' x,scan' y)) (words x)
instance (Scan a,Scan b,Scan c) => Scan (a,b,c) where scan' x = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)) (words x)
instance (Scan a,Scan b,Scan c,Scan d) => Scan (a,b,c,d) where scan' x = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)) (words x)
instance (Scan a,Scan b,Scan c,Scan d,Scan e) => Scan (a,b,c,d,e) where scan' x = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)) (words x)
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance Ans String where showans x = x
instance (Ans a, Ans b) => Ans (a,b) where showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z
scan :: (Scan a) => IO a
scan = getLine>>=(return.scan')
scans :: (Scan a) => Int -> IO [a]
scans n = if n==0 then return [] else scan>>=(\x->scans (n-1)>>=return.(x:))
scanlist :: (Scan a) => IO [a]
scanlist = getLine>>=return.(map scan').words
scanlists :: (Scan a) => Int -> IO [[a]]
scanlists n = if n==0 then return [] else scanlist>>=(\x->scanlists (n-1)>>=return.(x:))
putAnsLn :: (Ans a) => a -> IO ()
putAnsLn = putStrLn.showans
putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns = mapM_ putAnsLn

sieve :: Int -> UArray Int Bool
sieve n = runSTUArray $ do
            t <- newArray (0,n) True
            unsafeWrite t 1 False
            let sqn = (floor.sqrt.fromIntegral) (n::Int)
            mapM_ (\i -> unsafeRead t i >>= (flip when) (mapM_ (\j -> (unsafeWrite t j False)) [i*i,i*(i+2)..n])) [3,5..sqn]
            return t

solve l r = rec beg 0
    where
      sve = sieve r
      beg = case mod l 4 of
              0 -> l+1
              1 -> l
              2 -> l+3
              3 -> l+2
      rec i n |i>r = n + (if l<=2 then 1 else 0)
              |unsafeAt sve i = rec (i+4) (n+1)
              |otherwise = rec (i+4) n

main = do (l,r) <- scan :: IO (Int,Int)
          print (solve l r)


You've got an array a, consisting of n integers: a1, a2, ..., an. Your task is to find a minimal by inclusion segment [l, r] (1 ≤ l ≤ r ≤ n) such, that among numbers al,  al + 1,  ...,  ar there are exactly k distinct numbers.Segment [l, r] (1 ≤ l ≤ r ≤ n; l, r are integers) of length m = r - l + 1, satisfying the given property, is called minimal by inclusion, if there is no segment [x, y] satisfying the property and less then m in length, such that 1 ≤ l ≤ x ≤ y ≤ r ≤ n. Note that the segment [l, r] doesn't have to be minimal in length among all segments, satisfying the given property.

The first line contains two space-separated integers: n and k (1 ≤ n, k ≤ 105). The second line contains n space-separated integers a1, a2, ..., an — elements of the array a (1 ≤ ai ≤ 105).

Print a space-separated pair of integers l and r (1 ≤ l ≤ r ≤ n) such, that the segment [l, r] is the answer to the problem. If the sought segment does not exist, print "-1 -1" without the quotes. If there are multiple correct answers, print any of them.

NoteIn the first sample among numbers a1 and a2 there are exactly two distinct numbers.In the second sample segment [2, 5] is a minimal by inclusion segment with three distinct numbers, but it is not minimal in length among such segments.In the third sample there is no segment with four distinct numbers.

import Control.Monad (liftM)
import Data.Map ((!), adjust, delete, fromListWith, size)
import Data.Char (ord)
import Data.List (intercalate)

solve :: Int -> Int -> [Int] -> (Int, Int)
solve n k as
  | size map < k  =  (-1, -1)
  | otherwise  =  solve' (size map) 1 as map
  where
    map  =  fromListWith (+) [(a, 1) | a <- as]
    solve' k' l (a:as') map
      | map ! a > 1  =  solve' k' l' as' (adjust (\x -> x - 1) a map)
      | k' > k  =  solve' (k' - 1) l' as' (delete a map)
      | otherwise  =  (l, n + 1 - length (takeWhile (== last as) (reverse as)))
      where
        l'  =  l + 1

main :: IO ()
main  =  do
    [n, k]  <-  reads
    as  <-  reads
    prints $ toList $ solve n k as

  where

    toList (a, b)  =  [a, b]

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

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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

import Control.Monad (liftM)
import Data.Map ((!), adjust, delete, fromListWith, size)
import Data.Char (ord)
import Data.List (intercalate)

solve :: Int -> Int -> [Int] -> (Int, Int)
solve n k as
  | size map < k  =  (-1, -1)
  | otherwise  =  solve' (size map) 1 as map
  where
    map  =  fromListWith (+) [(a, 1) | a <- as]
    solve' k' l (a:as) map
      | map ! a > 1  =  solve' k' l' as (adjust (\x -> x - 1) a map)
      | k' > k  =  solve' (k' - 1) l' as (delete a map)
      | otherwise  =  (l, n + 1 - length (takeWhile (== last as) (reverse as)))
      where
        l'  =  l + 1

main :: IO ()
main  =  do
    [n, k]  <-  reads
    as  <-  reads
    prints $ toList $ solve n k as

  where

    toList (a, b)  =  [a, b]

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

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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


You are given an integer $$$n$$$. In one move, you can either multiply $$$n$$$ by two or divide $$$n$$$ by $$$6$$$ (if it is divisible by $$$6$$$ without the remainder).Your task is to find the minimum number of moves needed to obtain $$$1$$$ from $$$n$$$ or determine if it's impossible to do that.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow.  The only line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 10^9$$$).

For each test case, print the answer — the minimum number of moves needed to obtain $$$1$$$ from $$$n$$$ if it's possible to do that or -1 if it's impossible to obtain $$$1$$$ from $$$n$$$.

NoteConsider the sixth test case of the example. The answer can be obtained by the following sequence of moves from the given integer $$$15116544$$$:  Divide by $$$6$$$ and get $$$2519424$$$;  divide by $$$6$$$ and get $$$419904$$$;  divide by $$$6$$$ and get $$$69984$$$;  divide by $$$6$$$ and get $$$11664$$$;  multiply by $$$2$$$ and get $$$23328$$$;  divide by $$$6$$$ and get $$$3888$$$;  divide by $$$6$$$ and get $$$648$$$;  divide by $$$6$$$ and get $$$108$$$;  multiply by $$$2$$$ and get $$$216$$$;  divide by $$$6$$$ and get $$$36$$$;  divide by $$$6$$$ and get $$$6$$$;  divide by $$$6$$$ and get $$$1$$$.

import Control.Monad

f :: Int -> (Int,Int) -> Int
f 1 (a,b)
  | a <= b = b - a + b
  | otherwise = -1
f n (a,b)
  | even n = f (div n 2) (a+1,b)
  | mod n 3 == 0 = f (div n 3) (a,b+1)
  | otherwise = -1

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    print $ f n (0,0)

solve :: Int -> Int -> Int
solve k n
  | n == 1         = k
  | n `mod` 6 == 0 = solve (k + 1) (n `div` 6)
  | n `mod` 3 == 0 = solve (k + 1) (2 * n)
  | otherwise      = -1

main :: IO ()
main = interact $ unlines . map show . map (solve 0) . map read . tail . lines

import Control.Monad (replicateM_)
import Data.Maybe (fromMaybe)

main = readLn >>= flip replicateM_ (getLine >>= print . fromMaybe (-1) . f . read)

f :: Int -> Maybe Int
f 1 = Just 0
f n | n `mod` 6 == 0 = (1+) <$> f (n `div` 6)
    | n `mod` 3 == 0 = (2+) <$> f (n `div` 3)
    | otherwise = Nothing

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List
import Data.Maybe

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (l : rest) = (itoline . solve . linetoi) l : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

fac :: Int -> [Int]
fac = unfoldr firstfac where
  firstfac n = listToMaybe [ (f, n `div` f) | f <- [6,3,(max n 2)], n `mod` f == 0]

solve :: Int -> Int
solve n | n==1 = 0
        | (not.null) [x | x <-fac n, x /=6, x/=3] = -1
        | otherwise = sum [6 `div` x | x<-fac n]

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List
import Data.Maybe

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (l : rest) = (itoline . solve . linetoi) l : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: Int -> Int
solve = (fromMaybe (-1)).solve' where
  solve' n | n == 1 = Just 0
           | n `mod` 6 == 0 = pure (+) <*> Just 1 <*> solve' (n `div` 6)
           | n `mod` 3 == 0 = pure (+) <*> Just 2 <*> solve' (n `div` 3)
           | otherwise = Nothing

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

process 1 n = n
process x n | mod x 3 >0 = -1
            | mod x 6==0 = process (div x 6) (n+1)
            | otherwise = process (x+x) (n+1)

onecase = do
		x<- read <$> getLine ::IO Int
		print $ process x 0

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


There is a frog staying to the left of the string $$$s = s_1 s_2 \ldots s_n$$$ consisting of $$$n$$$ characters (to be more precise, the frog initially stays at the cell $$$0$$$). Each character of $$$s$$$ is either 'L' or 'R'. It means that if the frog is staying at the $$$i$$$-th cell and the $$$i$$$-th character is 'L', the frog can jump only to the left. If the frog is staying at the $$$i$$$-th cell and the $$$i$$$-th character is 'R', the frog can jump only to the right. The frog can jump only to the right from the cell $$$0$$$.Note that the frog can jump into the same cell twice and can perform as many jumps as it needs.The frog wants to reach the $$$n+1$$$-th cell. The frog chooses some positive integer value $$$d$$$ before the first jump (and cannot change it later) and jumps by no more than $$$d$$$ cells at once. I.e. if the $$$i$$$-th character is 'L' then the frog can jump to any cell in a range $$$[max(0, i - d); i - 1]$$$, and if the $$$i$$$-th character is 'R' then the frog can jump to any cell in a range $$$[i + 1; min(n + 1; i + d)]$$$.The frog doesn't want to jump far, so your task is to find the minimum possible value of $$$d$$$ such that the frog can reach the cell $$$n+1$$$ from the cell $$$0$$$ if it can jump by no more than $$$d$$$ cells at once. It is guaranteed that it is always possible to reach $$$n+1$$$ from $$$0$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The next $$$t$$$ lines describe test cases. The $$$i$$$-th test case is described as a string $$$s$$$ consisting of at least $$$1$$$ and at most $$$2 \cdot 10^5$$$ characters 'L' and 'R'. It is guaranteed that the sum of lengths of strings over all test cases does not exceed $$$2 \cdot 10^5$$$ ($$$\sum |s| \le 2 \cdot 10^5$$$).

For each test case, print the answer — the minimum possible value of $$$d$$$ such that the frog can reach the cell $$$n+1$$$ from the cell $$$0$$$ if it jumps by no more than $$$d$$$ at once.

NoteThe picture describing the first test case of the example and one of the possible answers:In the second test case of the example, the frog can only jump directly from $$$0$$$ to $$$n+1$$$.In the third test case of the example, the frog can choose $$$d=3$$$, jump to the cell $$$3$$$ from the cell $$$0$$$ and then to the cell $$$4$$$ from the cell $$$3$$$.In the fourth test case of the example, the frog can choose $$$d=1$$$ and jump $$$5$$$ times to the right.In the fifth test case of the example, the frog can only jump directly from $$$0$$$ to $$$n+1$$$.In the sixth test case of the example, the frog can choose $$$d=1$$$ and jump $$$2$$$ times to the right.

import Control.Monad
import Data.List
main = do
  t <- readLn
  replicateM t $ getLine >>= print.solve
solve = (+1).foldl max 0.map length.filter((=='L').head).group

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

main = getLine >>= test.read
test 0 = return ()
test i = do
  s <- ((++ "R").('R' :)) <$> getLine
  print $ maximum $ zipWith subtract <*> tail $ map snd $ filter ((== 'R').fst) $ zip s [0..]
  test (i - 1)

import Control.Monad

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        str <- getLine
        print $ maxDist 1 str

maxDist n "" = n
maxDist n ('R':xs) = max n $ maxDist 1 xs
maxDist n (_:xs) = maxDist (succ n) xs

import Data.List
import Control.Monad

solve xs = dist rs
  where
    l = length xs
    rs = sort $ (elemIndices 'R' xs) ++ [-1,l]
    dist [_] = 0
    dist (x:y:xs) = max (y-x) (dist (y:xs))

main = do
  t <- readLn :: IO Int
  xss <- replicateM t $ do
    getLine >>= return
  mapM_ (print . solve) xss

import Data.List

main :: IO ()

main = interact (format' . solve . format)

solve :: [[Int]] -> [Int]
solve = map solver

format' = unlines . map show

solver :: [Int] -> Int
solver xs = f 0 0 xs

f i l [] = i -- last
f i l (x:xs)
    | i < (x - l)   = f (x - l) x xs
    | otherwise     = f i x xs

format :: String -> [[Int]]
format xs = map (map fst . filter ((=='R') . snd) . zip [1..] . foldr (:) "R") . tail . lines $ xs


The "BerCorp" company has got n employees. These employees can use m approved official languages for the formal correspondence. The languages are numbered with integers from 1 to m. For each employee we have the list of languages, which he knows. This list could be empty, i. e. an employee may know no official languages. But the employees are willing to learn any number of official languages, as long as the company pays their lessons. A study course in one language for one employee costs 1 berdollar.Find the minimum sum of money the company needs to spend so as any employee could correspond to any other one (their correspondence can be indirect, i. e. other employees can help out translating).

The first line contains two integers n and m (2 ≤ n, m ≤ 100) — the number of employees and the number of languages. Then n lines follow — each employee's language list. At the beginning of the i-th line is integer ki (0 ≤ ki ≤ m) — the number of languages the i-th employee knows. Next, the i-th line contains ki integers — aij (1 ≤ aij ≤ m) — the identifiers of languages the i-th employee knows. It is guaranteed that all the identifiers in one list are distinct. Note that an employee may know zero languages. The numbers in the lines are separated by single spaces.

Print a single integer — the minimum amount of money to pay so that in the end every employee could write a letter to every other one (other employees can help out translating).

NoteIn the second sample the employee 1 can learn language 2, and employee 8 can learn language 4.In the third sample employee 2 must learn language 2.

import Control.Monad (liftM, replicateM)
import Data.Graph
import Data.Tree
import Data.Char (ord)
import Data.List ((\\), intercalate)

solve :: Int -> Int -> [[Int]] -> Int
solve n m xss
  | all (== [0]) xss  =  n
  | otherwise  =  length (map flatten (components graph) \\ (map toList [n+1 .. n+m])) - 1
  where
    toList x  =  [x]
    xss'   =  zip [1..] $ map (tail . map (+n)) xss
    graph  =  buildG (1, n + m) $ concatMap (\(i, ls) -> zip (repeat i) ls) xss'

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

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

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)
-}
    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

import Control.Applicative ((<$>), (<*>))
import Data.Graph (buildG, components)
import Data.List ((\\))
import Data.Tree (flatten)

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

solve :: (Int, Int) -> [[Int]] -> Int
solve (n, m) xs | all null xs = n
                | otherwise = length (map flatten (components graph) \\ map (:[]) [n + 1 .. n + m]) - 1
  where graph = buildG (1, n + m) $ concatMap (\(i, ys) -> map (\y -> (i, n + y)) ys) $ zip [1..] xs

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

import qualified Data.Map as M
import Data.List

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

solve :: [[Int]] -> Int
solve lss  = emp + (max 0 $ length (group $ sort $ map (root disjointSet) $ M.elems disjointSet) - 1)
  where
  (emp, disjointSet) = foldl f (0, M.empty) $ zip [101..] lss
  f (e, set) (n, []) = (e + 1, set)
  f (e, set) (n, ls) = (e, foldl (g n) set $ map (root set) ls)
  g n set r = M.insert r n set

root set l
    | M.member l set = root set (set M.! l)
    | otherwise = l

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

import Control.Applicative
import Control.Monad
import Data.Array.Base
import Data.Array (Array)
import Data.Array.IO (IOUArray)
import qualified Data.ByteString.Char8 as B
import Data.List hiding (find)
import Data.Ord

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

mkGraph :: Int -> [(Int,Int)] -> Array Int [Int]
mkGraph vnum edges = unsafeAccumArray (flip (:)) [] (0,vnum-1) edges

main = do
  [n,m] <- map read.words <$> getLine :: IO [Int]
  let f i [] = [(m,i)]
      f i xs = xs
  langToPerson <- mkGraph (m+1).concat.zipWith(\i (_:xs)->f i$map((,i).pred)xs)[0..].map(map readInt.B.words).B.lines <$> B.getContents :: IO (Array Int [Int])
  uf <- mkUnionFind n
  mapM_ (unites uf.unsafeAt langToPerson) [0..m]
  tmp <- pred.length.unique.sort <$> mapM (flip find uf) [0..n-1]
  let zeros = length $ unsafeAt langToPerson m
      res | tmp == 0 = zeros
          | zeros <= 1 = tmp
          | otherwise = tmp + zeros - 1
  print $ res

unique (x:xs) = x : unique (dropWhile (x==) xs)
unique [] = []

unites uf (x:y:xs) = unite x y uf >> unites uf (y:xs)
unites _ _ = return ()

type Parent = Int
type Rank = Int
data UnionFind = UF !(IOUArray Int Parent) !(IOUArray Int Rank)

mkUnionFind :: Int -> IO UnionFind
mkUnionFind n = do
  parent <- newListArray (0,n-1) [0..n-1] :: IO (IOUArray Int Parent)
  rank   <- newArray (0,n-1) 0            :: IO (IOUArray Int Rank)
  return $! UF parent rank

find :: Int -> UnionFind -> IO Parent
find x uf@(UF parent _) = do
  px <- unsafeRead parent x
  if x==px
     then return x
     else do
       ppx <- find px uf
       unsafeWrite parent x ppx
       return ppx

unite :: Int -> Int -> UnionFind -> IO ()
unite x y uf@(UF parent rank) = do
  px <- find x uf
  py <- find y uf
  when (px/=py) $ do
    rx <- unsafeRead rank px
    ry <- unsafeRead rank py
    case compare rx ry of
      LT -> unsafeWrite parent px py
      GT -> unsafeWrite parent py px
      EQ -> do
        unsafeWrite parent px py
        unsafeWrite rank py $! ry+1

import Control.Monad (liftM, replicateM)
import Data.Graph
import Data.Tree
import Data.Char (ord)
import Data.List ((\\), intercalate)

solve :: Int -> Int -> [[Int]] -> Int
solve n m xss  =  length (map flatten (components graph) \\ (map toList [n+1 .. n+m])) - 1
  where
    toList x  =  [x]
    xss'   =  zip [1..] $ map (tail . map (+n)) xss
    graph  =  buildG (1, n + m) $ concatMap (\(i, ls) -> zip (repeat i) ls) xss'

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

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

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)
-}
    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

import Control.Applicative ((<$>), (<*>))
import Data.Graph (buildG, components)
import Data.List ((\\))
import Data.Tree (flatten)

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

solve :: (Int, Int) -> [[Int]] -> Int
solve (n, m) xs = length (map flatten (components graph) \\ map (:[]) [n + 1 .. n + m]) - 1
  where graph = buildG (1, n + m) $ concatMap (\(i, ys) -> map (\y -> (i, n + y)) ys) $ zip [1..] xs

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

import qualified Data.Map as M
import Data.List

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

solve :: [[Int]] -> Int
solve lss  = length (group $ sort $ map (root disjointSet) $ M.elems disjointSet) - 1
  where
  disjointSet = foldl f M.empty $ zip [101..] lss
  f set (n, []) = M.insert (n * n) n set
  f set (n, ls) = foldl (g n) set ls
  g n set l = M.insert (root set l) n set

root set l
    | M.member l set = root set (set M.! l)
    | otherwise = l

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

import Control.Applicative
import Control.Monad
import Data.Array.Base
import Data.Array (Array)
import Data.Array.IO (IOUArray)
import qualified Data.ByteString.Char8 as B
import Data.List hiding (find)
import Data.Ord

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

mkGraph :: Int -> [(Int,Int)] -> Array Int [Int]
mkGraph vnum edges = unsafeAccumArray (flip (:)) [] (0,vnum-1) edges

main = do
  [n,m] <- map read.words <$> getLine :: IO [Int]
  langToPerson <- mkGraph m.concat.zipWith(\i (_:xs)->map((,i).pred)xs)[0..].map(map readInt.B.words).B.lines <$> B.getContents :: IO (Array Int [Int])
  uf <- mkUnionFind n
  mapM_ (unites uf.unsafeAt langToPerson) [0..m-1]
  res <- pred.length.unique.sort <$> mapM (flip find uf) [0..n-1]
  print res

unique (x:xs) = x : unique (dropWhile (x==) xs)
unique [] = []

unites uf (x:y:xs) = unite x y uf >> unites uf (y:xs)
unites _ _ = return ()

type Parent = Int
type Rank = Int
data UnionFind = UF !(IOUArray Int Parent) !(IOUArray Int Rank)

mkUnionFind :: Int -> IO UnionFind
mkUnionFind n = do
  parent <- newListArray (0,n-1) [0..n-1] :: IO (IOUArray Int Parent)
  rank   <- newArray (0,n-1) 0            :: IO (IOUArray Int Rank)
  return $! UF parent rank

find :: Int -> UnionFind -> IO Parent
find x uf@(UF parent _) = do
  px <- unsafeRead parent x
  if x==px
     then return x
     else do
       ppx <- find px uf
       unsafeWrite parent x ppx
       return ppx

unite :: Int -> Int -> UnionFind -> IO ()
unite x y uf@(UF parent rank) = do
  px <- find x uf
  py <- find y uf
  when (px/=py) $ do
    rx <- unsafeRead rank px
    ry <- unsafeRead rank py
    case compare rx ry of
      LT -> unsafeWrite parent px py
      GT -> unsafeWrite parent py px
      EQ -> do
        unsafeWrite parent px py
        unsafeWrite rank py $! ry+1


Polycarp has $$$x$$$ of red and $$$y$$$ of blue candies. Using them, he wants to make gift sets. Each gift set contains either $$$a$$$ red candies and $$$b$$$ blue candies, or $$$a$$$ blue candies and $$$b$$$ red candies. Any candy can belong to at most one gift set.Help Polycarp to find the largest number of gift sets he can create.For example, if $$$x = 10$$$, $$$y = 12$$$, $$$a = 5$$$, and $$$b = 2$$$, then Polycarp can make three gift sets:   In the first set there will be $$$5$$$ red candies and $$$2$$$ blue candies;  In the second set there will be $$$5$$$ blue candies and $$$2$$$ red candies;  In the third set will be $$$5$$$ blue candies and $$$2$$$ red candies. Note that in this example there is one red candy that Polycarp does not use in any gift set.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. Each test case consists of a single string containing four integers $$$x$$$, $$$y$$$, $$$a$$$, and $$$b$$$ ($$$1 \le x, y, a, b \le 10^9$$$).

For each test case, output one number — the maximum number of gift sets that Polycarp can make.

import Control.Arrow ((>>>))

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

solve :: [Int] -> Int
solve [x, y, a, b]
  | a == b = min x y `div` a
  | otherwise = search 0 (1 + min x y `div` c)
  where
    search l r
      | l + 1 == r = l
      | otherwise =
        let mid = (l + r) `div` 2
         in if ok mid
              then search mid r
              else search l mid
    c = min a b
    gap = abs (b - a)
    ok k =
      let m = (x - k * c) `div` gap
          n = (y - k * c) `div` gap
       in m + n >= k

import Control.Arrow ((>>>))

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

solve :: [Int] -> Int
solve [x, y, a, b]
  | a == b = min x y `div` a
  | otherwise = search 0 (10 ^ 9)
  where
    search l r
      | l + 1 == r = l
      | otherwise =
        let mid = (l + r) `div` 2
         in if ok mid
              then search mid r
              else search l mid
    c = min a b
    gap = abs (b - a)
    ok k =
      let m = (x - k * c) `div` gap
          n = (y - k * c) `div` gap
       in min x y >= k * c && m + n >= k


Okabe and Super Hacker Daru are stacking and removing boxes. There are n boxes numbered from 1 to n. Initially there are no boxes on the stack.Okabe, being a control freak, gives Daru 2n commands: n of which are to add a box to the top of the stack, and n of which are to remove a box from the top of the stack and throw it in the trash. Okabe wants Daru to throw away the boxes in the order from 1 to n. Of course, this means that it might be impossible for Daru to perform some of Okabe's remove commands, because the required box is not on the top of the stack.That's why Daru can decide to wait until Okabe looks away and then reorder the boxes in the stack in any way he wants. He can do it at any point of time between Okabe's commands, but he can't add or remove boxes while he does it.Tell Daru the minimum number of times he needs to reorder the boxes so that he can successfully complete all of Okabe's commands. It is guaranteed that every box is added before it is required to be removed.

The first line of input contains the integer n (1 ≤ n ≤ 3·105) — the number of boxes. Each of the next 2n lines of input starts with a string "add" or "remove". If the line starts with the "add", an integer x (1 ≤ x ≤ n) follows, indicating that Daru should add the box with number x to the top of the stack.  It is guaranteed that exactly n lines contain "add" operations, all the boxes added are distinct, and n lines contain "remove" operations. It is also guaranteed that a box is always added before it is required to be removed.

Print the minimum number of times Daru needs to reorder the boxes to successfully complete all of Okabe's commands.

3
add 1
remove
add 2
add 3
remove
remove

7
add 3
add 2
add 1
remove
add 4
remove
remove
remove
add 6
add 7
add 5
remove
remove
remove

NoteIn the first sample, Daru should reorder the boxes after adding box 3 to the stack.In the second sample, Daru should reorder the boxes after adding box 4 and box 7 to the stack.

{-# LANGUAGE OverloadedStrings, BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad

data Command = Add {-# UNPACK #-} !Int | Remove

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

solve n cs = (\(a, _, _, _) -> a) $ foldl go (0, 1, [], []) cs
  where
    go (!cnt, !i, s, !sorted) c = case c of
      Add x -> (cnt, i, x:s, False:sorted)
      Remove -> if head sorted || i == head s
                then (cnt, i + 1, tail s, tail sorted)
                else (cnt + 1, i + 1, tail s, repeat True)

main = do
  n <- fmap readInt B.getLine
  cs <- replicateM (2 * n) (fmap (\l -> case B.words l of { ["add", x] -> Add (readInt x); _ -> Remove }) B.getLine)
  print $ solve n cs

{-# LANGUAGE OverloadedStrings, BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad

data Command = Add Int | Remove

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

solve n cs = (\(a, _, _, _) -> a) $ foldl go (0, 1, [], []) cs
  where
    go (!cnt, !i, s, !sorted) c = case c of
      Add x -> (cnt, i, x:s, False:sorted)
      Remove -> if head sorted || i == head s
                then (cnt, i + 1, tail s, tail sorted)
                else (cnt + 1, i + 1, tail s, repeat True)

main = do
  n <- fmap readInt B.getLine
  cs <- replicateM (2 * n) (fmap (\l -> case B.words l of { ["add", x] -> Add (readInt x); _ -> Remove }) B.getLine)
  print $ solve n cs

{-# LANGUAGE OverloadedStrings, BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad

data Command = Add {-# UNPACK #-} !Int | Remove

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

solve n cs = (\(a, _, _, _) -> a) $ foldl go (0, 1, [], []) cs
  where
    go (!cnt, !i, s, sorted) c = case c of
      Add x -> (cnt, i, x:s, False:sorted)
      Remove -> if head sorted || i == head s
                then (cnt, i + 1, tail s, tail sorted)
                else (cnt + 1, i + 1, tail s, repeat True)

main = do
  n <- fmap readInt B.getLine
  cs <- replicateM (2 * n) (fmap (\l -> case B.words l of { ["add", x] -> Add (readInt x); _ -> Remove }) B.getLine)
  print $ solve n cs

import Data.List
import Data.Char

-- -- O( n^2 * log n ) method
-- boxes lst commands srts pos
--   | (null commands) = srts
--   | (take 3 (head commands)) == "add"  = boxes (((read (drop 4 (head commands)))::Int) : lst) (tail commands) srts pos
--   | (take 3 (head commands)) == "rem" && (head lst) /= pos = boxes (sort lst) commands (succ srts) pos
--   | (head lst) == pos = boxes (tail lst) (tail commands) srts (succ pos)

boxes lst commands srts pos
  | (null commands) = srts
  | (take 3 (head commands)) == "add" = boxes (((read (drop 4 (head commands)))::Int) : lst) (tail commands) srts pos
  | (null lst) = boxes [] (tail commands) (srts) (succ pos)
  | (head lst) /= pos = boxes [] (tail commands) (succ srts) (succ pos)
  | (head lst) == pos = boxes (tail lst) (tail commands) srts (succ pos)

main = do
  ff <- getLine
  let n = (read (ff)) :: Int
      hh = replicate (2*n) getLine

  gg <- sequence hh
  let ans = boxes [] gg 0 1
  putStrLn (show ans)

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

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import           Data.List
import           Data.List.Split
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = getLine >> B.getContents >>= print.solve.B.words

solve :: [B.ByteString] -> Int
solve bss = go 0 1 [] IS.empty bss
  where
    go !res !num (top:stock) set ("remove":rest)
      | top == num = go res (num + 1) stock set rest
      | set' <- foldl' (flip IS.insert) set (top:stock) =
           go (res + 1) (num + 1) [] (IS.deleteMin set') rest
    go !res !num [] set ("remove":rest) =
        go res (num + 1) [] (IS.deleteMin set) rest
    go res num stock set ("add":x:rest) =
        go res num (readInt x:stock) set rest
    go res _ _ _ [] = res

solve :: [Int] -> Int -> [String] -> Int
solve _ _ [] = 0
solve s j ("remove":t)
  | s == [] = sub
  | (head s) == j = solve (tail s) (j+1) t
  | otherwise = sub+1
    where sub = solve [] (j+1) t
solve s j (h:t) = solve (i:s) j t
  where i = read $ head $ tail $ words h

main = do
  sn <- getLine
  let n = read sn :: Int
  q <- sequence [getLine | i <- [1..(2*n)]]
  putStr $ show $ solve [] 1 q


You are given four integer values $$$a$$$, $$$b$$$, $$$c$$$ and $$$m$$$.Check if there exists a string that contains:   $$$a$$$ letters 'A';  $$$b$$$ letters 'B';  $$$c$$$ letters 'C';  no other letters;  exactly $$$m$$$ pairs of adjacent equal letters (exactly $$$m$$$ such positions $$$i$$$ that the $$$i$$$-th letter is equal to the $$$(i+1)$$$-th one).

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. Each of the next $$$t$$$ lines contains the description of the testcase — four integers $$$a$$$, $$$b$$$, $$$c$$$ and $$$m$$$ ($$$1 \le a, b, c \le 10^8$$$; $$$0 \le m \le 10^8$$$).

For each testcase print "YES" if there exists a string that satisfies all the requirements. Print "NO" if there are no such strings. 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 answer).

NoteIn the first testcase strings "ABCAB" or "BCABA" satisfy the requirements. There exist other possible strings.In the second testcase there's no way to put adjacent equal letters if there's no letter that appears at least twice.In the third testcase string "CABBCC" satisfies the requirements. There exist other possible strings.

import Control.Monad
import Data.List

calc :: [Int] -> Int -> String
calc [a,b,c] m =
  if c - (a + b + 1) <= m && m <= a + b + c  - 3 then "YES"
  else "NO"

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [a,b,c,m] = map read $ words line :: [Int]
    putStrLn $ calc (sort [a,b,c]) m

import Data.List (sort)
main = interact $ unlines . map solve . drop 1 . lines
solve t = solve' $ map read $ words t
solve' :: [Int] -> String
solve' [a, b, c, m] =
  if m >= minReachable && m <= maxReachable then "YES" else "NO"
    where minReachable = c' - 1 - a' - b'
          maxReachable = a + b + c - 3
          [a', b', c'] = sort [a, b, c]
solve' _ = "INVALID TEST CASE"

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

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

solve :: IO ()
solve = do
    arr <- rl
    let m = last arr
    let f = sort . take 3 $ arr
    if max 0 (2 * maximum f - sum f - 1) <= m && m <= sum f - 3
        then putStrLn "YES" else putStrLn "NO"

main :: IO ()
main = do
    [t] <- rl
    replicateM_ t solve

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import           Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import qualified Data.Foldable              as F
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), ViewR (..), (<|),
                                             (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

infixl 0 >$>
(>$>) = flip ($)

readB = C.unpack >>> read

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

solve :: [Int] -> Bool
solve [a,b,c,m] = a + b + c - m >= 3 && m >= z - (x+y) - 1
  where
    [x,y,z] = sort [a,b,c]

import Control.Monad
import Data.List

calc :: [Int] -> Int -> String
calc [a,b,c] m =
  if c - (a + b - 1) <= m && m <= a + b + c  - 3 then "YES"
  else "NO"

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [a,b,c,m] = map read $ words line :: [Int]
    putStrLn $ calc (sort [a,b,c]) m


Famil Door wants to celebrate his birthday with his friends from Far Far Away. He has n friends and each of them can come to the party in a specific range of days of the year from ai to bi. Of course, Famil Door wants to have as many friends celebrating together with him as possible.Far cars are as weird as Far Far Away citizens, so they can only carry two people of opposite gender, that is exactly one male and one female. However, Far is so far from here that no other transportation may be used to get to the party.Famil Door should select some day of the year and invite some of his friends, such that they all are available at this moment and the number of male friends invited is equal to the number of female friends invited. Find the maximum number of friends that may present at the party.

NoteIn the first sample, friends 3 and 4 can come on any day in range [117, 128].In the second sample, friends with indices 3, 4, 5 and 6 can come on day 140.

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

import qualified Data.ByteString.Char8 as C

data Person = Person Int Int Bool
  deriving Show

instance Eq Person where
   (Person _ a aa) == (Person _ b bb) = (a == b) && (aa == bb)

instance Ord Person where
   (Person _ a aa) <= (Person _ b bb) = (a < b) || ((a == b) && aa) || ((a == b) && (not aa) && (not bb))

findRes :: [Person] -> (Int, Int) -> Int
findRes [] a = 0
findRes ((Person i j k):xs) (a, b) =
    max (min a b) (findRes xs (c, d))
  where
    (c, d) = if i == 0 then if k then (a+1,b) else (a-1,b) else if k then (a, b+1) else (a, b-1)

tr :: C.ByteString -> [Person]
tr = fromJust . f . C.unpack
  where
    f (a:y:ys) =
        if (a == 'M')
        then
            (C.readInt.C.pack $ ys) >>=
                \x -> Just $ [ Person 0 (fst x) True
                             , Person 0 ((fst . fromJust . C.readInt . C.pack . tail . C.unpack . snd) x) False]
        else
            (C.readInt.C.pack $ ys) >>=
                \x -> Just $ [ Person 1 (fst x) True
                             , Person 1 ((fst . fromJust . C.readInt . C.pack . tail . C.unpack . snd) x) False]

main :: IO ()
main = do
    a <- (fst.fromJust.C.readInt) <$> C.getLine
    b <- sequence $ replicate a $ tr <$> C.getLine
    print $ (*2) $ flip findRes (0, 0) $ sort . concat $ b

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

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

main = do
  t <- fmap read getLine
  inp <- forM [1..t] $ \_ -> do
         [s, a, b] <- fmap words getLine
         case s of
           "F" -> return (Friend F (read a) (read b))
           _ -> return (Friend M (read a) (read b))
  print $ solve inp

data Gender = M | F deriving (Show)
type Start = Int
type End = Int
data Friend = Friend Gender Start End deriving (Show)
data Interval = Open Int Gender | Close Int Gender deriving (Show)

instance Ord Interval where
    compare x y = compare (getIntervalVal x) (getIntervalVal y)

getIntervalVal (Open x _) = x
getIntervalVal (Close x _) = x

instance Eq Interval where
    x == y = getIntervalVal x == getIntervalVal y

--solve :: [Friend] -> Int
solve fs = maximum . map f' . scanl f st .  group . sort $ fs >>= intervals
    where
      f' (x, y) = (min x y)*2
      st = (0,0)
      g (a, b) = a == b
      intervals (Friend x s e) = [Open s x, Close (e+1) x]
      f (m, f) l = foldl g (m,f) l
          where
            g (m,f) (Open _ M) = (m + 1, f)
            g (m,f) (Close _ M) = (m - 1, f)
            g (m,f) (Open _ F) = (m, f + 1)
            g (m,f) (Close _ F) = (m, f - 1)

inp = [Friend M 128(1 + 130),
      Friend F 128 (1 +131),
      Friend F 131 (1 +140),
      Friend F 131 (1 +141),
      Friend M 131 (1 +200),
      Friend M 140 (1 +200)]

inp2 = [Friend M 151(1 +  307),
        Friend F 343(1 +  352),
        Friend F 117(1 +  145),
        Friend M 24 (1 + 128)]

inp3 = [Friend M 157 160, Friend F 151 160, Friend F 155 159, Friend M 12 157]

inp4 = [Friend M 1 2, Friend F 2 3, Friend M 0 3, Friend F 0 3, Friend M 2 2, Friend F 2 2]

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function
-- import           Data.Array
-- import           Data.ByteString (ByteString)
-- import qualified Data.ByteString.Char8 as C
-- import           Data.ByteString.Char8 ()
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S

myread = read :: String -> Int
main = do
  n <- readLn
  ns <- map ((\[x,a,b]->(head x,myread a,myread b)).words) <$> replicateM n getLine
  print $ solve n ns

solve :: Int -> [(Char,Int,Int)] -> Int
solve n ns = maximum . map (go (partition (\(x,_,_)->x=='M') ns)) $ [1..366] where
  go !(ms,fs) !d = 2 * min (go2 d ms) (go2 d fs) where
    go2 d rs = length . filter (\(_,a,b) -> a<=d && d<=b) $ rs

import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Function as F
import Control.Monad
import Control.Applicative
import Data.List
readInt :: C.ByteString -> Int

readInt = fst . fromJust . C.readInt

getInts = map readInt . C.words <$> C.getLine

countLetters :: String -> Char -> Int
countLetters str c = length $ filter (== c) str

fst3 (a,b,c) = a
rd3 (_,_, c) = c

main :: IO ()
main = do
    (n:_) <- getInts
    rawInput <- replicateM n getLine
    let wordedInp = map words rawInput
    --print wordedInp
    let procInput = map processInput wordedInp
    let events = concatMap procEvent procInput
    let sEvents = sort events
    let groupedEvents = groupBy ((==) `F.on` fst3) sEvents
    let procEvents = map procList groupedEvents
    print $ rd3 $ foldl procSeries (0,0, 0) procEvents
    where
        processInput line = case line of
            [[c], n1, n2] -> (c, read n1 :: Int, read n2 :: Int)
        procEvent (c, n1, n2) = [(n1,c,1), (n2 + 1, c,-1)]
        procEl (men, women) (_, c, x)
            | c == 'M' = (men + x, women)
            | c == 'F' = (men, women + x)
        procList =
            foldl procEl (0,0)
        procSeries (men, women, score) (men2, women2) =
            (newMen, newWomen, trueScore)
            where
                newMen = men + men2
                newWomen = women + women2
                newScore = 2 * min newMen newWomen
                trueScore = max newScore score

{-
Famil Door wants to celebrate his birthday with his friends from Far Far Away.
He has n friends and each of them can come to the party in a specific range of
days of the year from ai to bi. Of course, Famil Door wants to have as many
friends celebrating together with him as possible.

Far cars are as weird as Far Far Away citizens, so they can only carry two people
of opposite gender, that is exactly one male and one female. However, Far is so
far from here that no other transportation may be used to get to the party.

Famil Door should select some day of the year and invite some of his friends,
such that they all are available at this moment and the number of male friends
invited is equal to the number of female friends invited. Find the maximum
number of friends that may present at the party.

Input
The first line of the input contains a single integer n (1 ≤ n ≤ 5000) — then
number of Famil Door's friends.

Then follow n lines, that describe the friends. Each line starts with a capital
letter 'F' for female friends and with a capital letter 'M' for male friends.
Then follow two integers ai and bi (1 ≤ ai ≤ bi ≤ 366), providing that the i-th
friend can come to the party from day ai to day bi inclusive.

Output
Print the maximum number of people that may come to Famil Door's party.

Found at: http://codeforces.com/contest/629/problem/B
-}

module Main where

solve :: [(Char, Int, Int)] -> Int
solve friends = 2 * (maximum $ zipWith (\m f -> min m f) mTotal fTotal)
  where mFriends = filter (\(g,_,_) -> g == 'M') friends
        mMasks = map mask mFriends
        mTotal = foldl addMasks mask0 mMasks
        fFriends = filter (\(g,_,_) -> g == 'F') friends
        fMasks = map mask fFriends
        fTotal = foldl addMasks mask0 fMasks

mask :: (Char,Int,Int) -> [Int]
mask (_,a,b) = [if a <= i && i <= b then 1 else 0 | i <- [1..366]]

mask0 = [0 | i <- [1..366]]

addMasks [] [] = []
addMasks (x:xs) (y:ys) = (x+y) : addMasks xs ys

getLines :: Int -> IO [String]
getLines n = sequence $ replicate n getLine

parseFriend :: [String] -> (Char, Int, Int)
parseFriend [genderStr, aStr, bStr] = (head genderStr, read aStr, read bStr)

main :: IO ()
main = do
  friendCountStr <- getLine
  let n = read friendCountStr :: Int
  friendLines <- getLines n
  let friends = map (parseFriend . words) friendLines
  putStrLn $ show (solve friends)

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

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

main = do
  t <- fmap read getLine
  inp <- forM [1..t] $ \_ -> do
         [s, a, b] <- fmap words getLine
         case s of
           "F" -> return (Friend F (read a) (read b + 1))
           _ -> return (Friend M (read a) (read b + 1))
  print $ solve inp

data Gender = M | F deriving (Show)
type Start = Int
type End = Int
data Friend = Friend Gender Start End deriving (Show)
data Interval = Open Int Gender | Close Int Gender deriving (Show)

instance Ord Interval where
    compare x y = compare (getIntervalVal x) (getIntervalVal y)

getIntervalVal (Open x _) = x
getIntervalVal (Close x _) = x

instance Eq Interval where
    x == y = getIntervalVal x == getIntervalVal y

--solve :: [Friend] -> Int
solve fs = maximum . map (uncurry (+)) . filter g . scanl f st .  group . sort $ fs >>= intervals
    where
      st = (0,0)
      g (a, b) = a == b
      intervals (Friend x s e) = [Open s x, Close e x]
      f (m, f) l = foldl g (m,f) l
          where

            g (m,f) (Open _ M) = (m + 1, f)
            g (m,f) (Close _ M) = (m - 1, f)
            g (m,f) (Open _ F) = (m, f + 1)
            g (m,f) (Close _ F) = (m, f - 1)

inp = [Friend M 128(1 + 130),
      Friend F 128 (1 +131),
      Friend F 131 (1 +140),
      Friend F 131 (1 +141),
      Friend M 131 (1 +200),
      Friend M 140 (1 +200)]

inp2 = [Friend M 151(1 +  307),
        Friend F 343(1 +  352),
        Friend F 117(1 +  145),
        Friend M 24 (1 + 128)]

inp3 = [Friend M 157 160, Friend F 151 160, Friend F 155 159, Friend M 12 157]

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

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

main = do
  t <- fmap read getLine
  inp <- forM [1..t] $ \_ -> do
         [s, a, b] <- fmap words getLine
         case s of
           "F" -> return (Friend F (read a) (read b + 1))
           _ -> return (Friend M (read a) (read b + 1))
  print $ solve inp

data Gender = M | F deriving (Show)
type Start = Int
type End = Int
data Friend = Friend Gender Start End deriving (Show)
data Interval = Open Int Gender | Close Int Gender deriving (Show)

instance Ord Interval where
    compare x y = compare (getIntervalVal x) (getIntervalVal y)

getIntervalVal (Open x _) = x
getIntervalVal (Close x _) = x

instance Eq Interval where
    x == y = getIntervalVal x == getIntervalVal y

--solve :: [Friend] -> Int
solve fs = {-maximum . map (uncurry (+)) . filter g .-} scanl f st .  group . sort $ fs >>= intervals
    where
      st = (0,0)
      g (a, b) = a == b
      intervals (Friend x s e) = [Open s x, Close e x]
      f (m, f) l = foldl g (m,f) l
          where

            g (m,f) (Open _ M) = (m + 1, f)
            g (m,f) (Close _ M) = (m - 1, f)
            g (m,f) (Open _ F) = (m, f + 1)
            g (m,f) (Close _ F) = (m, f - 1)

inp = [Friend M 128(1 + 130),
      Friend F 128 (1 +131),
      Friend F 131 (1 +140),
      Friend F 131 (1 +141),
      Friend M 131 (1 +200),
      Friend M 140 (1 +200)]

inp2 = [Friend M 151(1 +  307),
        Friend F 343(1 +  352),
        Friend F 117(1 +  145),
        Friend M 24 (1 + 128)]

inp3 = [Friend M 157 160, Friend F 151 160, Friend F 155 159, Friend M 12 157]


There is little time left before the release of the first national operating system BerlOS. Some of its components are not finished yet — the memory manager is among them. According to the developers' plan, in the first release the memory manager will be very simple and rectilinear. It will support three operations:   alloc n — to allocate n bytes of the memory and return the allocated block's identifier x;  erase x — to erase the block with the identifier x;  defragment — to defragment the free memory, bringing all the blocks as close to the beginning of the memory as possible and preserving their respective order; The memory model in this case is very simple. It is a sequence of m bytes, numbered for convenience from the first to the m-th.The first operation alloc n takes as the only parameter the size of the memory block that is to be allocated. While processing this operation, a free block of n successive bytes is being allocated in the memory. If the amount of such blocks is more than one, the block closest to the beginning of the memory (i.e. to the first byte) is prefered. All these bytes are marked as not free, and the memory manager returns a 32-bit integer numerical token that is the identifier of this block. If it is impossible to allocate a free block of this size, the function returns NULL.The second operation erase x takes as its parameter the identifier of some block. This operation frees the system memory, marking the bytes of this block as free for further use. In the case when this identifier does not point to the previously allocated block, which has not been erased yet, the function returns ILLEGAL_ERASE_ARGUMENT.The last operation defragment does not have any arguments and simply brings the occupied memory sections closer to the beginning of the memory without changing their respective order.In the current implementation you are to use successive integers, starting with 1, as identifiers. Each successful alloc operation procession should return following number. Unsuccessful alloc operations do not affect numeration.You are to write the implementation of the memory manager. You should output the returned value for each alloc command. You should also output ILLEGAL_ERASE_ARGUMENT for all the failed erase commands.

The first line of the input data contains two positive integers t and m (1 ≤ t ≤ 100;1 ≤ m ≤ 100), where t — the amount of operations given to the memory manager for processing, and m — the available memory size in bytes. Then there follow t lines where the operations themselves are given. The first operation is alloc n (1 ≤ n ≤ 100), where n is an integer. The second one is erase x, where x is an arbitrary 32-bit integer numerical token. The third operation is defragment.

Output the sequence of lines. Each line should contain either the result of alloc operation procession , or ILLEGAL_ERASE_ARGUMENT as a result of failed erase operation procession. Output lines should go in the same order in which the operations are processed. Successful procession of alloc operation should return integers, starting with 1, as the identifiers of the allocated blocks.

6 10
alloc 5
alloc 3
erase 1
alloc 6
defragment
alloc 6

import qualified Data.IntMap as IM
import qualified Data.List as L
import qualified Data.Maybe as May
import qualified Data.Tuple as Tup

main = do
    firstLine <- getLine
    let [numLines, memSize] = map read $ words firstLine
    procRequest numLines $ makeInitMem memSize

procRequest 0 _ = return ()
procRequest n memStruct = do
    request <- getLine
    let (maybeCode, newMemStruct) = request2Instr request memStruct
    maybePrint maybeCode
    procRequest (n - 1) newMemStruct

maybePrint (Just code) = print code
maybePrint Nothing = return ()

request2Instr :: String -> MemStruct -> (Maybe ReturnCode, MemStruct)
request2Instr req = case words req of
    ["alloc", bytes] -> Tup.swap . fmap Just . Tup.swap . allocate (read bytes)
    ["erase", id] -> erase (read id)
    ["defragment"] -> (,) Nothing . defragment

-- invariant: end - begin == size of the block
data Block = Block {begin :: Int,
                               end :: Int,
                               bid :: Maybe Int}
                    deriving (Show)
data MemStruct = MemStruct {id2loc :: IM.IntMap Int,
                               loc2alloc :: IM.IntMap Block,
                               loc2free :: IM.IntMap Block,
                               nextId :: Int,
                               size :: Int}
                               deriving (Show)

data ReturnCode = Id Int | NULL | ILLEGAL_ERASE_ARGUMENT
instance Show ReturnCode where
    show (Id n) = show n
    show NULL = "NULL"
    show ILLEGAL_ERASE_ARGUMENT = "ILLEGAL_ERASE_ARGUMENT"

makeInitMem memSize = MemStruct {id2loc = IM.empty,
                                 loc2alloc = IM.empty,
                                 loc2free = IM.singleton 0 (Block {begin = 0, end = memSize, bid = Nothing}),
                                 nextId = 1,
                                 size = memSize}

defragment :: MemStruct -> MemStruct
defragment memStruct = if IM.null $ loc2free memStruct
                       then memStruct
                       else MemStruct {id2loc = newIdAllocs,
                                       loc2alloc = newLocAllocs,
                                       loc2free = newFrees,
                                       nextId = nextId memStruct,
                                       size = size memStruct}
                        where add2Top (allocTop, currAllocs) (Block {begin = b, end = e, bid = sameBID}) =
                                    (allocTop + (e - b), IM.insert allocTop
                                                                   (Block {begin = allocTop, end = (e - b) + allocTop, bid = sameBID})
                                                                   currAllocs)
                              (finalTop, newLocAllocs) = IM.foldl add2Top (0, IM.empty) $ loc2alloc memStruct
                              newIdAllocs = IM.foldl' (\newIds (Block {begin = b, end = _, bid = Just bd}) -> IM.insert bd b newIds)
                                                      IM.empty newLocAllocs
                              newFrees = IM.singleton finalTop $ Block {begin = finalTop, end = size memStruct, bid = Nothing}

erase :: Int -> MemStruct -> (Maybe ReturnCode, MemStruct)
erase blkId memStruct = case IM.lookup blkId (id2loc memStruct) of
                             Nothing -> (Just ILLEGAL_ERASE_ARGUMENT, memStruct)
                             Just blkLoc -> let eraseBlk =  (loc2alloc memStruct) IM.! blkLoc
                                                newIds = IM.delete blkId (id2loc memStruct)
                                                newAllocs = IM.delete blkLoc (loc2alloc memStruct)
                                                newFrees = insertIntoFrees eraseBlk (loc2free memStruct)
                                            in  (Nothing, MemStruct {id2loc = newIds,
                                                                     loc2alloc = newAllocs,
                                                                     loc2free = newFrees,
                                                                     nextId = nextId memStruct,
                                                                     size = size memStruct})
                        where insertIntoFrees fr@(Block {begin = b,
                                                      end = e,
                                                      bid = _})
                                              frees = let toMergeBs = (May.maybeToList $
                                                                        (IM.lookupLT b frees) >>=
                                                                        return . snd >>=
                                                                        (\blk@(Block {begin = _, end = e', bid = _})
                                                                            -> if b == e'
                                                                               then Just blk
                                                                               else Nothing)) ++
                                                                        [fr] ++
                                                                        (May.maybeToList $ IM.lookup e frees)
                                                          newBlock = foldl1 mergeBlock toMergeBs
                                                          mergeBlock (Block {begin = b1, end = e1, bid =_})
                                                                     (Block {begin = b2, end = e2, bid = _}) =
                                                                        Block {begin = b1, end = e2, bid = Nothing}
                                                      in IM.insert (begin newBlock) newBlock $ foldl (flip $ IM.delete . begin) frees toMergeBs

allocate :: Int -> MemStruct -> (ReturnCode, MemStruct)
allocate bytes memStruct = case maybeBlock of
                                Nothing -> (NULL, memStruct)
                                Just Block {begin = bg,
                                      end = ed,
                                      bid = _} -> let allocBlock = Block {begin = bg,
                                                                        end = bytes + bg,
                                                                        bid = Just newId}
                                                      freesMinus1 = IM.delete bg $ loc2free memStruct
                                                      newFrees = if (bytes + bg < ed)
                                                               then IM.insert (bytes + bg) (Block {begin = bytes + bg,
                                                                                end = ed,
                                                                                bid = Nothing})
                                                                                freesMinus1
                                                               else freesMinus1
                                                      newId2locs = IM.insert newId bg $ id2loc memStruct
                                                      newLoc2allocs = IM.insert bg allocBlock $ loc2alloc memStruct
                                                      newId = nextId memStruct
                                                   in (Id newId, MemStruct {id2loc = newId2locs,
                                                                         loc2alloc = newLoc2allocs,
                                                                         loc2free = newFrees,
                                                                         nextId = newId + 1,
                                                                         size = size memStruct})
                           where maybeBlock = L.find (\blk -> (end blk - begin blk) >= bytes) $ IM.elems $ loc2free memStruct

import Array
import Char (toUpper)
import Monad (liftM)
import Prelude hiding (print)

data Query  =  Alloc Int | Erase Int | Defragment deriving Read
data Answer  =  Success Int | Null | IllegalErase | Empty deriving Show

solve :: Int -> [Query] -> [Answer]
solve m qs  =  solve' 1 (accumArray undefined 0 (1, m) []) qs
  where
    solve' _ _ []  =  []
    solve' n memory ((Alloc s) : qs)  =  case findEmptyMemory memory s of
        Just start  ->  Success n : solve' (n+1) (memory // (map (\i -> (i, n)) [start .. start + s - 1])) qs
        Nothing  ->  Null : solve' n memory qs
      where
        findEmptyMemory memory s  =  findEmptyMemory' 1 0
          where
            findEmptyMemory' k l
              | l == s  =  Just k
              | k + l > m  =  Nothing
              | memory ! (k+l) == 0  =  findEmptyMemory' k (l+1)
              | otherwise  =  findEmptyMemory' (k+l+1) 0
    solve' n memory ((Erase 0) : qs)  =  IllegalErase : solve' n memory qs
    solve' n memory ((Erase s) : qs)  =  case findMemory memory s of
        Just (start, length)  ->  Empty : solve' n (memory // (map (\i -> (i, 0)) [start .. start + length - 1])) qs
        Nothing  ->  IllegalErase : solve' n memory qs
      where
        findMemory memory s  =  findMemory' 1 0
          where
            findMemory' k l
              | k + l > m && l == 0  =  Nothing
              | k + l > m  =  Just (k, l)
              | memory ! (k+l) == s  =  findMemory' k (l+1)
              | memory ! (k+l) /= s && l == 0  =  findMemory' (k+1) 0
              | otherwise  =  Just (k, l)
    solve' n memory (Defragment : qs)  =  solve' n (defragment memory) qs
      where
        defragment memory  =  defragment' 1 1 memory
          where
            defragment' start current memory
              | current > m  =  memory // (map (\i -> (i, 0)) [start .. m])
              | memory ! current == 0  =  defragment' start (current + 1) memory
              | otherwise  =  defragment' (start + 1) (current + 1) (memory // [(start, memory ! current)])

parseQuery :: String -> Query
parseQuery (c:s)  =  read (toUpper c : s)

print :: Answer -> IO ()
print (Success n)   =  putStrLn (show n)
print Null          =  putStrLn "NULL"
print IllegalErase  =  putStrLn "ILLEGAL_ERASE_ARGUMENT"
print Empty         =  return ()

main :: IO ()
main  =  do
    [n, m]  <-  liftM (map read . words) getLine
    qs  <-  liftM (map parseQuery . take n . lines) getContents
    mapM_ print $ solve m qs

module Main where

import Data.Maybe (maybe)

main :: IO ()
main = interact $ unlines . solve . lines

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

solve :: [String] -> [String]
solve (meta:commands) = go commands (Mem 0 [Free (read m)])
  where
    [_, m] = words meta
    go [] _ = []
    go (c:cs) mem = case words c of
      ["defragment"] -> go cs (defragment mem)
      ["alloc", m] -> x:go cs nextMem where (x, nextMem) = alloc (read m) mem
      ["erase", m] -> maybe ("ILLEGAL_ERASE_ARGUMENT":go cs mem) (go cs) (erase (read m) mem)

data MemState = Free Int | Allocated Int Int deriving (Show)
data Mem = Mem Int [MemState] deriving (Show)

alloc :: Int -> Mem -> (String, Mem)
alloc x mem@(Mem m st) = case go x st of
    Just ms -> (show nextM, Mem nextM ms)
    Nothing -> ("NULL", mem)
  where
    nextM = m + 1
    go :: Int -> [MemState] -> Maybe [MemState]
    go _ [] = Nothing
    go x (Free c:xs) | c == x = Just $ Allocated nextM x:xs
    go x (Free c:xs) | c > x = Just $ Allocated nextM x:Free (c -x):xs
    go x (y:xs) = (y :) <$> go x xs

erase :: Int -> Mem -> Maybe Mem
erase x (Mem m st) = Mem m <$> go x st
  where
    go _ [] = Nothing
    go x (Allocated y c:Free d:xs) | x == y = Just $ Free (c + d):xs
    go x (Allocated y c:xs) | x == y = Just $ Free c:xs
    go x (y:xs) = (y :) <$> go x xs

defragment :: Mem -> Mem
defragment (Mem m st) = Mem m (go st 0)
  where
    go [] 0 = []
    go [] acc = [Free acc]
    go (Free a:xs) acc = go xs (acc + a)
    go (a:xs) acc = a:go xs acc

import Data.Map (Map)
import qualified Data.Map as M
import Data.List
import Data.Ord

type State = (Int , Map Int (Int, Int))

alloc :: Int -> State -> Int -> (State, [String])
alloc m (nextId, mem) n = res where
  go :: Int -> [(Int, Int)] -> Int
  go i ((st, l):t) | i + n <= st = i
   | otherwise = go (st+l) t
  go i [] = i

  went = go 1 (sort $ map snd $ M.toList mem)

  res | went + n > m+1 = ((nextId, mem) , ["NULL"])
    | otherwise = ((nextId + 1, M.insert nextId (went, n) mem), [show nextId])

defrag m (i, mem) = (i, M.fromList $ go 1 $ sortBy (comparing (fst.snd)) $ M.toList mem) where
  go i ((id, (from, len)):t) = (id, (i, len)):go (i+len) t
  go _ [] = []

step :: Int -> State -> [String] -> (State, [String])
step m state ["defragment"] = (defrag m state, [])
step m state ["alloc", n] = alloc m state (read n)
step m (i, mem) ["erase", x] | M.member (read x) mem = ((i, M.delete (read x) mem), [])
  | otherwise = ((i, mem), ["ILLEGAL_ERASE_ARGUMENT"])

initial = (1, M.empty)

s :: [[String]] -> [String]
s([_,m]:cmds)=concat$snd$mapAccumL (step (read m)) initial cmds

main=interact$unlines.s.map words.lines

{-
    Not in scope: `Data.Map.erase'
    Perhaps you meant one of these:
      `Data.Map.map' (imported from Data.Map),
      `Data.Map.delete' (imported from Data.Map),
      `Data.Map.elems' (imported from Data.Map)-}

module Main where

import Data.Maybe (maybe)

main :: IO ()
main = interact $ unlines . solve . lines

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

solve :: [String] -> [String]
solve (meta:commands) = go commands (Mem 0 [Free (read m)])
  where
    [_, m] = words meta
    go [] _ = []
    go (c:cs) mem = case words c of
      ["defragment"] -> go cs (defragment mem)
      ["alloc", m] -> x:go cs nextMem where (x, nextMem) = alloc (read m) mem
      ["erase", m] -> maybe ("ILLEGAL_ERASE_ARGUMENT":go cs mem) (go cs) (erase (read m) mem)

data MemState = Free Int | Allocated Int Int deriving (Show)
data Mem = Mem Int [MemState] deriving (Show)

alloc :: Int -> Mem -> (String, Mem)
alloc x mem@(Mem m st) = case go x st of
    Just ms -> (show nextM, Mem nextM ms)
    Nothing -> ("NULL", mem)
  where
    nextM = m + 1
    go :: Int -> [MemState] -> Maybe [MemState]
    go _ [] = Nothing
    go x (Free c:xs) | c == x = Just $ Allocated nextM x:xs
    go x (Free c:xs) | c > x = Just $ Allocated nextM x:Free (c -x):xs
    go x (y:xs) = (y :) <$> go x xs

erase :: Int -> Mem -> Maybe Mem
erase x (Mem m st) = Mem m <$> go x st
  where
    go _ [] = Nothing
    go x (Allocated y c:Free d:xs) | x == y = Just $ Free (c + d): xs
    go x (Allocated y c:xs) | x == y = Just $ Free c: xs
    go x (_:xs) = go x xs

defragment :: Mem -> Mem
defragment (Mem m st) = Mem m (go st 0)
  where
    go [] 0 = []
    go [] acc = [Free acc]
    go (Free a:xs) acc = go xs (acc + a)
    go (a:xs) acc = a:go xs acc

import Data.Map (Map)
import qualified Data.Map as M
import Data.List
import Data.Ord

type State = (Int , Map Int (Int, Int))

alloc :: Int -> State -> Int -> (State, [String])
alloc m (nextId, mem) n = res where
  go :: Int -> [(Int, Int)] -> Int
  go i ((st, l):t) | i + n <= st = i
   | otherwise = go (st+l) t
  go i [] = i

  went = go 1 (sort $ map snd $ M.toList mem)

  res | went + n > m = ((nextId, mem) , ["NULL"])
    | otherwise = ((nextId + 1, M.insert nextId (went, n) mem), [show nextId])

defrag m (i, mem) = (i, M.fromList $ go 1 $ sortBy (comparing (fst.snd)) $ M.toList mem) where
  go i ((id, (from, len)):t) = (id, (i, len)):go (i+len) t
  go _ [] = []

step :: Int -> State -> [String] -> (State, [String])
step m state ["defragment"] = (defrag m state, [])
step m state ["alloc", n] = alloc m state (read n)
step m (i, mem) ["erase", x] | M.member (read x) mem = ((i, M.delete (read x) mem), [])
  | otherwise = ((i, mem), ["ILLEGAL_ERASE_ARGUMENT"])

initial = (1, M.empty)

s :: [[String]] -> [String]
s([_,m]:cmds)=concat$snd$mapAccumL (step (read m)) initial cmds

main=interact$unlines.s.map words.lines

{-
    Not in scope: `Data.Map.erase'
    Perhaps you meant one of these:
      `Data.Map.map' (imported from Data.Map),
      `Data.Map.delete' (imported from Data.Map),
      `Data.Map.elems' (imported from Data.Map)-}


You are given a multiset (i. e. a set that can contain multiple equal integers) containing $$$2n$$$ integers. Determine if you can split it into exactly $$$n$$$ pairs (i. e. each element should be in exactly one pair) so that the sum of the two elements in each pair is odd (i. e. when divided by $$$2$$$, the remainder is $$$1$$$).

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1\leq t\leq 100$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1\leq n\leq 100$$$). The second line of each test case contains $$$2n$$$ integers $$$a_1,a_2,\dots, a_{2n}$$$ ($$$0\leq a_i\leq 100$$$) — the numbers in the set.

For each test case, print "Yes" if it can be split into exactly $$$n$$$ pairs so that the sum of the two elements in each pair is odd, and "No" otherwise. You can print each letter in any case.

NoteIn the first test case, a possible way of splitting the set is $$$(2,3)$$$, $$$(4,5)$$$.In the second, third and fifth test case, we can prove that there isn't any possible way.In the fourth test case, a possible way of splitting the set is $$$(2,3)$$$.

module Main where

import Data.List
import Control.Monad

solve :: [Int] -> String
solve lst
    | e == o = "Yes"
    | otherwise = "No"
    where
        e = length (filter even lst)
        o = length (filter odd lst)

readTestcase :: IO [Int]
readTestcase =
    getLine >> getLine >>= \l ->
        return $ map read (words l)

main :: IO ()
main = getLine >>= \nstr ->
    let n = read nstr in
        replicateM n readTestcase >>= \tests ->
        putStrLn (unlines $ map solve tests)

module Main where

import Data.List
import Control.Monad

splitPar :: [Int] -> ([Int], [Int])
splitPar lst = (filter even lst, filter odd lst)

solve :: [Int] -> String
solve lst
    | length e == length o = "Yes"
    | otherwise = "No"
    where (e, o) = splitPar lst

readTestcase :: IO [Int]
readTestcase =
    getLine >> getLine >>= \l ->
        return $ map read (words l)

main :: IO ()
main = getLine >>= \nstr ->
    let n = read nstr in
        replicateM n readTestcase >>= \tests ->
        putStrLn (unlines $ map solve tests)

--{-# OPTIONS_GHC -O2 #-}

import Control.Monad
--import Prelude as P
--import Data.Char as C
--import Data.List as L
--import Data.IntSet as S

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  sxs <- getLine
  let xs = map read $ words sxs :: [Int]
      odds = length $ filter odd xs in
    putStrLn (if odds == n then "Yes" else "No")

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t solve

{-# LANGUAGE BangPatterns #-}
import Data.Bool
import Control.Monad

countOddEven = foldl (\(o, e) a -> if odd a then (o + 1, e) else (o, e + 1))
               (0, 0)

solve lst = bool "NO" "YES" $ odd == even
  where
    !counter = countOddEven lst
    !odd = fst counter
    !even = snd counter

readInt :: String -> Int
readInt = read

main = do
  n <- readInt <$> getLine
  replicateM_ n $ do
    _ <- getLine
    lst <- map readInt . words <$> getLine
    putStrLn $ solve lst

import Control.Monad (replicateM_)

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

canPartition :: [Int] -> Bool
canPartition xs = numEven == numOdd where
  numEven = length $ filter even xs
  numOdd = length $ filter odd xs

solve :: IO ()
solve = do
  n <- getLine
  ans <- canPartition <$> readInts
  putStrLn (if ans then "YES" else "NO")

main :: IO ()
main = do
  t <- readLn
  replicateM_ t solve

import Control.Monad

oddSets :: [Int]-> Bool

oddSets xs = (length xs) == 2*(length [x | x <- xs, (x `mod` 2) == 0])

it = do
	n_s <- getLine
	ln_s <-getLine

	let ans = oddSets(fmap read (words ln_s))
	let ans_s = if ans == True
		then "Yes"
		else "No"

	putStrLn ans_s

main = do
	n_s <- getLine
	let n = read n_s :: Int
	let prog = take n (repeat it)
	sequence prog
	return ()

import Control.Arrow ((>>>))
import Data.Bool (bool)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

main :: IO ()
main = interact $
  lines
    >>> drop 1
    >>> map (words >>> map read)
    >>> chunksOf 2
    >>> map (solve >>> bool "No" "Yes")
    >>> unlines

solve :: [[Int]] -> Bool
solve [[n], xs] = length (filter odd xs) == n

import qualified Data.Set as Set
import Data.List
import Control.Monad

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

printS = do
    n <- readLn::IO Int
    a<-readInts
    let o = sum[1|x<-a,mod x 2 == 1]
    putStrLn $ if (o == n) then "Yes" else "No"

main = do
    t<-readLn
    replicateM_ t printS

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

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let ce = length $ filter even a
    putStrLn $ if ce == n then "Yes" else "No"

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


Amr bought a new video game "Guess Your Way Out! II". The goal of the game is to find an exit from the maze that looks like a perfect binary tree of height h. The player is initially standing at the root of the tree and the exit from the tree is located at some leaf node.Let's index all the nodes of the tree such that   The root is number 1  Each internal node i (i ≤ 2h - 1 - 1) will have a left child with index = 2i and a right child with index = 2i + 1 The level of a node is defined as 1 for a root, or 1 + level of parent of the node otherwise. The vertices of the level h are called leaves. The exit to the maze is located at some leaf node n, the player doesn't know where the exit is so he has to guess his way out! In the new version of the game the player is allowed to ask questions on the format "Does the ancestor(exit, i) node number belong to the range [L, R]?". Here ancestor(v, i) is the ancestor of a node v that located in the level i. The game will answer with "Yes" or "No" only. The game is designed such that it doesn't always answer correctly, and sometimes it cheats to confuse the player!.Amr asked a lot of questions and got confused by all these answers, so he asked you to help him. Given the questions and its answers, can you identify whether the game is telling contradictory information or not? If the information is not contradictory and the exit node can be determined uniquely, output its number. If the information is not contradictory, but the exit node isn't defined uniquely, output that the number of questions is not sufficient. Otherwise output that the information is contradictory.

The first line contains two integers h, q (1 ≤ h ≤ 50, 0 ≤ q ≤ 105), the height of the tree and the number of questions respectively. The next q lines will contain four integers each i, L, R, ans (1 ≤ i ≤ h, 2i - 1 ≤ L ≤ R ≤ 2i - 1, ), representing a question as described in the statement with its answer (ans = 1 if the answer is "Yes" and ans = 0 if the answer is "No").

If the information provided by the game is contradictory output "Game cheated!" without the quotes. Else if you can uniquely identify the exit to the maze output its index.  Otherwise output "Data not sufficient!" without the quotes.

NoteNode u is an ancestor of node v if and only if   u is the same node as v,  u is the parent of node v,  or u is an ancestor of the parent of node v. In the first sample test there are 4 leaf nodes 4, 5, 6, 7. The first question says that the node isn't in the range [4, 6] so the exit is node number 7.In the second sample test there are 8 leaf nodes. After the first question the exit is in the range [10, 14]. After the second and the third questions only node number 14 is correct. Check the picture below to fully understand.

module Main where

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

import Data.Int
import Data.Bits

parse :: BS.ByteString -> [Int64]
parse = map (fromInteger . fst . fromJust . BS.readInteger) . BS.words

shl :: (Integral s, Bits a) => a -> s -> a
shl a s = shiftL a $ fromIntegral s

type State = ([(Int64, Int64)], Int64, Int)

go :: State -> (Int64, Bool) -> State
go (xs, l, n) (x, True) = (xs, x+1, n-1)
go (xs, l, 0) (x, False) = ((l, x-1):xs, l, 1)
go (xs, l, n) (x, False) = (xs, l, n + 1)

isect :: Ord a => (a,a) -> (a,a) -> (a,a)
isect (l1, r1) (l2, r2) = (max l1 l2, min r1 r2)

main = do
  line1 <- BS.getLine
  let [h, q] = parse line1
  text <- BS.getContents
  let queries = map parse $ BS.lines text
      normal = map (\[i,l,r,ans] -> (l `shl` (h - i), (r + 1) `shl` (h - i) - 1, ans)) queries
      (yeses, nos) = partition (\(_,_,ans) -> ans == 1) normal
      defaultYes = ((1 `shl` (h - 1) :: Int64), (1 `shl` h - 1 :: Int64), 1)
      l = (\(x,_,_) -> x) $ maximumBy (\(x,_,_) (y,_,_) -> compare x y) (defaultYes : yeses)
      r = (\(_,y,_) -> y) $ minimumBy (\(_,x,_) (_,y,_) -> compare x y) (defaultYes : yeses)
      (xs,_,_) = foldl' go ([], (1 `shl` (h-1) :: Int64), 0) $ sort $ (r+1,False):concatMap (\(l,r,ans) -> [(l, False), (r, True)]) nos
      xs' = filter (\(x,y) -> x <= y) $ map (isect (l,r)) xs
  --print (l,r)
  --print xs
  --print xs'
  if null xs' then putStrLn "Game cheated!" else
    if length xs' > 1 || (uncurry (/=) (head xs')) then putStrLn "Data not sufficient!"
      else putStrLn $ show (fst $ head xs')

  return ()

module Main where

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

import Data.Int
import Data.Bits

parse :: BS.ByteString -> [Int64]
parse = map (fromInteger . fst . fromJust . BS.readInteger) . BS.words

shl :: (Integral s, Bits a) => a -> s -> a
shl a s = shiftL a $ fromIntegral s

type State = ([(Int64, Int64)], Int64, Int)

go :: State -> (Int64, Bool) -> State
go (xs, l, n) (x, True) = (xs, x+1, n-1)
go (xs, l, 0) (x, False) = ((l, x-1):xs, l, 1)
go (xs, l, n) (x, False) = (xs, l, n + 1)

isect :: Ord a => (a,a) -> (a,a) -> (a,a)
isect (l1, r1) (l2, r2) = (max l1 l2, min r1 r2)

main = do
  line1 <- BS.getLine
  let [h, q] = parse line1
  text <- BS.getContents
  let queries = map parse $ BS.lines text
      normal = map (\[i,l,r,ans] -> (l `shl` (h - i), (r + 1) `shl` (h - i) - 1, ans)) queries
      (yeses, nos) = partition (\(_,_,ans) -> ans == 1) normal
      defaultYes = ((1 `shl` (h - 1) :: Int64), (1 `shl` h - 1 :: Int64), 1)
      l = (\(x,_,_) -> x) $ maximumBy (\(x,_,_) (y,_,_) -> compare x y) (defaultYes : yeses)
      r = (\(_,y,_) -> y) $ minimumBy (\(_,x,_) (_,y,_) -> compare x y) (defaultYes : yeses)
      (xs,_,_) = foldl' go ([], (1 `shl` (h-1) :: Int64), 0) $ sort $ (r+1,False):concatMap (\(l,r,ans) -> [(l, False), (r, True)]) nos
      xs' = filter (\(x,y) -> x <= y) $ map (isect (l,r)) xs
  --print (l,r)
  --print xs
  --print xs'
  if null xs' then putStrLn "Game cheated!" else
    if length xs' > 1 || (uncurry (/=) (head xs')) then putStrLn "Data not sufficient"
      else putStrLn $ show (fst $ head xs')

  return ()


You are given strings $$$S$$$ and $$$T$$$, consisting of lowercase English letters. It is guaranteed that $$$T$$$ is a permutation of the string abc. Find string $$$S'$$$, the lexicographically smallest permutation of $$$S$$$ such that $$$T$$$ is not a subsequence of $$$S'$$$.String $$$a$$$ is a permutation of string $$$b$$$ if the number of occurrences of each distinct character is the same in both strings.A string $$$a$$$ is a subsequence of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) elements.A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ if and only if one of the following holds: $$$a$$$ is a prefix of $$$b$$$, but $$$a \ne b$$$; in the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$b$$$.

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains a string $$$S$$$ ($$$1 \le |S| \le 100$$$), consisting of lowercase English letters. The second line of each test case contains a string $$$T$$$ that is a permutation of the string abc. (Hence, $$$|T| = 3$$$). Note that there is no limit on the sum of $$$|S|$$$ across all test cases.

For each test case, output a single string $$$S'$$$, the lexicographically smallest permutation of $$$S$$$ such that $$$T$$$ is not a subsequence of $$$S'$$$.

7
abacaba
abc
cccba
acb
dbsic
bac
abracadabra
abc
dddddddddddd
cba
bbc
abc
ac
abc

aaaacbb
abccc
bcdis
aaaaacbbdrr
dddddddddddd
bbc
ac

NoteIn the first test case, both aaaabbc and aaaabcb are lexicographically smaller than aaaacbb, but they contain abc as a subsequence.In the second test case, abccc is the smallest permutation of cccba and does not contain acb as a subsequence.In the third test case, bcdis is the smallest permutation of dbsic and does not contain bac as a subsequence.

-- https://codeforces.com/contest/1617/problem/A
import Data.List

count char string = length $ filter (== char) string
getCountAbc str = [count 'a' str, count 'b' str, count 'c' str]
excludeAbc = filter (`notElem` "abc")
duplicate char 0 = ""
duplicate char n = char : duplicate char (n-1)
abcAnswer perm countAbc =
    duplicate 'a' (countAbc!!0) ++
    if perm /= "abc" || countAbc!!0 == 0 then
        duplicate 'b' (countAbc!!1) ++
        duplicate 'c' (countAbc!!2)
    else
        duplicate 'c' (countAbc!!2) ++
        duplicate 'b' (countAbc!!1)

run 0 = return 0
run n = do
    s <- getLine
    perm <- getLine
    putStrLn $ abcAnswer perm (getCountAbc s) ++ sort (excludeAbc s)
    run $ n-1
main = getLine >>= run . read

import Data.Ord
import Data.List

main :: IO ()
main = interact solve

solve :: String -> String
solve = unlines . map f . readInput . tail . lines
  where
    readInput [] = []
    readInput (s:t:ts) = (s,t) : readInput ts

f :: (String, String) -> String
f (s, t)
  | no as || no bs || no cs || t /= "abc" = sort s
  | otherwise = sortBy (comparing g) s
  where
    no = not . flip any s
    as = (== 'a')
    bs = (== 'b')
    cs = (== 'c')

g :: Char -> Char
g 'c' = 'b'
g 'b' = 'c'
g chr = chr

-- https://codeforces.com/contest/1617/problem/A
import Data.List

count char string = length $ filter (== char) string
getCountAbc str = [count 'a' str, count 'b' str, count 'c' str]
excludeAbc = filter (`notElem` "abc")
duplicate char 0 = ""
duplicate char n = char : duplicate char (n-1)
abcAnswer perm countAbc =
    duplicate (perm!!0) (countAbc!!0) ++
    if perm /= "abc" || countAbc!!0 == 0 then
        duplicate 'b' (countAbc!!1) ++
        duplicate 'c' (countAbc!!2)
    else
        duplicate 'c' (countAbc!!2) ++
        duplicate 'b' (countAbc!!1)

run 0 = return 0
run n = do
    s <- getLine
    perm <- getLine
    putStrLn $ abcAnswer perm (getCountAbc s) ++ sort (excludeAbc s)
    run $ n-1
main = getLine >>= run . read


Let $$$\mathsf{AND}$$$ denote the bitwise AND operation, and $$$\mathsf{OR}$$$ denote the bitwise OR operation.You are given an array $$$a$$$ of length $$$n$$$ and a non-negative integer $$$k$$$. You can perform at most $$$k$$$ operations on the array of the following type:  Select an index $$$i$$$ ($$$1 \leq i \leq n$$$) and replace $$$a_i$$$ with $$$a_i$$$ $$$\mathsf{OR}$$$ $$$2^j$$$ where $$$j$$$ is any integer between $$$0$$$ and $$$30$$$ inclusive. In other words, in an operation you can choose an index $$$i$$$ ($$$1 \leq i \leq n$$$) and set the $$$j$$$-th bit of $$$a_i$$$ to $$$1$$$ ($$$0 \leq j \leq 30$$$). Output the maximum possible value of $$$a_1$$$ $$$\mathsf{AND}$$$ $$$a_2$$$ $$$\mathsf{AND}$$$ $$$\dots$$$ $$$\mathsf{AND}$$$ $$$a_n$$$ after performing at most $$$k$$$ operations.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains the integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$0 \le k \le 10^9$$$). Then a single line follows, containing $$$n$$$ integers describing the arrays $$$a$$$ ($$$0 \leq a_i < 2^{31}$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a single line containing the maximum possible $$$\mathsf{AND}$$$ value of $$$a_1$$$ $$$\mathsf{AND}$$$ $$$a_2$$$ $$$\mathsf{AND}$$$ $$$\dots$$$ $$$\mathsf{AND}$$$ $$$a_n$$$ after performing at most $$$k$$$ operations.

NoteFor the first test case, we can set the bit $$$1$$$ ($$$2^1$$$) of the last $$$2$$$ elements using the $$$2$$$ operations, thus obtaining the array [$$$2$$$, $$$3$$$, $$$3$$$], which has $$$\mathsf{AND}$$$ value equal to $$$2$$$.For the second test case, we can't perform any operations so the answer is just the $$$\mathsf{AND}$$$ of the whole array which is $$$4$$$.

import Data.List
import Data.Bits

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

zeroArr :: Int -> [Int]
zeroArr 0 = []
zeroArr i = (0: (zeroArr $ i -1))

calcBit :: [Int] -> Int -> Int
calcBit [] _ = 0
calcBit (x: xs) i = calcBit xs i + if x .&. (shift 1 i) == 0
  then 0
  else 1

parse :: [Int] -> [Int]
parse arr = ((calcBit arr 0): (calcBit arr 1): (calcBit arr 2): (calcBit arr 3): (calcBit arr 4): (calcBit arr 5): (calcBit arr 6): (calcBit arr 7): (calcBit arr 8): (calcBit arr 9): (calcBit arr 10): (calcBit arr 11): (calcBit arr 12): (calcBit arr 13): (calcBit arr 14): (calcBit arr 15): (calcBit arr 16): (calcBit arr 17): (calcBit arr 18): (calcBit arr 19): (calcBit arr 20): (calcBit arr 21): (calcBit arr 22): (calcBit arr 23): (calcBit arr 24): (calcBit arr 25): (calcBit arr 26): (calcBit arr 27): (calcBit arr 28): (calcBit arr 29): (calcBit arr 30): [])

calc :: [Int] -> Int -> Int -> Int -> Int
calc arr (-1) _ _ = 0
calc arr i c n = if n - (arr !! i) <= c
  then (shift 1 i) + calc arr (i - 1) (c - n + (arr !! i)) n
  else calc arr (i - 1) c n

solve :: IO ()
solve = do
  (n: k: _) <- readIntArr
  arr <- readIntArr
  print $ calc (parse arr) 30 k n

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