Everyone knows that 2010 FIFA World Cup is being held in South Africa now. By the decision of BFA (Berland's Football Association) next World Cup will be held in Berland. BFA took the decision to change some World Cup regulations:  the final tournament features n teams (n is always even)  the first n / 2 teams (according to the standings) come through to the knockout stage  the standings are made on the following principle: for a victory a team gets 3 points, for a draw — 1 point, for a defeat — 0 points. In the first place, teams are ordered in the standings in decreasing order of their points; in the second place — in decreasing order of the difference between scored and missed goals; in the third place — in the decreasing order of scored goals  it's written in Berland's Constitution that the previous regulation helps to order the teams without ambiguity. You are asked to write a program that, by the given list of the competing teams and the results of all the matches, will find the list of teams that managed to get through to the knockout stage.

The first input line contains the only integer n (1 ≤ n ≤ 50) — amount of the teams, taking part in the final tournament of World Cup. The following n lines contain the names of these teams, a name is a string of lower-case and upper-case Latin letters, its length doesn't exceed 30 characters. The following n·(n - 1) / 2 lines describe the held matches in the format name1-name2 num1:num2, where name1, name2 — names of the teams; num1, num2 (0 ≤ num1, num2 ≤ 100) — amount of the goals, scored by the corresponding teams. Accuracy of the descriptions is guaranteed: there are no two team names coinciding accurate to the letters' case; there is no match, where a team plays with itself; each match is met in the descriptions only once.

Output n / 2 lines — names of the teams, which managed to get through to the knockout stage in lexicographical order. Output each name in a separate line. No odd characters (including spaces) are allowed. It's guaranteed that the described regulations help to order the teams without ambiguity.

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

main = do
  n <- readLn :: IO Int
  names <- replicateM n getLine
  matchResult <- replicateM (n*(n-1)`div`2) getLine
  let mr = concatMap readMatchResult matchResult
      mr1 = sortBy (comparing (fst.fst)) mr
      mr2 = groupBy (on (==) (fst.fst)) mr1
      mr3 = map toScore mr2
      mr4 = reverse $ sortBy cmp mr3
  --mapM_ print mr2
  --mapM_ print mr3
  mapM_ putStrLn . sort . map fst4 $ take (n`div`2) mr4
  where
    fst4 (x,_,_,_) = x
    rev ((a,b),(c,d)) = ((b,a),(d,c))
    split c [] = []
    split c cs = let (a,b) = span (c/=) cs
                     tail' [] = []
                     tail' (a:as) = as
                 in a : split c (tail' b)
    readMatchResult :: String -> [((String,String),(Int,Int))]
    readMatchResult cs = let (ts:ss:[]) = words cs
                             (t1:t2:[]) = split '-' ts
                             (s1:s2:[]) = map read $ split ':' ss
                             res = ((t1,t2),(s1,s2))
                         in [res,rev res]
    toScore :: [((String,String),(Int,Int))] -> (String,Int,Int,Int)
    toScore cs = let (x,y,z) = f (0,0,0) cs
                     name = fst.fst.head$cs
                 in (name,x,y,z)
      where
        f x [] = x
        f (x,y,z) ((_,(s,m)):as)
          | s>m = f (x+3,y+s-m,z+s) as
          | s==m = f (x+1,y+s-m,z+s) as
          | s<m = f (x,y+s-m,z+s) as
    cmp :: (String,Int,Int,Int) -> (String,Int,Int,Int) -> Ordering
    cmp (_,x1,y1,z1) (_,x2,y2,z2)
      | x1 /= x2 = compare x1 x2
      | y1 /= y2 = compare y1 y2
      | z1 /= z2 = compare z1 z2

 import Data.List

 parse :: String -> (String, String, Int, Int)
 parse s = let s0 = s; a = takeWhile (/='-') s0 in
                let s1 = drop (length a + 1) s0; b = takeWhile (/=' ') s1 in
                    let s2 = drop (length b + 1) s1; c = takeWhile (/=':') s2 in
                        let s3 = drop (length c + 1) s2; d = s3 in
                            (a, b, read c, read d)

 table :: [String] -> [(String, String, Int, Int)] -> [String]
 table teams results = snd $ unzip $ sort $ zip scores teams
    where scores = map (score results) teams
            where score results team = (sum [sc result | result <- resultsOfThisTeam],
                                    sum [c - d | (_, _, c, d) <- resultsOfThisTeam],
                                    sum [c | (_, _, c, _) <- resultsOfThisTeam])
                    where sc (a, b, c, d) = case compare c d of GT -> 3
                                                                EQ -> 1
                                                                LT -> 0
                          resultsOfThisTeam = [result | result@(a, _, _, _) <- results, a == team]

 solve :: Int -> [String] -> [String] -> [String]
 solve n teams matches = sort $ drop (n `div` 2) (table teams results)
    where singleResults = map parse matches
          results = singleResults ++ map (\(a, b, c, d) -> (b, a, d, c)) singleResults

 main = do
    contents <- getContents
    let n = read $ head $ lines contents
    let teams = take n $ drop 1 $ lines contents
    let matches = take (n * (n - 1) `div` 2) $ drop (n + 1) $ lines contents
    mapM putStrLn (solve n teams matches)

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

fst3 (a, b, c) = a
snd3 (a, b, c) = b
trd3 (a, b, c) = c
frt4 (a, b, c, d) = d

toMatch ss =
    let (t1, '-':ss2) = break (== '-') ss
        (t2, ' ':ss3) = break (== ' ') ss2
        [(n1, ':':ss4)] = reads ss3
        n2 = read ss4
    in  (t1, t2, n1, n2)

main = do
  n <- readLn
  ns <- replicateM n getLine
  ms <- replicateM (n*(n-1)`div`2) $ toMatch <$> getLine
  let ms' = reverse $ sort [ accum (catMaybes [ conv name match | match <- ms ]) | name <- ns]
  mapM_ putStrLn $ sort $ map frt4 $ take (n `div` 2) ms'
    where
      conv name (t1, t2, n1, n2)
          | t1 == name = Just (name, n1, n2)
          | t2 == name = Just (name, n2, n1)
          | otherwise = Nothing
      accum :: [(String, Int, Int)] -> (Int, Int, Int, String)
      accum ls =
          let sco = sum $ map snd3 ls
              mis = sum $ map trd3 ls
              p = sum $ zipWith point (map snd3 ls) (map trd3 ls)
              name = fst3 $ head ls
          in  (p, sco-mis, sco, name)
      point n1 n2 | n1 < n2 = 0
                  | n1 > n2 = 3
                  | otherwise = 1

import Text.ParserCombinators.Parsec
import Data.Map.Strict hiding (foldl)
import Data.Function( on)
import Data.List( sortBy, intercalate, sort)
import Control.Applicative( (<$>))

main = do
    winScores <- return . (parse parser "(stdin)") =<< getContents
    case winScores  of
	Left _	    -> fail "Parsing failed."
	Right ws    -> do
	    let performance = foldl proc empty $ concat ws
		  where proc mp (team,po) = insertWith plus team po mp
			plus (w1,d1,g1) (w2,d2,g2) = (w1+w2,d1+d2,g1+g2)
		r = toList performance
		winner = take half $ sortBy (descOrder `on` snd) r
		  where
		    half = length r `div` 2
		    descOrder = flip compare
	    putStr $ intercalate "\n" . sort $ fst <$> winner

parser = do
    sz <- szTeams
    spaces
    count sz name
    let szRecords = sz*(sz-1)`div`2
    count szRecords matchRecord

szTeams = many1 digit >>= return . read

name = do
    v <- many1 letter
    spaces
    return v

matchRecord = do
    (t1, t2) <- card
    spaces
    (s1, s2) <- score
    spaces
    return $ if s1>s2
	then [(t1,(3::Int,s1-s2,s1)),(t2,(0,s2-s1,s2))]
	else if s1<s2
		then [(t1,(0,s1-s2,s1)),(t2,(3,s2-s1,s2))]
		else [(t1,(1,0,s1)),(t2,(1,0,s2))]
card = do
    team1 <- name
    char '-'
    team2 <- name
    return (team1, team2)

score = do
    score1 <- many1 digit
    char ':'
    score2 <- many1 digit
    return (read score1, read score2)

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

main = do
  n <- readLn :: IO Int
  names <- replicateM n getLine
  matchResult <- replicateM (n*(n-1)`div`2) getLine
  let mr = concatMap readMatchResult matchResult
      mr1 = sortBy (comparing (fst.fst)) mr
      mr2 = groupBy (on (==) (fst.fst)) mr1
      mr3 = map toScore mr2
      mr4 = reverse $ sortBy cmp mr3
  mapM_ print mr2
  mapM_ print mr3
  mapM_ putStrLn . sort . map fst4 $ take (n`div`2) mr4
  where
    fst4 (x,_,_,_) = x
    rev ((a,b),(c,d)) = ((b,a),(d,c))
    split c [] = []
    split c cs = let (a,b) = span (c/=) cs
                     tail' [] = []
                     tail' (a:as) = as
                 in a : split c (tail' b)
    readMatchResult :: String -> [((String,String),(Int,Int))]
    readMatchResult cs = let (ts:ss:[]) = words cs
                             (t1:t2:[]) = split '-' ts
                             (s1:s2:[]) = map read $ split ':' ss
                             res = ((t1,t2),(s1,s2))
                         in [res,rev res]
    toScore :: [((String,String),(Int,Int))] -> (String,Int,Int,Int)
    toScore cs = let (x,y,z) = f (0,0,0) cs
                     name = fst.fst.head$cs
                 in (name,x,y,z)
      where
        f x [] = x
        f (x,y,z) ((_,(s,m)):as)
          | s>m = f (x+3,y+s-m,z+s) as
          | s==m = f (x+1,y+s-m,z+s) as
          | s<m = f (x,y+s-m,z+s) as
    cmp :: (String,Int,Int,Int) -> (String,Int,Int,Int) -> Ordering
    cmp (_,x1,y1,z1) (_,x2,y2,z2)
      | x1 /= x2 = compare x1 x2
      | y1 /= y2 = compare y1 y2
      | z1 /= z2 = compare z1 z2

 import Data.List

 parse :: String -> (String, String, Int, Int)
 parse s = let s0 = s; a = takeWhile (/='-') s0 in
                let s1 = drop (length a + 1) s0; b = takeWhile (/=' ') s1 in
                    let s2 = drop (length b + 1) s1; c = takeWhile (/=':') s2 in
                        let s3 = drop (length c + 1) s2; d = s3 in
                            (a, b, read c, read d)

 table :: [String] -> [(String, String, Int, Int)] -> [String]
 table teams results = snd $ unzip $ sort $ zip scores teams
    where scores = map (score results) teams
            where score results team = (sum [sc result | result <- resultsOfThisTeam],
                                    sum [c - d | (_, _, c, d) <- resultsOfThisTeam],
                                    sum [c | (_, _, c, _) <- resultsOfThisTeam])
                    where sc (a, b, c, d) = case compare c d of GT -> 3
                                                                EQ -> 1
                                                                LT -> 0
                          resultsOfThisTeam = [result | result@(a, _, _, _) <- results, a == team]

 solve :: Int -> [String] -> [String] -> [String]
 solve n teams matches = drop (n `div` 2) (table teams results)
    where singleResults = map parse matches
          results = singleResults ++ map (\(a, b, c, d) -> (b, a, d, c)) singleResults

 main = do
    contents <- getContents
    let n = read $ head $ lines contents
    let teams = take n $ drop 1 $ lines contents
    let matches = take (n * (n - 1) `div` 2) $ drop (n + 1) $ lines contents
    mapM putStrLn (solve n teams matches)


The Trinitarian kingdom has exactly n = 3k cities. All of them are located on the shores of river Trissisipi, which flows through the whole kingdom. Some of the cities are located on one side of the river, and all the rest are on the other side.Some cities are connected by bridges built between them. Each bridge connects two cities that are located on the opposite sides of the river. Between any two cities exists no more than one bridge.The recently inaugurated King Tristan the Third is busy distributing his deputies among cities. In total there are k deputies and the king wants to commission each of them to control exactly three cities. However, no deputy can be entrusted to manage the cities, which are connected by a bridge — the deputy can set a too high fee for travelling over the bridge to benefit his pocket, which is bad for the reputation of the king.Help King Tristan the Third distribute the deputies between the cities, if it is possible.

The first line contains two integers n and m — the number of cities and bridges (3 ≤ n < 105, n = 3k, 0 ≤ m ≤ 105). Next m lines describe the bridges. The i-th line contains two integers ai and bi — the numbers of cities that are connected by the i-th bridge (1 ≤ ai, bi ≤ n, ai ≠ bi, 1 ≤ i ≤ m). It is guaranteed that no bridge connects a city with itself and that any two cities are connected with no more than one bridge.

If distributing the deputies in the required manner is impossible, print in a single line "NO" (without the quotes). Otherwise, in the first line print "YES" (without the quotes), and in the second line print which deputy should be put in charge of each city. The i-th number should represent the number of the deputy (from 1 to k), who should be in charge of city numbered i-th in the input — overall there should be n numbers. If there are multiple solutions, print any of them.

import Control.Monad
import Data.Array
import Data.Bits
import Data.List
import Data.Maybe
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as C

data Color
  = Red
  | Black
  deriving (Enum, Eq, Show)

switch Red = Black
switch Black = Red

type Edge = (Int, Int)
type Vertices = [Int]
type Graph = Array Int Vertices

toGraph :: Int -> [Edge] -> Graph
toGraph n = accumArray (flip (:)) [] (1, n)

color :: Int -> Graph -> Array Int Color
color n e = array (1, n) $ M.assocs $ foldl (dfs Red) M.empty [1 .. n]
  where
    dfs t c v
      | M.member v c  = c
      | otherwise     = foldl (dfs (switch t)) (M.insert v t c) $ e!v

try12 :: Int -> Graph -> Vertices -> Vertices -> Maybe Vertices
try12 n e r b
  | null u    = Nothing
  | otherwise = Just $ (u':v') ++ (delete u' r) ++ (b \\ v')
  where
    m = length b
    u = [i | i <- r, length (e!i) <= m - 2]
    u' = head u
    v = [j | j <- b, notElem u' $ e!j]
    v' = take 2 v

try42 :: Int -> Graph -> Vertices -> Vertices -> Maybe Vertices
try42 n e r b
  | length v' < 6 = Nothing
  | otherwise     = Just $ v' ++ (r \\ v') ++ (b \\ v')
  where
    m = length b
    x = foldr1 xor b
    e' = toGraph n [(foldr xor x $ e!i, i) | i <- r, length (e!i) == m - 1]
    v' = concat $ take 2 [i: take 2 j | (i, j) <- assocs e', length j >= 2]

yes :: Vertices -> IO ()
yes v = putStrLn $ ("YES\n" ++) $ unwords $ map show $ elems w
  where
    n = length v
    w = array (1,n) $ zip v $ concatMap (replicate 3) [1 ..]

no :: IO ()
no = putStrLn "NO"

solve :: Int -> Graph -> IO ()
solve n e =
  if m == 0 then yes $ r ++ b
  else case try12 n e x y of
            Just z  -> yes z
            Nothing -> case try42 n e x y of
                            Just z  -> yes z
                            Nothing -> no
  where
    c = color n e
    r = [i | (i, e) <- assocs c, e == Red]
    b = [i | (i, e) <- assocs c, e == Black]
    m = length r `mod` 3
    (x, y) = if m /= 2 then (r, b) else (b, r)

main = do
  [n, m] <- get
  e <- replicateM m get
  solve n $ toGraph n $ concat [[(i, j), (j, i)] | [i, j] <- e]
  where
    get = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

import Control.Monad
import Data.Array
import Data.Bits
import Data.List
import Data.Maybe
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as C

toGraph n = accumArray (flip (:)) [] (1, n)

color n e = array (1, n) $ M.assocs $ foldl (dfs True) M.empty [1 .. n]
  where
    dfs t c v
      | M.member v c = c
      | True = foldl (dfs (not t)) (M.insert v t c) $ e!v

try12 n e r b
  | null u = Nothing
  | True = Just $ (u':v') ++ (delete u' r) ++ (b \\ v')
  where
    m = length b
    u = [i | i <- r, length (e!i) <= m - 2]
    u' = head u
    v = [j | j <- b, notElem u' $ e!j]
    v' = take 2 v

try42 n e r b
  | length v' < 6 = Nothing
  | True = Just $ v' ++ (r \\ v') ++ (b \\ v')
  where
    m = length b
    x = foldr1 xor b
    e' = toGraph n [(foldr xor x $ e!i, i) | i <- r, length (e!i) == m - 1]
    v' = concat $ take 2 [i: take 2 j | (i, j) <- assocs e', length j >= 2]

yes v = putStrLn $ ("YES\n" ++) $ unwords $ map show $ elems w
  where
    n = length v
    w = array (1,n) $ zip v $ concatMap (replicate 3) [1 ..]

solve n e =
  if m == 0
  then
    yes $ r ++ b
  else
    case try12 n e x y of
      Just z -> yes z
      _      ->
        case try42 n e x y of
          Just z -> yes z
          _      -> putStrLn "NO"
  where
    c = color n e
    r = [i | (i, e) <- assocs c, e]
    b = [i | (i, e) <- assocs c, not e]
    m = length r `mod` 3
    (x, y) = if m /= 2 then (r, b) else (b, r)

get = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

main = do
  [n, m] <- get
  e <- replicateM m get
  solve n $ toGraph n $ concat [[(i, j), (j, i)] | [i, j] <- e]


Sonya decided to organize an exhibition of flowers. Since the girl likes only roses and lilies, she decided that only these two kinds of flowers should be in this exhibition.There are $$$n$$$ flowers in a row in the exhibition. Sonya can put either a rose or a lily in the $$$i$$$-th position. Thus each of $$$n$$$ positions should contain exactly one flower: a rose or a lily.She knows that exactly $$$m$$$ people will visit this exhibition. The $$$i$$$-th visitor will visit all flowers from $$$l_i$$$ to $$$r_i$$$ inclusive. The girl knows that each segment has its own beauty that is equal to the product of the number of roses and the number of lilies.Sonya wants her exhibition to be liked by a lot of people. That is why she wants to put the flowers in such way that the sum of beauties of all segments would be maximum possible.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1\leq n, m\leq 10^3$$$) — the number of flowers and visitors respectively. Each of the next $$$m$$$ lines contains two integers $$$l_i$$$ and $$$r_i$$$ ($$$1\leq l_i\leq r_i\leq n$$$), meaning that $$$i$$$-th visitor will visit all flowers from $$$l_i$$$ to $$$r_i$$$ inclusive.

Print the string of $$$n$$$ characters. The $$$i$$$-th symbol should be «0» if you want to put a rose in the $$$i$$$-th position, otherwise «1» if you want to put a lily. If there are multiple answers, print any.

NoteIn the first example, Sonya can put roses in the first, fourth, and fifth positions, and lilies in the second and third positions;  in the segment $$$[1\ldots3]$$$, there are one rose and two lilies, so the beauty is equal to $$$1\cdot 2=2$$$;  in the segment $$$[2\ldots4]$$$, there are one rose and two lilies, so the beauty is equal to $$$1\cdot 2=2$$$;  in the segment $$$[2\ldots5]$$$, there are two roses and two lilies, so the beauty is equal to $$$2\cdot 2=4$$$. The total beauty is equal to $$$2+2+4=8$$$.In the second example, Sonya can put roses in the third, fourth, and sixth positions, and lilies in the first, second, and fifth positions;  in the segment $$$[5\ldots6]$$$, there are one rose and one lily, so the beauty is equal to $$$1\cdot 1=1$$$;  in the segment $$$[1\ldots4]$$$, there are two roses and two lilies, so the beauty is equal to $$$2\cdot 2=4$$$;  in the segment $$$[4\ldots6]$$$, there are two roses and one lily, so the beauty is equal to $$$2\cdot 1=2$$$. The total beauty is equal to $$$1+4+2=7$$$.

import Data.List.Split as Split
import Data.Bits
import Data.List

stringToInt s = read s :: Int

int_arr = map stringToInt . words

main = do
  n_m <- getLine
  let [n, m] = int_arr n_m
  ss <- (read_strings m)
  let num_arr = map show (most_beauty n (map int_arr ss))
  -- putStrLn (intercalate " " num_arr)
  putStrLn (foldl (\acc s -> acc ++ s) [] num_arr)

read_strings 0 = return []
read_strings n = do
  s <- getLine
  ss <- (read_strings (n - 1))
  return (s:ss)

most_beauty :: Int -> [[Int]] -> [Int]
most_beauty n _ | n > 16 = [x `rem` 2 | x <- [1..n]]
most_beauty n lr_arr =
  variant n lr_arr (2 ^ n) (repr n (2 ^ n)) 0

variant :: Int -> [[Int]] -> Int -> [Int] -> Int -> [Int]
variant _ _ 0 best _best_score = best
variant n lr_arr v1 best best_score =
  let rv = repr n v1
  in case is_suitable rv of
    False -> variant n lr_arr (v1 - 1) best best_score
    True ->
      let b = beauty_sum rv lr_arr
      in if b > best_score
        then variant n lr_arr (v1 - 1) rv b
        else variant n lr_arr (v1 - 1) best best_score

repr :: Int -> Int -> [Int]
repr n v = [(bit 0).&.(shift v (1 - x)) | x <- (reverse [1..n])]

beauty_sum :: [Int] -> [[Int]] -> Int
beauty_sum mask lr_arr = sum (map (beauty mask) lr_arr)

beauty :: [Int] -> [Int] -> Int
beauty mask [l, r] =
  let m = take (r - l + 1) $ drop (l - 1) mask
  in (length $ filter (== 1) m) * (length $ filter (== 0) m)

is_suitable (1:1:1:_) = False
is_suitable (0:0:0:_) = False
is_suitable [] = True
is_suitable (x:xs) = is_suitable xs

-- suitable _n _mask [False, False, False] = False
-- suitable _n _mask [True, True, True] = False
-- suitable 0 _mask _ = True
-- suitable n mask prev =
--   let p = testBit mask 0
--       prev1 = case prev of
--         [p1, p2, p3] -> [p, p1, p2]
--         _ -> (p:prev)
--   in suitable (n - 1) (shift mask (-1)) prev1

-- possible n_d x_n =
--   let [_n, d] = map stringToInt $ Split.splitOn " " n_d
--       x = map stringToInt $ Split.splitOn " " x_n
--   in show (2 + (behind d x))

-- behind d (x1:[]) = 0
-- behind d (x1:x2:xs) =
--   case compare (2*d) (x2 - x1) of
--     EQ -> 1 + behind d (x2:xs)
--     GT -> behind d (x2:xs)
--     LT -> 2 + behind d (x2:xs)

main = getContents >>= putStrLn . solve . read . head . words

solve 0 = []
solve n = (if n `mod` 2 == 0 then '0' else '1') : solve (n - 1)

import Data.List.Split as Split
import Data.Bits
import Data.List

stringToInt s = read s :: Int

int_arr = map stringToInt . words

main = do
  n_m <- getLine
  let [n, m] = int_arr n_m
  ss <- (read_strings m)
  let num_arr = map show (most_beauty n (map int_arr ss))
  -- putStrLn (intercalate " " num_arr)
  putStrLn (foldl (\acc s -> acc ++ s) [] num_arr)

read_strings 0 = return []
read_strings n = do
  s <- getLine
  ss <- (read_strings (n - 1))
  return (s:ss)

most_beauty :: Int -> [[Int]] -> [Int]
most_beauty n lr_arr =
  variant n lr_arr (2 ^ n) (repr n (2 ^ n)) 0

variant :: Int -> [[Int]] -> Int -> [Int] -> Int -> [Int]
variant _ _ 0 best _best_score = best
variant n lr_arr v1 best best_score =
  let rv = repr n v1
  in case is_suitable rv of
    False -> variant n lr_arr (v1 - 1) best best_score
    True ->
      let b = beauty_sum rv lr_arr
      in if b > best_score
        then variant n lr_arr (v1 - 1) rv b
        else variant n lr_arr (v1 - 1) best best_score

repr :: Int -> Int -> [Int]
repr n v = [(bit 0).&.(shift v (1 - x)) | x <- (reverse [1..n])]

beauty_sum :: [Int] -> [[Int]] -> Int
beauty_sum mask lr_arr = sum (map (beauty mask) lr_arr)

beauty :: [Int] -> [Int] -> Int
beauty mask [l, r] =
  let m = take (r - l + 1) $ drop (l - 1) mask
  in (length $ filter (== 1) m) * (length $ filter (== 0) m)

is_suitable (1:1:1:_) = False
is_suitable (0:0:0:_) = False
is_suitable [] = True
is_suitable (x:xs) = is_suitable xs

-- suitable _n _mask [False, False, False] = False
-- suitable _n _mask [True, True, True] = False
-- suitable 0 _mask _ = True
-- suitable n mask prev =
--   let p = testBit mask 0
--       prev1 = case prev of
--         [p1, p2, p3] -> [p, p1, p2]
--         _ -> (p:prev)
--   in suitable (n - 1) (shift mask (-1)) prev1

-- possible n_d x_n =
--   let [_n, d] = map stringToInt $ Split.splitOn " " n_d
--       x = map stringToInt $ Split.splitOn " " x_n
--   in show (2 + (behind d x))

-- behind d (x1:[]) = 0
-- behind d (x1:x2:xs) =
--   case compare (2*d) (x2 - x1) of
--     EQ -> 1 + behind d (x2:xs)
--     GT -> behind d (x2:xs)
--     LT -> 2 + behind d (x2:xs)

import Data.List.Split as Split
import Data.Bits

stringToInt s = read s :: Int

int_arr = map stringToInt . words

main = do
  n_m <- getLine
  let [n, m] = int_arr n_m
  ss <- (read_strings m)
  let num_arr = map show (most_beauty n (map int_arr ss))
  putStrLn (foldl (\acc s -> acc ++ s ++ " ") [] num_arr)

read_strings 0 = return []
read_strings n = do
  s <- getLine
  ss <- (read_strings (n - 1))
  return (s:ss)

most_beauty :: Int -> [[Int]] -> [Int]
most_beauty n lr_arr =
  variant n lr_arr (2 ^ n) (repr n (2 ^ n)) 0

variant :: Int -> [[Int]] -> Int -> [Int] -> Int -> [Int]
variant _ _ 0 best _best_score = best
variant n lr_arr v1 best best_score =
  let rv = repr n v1
  in case is_suitable rv of
    False -> variant n lr_arr (v1 - 1) best best_score
    True ->
      let b = beauty_sum rv lr_arr
      in if b > best_score
        then variant n lr_arr (v1 - 1) rv b
        else variant n lr_arr (v1 - 1) best best_score

repr :: Int -> Int -> [Int]
repr n v = [(bit 0).&.(shift v (1 - x)) | x <- (reverse [1..n])]

beauty_sum :: [Int] -> [[Int]] -> Int
beauty_sum mask lr_arr = sum (map (beauty mask) lr_arr)

beauty :: [Int] -> [Int] -> Int
beauty mask [l, r] =
  let m = take (r - l + 1) $ drop (l - 1) mask
  in (length $ filter (== 1) m) * (length $ filter (== 0) m)

is_suitable (1:1:1:_) = False
is_suitable (0:0:0:_) = False
is_suitable [] = True
is_suitable (x:xs) = is_suitable xs

-- suitable _n _mask [False, False, False] = False
-- suitable _n _mask [True, True, True] = False
-- suitable 0 _mask _ = True
-- suitable n mask prev =
--   let p = testBit mask 0
--       prev1 = case prev of
--         [p1, p2, p3] -> [p, p1, p2]
--         _ -> (p:prev)
--   in suitable (n - 1) (shift mask (-1)) prev1

-- possible n_d x_n =
--   let [_n, d] = map stringToInt $ Split.splitOn " " n_d
--       x = map stringToInt $ Split.splitOn " " x_n
--   in show (2 + (behind d x))

-- behind d (x1:[]) = 0
-- behind d (x1:x2:xs) =
--   case compare (2*d) (x2 - x1) of
--     EQ -> 1 + behind d (x2:xs)
--     GT -> behind d (x2:xs)
--     LT -> 2 + behind d (x2:xs)


In order to do some research, $$$n^2$$$ labs are built on different heights of a mountain. Let's enumerate them with integers from $$$1$$$ to $$$n^2$$$, such that the lab with the number $$$1$$$ is at the lowest place, the lab with the number $$$2$$$ is at the second-lowest place, $$$\ldots$$$, the lab with the number $$$n^2$$$ is at the highest place.To transport water between the labs, pipes are built between every pair of labs. A pipe can transport at most one unit of water at a time from the lab with the number $$$u$$$ to the lab with the number $$$v$$$ if $$$u > v$$$.Now the labs need to be divided into $$$n$$$ groups, each group should contain exactly $$$n$$$ labs. The labs from different groups can transport water to each other. The sum of units of water that can be sent from a group $$$A$$$ to a group $$$B$$$ is equal to the number of pairs of labs ($$$u, v$$$) such that the lab with the number $$$u$$$ is from the group $$$A$$$, the lab with the number $$$v$$$ is from the group $$$B$$$ and $$$u > v$$$. Let's denote this value as $$$f(A,B)$$$ (i.e. $$$f(A,B)$$$ is the sum of units of water that can be sent from a group $$$A$$$ to a group $$$B$$$).For example, if $$$n=3$$$ and there are $$$3$$$ groups $$$X$$$, $$$Y$$$ and $$$Z$$$: $$$X = \{1, 5, 6\}, Y = \{2, 4, 9\}$$$ and $$$Z = \{3, 7, 8\}$$$. In this case, the values of $$$f$$$ are equal to:  $$$f(X,Y)=4$$$ because of $$$5 \rightarrow 2$$$, $$$5 \rightarrow 4$$$, $$$6 \rightarrow 2$$$, $$$6 \rightarrow 4$$$,  $$$f(X,Z)=2$$$ because of $$$5 \rightarrow 3$$$, $$$6 \rightarrow 3$$$,  $$$f(Y,X)=5$$$ because of $$$2 \rightarrow 1$$$, $$$4 \rightarrow 1$$$, $$$9 \rightarrow 1$$$, $$$9 \rightarrow 5$$$, $$$9 \rightarrow 6$$$,  $$$f(Y,Z)=4$$$ because of $$$4 \rightarrow 3$$$, $$$9 \rightarrow 3$$$, $$$9 \rightarrow 7$$$, $$$9 \rightarrow 8$$$,  $$$f(Z,X)=7$$$ because of $$$3 \rightarrow 1$$$, $$$7 \rightarrow 1$$$, $$$7 \rightarrow 5$$$, $$$7 \rightarrow 6$$$, $$$8 \rightarrow 1$$$, $$$8 \rightarrow 5$$$, $$$8 \rightarrow 6$$$,  $$$f(Z,Y)=5$$$ because of $$$3 \rightarrow 2$$$, $$$7 \rightarrow 2$$$, $$$7 \rightarrow 4$$$, $$$8 \rightarrow 2$$$, $$$8 \rightarrow 4$$$. Please, divide labs into $$$n$$$ groups with size $$$n$$$, such that the value $$$\min f(A,B)$$$ over all possible pairs of groups $$$A$$$ and $$$B$$$ ($$$A \neq B$$$) is maximal.In other words, divide labs into $$$n$$$ groups with size $$$n$$$, such that minimum number of the sum of units of water that can be transported from a group $$$A$$$ to a group $$$B$$$ for every pair of different groups $$$A$$$ and $$$B$$$ ($$$A \neq B$$$) as big as possible.Note, that the example above doesn't demonstrate an optimal division, but it demonstrates how to calculate the values $$$f$$$ for some division.If there are many optimal divisions, you can find any.

The only line contains one number $$$n$$$ ($$$2 \leq n \leq 300$$$).

Output $$$n$$$ lines: In the $$$i$$$-th line print $$$n$$$ numbers, the numbers of labs of the $$$i$$$-th group, in any order you want. If there are multiple answers, that maximize the minimum number of the sum of units of water that can be transported from one group the another, you can print any.

NoteIn the first test we can divide $$$9$$$ labs into groups $$$\{2, 8, 5\}, \{9, 3, 4\}, \{7, 6, 1\}$$$.From the first group to the second group we can transport $$$4$$$ units of water ($$$8 \rightarrow 3, 8 \rightarrow 4, 5 \rightarrow 3, 5 \rightarrow 4$$$).From the first group to the third group we can transport $$$5$$$ units of water ($$$2 \rightarrow 1, 8 \rightarrow 7, 8 \rightarrow 6, 8 \rightarrow 1, 5 \rightarrow 1$$$).From the second group to the first group we can transport $$$5$$$ units of water ($$$9 \rightarrow 2, 9 \rightarrow 8, 9 \rightarrow 5, 3 \rightarrow 2, 4 \rightarrow 2$$$).From the second group to the third group we can transport $$$5$$$ units of water ($$$9 \rightarrow 7, 9 \rightarrow 6, 9 \rightarrow 1, 3 \rightarrow 1, 4 \rightarrow 1$$$).From the third group to the first group we can transport $$$4$$$ units of water ($$$7 \rightarrow 2, 7 \rightarrow 5, 6 \rightarrow 2, 6 \rightarrow 5$$$).From the third group to the second group we can transport $$$4$$$ units of water ($$$7 \rightarrow 3, 7 \rightarrow 4, 6 \rightarrow 3, 6 \rightarrow 4$$$).The minimal number of the sum of units of water, that can be transported from one group to another is equal to $$$4$$$. It can be proved, that it is impossible to make a better division.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}
#ifndef DEBUG
{-# LANGUAGE Safe              #-}
#endif

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.State.Strict
import qualified Data.Array                 as A
import qualified Data.Array.Unboxed         as UA
import qualified Data.Array.ST.Safe         as MA
import           Data.Bool
import qualified Data.ByteString.Builder    as B
import qualified Data.ByteString.Char8      as C
import           Data.Char
import           Data.Function
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import qualified Data.List                  as L
import qualified Data.List.NonEmpty         as NL
import           Data.Monoid
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup
import qualified Data.Set                   as S
import           Data.Tuple
import           Foreign
import qualified System.IO                  as IO
#ifdef DEBUG
import           Debug.Trace
#endif

main :: IO ()
main = do
  n <- readLn
  putStr.unlines.map (unwords.map show) $ solve n

solve :: Int -> [[Int]]
solve n = L.transpose $ zipWith ($) (cycle [id, reverse])[[n*i+j|j<-[1..n]]|i<-[0..n-1]]


You have a connected undirected graph made of $$$n$$$ nodes and $$$m$$$ edges. The $$$i$$$-th node has a value $$$v_i$$$ and a target value $$$t_i$$$.In an operation, you can choose an edge $$$(i, j)$$$ and add $$$k$$$ to both $$$v_i$$$ and $$$v_j$$$, where $$$k$$$ can be any integer. In particular, $$$k$$$ can be negative.Your task to determine if it is possible that by doing some finite number of operations (possibly zero), you can achieve for every node $$$i$$$, $$$v_i = t_i$$$.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 1000$$$), the number of test cases. Then the test cases follow. The first line of each test case contains two integers $$$n$$$, $$$m$$$ ($$$2 \leq n \leq 2\cdot 10^5$$$, $$$n-1\leq m\leq \min(2\cdot 10^5, \frac{n(n-1)}{2})$$$) — the number of nodes and edges respectively. The second line contains $$$n$$$ integers $$$v_1\ldots, v_n$$$ ($$$-10^9 \leq v_i \leq 10^9$$$) — initial values of nodes. The third line contains $$$n$$$ integers $$$t_1\ldots, t_n$$$ ($$$-10^9 \leq t_i \leq 10^9$$$) — target values of nodes. Each of the next $$$m$$$ lines contains two integers $$$i$$$ and $$$j$$$ representing an edge between node $$$i$$$ and node $$$j$$$ ($$$1 \leq i, j \leq n$$$, $$$i\ne j$$$). It is guaranteed that the graph is connected and there is at most one edge between the same pair of nodes. It is guaranteed that the sum of $$$n$$$ over all testcases does not exceed $$$2 \cdot 10^5$$$ and the sum of $$$m$$$ over all testcases does not exceed $$$2 \cdot 10^5$$$.

For each test case, if it is possible for every node to reach its target after some number of operations, print "YES". Otherwise, print "NO".

NoteHere is a visualization of the first test case (the orange values denote the initial values and the blue ones the desired values):   One possible order of operations to obtain the desired values for each node is the following:  Operation $$$1$$$: Add $$$2$$$ to nodes $$$2$$$ and $$$3$$$.  Operation $$$2$$$: Add $$$-2$$$ to nodes $$$1$$$ and $$$4$$$.  Operation $$$3$$$: Add $$$6$$$ to nodes $$$3$$$ and $$$4$$$. Now we can see that in total we added $$$-2$$$ to node $$$1$$$, $$$2$$$ to node $$$2$$$, $$$8$$$ to node $$$3$$$ and $$$4$$$ to node $$$4$$$ which brings each node exactly to it's desired value.For the graph from the second test case it's impossible to get the target values.

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.List
import Data.Maybe
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt

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

parseInteger = fst . fromJust . BS.readInteger

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

runMm :: Graph -> (UArray Int Int, UArray Int Bool)
runMm g =
    runST $ do
        mt <- newArray (bounds g) (-1)
        forM_ (indices g) $ \i -> do
            vis <- newArray (bounds g) False
            go vis mt i
        vis <- newArray (bounds g) False
        mt' <- unsafeFreezeSTUArray mt
        let matched = Set.fromList (filter (>=0) (elems mt'))
        forM_ (indices g) $ \i -> do
            unless (Set.member i matched) $
                void (go vis mt i)
        vis' <- unsafeFreezeSTUArray vis
        return (mt', vis')
    where
        go :: STUArray s Int Bool -> STUArray s Int Int -> Int -> ST s Bool
        go vis mt x = do
            visx <- readArray vis x
            if visx then
                return False
            else do
                writeArray vis x True
                trav (g ! x)
            where
                trav [] = return False
                trav (y:ys) = do
                    v <- readArray mt y
                    if v < 0 then win
                    else do
                        can <- go vis mt v
                        if can then win
                        else
                            trav ys
                    where
                        win = do
                            writeArray mt y x
                            return True

getMvc :: Graph -> [Int]
getMvc g =
    let (mt, vis) = runMm g
    in
        [i | (i, t) <- assocs vis, not t] ++ [-i | (i, t) <- assocs mt, t >= 0 && vis ! t]

solve :: [Int] -> [(Int64, Int64)] -> Int -> Int -> [Int]
solve os vs' n k = runST $ do
    mem <- newArray ((0,0), (k+1,mm+1)) (-1)
    c <- newArray ((0,0), (k+1,mm+1)) (-1)
    r <- f mem c 0 mm
    cc <- unsafeFreezeSTUArray c
    return $ build cc 0 mm os
    where
        mm = length os
        vs = listArray (0, k-1) vs' :: Array Int (Int64,Int64)
        f :: STUArray s (Int, Int) Int64 -> STUArray s (Int, Int) Int -> Int -> Int -> ST s Int64
        f mem c i j = do
            rr <- readArray mem (i,j)
            if rr >= 0 then
                return rr
            else do
                if i == k then
                    writeArray mem (i,j) 0
                else do
                    let (x,y) = vs ! i
                    writeArray mem (i,j) (1 `shift` 60)
                    forM_ [0..j] $ \t -> do
                        when (j-t <= n-2-i) $ do
                            rcost <- f mem c (i+1) (j-t)
                            let cost = rcost + ((y * fromIntegral t) `min` x)
                            curcost <- readArray mem (i,j)
                            when (cost < curcost) $ do
                                writeArray mem (i,j) cost
                                writeArray c (i,j) t
                readArray mem (i,j)
        build :: UArray (Int, Int) Int -> Int -> Int -> [Int] -> [Int]
        build c i j os
            | i == k = []
            | otherwise =
                let t = c ! (i,j) in
                    take t os ++ [0] ++ build c (i+1) (j-t) (drop t os)

main = do
    tn <- parseInt <$> BS.getLine

    replicateM_ tn $ do
        [n,m] <- map parseInt . BS.words <$> BS.getLine
        vs0 <- map parseInt64 . BS.words <$> BS.getLine
        vs1 <- map parseInt64 . BS.words <$> BS.getLine
        let vs = zipWith (flip (-)) vs0 vs1
        es <- replicateM m $ do
            [x, y] <- map parseInt . BS.words <$> BS.getLine
            return (x, y)
        let g = buildG (1,n) (es ++ map (\(x,y) -> (y,x)) es)

        ca <- newArray (1,n) (-1) :: IO (IOArray Int Int)

        let
            dfs :: Int -> IO Bool
            dfs x = do
                cx <- readArray ca x
                trav cx (g ! x)
             where
                trav :: Int -> [Int] -> IO Bool
                trav _ [] = return True
                trav cx (y:ys) = do
                    cy <- readArray ca y
                    if cx == cy then do
                        trav cx ys
                        return False
                    else if cy < 0 then do
                        writeArray ca y (1-cx)
                        r <- dfs y
                        if not r then do
                            trav cx ys
                            return False
                        else
                            trav cx ys
                    else
                        trav cx ys
        writeArray ca 1 0
        bip <- dfs 1
        cs <- getElems ca

        -- print g

        -- print (bip,cs)

        let r = if bip then
                    let
                        s0 = sum . map fst . filter ((==0) . snd) $ zip vs cs
                        s1 = sum . map fst . filter ((==1) . snd) $ zip vs cs
                    in
                        s0 == s1
                else
                    even $ sum vs

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


Today at the lesson of mathematics, Petya learns about the digital root.The digital root of a non-negative integer is the single digit value obtained by an iterative process of summing digits, on each iteration using the result from the previous iteration to compute a digit sum. The process continues until a single-digit number is reached. Let's denote the digital root of $$$x$$$ as $$$S(x)$$$. Then $$$S(5)=5$$$, $$$S(38)=S(3+8=11)=S(1+1=2)=2$$$, $$$S(10)=S(1+0=1)=1$$$.As a homework Petya got $$$n$$$ tasks of the form: find $$$k$$$-th positive number whose digital root is $$$x$$$.Petya has already solved all the problems, but he doesn't know if it's right. Your task is to solve all $$$n$$$ tasks from Petya's homework.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^3$$$) — the number of tasks in Petya's homework. The next $$$n$$$ lines contain two integers $$$k_i$$$ ($$$1 \le k_i \le 10^{12}$$$) and $$$x_i$$$ ($$$1 \le x_i \le 9$$$) — $$$i$$$-th Petya's task in which you need to find a $$$k_i$$$-th positive number, the digital root of which is $$$x_i$$$.

Output $$$n$$$ lines, $$$i$$$-th line should contain a single integer — the answer to the $$$i$$$-th problem.

import qualified Data.ByteString.Char8 as B
import Control.Arrow
import Data.Maybe

main = B.interact $ B.unlines . map (B.pack . show . ( (9*). pred *** id >>> uncurry (+)) . (\[x,y] ->(x,y)) .  map (fst . fromJust . B.readInteger) . B.words ) . tail . B.lines

main :: IO ()
main = do
  n <- readLn :: IO Int
  doQueries n

doQueries :: Int -> IO ()
doQueries 0 = return ()
doQueries n = do
  l <- getLine
  let (k:x:[]) = map read (words l)
  putStrLn $ show $ (k-1) * 9 + x
  doQueries (n-1)

dig_root :: Int -> Int
dig_root n = n - 9 * ((n-1) `div` 9)

import qualified Data.ByteString.Char8 as B
import Control.Arrow
import Data.Maybe

main = B.interact $ B.unlines . map (B.pack . show . ( (9*). pred *** id >>> uncurry (+)) . (\[x,y] ->(x,y)) .  map (fst . fromJust . B.readInt) . B.words ) . tail . B.lines


I, Fischl, Prinzessin der Verurteilung, descend upon this land by the call of fate an — Oh, you are also a traveler from another world? Very well, I grant you permission to travel with me.It is no surprise Fischl speaks with a strange choice of words. However, this time, not even Oz, her raven friend, can interpret her expressions! Maybe you can help us understand what this young princess is saying?You are given a string of $$$n$$$ lowercase Latin letters, the word that Fischl just spoke. You think that the MEX of this string may help you find the meaning behind this message. The MEX of the string is defined as the shortest string that doesn't appear as a contiguous substring in the input. If multiple strings exist, the lexicographically smallest one is considered the MEX. Note that the empty substring does NOT count as a valid MEX.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$$$. A string $$$a$$$ is a substring of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) characters from the beginning and several (possibly, zero or all) characters from the end.Find out what the MEX of the string is!

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \leq t \leq 1000$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 1000$$$) — the length of the word. The second line for each test case contains a single string of $$$n$$$ lowercase Latin letters. The sum of $$$n$$$ over all test cases will not exceed $$$1000$$$.

For each test case, output the MEX of the string on a new line.

3
28
qaabzwsxedcrfvtgbyhnujmiklop
13
cleanairactbd
10
aannttoonn

import Data.List (tails, isPrefixOf)

alphabet = map pure ['a'..'z'] :: [String]

gen' :: [String]
gen' = "" : ( (++) <$> gen' <*> alphabet )

