Little X has n distinct integers: p1, p2, ..., pn. He wants to divide all of them into two sets A and B. The following two conditions must be satisfied:  If number x belongs to set A, then number a - x must also belong to set A.  If number x belongs to set B, then number b - x must also belong to set B. Help Little X divide the numbers into two sets or determine that it's impossible.

The first line contains three space-separated integers n, a, b (1 ≤ n ≤ 105; 1 ≤ a, b ≤ 109). The next line contains n space-separated distinct integers p1, p2, ..., pn (1 ≤ pi ≤ 109).

If there is a way to divide the numbers into two sets, then print "YES" in the first line. Then print n integers: b1, b2, ..., bn (bi equals either 0, or 1), describing the division. If bi equals to 0, then pi belongs to set A, otherwise it belongs to set B. If it's impossible, print "NO" (without the quotes).

NoteIt's OK if all the numbers are in the same set, and the other one is empty.

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

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 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 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

{-# 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


Little Chris is very keen on his toy blocks. His teacher, however, wants Chris to solve more problems, so he decided to play a trick on Chris.There are exactly s blocks in Chris's set, each block has a unique number from 1 to s. Chris's teacher picks a subset of blocks X and keeps it to himself. He will give them back only if Chris can pick such a non-empty subset Y from the remaining blocks, that the equality holds:  "Are you kidding me?", asks Chris.For example, consider a case where s = 8 and Chris's teacher took the blocks with numbers 1, 4 and 5. One way for Chris to choose a set is to pick the blocks with numbers 3 and 6, see figure. Then the required sums would be equal: (1 - 1) + (4 - 1) + (5 - 1) = (8 - 3) + (8 - 6) = 7.  However, now Chris has exactly s = 106 blocks. Given the set X of blocks his teacher chooses, help Chris to find the required set Y!

The first line of input contains a single integer n (1 ≤ n ≤ 5·105), the number of blocks in the set X. The next line contains n distinct space-separated integers x1, x2, ..., xn (1 ≤ xi ≤ 106), the numbers of the blocks in X. Note: since the size of the input and output could be very large, don't use slow output techniques in your language. For example, do not use input and output streams (cin, cout) in C++.

In the first line of output print a single integer m (1 ≤ m ≤ 106 - n), the number of blocks in the set Y. In the next line output m distinct space-separated integers y1, y2, ..., ym (1 ≤ yi ≤ 106), such that the required equality holds. The sets X and Y should not intersect, i.e. xi ≠ yj for all i, j (1 ≤ i ≤ n; 1 ≤ j ≤ m). It is guaranteed that at least one solution always exists. If there are multiple solutions, output any of them.

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray,STArray)
import qualified Data.ByteString.Char8 as B

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

main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  print n
  putStrLn.unwords.map show $ solve n xs

s :: Int
s = 1000000

solve :: Int -> [Int] -> [Int]
solve n xs = runST $ do
  used <- newArray (0, s) False :: ST s (STUArray s Int Bool)
  forM_ xs $ \x -> do
    unsafeWrite used x True
  let go0 !cnt !res (x:xs) = do
         let !y = s+1-x
         flg <- unsafeRead used y
         if flg then do
           go0 cnt res xs
         else do
           unsafeWrite used y True
           go0 (cnt+1) (y:res) xs
      go0 cnt res [] = go1 cnt res 1

      go1 !cnt !res !i
        | cnt == n  = return res
        | otherwise = do
           let !j = s+1-i
           flg <- (||) <$> unsafeRead used i <*> unsafeRead used j
           if flg then do
             go1 cnt res (i+1)
           else do
             unsafeWrite used i True
             unsafeWrite used j True
             go1 (cnt+2) (i:j:res) (i+1)

  go0 0 [] xs

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray,STArray)
import qualified Data.ByteString.Char8 as B

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

main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  print n
  putStrLn.unwords.map show $ solve n xs

s :: Int
s = 1000000

