A TV show called "Guess a number!" is gathering popularity. The whole Berland, the old and the young, are watching the show.The rules are simple. The host thinks of an integer y and the participants guess it by asking questions to the host. There are four types of acceptable questions:  Is it true that y is strictly larger than number x?  Is it true that y is strictly smaller than number x?  Is it true that y is larger than or equal to number x?  Is it true that y is smaller than or equal to number x? On each question the host answers truthfully, "yes" or "no".Given the sequence of questions and answers, find any integer value of y that meets the criteria of all answers. If there isn't such value, print "Impossible".

The first line of the input contains a single integer n (1 ≤ n ≤ 10000) — the number of questions (and answers). Next n lines each contain one question and one answer to it. The format of each line is like that: "sign x answer", where the sign is:   ">" (for the first type queries),  "<" (for the second type queries),  ">=" (for the third type queries),  "<=" (for the fourth type queries).  All values of x are integer and meet the inequation  - 109 ≤ x ≤ 109. The answer is an English letter "Y" (for "yes") or "N" (for "no"). Consequtive elements in lines are separated by a single space.

Print any of such integers y, that the answers to all the queries are correct. The printed number y must meet the inequation  - 2·109 ≤ y ≤ 2·109. If there are many answers, print any of them. If such value doesn't exist, print word "Impossible" (without the quotes).

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

normalize :: C.ByteString -> C.ByteString -> Int -> (Ordering, Int)
normalize "Y" ">"  x = (GT, x)
normalize "Y" "<"  x = (LT, x)
normalize "Y" ">=" x = (GT, x - 1)
normalize "Y" "<=" x = (LT, x + 1)
normalize "N" ">"  x = (LT, x + 1)
normalize "N" "<"  x = (GT, x - 1)
normalize "N" ">=" x = (LT, x)
normalize "N" "<=" x = (GT, x)
normalize _ _ _ = undefined

main :: IO ()
main = do
  n <- readInt <$> C.getLine
  qna <- replicateM n $ do
    [sign, x, answer] <- C.words <$> C.getLine
    return $ normalize answer sign $ readInt x
  let gt = [j | (i, j) <- qna, i == GT]
      lt = [j | (i, j) <- qna, i == LT]
      gtmax = maximum gt
      ltmin = minimum lt
  if null gt then print $ ltmin - 1
  else if null lt || gtmax + 1 <= ltmin - 1 then print $ gtmax + 1
  else putStrLn "Impossible"

main=interact$maybe "Impossible" show.solve.parse.tail.words

solve :: [Either Int Int] -> Maybe Int
solve xs = go (-2000000000) 2000000000 xs
   where
     go l r (Left i:xs) = go (max l i) r xs
     go l r (Right i:xs) = go l (min r i) xs
     go l r []
       | l <= r = Just l
       | otherwise = Nothing

parse :: [String] -> [Either Int Int]
parse (">":i:"Y":cs) = Left (read i+1) : parse cs
parse (">=":i:"Y":cs) = Left (read i) : parse cs
parse ("<":i:"Y":cs) = Right (read i-1) : parse cs
parse ("<=":i:"Y":cs) = Right (read i) : parse cs
parse (">":i:"N":cs) = parse ("<=":i:"Y":cs)
parse (">=":i:"N":cs) = parse ("<":i:"Y":cs)
parse ("<":i:"N":cs) = parse (">=":i:"Y":cs)
parse ("<=":i:"N":cs) = parse (">":i:"Y":cs)
parse _ = []