gen = drop 1 gen'

isSubstr :: (Eq a) => [a] -> [a] -> Bool
isSubstr xs ys = or $ map (xs `isPrefixOf`) $ tails ys

doTestCase :: IO ()
doTestCase = do getLine
                str <- getLine
                putStrLn . head $ dropWhile (`isSubstr` str) gen

main = do t <- readLn :: IO Int
          sequence_ $ replicate t doTestCase

import Data.List (tails)

alphabet = map pure ['a'..'z'] :: [String]

gen' :: [String]
gen' = "" : ( (++) <$> gen' <*> alphabet )

gen = drop 1 gen'

isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf xs ys | length xs <= length ys = and $ zipWith (==) xs ys
                 | otherwise = False

isSubstr :: (Eq a) => [a] -> [a] -> Bool
isSubstr xs ys = or $ map (xs `isPrefixOf`) $ tails ys

doTestCase :: IO ()
doTestCase = do _ <- getLine
                str <- getLine
                putStrLn . head $ dropWhile (`isSubstr` str) gen

main = do t <- readLn :: IO Int
          sequence_ $ replicate t doTestCase

import Data.List (intercalate, tails, isPrefixOf, head)
import Control.Monad (replicateM)
import Data.Maybe (fromJust, listToMaybe, catMaybes)