solve :: Int -> [Int] -> [Int]
solve n xs = runST $ do
  used <- newArray (0, n) False :: ST s (STUArray s Int Bool)
  forM_ xs $ \x -> do
    unsafeWrite used x True
  let go0 !cnt !res (x:xs) = do
         let !y = s+1-x
         flg <- unsafeRead used y
         if flg then do
           go0 cnt res xs
         else do
           unsafeWrite used y True
           go0 (cnt+1) (y:res) xs
      go0 cnt res [] = go1 cnt res 1

      go1 !cnt !res !i
        | cnt == n  = return res
        | otherwise = do
           let !j = s+1-i
           flg <- (||) <$> unsafeRead used i <*> unsafeRead used j
           if flg then do
             unsafeWrite used i True
             unsafeWrite used j True
             go1 (cnt+2) (i:j:res) (i+1)
           else do
             go1 cnt res (i+1)

  go0 0 [] xs


InputThe first line contains a single integer n (1 ≤ n ≤ 1000) — the number of points on a plane.Each of the next n lines contains two real coordinates xi and yi of the  point, specified with exactly 2 fractional digits. All coordinates are between  - 1000 and 1000, inclusive.OutputOutput a single real number θ — the answer to the problem statement. The absolute or relative error of your answer should be at most 10 - 2.ExamplesInput8-2.14 2.06-1.14 2.04-2.16 1.46-2.14 0.70-1.42 0.40-0.94 -0.48-1.42 -1.28-2.16 -1.62Output5.410Input52.26 1.442.28 0.642.30 -0.301.58 0.663.24 0.66Output5.620Input86.98 2.066.40 1.125.98 0.245.54 -0.607.16 0.307.82 1.248.34 0.248.74 -0.76Output5.480Input510.44 2.0610.90 0.8011.48 -0.4812.06 0.7612.54 2.06Output6.040Input816.94 2.4215.72 2.3814.82 1.5814.88 0.5015.76 -0.1616.86 -0.2017.00 0.8816.40 0.92Output6.040Input720.62 3.0021.06 2.2821.56 1.3621.66 0.5621.64 -0.5222.14 2.3222.62 3.04Output6.720

The first line contains a single integer n (1 ≤ n ≤ 1000) — the number of points on a plane. Each of the next n lines contains two real coordinates xi and yi of the  point, specified with exactly 2 fractional digits. All coordinates are between  - 1000 and 1000, inclusive.

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

solve :: [Double] -> Double
solve a = let b = map fst $ filter (odd . snd)  $ zip a [0..]
          in  5.0 + sum b / (fromIntegral (length b))

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

solve :: [Double] -> Double
solve a = let b = map fst $ filter (odd . snd)  $ zip a [0..]
          in  5.0 + sum b / fromIntegral (length b)


You are given a string $$$s$$$ consisting of the characters '0', '1', and '?'. You need to replace all the characters with '?' in the string $$$s$$$ by '0' or '1' so that the string becomes a palindrome and has exactly $$$a$$$ characters '0' and exactly $$$b$$$ characters '1'. Note that each of the characters '?' is replaced independently from the others.A string $$$t$$$ of length $$$n$$$ is called a palindrome if the equality $$$t[i] = t[n-i+1]$$$ is true for all $$$i$$$ ($$$1 \le i \le n$$$).For example, if $$$s=$$$"01?????0", $$$a=4$$$ and $$$b=4$$$, then you can replace the characters '?' in the following ways:   "01011010";  "01100110". For the given string $$$s$$$ and the numbers $$$a$$$ and $$$b$$$, replace all the characters with '?' in the string $$$s$$$ by '0' or '1' so that the string becomes a palindrome and has exactly $$$a$$$ characters '0' and exactly $$$b$$$ characters '1'.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. The first line of each test case contains two integers $$$a$$$ and $$$b$$$ ($$$0 \le a, b \le 2 \cdot 10^5$$$, $$$a + b \ge 1$$$). The second line of each test case contains the string $$$s$$$ of length $$$a+b$$$, consisting of the characters '0', '1', and '?'. It is guaranteed that the sum of the string lengths of $$$s$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output:    "-1", if you can't replace all the characters '?' in the string $$$s$$$ by '0' or '1' so that the string becomes a palindrome and that it contains exactly $$$a$$$ characters '0' and exactly $$$b$$$ characters '1';  the string that is obtained as a result of the replacement, otherwise.  If there are several suitable ways to replace characters, you can output any.

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 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"
	| 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


