Fox Ciel saw a large field while she was on a bus. The field was a n × m rectangle divided into 1 × 1 cells. Some cells were wasteland, and other each cell contained crop plants: either carrots or kiwis or grapes. After seeing the field carefully, Ciel found that the crop plants of each cell were planted in following procedure:  Assume that the rows are numbered 1 to n from top to bottom and the columns are numbered 1 to m from left to right, and a cell in row i and column j is represented as (i, j).  First, each field is either cultivated or waste. Crop plants will be planted in the cultivated cells in the order of (1, 1) → ... → (1, m) → (2, 1) → ... → (2, m) → ... → (n, 1) → ... → (n, m). Waste cells will be ignored.  Crop plants (either carrots or kiwis or grapes) will be planted in each cell one after another cyclically. Carrots will be planted in the first cell, then kiwis in the second one, grapes in the third one, carrots in the forth one, kiwis in the fifth one, and so on. The following figure will show you the example of this procedure. Here, a white square represents a cultivated cell, and a black square represents a waste cell.  Now she is wondering how to determine the crop plants in some certain cells.

In the first line there are four positive integers n, m, k, t (1 ≤ n ≤ 4·104, 1 ≤ m ≤ 4·104, 1 ≤ k ≤ 103, 1 ≤ t ≤ 103), each of which represents the height of the field, the width of the field, the number of waste cells and the number of queries that ask the kind of crop plants in a certain cell. Following each k lines contains two integers a, b (1 ≤ a ≤ n, 1 ≤ b ≤ m), which denotes a cell (a, b) is waste. It is guaranteed that the same cell will not appear twice in this section. Following each t lines contains two integers i, j (1 ≤ i ≤ n, 1 ≤ j ≤ m), which is a query that asks you the kind of crop plants of a cell (i, j).

For each query, if the cell is waste, print Waste. Otherwise, print the name of crop plants in the cell: either Carrots or Kiwis or Grapes.

Waste
Grapes
Carrots
Kiwis
Carrots
Carrots

NoteThe sample corresponds to the figure in the statement.

module Main where

import Control.Monad
import Data.Array.IO
import Data.Array
import Data.List
import Data.Ix

data SegTree w a = SegTree w (SegNode a) deriving Show
data SegNode a = SegLeave a | SegBranch a (SegNode a) (SegNode a) deriving Show

newSegTree :: (Integral w, Num v) => w -> v -> SegTree w v
newSegTree w v =
    let newSegNode w v =
            if w == 1
            then SegLeave v
            else let
                w1 = w `div` 2
                w2 = w - w1
            in SegBranch (v * (fromIntegral w)) (newSegNode w1 v) (newSegNode w2 v)
    in SegTree w $ newSegNode w v

updateSegTree :: (Integral i, Num a) => SegTree i a -> i -> a -> SegTree i a
updateSegTree (SegTree w n) i v =
    let updateSegNode (SegLeave v0) w i v = SegLeave (v0+v)
        updateSegNode (SegBranch v0 left right) w i v =
            let w1 = w `div` 2
                w2 = w - w1
                (left', right') = if i < w1
                    then (updateSegNode left w1 i v, right)
                    else (left, updateSegNode right w2 (i-w1) v)
            in SegBranch (v0+v) left' right'
    in SegTree w (updateSegNode n w i v)

pickSegTree :: (Integral i, Num a) => SegTree i a -> i -> a
pickSegTree (SegTree w n) i =
    let pickSegNode (SegLeave v) _ _ = v
        pickSegNode (SegBranch v left right) w i =
            let w1 = w `div` 2
                w2 = w - w1
            in if i < w1
            then pickSegNode left w1 i
            else pickSegNode right w2 (i-w1)
    in pickSegNode n w i

leftHalfSegTree :: (Integral i, Num a) => SegTree i a -> i -> a
leftHalfSegTree (SegTree w n) i =
    let leftHalfSegNode (SegLeave v) w i = if i < 0
            then 0
            else v
        leftHalfSegNode (SegBranch v left right) w i =
            let w1 = w `div` 2
                w2 = w - w1
            in if i < 0
            then 0
            else if i < w
            then leftHalfSegNode left w1 i + leftHalfSegNode right w2 (i-w1)
            else v
    in leftHalfSegNode n w i

showName n = case (n-1) `mod` 3 of
    0 -> "Carrots"
    1 -> "Kiwis"
    2 -> "Grapes"

main = do
    [n, m, k, t] <- ( map read . words ) `liftM` getLine

    let seg = newSegTree (n*m) 1
    --putStrLn $ show seg

    seg' <-iterate (\seg0' -> do
            seg0 <- seg0'
            [a, b] <- ( map read . words ) `liftM` getLine
            return $ updateSegTree seg0 ((a-1)*m+(b-1)) (-1)
        ) (return seg) !! k
    --putStrLn $ show seg'

    replicateM_ t $ do
        [i, j] <- ( map read . words ) `liftM` getLine
        let p = (i-1)*m+(j-1)

        if pickSegTree seg' p == 0
            then putStrLn "Waste"
            else putStrLn $ showName $ leftHalfSegTree seg' p