main = do t <- read <$> getLine
          replicateM t solve

solve = do getLine
           s <- getLine
           putStrLn (leastNonSubstring s)

leastNonSubstring s = head $ catMaybes [leastOfLength l | l <- [1..]]
  where leastOfLength l = helper "" l
        helper prefix 0 | isSubstring prefix s = Nothing
                        | otherwise            = Just prefix
        helper prefix l = listToMaybe $ catMaybes [helper (prefix ++ [letter]) (l - 1) | letter <- ['a'..'z']]

isSubstring s t = any id (map (isPrefixOf s) (tails t))

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

allStrings :: [String]
allStrings = [] : [string ++ [ch] | string <- allStrings, ch <- ['a' .. 'z']]

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    s <- C.unpack <$> C.getLine
    let check str = not $ any (isPrefixOf str) $ tails s
        result = head $ filter check $ tail allStrings
    return $ string7 result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

import Data.List

-- generate string
genstr :: [Char] -> Int -> [String]
genstr _ 0 = [""]
genstr chars n = prev ++ (concat $ map jimmy chars)
	where prev = genstr chars (n-1)
	      jimmy c = map ((:) c) prev

jimmy :: String -> String
jimmy str = head $ filter (not.(flip isInfixOf str)) jim
	where (_:jim) = genstr "abcdefghijklmnopqrstuvwxyz" (length str)