There are n employees in Alternative Cake Manufacturing (ACM). They are now voting on some very important question and the leading world media are trying to predict the outcome of the vote.Each of the employees belongs to one of two fractions: depublicans or remocrats, and these two fractions have opposite opinions on what should be the outcome of the vote. The voting procedure is rather complicated:   Each of n employees makes a statement. They make statements one by one starting from employees 1 and finishing with employee n. If at the moment when it's time for the i-th employee to make a statement he no longer has the right to vote, he just skips his turn (and no longer takes part in this voting).  When employee makes a statement, he can do nothing or declare that one of the other employees no longer has a right to vote. It's allowed to deny from voting people who already made the statement or people who are only waiting to do so. If someone is denied from voting he no longer participates in the voting till the very end.  When all employees are done with their statements, the procedure repeats: again, each employees starting from 1 and finishing with n who are still eligible to vote make their statements.  The process repeats until there is only one employee eligible to vote remaining and he determines the outcome of the whole voting. Of course, he votes for the decision suitable for his fraction. You know the order employees are going to vote and that they behave optimal (and they also know the order and who belongs to which fraction). Predict the outcome of the vote.

The first line of the input contains a single integer n (1 ≤ n ≤ 200 000) — the number of employees.  The next line contains n characters. The i-th character is 'D' if the i-th employee is from depublicans fraction or 'R' if he is from remocrats.

Print 'D' if the outcome of the vote will be suitable for depublicans and 'R' if remocrats will win.

NoteConsider one of the voting scenarios for the first sample:   Employee 1 denies employee 5 to vote.  Employee 2 denies employee 3 to vote.  Employee 3 has no right to vote and skips his turn (he was denied by employee 2).  Employee 4 denies employee 2 to vote.  Employee 5 has no right to vote and skips his turn (he was denied by employee 1).  Employee 1 denies employee 4.  Only employee 1 now has the right to vote so the voting ends with the victory of depublicans.

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)

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

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


One way to create a task is to learn from math. You can generate some random math statement or modify some theorems to get something new and build a new task from that.For example, there is a statement called the "Goldbach's conjecture". It says: "each even number no less than four can be expressed as the sum of two primes". Let's modify it. How about a statement like that: "each integer no less than 12 can be expressed as the sum of two composite numbers." Not like the Goldbach's conjecture, I can prove this theorem.You are given an integer n no less than 12, express it as a sum of two composite numbers.

The only line contains an integer n (12 ≤ n ≤ 106).

Output two composite integers x and y (1 < x, y < n) such that x + y = n. If there are multiple solutions, you can output any of them.

NoteIn the first example, 12 = 4 + 8 and both 4, 8 are composite numbers. You can output "6 6" or "8 4" as well.In the second example, 15 = 6 + 9. Note that you can't output "1 14" because 1 is not a composite number.

