{-# LANGUAGE OverloadedStrings #-}

import Data.Array.IArray
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Monoid
import Control.Monad
import Debug.Trace
import Text.Printf

kmpJumpBack :: B.ByteString -> Array Int Int
kmpJumpBack str = arr
    where len    = B.length str
          arr    = listArray (0, len) $ [f i $ f'(i-1) | i <- [0..len]]
          f'     = (arr !)
          str' n = B.head $ B.drop (n-1) str
          f i k
            | i <= 1               = 0
            | str'(k+1) == str'(i) = k+1
            | k == 0               = 0
            | otherwise            = f i $ f' k

solve :: Int -> Int -> B.ByteString -> B.ByteString -> Maybe String
solve n alph str acc = f' 0 0
    where len = B.length str
          arr :: Array (Int, Int) (Maybe String)
          arr = listArray ((0,0), (n,len-1)) $
                   [f pos st | pos <- [0..n], st <- [0..len-1]]
          f'  = curry (arr !)

          acc' :: Int -> Int
          acc' pos = if pos < len then 0
                     else ord (B.head $ B.drop (pos - len) acc) - ord '0'

          jumpBack = (kmpJumpBack str !)
          str' n = B.head $ B.drop (n-1) str
          ch n = chr $ ord 'a' + n

          jump st i
             | str'(st+1) == ch i
                = if st + 1 == len
                     then (1, jumpBack(st+1))
                     else (0, st + 1)
             | st == 0    = (0,0)
             | otherwise  = jump (jumpBack st) i

          f pos st
           | pos == n   = Just []
           | otherwise  = getFirst $ mconcat [First $ tryJump i | i <- [0..alph-1]]
              where
                tryJump :: Int -> Maybe String
                tryJump i = do
                    let (a, st') = jump st i

                    guard $ a == acc'(pos+1)

                    ret <- f' (pos+1) st'
                    return $ chr (i + ord 'a'):ret

main = do
   [n, alph] <- (map read . words) `fmap` getLine
   [str]     <- B.words `fmap` B.getLine
   [acc]     <- B.words `fmap` B.getLine

   case solve n alph str acc of
      Just ans -> putStrLn ans
      Nothing  -> putStrLn "No solution"

{-# LANGUAGE OverloadedStrings #-}

import Data.Array.IArray
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Monoid
import Control.Monad
import Debug.Trace
import Text.Printf

kmpJumpBack :: B.ByteString -> Array Int Int
kmpJumpBack str = arr
    where len    = B.length str
          arr    = listArray (0, len) $ [f i $ f'(i-1) | i <- [0..len]]
          f'     = (arr !)
          str' n = B.head $ B.drop (n-1) str
          f i k
            | i <= 1               = 0
            | str'(k+1) == str'(i) = k+1
            | k == 0               = 0
            | otherwise            = f i $ f' k

jumpTable :: B.ByteString -> Int -> Array (Int, Int) (Int, Int)
jumpTable str alph = arr
    where len    = B.length str
          arr    = listArray ((0,0), (len-1, alph-1)) $
                     [f st i | st <- [0..len-1], i <- [0..alph-1]]
          f'     = curry (arr !)
          str' n = B.head $ B.drop (n-1) str
          ch x   = chr $ ord 'a' + x
          f st i
             | str'(st+1) == ch i
                = if st + 1 == len
                     then (1, jumpBack(st+1))
                     else (0, st + 1)
             | st == 0    = (0,0)
             | otherwise  = f (jumpBack st) i

          jumpBack = (kmpJumpBack str !)

solve :: Int -> Int -> B.ByteString -> B.ByteString -> Maybe String
solve n alph str acc = f' 0 0
    where len = B.length str
          arr :: Array (Int, Int) (Maybe String)
          arr = listArray ((0,0), (n,len-1)) $
                   [f pos st | pos <- [0..n], st <- [0..len-1]]
          f'  = curry (arr !)

          acc' :: Int -> Int
          acc' pos = if pos < len then 0
                     else ord (B.head $ B.drop (pos - len) acc) - ord '0'

          jumpTable' = jumpTable str alph
          jump = curry (jumpTable'!)

          f pos st
           | pos == n   = Just []
           | otherwise  = getFirst $ mconcat [First $ tryJump i | i <- [0..alph-1]]
              where
                tryJump :: Int -> Maybe String
                tryJump i = do
                    let (a, st') = jump st i

                    guard $ a == acc'(pos+1)

                    ret <- f' (pos+1) st'
                    return $ chr (i + ord 'a'):ret

main = do
   [n, alph] <- (map read . words) `fmap` getLine
   [str]     <- B.words `fmap` B.getLine
   [acc]     <- B.words `fmap` B.getLine

   case solve n alph str acc of
      Just ans -> putStrLn ans
      Nothing  -> putStrLn "No solution"

{-# LANGUAGE OverloadedStrings #-}

import Data.Array.IArray
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Monoid
import Control.Monad
import Debug.Trace
import Text.Printf

kmpJumpBack :: B.ByteString -> Array Int Int
kmpJumpBack str = arr
    where len    = B.length str
          arr    = listArray (0, len) $ [f i $ f'(i-1) | i <- [0..len]]
          f'     = (arr !)
          str' n = B.head $ B.drop (n-1) str
          f i k
            | i <= 1               = 0
            | str'(k+1) == str'(i) = k+1
            | k == 0               = 0
            | otherwise            = f i $ f' k

jumpTable :: B.ByteString -> Int -> Array (Int, Int) (Int, Int)
jumpTable str alph = arr
    where len    = B.length str
          arr    = listArray ((0,0), (len-1, alph-1)) $
                     [f st i | st <- [0..len-1], i <- [0..alph-1]]
          f'     = curry (arr !)
          str' n = B.head $ B.drop (n-1) str
          ch x   = chr $ ord 'a' + x
          f st i
             | str'(st+1) == ch i
                = if st + 1 == len
                     then (1, jumpBack(st+1))
                     else (0, st + 1)
             | st == 0    = (0,0)
             | otherwise  = f (jumpBack st) i

          jumpBack = (kmpJumpBack str !)

solve :: Int -> Int -> B.ByteString -> B.ByteString -> Maybe String
solve n alph str acc = f' 0 0
    where len = B.length str
          arr :: Array (Int, Int) (Maybe String)
          arr = listArray ((0,0), (n,len-1)) $
                   [f pos st | pos <- [0..n], st <- [0..len-1]]
          f'  = curry (arr !)

          acc' :: Int -> Int
          acc' pos = if pos < len then 0
                     else ord (B.head $ B.drop (pos - len) acc) - ord '0'

          jumpTable' = jumpTable str alph
          jump = curry (jumpTable'!)

          f pos st
           | pos == n   = Just []
           | otherwise  = getFirst $ mconcat [First $ tryJump i | i <- [0..alph-1]]
              where
                tryJump :: Int -> Maybe String
                tryJump i = do
                    let (a, st') = jump st i

                    guard $ a == acc'(pos+1)

                    ret <- f' (pos+1) st'
                    return $ chr (i + ord 'a'):ret

main = do
   [n, alph] <- (map read . words) `fmap` getLine
   str       <- B.getLine
   acc       <- B.getLine

   printf "%d %d %d %d\n" n alph (length $ B.unpack str) (length $ B.unpack acc)

   case solve n alph str acc of
      Just ans -> putStrLn ans
      Nothing  -> putStrLn "No solution"

{-# LANGUAGE OverloadedStrings #-}

import Data.Array.IArray
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Monoid
import Control.Monad
import Debug.Trace

kmpJumpBack :: B.ByteString -> Array Int Int
kmpJumpBack str = arr
    where len    = B.length str
          arr    = listArray (0, len) $ [f i $ f'(i-1) | i <- [0..len]]
          f'     = (arr !)
          str' n = B.head $ B.drop (n-1) str
          f i k
            | i <= 1               = 0
            | str'(k+1) == str'(i) = k+1
            | k == 0               = 0
            | otherwise            = f i $ f' k

jumpTable :: B.ByteString -> Int -> Array (Int, Int) (Int, Int)
jumpTable str alph = arr
    where len    = B.length str
          arr    = listArray ((0,0), (len-1, alph-1)) $
                     [f st i | st <- [0..len-1], i <- [0..alph-1]]
          f'     = curry (arr !)
          str' n = B.head $ B.drop (n-1) str
          ch x   = chr $ ord 'a' + x
          f st i
             | str'(st+1) == ch i
                = if st + 1 == len
                     then (1, jumpBack(st+1))
                     else (0, st + 1)
             | st == 0    = (0,0)
             | otherwise  = f (jumpBack st) i

          jumpBack = (kmpJumpBack str !)

solve :: Int -> Int -> B.ByteString -> B.ByteString -> Maybe String
solve n alph str acc = f' 0 0
    where len = B.length str
          arr :: Array (Int, Int) (Maybe String)
          arr = listArray ((0,0), (n,len-1)) $
                   [f pos st | pos <- [0..n], st <- [0..len-1]]
          f'  = curry (arr !)

          acc' :: Int -> Int
          acc' pos = if pos < len then 0
                     else ord (B.head $ B.drop (pos - len) acc) - ord '0'

          jumpTable' = jumpTable str alph
          jump = curry (jumpTable'!)

          f pos st
           | pos == n   = Just []
           | otherwise  = getFirst $ mconcat [First $ tryJump i | i <- [0..alph-1]]
              where
                tryJump :: Int -> Maybe String
                tryJump i = do
                    let (a, st') = jump st i

                    guard $ a == acc'(pos+1)

                    ret <- f' (pos+1) st'
                    return $ chr (i + ord 'a'):ret

main = do
   [n, alph] <- (map read . words) `fmap` getLine
   str       <- B.getLine
   acc       <- B.getLine

   case solve n alph str acc of
      Just ans -> putStrLn ans
      Nothing  -> putStrLn "No solution"


solve :: (Integer, Integer, Integer) -> Integer
solve (h, c, t)
  | 2 * t <= h + c     = 2
  | otherwise  = let
    n = 2 * t - h - c
    d = h - c
    q = quot d (2 * n)
    v1 = 2*q + 1
    v2 = v1 + 2
    in  if  (v1 + v2) * d <= v1 * v2 * 2 * n
         -- 1 / v1 - n / d <= n / d - 1 / v2
      then  v1  else  v2

parse :: String -> [(Integer, Integer, Integer)]
parse inp = [(h, c, t) | [h, c, t] <- map (map read . words) . tail $ lines inp]

main :: IO ()
main = interact (unlines . map (show . solve) . parse)

import Data.Int
import Data.Ratio

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

parse :: String -> (Int64, Int64, Int64)
parse s = (h, c, t)
  where
    [h, c, t] = map read . words $ s

solve :: (Int64, Int64, Int64) -> Int64
solve (h, c, t)
  | 2 * t <= h + c = 2
  | f n <= f (n + 1) = 2 * n + 1
  | otherwise = 2 * (n + 1) + 1
  where
    n = div (h - t) (2 * t - (h + c))
    f k = abs (fromIntegral t - ((k + 1) * h + k * c) % (2 * k + 1))

{-# LANGUAGE MultiWayIf #-}

import Data.List
import Data.Ratio

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

oddRoundDown n
  | (n `mod` 2 == 0) = if n >= 2 then n - 1 else n + 1
  | otherwise = n

oddRoundUp n
  | (n `mod` 2 == 0) = n + 1
  | otherwise = n

mixTemp :: Rational -> Rational -> Integer -> Rational
mixTemp c h numCups =
  let numH = ((numCups + 1) `div` 2) % 1
      numC = (numCups `div` 2) % 1
  in (numC * c + numH * h) / (numC + numH)

main = do
  input <- getContents
  let (_:vals) = read <$> split input :: [Integer]
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          hInt:cInt:tgtInt:rest  -> Just (res, rest) where
            res = let
              h = hInt % 1
              c = cInt % 1
              tgt = tgtInt % 1
              avg = (c+h) / 2
              in if
              | tgt <= avg  -> 2
              | otherwise   ->
                  let diff = tgt - avg
                      exact = (h - avg) / diff
                      num = numerator exact
                      denom = denominator exact
                      near1 = oddRoundDown $ num `div` denom
                      near2 = oddRoundUp $ (num + denom - 1) `div` denom
                      temp1 = mixTemp c h near1
                      temp2 = mixTemp c h near2
                  in  if abs (temp1 - tgt) <= abs (temp2 - tgt) then near1 else near2
        ) vals
  sequence_ (putStrLn . show <$> res)

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

main = getLine >>= flip replicateM_ test . read

test = do
    (h:c:t:_) <- map read . words <$> getLine
    if t == h
        then print 1
        else if t <= (c + h) `div` 2
                 then print 2
                 else do
                     let x = (t - h) `div` (c + h - 2 * t)
                     print $
                         ((+ 1) . (* 2)) $
                         minimumBy
                             (comparing (\x -> abs $ fromInteger t - (x * c + (x + 1) * h) % (2 * x + 1)))
                             [max (x - 5) 0 .. x + 5]

import Data.Ratio

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

parse :: String -> (Int, Int, Int)
parse s = (h, c, t)
  where
    [h, c, t] = map read . words $ s

solve :: (Int, Int, Int) -> Int
solve (h, c, t)
  | 2 * t <= h + c = 2
  | f n <= f (n + 1) = 2 * n + 1
  | otherwise = 2 * (n + 1) + 1
  where
    n = div (h - t) (2 * t - (h + c))
    f k = abs (fromIntegral t - ((k + 1) * h + k * c) % (2 * k + 1))

import Data.Ratio

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

parse :: String -> (Int, Int, Int)
parse s = (h, c, t)
  where
    [h, c, t] = map read . words $ s

solve :: (Int, Int, Int) -> Int
solve (h, c, t)
  | 2 * t <= h + c = 2
  | f n < f (n + 1) = 2 * n + 1
  | otherwise = 2 * (n + 1) + 1
  where
    n = div (h - t) (2 * t - (h + c))
    f k = abs (fromIntegral t - ((k + 1) * h + k * c) % (2 * k + 1))


import Control.Monad (replicateM_)

main :: IO ()
main = do
	n <- getLine
	replicateM_ (read n) $ do
		zm <- fmap (read . head . tail . words) getLine
		print (zm*2)

solve :: Int -> IO ()
solve 0 = return ()
solve t = do
    line <- getLine
    let [_, b] = map (\x -> read x :: Int) $ words line
    print $ 2 * b
    solve $ t - 1

main :: IO ()
main = do
    line <- getLine
    let t = read line :: Int
    solve t

main = interact $ unlines . map (show . solve) . pairs . map read . tail . words
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []
solve (_,x) = 2*x

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import qualified Data.Map as M

onecase = do
		[a,x]<-map read <$> words <$> getLine::IO [Int]
		print $ x+ x

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

process :: Int -> Int -> Int
process n x = 2*x

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    t <- fmap readInt getLine
    ts <- fmap (map (map readInt.words).lines) getContents
    mapM_ print $ map (\[n,x] -> process n x) ts

import Data.Char (ord)
import Control.Monad (replicateM_)

parseInt :: String -> Int
parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

solve :: [Int] -> Int
solve [_, x] = x * 2

main :: IO ()
main = do
  testNum <- fmap parseInt getLine
  replicateM_ testNum (print . solve . map parseInt . words =<< getLine)

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	t <- readInt
	replicateM t $ do
		[ x, n ] <- readInts
		print $ n * 2

main = interact $ unlines . map (show . solve) . pairs . map read . tail . words
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []
solve (_,x) = s !! (x-1)
s = go 0 [1..] where
  go i xs | null r = xs
          | otherwise = l ++ go (i+1) (tail r)
    where (l,r) = splitAt i xs


import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

import Data.List
import Data.Int

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put . P.tail . snd $ P.break (== '\n') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

readInt64s :: SIO [Int64]
readInt64s = do
  currLine <- readLine
  pure [fromIntegral x | Just (x, _) <- P.readInteger <$> P.words currLine]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, k] <- readInt64s
    x1 : x <- readInt64s
    let
      w = foldl' gcd 0 $ map (x1 -) x
    lift . P.putStrLn . P.pack $ if  mod (k-x1) w == 0
      then  "YES"
      else  "NO"

module Main where

import           Control.Monad                  ( foldM
                                                , replicateM
                                                , replicateM_
                                                )
import           Data.Array                     ( listArray )
import           Data.Foldable                  ( maximumBy )
import           Data.Int                       ( Int64 )
import qualified Data.Map                      as Map

solve :: Int64 -> [Int64] -> Bool
solve _ []       = False
solve k [x     ] = k == x
solve k (x : xs) = k == x || not (null xs') && (k - x) `mod` foldl1 gcd xs' == 0 where xs' = filter (/= 0) (subtract x <$> xs)

main :: IO ()
main = readLn >>= flip replicateM_ go
  where
    go = do
        k <- (!! 1) . fmap read . words <$> getLine
        r <- solve k . fmap read . words <$> getLine
        if r then putStrLn "YES" else putStrLn "NO"

import Control.Monad (replicateM_)
import Data.Functor ((<&>))

main :: IO ()
main = do
    let getList = getLine <&> words <&> map read
    [tests_n] <- getList
    replicateM_ tests_n $ do
        [n, k] <- getList
        xs <- getList
        let output = if canGetK k xs then "YES" else "NO"
        putStrLn output

canGetK :: Integral int => int -> [int] -> Bool
canGetK k [] = False
canGetK k (x:xs) = step `divides` (k - x)
    where
        relative_xs = map (subtract x) xs
        step = foldr gcd 0 relative_xs

divides :: (Integral int) => int -> int -> Bool
divides 0 x = x == 0
divides d x = mod x d == 0

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

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  [_, k] <- map read . words <$> getLine :: IO [Integer]
  xs <- map read . words <$> getLine :: IO [Integer]
  let d = foldl gcd 0 (zipWith (-) <*> tail $ sort xs)
  putStrLn $ bool "NO" "YES" $ k `mod` d == head xs `mod` d

module Main where

import           Control.Monad                  ( foldM
                                                , replicateM
                                                , replicateM_
                                                )
import           Data.Array                     ( listArray )
import           Data.Foldable                  ( maximumBy )
import qualified Data.Map                      as Map

solve :: Int -> [Int] -> Bool
solve _ []       = False
solve k [x     ] = k == x
solve k (x : xs) = k == x || not (null xs') && (k - x) `mod` foldl1 gcd xs' == 0 where xs' = filter (/= 0) (subtract x <$> xs)

main :: IO ()
main = readLn >>= flip replicateM_ go
  where
    go = do
        k <- (!! 1) . fmap read . words <$> getLine
        r <- solve k . fmap read . words <$> getLine
        if r then putStrLn "YES" else putStrLn "NO"

module Main where

import           Control.Monad                  ( foldM
                                                , replicateM
                                                , replicateM_
                                                )
import           Data.Array                     ( listArray )
import           Data.Foldable                  ( maximumBy )
import           Data.List
import qualified Data.Map                      as Map

-- >>> solve 1 $ sort [1,2]
-- True

solve :: Int -> [Int] -> Bool
solve _ []       = False
solve k [x     ] = k == x
solve k (x : xs) = k == x || not (null xs') && k - x `mod` foldl1 gcd xs' == 0 where xs' = filter (/= 0) (subtract x <$> xs)

main :: IO ()
main = readLn >>= flip replicateM_ go
  where
    go = do
        k <- (!! 1) . fmap read . words <$> getLine
        r <- solve k . fmap read . words <$> getLine
        if r then putStrLn "YES" else putStrLn "NO"


import Data.List
import Control.Monad
import Control.Monad.ST
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.Array.ST as STArray
import qualified Data.Array.Unboxed as UArray
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.Map.Strict as Map
-- import Data.Map.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> addX []
    Just (c, cs)
      | c' == ord ' ' || c' == ord '\r' -> addX $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where c' = fromIntegral c
    where addX = (case x of Nothing -> id; Just x' -> (x':))

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [(Id, Int)]
data ChainNode = ChainNode {
    nodeValue :: Int
  , nodeIndex :: Id
  , nodeNeighA :: Maybe ChainNode
  , nodeNeighB :: Maybe ChainNode
  }

chainItems (Chain _ xs) = xs

groupId :: Group -> Id
groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode i x) | (i, x) <- zip [0..] xs]
  buildNode i x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode {
        nodeValue = x
      , nodeIndex = i
      , nodeNeighA = neighbour a
      , nodeNeighB = neighbour b
      }
  traceItems :: Group -> ChainNode -> [(Id, Int)]
  traceItems g chain@(ChainNode { nodeValue = x, nodeIndex = i, nodeNeighA = na, nodeNeighB = nb })
    | g == G1 = if isNothing na || (nodeValue na' == x) then [item] else item : traceItems G2 na'
    | g == G2 = if isNothing nb || (nodeValue nb' == x) then [item] else item : traceItems G1 nb'
    where
      Just na' = na
      Just nb' = nb
      item = (i, x)
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node -> let
    na = nodeNeighA node
    nb = nodeNeighB node
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceItems G1 node]
      else Just [Chain G2 $ traceItems G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g items) =
  if length items `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    (i0, x0) = head items
    (i1, x1) = last items

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

getGroupMap :: Int -> [(Id, Group)] -> [Maybe Group]
getGroupMap n xs = map t . UArray.elems $ gs where
  t (-1) = Nothing
  t 0 = Just G1
  t 1 = Just G2

  gs :: UArray.UArray Int Id
  gs = STArray.runSTUArray $ do
    gs <- STArray.newArray (0, n - 1) (-1)
    forM_ xs $ \(i, g) -> STArray.writeArray gs i (groupId g)
    return gs

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = getGroupMap (length xs) . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(i, g) | (i, x) <- chainItems chain])
      sequence $ groupMap

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  case solve a b xs of
    No -> putStrLn "NO"
    Yes gs -> putStrLn "YES" >> putStrLn (unwords . map (show . groupId) $ gs)

import Data.List
import Control.Monad
import Control.Monad.ST
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.Array.ST as STArray
import qualified Data.Array as Array
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.Map.Strict as Map
-- import Data.Map.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> addX []
    Just (c, cs)
      | c' == ord ' ' || c' == ord '\r' -> addX $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where c' = fromIntegral c
    where addX = (case x of Nothing -> id; Just x' -> (x':))

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [(Id, Int)]
data ChainNode = ChainNode {
    nodeValue :: Int
  , nodeIndex :: Id
  , nodeNeighA :: Maybe ChainNode
  , nodeNeighB :: Maybe ChainNode
  }

chainItems (Chain _ xs) = xs

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode i x) | (i, x) <- zip [0..] xs]
  buildNode i x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode {
        nodeValue = x
      , nodeIndex = i
      , nodeNeighA = neighbour a
      , nodeNeighB = neighbour b
      }
  traceItems :: Group -> ChainNode -> [(Id, Int)]
  traceItems g chain@(ChainNode { nodeValue = x, nodeIndex = i, nodeNeighA = na, nodeNeighB = nb })
    | g == G1 = if isNothing na || (nodeValue na' == x) then [item] else item : traceItems G2 na'
    | g == G2 = if isNothing nb || (nodeValue nb' == x) then [item] else item : traceItems G1 nb'
    where
      Just na' = na
      Just nb' = nb
      item = (i, x)
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node -> let
    na = nodeNeighA node
    nb = nodeNeighB node
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceItems G1 node]
      else Just [Chain G2 $ traceItems G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g items) =
  if length items `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    (i0, x0) = head items
    (i1, x1) = last items

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

getGroupMap :: Int -> [(Id, Group)] -> [Maybe Group]
getGroupMap n xs = Array.elems gs where
  gs :: Array.Array Int (Maybe Group)
  gs = STArray.runSTArray $ do
    gs <- STArray.newArray (0, n - 1) Nothing
    forM_ xs $ \(i, g) -> STArray.writeArray gs i (Just g)
    return gs

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = getGroupMap (length xs) . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(i, g) | (i, x) <- chainItems chain])
      sequence $ groupMap

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  case solve a b xs of
    No -> putStrLn "NO"
    Yes gs -> putStrLn "YES" >> putStrLn (unwords . map (show . groupId) $ gs)

import Data.List
import Control.Monad
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.HashMap.Lazy as HashMap
-- import Data.HashMap.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> addX []
    Just (c, cs)
      | c' == ord ' ' || c' == ord '\r' -> addX $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where
        c' = fromIntegral c
    where addX = (case x of Nothing -> id; Just x' -> (x':))

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  print $ solve a b xs

import Data.List
import Control.Monad
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Map ((!))

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in  liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- return . map read . words =<< getLine
  print $ solve a b xs

{-# 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.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 . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

data Tree a = Null | Fork a (Tree a) (Tree a) deriving(Show)

empty :: Tree a
empty = Null

isEmpty :: Tree a -> Bool
isEmpty Null = True
isEmpty _ = False

minElem :: Tree a -> a
minElem (Fork a _ _) = a
minElem Null = error "min for empty queue is not supported"

deleteMin :: (Ord a) => Tree a -> Tree a
deleteMin (Fork _ a b) = merge a b

insert :: (Ord a) => a -> Tree a -> Tree a
insert x a = merge (Fork x Null Null) a

merge :: (Ord a) => Tree a -> Tree a -> Tree a
merge a Null = a
merge Null b = b
merge a b | minElem a <= minElem b = join a b
          | otherwise = join b a
    where
    join (Fork x a b) c = Fork x b (merge a c)

solve :: Int -> Int -> [Int] -> Maybe (S.Set Int,S.Set Int)
solve a b ps
    | a == b = guard (all (f.(a-)) ps) *> pure (S.fromList ps,S.empty)
    | otherwise = greedy queue S.empty S.empty s where
    s = S.fromList ps
    f p = p `S.member` s
    score p = length $ filter id $ [f (a - p),f (b - p)]
    queue :: Tree (Int,Int)
    queue = foldl (flip insert) Main.empty [ (k,p) | p <- ps, let k = score p ]
    greedy queue !as !bs !s
        | isEmpty queue = return (as, bs)
        | used = greedy (deleteMin queue) as bs s
        | k == 0 = Nothing
        | not $ S.member b' s = greedy (g (b - a') queue) as' bs  s'
        | not $ S.member a' s = greedy (g (a - b') queue) as  bs' s' where
           a' = a - p
           b' = b - p
           s' = S.delete p $ S.delete c $ s
           c  = if not $ S.member b' s then a' else b'
           as' = S.insert p $ S.insert a' as
           bs' = S.insert p $ S.insert b' bs
           (k,p) = minElem queue
           used = S.member p as || S.member p bs || k == 2
           g x queue | f x = insert (score x-1,x)$deleteMin queue
                     | otherwise = deleteMin queue

main = do
    [_,a,b] <- readInts
    ps <- readInts
    case solve a b ps of
        Nothing -> putStrLn "NO"
        Just (as,bs) -> do
            putStrLn "YES"
            let f p = if S.member p as then "0" else "1"
            putStrLn $ unwords $ map f ps

import Data.List
import Control.Monad
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.HashMap.Lazy as HashMap
-- import Data.HashMap.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> addX []
    Just (c, cs)
      | c' `elem` map ord " \t" -> addX $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where
        c' = fromIntegral c
    where addX = (case x of Nothing -> id; Just x' -> (x':))

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  print xs
  print $ solve a b xs

import Data.List
import Control.Monad
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.HashMap.Lazy as HashMap
-- import Data.HashMap.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> addX []
    Just (c, cs)
      | c' `elem` map ord " \n" -> addX $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where
        c' = fromIntegral c
    where addX = (case x of Nothing -> id; Just x' -> (x':))

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  print xs
  print $ solve a b xs

import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Map ((!))
import Debug.Trace

traceShow' x = traceShow x x

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Link = Link Group [Id] deriving Show
type GroupMap = Map.Map Id Group

instance Show Answer where
  show No = "No"
  show (Yes gs) = "YES\n" ++ unwords (map show' gs) where
    show' G1 = "0"
    show' G2 = "1"

otherGroup G1 = G2
otherGroup G2 = G1

putGroup :: Group -> GroupMap -> [Id] -> GroupMap
putGroup g = foldr (flip Map.insert g)

groupMapToAnswer :: [Int] -> Maybe GroupMap -> Answer
groupMapToAnswer _ Nothing = No
groupMapToAnswer xs (Just groupMap) =
  if Map.size groupMap == length xs then Yes $ Map.elems groupMap
  else No

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = groupMapToAnswer xs $
      -- flip applyLinks initGroupMap $ (traceShow' $ findLinks Set.empty xs)
      flip applyLinks initGroupMap $ findLinks Set.empty xs
    where
      n = length xs
      initGroupMap = Map.empty
      values = Map.fromList . zip [0..] $ xs
      idMap = Map.fromList $ zip xs [0..]

      findLinks :: Set.Set Int -> [Int] -> [Link]
      findLinks used [] = []
      findLinks used (x:xs) = let
        y = a - x
        z = b - x
        inIdMap = (`Map.member` idMap)
        notUsed = not . (`Set.member` used)
        f1 = inIdMap y && notUsed y
        f2 = inIdMap z && notUsed z
        mLink = if (not f1 && not f2) then []
          else if (f1 || f2) && (not (f1 && f2)) then
            if f1 then [Link G1 $ traceIds a x]
            else [Link G2 $ traceIds b x]
          else []
        used' = case mLink of
          [] -> used
          [(Link _ ids)] -> Set.union used . Set.fromList . map (values!) $ ids
        in mLink ++ findLinks used' xs

      traceIds :: Int -> Int -> [Int]
      traceIds t x =
        if not (x `Map.member` idMap) then []
        else (idMap!x) : if x + x == t then [] else traceIds (a + b - t) (t - x)
        -- else (idMap!x) : traceIds (a + b - t) (t - x)

      applyLinks :: [Link] -> GroupMap -> Maybe GroupMap
      applyLinks [] g = Just g
      applyLinks (x:xs) g = applyLink x g >>= applyLinks xs

      applyLink :: Link -> GroupMap -> Maybe GroupMap
      applyLink link@(Link g ids) groupMap = let
        x0 = values ! head ids
        x1 = values ! last ids
        in if length ids `mod` 2 == 0 then
          -- put all ids to group g
          Just $ putGroup g groupMap ids
        else if g == G1 && x0 * 2 == b || g == G2 && x0 * 2 == a then
          -- put all ids to group other than g
          Just $ putGroup (otherGroup g) groupMap ids
        else if g == G1 && x1 * 2 == a || g == G2 && x1 * 2 == b then
          -- put all ids to group g
          Just $ putGroup g groupMap ids
        else
          Nothing

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- return . map read . words =<< getLine
  print $ solve a b xs

import Data.List
import Control.Monad
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.HashMap.Lazy as HashMap
-- import Data.HashMap.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> addX []
    Just (c, cs)
      | c' `elem` map ord " \n\r\t" -> addX $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where
        c' = fromIntegral c
    where addX = (case x of Nothing -> id; Just x' -> (x':))

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  print xs
  print $ solve a b xs

import Data.List
import Control.Monad
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.HashMap.Lazy as HashMap
-- import Data.HashMap.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> case x of
      Nothing -> []
      Just x' -> [x']
    Just (c, cs)
      | c' == ord ' ' -> (case x of Nothing -> id; Just x' -> (x':)) $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where
        c' = fromIntegral c

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  print $ solve a b xs

import Data.List
import Data.Char
import Control.Monad
import Data.Maybe
import Debug.Trace
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.HashMap.Lazy as HashMap
-- import Data.HashMap.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' 0 where
  readInts' x s = case B.uncons s of
    Nothing -> []
    Just (c, cs)
      | c' == ord ' ' -> x : readInts' x cs
      | otherwise -> readInts' (x * 10 + c' - ord '0') cs
      where
        c' = fromIntegral c

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  print $ solve a b xs

import Data.List
import Control.Monad
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.HashMap.Lazy as HashMap
-- import Data.HashMap.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> addX []
    Just (c, cs)
      | c' `elem` map ord " \r" -> addX $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where
        c' = fromIntegral c
    where addX = (case x of Nothing -> id; Just x' -> (x':))

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  print xs
  print $ solve a b xs

import Data.List
import Control.Monad
import Control.Monad.ST
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.Array.ST as STArray
import qualified Data.Array as Array
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.Map.Strict as Map
-- import Data.Map.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> addX []
    Just (c, cs)
      | c' == ord ' ' || c' == ord '\r' -> addX $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where c' = fromIntegral c
    where addX = (case x of Nothing -> id; Just x' -> (x':))

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [(Id, Int)]
data ChainNode = ChainNode {
    nodeValue :: Int
  , nodeIndex :: Id
  , nodeNeighA :: Maybe ChainNode
  , nodeNeighB :: Maybe ChainNode
  }

chainItems (Chain _ xs) = xs

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode i x) | (i, x) <- zip [0..] xs]
  buildNode i x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode {
        nodeValue = x
      , nodeIndex = i
      , nodeNeighA = neighbour a
      , nodeNeighB = neighbour b
      }
  traceItems :: Group -> ChainNode -> [(Id, Int)]
  traceItems g chain@(ChainNode { nodeValue = x, nodeIndex = i, nodeNeighA = na, nodeNeighB = nb })
    | g == G1 = if isNothing na || (nodeValue na' == x) then [item] else item : traceItems G2 na'
    | g == G2 = if isNothing nb || (nodeValue nb' == x) then [item] else item : traceItems G1 nb'
    where
      Just na' = na
      Just nb' = nb
      item = (i, x)
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node -> let
    na = nodeNeighA node
    nb = nodeNeighB node
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceItems G1 node]
      else Just [Chain G2 $ traceItems G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g items) =
  if length items `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    (i0, x0) = head items
    (i1, x1) = last items

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

getGroupMap :: Int -> [(Id, Group)] -> [Maybe Group]
getGroupMap n xs = Array.elems gs where
  gs :: Array.Array Int (Maybe Group)
  gs = STArray.runSTArray $ do
    gs <- STArray.newArray (0, n - 1) Nothing
    forM_ xs $ \(i, g) -> STArray.writeArray gs i (Just g)
    return gs

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = getGroupMap (length xs) . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(i, g) | (i, x) <- chainItems chain])
      sequence $ groupMap

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  case solve a b xs of
    No -> putStrLn "No"
    Yes gs -> putStrLn "YES" >> putStrLn (unwords . map (show . groupId) $ gs)

import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Map ((!))
import Debug.Trace

traceShow' x = traceShow x x

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Link = Link Group [Id] deriving Show
type GroupMap = Map.Map Id Group

instance Show Answer where
  show No = "No"
  show (Yes gs) = "YES\n" ++ unwords (map show' gs) where
    show' G1 = "0"
    show' G2 = "1"

otherGroup G1 = G2
otherGroup G2 = G1

putGroup :: Group -> GroupMap -> [Id] -> GroupMap
putGroup g = foldr (flip Map.insert g)

groupMapToAnswer :: Maybe GroupMap -> Answer
groupMapToAnswer Nothing = No
groupMapToAnswer (Just groupMap) = Yes $ Map.elems groupMap

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = groupMapToAnswer $
      flip applyLinks initGroupMap . checkLinks =<< sequence (findLinks Set.empty xs)
    where
      n = length xs
      initGroupMap = Map.empty
      values = Map.fromList . zip [0..] $ xs
      idMap = Map.fromList $ zip xs [0..]

      checkLinks :: [Link] -> [Link]
      checkLinks links =
        if (sum . map (\(Link g ids) -> length ids) $ links) == n
        then links
        else error $ "check link failed" ++ show links

      findLinks :: Set.Set Int -> [Int] -> [Maybe Link]
      findLinks used [] = []
      findLinks used (x:xs) = let
        y = a - x
        z = b - x
        inIdMap = (`Map.member` idMap)
        notUsed = not . (`Set.member` used)
        f1 = inIdMap y && notUsed y
        f2 = inIdMap z && notUsed z
        mLink = if (not f1 && not f2) then [Nothing]
          else if (f1 || f2) && (not (f1 && f2)) then
            if f1 then [Just $ Link G1 $ traceIds a x]
            else [Just $ Link G2 $ traceIds b x]
          else []
        used' = case mLink of
          [] -> used
          [Nothing] -> used
          [Just (Link _ ids)] -> Set.union used . Set.fromList . map (values!) $ ids
        in mLink ++ findLinks used' xs

      traceIds :: Int -> Int -> [Int]
      traceIds t x =
        if not (x `Map.member` idMap) then []
        else (idMap!x) : if x + x == t then [] else traceIds (a + b - t) (t - x)
        -- else (idMap!x) : traceIds (a + b - t) (t - x)

      applyLinks :: [Link] -> GroupMap -> Maybe GroupMap
      applyLinks [] g = Just g
      applyLinks (x:xs) g = applyLink x g >>= applyLinks xs

      applyLink :: Link -> GroupMap -> Maybe GroupMap
      applyLink link@(Link g ids) groupMap = let
        x0 = values ! head ids
        x1 = values ! last ids
        in if length ids `mod` 2 == 0 then
          -- put all ids to group g
          Just $ putGroup g groupMap ids
        else if g == G1 && x0 * 2 == b || g == G2 && x0 * 2 == a then
          -- put all ids to group other than g
          Just $ putGroup (otherGroup g) groupMap ids
        else if g == G1 && x1 * 2 == a || g == G2 && x1 * 2 == b then
          -- put all ids to group g
          Just $ putGroup g groupMap ids
        else
          Nothing

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- return . map read . words =<< getLine
  print $ solve a b xs

import Data.List
import Control.Monad
import Data.Char
import Data.Maybe
import Debug.Trace
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.HashMap.Lazy as HashMap
-- import Data.HashMap.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' Nothing where
  readInts' :: Maybe Int -> B.ByteString -> [Int]
  readInts' x s = case B.uncons s of
    Nothing -> case x of
      Nothing -> []
      Just x' -> [x']
    Just (c, cs)
      | c' == ord ' ' -> (case x of Nothing -> id; Just x' -> (x':)) $ readInts' Nothing cs
      | otherwise -> readInts' (Just $ (maybe 0 id x) * 10 + c' - ord '0') cs
      where
        c' = fromIntegral c

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  print xs
  print $ solve a b xs

import Data.List
import Data.Char
import Control.Monad
import Data.Maybe
import Debug.Trace
import qualified Data.ByteString as B
import qualified Data.Set as Set

-- import qualified Data.HashMap.Lazy as HashMap
-- import Data.HashMap.Lazy ((!))

import qualified Data.Map as Map
import Data.Map ((!))

-- Utils

readInts :: IO [Int]
readInts = B.getLine >>= return . readInts' 0 . (\s -> traceShow (B.length s) s) where
  readInts' x s = case B.uncons s of
    Nothing -> []
    Just (c, cs)
      | c' == ord ' ' -> x : readInts' x cs
      | otherwise -> readInts' (x * 10 + c' - ord '0') cs
      where
        c' = fromIntegral c

-- End of Utils

data Group = G1 | G2 deriving (Show, Eq)
data Answer = No | Yes [Group]
type Id = Int
data Chain = Chain Group [Id]
data ChainNode = ChainNode Int (Maybe ChainNode) (Maybe ChainNode)

instance Show Answer where
  show No = "NO"
  show (Yes gs) = "YES\n" ++ unwords (map (show . groupId) gs)

nodeValue (ChainNode x _ _) = x
chainValues (Chain _ values) = values

groupId G1 = 0
groupId G2 = 1

otherGroup G1 = G2
otherGroup G2 = G1

findChains :: Int -> Int -> [Int] -> Maybe [Chain]
findChains a b xs = let
  nodes = Map.fromList [(x, buildNode x) | x <- xs]
  buildNode x = let
    neighbour t = Map.lookup (t - x) nodes
    in ChainNode x (neighbour a) (neighbour b)
  traceValues :: Group -> ChainNode -> [Int]
  traceValues g (ChainNode x na nb)
      | g == G1 = if isNothing na || (nodeValue na' == x) then [x] else x : traceValues G2 na'
      | g == G2 = if isNothing nb || (nodeValue nb' == x) then [x] else x : traceValues G1 nb'
      where
        Just na' = na
        Just nb' = nb
  in liftM concat . sequence . flip map (Map.elems nodes) $ \node@(ChainNode x na nb) -> let
    Just (ChainNode y _ _) = na
    Just (ChainNode z _ _) = nb
    in if isNothing na && isNothing nb then Nothing
      else if isJust na && isJust nb then Just []
      else if isJust na then Just [Chain G1 $ traceValues G1 node]
      else Just [Chain G2 $ traceValues G2 node]

markChain :: Int -> Int -> Chain -> Maybe Group
markChain a b (Chain g values) =
  if length values `mod` 2 == 0 then Just g
  else if x0 + x0 == [b, a]!!groupId g then Just (otherGroup g)
  else if x1 + x1 == [a, b]!!groupId g then Just g
  else Nothing
  where
    x0 = head values
    x1 = last values

solveSame :: Int -> [Int] -> Answer
solveSame a xs = let
  xsSet = Set.fromList xs
  haveAns = all (`Set.member` xsSet) . map (a -) $ xs
  in if haveAns then Yes $ map (const G1) xs else No

solve :: Int -> Int -> [Int] -> Answer
solve a b xs
  | a == b = solveSame a xs
  | otherwise = maybe No Yes $ do
      chains <- findChains a b xs
      groups <- sequence . map (markChain a b) $ chains
      let groupMap = Map.fromList . flip concatMap (zip groups chains) $ (
            \(g, chain) -> [(x, g) | x <- chainValues chain])
      sequence $ map (`Map.lookup` groupMap) xs

main = do
  [n, a, b] <- return . map read . words =<< getLine
  xs <- readInts
  print $ solve a b xs


import Control.Monad
import Data.List (words)
import Data.Sequence (Seq,Seq (Empty, (:<|), (:|>)), fromList, (><), (<|), (|>), empty)
import Data.Foldable (toList)

-- ex:
-- 4 4
-- 01?????0

type SChar = Seq Char

calc1 :: SChar -> Int -> Int -> SChar -> SChar -> (Int,Int,SChar)
calc1 Empty a b pref suf = (a,b, pref >< suf)
calc1 ('1' :<| Empty) a b pref suf = (a,b-1, pref >< ('1' <| suf))
calc1 ('0' :<| Empty) a b pref suf = (a-1,b, pref >< ('0' <| suf))
calc1 (x :<| Empty) a b pref suf = (a,b, pref >< (x <| suf))
calc1 s a b pref suf =
  let (x1 :<| xs1) = s
      (xs :|> xn) = xs1
  in
    case (x1,xn) of
      ('?','1') -> calc1 xs a (b-2) (pref |> '1') (xn <| suf)
      ('1','?') -> calc1 xs a (b-2) (pref |> x1) ('1' <| suf)
      ('?','0') -> calc1 xs (a-2) b (pref |> '0') (xn <| suf)
      ('0','?') -> calc1 xs (a-2) b (pref |> x1) ('0' <| suf)
      ('0','0') -> calc1 xs (a-2) b (pref |> x1) (xn <| suf)
      ('1','1') -> calc1 xs a (b-2) (pref |> x1) (xn <| suf)
      (_,_) -> calc1 xs a b (pref |> x1) (xn <| suf)

calc2 :: SChar -> Int -> Int -> SChar -> SChar -> SChar
calc2 Empty a b _ _ | a /= 0 || b /= 0 = fromList "-1"
calc2 Empty 0 0 pref suf = pref >< suf
calc2 ('?':<|Empty) a b pref suf
  | a == 1 && b == 0 = pref >< ('0' <| suf)
  | a == 0 && b == 1 = pref >< ('1' <| suf)
  | otherwise = fromList "-1"
calc2 ('1' :<| Empty) a b pref suf = calc2 empty a b pref ('1' <| suf)
calc2 ('0' :<| Empty) a b pref suf = calc2 empty a b pref ('0' <| suf)
calc2 (x :<| Empty) _ _ _ _ = fromList "-1"

calc2 s a b pref suf | a<0 && b<0 = fromList "-1"
calc2 s a b pref suf =
  let (x1 :<| xs1) = s
      (xs :|> xn) = xs1
  in
    case (x1,xn) of
      ('?','?') | a>1 -> calc2 xs (a-2) b (pref |> '0') ('0' <| suf)
      ('?','?') | b>1 -> calc2 xs a (b-2) (pref |> '1') ('1' <| suf)
      (_,_) -> calc2 xs a b (pref |> x1) (xn <| suf)

calc :: String -> Int -> Int -> String
calc line a b =
  let sq = fromList line
      (a',b',sq') = calc1 sq a b empty empty
  in
    toList $ calc2 sq' a' b' empty empty

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

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L

result :: Int -> Int -> String -> String
result a b str'
	| not isP = "-1"
	| a + b /= n = "-1"
	| mod a 2 == 1 && mod b 2 == 1 = "-1"
	| S.size val /= div (a-num0) 2 = "-1"
	| sum [1|s<-solution, s=='0'] /= a = "-1"
	| otherwise = solution
	where
		n = length str'
		num0 = sum [1 | s <- str, s=='0']
		two_ = [i | (i, s) <- zip [0..(div n 2 - 1)] str, s == '?', strM ! (n-1-i) == '?']
		isP = foldr (\i b-> (&&) b $ strM ! i == strM ! (n-1-i)) True $ [0..(div n 2 - 1)]

		strM' = M.fromList $ zip [0..] str'
		strM = M.fromList $ zip [0..] str
		str = fmap aux [0..(n-1)] where
			aux i
				| strM' ! i /= '?' = strM' ! i
				| strM' ! (n-1-i) /= '?' = strM' ! (n-1-i)
				| mod n 2 == 1 && i == div n 2 = if mod a 2 == 0 then '1' else '0'
				| otherwise = '?'

		val = S.fromList $ take (div (a-num0) 2) two_
		aux0 (i, s)
			| s /= '?' = s
			| s == '?' && (S.member i val || S.member (n-1-i) val) = '0'
			| otherwise = '1'

		solution = fmap aux0 $ zip [0..] str

main = do
	t <- getLine >>= return . read :: IO Int

	let loop t = if t==0 then return () else do
		l <- getLine >>= return . (fmap read) . words :: IO [Int]
		let (a, b) = (l !! 0, l !! 1)

		str <- getLine

		putStrLn $ result a b str

		loop $ t - 1

	loop t

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L

result :: Int -> Int -> String -> String
result a b str'
	| not isP = "-1"
	| a + b /= n = "-1"
	| mod a 2 == 1 && mod b 2 == 1 = "-1"
	| length val /= div (a-num0) 2 = "-1"
	| otherwise = fmap aux0 $ zip [0..] str
	where
		n = length str'
		num0 = sum [1 | s <- str, s=='0']
		two_ = [i | (i, s) <- zip [0..(div n 2 - 1)] str, s == '?', str !! (n-1-i) == '?']
		isP = foldr (\i b-> (&&) b $ str !! i == str !! (n-1-i)) True $ [0..(div n 2 - 1)]

		str = fmap aux [0..(n-1)] where
			aux i
				| str' !! i /= '?' = str' !! i
				| str' !! (n-1-i) /= '?' = str' !! (n-1-i)
				| mod n 2 == 1 && i == div n 2 = if mod a 2 == 0 then '1' else '0'
				| otherwise = '?'

		val = take (div (a-num0) 2) two_
		aux0 (i, s)
			| s /= '?' = s
			| s == '?' && (elem i val || elem (n-1-i) val) = '0'
			| otherwise = '1'

main = do
	t <- getLine >>= return . read :: IO Int

	let loop t = if t==0 then return () else do
		l <- getLine >>= return . (fmap read) . words :: IO [Int]
		let (a, b) = (l !! 0, l !! 1)

		str <- getLine

		putStrLn $ result a b str

		loop $ t - 1

	loop t

import Control.Monad
import Data.List (words)
import Data.Sequence (Seq,Seq (Empty, (:<|), (:|>)), fromList, (><), (<|), (|>), empty)
import Data.Foldable (toList)

-- ex:
-- 4 4
-- 01?????0

type SChar = Seq Char

calc1 :: SChar -> Int -> Int -> SChar -> SChar -> (Int,Int,SChar)
calc1 Empty a b pref suf = (a,b, pref >< suf)
calc1 ('1' :<| Empty) a b pref suf = (a,b-1, pref >< ('1' <| suf))
calc1 ('0' :<| Empty) a b pref suf = (a-1,b, pref >< ('0' <| suf))
calc1 (x :<| Empty) a b pref suf = (a,b, pref >< (x <| suf))
calc1 s a b pref suf =
  let (x1 :<| xs1) = s
      (xs :|> xn) = xs1
  in
    case (x1,xn) of
      ('?','1') -> calc1 xs a (b-2) (pref |> '1') (xn <| suf)
      ('1','?') -> calc1 xs a (b-2) (pref |> x1) ('1' <| suf)
      ('?','0') -> calc1 xs (a-2) b (pref |> '0') (xn <| suf)
      ('0','?') -> calc1 xs (a-2) b (pref |> x1) ('0' <| suf)
      ('0','0') -> calc1 xs (a-2) b (pref |> x1) (xn <| suf)
      ('1','1') -> calc1 xs a (b-2) (pref |> x1) (xn <| suf)
      (_,_) -> calc1 xs a b (pref |> x1) (xn <| suf)

calc2 :: SChar -> Int -> Int -> SChar -> SChar -> SChar
calc2 Empty a b _ _ | a /= 0 || b /= 0 = fromList "-1"
calc2 Empty 0 0 pref suf = pref >< suf
calc2 ('?':<|Empty) a b pref suf
  | a == 1 && b == 0 = pref >< ('0' <| suf)
  | a == 0 && b == 1 = pref >< ('1' <| suf)
  | otherwise = fromList "-1"
calc2 ('1' :<| Empty) a b pref suf = calc2 empty a b pref ('1' <| suf)
calc2 ('0' :<| Empty) a b pref suf = calc2 empty a b pref ('0' <| suf)
calc2 (x :<| Empty) _ _ _ _ = fromList "-1"

calc2 s a b pref suf | a<0 && b<0 = fromList "-1"
calc2 s a b pref suf =
  let (x1 :<| xs1) = s
      (xs :|> xn) = xs1
  in
    case (x1,xn) of
      ('?','?') | a>0 -> calc2 xs (a-2) b (pref |> '0') ('0' <| suf)
      ('?','?') | b>0 -> calc2 xs a (b-2) (pref |> '1') ('1' <| suf)
      (_,_) -> calc2 xs a b (pref |> x1) (xn <| suf)

calc :: String -> Int -> Int -> String
calc line a b =
  let sq = fromList line
      (a',b',sq') = calc1 sq a b empty empty
  in
    toList $ calc2 sq' a' b' empty empty

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


import Data.Sequence( empty, viewl, spanl, (<|), fromList, null,
			ViewL( EmptyL, (:<)), (><), (|>))
import qualified Data.Sequence as SEQ
main = do
    getLine
    statements_ <- getLine
    let tailSeq seq = case viewl seq    of
			EmptyL		-> empty
			(_:<rem)	-> rem
	drop1stn _ 0 sequence = sequence
	drop1stn e n sequence =
	    case viewl sequence of
		EmptyL	    -> empty
		s:<stRem    -> if e==s
				then drop1stn e (n-1) stRem
				else s<|drop1stn e n stRem
	oppo 'R' = 'D'
	oppo 'D' = 'R'
	proc sequence =
	    let
		s:<stRem = viewl sequence
		(friends, enemyHeaded) = spanl (s==) stRem
		sz = 1 + SEQ.length friends
		nextSeq = (drop1stn (oppo s) sz enemyHeaded) ><
				(s <| friends)
	    in
		if SEQ.null enemyHeaded
		    then [s]
		    else proc nextSeq
    putStr . proc $ fromList statements_

import Data.Sequence( empty, viewl, spanl, (<|), fromList, null,
			ViewL( EmptyL, (:<)), (><), (|>))
import qualified Data.Sequence as SEQ
main = do
    getLine
    statements_ <- getLine
    let tailSeq seq = case viewl seq    of
			EmptyL		-> empty
			(_:<rem)	-> rem
	drop1stn _ _ EmptyL = empty
	drop1stn _ 0 (s:<stRem) = s<|stRem
	drop1stn e n (s:<stRem)
	  | e==s		= drop1stn e (n-1) (viewl stRem)
	  | otherwise		= s<|drop1stn e n (viewl stRem)
	oppo 'R' = 'D'
	oppo 'D' = 'R'
	proc (s:<stRem) =
	    let
		(friends, enemyHeaded) = spanl (s==) stRem
		sz = 1 + SEQ.length friends
		nextSeq = (drop1stn (oppo s) sz$viewl enemyHeaded) ><
				(s <| friends)
	    in
		if SEQ.null enemyHeaded
		    then [s]
		    else proc $ viewl nextSeq
    putStr . proc . viewl $ fromList statements_

simulate = walk "" 0
  where walk past future []
          | all (== head past) past = [head past]
          | otherwise               = walk "" future $ reverse past
        walk past future ('D' : s)
          | future < 0 = walk past (future+1) s
          | otherwise  = walk ('D' : past) (future+1) s
        walk past future ('R' : s)
          | future > 0 = walk past (future-1) s
          | otherwise  = walk ('R' : past) (future-1) s

main = do
  s <- getContents
  let voters = lines s !! 1
  putStrLn $ simulate voters

import Control.Monad
import Data.List
import qualified Data.Sequence as S

main = do
    n <- read `fmap` getLine :: IO Int
    s <- zip [0..] `fmap` getLine
    let (d, r) = partition (\(_,c) -> c == 'D') s
    let d' = S.fromList $ map fst d
    let r' = S.fromList $ map fst r
    let (d'', r'') = fight n d' r'
    if S.length d'' == 0
    then putStrLn "R"
    else putStrLn "D"

type Queue = S.Seq Int

fight :: Int -> Queue -> Queue -> (Queue, Queue)
fight n d r
    | S.length d == 0 = (d, r)
    | S.length r == 0 = (d, r)
    | head' d < head' r = fight n (tail' d S.|> (head' d + n)) (tail' r)
    | otherwise = fight n (tail' d) (tail' r S.|> (head' r + n))

head' q = S.index q 0
tail' q = S.drop 1 q
last' q = S.index q (S.length q - 1)

solve = walk 0 0 0
  where walk k m s [] | s > 0 || s == 0 && k > 0 = "D"
                      | s < 0 || s == 0 && m > 0 = "R"
                      | otherwise = show (k, m, s)
        walk k 0 s ('D' : rest) = walk (k+1) 0 (s+1) rest
        walk k m s ('D' : rest) = walk k (m-1) s rest
        walk 0 k s ('R' : rest) = walk 0 (k+1) (s-1) rest
        walk k m s ('R' : rest) = walk (k-1) m s rest

main = do
  s <- getContents
  let voters = lines s !! 1
  putStrLn $ solve voters

solve voters@(first : _) = walk 0 0 0 voters
  where walk k m s [] | k - m + s > 0 = "D"
                      | k - m + s < 0 = "R"
                      | otherwise     = [first]
        walk k 0 s ('D' : rest) = walk (k+1) 0 (s+1) rest
        walk k m s ('D' : rest) = walk k (m-1) s rest
        walk 0 k s ('R' : rest) = walk 0 (k+1) (s-1) rest
        walk k m s ('R' : rest) = walk (k-1) m s rest

main = do
  s <- getContents
  let voters = lines s !! 1
  putStrLn $ solve voters

solve voters@(first : _) = walk 0 0 0 voters
  where walk k m s [] | s > 0 || s == 0 && k > 0 = "D"
                      | s < 0 || s == 0 && m > 0 = "R"
                      | otherwise                = [first]
        walk k 0 s ('D' : rest) = walk (k+1) 0 (s+1) rest
        walk k m s ('D' : rest) = walk k (m-1) s rest
        walk 0 k s ('R' : rest) = walk 0 (k+1) (s-1) rest
        walk k m s ('R' : rest) = walk (k-1) m s rest

main = do
  s <- getContents
  let voters = lines s !! 1
  putStrLn $ solve voters