{-# LANGUAGE MultiWayIf #-}

import Control.Monad

data Compare = LE | GE

data Query = Q Compare Int

apply :: (Int,Int) -> Query -> Maybe (Int,Int)
apply (lo,hi) (Q LE val)
  | val < lo  = Nothing
  | otherwise = Just (lo, min val hi)
apply (lo,hi) (Q GE val)
  | val > hi = Nothing
  | otherwise = Just (max lo val, hi)

complement :: Query -> Query
complement (Q LE v) = Q GE (v+1)
complement (Q GE v) = Q LE (v-1)

readQuery :: String -> Query
readQuery str =
  let (op:vs:bs:_) = words str
      v = read vs
      q1 = if | op == ">=" -> Q GE v
              | op == "<=" -> Q LE v
              | op == ">"  -> Q GE (v+1)
              | op == "<"  -> Q LE (v-1)
      q2 = if bs == "Y" then q1 else complement q1
  in q2

main = do
  n <- fmap read getLine
  queries <- replicateM n $ do fmap readQuery getLine
  let inf = 2*10^9 :: Int
  let loop r []     = Just r
      loop r (q:qs) = case apply r q of
                        Nothing -> Nothing
                        Just r' -> loop r' qs
      r = loop (-inf,inf) queries
  case r of
    Nothing      -> putStrLn "Impossible"
    Just (lo,hi) -> putStrLn $ show hi

import Control.Applicative
import Control.Monad
import Data.Maybe (fromJust)

data InequalitySign = LARGERT | SMALLERT | LTE | STE
                    deriving (Eq)

reverseSign LARGERT = STE
reverseSign SMALLERT = LTE
reverseSign LTE = SMALLERT
reverseSign STE = LARGERT

toInequality ">" = LARGERT
toInequality "<" = SMALLERT
toInequality ">=" = LTE
toInequality "<=" = STE

translate [a,b,c] = if c == "Y" then (i, read b) else (reverseSign i, read b)
  where i = toInequality a

main = do
  n <- readLn
  xs <- replicateM n (translate . words <$> getLine)
  let
    f [] (lb,ub) = if lb < ub then Just (lb, ub) else Nothing
    f ((i,x):ys) (lb,ub)
      | i == LARGERT = if x-1 >= ub
                  then Nothing
                  else f ys (max (x+1) lb, ub)
      | i == SMALLERT = if x <= lb
                  then Nothing
                  else f ys (lb, min x ub)
      | i == LTE = if x >= ub
                   then Nothing
                   else f ys (max x lb, ub)
      | i == STE = if x < lb
                   then Nothing
                   else f ys (lb, min (x+1) ub)
    b = f xs (-1000000010, 1000000010)
    result = if b == Nothing then "Impossible" else show . fst $ fromJust b
    in putStrLn $ result

import Control.Monad
import Data.Maybe

solve :: [String] -> Maybe Int
solve ss = if l > r then Nothing
                    else Just l
    where (l, r) = hlp (-2*10^9, 2*10^9) ss
          hlp :: (Int, Int) -> [String] -> (Int, Int)
          hlp (a, b) [] = (a, b)
          hlp (a, b) (s:ts) =
              if ((sgn == ">=") && (ans == "Y")) || ((sgn == "<") && (ans == "N")) then
                  if n > a then hlp (n, b) ts
                           else hlp (a, b) ts
              else if ((sgn == "<=") && (ans == "Y")) || ((sgn == ">") && (ans == "N")) then
                  if n < b then hlp (a, n) ts
                           else hlp (a, b) ts
              else if ((sgn == "<") && (ans == "Y")) || ((sgn == ">=") && (ans == "N")) then
                  if n-1 < b then hlp (a, n-1) ts
                             else hlp (a, b) ts
              else if ((sgn == ">") && (ans == "Y")) || ((sgn == "<=") && (ans == "N")) then
                  if n+1 > a then hlp (n+1, b) ts
                             else hlp (a, b) ts
              else (a, b)
              where [sgn, n', ans] = words s
                    n = read n'

main = do
    n <- fmap read getLine
    lst <- forM [1..n] (\_ -> getLine)
    let solution = solve lst
    if isNothing solution then putStrLn "Impossible"
                          else print (fromJust solution)

{-# LANGUAGE BangPatterns #-}
main=interact$maybe "Impossible" show.solve.parse.tail.words

solve :: [Either Int Int] -> Maybe Int
solve xs = go (-2000000000) 2000000000 xs
   where
     go !l !r (Left i:xs) = go (max l i) r xs
     go !l !r (Right i:xs) = go l (min r i) xs
     go !l !r []
       | l <= r = Just l
       | otherwise = Nothing

parse :: [String] -> [Either Int Int]
parse (">":i:"Y":cs) = Left (read i+1) : parse cs
parse (">=":i:"Y":cs) = Left (read i) : parse cs
parse ("<":i:"Y":cs) = Right (read i-1) : parse cs
parse ("<=":i:"Y":cs) = Right (read i) : parse cs
parse (">":i:"N":cs) = parse ("<=":i:"Y":cs)
parse (">=":i:"N":cs) = parse ("<":i:"Y":cs)
parse ("<":i:"N":cs) = parse (">=":i:"Y":cs)
parse ("<=":i:"N":cs) = parse (">":i:"Y":cs)
parse _ = []

import Data.Maybe

data Var = Gt

process :: Integer -> Integer -> [[String]] -> Maybe Integer
process a b _ | a > b = Nothing
process a _ [] = Just a
process a b ((sign:x:"N":[]):other_lines) = process a b ((oposite sign:x:"Y":[]):other_lines)

process a b ((">=":x:"Y":[]):other_lines) = process (max a $ read x) b other_lines
process a b ((">":x:"Y":[]):other_lines) = process (max a $ 1 + read x) b other_lines
process a b (("<":x:"Y":[]):other_lines) = process a (min b $ -1 + read x) other_lines
process a b (("<=":x:"Y":[]):other_lines) = process a (min b $ read x) other_lines

oposite ">=" = "<"
oposite "<=" = ">"
oposite "<" = ">="
oposite ">" = "<="

main = do
        n <- read `fmap` getLine
        my_lines <- sequence $ replicate n getLine

        let
            res = process (-2000000000) 2000000000 (map words my_lines)

        putStrLn $ if res == Nothing then "Impossible" else show $ fromJust res

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

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

transform :: String -> String -> Int -> (Ordering, Int)
transform "Y" ">=" x = (GT, x-1)
transform "N" ">=" x = (LT, x)
transform "Y" "<=" x = (LT, x+1)
transform "N" "<=" x = (GT, x)
transform "Y" ">" x = (GT, x)
transform "N" ">" x = (LT, x+1)
transform "Y" "<" x = (LT, x)
transform "N" "<" x = (GT, x-1)
transform _ _ _ = undefined

main :: IO ()
main = do
  n <- readInt <$> C.getLine
  array <- replicateM n $ do
    [symbol, x, ans] <- C.words <$> C.getLine
    return $ transform (C.unpack ans) (C.unpack symbol) (readInt x)
  let lt = [y | (x,y) <- array, x == LT]
      gt = [y | (x,y) <- array, x == GT]
      ltmi = minimum lt
      gtmx = maximum gt
  if null lt then print $ gtmx + 1
  else if null gt then print $ ltmi - 1
  else if ltmi - 1 > gtmx then print $ ltmi - 1
  else putStrLn "Impossible"

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections, BangPatterns, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

data Answer = Lt !Int | Geq !Int

neg :: Answer -> Answer
neg (Lt a) = Geq a
neg (Geq a) = Lt a

inputAnswer :: IO Answer
inputAnswer = do
	[sign, ns, ts] <- words <$> getLine
	let n :: Int = read ns
	let t = ts == "Y"
	let ans = case sign of
		">=" -> Geq n
		"<" -> Lt n
		">" -> Geq (n + 1)
		"<=" -> Lt (n + 1)
	return $ if t then ans else neg ans

solve :: [Answer] -> Maybe Int
solve = go (-2^30, 2^30)
	where
		go (a,b) [] | a < b = Just a
		go (a,b) (Lt x : xs) = go (a, min b x) xs
		go (a,b) (Geq x : xs) = go (max a x, b) xs
		go _ _ = Nothing

main :: IO ()
main = do
	n <- inputInt
	a <- replicateM n inputAnswer
	case solve a of
		Just x -> print x
		Nothing -> putStrLn "Impossible"

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

normalize :: C.ByteString -> C.ByteString -> Int -> (Ordering, Int)
normalize "Y" ">"  x = (GT, x)
normalize "Y" "<"  x = (LT, x)
normalize "Y" ">=" x = (GT, x + 1)
normalize "Y" "<=" x = (LT, x - 1)
normalize "N" ">"  x = (LT, x + 1)
normalize "N" "<"  x = (GT, x - 1)
normalize "N" ">=" x = (LT, x)
normalize "N" "<=" x = (GT, x)
normalize _ _ _ = undefined

main :: IO ()
main = do
  n <- readInt <$> C.getLine
  qna <- replicateM n $ do
    [sign, x, answer] <- C.words <$> C.getLine
    return $ normalize answer sign $ readInt x
  let gt = [j | (i, j) <- qna, i == GT]
      lt = [j | (i, j) <- qna, i == LT]
      gtmax = maximum gt
      ltmin = minimum lt
  if null gt then print $ ltmin - 1
  else if null lt || gtmax + 1 <= ltmin - 1 then print $ gtmax + 1
  else putStrLn "Impossible"

{-# LANGUAGE MultiWayIf #-}

import Control.Monad

data Compare = LE | GE

data Query = Q Compare Int

apply :: (Int,Int) -> Query -> Maybe (Int,Int)
apply (lo,hi) (Q LE val)
  | val < lo  = Nothing
  | otherwise = Just (lo, min val hi)
apply (lo,hi) (Q GE val)
  | val > hi = Nothing
  | otherwise = Just (max lo val, hi)

complement :: Query -> Query
complement (Q LE v) = Q GE (v+1)
complement (Q GE v) = Q LE (v-1)

readQuery :: String -> Query
readQuery str =
  let (op:vs:bs:_) = words str
      v = read vs
      q1 = if | op == ">=" -> Q GE v
              | op == "<=" -> Q LE v
              | op == ">"  -> Q GE (v+1)
              | op == "<"  -> Q LE (v-1)
      q2 = if bs == "Y" then q1 else complement q1
  in q2

main = do
  n <- fmap read getLine
  queries <- replicateM n $ do fmap readQuery getLine
  let inf = 10^9 :: Int
  let loop r []     = Just r
      loop r (q:qs) = case apply r q of
                        Nothing -> Nothing
                        Just r' -> loop r' qs
      r = loop (-inf,inf) queries
  case r of
    Nothing      -> putStrLn "Impossible"
    Just (lo,hi) -> putStrLn $ show (min hi 2*10^9)

{-# LANGUAGE MultiWayIf #-}

import Control.Monad

data Compare = LE | GE

data Query = Q Compare Int

apply :: (Int,Int) -> Query -> Maybe (Int,Int)
apply (lo,hi) (Q LE val)
  | val < lo  = Nothing
  | otherwise = Just (lo, min val hi)
apply (lo,hi) (Q GE val)
  | val > hi = Nothing
  | otherwise = Just (max lo val, hi)

complement :: Query -> Query
complement (Q LE v) = Q GE (v+1)
complement (Q GE v) = Q LE (v-1)

readQuery :: String -> Query
readQuery str =
  let (op:vs:bs:_) = words str
      v = read vs
      q1 = if | op == ">=" -> Q GE v
              | op == "<=" -> Q LE v
              | op == ">"  -> Q GE (v+1)
              | op == "<"  -> Q LE (v-1)
      q2 = if bs == "Y" then q1 else complement q1
  in q2

main = do
  n <- fmap read getLine
  queries <- replicateM n $ do fmap readQuery getLine
  let inf = 10^9 :: Int
  let loop r []     = Just r
      loop r (q:qs) = case apply r q of
                        Nothing -> Nothing
                        Just r' -> loop r' qs
      r = loop (-inf,inf) queries
  case r of
    Nothing      -> putStrLn "Impossible"
    Just (lo,hi) -> putStrLn $ show (min hi (2*10^9))

import Control.Applicative
import Control.Monad
import Data.Maybe (fromJust)

data InequalitySign = LARGERT | SMALLERT | LTE | STE
                    deriving (Eq)

reverseSign LARGERT = STE
reverseSign SMALLERT = LTE
reverseSign LTE = SMALLERT
reverseSign STE = LARGERT

toInequality ">" = LARGERT
toInequality "<" = SMALLERT
toInequality ">=" = LTE
toInequality "<=" = STE

translate [a,b,c] = if c == "Y" then (i, read b) else (reverseSign i, read b)
  where i = toInequality a

main = do
  n <- readLn
  xs <- replicateM n (translate . words <$> getLine)
  let
    f [] bound = Just bound
    f ((i,x):ys) (lb,ub)
      | i == LARGERT = if x-1 >= ub
                  then Nothing
                  else f ys (max (x-1) lb, ub)
      | i == SMALLERT = if x <= lb
                  then Nothing
                  else f ys (lb, min x ub)
      | i == LTE = if x >= ub
                   then Nothing
                   else f ys (max x lb, ub)
      | i == STE = if x < lb
                   then Nothing
                   else f ys (lb, min (x+1) ub)
    b = f xs (-1000000000, 1000000001)
    result = if b == Nothing then "Impossible" else show . fst $ fromJust b
    in putStrLn $ result

import Control.Applicative
import Control.Monad
import Data.Maybe (fromJust)

data InequalitySign = LARGERT | SMALLERT | LTE | STE
                    deriving (Eq)

reverseSign LARGERT = STE
reverseSign SMALLERT = LTE
reverseSign LTE = SMALLERT
reverseSign STE = LARGERT

toInequality ">" = LARGERT
toInequality "<" = SMALLERT
toInequality ">=" = LTE
toInequality "<=" = STE

translate [a,b,c] = if c == "Y" then (i, read b) else (reverseSign i, read b)
  where i = toInequality a

main = do
  n <- readLn
  xs <- replicateM n (translate . words <$> getLine)
  let
    f [] bound = Just bound
    f ((i,x):ys) (lb,ub)
      | i == LARGERT = if x-1 >= ub
                  then Nothing
                  else f ys (max (x+1) lb, ub)
      | i == SMALLERT = if x <= lb
                  then Nothing
                  else f ys (lb, min x ub)
      | i == LTE = if x >= ub
                   then Nothing
                   else f ys (max x lb, ub)
      | i == STE = if x < lb
                   then Nothing
                   else f ys (lb, min (x+1) ub)
    b = f xs (-1000000000, 1000000001)
    result = if b == Nothing then "Impossible" else show . fst $ fromJust b
    in putStrLn $ result

import Control.Applicative
import Control.Monad
import Data.Maybe (fromJust)

data InequalitySign = LARGERT | SMALLERT | LTE | STE
                    deriving (Eq)

reverseSign LARGERT = STE
reverseSign SMALLERT = LTE
reverseSign LTE = SMALLERT
reverseSign STE = LARGERT

toInequality ">" = LARGERT
toInequality "<" = SMALLERT
toInequality ">=" = LTE
toInequality "<=" = STE

translate [a,b,c] = if c == "Y" then (i, read b) else (reverseSign i, read b)
  where i = toInequality a

main = do
  n <- readLn
  xs <- replicateM n (translate . words <$> getLine)
  let
    f [] bound = Just bound
    f ((i,x):ys) (lb,ub)
      | i == LARGERT = if x-1 >= ub
                  then Nothing
                  else f ys (max (x+1) lb, ub)
      | i == SMALLERT = if x <= lb
                  then Nothing
                  else f ys (lb, min x ub)
      | i == LTE = if x >= ub
                   then Nothing
                   else f ys (max x lb, ub)
      | i == STE = if x < lb
                   then Nothing
                   else f ys (lb, min (x+1) ub)
    b = f xs (-1000000010, 1000000010)
    result = if b == Nothing then "Impossible" else show . fst $ fromJust b
    in putStrLn $ result

import Control.Monad
import Data.Maybe

solve :: [String] -> Maybe Int
solve ss = if l > r then Nothing
                    else Just l
    where (l, r) = hlp (-10^9, 10^9) ss
          hlp :: (Int, Int) -> [String] -> (Int, Int)
          hlp (a, b) [] = (a, b)
          hlp (a, b) (s:ts) =
              if ((sgn == ">=") && (ans == "Y")) || ((sgn == "<") && (ans == "N")) then
                  if n > a then hlp (n, b) ts
                           else hlp (a, b) ts
              else if ((sgn == "<=") && (ans == "Y")) || ((sgn == ">") && (ans == "N")) then
                  if n < b then hlp (a, n) ts
                           else hlp (a, b) ts
              else if ((sgn == "<") && (ans == "Y")) || ((sgn == ">=") && (ans == "N")) then
                  if n-1 < b then hlp (a, n-1) ts
                             else hlp (a, b) ts
              else if ((sgn == ">") && (ans == "Y")) || ((sgn == "<=") && (ans == "N")) then
                  if n+1 > a then hlp (n+1, b) ts
                             else hlp (a, b) ts
              else (a, b)
              where [sgn, n', ans] = words s
                    n = read n'

main = do
    n <- fmap read getLine
    lst <- forM [1..n] (\_ -> getLine)
    let solution = solve lst
    if isNothing solution then putStrLn "Impossible"
                          else print (fromJust solution)

import Control.Monad
import Data.Maybe

solve :: [String] -> Maybe Int
solve ss = if l > r then Nothing
                    else Just l
    where (l, r) = hlp (-10^9, 10^9) ss
          hlp :: (Int, Int) -> [String] -> (Int, Int)
          hlp (a, b) [] = (a, b)
          hlp (a, b) (s:ts) =
              if ((sgn == ">=") && (ans == "Y")) || ((sgn == "<") && (ans == "N")) then
                  if n > a then hlp (n, b) ts
                           else hlp (a, b) ts
              else if ((sgn == "<=") && (ans == "Y")) || ((sgn == ">") && (ans == "N")) then
                  if n < b then hlp (a, n) ts
                           else hlp (a, b) ts
              else if ((sgn == "<") && (ans == "Y")) || ((sgn == ">=") && (ans == "N")) then
                  if n-1 < b then hlp (a, n-1) ts
                             else hlp (a, b) ts
              else if ((sgn == ">") && (ans == "Y")) || ((sgn == "<=") && (ans == "N")) then
                  if n-1 > a then hlp (n-1, b) ts
                             else hlp (a, b) ts
              else (a, b)
              where [sgn, n', ans] = words s
                    n = read n'

main = do
    n <- fmap read getLine
    lst <- forM [1..n] (\_ -> getLine)
    let solution = solve lst
    if isNothing solution then putStrLn "Impossible"
                          else print (fromJust solution)

import Data.Maybe

data Var = Gt

process :: Integer -> Integer -> [[String]] -> Maybe Integer
process a b _ | a > b = Nothing
process a _ [] = Just a
process a b ((sign:x:"N":[]):other_lines) = process a b ((oposite sign:x:"Y":[]):other_lines)

process a b ((">=":x:"Y":[]):other_lines) = process (read x) b other_lines
process a b ((">":x:"Y":[]):other_lines) = process (1 + read x) b other_lines
process a b (("<":x:"Y":[]):other_lines) = process a (-1 + read x) other_lines
process a b (("<=":x:"Y":[]):other_lines) = process a (read x) other_lines

oposite ">=" = "<"
oposite "<=" = ">"
oposite "<" = ">="
oposite ">" = "<="

main = do
        n <- read `fmap` getLine
        my_lines <- sequence $ replicate n getLine

        let
            res = process (-2000000000) 2000000000 (map words my_lines)

        putStrLn $ if res == Nothing then "Impossible" else show $ fromJust res

import Data.Maybe

data Var = Gt

process :: Int -> Int -> [[String]] -> Maybe Int
process a b _ | a > b = Nothing
process a _ [] = Just a
process a b ((sign:x:"N":[]):other_lines) = process a b ((oposite sign:x:"Y":[]):other_lines)

process a b ((">=":x:"Y":[]):other_lines) = process (read x) b other_lines
process a b ((">":x:"Y":[]):other_lines) = process (1 + read x) b other_lines
process a b (("<":x:"Y":[]):other_lines) = process a (-1 + read x) other_lines
process a b (("<=":x:"Y":[]):other_lines) = process a (read x) other_lines

oposite ">=" = "<"
oposite "<=" = ">"
oposite "<" = ">="
oposite ">" = "<="

main = do
        n <- read `fmap` getLine
        my_lines <- sequence $ replicate n getLine

        let
            res = process (-2000000000) 2000000000 (map words my_lines)

        putStrLn $ if res == Nothing then "Impossible" else show $ fromJust res

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections, BangPatterns, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

data Answer = Lt !Int | Geq !Int

neg :: Answer -> Answer
neg (Lt a) = Geq a
neg (Geq a) = Lt a

inputAnswer :: IO Answer
inputAnswer = do
	[sign, ns, ts] <- words <$> getLine
	let n :: Int = read ns
	let t = ts == "Y"
	let ans = case sign of
		">=" -> Geq n
		"<" -> Lt n
		">" -> Geq (n + 1)
		"<=" -> Lt (n + 1)
	return $ if t then ans else neg ans

solve :: [Answer] -> Maybe Int
solve = go (-10^9, 10^9)
	where
		go (a,b) [] | a < b = Just a
		go (a,b) (Lt x : xs) = go (a, min b x) xs
		go (a,b) (Geq x : xs) = go (max a x, b) xs
		go _ _ = Nothing

main :: IO ()
main = do
	n <- inputInt
	a <- replicateM n inputAnswer
	case solve a of
		Just x -> print x
		Nothing -> putStrLn "Impossible"

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections, BangPatterns, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

data Answer = Lt !Int | Geq !Int

neg :: Answer -> Answer
neg (Lt a) = Geq a
neg (Geq a) = Lt a

inputAnswer :: IO Answer
inputAnswer = do
	[sign, ns, ts] <- words <$> getLine
	let n :: Int = read ns
	let t = ts == "Y"
	let ans = case sign of
		">=" -> Geq n
		"<" -> Lt n
		">" -> Geq (n + 1)
		"<=" -> Lt (n - 1)
	return $ if t then ans else neg ans

solve :: [Answer] -> Maybe Int
solve = go (-10^9, 10^9)
	where
		go (a,b) [] | a < b = Just a
		go (a,b) (Lt x : xs) = go (a, min b x) xs
		go (a,b) (Geq x : xs) = go (max a x, b) xs
		go _ _ = Nothing

main :: IO ()
main = do
	n <- inputInt
	a <- replicateM n inputAnswer
	case solve a of
		Just x -> print x
		Nothing -> putStrLn "Impossible"


Recently, Anton has found a set. The set consists of small English letters. Anton carefully wrote out all the letters from the set in one line, separated by a comma. He also added an opening curved bracket at the beginning of the line and a closing curved bracket at the end of the line. Unfortunately, from time to time Anton would forget writing some letter and write it again. He asks you to count the total number of distinct letters in his set.

The first and the single line contains the set of letters. The length of the line doesn't exceed 1000. It is guaranteed that the line starts from an opening curved bracket and ends with a closing curved bracket. Between them, small English letters are listed, separated by a comma. Each comma is followed by a space.

Print a single number — the number of distinct letters in Anton's set.

check [] y           = length y
check (x:xs) y
  | not (x `elem` y) = check xs (x:y)
  | otherwise        = check xs y

trim = f . f . filter (/=',') where f = reverse . drop 1

main = getLine >>= return . (flip check) [] . words . trim >>= putStrLn . show

import Data.List

main :: IO()
main = interact $ show . length . nub . filter (\c -> 'a' <= c && c <= 'z')

import Data.Set as Set
import Data.Char

main = interact $ show.f
f x = size (Set.fromList (Prelude.filter isLetter x))

import Data.List
import Data.Function
import Data.Char

main = interact $ show . length . nub . filter (isAlpha)

import Data.List
import Data.List.Split

main = do
  s <- getLine
  let xs = splitOn ", " $ tail $ init s

  print $ length $ group $ filter (not . null) $ sort xs

import Data.List as L
import Data.Char as C
main = interact $ show . length . L.nub . filter C.isLower

import Data.List

main = do
       a <- getLine
       let b = length $ nub $ filter (\c -> c >= 'a' && c <= 'z') a
       putStrLn $ show b

import Data.List (nub)
import Data.Char (isAlpha)
main =
	interact $ show. length. nub. filter isAlpha

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show.solve. words. (\a->if a=="" then a else a++",").init.tail.head . lines
solve :: [String]->Int
solve xss =  length $ slv1 xss
slv1 []=[]
slv1 (xs:xss) = xs:slv1 [ys|ys<-xss,ys/=xs]

import Data.Char

h :: String -> [Char] -> Int
h "}" a = count a
h ('{':s) a = h s a
h (',':xs) s = h xs s
h (' ':xs) s = h xs s
h (x:xs) s = h xs (s++[x])

count :: [Char] -> Int

count a = length b
 where b = rmdups a

rmdups [] = []
rmdups (x:xs)
 | x `elem` xs = rmdups xs
 | x == '"' = rmdups xs
 | otherwise = x : rmdups xs

main = do
 line <- getLine
 print (h line [])

hi :: String -> [Char] -> [Char]
hi "}" a = a
hi ('{':s) a = hi s a
hi (',':xs) s = hi xs s
hi (' ':xs) s = hi xs s
hi (x:xs) s = hi xs (s++[x])

import qualified Data.Set as S
import Control.Applicative

solve :: String -> Int
solve s = S.size.S.fromList $ filter (not.(`elem` "{, }")) s

main = do
    l <- getLine
    putStrLn . show $ solve l

{-# LANGUAGE OverloadedStrings #-}
module Main where

import qualified Data.Set as Set
import qualified Data.Text as T

main :: IO ()
main = do
    input <- getLine
    let input2 = T.pack . drop 1 . take (length input - 1) $ input
        splitted = map T.strip . T.splitOn "," $ input2
        l = Set.fromList . filter (not . T.null) $ splitted
    putStrLn . show $ Set.size l
    pure ()

{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import qualified Data.Foldable         as F
import           Data.Function
import           Data.Functor
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Traversable
import           Text.Printf           (printf)

import qualified Data.Set as S
import Data.Char

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  s <- getLine
  print $ length $ S.toList $ S.fromList $ words $ map (\c -> if isAlpha c then c else ' ') s

import Data.List (nub)

main :: IO()
main  =  getLine >>= print . length . nub . filter (not . flip elem "{}, ")

import Data.Char
import Data.List
main=interact$show.length.nub.filter(isLetter)

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

import Control.Applicative
import qualified Data.List as List
import qualified Data.Set  as Set
import qualified Data.Char as Char

lstrip :: String -> String
lstrip = dropWhile Char.isSpace
rstrip = reverse . lstrip . reverse
strip  = lstrip . rstrip

splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen p l = splitWhenAux l []
  where
    splitWhenAux []    []            = []
    splitWhenAux []    b@(_:_)       = [b]
    splitWhenAux (h:t) b | (p h)     = (reverse b) : (splitWhenAux t [])
                         | otherwise = splitWhenAux t (h:b)

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn n l = splitWhen (n ==) l

parse :: String -> [String]
parse s = map strip $ splitOn ',' $ (init . tail) s

solve :: String -> Int
solve = length . List.nub . parse

main :: IO ()
main = do
  s <- getLine
  putStrLn $ (show . solve) s

import Data.List (nub)
import Data.Char (isAlpha)

main = interact $ show . length . nub . filter isAlpha

import Control.Monad
import Data.Array
import Data.Char
import Data.Functor
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
-- import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = map (read . B.unpack) . B.words <$> B.getLine
getIntList :: IO [Int]
getIntList = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

solve :: String -> Int
solve = length . nub . filter (`notElem` "{, }")

main :: IO ()
main = do
    s <- getLine
    print $ solve s

import Control.Applicative
import Data.Char (isAlpha)
import Data.List (group, sort)

main = do
  s <- getLine
  putStrLn . show $ length . group . sort $ filter isAlpha s

import Data.List
import Data.Char

main = interact entry
    where entry input = show cnt
            where cnt = (length . nub) (filter isAlpha input)

import Control.Applicative
import Data.List
import Data.Char

main=do
   a<-show <$> length  <$> group <$> sort <$> filter (isLower) <$> init <$> tail <$> getLine
   putStrLn a

import Data.Char (isAlpha)
import Data.List (group, sort)

main :: IO ()
main = getLine >>= print . solve . filter isAlpha

solve :: String -> Int
solve = length . group . sort

import Data.Char
import Data.List
main = print . length . nub . filter isLetter =<< getContents

import qualified Data.Set as Set

main :: IO()
main = do
  xs <- getLine
  print $ Set.size $ foldl (\acc el -> Set.insert el acc) Set.empty $ trim $ xs
      where
          trim [] = []
          trim (x:xs)
              | x >= 'a' && x <= 'z' = x : trim xs
              | otherwise = trim xs

-- Vicfred
-- https://codeforces.com/problemset/problem/443/A

import Data.List

solve :: String -> Int
solve = length . nub . filter (`notElem` "{, }")

main :: IO ()
main = do
    s <- getLine
    print $ solve s

import Data.List

process :: String -> Int
process [] = 0
process xs = length $ nub $ filter (\x -> x >= 'a' && x <= 'z') xs

main = do
	str <- getLine
	putStrLn $ show $ process str

import Data.Char
import Data.List
main :: IO ()
main = fmap (length . nub . filter isAlpha) getLine >>= print

import Data.List

main = getLine >>= print.length.(flip (\\) "{, }").nub

import Control.Applicative
import Data.List
import qualified Data.Set as S

repl '{' = ' '
repl '}' = ' '
repl ',' = ' '
repl x = x

main= do
	a<- getLine
	print $ length $ S.toList $ S.fromList $ words $ map repl a

import           Data.Char
import           Data.Set as S  (fromList)
main :: IO ()
main = print =<< length . S.fromList . filter isAlpha <$> getLine

getUnique :: [String] -> [Char] -> Int
getUnique [] _ = 0
getUnique (x:xs) letList
    | not $ curLet `elem` letList = 1 + getUnique xs (curLet:letList)
    | otherwise = getUnique xs letList
    where curLet = head x

main = do
    ln <- getLine
    let lets = words $ tail (init ln)
    putStrLn . show $ getUnique lets []

import Data.Char (isLetter)
import Data.List (nub)

main = interact $ show . length . nub . filter isLetter

import Data.List

main = getLine >>= print . length . nub . solve

solve "}"  = ""
solve ('{':ls) = solve ls
solve (',':ls) = solve ls
solve (' ':ls) = solve ls
solve (l:ls)   = l:(solve ls)

import qualified Data.Text as T
import Data.List

process :: [String] -> Int
process = length.nub

parse :: String -> [String]
parse "{}" = []
parse xs = map T.unpack $ T.splitOn (T.pack ", ") (T.pack.tail.init$xs)

main = do
    xs <- getLine
    print $ process $ parse xs

import Data.List
main = do interact $ show . length . nub . del
    where   del [] = []
            del (x:xs)
                | 'a' <= x && x <= 'z' = x : del xs
                | otherwise            = del xs

import Data.List.Split
import Data.List

solve :: String -> String
solve = show . length . nub .
            split ((dropBlanks. dropDelims .oneOf) "}{, \n")

main :: IO ()
main= interact $ solve

import Data.List
import Data.Char

solve :: String -> String
solve = show . length . nub . filter isLetter

main :: IO ()
main= interact $ solve

module Main where

import Data.Set (toList, fromList)

uniquify = toList . fromList

main = do
	s <- getLine
	putStr $ show $ uniqueNumber s

uniqueNumber :: String -> Int
uniqueNumber = length . uniquify . words . cleanString where
	cleanString = filter (not . (`elem` ",{}"))

import Data.List
f str = filter (\x->not (elem x "{, }\n")) str
main = interact $ show . length .  nub . f

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

parse :: Char -> Char
parse c
  | c == '{' = ' '
  | c == '}' = ' '
  | c == ',' = ' '
  | otherwise = c

solve :: String -> Int
solve s =
  let input = (words . map parse) s
      noDuplicates = Set.fromList input
      ans = Set.toList noDuplicates
  in length ans

main = do
  input <- getLine
  print $ solve input

module Main where

import Data.List (nub)

main :: IO ()
main = do
	ln <- getLine
	print $ process ln

process :: String ->  Int
process = length . nub . readLetters

readLetters :: String -> [Char]
readLetters (' ' : cs) = readLetters cs
readLetters ('{' : cs) = items cs
items [] = []
items ('}' : cs) = []
items (' ' : cs) = items cs
items (',' : cs) = items cs
items (c : cs) = c : items cs

import Control.Monad
import Control.Applicative
import Data.List (nub)

genAns [] = 0
genAns [x] = 1
genAns xs = max 0 $ (length $ nub xs) - 2

main = do
  aa <- getLine
  let ls = tail $ take (length aa - 1) aa
  print $ genAns ls

import Data.Char
import Data.List
f s = show $ length $ nub $ filter isLetter s
main = interact f

import Data.List
main = do
    s <- getLine
    putStrLn $ show $ length $ func s

func :: String -> String
func s = nub [x | x <- s, x `elem` ['a'..'z']]

s l = [x|x<-l,'a'<=x,x<='z']

d l ch k
    |ch == 'z' =(k+t)
    |otherwise = d l (succ ch) (k+t)
    where t = if null [0|x<-l,x==ch] then 0 else 1

n x = d (s x) 'a' 0

main = do
    s <- getLine
    print (n s)

import Data.List
solve s = length $ nub $ concat $ map words$ splitOn ',' $ init $ tail $ s

splitOn::Char->String->[String]
splitOn f [] = []
splitOn f ss = [takeWhile (/=f) ss] ++ splitOn f (stail (dropWhile (/=f) ss))

stail [] = []
stail (s:[]) = []
stail s = tail s

main = do
  s<-getLine
  putStrLn $show$solve s

import Data.List
solve s = length $ nub $ splitOn ',' $ init $ tail $ s

splitOn::Char->String->[String]
splitOn f [] = []
splitOn f ss = [takeWhile (/=f) ss] ++ splitOn f (stail (dropWhile (/=f) ss))

stail [] = []
stail (s:[]) = []
stail s = tail s

main = do
  s<-getLine
  putStrLn $show$solve s

import Data.Set as Set

main = interact $ show.f.tail.init
f x
  | (length x) > 1 = (size (Set.fromList x)) - 3
  | otherwise = (length x) - 1

import Data.Set as Set

main = interact $ show.f.tail.init
f x
  | (length x) > 1 = (size (Set.fromList x)) - 3
  | otherwise = length x

import Data.Set as Set

main = interact $ show.f.tail.init
f x
  | (length x) > 1 = (size (Set.fromList x)) - 2
  | otherwise = length x

import Data.Set as Set

main = interact $ show.f.tail.init
f x
  | (length x) > 1 = (size (Set.fromList x)) - 1
  | otherwise = length x

import Data.List
import Data.List.Split

main = do
  s <- getLine
  let xs = splitOn ", " $ tail $ init s
  print $ length $ group $ sort xs

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

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

splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen p l = splitWhenAux l []
  where
    splitWhenAux []    []            = []
    splitWhenAux []    b@(_:_)       = [b]
    splitWhenAux (h:t) b | (p h)     = (reverse b) : (splitWhenAux t [])
                         | otherwise = splitWhenAux t (h:b)

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn n l = splitWhen (n ==) l

parse :: String -> [String]
parse s = splitOn ',' $ (init . tail) s

solve :: String -> Int
solve = length . List.nub . parse

main :: IO ()
main = do
  s <- getLine
  putStrLn $ (show . solve) s

import Control.Applicative
import Data.List
import Data.List.Split

main=do
   a<-show <$> length <$> filter (/=[""]) <$> group <$> sort <$> splitOn "," <$> init <$> tail <$> getLine
   putStrLn a

import Control.Applicative
import Data.List
import Data.List.Split

check n | le >1 = snd $ head $ filter (\z-> odd (fst z)) $ zip n [1..]
        | otherwise = snd $ head $ filter (\z-> even (fst z)) $ zip n [1..]
  where le = length $ filter even n

main=do
   a<-show <$> length <$> splitOn "," <$> init <$> tail <$> getLine
   putStrLn a

import Control.Applicative
import Data.List
import Data.List.Split

main=do
   a<-show <$> length <$> group <$> sort <$> splitOn "," <$> init <$> tail <$> getLine
   putStrLn a

import Data.List

main = getLine >>= print.(max 0).(flip (-) 4).length.nub

import Data.List

main = getLine >>= print.(flip (-) 4).length.nub

import Data.List

main = getLine >>= print . length . nub . solve

solve "}"  = ""
solve ('{':ls) = solve ls
solve ('.':ls) = solve ls
solve (' ':ls) = solve ls
solve (l:ls)   = l:(solve ls)

f str = filter (\x->not (elem x "{, }\n")) str
g str = filter (\x-> length(filter (==x) str) ==1 ) str
main = interact $ g . f

f str = filter (\x->not (elem x "{, }\n")) str
g str = filter (\x-> length(filter (==x) str) ==1 ) str
main = interact $ show . length .  g . f


We say that a positive integer $$$n$$$ is $$$k$$$-good for some positive integer $$$k$$$ if $$$n$$$ can be expressed as a sum of $$$k$$$ positive integers which give $$$k$$$ distinct remainders when divided by $$$k$$$.Given a positive integer $$$n$$$, find some $$$k \geq 2$$$ so that $$$n$$$ is $$$k$$$-good or tell that such a $$$k$$$ does not exist.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^5$$$) — the number of test cases. Each test case consists of one line with an integer $$$n$$$ ($$$2 \leq n \leq 10^{18}$$$).

For each test case, print a line with a value of $$$k$$$ such that $$$n$$$ is $$$k$$$-good ($$$k \geq 2$$$), or $$$-1$$$ if $$$n$$$ is not $$$k$$$-good for any $$$k$$$. If there are multiple valid values of $$$k$$$, you can print any of them.

Note$$$6$$$ is a $$$3$$$-good number since it can be expressed as a sum of $$$3$$$ numbers which give different remainders when divided by $$$3$$$: $$$6 = 1 + 2 + 3$$$.$$$15$$$ is also a $$$3$$$-good number since $$$15 = 1 + 5 + 9$$$ and $$$1, 5, 9$$$ give different remainders when divided by $$$3$$$.$$$20$$$ is a $$$5$$$-good number since $$$20 = 2 + 3 + 4 + 5 + 6$$$ and $$$2,3,4,5,6$$$ give different remainders when divided by $$$5$$$.

import Control.Applicative
import Control.Monad
import Prelude

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

go :: (Integral t1, Num t2) => t1 -> t2 -> (t1, t2)
go n k = case n `rem` 2 of
    1 -> (n, k)
    _ -> go (n `div` 2) (k + k)

solve :: IO ()
solve = do
    [n] <- nextList
    let (x, y) = go (n + n) 1
    let f = min x y
    print $ if f == 1 then (-1) else f
    return ()

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

import Control.Applicative
import Control.Monad
import Prelude

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

go :: (Integral t1, Num t2) => t1 -> t2 -> (t1, t2)
go n k = case n `rem` 2 of
    1 -> (n, k)
    _ -> go (n `div` 2) (k + k)

solve :: IO ()
solve = do
    [n] <- nextList
    let k = 1
    let (x, y) = go (n + n) k
    let f = min x y
    print x
    print y
    print $ if f == 1 then (-1) else f
    return ()

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

import Control.Applicative
import Control.Monad
import Prelude

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

go :: (Integral t1, Num t2) => t1 -> t2 -> (t1, t2)
go n k = case n `rem` 2 of
    1 -> (n, k)
    _ -> go (n `div` 2) (k + k)

solve :: IO ()
solve = do
    [n] <- nextList
    let k = 1
    let (x, y) = go n k
    let f = min x y
    print $ if f == 1 then (-1) else f
    return ()

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


The only difference between this problem and D2 is the bound on the size of the tree.You are given an unrooted tree with $$$n$$$ vertices. There is some hidden vertex $$$x$$$ in that tree that you are trying to find.To do this, you may ask $$$k$$$ queries $$$v_1, v_2, \ldots, v_k$$$ where the $$$v_i$$$ are vertices in the tree. After you are finished asking all of the queries, you are given $$$k$$$ numbers $$$d_1, d_2, \ldots, d_k$$$, where $$$d_i$$$ is the number of edges on the shortest path between $$$v_i$$$ and $$$x$$$. Note that you know which distance corresponds to which query.What is the minimum $$$k$$$ such that there exists some queries $$$v_1, v_2, \ldots, v_k$$$ that let you always uniquely identify $$$x$$$ (no matter what $$$x$$$ is).Note that you don't actually need to output these queries.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2000$$$)  — the number of vertices in the tree. Each of the next $$$n-1$$$ lines contains two integers $$$x$$$ and $$$y$$$ ($$$1 \le x, y \le n$$$), meaning there is an edges between vertices $$$x$$$ and $$$y$$$ in the tree. It is guaranteed that the given edges form a tree. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2000$$$.

For each test case print a single nonnegative integer, the minimum number of queries you need, on its own line.

NoteIn the first test case, there is only one vertex, so you don't need any queries.In the second test case, you can ask a single query about the node $$$1$$$. Then, if $$$x = 1$$$, you will get $$$0$$$, otherwise you will get $$$1$$$.

{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
import Control.Monad
import Data.Bits
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import qualified Data.IntSet as S

solve :: Int -> [[Int]] -> Int
solve n edges
  | n == 1     = 0
  | isBamboo   = 1
  | otherwise  = length leaves - numBranches
  where
    deg :: UArray Int Int
    deg = accumArray (+) 0 (0,n-1) $ map (,1) $ concat edges

    adj :: UArray Int Int
    adj = accumArray xor 0 (0,n-1) $ concatMap (\[a,b] -> [(a,b),(b,a)]) edges

    rise :: Int -> Int
    rise a = go a (adj ! a)
      where
        go a b = if deg ! b >= 3 then b else go b (adj ! b `xor` a)

    isBamboo = maximum (elems deg) <= 2
    leaves = filter (\x -> deg ! x == 1) [0 .. n-1]
    numBranches = S.size $ S.fromList $ map rise leaves

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

main :: IO ()
main = do
  [tc] <- readInts
  replicateM_ tc $ do
    [n] <- readInts
    edges <- replicateM (n-1) $ map (-1+) <$> readInts
    print $ solve n edges


The only difference between easy and hard versions is constraints.You are given a sequence $$$a$$$ consisting of $$$n$$$ positive integers.Let's define a three blocks palindrome as the sequence, consisting of at most two distinct elements (let these elements are $$$a$$$ and $$$b$$$, $$$a$$$ can be equal $$$b$$$) and is as follows: $$$[\underbrace{a, a, \dots, a}_{x}, \underbrace{b, b, \dots, b}_{y}, \underbrace{a, a, \dots, a}_{x}]$$$. There $$$x, y$$$ are integers greater than or equal to $$$0$$$. For example, sequences $$$[]$$$, $$$[2]$$$, $$$[1, 1]$$$, $$$[1, 2, 1]$$$, $$$[1, 2, 2, 1]$$$ and $$$[1, 1, 2, 1, 1]$$$ are three block palindromes but $$$[1, 2, 3, 2, 1]$$$, $$$[1, 2, 1, 2, 1]$$$ and $$$[1, 2]$$$ are not.Your task is to choose the maximum by length subsequence of $$$a$$$ that is a three blocks palindrome.You have to answer $$$t$$$ independent test cases.Recall that the sequence $$$t$$$ is a a subsequence of the sequence $$$s$$$ if $$$t$$$ can be derived from $$$s$$$ by removing zero or more elements without changing the order of the remaining elements. For example, if $$$s=[1, 2, 1, 3, 1, 2, 1]$$$, then possible subsequences are: $$$[1, 1, 1, 1]$$$, $$$[3]$$$ and $$$[1, 2, 1, 3, 1, 2, 1]$$$, but not $$$[3, 2, 3]$$$ and $$$[1, 1, 1, 1, 2]$$$.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 2000$$$) — the length of $$$a$$$. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 26$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. Note that the maximum value of $$$a_i$$$ can be up to $$$26$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2000$$$ ($$$\sum n \le 2000$$$).

For each test case, print the answer — the maximum possible length of some subsequence of $$$a$$$ that is a three blocks palindrome.

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

solve xs = if length ids == 1 then length xs else res where
	sorted = sort xs
	ids = go sorted where
		go (x:xs) = x : go (dropWhile (==x) xs)
		go [] = []

	res = maximum [ solveTwo a b (filter (\k -> k == a || k == b) xs)| a <- ids, b <- ids, a /= b]

	solveTwo a b xs = maximum $ go a b xs (reverse xs) 0 (length $ filter (== b) xs) where
		total_a_count = length $ filter (==a) xs
		go a b xs rxs acount bcount = let
				(b1, xs') = strip xs 0
				(b2, rxs') = strip rxs 0
				acount' = acount + 2
				bcount' = bcount - b1 - b2
			in
				if acount > total_a_count then [total_a_count] else (acount + bcount) : go a b xs' rxs' acount' bcount'

			where
				strip (x:xs) acc
					| x == a = (acc, xs)
					| x == b = strip xs (acc + 1)

main = do
	t <- fmap read getLine
	forM_ [1..t] $ \i -> do
		n <- fmap read getLine :: IO Int
		xs <- fmap (map read.words) getLine :: IO [Int]
		print (solve xs)

import qualified Data.Map.Strict as Map
import Data.Map (Map)
import qualified Data.Array as Ar
import Data.Array (Array)
import qualified Data.List as L

getCounts :: [Int] -> Map Int Int
getCounts lst = Map.fromList $ map mapper grouping
    where
        grouping = L.group . L.sort $ lst
        mapper as = (head as, length as)

solve :: [Int] -> Int
solve lst = maximum $ map mapper lst
    where
        arr = Ar.listArray (0, length lst - 1) lst
        counts = Map.insert 0 0 $ getCounts lst
        helper :: Int -> Int -> Int -> Int -> Map Int Int -> Int
        helper n nCount start end remaining
            | start >= end  = counts Map.! n
            | sVal == n && eVal == n
                = max (nCount + 2 + maximum (Map.elems remaining)) (helper n (nCount+2) (start+1) (end-1) remaining)
            | eVal /= n
                = helper n nCount start (end-1) (Map.adjust pred eVal remaining)
            | otherwise
                = helper n nCount (start+1) end (Map.adjust pred sVal remaining)
            where
                sVal = arr Ar.! start
                eVal = arr Ar.! end
        mapper n = helper n 0 0 (length lst - 1) (Map.delete n counts)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    _ <- readInts
    lst <- readInts
    print $ solve lst
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readInts
    testCases t

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

import qualified Data.Map.Strict as Map
import Data.Map (Map)
import qualified Data.Array as Ar
import Data.Array (Array)
import qualified Data.List as L
import qualified Data.Maybe as Mb
import Data.Function

transform :: [Int] -> [Int]
transform lst = map (m Map.!) lst
    where
        unique = map head $ L.group $ L.sort lst
        m = Map.fromAscList $ zip unique [0..]

type Vector = Array Int

type PrefixSums = Vector (Vector Int)

makePrefixSum :: [Int] -> [Int]
makePrefixSum lst = 0 : go 0 lst
    where
        go aux [] = []
        go aux (e:es) = aux+e : go (aux+e) es

makePrefixSums :: [Int] -> PrefixSums
makePrefixSums lst = Ar.listArray (0,mx) $ map prefixSumMapper [0..mx]
    where
        n = length lst
        mx = maximum lst
        prefixSumMapper i = Ar.listArray (0, n) $ makePrefixSum $ map mapperF lst
            where
                mapperF j = if j == i then 1 else 0

frequency :: PrefixSums -> Int -> (Int, Int) -> Int
frequency vecVec i (start, end) = endSum - startSum
    where
        vec = vecVec Ar.! i
        endSum = vec Ar.! (end+1)
        startSum = vec Ar.! start

makeIndexList :: [Int] -> [[Int]]
makeIndexList lst = map (map snd) $ L.groupBy ((==) `on` fst) $ L.sort $ zip lst [0..]

maxValue :: Int -> (Int -> (Int, Int) -> Int) -> [(Int, Int)] -> Int
maxValue _ _ [] = 0
maxValue mx frequencyGetter indexes = maximum [2*c + frequencyGetter i (start+1,end-1) | (c, (start,end)) <- zip [1..] indexes, i <- [0..mx]]

solve :: [Int] -> Int
solve rawLst = maximum $ defaultAns : map (maxValueGetter . makeStartEndPairs) indexList
    where
        lst = transform rawLst
        mx = maximum lst
        defaultAns = maximum $ map length $ L.group $ L.sort lst
        indexList = makeIndexList lst
        makeStartEndPairs indexes = take (length indexes `div` 2) $ zip indexes (reverse indexes)
        frequencyGetter = frequency (makePrefixSums lst)
        maxValueGetter = maxValue mx frequencyGetter

{-
getCounts :: [Int] -> Map Int Int
getCounts lst = Map.fromList $ map mapper grouping
    where
        grouping = L.group . L.sort $ lst
        mapper as = (head as, length as)

dec :: Int -> Map Int Int -> Map Int Int -> (Map Int Int, Map Int Int)
dec n remaining remainingInv = (newRemaining, newRemainingInv2)
    where
        count = remaining Map.! n
        newRemaining = Map.adjust pred n remaining
        newRemainingInv1 = Map.adjust pred count remainingInv
        newRemainingInv2 = Map.alter (Just . succ . Mb.fromMaybe 0) (count-1) newRemainingInv1

createInvPair :: Map Int Int -> (Map Int Int, Map Int Int)
createInvPair remaining = (remaining, inv)
    where
        values = Map.elems remaining
        inv = getCounts values

solve :: [Int] -> Int
solve lst = maximum $ map mapper lst
    where
        arr = Ar.listArray (0, length lst - 1) lst
        counts = Map.insert 0 0 $ getCounts lst
        helper :: Int -> Int -> Int -> Int -> (Map Int Int, Map Int Int) -> Int
        helper n nCount start end (remaining, remainingInv)
            | start >= end  = counts Map.! n
            | sVal == n && eVal == n
                = max (nCount + 2 + maximum (Map.elems remaining)) (helper n (nCount+2) (start+1) (end-1) (remaining, remainingInv))
            | eVal /= n
                = helper n nCount start (end-1) (dec eVal remaining remainingInv)
            | otherwise
                = helper n nCount (start+1) end (dec sVal remaining remainingInv)
            where
                sVal = arr Ar.! start
                eVal = arr Ar.! end
        mapper n = helper n 0 0 (length lst - 1) (createInvPair $ Map.delete n counts)
-}

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    _ <- readInts
    lst <- readInts
    print $ solve lst
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readInts
    testCases t

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

{-# LANGUAGE BangPatterns #-}

import qualified Data.Map.Strict as Map
import Data.Map (Map)
import qualified Data.Array as Ar
import Data.Array (Array)
import qualified Data.List as L
import qualified Data.Maybe as Mb
import Data.Function
import Data.Int

transform :: [Int16] -> [Int16]
transform lst = map (m Map.!) lst
    where
        unique = map head $ L.group $ L.sort lst
        m = Map.fromAscList $ zip unique [0..]

type PrefixSums = Array Int16 (Array Int32 Int32)

makePrefixSum :: (Num a) => [a] -> [a]
makePrefixSum lst = 0 : go 0 lst
    where
        go aux [] = []
        go aux (e:es) = aux+e : go (aux+e) es

makePrefixSums :: [Int16] -> PrefixSums
makePrefixSums lst = Ar.listArray (0,mx) $ map prefixSumMapper [0..mx]
    where
        n = fromIntegral $ length lst
        mx = fromIntegral $ maximum lst
        prefixSumMapper i = Ar.listArray (0, n) $ makePrefixSum $ map mapperF lst
            where
                mapperF j = if j == i then 1 else 0

frequency :: PrefixSums -> Int16 -> (Int32, Int32) -> Int32
frequency vecVec i (start, end) = endSum - startSum
    where
        vec = vecVec Ar.! i
        endSum = vec Ar.! (end+1)
        startSum = vec Ar.! start

makeIndexList :: [Int16] -> [[Int32]]
makeIndexList lst = map (map snd) $ L.groupBy ((==) `on` fst) $ L.sort $ zip lst [0..]

maxValue :: Int16 -> (Int16 -> (Int32, Int32) -> Int32) -> [(Int32, Int32)] -> Int32
maxValue _ _ [] = 0
maxValue mx frequencyGetter indexes = maximum [2*c + frequencyGetter i (start+1,end-1) | (c, (start,end)) <- zip [1..] indexes, i <- [0..mx]]

solve :: [Int16] -> Int32
solve rawLst = maximum $ defaultAns : map (maxValueGetter . makeStartEndPairs) indexList
    where
        !lst = transform rawLst
        mx = maximum lst
        !defaultAns = fromIntegral $ maximum $ map length $ L.group $ L.sort lst
        !indexList = makeIndexList lst
        makeStartEndPairs indexes = take (length indexes `div` 2) $ zip indexes (reverse indexes)
        !frequencyGetter = frequency (makePrefixSums lst)
        !maxValueGetter = maxValue mx frequencyGetter

{-
getCounts :: [Int] -> Map Int Int
getCounts lst = Map.fromList $ map mapper grouping
    where
        grouping = L.group . L.sort $ lst
        mapper as = (head as, length as)

dec :: Int -> Map Int Int -> Map Int Int -> (Map Int Int, Map Int Int)
dec n remaining remainingInv = (newRemaining, newRemainingInv2)
    where
        count = remaining Map.! n
        newRemaining = Map.adjust pred n remaining
        newRemainingInv1 = Map.adjust pred count remainingInv
        newRemainingInv2 = Map.alter (Just . succ . Mb.fromMaybe 0) (count-1) newRemainingInv1

createInvPair :: Map Int Int -> (Map Int Int, Map Int Int)
createInvPair remaining = (remaining, inv)
    where
        values = Map.elems remaining
        inv = getCounts values

solve :: [Int] -> Int
solve lst = maximum $ map mapper lst
    where
        arr = Ar.listArray (0, length lst - 1) lst
        counts = Map.insert 0 0 $ getCounts lst
        helper :: Int -> Int -> Int -> Int -> (Map Int Int, Map Int Int) -> Int
        helper n nCount start end (remaining, remainingInv)
            | start >= end  = counts Map.! n
            | sVal == n && eVal == n
                = max (nCount + 2 + maximum (Map.elems remaining)) (helper n (nCount+2) (start+1) (end-1) (remaining, remainingInv))
            | eVal /= n
                = helper n nCount start (end-1) (dec eVal remaining remainingInv)
            | otherwise
                = helper n nCount (start+1) end (dec sVal remaining remainingInv)
            where
                sVal = arr Ar.! start
                eVal = arr Ar.! end
        mapper n = helper n 0 0 (length lst - 1) (createInvPair $ Map.delete n counts)
-}

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    _ <- readInts
    lst <- readInts16
    print $ solve lst
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readInts
    testCases t

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

readInts32 :: IO [Int32]
readInts32 = map read . words <$> getLine

readInts16 :: IO [Int16]
readInts16 = map read . words <$> getLine

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

solve xs = if length ids == 1 then length xs else res where
	sorted = sort xs
	ids = go sorted where
		go (x:xs) = x : go (dropWhile (==x) xs)
		go [] = []

	res = maximum [ solveTwo a b (filter (\k -> k == a || k == b) xs)| a <- ids, b <- dropWhile (<= a) ids]

	solveTwo a b xs = maximum $ go a b xs (reverse xs) 0 (length $ filter (== b) xs) where
		total_a_count = length $ filter (==a) xs
		go a b xs rxs acount bcount = let
				(b1, xs') = strip xs 0
				(b2, rxs') = strip rxs 0
				acount' = acount + 2
				bcount' = bcount - b1 - b2
			in
				if acount > total_a_count then [total_a_count] else (acount + bcount) : go a b xs' rxs' acount' bcount'

			where
				strip (x:xs) acc
					| x == a = (acc, xs)
					| x == b = strip xs (acc + 1)

main = do
	t <- fmap read getLine
	forM_ [1..t] $ \i -> do
		n <- fmap read getLine :: IO Int
		xs <- fmap (map read.words) getLine :: IO [Int]
		print (solve xs)


Vasya is a born Berland film director, he is currently working on a new blockbuster, "The Unexpected". Vasya knows from his own experience how important it is to choose the main characters' names and surnames wisely. He made up a list of n names and n surnames that he wants to use. Vasya haven't decided yet how to call characters, so he is free to match any name to any surname. Now he has to make the list of all the main characters in the following format: "Name1 Surname1, Name2 Surname2, ..., Namen Surnamen", i.e. all the name-surname pairs should be separated by exactly one comma and exactly one space, and the name should be separated from the surname by exactly one space. First of all Vasya wants to maximize the number of the pairs, in which the name and the surname start from one letter. If there are several such variants, Vasya wants to get the lexicographically minimal one. Help him.An answer will be verified a line in the format as is shown above, including the needed commas and spaces. It's the lexicographical minimality of such a line that needs to be ensured. The output line shouldn't end with a space or with a comma.

The first input line contains number n (1 ≤ n ≤ 100) — the number of names and surnames. Then follow n lines — the list of names. Then follow n lines — the list of surnames. No two from those 2n strings match. Every name and surname is a non-empty string consisting of no more than 10 Latin letters. It is guaranteed that the first letter is uppercase and the rest are lowercase.

The output data consist of a single line — the needed list. Note that one should follow closely the output data format!

4
Ann
Anna
Sabrina
John
Petrov
Ivanova
Stoltz
Abacaba

Ann Abacaba, Anna Ivanova, John Petrov, Sabrina Stoltz

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = preparedfullnames
    where
        preparedfullnames = (prepare names, prepare surnames)
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

push [] acc = acc
push (x : xs) acc = push xs (x : acc)

alignTR acc namestack surnamestack _    ([], ss) = zip namestack (push (concatMap thrd ss) surnamestack) ++ acc
alignTR acc namestack surnamestack diff (ns, []) = zip (push (concatMap thrd ns) namestack) surnamestack ++ acc
alignTR acc namestack surnamestack diff (ns@((countn, cn, ln) : ns'), ss@((counts, cs, ls) : ss'))
    | cn < cs                           = alignTR acc (push ln namestack) surnamestack (diff + countn) (ns', ss)
    | cs < cn                           = alignTR acc namestack (push ls surnamestack) (diff - counts) (ns, ss')
    | countn == counts                  = alignTR (zip ln ls ++ acc) namestack surnamestack diff (ns', ss')

    | countn > counts && diff == 0      = let (ln', ln'') = splitAt counts ln in
        alignTR (zip ln' ls ++ acc) (push ln'' namestack) surnamestack (countn - counts) (ns', ss')

    | countn > counts && diff > 0       = let (ln', ln'') = splitAt counts ln in
        alignTR (zip ln' ls ++ acc) namestack surnamestack diff ((countn - counts, cn, ln'') : ns', ss')

    | countn > counts && diff < 0       = let draw = min (abs diff) (countn - counts) in let (ln', ln'') = splitAt draw ln in
        alignTR acc (push ln' namestack) surnamestack (diff + draw) ((countn - draw, cn, ln'') : ns', ss)

    | countn < counts && diff == 0      = let (ls', ls'') = splitAt countn ls in
        alignTR (zip ln ls' ++ acc) namestack (push ls'' surnamestack) (countn - counts) (ns', ss')

    | countn < counts && diff > 0       = let draw = min diff (counts - countn) in let (ls', ls'') = splitAt draw ls in
        alignTR acc namestack (push ls' surnamestack) (diff - draw) (ns, (counts - draw, cs, ls'') : ss')

    | countn < counts && diff < 0       = let (ls', ls'') = splitAt countn ls in
        alignTR (zip ln ls' ++ acc) namestack surnamestack diff (ns', (counts - countn, cs, ls'') : ss')

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . sort . (alignTR [] [] [] 0) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     putStrLn (solve (names, surnames))

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = (names', surnames')
    where
        names'    = prepare names
        surnames' = prepare surnames
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

alignTR accE (accUN, accUS) ([], ss) = (accE, (accUN, accUS ++ (concatMap thrd ss)))
alignTR accE (accUN, accUS) (ns, []) = (accE, (accUN ++ (concatMap thrd ns), accUS))
alignTR accE accU (ns@(n : ns'), ss@(s : ss'))
    | countn == counts && cn == cs   = alignTR ((ln ++ accEN), (ls ++ accES)) accU (ns', ss')
    | cn < cs                        = alignTR accE (accUN ++ ln, accUS) (ns', ss)
    | otherwise                      = alignTR accE (accUN, accUS ++ ls) (ns, ss')
    where
        (accEN, accES) = accE
        (accUN, accUS) = accU
        (countn, cn, ln) = n
        (counts, cs, ls) = s

match ((evenNames, evenSurnames), (unevenNames, unevenSurnames)) =
    sort $ (zip evenNames evenSurnames) ++ (zip unevenNames unevenSurnames)

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . match . (alignTR ([], []) ([], [])) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     putStrLn (solve (names, surnames))

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = preparedfullnames
    where
        preparedfullnames = (prepare names, prepare surnames)
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

push [] acc = acc
push (x : xs) acc = push xs (x : acc)

alignTR acc namestack surnamestack _    ([], ss) = zip namestack (push (concatMap thrd ss) surnamestack) ++ acc
alignTR acc namestack surnamestack diff (ns, []) = zip (push (concatMap thrd ns) namestack) surnamestack ++ acc
alignTR acc namestack surnamestack diff (ns@((countn, cn, ln) : ns'), ss@((counts, cs, ls) : ss'))
    | cn < cs                           = alignTR acc (push ln namestack) surnamestack (diff + countn) (ns', ss)
    | cs < cn                           = alignTR acc namestack (push ls surnamestack) (diff - counts) (ns, ss')
    | countn == counts                  = alignTR acc (push ln namestack) (push ls surnamestack) diff (ns', ss')
    | countn > counts && diff >= 0      = let (ln', ln'') = splitAt counts ln in
        alignTR (push (zip ln' ls) acc) namestack surnamestack diff ((countn - counts, cn, ln'') : ns', ss')

    | countn > counts && diff < 0       = let draw = min (abs diff) (countn - counts) in let (ln', ln'') = splitAt draw ln in
        alignTR acc (push ln' namestack) surnamestack (diff + draw) ((countn - draw, cn, ln'') : ns', ss)

    | countn < counts && diff >= 0      = let draw = min diff (counts - countn) in let (ls', ls'') = splitAt draw ls in
        alignTR acc namestack (push ls' surnamestack) (diff - draw) (ns, (counts - draw, cs, ls'') : ss')

    | countn < counts && diff < 0       = let (ls', ls'') = splitAt countn ls in
        alignTR (push (zip ln ls') acc) namestack surnamestack diff (ns', (counts - countn, cs, ls'') : ss')

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . sort . (alignTR [] [] [] 0) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     putStrLn (solve (names, surnames))

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = preparedfullnames
    where
        preparedfullnames = (prepare names, prepare surnames)
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

push [] acc = acc
push (x : xs) acc = push xs (x : acc)

alignTR acc namestack surnamestack _    ([], ss) = zip namestack (push (concatMap thrd ss) surnamestack) ++ acc
alignTR acc namestack surnamestack diff (ns, []) = zip (push (concatMap thrd ns) namestack) surnamestack ++ acc
alignTR acc namestack surnamestack diff (ns@((countn, cn, ln) : ns'), ss@((counts, cs, ls) : ss'))
    | cn < cs                           = alignTR acc (push ln namestack) surnamestack (diff + countn) (ns', ss)
    | cs < cn                           = alignTR acc namestack (push ls surnamestack) (diff - counts) (ns, ss')
    | countn == counts                  = alignTR (zip ln ls ++ acc) namestack surnamestack diff (ns', ss')

    | countn > counts && diff == 0      = let (ln', ln'') = splitAt counts ln in
        alignTR (zip ln' ls ++ acc) (push ln'' namestack) surnamestack (countn - counts) (ns', ss')

    | countn > counts && diff > 0       = let (ln', ln'') = splitAt counts ln in
        alignTR (zip ln' ls ++ acc) namestack surnamestack diff ((countn - counts, cn, ln'') : ns', ss')

    | countn > counts && diff < 0       = let draw = min (abs diff) (countn - counts) in let (ln', ln'') = splitAt draw ln in
        alignTR acc (push ln' namestack) surnamestack (diff + draw) ((countn - draw, cn, ln'') : ns', ss)

    | countn < counts && diff == 0      = let (ls', ls'') = splitAt countn ls in
        alignTR (zip ln ls' ++ acc) namestack (push ls'' surnamestack) (counts - countn) (ns', ss')

    | countn < counts && diff > 0       = let draw = min diff (counts - countn) in let (ls', ls'') = splitAt draw ls in
        alignTR acc namestack (push ls' surnamestack) (diff - draw) (ns, (counts - draw, cs, ls'') : ss')

    | countn < counts && diff < 0       = let (ls', ls'') = splitAt countn ls in
        alignTR (zip ln ls' ++ acc) namestack surnamestack diff (ns', (counts - countn, cs, ls'') : ss')

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . sort . (alignTR [] [] [] 0) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     putStrLn (solve (names, surnames))

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = (names', surnames')
    where
        names'    = prepare names
        surnames' = prepare surnames
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

alignTR accE (accUN, accUS) ([], ss) = (accE, (accUN, accUS ++ (concatMap thrd ss)))
alignTR accE (accUN, accUS) (ns, []) = (accE, (accUN ++ (concatMap thrd ns), accUS))
alignTR accE accU (ns@(n : ns'), ss@(s : ss'))
    | countn == counts && cn == cs   = alignTR ((ln ++ accEN), (ls ++ accES)) accU (ns', ss')
    | cn < cs                        = alignTR accE (accUN ++ ln, accUS) (ns', ss)
    | otherwise                      = alignTR accE (accUN, accUS ++ ls) (ns, ss')
    where
        (accEN, accES) = accE
        (accUN, accUS) = accU
        (countn, cn, ln) = n
        (counts, cs, ls) = s

match ((evenNames, evenSurnames), (unevenNames, unevenSurnames)) =
    sort $ (zip evenNames evenSurnames) ++ (zip unevenNames unevenSurnames)

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . match . (alignTR ([], []) ([], [])) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     print (solve (names, surnames))


Anatoly lives in the university dorm as many other students do. As you know, cockroaches are also living there together with students. Cockroaches might be of two colors: black and red. There are n cockroaches living in Anatoly's room.Anatoly just made all his cockroaches to form a single line. As he is a perfectionist, he would like the colors of cockroaches in the line to alternate. He has a can of black paint and a can of red paint. In one turn he can either swap any two cockroaches, or take any single cockroach and change it's color.Help Anatoly find out the minimum number of turns he needs to make the colors of cockroaches in the line alternate.

The first line of the input contains a single integer n (1 ≤ n ≤ 100 000) — the number of cockroaches. The second line contains a string of length n, consisting of characters 'b' and 'r' that denote black cockroach and red cockroach respectively.

Print one integer — the minimum number of moves Anatoly has to perform in order to make the colors of cockroaches in the line to alternate.

NoteIn the first sample, Anatoly has to swap third and fourth cockroaches. He needs 1 turn to do this.In the second sample, the optimum answer is to paint the second and the fourth cockroaches red. This requires 2 turns.In the third sample, the colors of cockroaches in the line are alternating already, thus the answer is 0.

import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe

calc :: String -> Int
calc xs = min ynum znum
  where l = length xs
        ys = take l $ cycle "rb"
        zs = take l $ cycle "br"
        ynum = diff xs ys
        znum = diff xs zs

diff :: String -> String -> Int
diff xs ys = max r b
  where zs = zip xs ys
        ds = map fst $ filter (\(x,y) -> x /= y) zs
        (rs,bs) = partition (=='r') ds
        r = length rs
        b = length bs
main = do
  getLine
  l <- getLine
  putStrLn . show . calc $ l

neg :: Char -> Char
neg 'r' = 'b'
neg 'b' = 'r'

turn :: String -> Char -> (Int, Int)
turn [] _ = (0, 0)
turn (a:rest) 'r'
  | a == 'r'  = turn rest 'b'
  | otherwise = let (x, y) = turn rest 'b' in (1 + x, y)
turn (a:rest) 'b'
  | a == 'b'  = turn rest 'r'
  | otherwise = let (x, y) = turn rest 'r' in (x, 1 + y)

process :: String -> String
process str =
  let [n, rest] = words str
      line      = take (read n) rest
      (xr, yr)  = turn line 'r'
      (xb, yb)  = turn line 'b'
  in show $ min (max xr yr) (max xb yb)

main :: IO ()
main = interact process

import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe

calc :: String -> Int
calc [] = 0
calc [_] = 0
calc "rr" = 1
calc "bb" = 1
calc [_,_] = 0
calc ('r':'r':'r':xs) = 1 + calc ('r':xs)
calc ('b':'b':'b':xs) = 1 + calc ('b':xs)
calc ('r':'r':xs) = 1 + (calc $ swap $ 'r':xs)
calc ('b':'b':xs) = 1 + (calc $ swap $ 'b':xs)
calc ('r':'b':xs) = calc ('b':xs)
calc ('b':'r':xs) = calc ('r':xs)

swap :: String -> String
swap [] = []
swap [x] = [x]
swap (x:y:xs) = y:x:xs

main = do
  getLine
  l <- getLine
  putStrLn . show . calc $ l

import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe

calc :: String -> Int
calc [] = 0
calc [_] = 0
calc "rr" = 1
calc "bb" = 1
calc [_,_] = 0
calc ('r':'r':'r':xs) = 1 + calc xs
calc ('b':'b':'b':xs) = 1 + calc xs
calc ('r':'r':xs) = 1 + (calc $ swap $ 'r':xs)
calc ('b':'b':xs) = 1 + (calc $ swap $ 'b':xs)
calc ('r':'b':xs) = calc ('b':xs)
calc ('b':'r':xs) = calc ('r':xs)

swap :: String -> String
swap [] = []
swap [x] = [x]
swap (x:y:xs) = y:x:xs

main = do
  getLine
  l <- getLine
  putStrLn . show . calc $ l

neg :: Char -> Char
neg 'r' = 'b'
neg 'b' = 'r'

turn :: String -> Char -> Int
turn [c] t
  | c == t    = 0
  | otherwise = 1
turn (a:b:rest) t
  | a == t    = turn (b:rest) (neg t)
  | b == t    = 1 + turn rest t
  | otherwise = 1 + turn (b:rest) (neg t)

process :: String -> String
process str =
  let [n, rest] = words str
      line      = take (read n) rest
  in show $ min (turn line 'r') (turn line 'b')

main :: IO ()
main = interact process


You have a square chessboard of size $$$n \times n$$$. Rows are numbered from top to bottom with numbers from $$$1$$$ to $$$n$$$, and columns — from left to right with numbers from $$$1$$$ to $$$n$$$. So, each cell is denoted with pair of integers $$$(x, y)$$$ ($$$1 \le x, y \le n$$$), where $$$x$$$ is a row number and $$$y$$$ is a column number.You have to perform $$$q$$$ queries of three types:  Put a new rook in cell $$$(x, y)$$$.  Remove a rook from cell $$$(x, y)$$$. It's guaranteed that the rook was put in this cell before.  Check if each cell of subrectangle $$$(x_1, y_1) - (x_2, y_2)$$$ of the board is attacked by at least one rook. Subrectangle is a set of cells $$$(x, y)$$$ such that for each cell two conditions are satisfied: $$$x_1 \le x \le x_2$$$ and $$$y_1 \le y \le y_2$$$.Recall that cell $$$(a, b)$$$ is attacked by a rook placed in cell $$$(c, d)$$$ if either $$$a = c$$$ or $$$b = d$$$. In particular, the cell containing a rook is attacked by this rook.

The first line contains two integers $$$n$$$ and $$$q$$$ ($$$1 \le n \le 10^5$$$, $$$1 \le q \le 2 \cdot 10^5$$$) — the size of the chessboard and the number of queries, respectively. Each of the following $$$q$$$ lines contains description of a query. Description begins with integer $$$t$$$ ($$$t \in \{1, 2, 3\}$$$) which denotes type of a query:   If $$$t = 1$$$, two integers $$$x$$$ and $$$y$$$ follows ($$$1 \le x, y \le n$$$) — coordinated of the cell where the new rook should be put in. It's guaranteed that there is no rook in the cell $$$(x, y)$$$ at the moment of the given query.  If $$$t = 2$$$, two integers $$$x$$$ and $$$y$$$ follows ($$$1 \le x, y \le n$$$) — coordinates of the cell to remove a rook from. It's guaranteed that there is a rook in the cell $$$(x, y)$$$ at the moment of the given query.  If $$$t = 3$$$, four integers $$$x_1, y_1, x_2$$$ and $$$y_2$$$ follows ($$$1 \le x_1 \le x_2 \le n$$$, $$$1 \le y_1 \le y_2 \le n$$$) — subrectangle to check if each cell of it is attacked by at least one rook.  It's guaranteed that among $$$q$$$ queries there is at least one query of the third type.

Print the answer for each query of the third type in a separate line. Print "Yes" (without quotes) if each cell of the subrectangle is attacked by at least one rook. Otherwise print "No" (without quotes).

NoteConsider example. After the first two queries the board will look like the following picture (the letter $$$R$$$ denotes cells in which rooks are located, the subrectangle of the query of the third type is highlighted in green):  Chessboard after performing the third and the fourth queries:  Chessboard after performing the fifth and the sixth queries:  Chessboard after performing the seventh and the eighth queries:  Chessboard after performing the last two queries:

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE TupleSections #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S

import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import Control.Monad.Cont (MonadIO(liftIO))

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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)

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =  if value
        then "Yes"
        else "No"
    printf "%s\n" result

{- END OF GENERAL -}

data Structure = Structure {
        xFreeRows :: IS.IntSet,
        xAttackRowCnts :: IM.IntMap Int,
        yFreeRows :: IS.IntSet,
        yAttackRowCnts :: IM.IntMap Int,
        size :: Int
    }

emptyStructure :: Int -> Structure
emptyStructure size = Structure {
        xFreeRows = IS.fromAscList [1 .. size],
        xAttackRowCnts = IM.fromAscList $ map (, 0) [1 .. size],
        yFreeRows = IS.fromAscList [1 .. size],
        yAttackRowCnts = IM.fromAscList $ map (, 0) [1 .. size],
        size = size
    }

structureInsertRook :: (Monad m) => (Int, Int) -> S.StateT Structure m ()
structureInsertRook (x, y) = do
    S.modify (\structure ->
        structure { xFreeRows = IS.delete x (xFreeRows structure),
                    xAttackRowCnts = IM.update (\x -> Just (x + 1)) x (xAttackRowCnts structure),
                    yFreeRows = IS.delete y (yFreeRows structure),
                    yAttackRowCnts = IM.update (\y -> Just (y + 1)) y (yAttackRowCnts structure)
                    })

structureRemoveRook :: (Monad m) => (Int, Int) -> S.StateT Structure m ()
structureRemoveRook (x, y) = do
    S.modify (\structure ->
        let
            xIsFree = ((xAttackRowCnts structure) IM.! x) == 1
            yIsFree = ((yAttackRowCnts structure) IM.! y) == 1
        in
        structure { xFreeRows = if xIsFree then IS.insert x (xFreeRows structure) else xFreeRows structure,
                    xAttackRowCnts = IM.update (\x -> Just (x - 1)) x (xAttackRowCnts structure),
                    yFreeRows = if yIsFree then IS.insert y (yFreeRows structure) else yFreeRows structure,
                    yAttackRowCnts = IM.update (\y -> Just (y - 1)) y (yAttackRowCnts structure)
                    })

structureQueryAttackRectangle :: (Monad m) => (Int, Int) -> (Int, Int) -> S.StateT Structure m Bool
structureQueryAttackRectangle (fromX, fromY) (toX, toY) = do
    structure <- S.get
    let
        xIsAttackRange = fromMaybe True (IS.lookupGE fromX (xFreeRows structure) <&> (> toX))
        yIsAttackRange = fromMaybe True (IS.lookupGE fromY (yFreeRows structure) <&> (> toY))
    return $ xIsAttackRange || yIsAttackRange

main :: IO ()
main = do
    [n, q] <- B8.getLine <&> readIntB8s

    flip S.evalStateT (emptyStructure n) $ do
        replicateM_ q $ do
            query <- liftIO (B8.getLine <&> readIntB8s)
            case query of
                [1, x, y] -> structureInsertRook (x, y)
                [2, x, y] -> structureRemoveRook (x, y)
                [3, fromX, fromY, toX, toY] -> do
                    answer <- structureQueryAttackRectangle (fromX, fromY) (toX, toY)
                    liftIO $ putsYesNo answer


You have number a, whose decimal representation quite luckily contains digits 1, 6, 8, 9. Rearrange the digits in its decimal representation so that the resulting number will be divisible by 7.Number a doesn't contain any leading zeroes and contains digits 1, 6, 8, 9 (it also can contain another digits). The resulting number also mustn't contain any leading zeroes.

The first line contains positive integer a in the decimal record. It is guaranteed that the record of number a contains digits: 1, 6, 8, 9. Number a doesn't contain any leading zeroes. The decimal representation of number a contains at least 4 and at most 106 characters.

Print a number in the decimal notation without leading zeroes — the result of the permutation. If it is impossible to rearrange the digits of the number a in the required manner, print 0.

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

import Data.List
import Data.Char

import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IntMap

main = getLine >>= (putStrLn . map intToDigit . solve . map digitToInt)

iterateN' 0 f x = x
iterateN' n f x = x `seq` iterateN' (n-1) f (f x)

pre :: Int -> [Int]
pre 0 = [9, 6, 1, 8]
pre 1 = [9, 8, 1, 6]
pre 2 = [9, 8, 6, 1]
pre 3 = [1, 9, 8, 6]
pre 4 = [1, 9, 6, 8]
pre 5 = [1, 6, 8, 9]
pre 6 = [6, 9, 8, 1]
pre n = pre $ n `mod` 7

count :: [Int] -> IntMap Int
count = foldl' (\(!m) d -> IntMap.insertWith (+) d 1 m) IntMap.empty

solve :: [Int] -> [Int]
solve xs = reverse $ iterateN' (IntMap.findWithDefault 0 0 mp) (0:) (pre (-10^4 * rm) ++ ys)
    where
        dec = IntMap.adjust (subtract 1)
        mp = dec 1 . dec 6 . dec 8 . dec 9 $ count xs
        (ys, rm) = IntMap.foldlWithKey' proc ([], 0) mp

        proc acc 0 _ = acc
        proc acc d c = iterateN' c (\(!st, !rm) -> (d:st, (10*rm + d) `mod` 7)) acc

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

import Data.List
import Data.Char

import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IntMap

-- import System.Random

main = getLine >>= (putStrLn . map intToDigit . solve . map digitToInt)

{- main = do
    gen <- getStdGen
    let xs = take (10^5) $ randomRs (0, 9) gen
    print xs
    print $ solve xs
    print $ count xs == count (solve xs) -}

iterateN' 0 f x = x
iterateN' n f x = x `seq` iterateN' (n-1) f (f x)

pre :: Int -> [Int]
pre 0 = [9, 6, 1, 8]
pre 1 = [9, 8, 1, 6]
pre 2 = [9, 8, 6, 1]
pre 3 = [1, 9, 8, 6]
pre 4 = [1, 9, 6, 8]
pre 5 = [1, 6, 8, 9]
pre 6 = [6, 9, 8, 1]
pre n = pre $ n `mod` 7

count :: [Int] -> IntMap Int
count = foldl' (\(!m) d -> IntMap.insertWith (+) d 1 m) IntMap.empty

solve :: [Int] -> [Int]
solve xs = reverse $ iterateN' (IntMap.findWithDefault 0 0 mp) (0:) (pre (-10^4 * rm) ++ ys)
    where
        dec = IntMap.adjust (subtract 1)
        mp = dec 1 . dec 6 . dec 8 . dec 9 $ count xs
        (ys, rm) = IntMap.foldlWithKey' proc ([], 0) mp

        proc acc 0 _ = acc
        proc acc d c = iterateN' c (\(!st, !rm) -> (d:st, (10*rm + d) `mod` 7)) acc

import Data.List
import Data.Char
import Data.Maybe
chars = "1689"
modulus = 7
base = 10
notFound = "0"
clearChars xs = foldr (\ f x -> f x) xs (map delete chars)
mods xs = foldl' (\p d-> mod (base * p + digitToInt d) modulus) 0 xs
findPrefix str = find suitable (permutations chars) where
	suitable prefix = (mod (mods prefix * modPower + modStr) modulus) == 0
	modPower 		= mods ('1':replicate (length str) '0')
	modStr   		= mods str
solution str =
	let cleared = clearChars str in
	let	prefix  = findPrefix cleared
	in case prefix of
		Just prefix -> Just (prefix ++ cleared)
		Nothing     -> Nothing

main = do
	str <- getLine
	putStrLn ( fromMaybe notFound ( solution str ) )

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

elim1689 s = delete '1' $ delete '6' $ delete '9' $ delete '8' s

modulo = 7

newtype Modulo = Modulo { getInteger :: Integer } deriving(Eq,Ord)
instance Num Modulo where
    Modulo a + Modulo b = Modulo ((a+b) `mod` modulo)
    Modulo a - Modulo b = Modulo ((a-b) `mod` modulo)
    Modulo a * Modulo b = Modulo ((a*b) `mod` modulo)
    abs (Modulo a) = Modulo (abs a)
    signum (Modulo a) = Modulo (signum a)
    fromInteger i = Modulo i
instance Fractional Modulo where
    recip (Modulo a) = Modulo (modInv a)
    fromRational = undefined

instance Show Modulo where
    show (Modulo i) = show i

modInv i = (modulo + x `mod` modulo) `mod` modulo
    where
    (x,y) = go i modulo
    go a 0 = (1,0)
    go a b = let (y,x) = go b (a `mod` b) in (x,y - a `div` b * x)

main = do
    s <- getLine
    let s' = elim1689 s
        v = fst (fromJust (B.readInteger (B.pack s'))) `mod` 7 :: Integer
        n = length s'
        q = getInteger (Modulo 10 ^ n)
    if n == 0 then
        putStrLn "1869"
    else do
        let Just x = find (\x -> (q * x + v) `mod` 7 == 0) [0..]
        putStrLn $ case x of
            0 -> "1869"++s'
            1 -> "1968"++ s'
            2 -> "1689"++ s'
            3 -> "6198"++ s'
            4 -> "1698"++ s'
            5 -> "1986"++ s'
            6 -> "1896"++ s'

#!/usr/bin/env runghc
import Data.List
import Data.Char
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (c:cs) = (:solve cs)$ f (permutations t)
  where
    t = "1689"
    s = c\\t
    f [] = "0"
    f (t:ts) = if r==0 then t++s else f ts
      where r = foldl (\r c->(r*10+ord c-ord '0')`mod`7) 0 (t++s)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

elim1689 s = delete '1' $ delete '6' $ delete '9' $ delete '8' s

main = do
    s <- getLine
    let s' = elim1689 s
        v = fst (fromJust (B.readInteger (B.pack s'))) `mod` 7 :: Integer
    if length s' == 0 then
        putStrLn "1869"
    else
        putStrLn $ case mod (v * 4) 7 of
            0 -> s'++"1869"
            1 -> s'++"1896"
            2 -> s'++"1986"
            3 -> s'++"1698"
            4 -> s'++"6198"
            5 -> s'++"1689"
            6 -> s'++"1968"

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

elim1689 s = delete '1' $ delete '6' $ delete '9' $ delete '8' s

main = do
    s <- getLine
    let s' = elim1689 s
        v = fst (fromJust (B.readInteger (B.pack s'))) `mod` 7 :: Integer
    if length s' == 0 then
        putStrLn "1896"
    else
        putStrLn $ case mod (v * 4) 7 of
            0 -> s'++"1896"
            1 -> s'++"1869"
            2 -> s'++"1986"
            3 -> s'++"1698"
            4 -> s'++"6198"
            5 -> s'++"1689"
            6 -> s'++"1968"