{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

readInt = ( readLn :: IO Int )
getInts = map ( read :: String -> Int ) . words <$> getLine

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

main = do
	n <- readInt

	let
		m = which 6 9 $ even n

	printf "%d %d\n" m ( n - m )

import Control.Monad

import Data.Array.Unboxed

primes = primesToNA (2 * 10^6)
primesToNA n = 2: [i | i <- [3,5..n], ar ! i]
  where
    ar = f 5 $ accumArray (\ a b -> False) True (3,n)
                        [(i,()) | i <- [9,15..n]]
    f p a | q > n = a
          | True  = if null x then a2 else f (head x) a2
      where q = p*p
            a2  :: UArray Int Bool
            a2 = a // [(i,False) | i <- [q, q+2*p..n]]
            x  = [i | i <- [p+2,p+4..n], a2 ! i]

isPrime n = n `elem` primes

main = do
  n <- readLn

  putStrLn $ unwords $ map show $ head [ [i,j] | i <- [2..n-2], let j = n - i, not (isPrime i), not (isPrime j)]

main = do
    input <- getLine
    let n = read input
    if odd n then
        putStrLn $ ("9 " ++ (show $ n - 9))
    else
        putStrLn $ ("4 " ++ (show $ n - 4))

-- https://wiki.haskell.org/Converting_numbers
--
-- figure out how to convert fractional types to
-- integers and vice-versa

iscomp y e
  | y == e = False
  | (mod y e) == 0 = True
  | otherwise = iscomp y (e+1)

findsum a b
  | iscomp b 2 && iscomp (a-b) 2 = b
  | otherwise = findsum a (b+1)

main = do
  gg <- getLine
  let ss = (read gg)::Int
      hh = findsum ss 2

  putStr (show hh)
  putStr " "
  putStr (show (ss-hh))
  putStr "\n"

main = do
    n <- readLn
    let answer = if even n then [4, n - 4] else [9, n - 9]
    putStrLn $ unwords $ map show answer

main = do
    n <- readLn

    let
        primes = takeWhile (<= n) $ [2, 3] ++ (filter (\x -> and [x `mod` p /= 0 | p <- takeWhile (\p -> p*p <= x) primes]) [4..])

        (a, b) = head [(a, b) | a <- [2..n-2], let b = n-a, notElem a primes, notElem b primes]

    putStrLn $ show a ++ " " ++ show b

solve n
  | even n = [4,n-4]
  | otherwise = [9,n-9]
main = interact $ unwords . map show . solve . read

{-# 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 . (,)
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

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

main = do
    n <- readLn
    let a = primeArray n
    let (x,y) = head [ (x,y) | x <- [2..n-1], let y = n-x, not (a ! x) && not (a ! y) ]
    printf "%d %d\n" x y

import System.IO

main :: IO ()
main = getLine >>= putStrLn . (\(a,b) -> show a ++ " " ++ show b) . breakIntoComposite . read

breakIntoComposite :: Integer -> (Integer, Integer)
breakIntoComposite n = (first, n - first)
    where first = 4 + 5 * (n `mod` 2)

isPrime num = [x | x <- [1..num], num `mod` x == 0] == [1,num]
decompose x = [n:d:[] | n <- [2..x-2], let d = (x - n)]
sumNotPrimes n = concat $ take 1 [x:y:[] | [x,y] <- decompose n, isPrime x == False && isPrime y == False]
main = do
	str <- getLine
	(\[a,b] -> putStrLn ((show a) ++ " " ++ (show b))) $ sumNotPrimes (read str)

main = do
    aux <- getLine
    let n = read aux :: Int
    let xs = [x | x <- [4,5..(n-4)], complex x, complex (n - x)]
    putStrLn (show (head xs) ++ " " ++ show (n - (head xs)))

prime k = null [x | x <- [2..(k - 1)], mod k x == 0]

complex k = if (prime k) then (False) else (True)

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve. read.  head . lines
solve :: Int->String
solve x=if x `mod` 2 ==0 then "4" ++" "++ show (x-4) else let (y1,y2)=head [(a,b) |b<-[4,6..], let a = x-b, a `mod` 3 == 0] in  show y1 ++ " " ++ show y2

main = interact $ p . read
p a = if mod a 2 == 1 then "9 "++show (a-9) else "4 "++show (a-4)

main = interact $ p . read
p a = if odd a then "9 "++show (a-9) else "4 "++show (a-4)

getInt :: IO Int
getInt = readLn

isPrime :: Int -> Int -> Bool
isPrime a i | i > a `quot` 2 = True
            | a `mod` i == 0 = False
            | otherwise = isPrime a (i + 1)

divsum :: Int -> Int -> Int -> (Int, Int)
divsum a i j | i == 0 || j == a = (-1, -1)
             | (not (isPrime i 2)) && (not (isPrime j 2)) && (a == i + j) = (i, j)
             | otherwise = divsum a (i - 1) (j + 1)

out a = show (fst a) ++ " " ++ show (snd a)
solve a = putStrLn $ out (divsum a (a - 1) 1)
main = getInt >>= solve

import Control.Applicative
import Data.List

isprime x =all (/=0) [mod x i |i<-[2..(div x 2) ]]

main=do
    n<- read <$> getLine ::IO Int
    putStrLn $ intercalate " " $ map show $ head $ [ [i,j]|i<-[4..], not (isprime i), let j= n-i, not(isprime j)]

main :: IO ()
main = readLn >>= putStrLn . unwords . map show . solve

solve :: Int -> [Int]
solve n | even n = [ 4, n - 4 ]
        | otherwise = [ 9, n - 9 ]

import Prelude hiding (readList, showList)
import Control.Monad
import Control.Applicative
import Data.List

readList :: Read a => IO [a]
readList = fmap (fmap read . words) getLine

readList' :: Read a => a -> IO [a]
readList' _ = readList

readInt :: IO Int
readInt = head <$> readList' (undefined::Int)

showList :: Show a => [a] -> IO ()
showList = putStrLn . unwords . map show

skipLine :: IO ()
skipLine = void $ getLine

count :: (a -> Bool) -> [a] -> Int
count f = length . filter f

divUp :: Integral a => a -> a -> a
divUp x y
  | x `mod` y /= 0 = x `div` y + 1
  | otherwise      = x `div` y

u :: a
u = undefined

isComp :: Int -> Bool
isComp x = any ((==0) . mod x) [2..x-1]

isOk :: Int -> Int -> Bool
isOk x y = isComp x && isComp y

main :: IO ()
main = do
  n <- readInt
  let x= head $ filter (\x -> isOk x (n-x)) [2..n-1]
  showList [x,n-x]

main = do
    input <- getLine
    let n = read input
    if odd n then putStrLn $ ("9 " ++ (show $ n-9))
    else putStrLn $ ("4 " ++ (show $ n-4))

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

solve :: Int -> String
solve n = if odd n then "9 " ++ show (n - 9) else "4 " ++ show (n - 4)

main :: IO ()
main = interact $ solve . read

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = readLn >>= putStrLn.unwords.map show.solve

sieveLimit :: Int
sieveLimit = sieveWidth

sieveWidth :: Int
sieveWidth = 0xfffff

intSqrt :: Int -> Int
intSqrt x = floor . sqrt $ fromIntegral x

solve :: Int -> [Int]
solve n = head [[x,n-x]|x<-[2..], not(isPrime x), not (isPrime (n-x))]
   where
     isPrime 2 = True
     isPrime n | even n || n < 2= False
     isPrime n = unsafeAt isPrimeArray (n `quot` 2)
     !lim = (sieveLimit + sieveWidth - 1) `quot` sieveWidth * sieveWidth
     !isPrimeArray = runSTUArray $ do
       isp <- newArray (0, lim `quot` 2) True :: ST s (STUArray s Int Bool)
       unsafeWrite isp 0 False
       forM_ [0, sieveWidth .. lim - sieveWidth] $ \l -> do
         let !l2 = l `quot` 2
             !r  = l + sieveWidth
             !r2 = r `quot` 2
         forM_ [1 .. intSqrt r `quot` 2] $ \i-> do
           flg <- unsafeRead isp i
           when flg $ do
             let !p = 2 * i + 1
                 go !j = when (j < r2) $ do
                   unsafeWrite isp j False
                   go $ j + p
             go $ ((l2 - 2 * i * i) `quot` p + i) * p + i
       return isp

import Text.Printf

main = do
    n <- readLn
    if n `mod` 2 == 0
        then printf "%d %d\n" (8::Int) ((n - 8)::Int)
        else printf "%d %d\n" (9::Int) ((n - 9)::Int)

main = do
    n <- getLine >>= return . read
    let x = if even n then 4 else 9
    let y = n - x
    putStrLn $ unwords . map show $ [x, y]

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

main = do
  [n] <- getInts
  let
    solution
      | odd n = [9, n-9]
      | otherwise = [4, n-4]
  putStrLn $ unwords $ map show solution

-- helper functions --

readInt = fst . fromJust . B.readInt
getInts = map readInt . B.words <$> B.getLine

memoArr :: Ix i => (i, i) -> (i -> r) -> (i -> r)
memoArr range f = f' where
  f' i
    | Arr.inRange range i = arr ! i
    | otherwise = f i
  arr = Arr.listArray range (map f (Arr.range range))

dpArr :: Ix i => (i, i) -> ((i -> r) -> (i -> r)) -> (i -> r)
dpArr ixs f = fix (memoArr ixs . f)

isPrime :: Int -> Bool
isPrime 1 = False
isPrime n = null [x | x <- takeWhile (\m -> m*m <= n) [2..], n `mod` x == 0]

getComposite :: Int -> (Int, Int)
getComposite x = head [(m, x-m) | m <- [4..], not $ isPrime m, not $ isPrime (x-m)]

main = do
    n <- getLine
    let (a, b) = getComposite (read n)
    putStrLn ((show a) ++ " " ++ (show b))

import Control.Applicative

process a | even a = putStrLn ( "4 " ++ show (a-4))
	  | a==13 = putStrLn ( "4 9")
	  | a==15 = putStrLn ( "6 9")
	  | a==17 = putStrLn ("8 9")
          | mod a 5 == 1 = putStrLn ( "6 " ++ show (a-6))
	  | mod a 5 == 2 = putStrLn ( "12 " ++ show (a-12))
          | mod a 5 == 3 = putStrLn ( "8 " ++ show (a-8))
          | mod a 5 == 4 = putStrLn ( "4 " ++ show (a-4))
          | mod a 5 == 0 = putStrLn ( "10 " ++ show (a-10))

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

main = do
  n <- readLn :: IO Int
  putStr.show $ if odd n then 9 else 4
  putStrLn $ " " ++ show (if odd n then n - 9 else n - 4)

main = interact $ unwords . map show . solve . read
solve n = if even n then [4, n - 4] else [9, n - 9]

process :: Int -> (Int,Int)
process n = (x,n-x)
    where
        x = [6,4,8] !! (n `mod` 3)

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    let (a,b) = process n
    putStrLn (show a ++ " " ++ show b)

main = interact $ (\x -> if even x then "4 "++show (x-4) else "9 "++show (x-9)) . read

decomp :: Int -> [Int]
decomp n
    | even n = [4, n - 4]
    | otherwise = [9, n - 9]

solve :: String -> String
solve = unwords.fmap show.decomp.read

main :: IO ()
main = interact $ solve

isComp n = 0 `elem` (map (\x -> n `rem` x) [2.. (n `quot` 2)])
f n = head [(a,b) | a <- [3..(n `quot` 2)], let b = n - a,
                    isComp a, isComp b]
main = do
  k <-getLine
  let n = read k :: Int
      ans = f n
  putStrLn $ (show $ fst ans)++" "++(show $ snd ans)

f::Int -> [Int]
f x | even x = [4,x-4]
    | 1>0 = [9,x-9]
main = interact $ unwords.map show.f.read

main = do
    n <- readLn

    let
        primes = takeWhile (<= n) $ [2, 3] ++ (filter (\x -> and [x `mod` p /= 0 | p <- takeWhile (\p -> p*p <= x) primes]) [4..])

        (a, b) = head [(a, b) | a <- [2..n-2], let b = n-a, notElem a primes, notElem b primes]

    print $ show a ++ " " ++ show b

{-# 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 . (,)
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

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

main = do
    n <- readLn
    let a = primeArray n
    let (x,y) = head [ (x,y) | x <- [1..n], let y = n-x, not (a ! x) && not (a ! y) ]
    printf "%d %d\n" x y

getInt :: IO Int
getInt = readLn

isPrime :: Int -> Int -> Bool
isPrime a i | i > a `quot` 2 = True
            | a `mod` i == 0 = False
            | otherwise = isPrime a (i + 1)

divsum :: Int -> Int -> Int -> (Int, Int)
divsum a i j | i == 0 || j == a = (-1, -1)
             | (not (isPrime i 2)) && (not (isPrime j 2)) && (a == i + j) = (i, j)
             | otherwise = divsum a (i - 1) (j + 1)

solve a = putStrLn $ show (divsum a (a - 1) 1)
main = getInt >>= solve

main :: IO ()
main = readLn >>= putStrLn . unwords . map show . solve

solve :: Int -> [Int]
solve n | even n = [ 2, n - 2 ]
        | otherwise = [ 9, n - 9 ]

import Control.Applicative

main= do
	a<-   read  <$> getLine::IO Int
	if even a then putStrLn ( "4 " ++ show (a-4)) else if mod a 5 ==3 then putStrLn ( "8 " ++ show (a-8)) else putStrLn ( "6 " ++ show (a-6))

decomp :: Int -> [Int]
decomp n
    | even n = [2, n - 2]
    | otherwise = [9, n - 9]

solve :: String -> String
solve = unwords.fmap show.decomp.read

main :: IO ()
main = interact $ solve


A permutation is a sequence of integers from 1 to n of length n containing each number exactly once. For example, (1), (4, 3, 5, 1, 2), (3, 2, 1) are permutations, and (1, 1), (4, 3, 1), (2, 3, 4) are not. There are many tasks on permutations. Today you are going to solve one of them. Let’s imagine that somebody took several permutations (perhaps, with a different number of elements), wrote them down consecutively as one array and then shuffled the resulting array. The task is to restore the initial permutations if it is possible.

The first line contains an integer n (1 ≤ n ≤ 105). The next line contains the mixed array of n integers, divided with a single space. The numbers in the array are from 1 to 105.

If this array can be split into several permutations so that every element of the array belongs to exactly one permutation, print in the first line the number of permutations. The second line should contain n numbers, corresponding to the elements of the given array. If the i-th element belongs to the first permutation, the i-th number should be 1, if it belongs to the second one, then its number should be 2 and so on. The order of the permutations’ numbering is free. If several solutions are possible, print any one of them. If there’s no solution, print in the first line  - 1.

NoteIn the first sample test the array is split into three permutations: (2, 1), (3, 2, 1, 4, 5), (1, 2). The first permutation is formed by the second and the fourth elements of the array, the second one — by the third, the fifth, the sixth, the seventh and the ninth elements, the third one — by the first and the eigth elements. Clearly, there are other splitting variants possible.

import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import List
main = interact solve
solve input = output where
  [[n],nums] = map (map (read:: String -> Int)) $ map words $ lines input
  output = unlines $ map (unwords . map show) $
   if check e then [[m],xs] else [[-1]]
   where (xs,xm) = count nums
         e = zip (IntMap.toList xm) [1..]
         m = maximum xs
count :: [Int] -> ( [Int], IntMap Int)
count [] = ( [] , IntMap.empty )
count (x:xs) = if IntMap.member x ym
                   then ( ym IntMap.! x + 1 : ys , IntMap.adjust (+1) x ym )
                   else ( 1 : ys , IntMap.insert x 1 ym )
   where (ys,ym) = count xs
check :: [((Int,Int),Int)] -> Bool
check [((x,y),z)] = x==z
check (((x,y),z):((u,v),w):xs) = if y<v || x/=z then False else check (((u,v),w):xs)

import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import List
main = interact solve
solve input = output where
  [[n],nums] = map (map (read:: String -> Int)) $ map words $ lines input
  output = unlines $ map (unwords . map show) $
   if (check e) then [[m],xs] else [[-1]]
   where (xs,xm) = count nums
         e = sort $ IntMap.elems xm
         m = maximum xs
count :: [Int] -> ( [Int], IntMap Int)
count [] = ( [] , IntMap.empty )
count (x:xs) = if IntMap.member x ym
                   then ( ym IntMap.! x + 1 : ys , IntMap.adjust (+1) x ym )
                   else ( 1 : ys , IntMap.insert x 1 ym )
   where (ys,ym) = count xs
check :: [Int] -> Bool
check [_] = True
check (x:y:xs) = if x<y then False else check (y:xs)

import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import List
main = interact solve
solve input = output where
  [[n],nums] = map (map (read:: String -> Int)) $ map words $ lines input
  output = unlines $ map (unwords . map show) $
   if (check e && IntMap.member 1 xm) then [[m],xs] else [[-1]]
   where (xs,xm) = count nums
         e = IntMap.elems xm
         m = maximum xs
count :: [Int] -> ( [Int], IntMap Int)
count [] = ( [] , IntMap.empty )
count (x:xs) = if IntMap.member x ym
                   then ( ym IntMap.! x + 1 : ys , IntMap.adjust (+1) x ym )
                   else ( 1 : ys , IntMap.insert x 1 ym )
   where (ys,ym) = count xs
check :: [Int] -> Bool
check [_] = True
check (x:y:xs) = if x<y then False else check (y:xs)

import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
main = interact solve
solve input = output where
  [[n],nums] = map (map (read:: String -> Int)) $ map words $ lines input
  output = unlines $ map (unwords . map show) $ if (check e) then [[m],xs] else [[-1]]
   where (xs,xm) = count nums
         e = IntMap.elems xm
         m = maximum e
count :: [Int] -> ( [Int], IntMap Int)
count [] = ( [] , IntMap.empty )
count (x:xs) = if IntMap.member x ym
                   then ( ym IntMap.! x + 1 : ys , IntMap.adjust (+1) x ym )
                   else ( 1 : ys , IntMap.insert x 1 ym )
   where (ys,ym) = count xs
check :: [Int] -> Bool
check [_] = True
check (x:y:xs) = if x<y then False else check (y:xs)

import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
main = interact solve
solve input = output where
  [[n],nums] = map (map (read:: String -> Int)) $ map words $ lines input
  output = unlines $ map (unwords . map show) $
   if (check e) then [[m],xs] else [[-1]]
   where (xs,xm) = count nums
         e = IntMap.elems xm
         m = maximum xs
count :: [Int] -> ( [Int], IntMap Int)
count [] = ( [] , IntMap.empty )
count (x:xs) = if IntMap.member x ym
                   then ( ym IntMap.! x + 1 : ys , IntMap.adjust (+1) x ym )
                   else ( 1 : ys , IntMap.insert x 1 ym )
   where (ys,ym) = count xs
check :: [Int] -> Bool
check [_] = True
check (x:y:xs) = if x<y then False else check (y:xs)


Luntik has decided to try singing. He has $$$a$$$ one-minute songs, $$$b$$$ two-minute songs and $$$c$$$ three-minute songs. He wants to distribute all songs into two concerts such that every song should be included to exactly one concert.He wants to make the absolute difference of durations of the concerts as small as possible. The duration of the concert is the sum of durations of all songs in that concert.Please help Luntik and find the minimal possible difference in minutes between the concerts durations.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Each test case consists of one line containing three integers $$$a, b, c$$$ $$$(1 \le a, b, c \le 10^9)$$$ — the number of one-minute, two-minute and three-minute songs.

For each test case print the minimal possible difference in minutes between the concerts durations.

NoteIn the first test case, Luntik can include a one-minute song and a two-minute song into the first concert, and a three-minute song into the second concert. Then the difference will be equal to $$$0$$$.In the second test case, Luntik can include two one-minute songs and a two-minute song and a three-minute song into the first concert, and two three-minute songs into the second concert. The duration of the first concert will be $$$1 + 1 + 2 + 3 = 7$$$, the duration of the second concert will be $$$6$$$. The difference of them is $$$|7-6| = 1$$$.

{-# OPTIONS -Wall #-}

import Control.Monad

main :: IO ()
main = do
    numTests <- readLn
    replicateM_ numTests $ do
        [a, b, c] <- map read . words <$> getLine
        let (x, y) = go [c, b, a] 3 0 0
        print $ abs (x - y)
        return ()
  where
    go :: [Int] -> Int -> Int -> Int -> (Int, Int)
    go [] _ x y = (x, y)
    go (n:ns) k x y
      | n > 0 && abs (x - y) > k = go (n - 1:ns) k (min x y + k) (max x y)
      | otherwise =
        let half = n `div` 2
            less = half * k
            more = (n - half) * k
         in go ns (k - 1) (min x y + more) (max x y + less)