hoo :: [String] -> [String]
hoo [] = []
hoo (a:b:cs) = b:(hoo cs)

main = interact $ unlines.(map jimmy).hoo.tail.lines

import Data.List (tails)

alphabet = map pure ['a'..'z'] :: [String]

gen' :: [String]
gen' = "" : ( (++) <$> gen' <*> alphabet )

gen = drop 1 gen'

isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf xs ys | length xs < length ys = and $ zipWith (==) xs ys
                 | otherwise = False

isSubstr :: (Eq a) => [a] -> [a] -> Bool
isSubstr xs ys = or $ map (xs `isPrefixOf`) $ init $ tails ys

doTestCase :: IO ()
doTestCase = do _ <- getLine
                str <- getLine
                putStrLn . head $ dropWhile (`isSubstr` str) gen

main = do t <- readLn :: IO Int
          sequence_ $ replicate t doTestCase

import Data.List (tails)

alphabet = map pure ['a'..'z'] :: [String]

gen' :: [String]
gen' = "" : ( (++) <$> gen' <*> alphabet )

gen = drop 1 gen'

isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf xs ys = and $ zipWith (==) xs ys

isSubstr :: (Eq a) => [a] -> [a] -> Bool
isSubstr xs ys = or $ map (xs `isPrefixOf`) $ init $ tails ys