nth :: Int -> [(Int, Int)] -> Int -> Int -> Int
nth m block i j
	| elem (i, j) block = 3
	| otherwise = (m * (i-1) + (j-1) - (length . filter (\(x,y) -> x < i || x == i && y < j)) block) `mod` 3

getLines :: Int -> IO [(Int, Int)]
getLines 0 = return []
getLines n = do x <- getLine >>= return . (\x -> (head x, last x)) . map read . words; xs <- getLines (n-1); return (x:xs)

main = do
	[n,m,k,t] <- getLine >>= return . map read . words :: IO [Int]
	block <- getLines k
	query <- getLines t
	(putStr . unlines . map (\i -> ["Carrots", "Kiwis", "Grapes", "Waste"] !! i)) [ nth m block x y | (x,y) <- query ]

import Data.List

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

solve :: [[Int]] -> [String]
solve ((n:m:k:t:_):xs) = map (f m wastes) queries
  where
  wastes = sort $ take k xs
  queries = take t $ drop k xs

f :: Int -> [[Int]] -> [Int] -> String
f m wastes query@[x,y]
  | not (null b) && head b == query = "Waste"
  | otherwise = ["Carrots", "Kiwis", "Grapes"] !! rem (x*m-m+y-1-length a) 3
  where
  (a, b) = span (< query) wastes

import List

type Cell = (Int, Int)

number :: (Int, Int) -> Int -> Cell -> Int
number      range    cntEmpty  cell  = (fst cell - 1) * snd range + snd cell - cntEmpty

numberCell :: (Int, Int) -> [Cell] -> Cell -> Int
numberCell    range        emptyCells cell  = numberCell' range 0 emptyCells cell
  where
    numberCell' range cntEmpty []       cell  = number range cntEmpty cell
    numberCell' range cntEmpty (ec:ecs) cell
      | ec < cell  =  numberCell' range (cntEmpty + 1) ecs cell
      | ec > cell  =  numberCell' range cntEmpty [] cell
      | otherwise  =  0

ans :: Int -> String
ans 0  =  "Waste"
ans 1  =  "Carrots"
ans 2  =  "Kiwis"
ans 3  =  "Grapes"
ans n  =  ans (mod (n - 1) 3 + 1)

printAns :: [Int] -> IO ()
printAns [] = return ()
printAns (x:xs) = do
  putStrLn $ ans x
  printAns xs

readCell :: Int -> IO Cell
readCell _ = do
  line <- getLine
  let [a, b] = map read $ words line
  return (a, b)

main = do
  line <- getLine
  let [n, m, k, t] = map read $ words line
  emptyCells <- sequence (map readCell [1..k])
  cells      <- sequence (map readCell [1..t])
  printAns (map (numberCell (n, m) (sort emptyCells)) cells)

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, ImplicitParams #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Foreign
import Foreign.C
import Data.List
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
-- import qualified Data.Map as Map
import qualified Data.IntSet as Set

main :: IO ()
main = do
  _   :: Int        <- input
  m   :: Int        <- input
  k   :: Int        <- input
  t   :: Int        <- input
  let checkWasteCells acc !i | i >= k     = return acc
                             | otherwise  = do
                                 a   :: Int        <- input
                                 b   :: Int        <- input
                                 checkWasteCells (Set.insert ((a - 1) * m + (b - 1)) acc) (i + 1)
  wasteCells <- checkWasteCells Set.empty 0
  let a          = listArray (0, k - 1) (Set.toList wasteCells)     :: UArray Int Int
      candidates = listArray (0, 2) ["Carrots", "Kiwis", "Grapes"]  :: Array  Int String
  rep t $ \_ -> do
    i   :: Int        <- input
    j   :: Int        <- input
    let !v = (i - 1) * m + (j - 1)
    if Set.member v wasteCells
      then output' ("Waste" :: String)
      else do
        let loop !n | n < k, a ! n <= v   = loop (n + 1)
                    | otherwise           = do
                        let idx = (v - n) `mod` 3
                        output'  $ candidates ! idx
        loop 0

--------------------------------------------------
-- Imported C functions
--------------------------------------------------
#define BUFMAX                (100005)

type BString = BS.ByteString

foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i     :: CString -> Ptr Int   -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i64   :: CString -> Ptr Int64 -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_f     :: CString -> Ptr Float -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_s     :: CString -> CString   -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i    :: CString -> Int       -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i64  :: CString -> Int64     -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_d    :: CString -> Double    -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_s    :: CString -> CString   -> IO ()

fmt_i, fmt_i64, fmt_f, fmt_d, fmt_s :: CString
fmt_i   = unsafePerformIO $ newCString "%d"
fmt_i64 = unsafePerformIO $ newCString "%I64d"
fmt_f   = unsafePerformIO $ newCString "%f"
fmt_d   = unsafePerformIO $ newCString "%.16f"
fmt_s   = unsafePerformIO $ newCString "%s"
{-# NOINLINE fmt_i    #-}
{-# NOINLINE fmt_i64  #-}
{-# NOINLINE fmt_f    #-}
{-# NOINLINE fmt_d    #-}
{-# NOINLINE fmt_s    #-}

ptr_i   :: Ptr Int
ptr_i   = unsafePerformIO malloc
ptr_i64 :: Ptr Int64
ptr_i64 = unsafePerformIO malloc
ptr_f   :: Ptr Float
ptr_f   = unsafePerformIO malloc
ptr_d   :: Ptr Double
ptr_d   = unsafePerformIO malloc
ptr_s   :: CString
ptr_s   = unsafePerformIO $ mallocArray BUFMAX
{-# NOINLINE ptr_i    #-}
{-# NOINLINE ptr_i64  #-}
{-# NOINLINE ptr_f    #-}
{-# NOINLINE ptr_d    #-}
{-# NOINLINE ptr_s    #-}

class Input a           where
  input :: IO a

instance Input Int      where
  input = c_scanf_i fmt_i ptr_i >> peek ptr_i
instance Input Int64    where
  input = c_scanf_i64 fmt_i64 ptr_i64 >> peek ptr_i64
instance Input Integer  where
  input = toInteger <$> (input :: IO Int64)
instance Input Double   where
  input = c_scanf_f fmt_f ptr_f >> realToFrac <$> peek ptr_f
instance Input String   where
  input = c_scanf_s fmt_s ptr_s >> peekCString ptr_s
instance Input BString  where
  input = c_scanf_s fmt_s ptr_s >> BS.packCString ptr_s

class Output a          where
  output_   :: a -> IO ()
  output    :: a -> IO ()
  output    = (>> space  ) . output_
  output'   :: a -> IO ()
  output'   = (>> newline) . output_

instance Output Int     where
  output_   = c_printf_i fmt_i
instance Output Int64   where
  output_   = c_printf_i64 fmt_i64
instance Output Integer where
  output_   = output_ . show
instance Output Double  where
  output_   = c_printf_d fmt_d
instance Output String  where
  output_   = flip withCString (c_printf_s fmt_s)
instance Output BString where
  output_   = flip BS.useAsCString (c_printf_s fmt_s)

space   :: IO ()
space   = output_ (" "  :: String)

newline :: IO ()
newline = output_ ("\n" :: String)

for :: Int -> Int -> (Int -> IO ()) -> IO ()
for !begin !end k = loop begin
  where loop !i | i >= end  = return ()
                | otherwise = k i >> loop (i + 1)

rep :: Int -> (Int -> IO ()) -> IO ()
rep = for 0

nth :: Int -> [(Int, Int)] -> Int -> Int -> Int
nth m block i j
	| elem (i, j) block = 3
	| otherwise = (m * i + j - (length . filter (\(x,y) -> x < i || x == i && y < j)) block) `mod` 3

getLines :: Int -> IO [(Int, Int)]
getLines 0 = return []
getLines n = do x <- getLine >>= return . (\x -> (head x, last x)) . map read . words; xs <- getLines (n-1); return (x:xs)

main = do
	[n,m,k,t] <- getLine >>= return . map read . words :: IO [Int]
	block <- getLines k
	query <- getLines t
	(putStr . unlines . map (\i -> ["Carrots", "Kiwis", "Grapes", "Waste"] !! i)) [ nth m block x y | (x,y) <- query ]

import List

type Cell = (Int, Int)

number :: (Int, Int) -> Int -> Cell -> Int
number      range    cntEmpty  cell  = (fst cell - 1) * snd range + snd cell - cntEmpty

numberCell :: (Int, Int) -> [Cell] -> Cell -> Int
numberCell    range        emptyCells cell  = numberCell' range 0 emptyCells cell
  where
    numberCell' range cntEmpty []       cell  = number range cntEmpty cell
    numberCell' range cntEmpty (ec:ecs) cell
      | ec < cell  =  numberCell' range (cntEmpty + 1) ecs cell
      | ec > cell  =  numberCell' range cntEmpty [] cell
      | otherwise  =  0

ans :: Int -> String
ans 0  =  "Waste"
ans 1  =  "Carrots"
ans 2  =  "Kiwis"
ans 3  =  "Grapes"
ans n  =  ans (mod (n - 1) 3 + 1)

printAns :: [Int] -> IO ()
printAns [] = return ()
printAns (x:xs) = do
  print $ ans x
  printAns xs

readCell :: Int -> IO Cell
readCell _ = do
  line <- getLine
  let [a, b] = map read $ words line
  return (a, b)

main = do
  line <- getLine
  let [n, m, k, t] = map read $ words line
  emptyCells <- sequence (map readCell [1..k])
  cells      <- sequence (map readCell [1..t])
  printAns (map (numberCell (n, m) (sort emptyCells)) cells)

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, ImplicitParams #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Foreign
import Foreign.C
import Data.List
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
-- import qualified Data.Map as Map
import qualified Data.IntSet as Set

main :: IO ()
main = do
  _   :: Int        <- input
  m   :: Int        <- input
  k   :: Int        <- input
  t   :: Int        <- input
  let checkWasteCells acc !i | i >= k     = return acc
                             | otherwise  = do
                                 a   :: Int        <- input
                                 b   :: Int        <- input
                                 checkWasteCells (Set.insert ((a - 1) * m + (b - 1)) acc) (i + 1)
  wasteCells <- checkWasteCells Set.empty 0
  let a          = listArray (0, k - 1) (Set.toList wasteCells)     :: UArray Int Int
      candidates = listArray (0, 2) ["Carrots", "Kiwis", "Grapes"]  :: Array  Int String
  rep t $ \_ -> do
    i   :: Int        <- input
    j   :: Int        <- input
    let !v = (i - 1) * m + (j - 1)
    if Set.member v wasteCells
      then output' ("Waste" :: String)
      else do
        let loop !n | n < k, v <= a ! n   = loop (n + 1)
                    | otherwise           = do
                        let idx = (v - (n + 1)) `mod` 3
                        output'  $ candidates ! idx
        loop 0

--------------------------------------------------
-- Imported C functions
--------------------------------------------------
#define BUFMAX                (100005)

type BString = BS.ByteString

foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i     :: CString -> Ptr Int   -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i64   :: CString -> Ptr Int64 -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_f     :: CString -> Ptr Float -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_s     :: CString -> CString   -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i    :: CString -> Int       -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i64  :: CString -> Int64     -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_d    :: CString -> Double    -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_s    :: CString -> CString   -> IO ()

fmt_i, fmt_i64, fmt_f, fmt_d, fmt_s :: CString
fmt_i   = unsafePerformIO $ newCString "%d"
fmt_i64 = unsafePerformIO $ newCString "%I64d"
fmt_f   = unsafePerformIO $ newCString "%f"
fmt_d   = unsafePerformIO $ newCString "%.16f"
fmt_s   = unsafePerformIO $ newCString "%s"
{-# NOINLINE fmt_i    #-}
{-# NOINLINE fmt_i64  #-}
{-# NOINLINE fmt_f    #-}
{-# NOINLINE fmt_d    #-}
{-# NOINLINE fmt_s    #-}

ptr_i   :: Ptr Int
ptr_i   = unsafePerformIO malloc
ptr_i64 :: Ptr Int64
ptr_i64 = unsafePerformIO malloc
ptr_f   :: Ptr Float
ptr_f   = unsafePerformIO malloc
ptr_d   :: Ptr Double
ptr_d   = unsafePerformIO malloc
ptr_s   :: CString
ptr_s   = unsafePerformIO $ mallocArray BUFMAX
{-# NOINLINE ptr_i    #-}
{-# NOINLINE ptr_i64  #-}
{-# NOINLINE ptr_f    #-}
{-# NOINLINE ptr_d    #-}
{-# NOINLINE ptr_s    #-}

class Input a           where
  input :: IO a

instance Input Int      where
  input = c_scanf_i fmt_i ptr_i >> peek ptr_i
instance Input Int64    where
  input = c_scanf_i64 fmt_i64 ptr_i64 >> peek ptr_i64
instance Input Integer  where
  input = toInteger <$> (input :: IO Int64)
instance Input Double   where
  input = c_scanf_f fmt_f ptr_f >> realToFrac <$> peek ptr_f
instance Input String   where
  input = c_scanf_s fmt_s ptr_s >> peekCString ptr_s
instance Input BString  where
  input = c_scanf_s fmt_s ptr_s >> BS.packCString ptr_s

class Output a          where
  output_   :: a -> IO ()
  output    :: a -> IO ()
  output    = (>> space  ) . output_
  output'   :: a -> IO ()
  output'   = (>> newline) . output_

instance Output Int     where
  output_   = c_printf_i fmt_i
instance Output Int64   where
  output_   = c_printf_i64 fmt_i64
instance Output Integer where
  output_   = output_ . show
instance Output Double  where
  output_   = c_printf_d fmt_d
instance Output String  where
  output_   = flip withCString (c_printf_s fmt_s)
instance Output BString where
  output_   = flip BS.useAsCString (c_printf_s fmt_s)

space   :: IO ()
space   = output_ (" "  :: String)

newline :: IO ()
newline = output_ ("\n" :: String)

for :: Int -> Int -> (Int -> IO ()) -> IO ()
for !begin !end k = loop begin
  where loop !i | i >= end  = return ()
                | otherwise = k i >> loop (i + 1)

rep :: Int -> (Int -> IO ()) -> IO ()
rep = for 0

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, ImplicitParams #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Foreign
import Foreign.C
import Data.List
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
-- import qualified Data.Map as Map
import qualified Data.IntSet as Set

main :: IO ()
main = do
  _   :: Int        <- input
  m   :: Int        <- input
  k   :: Int        <- input
  t   :: Int        <- input
  let checkWasteCells acc !i | i > k      = return acc
                             | otherwise  = do
                                 a   :: Int        <- input
                                 b   :: Int        <- input
                                 checkWasteCells (Set.insert (a * m + b) acc) (i + 1)
  wasteCells <- checkWasteCells Set.empty 1
  let a          = listArray (1, k) (Set.toList wasteCells)         :: UArray Int Int
      candidates = listArray (0, 2) ["Carrots", "Kiwis", "Grapes"]  :: Array  Int String
  rep t $ \_ -> do
    i   :: Int        <- input
    j   :: Int        <- input
    let !v = i * m + j
    if Set.member v wasteCells
      then output' ("Waste" :: String)
      else do
        let loop !n | n <= k, v <= v'   = loop (n + 1)
                    | otherwise = do
                        let idx = (v - n) `mod` 3
                        output'  $ candidates ! idx
              where v' = a ! n
        loop 1

--------------------------------------------------
-- Imported C functions
--------------------------------------------------
#define BUFMAX                (100005)

type BString = BS.ByteString

foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i     :: CString -> Ptr Int   -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i64   :: CString -> Ptr Int64 -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_f     :: CString -> Ptr Float -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_s     :: CString -> CString   -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i    :: CString -> Int       -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i64  :: CString -> Int64     -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_d    :: CString -> Double    -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_s    :: CString -> CString   -> IO ()

fmt_i, fmt_i64, fmt_f, fmt_d, fmt_s :: CString
fmt_i   = unsafePerformIO $ newCString "%d"
fmt_i64 = unsafePerformIO $ newCString "%I64d"
fmt_f   = unsafePerformIO $ newCString "%f"
fmt_d   = unsafePerformIO $ newCString "%.16f"
fmt_s   = unsafePerformIO $ newCString "%s"
{-# NOINLINE fmt_i    #-}
{-# NOINLINE fmt_i64  #-}
{-# NOINLINE fmt_f    #-}
{-# NOINLINE fmt_d    #-}
{-# NOINLINE fmt_s    #-}

ptr_i   :: Ptr Int
ptr_i   = unsafePerformIO malloc
ptr_i64 :: Ptr Int64
ptr_i64 = unsafePerformIO malloc
ptr_f   :: Ptr Float
ptr_f   = unsafePerformIO malloc
ptr_d   :: Ptr Double
ptr_d   = unsafePerformIO malloc
ptr_s   :: CString
ptr_s   = unsafePerformIO $ mallocArray BUFMAX
{-# NOINLINE ptr_i    #-}
{-# NOINLINE ptr_i64  #-}
{-# NOINLINE ptr_f    #-}
{-# NOINLINE ptr_d    #-}
{-# NOINLINE ptr_s    #-}

class Input a           where
  input :: IO a

instance Input Int      where
  input = c_scanf_i fmt_i ptr_i >> peek ptr_i
instance Input Int64    where
  input = c_scanf_i64 fmt_i64 ptr_i64 >> peek ptr_i64
instance Input Integer  where
  input = toInteger <$> (input :: IO Int64)
instance Input Double   where
  input = c_scanf_f fmt_f ptr_f >> realToFrac <$> peek ptr_f
instance Input String   where
  input = c_scanf_s fmt_s ptr_s >> peekCString ptr_s
instance Input BString  where
  input = c_scanf_s fmt_s ptr_s >> BS.packCString ptr_s

class Output a          where
  output_   :: a -> IO ()
  output    :: a -> IO ()
  output    = (>> space  ) . output_
  output'   :: a -> IO ()
  output'   = (>> newline) . output_

instance Output Int     where
  output_   = c_printf_i fmt_i
instance Output Int64   where
  output_   = c_printf_i64 fmt_i64
instance Output Integer where
  output_   = output_ . show
instance Output Double  where
  output_   = c_printf_d fmt_d
instance Output String  where
  output_   = flip withCString (c_printf_s fmt_s)
instance Output BString where
  output_   = flip BS.useAsCString (c_printf_s fmt_s)

space   :: IO ()
space   = output_ (" "  :: String)

newline :: IO ()
newline = output_ ("\n" :: String)

for :: Int -> Int -> (Int -> IO ()) -> IO ()
for !begin !end k = loop begin
  where loop !i | i >= end  = return ()
                | otherwise = k i >> loop (i + 1)

rep :: Int -> (Int -> IO ()) -> IO ()
rep = for 0

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, ImplicitParams #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Foreign
import Foreign.C
import Data.List
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
-- import qualified Data.Map as Map
import qualified Data.IntSet as Set

main :: IO ()
main = do
  _   :: Int        <- input
  m   :: Int        <- input
  k   :: Int        <- input
  t   :: Int        <- input
  let checkWasteCells acc !i | i >= k     = return acc
                             | otherwise  = do
                                 a   :: Int        <- input
                                 b   :: Int        <- input
                                 checkWasteCells (Set.insert ((a - 1) * m + (b - 1)) acc) (i + 1)
  wasteCells <- checkWasteCells Set.empty 0
  let a          = listArray (0, k - 1) (Set.toList wasteCells)     :: UArray Int Int
      candidates = listArray (0, 2) ["Carrots", "Kiwis", "Grapes"]  :: Array  Int String
  rep t $ \_ -> do
    i   :: Int        <- input
    j   :: Int        <- input
    let !v = (i - 1) * m + (j - 1)
    if Set.member v wasteCells
      then output' ("Waste" :: String)
      else do
        let loop !n | n < k, v <= a ! n   = loop (n + 1)
                    | otherwise           = do
                        let idx = (v - n + 2) `mod` 3
                        output'  $ candidates ! idx
        loop 0

--------------------------------------------------
-- Imported C functions
--------------------------------------------------
#define BUFMAX                (100005)

type BString = BS.ByteString

foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i     :: CString -> Ptr Int   -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i64   :: CString -> Ptr Int64 -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_f     :: CString -> Ptr Float -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_s     :: CString -> CString   -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i    :: CString -> Int       -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i64  :: CString -> Int64     -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_d    :: CString -> Double    -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_s    :: CString -> CString   -> IO ()

fmt_i, fmt_i64, fmt_f, fmt_d, fmt_s :: CString
fmt_i   = unsafePerformIO $ newCString "%d"
fmt_i64 = unsafePerformIO $ newCString "%I64d"
fmt_f   = unsafePerformIO $ newCString "%f"
fmt_d   = unsafePerformIO $ newCString "%.16f"
fmt_s   = unsafePerformIO $ newCString "%s"
{-# NOINLINE fmt_i    #-}
{-# NOINLINE fmt_i64  #-}
{-# NOINLINE fmt_f    #-}
{-# NOINLINE fmt_d    #-}
{-# NOINLINE fmt_s    #-}

ptr_i   :: Ptr Int
ptr_i   = unsafePerformIO malloc
ptr_i64 :: Ptr Int64
ptr_i64 = unsafePerformIO malloc
ptr_f   :: Ptr Float
ptr_f   = unsafePerformIO malloc
ptr_d   :: Ptr Double
ptr_d   = unsafePerformIO malloc
ptr_s   :: CString
ptr_s   = unsafePerformIO $ mallocArray BUFMAX
{-# NOINLINE ptr_i    #-}
{-# NOINLINE ptr_i64  #-}
{-# NOINLINE ptr_f    #-}
{-# NOINLINE ptr_d    #-}
{-# NOINLINE ptr_s    #-}

class Input a           where
  input :: IO a

instance Input Int      where
  input = c_scanf_i fmt_i ptr_i >> peek ptr_i
instance Input Int64    where
  input = c_scanf_i64 fmt_i64 ptr_i64 >> peek ptr_i64
instance Input Integer  where
  input = toInteger <$> (input :: IO Int64)
instance Input Double   where
  input = c_scanf_f fmt_f ptr_f >> realToFrac <$> peek ptr_f
instance Input String   where
  input = c_scanf_s fmt_s ptr_s >> peekCString ptr_s
instance Input BString  where
  input = c_scanf_s fmt_s ptr_s >> BS.packCString ptr_s

class Output a          where
  output_   :: a -> IO ()
  output    :: a -> IO ()
  output    = (>> space  ) . output_
  output'   :: a -> IO ()
  output'   = (>> newline) . output_

instance Output Int     where
  output_   = c_printf_i fmt_i
instance Output Int64   where
  output_   = c_printf_i64 fmt_i64
instance Output Integer where
  output_   = output_ . show
instance Output Double  where
  output_   = c_printf_d fmt_d
instance Output String  where
  output_   = flip withCString (c_printf_s fmt_s)
instance Output BString where
  output_   = flip BS.useAsCString (c_printf_s fmt_s)

space   :: IO ()
space   = output_ (" "  :: String)

newline :: IO ()
newline = output_ ("\n" :: String)

for :: Int -> Int -> (Int -> IO ()) -> IO ()
for !begin !end k = loop begin
  where loop !i | i >= end  = return ()
                | otherwise = k i >> loop (i + 1)

rep :: Int -> (Int -> IO ()) -> IO ()
rep = for 0

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, ImplicitParams #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Foreign
import Foreign.C
import Data.List
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
-- import qualified Data.Map as Map
import qualified Data.Set as Set

main :: IO ()
main = do
  _   :: Int64        <- input
  m   :: Int64        <- input
  k   :: Int64        <- input
  t   :: Int64        <- input
  let checkWasteCells acc !i | i >= k     = return acc
                             | otherwise  = do
                                 a   :: Int64        <- input
                                 b   :: Int64        <- input
                                 checkWasteCells (Set.insert ((a - 1) * m + (b - 1)) acc) (i + 1)
  wasteCells <- checkWasteCells Set.empty 0
  let a          = listArray (0, k - 1) (Set.toList wasteCells)     :: UArray Int64 Int64
      candidates = listArray (0, 2) ["Carrots", "Kiwis", "Grapes"]  :: Array  Int64 String
  rep (fromIntegral t) $ \_ -> do
    i   :: Int64        <- input
    j   :: Int64        <- input
    let !v = (i - 1) * m + (j - 1)
    if Set.member v wasteCells
      then output' ("Waste" :: String)
      else do
        let loop !n | n < k, v <= a ! n   = loop (n + 1)
                    | otherwise           = do
                        let idx = (v - n + 2) `mod` 3
                        output'  $ candidates ! idx
        loop 0

--------------------------------------------------
-- Imported C functions
--------------------------------------------------
#define BUFMAX                (100005)

type BString = BS.ByteString

foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i     :: CString -> Ptr Int   -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i64   :: CString -> Ptr Int64 -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_f     :: CString -> Ptr Float -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_s     :: CString -> CString   -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i    :: CString -> Int       -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i64  :: CString -> Int64     -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_d    :: CString -> Double    -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_s    :: CString -> CString   -> IO ()

fmt_i, fmt_i64, fmt_f, fmt_d, fmt_s :: CString
fmt_i   = unsafePerformIO $ newCString "%d"
fmt_i64 = unsafePerformIO $ newCString "%I64d"
fmt_f   = unsafePerformIO $ newCString "%f"
fmt_d   = unsafePerformIO $ newCString "%.16f"
fmt_s   = unsafePerformIO $ newCString "%s"
{-# NOINLINE fmt_i    #-}
{-# NOINLINE fmt_i64  #-}
{-# NOINLINE fmt_f    #-}
{-# NOINLINE fmt_d    #-}
{-# NOINLINE fmt_s    #-}

ptr_i   :: Ptr Int
ptr_i   = unsafePerformIO malloc
ptr_i64 :: Ptr Int64
ptr_i64 = unsafePerformIO malloc
ptr_f   :: Ptr Float
ptr_f   = unsafePerformIO malloc
ptr_d   :: Ptr Double
ptr_d   = unsafePerformIO malloc
ptr_s   :: CString
ptr_s   = unsafePerformIO $ mallocArray BUFMAX
{-# NOINLINE ptr_i    #-}
{-# NOINLINE ptr_i64  #-}
{-# NOINLINE ptr_f    #-}
{-# NOINLINE ptr_d    #-}
{-# NOINLINE ptr_s    #-}

class Input a           where
  input :: IO a

instance Input Int      where
  input = c_scanf_i fmt_i ptr_i >> peek ptr_i
instance Input Int64    where
  input = c_scanf_i64 fmt_i64 ptr_i64 >> peek ptr_i64
instance Input Integer  where
  input = toInteger <$> (input :: IO Int64)
instance Input Double   where
  input = c_scanf_f fmt_f ptr_f >> realToFrac <$> peek ptr_f
instance Input String   where
  input = c_scanf_s fmt_s ptr_s >> peekCString ptr_s
instance Input BString  where
  input = c_scanf_s fmt_s ptr_s >> BS.packCString ptr_s

class Output a          where
  output_   :: a -> IO ()
  output    :: a -> IO ()
  output    = (>> space  ) . output_
  output'   :: a -> IO ()
  output'   = (>> newline) . output_

instance Output Int     where
  output_   = c_printf_i fmt_i
instance Output Int64   where
  output_   = c_printf_i64 fmt_i64
instance Output Integer where
  output_   = output_ . show
instance Output Double  where
  output_   = c_printf_d fmt_d
instance Output String  where
  output_   = flip withCString (c_printf_s fmt_s)
instance Output BString where
  output_   = flip BS.useAsCString (c_printf_s fmt_s)

space   :: IO ()
space   = output_ (" "  :: String)

newline :: IO ()
newline = output_ ("\n" :: String)

for :: Int -> Int -> (Int -> IO ()) -> IO ()
for !begin !end k = loop begin
  where loop !i | i >= end  = return ()
                | otherwise = k i >> loop (i + 1)

rep :: Int -> (Int -> IO ()) -> IO ()
rep = for 0


Let A = {a1, a2, ..., an} be any permutation of the first n natural numbers {1, 2, ..., n}. You are given a positive integer k and another sequence B = {b1, b2, ..., bn}, where bi is the number of elements aj in A to the left of the element at = i such that aj ≥ (i + k).For example, if n = 5, a possible A is {5, 1, 4, 2, 3}. For k = 2, B is given by {1, 2, 1, 0, 0}. But if k = 3, then B = {1, 1, 0, 0, 0}.For two sequences X = {x1, x2, ..., xn} and Y = {y1, y2, ..., yn}, let i-th elements be the first elements such that xi ≠ yi. If xi < yi, then X is lexicographically smaller than Y, while if xi > yi, then X is lexicographically greater than Y.Given n, k and B, you need to determine the lexicographically smallest A.

The first line contains two space separated integers n and k (1 ≤ n ≤ 1000, 1 ≤ k ≤ n). On the second line are n integers specifying the values of B = {b1, b2, ..., bn}.

Print on a single line n integers of A = {a1, a2, ..., an} such that A is lexicographically minimal. It is guaranteed that the solution exists.

module Main where

import Control.Monad
import Data.List
import Debug.Trace

readI :: String -> Int
readI = read

readL :: String -> [Int]
readL = (map read) . words

main = do
    [n, k] <- getLine >>= return . readL
    bs <- getLine >>= return . readL
    mapM (\x -> putStr $ show x ++ " ") $ solve n k bs
    putStrLn ""

solve n k bs = rett n (reverse bs) [] where
    rett 0 _      acc = acc
    rett i (b:bs) acc = if b == 0
        then rett (i-1) bs (i:acc)
        else rett (i-1) bs (take s acc ++ [i] ++ drop s acc) where
            s = (findIndices (>=(k+i)) acc)!!(b-1) + 1


We call two numbers $$$x$$$ and $$$y$$$ similar if they have the same parity (the same remainder when divided by $$$2$$$), or if $$$|x-y|=1$$$. For example, in each of the pairs $$$(2, 6)$$$, $$$(4, 3)$$$, $$$(11, 7)$$$, the numbers are similar to each other, and in the pairs $$$(1, 4)$$$, $$$(3, 12)$$$, they are not.You are given an array $$$a$$$ of $$$n$$$ ($$$n$$$ is even) positive integers. Check if there is such a partition of the array into pairs that each element of the array belongs to exactly one pair and the numbers in each pair are similar to each other.For example, for the array $$$a = [11, 14, 16, 12]$$$, there is a partition into pairs $$$(11, 12)$$$ and $$$(14, 16)$$$. The numbers in the first pair are similar because they differ by one, and in the second pair because they are both even.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of two lines. The first line contains an even positive integer $$$n$$$ ($$$2 \le n \le 50$$$) — length of array $$$a$$$. The second line contains $$$n$$$ positive integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 100$$$).

For each test case print:   YES if the such a partition exists,  NO otherwise.  The letters in the words YES and NO can be displayed in any case.

NoteThe first test case was explained in the statement.In the second test case, the two given numbers are not similar.In the third test case, any partition is suitable.

import Control.Monad
import Data.List

data Answer = YES | NO deriving (Show)
type Test = [Int]

getTests :: Int -> IO [Test]
getTests n = replicateM n getTest

getTest :: IO Test
getTest = do
    _ <- getLine
    list <- getLine
    return $ parseInput list

parseInput :: String -> Test
parseInput list = map read (words list)

findAnswer :: [Test] -> [Answer]
findAnswer [] = []
findAnswer (first:rest) = (if (evens `mod` 2) + (odds `mod` 2) == 1
                         then NO
                         else if evens `mod` 2 == 0
                              then YES
                              else if areNeighbours $ sort first
                                   then YES
                                   else NO) : findAnswer rest
    where evens = length $ filter (\x -> x `mod` 2 == 0) first
          odds = (length first) - evens

areNeighbours :: Test -> Bool
areNeighbours [x] = False
areNeighbours (x:y:rest) = if y == x+1
                           then True
                           else areNeighbours (y:rest)

main :: IO ()
main = do
    count <- getLine
    tests <- getTests $ read count
    mapM_ print (findAnswer tests)

import           Data.List
import           Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t solve

solve :: IO ()
solve = do
    _  <- getLine
    as <- map read . words <$> getLine
    let (evens, odds) = partition even as
    putStrLn $ case mod (length evens) 2 of
        0 -> "YES"
        1 -> if or [ abs (x - y) == 1 | x <- evens, y <- odds ]
            then "YES"
            else "NO"

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

main = getLine >>= flip replicateM_ test . read

test = do
    getLine
    as <- map read . words <$> getLine
    let ok = elem 1 (zipWith subtract <*> tail $ sort as) || even (length $ filter even as)
    putStrLn $ bool "NO" "YES" ok

import Control.Monad (replicateM_)
import qualified Data.Set as Set

readLine :: IO [Integer]
readLine = getLine >> (map read) . words <$> getLine

isPartitionPossible xs =
    if numEven == 0 || numOdd == 0 || even numEven then "YES"
    else if any (\x -> Set.member (x + 1) evenSet || Set.member (x - 1) evenSet) odds then "YES"
    else "NO"
    where
        evens = filter even xs
        odds = filter odd xs
        numEven = length evens
        numOdd = length odds
        evenSet = Set.fromList evens

main =
    read <$> getLine >>= \t ->
    replicateM_ t (isPartitionPossible <$> readLine >>= putStrLn)

import Control.Monad ( replicateM_ )
import qualified Data.Set as Set

readInput = getLine >> (map read . words <$> getLine)

similarPairs :: [Int] -> String
similarPairs s = let odds = length (filter odd s) in
    if even odds then "YES"
    else if any (flip Set.member set . succ) s then "YES"
    else "NO"
    where set = Set.fromList s

main = do
    t <- read <$> getLine
    replicateM_ t (similarPairs <$> readInput >>= putStrLn)

--- frederick99, 6/2020
--- https://codeforces.com/contest/1360/problem/C

import           Control.Monad ( replicateM_ )
import qualified Data.Set as Set

similarPairs :: [Int] -> String
similarPairs s = let odds = length (filter odd s) in
    if even odds || any (seen . succ) s
        then "YES"
        else "NO"
    where seen = (`Set.member` Set.fromList s)

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

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (similarPairs <$> readInput >>= putStrLn)

import Data.List (sort)
import Data.Traversable (for)

diff1 :: [Int] -> Bool
diff1 li = let  sli = sort li  in  elem 1 $ zipWith (-) (tail sli) sli

countEven :: [Int] -> Int
countEven = length . filter ((== 0) . (`mod` 2))

main :: IO ()
main = do
  nCases <- fmap read getLine :: IO Int
  _ <- for [1..nCases] $ \_ -> do
    n <- fmap read getLine :: IO Int
    a <- fmap (map read . words) getLine :: IO [Int]
    putStrLn $ case () of
      _ | odd n -> "NO"
      _ | even (countEven a) -> "YES"
      _ | diff1 a -> "YES"
      _ -> "NO"
  return ()

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

main = getLine >>= flip replicateM_ test . read

test = do
    getLine
    as <- map read . words <$> getLine
    let ok = elem 1 (zipWith subtract <*> tail $ sort as) || even (length $ filter even as)
    print $ bool "NO" "YES" ok

import Control.Monad (replicateM_)
import qualified Data.Set as Set

readLine :: IO [Integer]
readLine = getLine >> (map read) . words <$> getLine

isPartitionPossible xs =
    if numEven == 0 || numOdd == 0 || even numEven then "YES"
    else if any (\x -> Set.member (x + 1) evenSet || Set.member (x - 1) evenSet) odds then "YES"
    else "NO"
    where
        evens = filter even xs
        odds = filter odd xs
        numEven = length evens
        numOdd = length odds
        evenSet = Set.fromList evens

main =
    read <$> getLine >>= \t ->
    replicateM_ t (isPartitionPossible <$> readLine >>= print)