doTestCase :: IO ()
doTestCase = do _ <- getLine
                str <- getLine
                putStrLn . head $ dropWhile (`isSubstr` str) gen

main = do t <- readLn :: IO Int
          sequence_ $ replicate t doTestCase


There are $$$n$$$ participants in a competition, participant $$$i$$$ having a strength of $$$s_i$$$. Every participant wonders how much of an advantage they have over the other best participant. In other words, each participant $$$i$$$ wants to know the difference between $$$s_i$$$ and $$$s_j$$$, where $$$j$$$ is the strongest participant in the competition, not counting $$$i$$$ (a difference can be negative).So, they ask you for your help! For each $$$i$$$ ($$$1 \leq i \leq n$$$) output the difference between $$$s_i$$$ and the maximum strength of any participant other than participant $$$i$$$.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The descriptions of the test cases follow. The first line of each test case contains an integer $$$n$$$ ($$$2 \leq n \leq 2\cdot10^5$$$) — the length of the array. The following line contains $$$n$$$ space-separated positive integers $$$s_1$$$, $$$s_2$$$, ..., $$$s_n$$$ ($$$1 \leq s_i \leq 10^9$$$) — the strengths of the participants. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot10^5$$$.

For each test case, output $$$n$$$ space-separated integers. For each $$$i$$$ ($$$1 \leq i \leq n$$$) output the difference between $$$s_i$$$ and the maximum strength of any other participant.

NoteFor the first test case: The first participant has a strength of $$$4$$$ and the largest strength of a participant different from the first one is $$$7$$$, so the answer for the first participant is $$$4 - 7 = -3$$$.  The second participant has a strength of $$$7$$$ and the largest strength of a participant different from the second one is $$$5$$$, so the answer for the second participant is $$$7 - 5 = 2$$$. The third participant has a strength of $$$3$$$ and the largest strength of a participant different from the third one is $$$7$$$, so the answer for the third participant is $$$3 - 7 = -4$$$. The fourth participant has a strength of $$$5$$$ and the largest strength of a participant different from the fourth one is $$$7$$$, so the answer for the fourth participant is $$$5 - 7 = -2$$$.

{-# LANGUAGE CPP, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
{-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
import Control.Monad (replicateM_, forM_)
import Control.Arrow ((>>>))
import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.List (sort, sortBy, intercalate)
import qualified Data.ByteString.Char8 as B8
import Data.Functor ((<&>))
import System.IO (stdin, stdout, hFlush)
import Text.Printf
import qualified Data.Array as A

solve :: [Integer] -> [Integer]
solve a = res a
        where
                d = sort a
                ld = last d
                ldd = d !! m
                m = length a - 2
                res [] = []
                res (x : xs)
                        | x == ld = (x - ldd : res xs)
                        | otherwise = (x - ld : res xs)

{---}

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

{---}

task = do
        n <- B8.getLine <&> readIntegerB8
        a <- B8.getLine <&> readIntegerB8s
        let answer = solve a
        forM_ answer $ \p -> printf "%lld " p
        putStrLn ""

main = do
        t <- B8.getLine <&> readIntB8
        replicateM_ t task

{-# LANGUAGE CPP, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
{-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields -fvia-C -optc-O3 #-}
import Control.Monad (replicateM_, forM_)
import Control.Arrow ((>>>))
import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.List (sort, sortBy, intercalate)
import qualified Data.ByteString.Char8 as B8
import Data.Functor ((<&>))
import System.IO (stdin, stdout, hFlush)
import Text.Printf

pairs :: [Integer] -> [(Integer, Integer)]
pairs a = zip a [1..]

diffs :: [Integer] -> [Integer]
diffs [] = []
diffs (a : b : []) = (a - b : b - a : [])
diffs (a : xs) = (a - b  : diffs xs)
        where b = last xs

reorder :: [(Integer, Integer)] -> [(Integer, Integer)]
reorder a = sortBy (\(_, a) (_, b) -> compare a b) a

unpairs :: [(Integer, Integer)] -> [Integer]
unpairs a = map (\(a, _) -> a) a

solve :: [Integer] -> [Integer]
solve a = unpairs $ reorder d
        where
                b = sort c
                c = pairs a
                d = zip (diffs a1) a2
                a1 = unpairs b
                a2 = map (\(_, b) -> b) c

everyOther [] = []
everyOther (_ : x : xs) = (x : everyOther xs)

{---}

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

{---}

task = do
        n <- B8.getLine <&> readIntegerB8
        a <- B8.getLine <&> readIntegerB8s
        let answer = solve a
        forM_ answer $ \p -> printf "%lld " p
main = do
        t <- B8.getLine <&> readIntB8
        replicateM_ t task


In late autumn evening n robots gathered in the cheerful company of friends. Each robot has a unique identifier — an integer from 1 to 109.At some moment, robots decided to play the game "Snowball". Below there are the rules of this game. First, all robots stand in a row. Then the first robot says his identifier. After that the second robot says the identifier of the first robot and then says his own identifier. Then the third robot says the identifier of the first robot, then says the identifier of the second robot and after that says his own. This process continues from left to right until the n-th robot says his identifier.Your task is to determine the k-th identifier to be pronounced.

The first line contains two positive integers n and k (1 ≤ n ≤ 100 000, 1 ≤ k ≤ min(2·109, n·(n + 1) / 2). The second line contains the sequence id1, id2, ..., idn (1 ≤ idi ≤ 109) — identifiers of roborts. It is guaranteed that all identifiers are different.

Print the k-th pronounced identifier (assume that the numeration starts from 1).

NoteIn the first sample identifiers of robots will be pronounced in the following order: 1, 1, 2. As k = 2, the answer equals to 1.In the second test case identifiers of robots will be pronounced in the following order: 10, 10, 4, 10, 4, 18, 10, 4, 18, 3. As k = 5, the answer equals to 4.

sq :: Int -> Int -> (Int, Int)
sq k i
  | k < i = (i - 1, k)
  | otherwise = sq (k-i) (i+1)

--  if (k <= i * (i + 1) `div` 2 + i) then (i, k - i * (i+1) `div` 2) else  sq k (i+1)

solve :: Int -> Int -> [Int] -> Int
solve n k ids = ids !! index
      where
        (a,b) = sq k 0
        index = (b + a - 1) `mod` a

main :: IO ()
main = do
  line <- getLine
  let [n,k] = map read (words line) :: [Int]
  line2 <- getLine
  let ids = map read (words line2) :: [Int]
  print (solve n k ids)

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

natureSum :: Int -> Int
natureSum n | odd n = n * div (n + 2) 2
            | otherwise = div n 2 * (n + 1)

findBottom :: Int -> Int -> Int -> Int -> Int
findBottom l r k b | l > r = b
                   | otherwise = let mid = div (l + r) 2
                                     m = natureSum mid
                                 in if m <= k
                                    then findBottom (mid + 1) r k (max b m)
                                    else findBottom l (mid - 1) k b

solve :: [Int] -> Int
solve (n:k:id) = let m = findBottom 1 (min n 63246) (k - 1) 0
                 in id !! (k - m - 1)

module Main where

-- correct, but SLOW
thisSeq = concat $ map (\x->[0..x]) [0..]

triSeq :: [Integer]
triSeq = map (\x-> x * (x + 1) `div` 2) [1..]

revIdx 0 = 0
revIdx k = k - (last $ takeWhile (<= k) triSeq)

pronounce xs k = xs !! (fromInteger (revIdx k))

main = do
    l0 <- getLine
    l1 <- getLine
    let [_, k] = map (\w->read w::Integer) $ words l0
        ids = map (\w->read w::Integer) $ words l1
    print $ pronounce ids (k - 1)

{-
instructions go here...
-}

module Main where

solve :: [Int] -> Int -> Int -> Int
solve ids k me | k <= me   = ids !! (k - 1)
               | otherwise = solve ids (k - me) (me + 1)

main :: IO ()
main = do
  line <- getLine
  let [n,k] = map read (words line) :: [Int]
  line2 <- getLine
  let ids = map read (words line2) :: [Int]
  putStrLn $ show (solve ids k 1)


In order to celebrate Twice's 5th anniversary, Tzuyu and Sana decided to play a game.Tzuyu gave Sana two integers $$$a$$$ and $$$b$$$ and a really important quest.In order to complete the quest, Sana has to output the smallest possible value of ($$$a \oplus x$$$) + ($$$b \oplus x$$$) for any given $$$x$$$, where $$$\oplus$$$ denotes the bitwise XOR operation.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^{4}$$$). Description of the test cases follows. The only line of each test case contains two integers $$$a$$$ and $$$b$$$ ($$$1 \le a, b \le 10^{9}$$$).

For each testcase, output the smallest possible value of the given expression.

NoteFor the first test case Sana can choose $$$x=4$$$ and the value will be ($$$6 \oplus 4$$$) + ($$$12 \oplus 4$$$) = $$$2 + 8$$$ = $$$10$$$. It can be shown that this is the smallest possible value.

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

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

solve :: [Int] -> Int
solve [x, y] = x `xor` y

import Data.Bits
import Control.Monad

main :: IO ()
main = do
  numCases <- getLine
  replicateM_ (read numCases) solveTest

solveTest :: IO ()
solveTest = do
  ln <- getLine
  let lnData = map read (words ln)
  let (a, b) = (lnData !! 0, lnData !! 1)
  let answer = minXor a b
  putStrLn (show answer)

minXor :: Int -> Int -> Int
minXor a b =
  let maxBits = max (bitCount a) (bitCount b)
      bits = reverse $ map (combineBits a b) [0..maxBits]
      x = numFromBits bits
  in sumXor a b x

combineBits :: Int -> Int -> Int -> Bool
combineBits a b n = if (testBit a n) == (testBit b n) then testBit a n else False

numFromBits :: [Bool] -> Int
numFromBits bits = sum (zipWith (*) realBits values)
  where realBits = map (\b -> if b == True then 1 else 0) (reverse bits)
        values = map ((^) 2)[0..length bits - 1]

sumXor :: Int -> Int -> Int -> Int
sumXor a b x = (xor a x) + (xor b x)

bitCount :: Int -> Int
bitCount n = 1 + floor (logBase 2 (fromIntegral n))

import Data.Bits

solve :: IO ()
solve = do
    str <- getLine
    let (a:b:[]) = map read $ words str :: [Int]
    print $ a + b - 2 * (a .&. b)

main = do
    tests_str <- getLine
    sequence $ take (read tests_str) $ repeat solve

import Control.Monad
import Data.Bits

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

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [a, b] <- readInts
    let  x = a .|. b
    print $ xor a x + xor b x


Vova is again playing some computer game, now an RPG. In the game Vova's character received a quest: to slay the fearsome monster called Modcrab.After two hours of playing the game Vova has tracked the monster and analyzed its tactics. The Modcrab has h2 health points and an attack power of a2. Knowing that, Vova has decided to buy a lot of strong healing potions and to prepare for battle.Vova's character has h1 health points and an attack power of a1. Also he has a large supply of healing potions, each of which increases his current amount of health points by c1 when Vova drinks a potion. All potions are identical to each other. It is guaranteed that c1 > a2.The battle consists of multiple phases. In the beginning of each phase, Vova can either attack the monster (thus reducing its health by a1) or drink a healing potion (it increases Vova's health by c1; Vova's health can exceed h1). Then, if the battle is not over yet, the Modcrab attacks Vova, reducing his health by a2. The battle ends when Vova's (or Modcrab's) health drops to 0 or lower. It is possible that the battle ends in a middle of a phase after Vova's attack.Of course, Vova wants to win the fight. But also he wants to do it as fast as possible. So he wants to make up a strategy that will allow him to win the fight after the minimum possible number of phases.Help Vova to make up a strategy! You may assume that Vova never runs out of healing potions, and that he can always win.

The first line contains three integers h1, a1, c1 (1 ≤ h1, a1 ≤ 100, 2 ≤ c1 ≤ 100) — Vova's health, Vova's attack power and the healing power of a potion. The second line contains two integers h2, a2 (1 ≤ h2 ≤ 100, 1 ≤ a2 < c1) — the Modcrab's health and his attack power.

In the first line print one integer n denoting the minimum number of phases required to win the battle. Then print n lines. i-th line must be equal to HEAL if Vova drinks a potion in i-th phase, or STRIKE if he attacks the Modcrab. The strategy must be valid: Vova's character must not be defeated before slaying the Modcrab, and the monster's health must be 0 or lower after Vova's last action. If there are multiple optimal solutions, print any of them.

NoteIn the first example Vova's character must heal before or after his first attack. Otherwise his health will drop to zero in 2 phases while he needs 3 strikes to win.In the second example no healing needed, two strikes are enough to get monster to zero health and win with 6 health left.

main = getContents >>= putStr . exec
exec = unlines . (\xs -> show (length xs):xs) . solve . map read . words

solve [h1, a1, c1, h2, a2] = go h1 h2
  where
  go h1 h2
    | h2 <= 0 = []
    | h2 > a1 && a2 >= h1 = "HEAL":go (h1 + c1 - a2) h2
    | otherwise = "STRIKE":go (h1 - a2) (h2 - a1)

import Control.Applicative

main :: IO ()
main = do
    [h1, a1, c1, h2, a2] <- map read . words <$> getContents
    let s = ((h2 - 1) `div` a1) + 1;
        h = head [t | t <- [0 ..], h1 + t * c1 > (t + s - 1) * a2]
    print $ s + h
    putStr . unlines $ replicate h "HEAL" ++ replicate s "STRIKE"

groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds
-------------------------------------------------------------------------------

main = interact $ unlines . parse . lines

parse [st,nd] = sol s n
  where
    (s, n) = (fn $ words st, fn $ words nd)
    fn :: [String] -> [Int]
    fn xs = map read xs

sol [h, a, c] [hh, aa] = (show $ length res) : res
  where
    res = sol' h hh
    sol' h hh
      | hha <= 0  = ["STRIKE"]
      | haa <= 0  = "HEAL" : sol' (haa+c) hh
      | otherwise = "STRIKE" : sol' haa hha
      where haa = h-aa
            hha = hh-a

main = getContents >>= putStr . exec
exec = unlines . (\xs -> show (length xs):xs) . solve . map read . words

solve [h1, a1, c1, h2, a2] = go h1 h2
  where
  go h1 h2
    | h2 <= 0 = []
    | a2 >= h1 = "HEAL":go (h1 + c1 - a2) h2
    | otherwise = "STRIKE":go (h1 - a2) (h2 - a1)

import Control.Applicative

main :: IO ()
main = do
    [h1, a1, c1, h2, a2] <- map read . words <$> getContents
    let s = ((h2 - 1) `div` a1) + 1;
        h = head [t | t <- [0 ..], h1 + t * c1 > (s - 1) * a2]
    print $ s + h
    putStr . unlines $ replicate h "HEAL" ++ replicate s "STRIKE"

groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds
-------------------------------------------------------------------------------

main = interact $ unlines . parse . lines

parse [st,nd] = sol s n
  where
    (s, n) = (fn $ words st, fn $ words nd)
    fn :: [String] -> [Int]
    fn xs = map read xs

sol [h, a, c] [hh, aa] = (show $ length res) : res
  where
    res = sol' h hh
    sol' h hh
      | h <= 0 = ["Problem"]
      | hh <= 0 = []
      | haa <= 0 = "HEAL" : sol' (haa+c) hh
      | otherwise = "STRIKE" : sol' haa (hh-a)
      where haa = h-aa


You are given an array $$$a_1, a_2, \dots, a_n$$$. You can perform operations on the array. In each operation you can choose an integer $$$i$$$ ($$$1 \le i < n$$$), and swap elements $$$a_i$$$ and $$$a_{i+1}$$$ of the array, if $$$a_i + a_{i+1}$$$ is odd.Determine whether it can be sorted in non-decreasing order using this operation any number of times.

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1,a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the elements of the array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print "Yes" or "No" depending on whether you can or can not sort the given array. You may print each letter in any case (for example, "YES", "Yes", "yes", "yEs" will all be recognized as positive answer).

NoteIn the first test case, we can simply swap $$$31$$$ and $$$14$$$ ($$$31 + 14 = 45$$$ which is odd) and obtain the non-decreasing array $$$[1,6,14,31]$$$.In the second test case, the only way we could sort the array is by swapping $$$4$$$ and $$$2$$$, but this is impossible, since their sum $$$4 + 2 = 6$$$ is even.In the third test case, there is no way to make the array non-decreasing.In the fourth test case, the array is already non-decreasing.

import Control.Monad (forM_)
import Data.List (sort, partition)

sorted = and . (zipWith (<=) <*> tail)

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        let (xs, ys) = partition even arr
        putStrLn $ if sorted xs && sorted ys then "Yes" else "No"

{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE LambdaCase #-}

module Main where

import           Control.Applicative            ( liftA2 )
import           Control.Monad.State
import qualified Data.ByteString.Lazy.Char8    as C
import           Data.Function                  ( (&) )
import           Data.List
import           Data.Maybe                     ( fromJust )

type Scanner = State [C.ByteString]

scan :: Scanner a -> C.ByteString -> a
scan input = evalState input . C.lines

line :: Scanner C.ByteString
line = get >>= \case
  []     -> error "eof"
  s : ss -> put ss >> return s

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

main :: IO ()
main = C.interact solve

solve :: C.ByteString -> C.ByteString
solve input =
  input
    & scan parse
    & map (format . answer)
    & C.unlines

parse :: Scanner [[Int]]
parse = do
  _ <- line
  many $ do
    _ <- line
    map (fst . fromJust . C.readInt) . C.words <$> line

format :: Bool -> C.ByteString
format True  = C.pack "Yes"
format False = C.pack "No"

answer :: [Int] -> Bool
answer xs = sorted os && sorted es
  where (os, es) = partition odd xs

sorted :: Ord a => [a] -> Bool
sorted xs = and [ x <= x' | x <- xs | x' <- tail xs ]

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

solve [] _ _ = True
solve (x:xs) o e
  | (x `rem` 2) == 0 = if (e > x) then False else solve xs o x
  | (x `rem` 2) == 1 = if (o > x) then False else solve xs x e

main :: IO ()
main = do
  t <- readLn :: IO Int
  forM_ [1 .. t] $ \i -> do
    n <- readLn :: IO Int
    l <- getLine
    let arr = map read (words l) :: [Int]
    putStrLn $ if solve arr  0 0 then "YES" else "NO"

import Control.Monad (forM)
import Data.List

solve t = do
  n <- readLn::IO Int
  arr <- getLine >>= \s -> return $ map (read::String -> Int) (words s)
  let e = [ x | x <- arr, even x]
      o = [ x | x <- arr, odd x ]
  if sort e /= e || sort o /= o then putStrLn "NO" else putStrLn "YES"

main = do
tlen <- readLn :: IO Int
forM [0..(tlen - 1)] (\t -> do solve t)

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

solve :: IO ()
solve = do
    ~[n] <- readInts
    as <- readInts
    let (xs, ys) = partition even as
        sorted = and . (zipWith (<=) <*> tail)
    putStrLn $ if sorted xs && sorted ys then "Yes" else "No"

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

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

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
--import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    let
      (ae, ao) = partition even a
      isSorted li = and $ zipWith (<=) li (tail li)
    pure $ string7 $ if  isSorted ae && isSorted ao
      then  "Yes\n"
      else  "No\n"

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace
{-
putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'
-}
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun inp
  P.putStr $ toLazyByteString outp

{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE LambdaCase #-}

module Main where

import           Control.Applicative            ( liftA2 )
import           Control.Monad.State
import qualified Data.ByteString.Lazy.Char8    as C
import           Data.Function                  ( (&) )
import           Data.List
import           Data.Maybe                     ( fromJust )

type Scanner = State [C.ByteString]

scan :: Scanner a -> C.ByteString -> a
scan input = evalState input . C.lines

line :: Scanner C.ByteString
line = get >>= \case
  []     -> error "eof"
  s : ss -> put ss >> return s

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

main :: IO ()
main = C.interact solve

solve :: C.ByteString -> C.ByteString
solve input = input & scan parse & map (format . answer) & C.unlines

parse :: Scanner [[Int]]
parse = do
  _ <- line
  many $ do
    _ <- line
    map (fst . fromJust . C.readInt) . C.words <$> line

format :: Bool -> C.ByteString
format True  = C.pack "Yes"
format False = C.pack "No"

answer :: [Int] -> Bool
answer xs = all (\(x, x') -> odd $ x + x') swaps
  where
    xs'   = sort xs
    swaps = filter (uncurry (/=)) [ (x, x') | x <- xs | x' <- xs' ]


Tired of boring office work, Denis decided to open a fast food restaurant.On the first day he made $$$a$$$ portions of dumplings, $$$b$$$ portions of cranberry juice and $$$c$$$ pancakes with condensed milk.The peculiarity of Denis's restaurant is the procedure of ordering food. For each visitor Denis himself chooses a set of dishes that this visitor will receive. When doing so, Denis is guided by the following rules:  every visitor should receive at least one dish (dumplings, cranberry juice, pancakes with condensed milk are all considered to be dishes);  each visitor should receive no more than one portion of dumplings, no more than one portion of cranberry juice and no more than one pancake with condensed milk;  all visitors should receive different sets of dishes. What is the maximum number of visitors Denis can feed?

The first line contains an integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases to solve. Each of the remaining $$$t$$$ lines contains integers $$$a$$$, $$$b$$$ and $$$c$$$ ($$$0 \leq a, b, c \leq 10$$$) — the number of portions of dumplings, the number of portions of cranberry juice and the number of condensed milk pancakes Denis made.

For each test case print a single integer — the maximum number of visitors Denis can feed.

NoteIn the first test case of the example, Denis can feed the first visitor with dumplings, give the second a portion of cranberry juice, and give the third visitor a portion of cranberry juice and a pancake with a condensed milk.In the second test case of the example, the restaurant Denis is not very promising: he can serve no customers.In the third test case of the example, Denise can serve four visitors. The first guest will receive a full lunch of dumplings, a portion of cranberry juice and a pancake with condensed milk. The second visitor will get only dumplings. The third guest will receive a pancake with condensed milk, and the fourth guest will receive a pancake and a portion of dumplings. Please note that Denis hasn't used all of the prepared products, but is unable to serve more visitors.

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

main = getLine >>= test.read
test 0 = return ()
test n = getLine >>= print.solve1.map read.words >> test (n - 1)

solve1 as = length (filter (> 0) as) + solve2 (subtract 1 <$> as)
solve2 as
  | length (filter (> 0) as) < 2 = 0
  | length (filter (> 0) as) == 2 = 1
  | length (filter (> 1) as) == 0 = 1
  | length (filter (> 1) as) == 1 = 2
  | length (filter (> 1) as) == 2 = 2
  | otherwise = 3 + solve3 (subtract 2 <$> as)
solve3 as = fromEnum $ all (> 0) as

import Data.List as L

dec :: Int -> Int
dec n = n-1

solve' :: [String] -> Int -> Int -> Int -> Int -> Int
solve' [] ans _ _ _ = ans
solve' (option:others) ans a b c = case option of
                                    "A" -> if a /= 0 then solve' others (ans+1) (dec a) b c
                                                     else solve' others ans a b c
                                    "B" -> if b /= 0 then solve' others (ans+1) a (dec b) c
                                                     else solve' others ans a b c
                                    "C" -> if c /= 0 then solve' others (ans+1) a b (dec c)
                                                     else solve' others ans a b c
                                    "AB" -> if a/=0 && b/=0 then solve' others (ans+1) (dec a) (dec b) c
                                                            else solve' others ans a b c
                                    "BC" -> if b/=0 && c/=0 then solve' others (ans+1) a (dec b) (dec c)
                                                            else solve' others ans a b c
                                    "AC" -> if a/=0 && c/=0 then solve' others (ans+1) (dec a) b (dec c)
                                                            else solve' others ans a b c
                                    "ABC" -> if a/=0 && b/=0 && c/=0 then solve' others (ans+1) (dec a) (dec b) (dec c)
                                                                     else solve' others ans a b c

solve :: Int -> Int -> Int -> Int
solve a b c = solve' ["A", "B", "C", "AB", "BC", "AC", "ABC"] 0 c' b' a'
  where [a', b', c'] = L.sort [a, b, c]

parse :: String -> String
parse input = show $ solve a b c
  where [a, b, c] = map (\x -> read x :: Int) $ words input

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


You've got two numbers. As long as they are both larger than zero, they go through the same operation: subtract the lesser number from the larger one. If they equal substract one number from the another. For example, one operation transforms pair (4,17) to pair (4,13), it transforms (5,5) to (0,5).You've got some number of pairs (ai, bi). How many operations will be performed for each of them?

The first line contains the number of pairs n (1  ≤  n  ≤  1000). Then follow n lines, each line contains a pair of positive integers ai, bi (1  ≤  ai,  bi  ≤  109).

Print the sought number of operations for each pair on a single line.

module Main where

solve :: Int -> Int -> Int
solve 0 _ = 0
solve _ 0 = 0
solve a b
	| a >= b = (a `div` b) + solve b (a  `mod` b)
	| otherwise = solve b a

printSolution :: IO ()
printSolution = do
	numsStr <- getLine
	let [x, y] = map read $ words numsStr
	print $ solve x y

printNSolutions :: Int -> IO ()
printNSolutions 1 = printSolution
printNSolutions n = do
	printSolution
	printNSolutions (n-1)

main = getLine >>= (printNSolutions . read)

main = do
		args <- getContents
		let
			(n:xs) = words args
			ab = go xs
		mapM print $ map calc ab

go :: [String] -> [ (Int, Int) ]
go [] = []
go (a:b:xs) = (read a, read b):go xs

calc :: (Int, Int) -> Int
calc (a, b)
		| a == 0 = 0
		| b == 0 = 0
		| otherwise = div a b + calc(b, mod a b)

combine :: [Int] -> [(Int, Int)]
combine (a:(b:c)) = (a, b) : combine c
combine _         = []

ans :: (Int, Int) -> Int
ans (a, b)
    | a == 0 || b == 0 = 0
    | a <= b           = div b a + ans (a, mod b a)
    | otherwise        = ans (b, a)

printAns :: [Int] -> IO()
printAns (a:b) = do
    putStrLn (show a)
    printAns b
printAns _  = do
    putStr ""

main :: IO()
main = do
    str <- getContents
    let pairs = combine (map read ((tail . words) str))
    printAns (map ans pairs)

module Main where
import Prelude
solve :: Int -> Int -> Int
solve 0 _ = 0
solve _ 0 = 0
solve a b
      | a >= b = (a `div` b) + solve b (a `mod` b)
      | otherwise = solve b a

printSolution :: IO ()
printSolution = do
              numsStr <- getLine
              let nums = map (read :: String -> Int) $ words numsStr
              print $ solve (nums!!0) (nums!!1)

printNSolutions :: Int -> IO ()
printNSolutions 1 = printSolution
printNSolutions n = do
                  printSolution
                  printNSolutions (n-1)

main = do
     nStr <- getLine
     printNSolutions $ (read nStr :: Int)

-- http://codeforces.ru/problemset/problem/267/A
import Data.List
import Control.Monad
-- helpers
getInt = \x -> read x :: Int
getPair str = (getInt $ lst !! 0, getInt $ lst !! 1) where lst = words str

solve :: (Int,Int) -> Int
solve (_,0) = 0
solve (0,_) = 0
solve (x,y) =
  acc' + (solve (mn,rm))
  where
    (mn, mx) = (min x y, max x y)
    (acc', rm) = mx `divMod` mn

main = do
  count <- fmap getInt getLine
  pairs <- replicateM count getLine
  let ps = map getPair pairs
      ss = map solve ps
  mapM_ putStrLn $ map show ss
{-
Заданы два числа. До тех пор, пока оба они больше нуля, с ними производят одну и ту же операцию: из большего числа вычитают меньшее. Если числа равны, то из одного вычитают другое. Например, из пары (4,17) за одну операцию получается пара (4,13), а из пары (5,5) пара (0,5).

Вам задано некоторое количество пар (ai, bi). Сколько операций будет выполнено для каждой из них?

Входные данные
В первой строке задано количество пар n (1  ≤  n  ≤  1000). Далее идут n строк, каждая содержит пару целых положительных чисел ai, bi (1  ≤  ai,  bi  ≤  109).

Выходные данные
Выведите искомое количество операций для каждой пары на отдельной строке.

Примеры тестов
входные данные
2
4 17
7 987654321
выходные данные
8
141093479
-}

f [a,b] | a == 0 = 0 | a > b = f [b, a] | 1 > 0 = div b a + f [mod b a, a]
main = interact $ unlines . map (show . f . map read . words) . tail . lines

f [0, _] = 0
f [a, b]
  | a > b     = f [b, a]
  | otherwise = b `div` a + f [(b `mod` a), a]

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

{-# LANGUAGE ScopedTypeVariables #-}

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad.State.Strict
import Data.Int
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

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

calculateGcd a b
    | (a == 0) || (b == 0) = 0
    | otherwise = (calculateGcd b (a `mod` b)) + (a `div` b)

main :: IO ()
main = do
    n <- readB8Int <$> B8.getLine
    replicateM_ n $ do
        [a, b] <- (map readB8Int) <$> B8.words <$> B8.getLine
        printf "%d\n" $ calculateGcd a b

import Control.Monad
gcd' :: [Int] -> Int
gcd' [0, a] = 0
gcd' [a, b] = gcd' [(b`mod`a), a] + b `div` a
main = do
    n <- (fmap read getLine) :: IO Int
    list <- replicateM n $ (fmap (map read.words) getLine) :: IO [[Int]]
    let slist = [[(max a b), (min a b)] | [a, b] <- list]
    mapM print $ map gcd' slist

solve :: Int -> Int -> Int
solve 0 _ = 0
solve _ 0 = 0
solve n1 n2
	| n1 >= n2 = n1 `div` n2 + solve n2 (n1 `mod` n2)
	| otherwise = solve n2 n1

printSolution :: IO ()
printSolution = do
	numsStr <- getLine
	let [n1, n2] = map read $ words numsStr
	print $ solve n1 n2

printNSolutions :: Int -> IO ()
printNSolutions 1 = printSolution
printNSolutions n = do
	printSolution
	printNSolutions (n-1)

main = do
	nStr <- getLine
	printNSolutions $ read nStr

module Main where

solve :: Int -> Int -> Int
solve 0 _ = 0
solve _ 0 = 0
solve a b
      | a >= b = (a `div` b) + solve b (a `mod` b)
      | otherwise = solve b a

printSolution :: IO ()
printSolution = do
              numsStr <- getLine
              let nums = map (read :: String -> Int) $ words numsStr
              print $ solve (nums!!0) (nums!!1)

printNSolutions :: Int -> IO ()
printNSolutions 1 = printSolution
printNSolutions n = do
                  printSolution
                  printNSolutions (n-1)

main = do
     nStr <- getLine
     printNSolutions $ (read nStr :: Int)

main :: IO ()
main = do
	   n <-getLine
	   let num = read n
	   printSolve num

printSolve :: Int -> IO ()
printSolve 1 = solving
printSolve n = do
	           solving
	           printSolve (n-1)

solving :: IO ()
solving = do
	      numargs <- getLine
	      let [arg1, arg2] = map read $ words numargs
	      print $ solve arg1 arg2

solve :: Int -> Int -> Int
solve _ 0 = 0
solve 0 _ = 0
solve a b
      |a >= b = (a `div` b) + solve b (a `mod` b)
      |otherwise = solve b a

{-# LANGUAGE BangPatterns #-}
main=interact$unlines.map show.f.tail.map read.words
f(x:y:rest)=g 0 x y : f rest
f _ = []

g !ans !x !y
  | x==0 || y==0 = ans
  | x < y = let (!q,!r) = quotRem y x in g (ans+q) r x
  | x > y = let (!q,!r) = quotRem x y in g (ans+q) r y
  | otherwise = ans + 1

main = do
	args <- getContents
	let
		(n:xs) = words args
		ab = cov xs
	mapM print $ map cal ab

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

cal :: (Int,Int) -> Int
cal (x,y)
	| y == 0 = 0
	| otherwise = x `div` y + cal (y,(x `mod` y))

solve :: Int -> Int -> Int
solve a b
    | a == 0 || b == 0 = 0
    | a >= b = (a `div` b) + solve b (a `mod` b)
    | otherwise = solve b a

printSolution :: IO ()
printSolution = do
    numsStr <- getLine
    let nums = map (read :: String -> Int) $ words numsStr
    print $ solve (nums!!0) (nums!!1)

printNSolutions :: Int -> IO ()
printNSolutions 0 = return ()
printNSolutions n = do
    printSolution
    printNSolutions (n-1)

main = do
    nStr <- getLine
    printNSolutions (read nStr :: Int)

import Data.Char
import Data.List

ans [a,0] = 0
ans [a,b] = a`div`b + ans [b,(a`mod`b)]

main = do
    n<-getLine
    a<-getContents
    let input = map  (map (\x->read x::Int)) (map words $ lines a)
    putStrLn.unlines $ map show $ map ans input

solve :: Int -> Int -> Int
solve 0 _ = 0
solve _ 0 = 0
solve a b
      | a >= b = (a `div` b) + solve b (a `mod` b)
      | otherwise = solve b a

printSolution :: IO ()
printSolution =   do
                     numsStr <- getLine
                     let [ n1, n2 ] = map read $ words numsStr
                     print $ solve n1 n2

printNSolutions :: Int -> IO ()
printNSolutions 1 =  printSolution
printNSolutions n =  do
                     printSolution
                     printNSolutions ( n - 1 )

main = getLine >>= ( printNSolutions . read )

{-# LANGUAGE BangPatterns #-}
main=interact$unlines.map show.f.tail.map read.words
f(x:y:rest)=g 0 x y : f rest
f _ = []

g !ans !x !y
  | x==0 || y==0 = ans
  | x < y = let (!q,!r) = quotRem y x in g (ans+q) r x
  | x > y = let (!q,!r) = quotRem y x in g (ans+q) r y
  | otherwise = 1

{-# LANGUAGE BangPatterns #-}
main=interact$unlines.map show.f.tail.map read.words
f(x:y:rest)=g 0 x y : f rest
f _ = []

g !ans !x !y
  | x==0 || y==0 = ans
  | x < y = let (!q,!r) = quotRem y x in g (ans+q) r x
  | x > y = let (!q,!r) = quotRem y x in g (ans+q) r y
  | otherwise = ans + 1

{-# LANGUAGE BangPatterns #-}
main=interact$unlines.map show.f.tail.map read.words
f(x:y:rest)=g 0 x y : f rest
f _ = []

g !ans !x !y
  | x==0 || y==0 = ans
  | x < y = let (!q,!r) = quotRem y x in g (ans+q) r x
  | x > y = let (!q,!r) = quotRem y x in g (ans+q) r y
  | otherwise = 2


Polycarp wrote on a whiteboard an array $$$p$$$ of length $$$n$$$, which is a permutation of numbers from $$$1$$$ to $$$n$$$. In other words, in $$$p$$$ each number from $$$1$$$ to $$$n$$$ occurs exactly once.He also prepared a resulting array $$$a$$$, which is initially empty (that is, it has a length of $$$0$$$).After that, he did exactly $$$n$$$ steps. Each step looked like this:  Look at the leftmost and rightmost elements of $$$p$$$, and pick the smaller of the two. If you picked the leftmost element of $$$p$$$, append it to the left of $$$a$$$; otherwise, if you picked the rightmost element of $$$p$$$, append it to the right of $$$a$$$. The picked element is erased from $$$p$$$. Note that on the last step, $$$p$$$ has a length of $$$1$$$ and its minimum element is both leftmost and rightmost. In this case, Polycarp can choose what role the minimum element plays. In other words, this element can be added to $$$a$$$ both on the left and on the right (at the discretion of Polycarp).Let's look at an example. Let $$$n=4$$$, $$$p=[3, 1, 4, 2]$$$. Initially $$$a=[]$$$. Then: During the first step, the minimum is on the right (with a value of $$$2$$$), so after this step, $$$p=[3,1,4]$$$ and $$$a=[2]$$$ (he added the value $$$2$$$ to the right).  During the second step, the minimum is on the left (with a value of $$$3$$$), so after this step, $$$p=[1,4]$$$ and $$$a=[3,2]$$$ (he added the value $$$3$$$ to the left).  During the third step, the minimum is on the left (with a value of $$$1$$$), so after this step, $$$p=[4]$$$ and $$$a=[1,3,2]$$$ (he added the value $$$1$$$ to the left).  During the fourth step, the minimum is both left and right (this value is $$$4$$$). Let's say Polycarp chose the right option. After this step, $$$p=[]$$$ and $$$a=[1,3,2,4]$$$ (he added the value $$$4$$$ to the right).Thus, a possible value of $$$a$$$ after $$$n$$$ steps could be $$$a=[1,3,2,4]$$$.You are given the final value of the resulting array $$$a$$$. Find any possible initial value for $$$p$$$ that can result the given $$$a$$$, or determine that there is no solution.

The first line of the input contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the test. Each test case consists of two lines. The first of them contains an integer $$$n$$$ ($$$1 \le n \le 2\cdot10^5$$$) — the length of the array $$$a$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$) — the elements of the array $$$a$$$. All elements of the $$$a$$$ array are distinct numbers. It is guaranteed that the sum of the values $$$n$$$ over all test cases in the test does not exceed $$$2\cdot10^5$$$.

Print $$$t$$$ lines, each of the lines must contain the answer to the corresponding set of input data: numbers $$$p_1, p_2, \dots, p_n$$$  — any of the possible initial values of the array $$$p$$$, which will lead to the given array $$$a$$$. All elements of $$$p$$$ are distinct integers from $$$1$$$ to $$$n$$$. Thus, if there are several solutions, print any. If there is no solution, then print -1 on the line.

NoteThe first test case in the example is clarified in the main section of the problem statement. There may be other correct answers for this test set.In the second test case, $$$n=1$$$. Thus, there is only one permutation that can be the answer: $$$p=[1]$$$. Indeed, this is the answer to this test case.In the third test case of the example, no matter what permutation you take as $$$p$$$, after applying the $$$n$$$ steps, the result will differ from $$$a=[1, 3, 5, 4, 2]$$$.

{-# LANGUAGE MultiWayIf, TypeApplications, OverloadedStrings #-}

import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Internal as BSI
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Maybe

cf x = readLn >>= (`replicateM_` x)

r p bs =
  let l = BS.length bs
   in fmap (BS.index bs) [l - 1,l - 2 .. 0]

main =
  cf $ do
    len <- readLn @Int
    line <- BS.getLine
    let p = not . BSI.isSpaceChar8
        n1 = (read @Int) $ reverse $ head $ words $ r p line
        n2 = fst $ fromJust $ BS.readInt $ BS.takeWhile p line
    BS.putStr $
      if n1 == len || n2 == len
        then BS.intercalate " " $ reverse $ BS.words line
        else "-1"
    putStrLn ""

{-# LANGUAGE MultiWayIf, TypeApplications #-}

import Control.Monad

main = do
  numCases <- readLn
  replicateM_ numCases $ do
    len <- readLn @Int
    nums_ <- getLine
    let nums = words $ nums_
    putStrLn $
      if read (head nums) == len || read (last nums) == len
        then unwords $ reverse nums
        else "-1"


You are given an array consisting of $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$. Initially $$$a_x = 1$$$, all other elements are equal to $$$0$$$.You have to perform $$$m$$$ operations. During the $$$i$$$-th operation, you choose two indices $$$c$$$ and $$$d$$$ such that $$$l_i \le c, d \le r_i$$$, and swap $$$a_c$$$ and $$$a_d$$$.Calculate the number of indices $$$k$$$ such that it is possible to choose the operations so that $$$a_k = 1$$$ in the end.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then the description of $$$t$$$ testcases follow. The first line of each test case contains three integers $$$n$$$, $$$x$$$ and $$$m$$$ ($$$1 \le n \le 10^9$$$; $$$1 \le m \le 100$$$; $$$1 \le x \le n$$$). Each of next $$$m$$$ lines contains the descriptions of the operations; the $$$i$$$-th line contains two integers $$$l_i$$$ and $$$r_i$$$ ($$$1 \le l_i \le r_i \le n$$$).

For each test case print one integer — the number of indices $$$k$$$ such that it is possible to choose the operations so that $$$a_k = 1$$$ in the end.

NoteIn the first test case, it is possible to achieve $$$a_k = 1$$$ for every $$$k$$$. To do so, you may use the following operations:  swap $$$a_k$$$ and $$$a_4$$$;  swap $$$a_2$$$ and $$$a_2$$$;  swap $$$a_5$$$ and $$$a_5$$$. In the second test case, only $$$k = 1$$$ and $$$k = 2$$$ are possible answers. To achieve $$$a_1 = 1$$$, you have to swap $$$a_1$$$ and $$$a_1$$$ during the second operation. To achieve $$$a_2 = 1$$$, you have to swap $$$a_1$$$ and $$$a_2$$$ during the second operation.

import Control.Monad

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

routine :: IO ()
routine = do
  [_,x,m] <- (map read.words) <$> getLine
  lrs <- replicateM m ((map read.words) <$> getLine)
  print $ solve x lrs

solve :: Int -> [[Int]] -> Int
solve x lrs = b+1-a
  where
    (a,b) = solveRec (x,x) lrs

solveRec :: (Int,Int) -> [[Int]] -> (Int,Int)
solveRec p [] = p
solveRec (lo,hi) ([nlo,nhi]:xs) = if ok then solveRec (min lo nlo, max hi nhi) xs else solveRec (lo,hi) xs
  where
    ok = ((nlo <= hi) && (hi <= nhi))  || ((nlo <= lo) && (lo <= nhi))
solveRec _ _ = undefined