There is an infinite pond that can be represented with a number line. There are $$$n$$$ rocks in the pond, numbered from $$$1$$$ to $$$n$$$. The $$$i$$$-th rock is located at an integer coordinate $$$a_i$$$. The coordinates of the rocks are pairwise distinct. The rocks are numbered in the increasing order of the coordinate, so $$$a_1 < a_2 < \dots < a_n$$$.A robot frog sits on the rock number $$$s$$$. The frog is programmable. It has a base jumping distance parameter $$$d$$$. There also is a setting for the jumping distance range. If the jumping distance range is set to some integer $$$k$$$, then the frog can jump from some rock to any rock at a distance from $$$d - k$$$ to $$$d + k$$$ inclusive in any direction. The distance between two rocks is an absolute difference between their coordinates.You are assigned a task to implement a feature for the frog. Given two integers $$$i$$$ and $$$k$$$ determine if the frog can reach a rock number $$$i$$$ from a rock number $$$s$$$ performing a sequence of jumps with the jumping distance range set to $$$k$$$. The sequence can be arbitrarily long or empty.You will be given $$$q$$$ testcases for that feature, the $$$j$$$-th testcase consists of two integers $$$i$$$ and $$$k$$$. Print "Yes" if the $$$i$$$-th rock is reachable and "No" otherwise.You can output "YES" and "NO" in any case (for example, strings "yEs", "yes", "Yes" and 'YES"' will be recognized as a positive answer).

The first line contains four integers $$$n$$$, $$$q$$$, $$$s$$$ and $$$d$$$ ($$$1 \le n, q \le 2 \cdot 10^5$$$; $$$1 \le s \le n$$$; $$$1 \le d \le 10^6$$$) — the number of rocks, the number of testcases, the starting rock and the base jumping distance parameter. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^6$$$) — the coordinates of the rocks. The coordinates of the rocks are pairwise distinct. The rocks are numbered in the increasing order of distance from the land, so $$$a_1 < a_2 < \dots < a_n$$$. Each of the next $$$q$$$ lines contains two integers $$$i$$$ and $$$k$$$ ($$$1 \le i \le n$$$; $$$1 \le k \le 10^6$$$) — the parameters to the testcase.

For each of the testcases print an answer. If there is a sequence of jumps from a rock number $$$s$$$ to a rock number $$$i$$$ with the jumping distance range set to $$$k$$$, then print "Yes". Otherwise, print "No".

NoteExplanation of the first example:In the first testcase the destination rock is the same as the starting rock, thus no jumps are required to reach it.In the second testcase the frog can jump any distance in the range $$$[5 - 2; 5 + 2]$$$. Thus, it can reach rock number $$$5$$$ (by jumping $$$7$$$ to the right) and rock number $$$3$$$ (by jumping $$$3$$$ to the left). From rock number $$$3$$$ it can reach rock number $$$2$$$ (by jumping $$$5$$$ to the left). From rock number $$$2$$$ it can reach rock number $$$1$$$ (by jumping $$$4$$$ to the left). However, there is no way to reach rock number $$$7$$$.In the third testcase the frog can jump any distance in the range $$$[5 - 3; 5 + 3]$$$. Thus, it can reach rock number $$$7$$$ by jumping to rock $$$5$$$ first and to $$$7$$$ afterwards.The fourth testcase is shown in the explanation for the second testcase.

{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
import Control.Monad
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as IS
import qualified Data.Set as S

solve :: IO ()
solve = do
    [n, q, s, d] <- readInts
    a :: UArray Int Int <- listArray (0, n - 1) <$> readInts
    qs <- replicateM q readInts
    let nb i = map ((i,) . (cost i >>= (,))) $ [l | l /= i] ++ [l - 1 | l > 0] ++ [r | r /= n] ++ [r - 1 | i /= r - 1]
            where l = lowerBound ((>= a!i - d) . (a!)) 0 i
                  r = lowerBound ((>= a!i + d) . (a!)) i n
                  cost i j = abs $ d - abs (a!i - a!j)
        edges = e ++ map flipE e
            where e = concatMap nb [0 .. n - 1]
                  flipE (i, (w, j)) = (j, (w, i))
        g = accumArray (flip (:)) [] (0, n - 1) edges :: Array Int [(Int, Int)]
        mst = prim (s - 1) (g!)
        ks = array (0, n - 1) $ zip vs ws :: UArray Int Int
            where vs = s - 1 : map snd mst
                  ws = scanl max 0 $ map fst mst
        ok [i, k] = ks!(i - 1) <= k
        yesNo True = "Yes"
        yesNo _ = "No"
    putStr $ unlines $ map (yesNo . ok) qs

prim :: Int -> (Int -> [(Int, Int)]) -> [(Int, Int)]
prim s nb = go (S.fromList $ nb s) (IS.singleton s) where
    go pq vis = case S.minView pq of
        Nothing -> []
        Just (e@(w, u), pq') -> if u `IS.member` vis
            then go pq' vis
            else e : go (pq' <> S.fromList (nb u)) (IS.insert u vis)

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound f l h
    | l >= h    = l
    | f m       = lowerBound f l m
    | otherwise = lowerBound f (m + 1) h
    where m = (l + h) `div` 2

parseInt = f . C.readInt where f (Just (i, _)) = i
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = solve

{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
import Control.Monad
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as IS
import qualified Data.Set as S

solve :: IO ()
solve = do
    [n, q, s, d] <- readInts
    a :: UArray Int Int <- listArray (0, n - 1) <$> readInts
    qs <- replicateM q $ (\[i, k] -> (i, k)) <$> readInts
    let nb i = map ((i,) . (cost i >>= (,))) $ [l | l /= i] ++ [l - 1 | l > 0] ++ [r | r /= n] ++ [r - 1 | i /= r - 1]
            where l = lowerBound ((>= a!i - d) . (a!)) 0 i
                  r = lowerBound ((>= a!i + d) . (a!)) i n
                  cost i j = abs $ d - abs (a!i - a!j)
        edges = e ++ map flipE e
            where e = concatMap nb [0 .. n - 1]
                  flipE (i, (w, j)) = (j, (w, i))
        g = accumArray (flip (:)) [] (0, length edges) edges :: Array Int [(Int, Int)]
        mst = prim (s - 1) (g!)
        ks = array (0, n - 1) $ zip vs ws :: UArray Int Int
            where vs = s - 1 : map snd mst
                  ws = scanl max 0 $ map fst mst
        ok (i, k) = ks!(i - 1) <= k
        yesNo True = "Yes"
        yesNo _ = "No"
    putStr $ unlines $ map (yesNo . ok) qs

prim :: Int -> (Int -> [(Int, Int)]) -> [(Int, Int)]
prim s nb = go (S.fromList $ nb s) (IS.singleton s) where
    go pq vis = case S.minView pq of
        Nothing -> []
        Just (e@(w, u), pq') -> if u `IS.member` vis
            then go pq' vis
            else e : go (pq' <> S.fromList (nb u)) (IS.insert u vis)

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound f l h
    | l >= h    = l
    | f m       = lowerBound f l m
    | otherwise = lowerBound f (m + 1) h
    where m = (l + h) `div` 2

parseInt = f . C.readInt where f (Just (i, _)) = i
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = solve

{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
import Control.Monad
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as IS

solve :: IO ()
solve = do
    [n, q, s, d] <- readInts
    a :: UArray Int Int <- listArray (0, n - 1) <$> readInts
    qs <- replicateM q $ (\[i, k] -> (i, k)) <$> readInts
    let nb i = map ((i,) . (cost i >>= (,))) $ [l | l /= i] ++ [l - 1 | l > 0] ++ [r | r /= n] ++ [r - 1 | i /= r - 1]
            where l = lowerBound ((>= a!i - d) . (a!)) 0 i
                  r = lowerBound ((>= a!i + d) . (a!)) i n
                  cost i j = abs $ d - abs (a!i - a!j)
        edges = e ++ map flipE e
            where e = concatMap nb [0 .. n - 1]
                  flipE (i, (w, j)) = (j, (w, i))
        g = accumArray (flip (:)) [] (0, length edges) edges :: Array Int [(Int, Int)]
        mst = prim (s - 1) (g!)
        ks = array (0, n - 1) $ zip vs ws :: UArray Int Int
            where vs = s - 1 : map snd mst
                  ws = scanl max 0 $ map fst mst
        ok (i, k) = ks!(i - 1) <= k
        yesNo True = "Yes"
        yesNo _ = "No"
    putStr $ unlines $ map (yesNo . ok) qs

data SkewHeap a = SkewNode {-# UNPACK #-} !a !(SkewHeap a) !(SkewHeap a)
                | Empty deriving Show

instance (Ord a) => Semigroup (SkewHeap a) where
    Empty <> h = h
    h <> Empty = h
    h1@(SkewNode x1 l1 r1) <> h2@(SkewNode x2 l2 r2)
        | x1 <= x2  = SkewNode x1 (h2 <> r1) l1
        | otherwise = SkewNode x2 (h1 <> r2) l2

instance (Ord a) => Monoid (SkewHeap a) where
    mempty = Empty

singleton :: a -> SkewHeap a
singleton x = SkewNode x Empty Empty

extractMin :: (Ord a) => SkewHeap a -> Maybe (a, SkewHeap a)
extractMin Empty = Nothing
extractMin (SkewNode x l r) = Just (x, l <> r)

fromList :: (Ord a) => [a] -> SkewHeap a
fromList = mconcat . map singleton

prim :: Int -> (Int -> [(Int, Int)]) -> [(Int, Int)]
prim s nb = go (fromList $ nb s) (IS.singleton s) where
    go pq vis = case extractMin pq of
        Nothing -> []
        Just (e@(w, u), pq') -> if u `IS.member` vis
            then go pq' vis
            else e : go (pq' <> fromList (nb u)) (IS.insert u vis)

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound f l h
    | l >= h    = l
    | f m       = lowerBound f l m
    | otherwise = lowerBound f (m + 1) h
    where m = (l + h) `div` 2

parseInt = f . C.readInt where f (Just (i, _)) = i
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = solve

{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
import Control.Monad
import Data.Array.Unboxed
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as IS

solve :: IO ()
solve = do
    [n, q, s, d] <- readInts
    a :: UArray Int Int <- listArray (0, n - 1) <$> readInts
    qs <- replicateM q $ (\[i, k] -> (i, k)) <$> readInts
    let nb i = map ((i,) . (cost i >>= (,))) $ [l | l /= i] ++ [l - 1 | l > 0] ++ [r | r /= n] ++ [r - 1 | i /= r - 1]
            where l = lowerBound ((>= a!i - d) . (a!)) 0 i
                  r = lowerBound ((>= a!i + d) . (a!)) i n
                  cost i j = abs $ d - abs (a!i - a!j)
        edges = e ++ map flipE e
            where e = concatMap nb [0 .. n - 1]
                  flipE (i, (w, j)) = (j, (w, i))
        g = accumArray (flip (:)) [] (0, length edges) edges :: Array Int [(Int, Int)]
        mst = prim (s - 1) (g!)
        ks = array (0, n - 1) $ zip vs ws :: UArray Int Int
            where vs = s - 1 : map snd mst
                  ws = scanl max 0 $ map fst mst
        ok (i, k) = ks!(i - 1) <= k
        yesNo True = "Yes"
        yesNo _ = "No"
    putStr $ unlines $ map (yesNo . ok) qs

data SkewHeap a = Empty | SkewNode a (SkewHeap a) (SkewHeap a) deriving Show

instance (Ord a) => Semigroup (SkewHeap a) where
    Empty <> h = h
    h <> Empty = h
    h1@(SkewNode x1 l1 r1) <> h2@(SkewNode x2 l2 r2)
        | x1 <= x2  = SkewNode x1 (h2 <> r1) l1
        | otherwise = SkewNode x2 (h1 <> r2) l2

instance (Ord a) => Monoid (SkewHeap a) where
    mempty = Empty

singleton :: a -> SkewHeap a
singleton x = SkewNode x Empty Empty

extractMin :: (Ord a) => SkewHeap a -> Maybe (a, SkewHeap a)
extractMin Empty = Nothing
extractMin (SkewNode x l r) = Just (x, l <> r)

prim :: Int -> (Int -> [(Int, Int)]) -> [(Int, Int)]
prim s nb = reverse $ go (mconcat $ map singleton $ nb s) (IS.singleton s) [] where
    go pq vis edges = case extractMin pq of
        Nothing -> edges
        Just (e@(w, u), pq') -> if u `IS.member` vis
            then go pq' vis edges
            else go (pq' <> mconcat (map singleton $ nb u)) (IS.insert u vis) (e:edges)

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound f l h
    | l >= h    = l
    | f m       = lowerBound f l m
    | otherwise = lowerBound f (m + 1) h
    where m = (l + h) `div` 2

parseInt = f . C.readInt where f (Just (i, _)) = i
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = solve

-- The time complexity on this version is probably bad. It's fixable
-- with segment trees, but I don't feel like doing that right now.
-- Let's see if the test cases are strong enough to break this one!

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST.Lazy
import Data.Function

--import Debug.Trace
traceShow :: a -> b -> b
traceShow _ y = y

-------------------------------------------------------------------------------

data PQ t -- Maxiphobic persistent heap
  = Empty
  | Vertex t !Int (PQ t) (PQ t)
  deriving Show

getPQsize :: PQ t -> Int
getPQsize Empty = 0
getPQsize (Vertex _ sz _ _) = sz

instance  Ord t => Semigroup (PQ t)  where
  Empty <> q = q
  p <> Empty = p
  p@(Vertex pv ps pl pr) <> q@(Vertex qv qs _ _)
    | pv > qv = q <> p
    | otherwise = let
    [s1, s2, s3] = sortOn getPQsize [pl, pr, q]
    in  Vertex pv (ps + qs) s3 $ s1 <> s2

instance  Ord t => Monoid (PQ t)  where
  mempty = Empty
  mappend = (<>)
  mconcat = let
    mergePairs [] = []
    mergePairs [v] = [v]
    mergePairs (p:q:rs) = (p <> q) : mergePairs rs
    in  \li -> case  li  of
    [] -> Empty
    [v] -> v
    _ -> mconcat (mergePairs li)

single :: t -> PQ t
single v = Vertex v 1 Empty Empty

insertAll :: Ord t => [t] -> PQ t -> PQ t
insertAll = (<>) . mconcat . map single

popMaybe :: Ord t => PQ t -> Maybe (t, PQ t)
popMaybe Empty = Nothing
popMaybe (Vertex pv _ pl pr) = Just (pv, pl <> pr)

-------------------------------------------------------------------------------

isImprovement :: (Int, Int) -> [(Int, Int)] -> [Bool]
isImprovement bnds li = runST $ do
  arr <- strictToLazyST $ newArray bnds maxBound :: ST s (STUArray s Int Int)
  forM li $ \(ix, v) -> strictToLazyST $ do
    prev <- readArray arr ix
    (v < prev) <$ writeArray arr ix (min v prev)

binSearch :: UArray Int Int -> Int -> Int
binSearch arr tar = let
  (p, q) = bounds arr
  go li ri
    | li == ri  = li
    | otherwise = let
    mi = li + div (ri - li) 2
    in  if  tar <= arr ! mi
      then  go li mi
      else  go (mi+1) ri
  in  go p (q+1)

data ProcessDir
  = L { atIx :: !Int, getCost :: !Int }
  | R { atIx :: !Int, getCost :: !Int }
  deriving Show

instance  Eq ProcessDir  where -- not a pretty instance, but it is unused
  (==) = (==) `on` getCost
instance  Ord ProcessDir  where
  compare = compare `on` getCost
  (>) = (>) `on` getCost

successor :: UArray Int Int -> ProcessDir -> Maybe ProcessDir
successor arr (L ix cost) = if  ix <= fst (bounds arr)
  then  Nothing
  else  Just $ L (ix - 1) (cost + arr ! ix - arr ! (ix - 1))
successor arr (R ix cost) = if  ix >= snd (bounds arr)
  then  Nothing
  else  Just $ R (ix + 1) (cost + arr ! (ix + 1) - arr ! ix)

divergingAt :: UArray Int Int -> Int -> [ProcessDir]
divergingAt arr val = let
  tix = binSearch arr val
  (li, ri) = bounds arr
  lv = [L (tix - 1) (val - arr ! (tix - 1)) | tix > li]
  rv = [R tix (arr ! tix - val) | tix <= ri]
  in  lv ++ rv

solve :: UArray Int Int -> Int -> Int -> UArray Int Int
solve arr startIx stepSize = let
  div2 ix = let
    v = arr ! ix
    in  divergingAt arr (v - stepSize) ++ divergingAt arr (v + stepSize)
  solnStep :: [Bool] -> PQ ProcessDir -> [(Int, Int)]
  solnStep queryResponses pq = case  popMaybe pq  of
    Nothing -> []
    Just (a, npq) -> traceShow ("Here!!", a, npq) $ (atIx a, getCost a) : case  queryResponses  of
      [] -> error "solve: unanswered query: bug in isImprovement?"
      False : nqr -> solnStep nqr npq
      True  : nqr -> let
        toIns = div2 (atIx a) ++ [a' | Just a' <- [successor arr a]]
        in  solnStep nqr $ insertAll toIns npq
  queries = solnStep responses (insertAll (div2 startIx) Empty)
  responses = isImprovement (bounds arr) queries
  (pos, dists) = unzip $ (startIx, 0) : queries
  in  accumArray min maxBound (bounds arr) $ zip pos (scanl1 max dists)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, q, s, d] <- readInts
  a <- listArray (1, n) <$> readInts :: SIO (UArray Int Int)
  let  ansKey = solve a s d
  traceShow ansKey $ pure ()
  replicateM_ q $ do
    [i, k] <- readInts
    lift $ B.hPutBuilder stdout $ if  ansKey ! i <= k
      then  B.string7 "Yes\n"
      else  B.string7 "No\n"

type SIO = StateT P.ByteString IO

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

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

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST.Lazy
import Data.Function

-------------------------------------------------------------------------------

data PQ t -- Maxiphobic persistent heap
  = Empty
  | Vertex t !Int (PQ t) (PQ t)
  deriving Show

getPQsize :: PQ t -> Int
getPQsize Empty = 0
getPQsize (Vertex _ sz _ _) = sz

instance  Ord t => Semigroup (PQ t)  where
  Empty <> q = q
  p <> Empty = p
  p@(Vertex pv ps pl pr) <> q@(Vertex qv qs _ _)
    | pv > qv = q <> p
    | otherwise = let
    [s1, s2, s3] = sortOn getPQsize [pl, pr, q]
    in  Vertex pv (ps + qs) s3 $ s1 <> s2

instance  Ord t => Monoid (PQ t)  where
  mempty = Empty
  mappend = (<>)
  mconcat = let
    mergePairs [] = []
    mergePairs [v] = [v]
    mergePairs (p:q:rs) = (p <> q) : mergePairs rs
    in  \li -> case  li  of
    [] -> Empty
    [v] -> v
    _ -> mconcat (mergePairs li)

single :: t -> PQ t
single v = Vertex v 1 Empty Empty

insertAll :: Ord t => [t] -> PQ t -> PQ t
insertAll = (<>) . mconcat . map single

popMaybe :: Ord t => PQ t -> Maybe (t, PQ t)
popMaybe Empty = Nothing
popMaybe (Vertex pv _ pl pr) = Just (pv, pl <> pr)

-------------------------------------------------------------------------------

seenBefore :: (Int, Int) -> [Int] -> [Bool]
seenBefore bnds li = runST $ do
  vis <- strictToLazyST $ newArray bnds False :: ST s (STUArray s Int Bool)
  forM li $ \v -> strictToLazyST $ do
    ans <- readArray vis v
    ans <$ writeArray vis v True

binSearch :: UArray Int Int -> Int -> Int
binSearch arr tar = let
  (p, q) = bounds arr
  go li ri
    | li == ri  = li
    | otherwise = let
    mi = li + div (ri - li) 2
    in  if  tar <= arr ! mi
      then  go li mi
      else  go (mi+1) ri
  in  go p (q+1)

data ProcessDir
  = L { atIx :: !Int, getCost :: !Int }
  | R { atIx :: !Int, getCost :: !Int }

instance  Eq ProcessDir  where -- not a pretty instance, but it's unused
  (==) = (==) `on` getCost
instance  Ord ProcessDir  where
  compare = compare `on` getCost
  (>) = (>) `on` getCost

successor :: UArray Int Int -> ProcessDir -> Maybe ProcessDir
successor arr (L ix cost) = if  ix <= fst (bounds arr)
  then  Nothing
  else  Just $ L (ix - 1) (cost + arr ! ix - arr ! (ix - 1))
successor arr (R ix cost) = if  ix >= snd (bounds arr)
  then  Nothing
  else  Just $ R (ix + 1) (cost + arr ! (ix + 1) - arr ! ix)

divergingAt :: UArray Int Int -> Int -> [ProcessDir]
divergingAt arr val = let
  tix = binSearch arr val
  (li, ri) = bounds arr
  lv = [L (tix - 1) (val - arr ! (tix - 1)) | tix > li]
  rv = [R tix (arr ! tix - val) | tix <= ri]
  in  lv ++ rv

solve :: UArray Int Int -> Int -> Int -> UArray Int Int
solve arr startIx stepSize = let
  div2 ix = let
    v = arr ! ix
    in  divergingAt arr (v - stepSize) ++ divergingAt arr (v + stepSize)
  solnStep :: [Bool] -> PQ ProcessDir -> [(Int, Int)]
  solnStep queryResponses pq = case  popMaybe pq  of
    Nothing -> []
    Just (a, npq) -> (atIx a, getCost a) : case  queryResponses  of
      [] -> error "solve: unanswered query: bug in seenBefore?"
      True  : nqr -> solnStep nqr npq
      False : nqr -> let
        toIns = div2 (atIx a) ++ [a' | Just a' <- [successor arr a]]
        in  solnStep nqr $ insertAll toIns npq
  queries = (startIx, 0)
    : solnStep (tail responses) (insertAll (div2 startIx) Empty)
  responses = seenBefore (bounds arr) $ map fst queries
  (posli, dists) = unzip queries
  in  array (bounds arr) $
  [(pos, dist) | (pos, dist, False) <- zip3 posli (scanl1 max dists) responses]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, q, s, d] <- readInts
  a <- listArray (1, n) <$> readInts :: SIO (UArray Int Int)
  let  ansKey = solve a s d
  replicateM_ q $ do
    [i, k] <- readInts
    lift $ B.hPutBuilder stdout $ if  ansKey ! i <= k
      then  B.string7 "Yes\n"
      else  B.string7 "No\n"

type SIO = StateT P.ByteString IO

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

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


The determinant of a matrix 2 × 2 is defined as follows:A matrix is called degenerate if its determinant is equal to zero. The norm ||A|| of a matrix A is defined as a maximum of absolute values of its elements.You are given a matrix . Consider any degenerate matrix B such that norm ||A - B|| is minimum possible. Determine ||A - B||.

The first line contains two integers a and b (|a|, |b| ≤ 109), the elements of the first row of matrix A.  The second line contains two integers c and d (|c|, |d| ≤ 109) the elements of the second row of matrix A.

Output a single real number, the minimum possible value of ||A - B||. Your answer is considered to be correct if its absolute or relative error does not exceed 10 - 9.

NoteIn the first sample matrix B is In the second sample matrix B is

import Control.Applicative ((<$>), liftA3)
import Control.Monad (replicateM)

root :: Double -> Double -> Double -> [Double]
root 0 0 0 = [0]  -- ok. for our purposes
root 0 0 _ = []
root 0 b c = [- c / b]
root a b c = (/(-2*a)) <$> [b + delta, b - delta]
    where
    delta = sqrt $ b^2 - 4 * a * c :: Double

solve :: [[Double]] -> Double
solve [[a, b], [c, d]] =
    minimum . fmap abs . filter (\a -> a == a) . concat $ xs
    where
    xs = liftA3 f [-1, 1] [-1, 1] [-1, 1] :: [[Double]]

    f :: Double -> Double -> Double -> [Double]
    f i j l = root a' b' c'
        where
        a' = l - i * j :: Double
        b' = a * l + d - c * i - b * j :: Double
        c' = a * d - b * c :: Double

main = solve . fmap parse <$> replicateM 2 getLine >>= print
    where
    parse :: String -> [Double]
    parse = fmap read . words

import Control.Applicative

-- 8-neighbour-distance from point (c,d) to line x*b=y*a
distance :: Rational -> Rational -> Rational -> Rational -> Rational
distance a b c d =
  minimum $ [abs $ (a*d-b*c) / (b + s * a) | s <- [1,-1], b+a*s /= 0]

hflips (a,b,c,d) = [(a,b,c,d), (b,a,d,c)]
vflips (a,b,c,d) = [(a,b,c,d), (c,d,a,b)]
rotations (a,b,c,d) = [(a,b,c,d), (c,a,d,b)]

bsearch a b f
 | b - a < 1e-10 = c
 | f c
  = bsearch a c f
 | otherwise
  = bsearch c b f
  where
    c = (a + b) / 2

solve :: [Integer] -> Double
solve [a, b, c, d] = fromRational $ bsearch 0 (fromIntegral $ maximum $ map abs [a,b,c,d]) (canDo a b c d) where

canDo a b c d r =
    any can (return (a,b,c,d) >>= hflips >>= vflips >>= rotations >>= \x -> ((,,) x) <$> [1, -1] <*> [1, -1]) where
      can ((a,b,c,d), s1, s2) = distance (fromInteger a + r * s1) (fromInteger b + r * s2) (fromInteger c) (fromInteger d) < r

main = interact $ unlines . return . show . solve . map read . words

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

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

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

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

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

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

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

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

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

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

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

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

test a b c d x = let
        ad = [a' * d' | a' <- [a - x, a + x], d' <- [d - x, d + x]]
        bc = [b' * c' | b' <- [b - x, b + x], c' <- [c - x, c + x]]
    in minimum ad < maximum bc && maximum ad > minimum bc

refine a b c d (lo, hi) = let
        mid = (lo + hi) / 2
    in
        if test a b c d mid then (lo, mid) else (mid, hi)

solve a b c d
    | a * d == b * c = 0.0
    | otherwise = snd $ iterate (refine a b c d) (0.0, 1.0e9) !! 1024

main :: IO ()
main = do
    [a, b] <- map fi <$> inputIntegers
    [c, d] <- map fi <$> inputIntegers
    print $ solve a b c d

import Debug.Trace (trace)

type Input  = (Double, Double, Double, Double)
type Output = Double

parse :: String -> Input
parse contents = (a, b, c, d) where [a, b, c, d] = map read . words $ contents

type Range = (Double, Double)

multiply :: Range -> Range -> Range
multiply (a, b) (c, d) = (minimum products, maximum products)
                         where products = do x <- [a, b]
                                             y <- [c, d]
                                             return (x * y)

isOverlap :: Range -> Range -> Bool
isOverlap (a, b) (c, d) = max a c <= min b d

check :: Input -> Double -> Bool
check (a, b, c, d) r = isOverlap (f a d) (f b c)
                       where f x y = multiply (g x) (g y)
                             g x   = (x - r, x + r)

solve :: Input -> Output
solve param@(a, b, c, d) = fst (iterate bsearch (0, bound) !! 233)
                           where bound = maximum . map abs $ [a, b, c, d]
                                 bsearch (l, r) = let mid = (l + r) / 2 in
                                                  if check param mid
                                                  then (l, mid)
                                                  else (mid, r)

main :: IO ()
main = print . solve . parse =<< getContents

direction a b c d = (b/a) < (d/c)

solve :: [Integer] -> Double
solve [a, b, c, d]
  | a+b+c+d == 0 = fromIntegral $ minimum $ map abs [a,b,c,d] -- I have no idea why
  | otherwise = min (fromIntegral $ minimum $ map abs [a,b,c,d]) $ abs $ (fromIntegral $ b*c - a*d) / (fromIntegral $ a+b+c+d)

main = interact $ unlines . return . show . solve . map read . words

direction a b c d = (b/a) < (d/c)

solve :: [Integer] -> Double
solve [a, b, c, d]
  | a+b+c+d == 0 = fromIntegral $ maximum $ map abs [a,b,c,d] -- I have no idea why
  | otherwise = min (fromIntegral $ maximum $ map abs [a,b,c,d]) $ abs $ (fromIntegral $ b*c - a*d) / (fromIntegral $ a+b+c+d)

main = interact $ unlines . return . show . solve . map read . words

direction a b c d = (b/a) < (d/c)

-- 8-neighbour-distance from point (c,d) to line x*b=y*a
distance :: Rational -> Rational -> Rational -> Rational -> Rational
distance a b c d =
  minimum $ [abs $ (a*d-b*c) / (b + s * a) | s <- [1,-1], b+a*s /= 0]

hflips (a,b,c,d) = [(a,b,c,d), (b,a,d,c)]
vflips (a,b,c,d) = [(a,b,c,d), (c,d,a,b)]
rotations (a,b,c,d) = [(a,b,c,d), (c,a,d,b)]

bsearch a b f
 | b - a < 1e-10 = c
 | f c
  = bsearch a c f
 | otherwise
  = bsearch c b f
  where
    c = (a + b) / 2

solve :: [Integer] -> Double
solve [a, b, c, d] = fromRational $ bsearch 0 (fromIntegral $ maximum $ map abs [a,b,c,d]) (canDo a b c d) where

canDo a b c d r =
    any can (return (a,b,c,d) >>= hflips >>= vflips >>= rotations) where
      can (a,b,c,d) = distance (fromInteger a - r) (fromInteger b + r) (fromInteger c) (fromInteger d) < r

main = interact $ unlines . return . show . solve . map read . words

direction a b c d = (b/a) < (d/c)

solve :: [Integer] -> Double
solve [a, b, c, d] = abs $ (fromIntegral $ b*c - a*d) / (fromIntegral $ a+b+c+d)

main = interact $ unlines . return . show . solve . map read . words

direction a b c d = (b/a) < (d/c)

solve :: [Integer] -> Double
solve [a, b, c, d] | a+b+c+d == 0 = 0
                   | otherwise = abs $ (fromIntegral $ b*c - a*d) / (fromIntegral $ a+b+c+d)

main = interact $ unlines . return . show . solve . map read . words

type Input  = (Double, Double, Double, Double)
type Output = Double

parse :: String -> Input
parse contents = (a, b, c, d) where [a, b, c, d] = map read . words $ contents

type Range = (Double, Double)

multiply :: Range -> Range -> Range
multiply (a, b) (c, d) = (mi, ma)
                         where ma = maximum [a * c, b * d]
                               mi = minimum [a * c, a * d, b * c]

isOverlap :: Range -> Range -> Bool
isOverlap (a, b) (c, d) = max a c <= min b d

check :: Input -> Double -> Bool
check (a, b, c, d) r = isOverlap (f a d) (f b c)
                       where f x y = multiply (g x) (g y)
                             g x   = (x - r, x + r)

solve :: Input -> Output
solve param@(a, b, c, d) = fst (iterate bsearch (0, bound) !! 233)
                           where bound = maximum . map abs $ [a, b, c, d]
                                 bsearch (l, r) = let mid = (l + r) / 2 in
                                                  if check param mid
                                                  then (l, mid)
                                                  else (mid, r)

main :: IO ()
main = print . solve . parse =<< getContents


A subway scheme, classic for all Berland cities is represented by a set of n stations connected by n passages, each of which connects exactly two stations and does not pass through any others. Besides, in the classic scheme one can get from any station to any other one along the passages. The passages can be used to move in both directions. Between each pair of stations there is no more than one passage.Berland mathematicians have recently proved a theorem that states that any classic scheme has a ringroad. There can be only one ringroad. In other words, in any classic scheme one can find the only scheme consisting of stations (where any two neighbouring ones are linked by a passage) and this cycle doesn't contain any station more than once.This invention had a powerful social impact as now the stations could be compared according to their distance from the ringroad. For example, a citizen could say "I live in three passages from the ringroad" and another one could reply "you loser, I live in one passage from the ringroad". The Internet soon got filled with applications that promised to count the distance from the station to the ringroad (send a text message to a short number...).The Berland government decided to put an end to these disturbances and start to control the situation. You are requested to write a program that can determine the remoteness from the ringroad for each station by the city subway scheme.

The first line contains an integer n (3 ≤ n ≤ 3000), n is the number of stations (and trains at the same time) in the subway scheme. Then n lines contain descriptions of the trains, one per line. Each line contains a pair of integers xi, yi (1 ≤ xi, yi ≤ n) and represents the presence of a passage from station xi to station yi. The stations are numbered from 1 to n in an arbitrary order. It is guaranteed that xi ≠ yi and that no pair of stations contain more than one passage. The passages can be used to travel both ways. It is guaranteed that the given description represents a classic subway scheme.

Print n numbers. Separate the numbers by spaces, the i-th one should be equal to the distance of the i-th station from the ringroad. For the ringroad stations print number 0.

import qualified Data.ByteString.Char8 as BS
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.IArray
import Control.Monad
import List
import Debug.Trace

generateGraph :: Int -> [(Int, Int)] -> Array Int [Int]
generateGraph n m = runSTArray $ do
  g <- newArray (0, n - 1) []
  forM_ m $ \(a, b) -> do
    aa <- readArray g a
    bb <- readArray g b
    writeArray g a (b : aa)
    writeArray g b (a : bb)
  return g

checkCycle :: Int -> Array Int [Int] -> [Int]
checkCycle n g = cc 0 (-1) []
  where cc pos prev lst =
            case elemIndex pos lst of
              (Just x) -> take (x + 1) lst
              Nothing  -> loop (g ! pos) pos prev (pos : lst)

        loop :: [Int] -> Int -> Int -> [Int] -> [Int]
        loop [] _ _ _ = []
        loop (x:xs) pos prev lst
          | x == prev = loop xs pos prev lst
          | otherwise = let cand1 = cc x pos lst
                            cand2 = loop xs pos prev lst
                        in if null cand1 then cand2 else cand1

genCycleFlag :: Int -> [Int] -> Array Int Bool
genCycleFlag n c = runSTArray $ do
  flag <- newArray (0, n - 1) False
  forM_ c $ \x ->
    writeArray flag x True
  return flag

solve :: Int -> [(Int, Int)] -> [Int]
solve n m = let graph = generateGraph n m
                cycle = checkCycle n graph
                cflag = genCycleFlag n cycle
            in map (distance graph cflag) [0 .. n - 1]

distance g c pos = dist pos (-1) 0
    where dist pos prev cnt
              | c ! pos   = cnt
              | otherwise = foldr min 10000 $
                            map (\x -> dist x pos (cnt + 1)) $
                            filter (/= prev) (g ! pos)

printList :: Show a => [a] -> IO ()
printList (x:y:xs) = (putStr   $ show x ++ " ") >> printList (y:xs)
printList (x:[])   = putStrLn $ show x
printList []       = putStrLn ""

main :: IO ()
main = do nn <- BS.getLine
          mm <- BS.getContents
          let n  = bReadInt nn
              m  = map ((\x -> x - 1) . bReadInt) $ BS.words mm
              m2 = zip2 m
          printList $ solve n m2

zip2 :: [a] -> [(a, a)]
zip2 (x:y:xs) = (x, y) : zip2 xs
zip2        _ = []

bReadInt :: BS.ByteString -> Int
bReadInt = toNumber . BS.readInt

bReadInteger :: BS.ByteString -> Integer
bReadInteger = toNumber . BS.readInteger

toNumber :: Num a => Maybe (a, BS.ByteString) -> a
toNumber (Just (x, _)) = x
toNumber Nothing       = 0

import qualified Data.ByteString.Char8 as BS
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.IArray
import Control.Monad
import List
import Debug.Trace

generateGraph :: Int -> [(Int, Int)] -> Array Int [Int]
generateGraph n m = runSTArray $ do
  g <- newArray (0, n - 1) []
  forM_ m $ \(a, b) -> do
    aa <- readArray g a
    bb <- readArray g b
    writeArray g a (b : aa)
    writeArray g b (a : bb)
  return g

checkCycle :: Int -> Array Int [Int] -> [Int]
checkCycle n g = case cc 0 (-1) [] of
  (Just x) -> x
  Nothing  -> []
  where cc pos prev lst =
            case elemIndex pos lst of
              (Just x) -> Just (take (x + 1) lst)
              Nothing  -> loop (g ! pos) pos prev (pos : lst)

        loop [] _ _ _ = Nothing
        loop (x:xs) pos prev lst
          | x == prev = loop xs pos prev lst
          | otherwise =
                case cc x pos lst of
                  (Just x) -> Just x
                  Nothing  -> loop xs pos prev lst

genCycleFlag :: Int -> [Int] -> Array Int Bool
genCycleFlag n c = runSTArray $ do
  flag <- newArray (0, n - 1) False
  forM_ c $ \x ->
    writeArray flag x True
  return flag

solve :: Int -> [(Int, Int)] -> [Int]
solve n m = let graph = generateGraph n m
                cycle = checkCycle n graph
                cflag = genCycleFlag n cycle
            in map (distance graph cflag) [0 .. n - 1]

distance g c pos = dist pos (-1) 0
    where dist pos prev cnt
              | c ! pos   = cnt
              | otherwise = foldr min 10000 $
                            map (\x -> dist x pos (cnt + 1)) $
                            filter (/= prev) (g ! pos)

printList :: Show a => [a] -> IO ()
printList (x:y:xs) = (putStr   $ show x ++ " ") >> printList (y:xs)
printList (x:[])   = putStrLn $ show x
printList []       = putStrLn ""

main :: IO ()
main = do nn <- BS.getLine
          mm <- BS.getContents
          let n  = bReadInt nn
              m  = map ((\x -> x - 1) . bReadInt) $ BS.words mm
              m2 = zip2 m
          printList $ solve n m2

zip2 :: [a] -> [(a, a)]
zip2 (x:y:xs) = (x, y) : zip2 xs
zip2        _ = []

bReadInt :: BS.ByteString -> Int
bReadInt = toNumber . BS.readInt

bReadInteger :: BS.ByteString -> Integer
bReadInteger = toNumber . BS.readInteger

toNumber :: Num a => Maybe (a, BS.ByteString) -> a
toNumber (Just (x, _)) = x
toNumber Nothing       = 0


Phoenix has a string $$$s$$$ consisting of lowercase Latin letters. He wants to distribute all the letters of his string into $$$k$$$ non-empty strings $$$a_1, a_2, \dots, a_k$$$ such that every letter of $$$s$$$ goes to exactly one of the strings $$$a_i$$$. The strings $$$a_i$$$ do not need to be substrings of $$$s$$$. Phoenix can distribute letters of $$$s$$$ and rearrange the letters within each string $$$a_i$$$ however he wants.For example, if $$$s = $$$ baba and $$$k=2$$$, Phoenix may distribute the letters of his string in many ways, such as:   ba and ba  a and abb  ab and ab  aa and bb But these ways are invalid:   baa and ba  b and ba  baba and empty string ($$$a_i$$$ should be non-empty) Phoenix wants to distribute the letters of his string $$$s$$$ into $$$k$$$ strings $$$a_1, a_2, \dots, a_k$$$ to minimize the lexicographically maximum string among them, i. e. minimize $$$max(a_1, a_2, \dots, a_k)$$$. Help him find the optimal distribution and print the minimal possible value of $$$max(a_1, a_2, \dots, a_k)$$$.String $$$x$$$ is lexicographically less than string $$$y$$$ if either $$$x$$$ is a prefix of $$$y$$$ and $$$x \ne y$$$, or there exists an index $$$i$$$ ($$$1 \le i \le min(|x|, |y|))$$$ such that $$$x_i$$$ < $$$y_i$$$ and for every $$$j$$$ $$$(1 \le j < i)$$$ $$$x_j = y_j$$$. Here $$$|x|$$$ denotes the length of the string $$$x$$$.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Each test case consists of two lines. The first line of each test case consists of two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 10^5$$$) — the length of string $$$s$$$ and the number of non-empty strings, into which Phoenix wants to distribute letters of $$$s$$$, respectively. The second line of each test case contains a string $$$s$$$ of length $$$n$$$ consisting only of lowercase Latin letters. It is guaranteed that the sum of $$$n$$$ over all test cases is $$$\le 10^5$$$.

Print $$$t$$$ answers — one per test case. The $$$i$$$-th answer should be the minimal possible value of $$$max(a_1, a_2, \dots, a_k)$$$ in the $$$i$$$-th test case.

6
4 2
baba
5 2
baacb
5 3
baacb
5 3
aaaaa
6 4
aaxxzz
7 1
phoenix

NoteIn the first test case, one optimal solution is to distribute baba into ab and ab. In the second test case, one optimal solution is to distribute baacb into abbc and a.In the third test case, one optimal solution is to distribute baacb into ac, ab, and b.In the fourth test case, one optimal solution is to distribute aaaaa into aa, aa, and a.In the fifth test case, one optimal solution is to distribute aaxxzz into az, az, x, and x.In the sixth test case, one optimal solution is to distribute phoenix into ehinopx.

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

main = getLine >>= flip replicateM_ test . read

test = do
    (n:k:_) <- map read . words <$> getLine
    s <- sort <$> getLine
    if k == 1
        then putStrLn s
        else do
            let (a, as) = splitAt k s
            if all (== head a) a
                then if all (== head as) as
                         then putStrLn $
                              head a : replicate ((n - k) `div` k + fromEnum ((n - k) `mod` k /= 0)) (head as)
                         else putStrLn $ head a : as
                else putStrLn [maximum a]

import Data.List
import Control.Monad

main :: IO ()
main = readLn >>= flip replicateM_ routine

routine :: IO ()
routine = do
  [n,k] <- (map read.words) <$> getLine
  s <- getLine
  putStrLn $ solve n k s

solve ::Int ->  Int -> String -> String
solve n k s
  |k == 1 = sorted
  |all (== head start) start=
    head start :
    if all (== head end) end
      then replicate ((n `div` k) +(if n `mod` k == 0 then 0 else 1)-1) (head end)
      else end
  |otherwise = [last start]
  where
    sorted = sort s
    (start, end) = splitAt k sorted

import qualified Data.List as L

readInts :: IO [Int]
readInts = do
    line <- getLine
    return $  map read . words $ line

solve :: Int -> Int -> Int -> String -> String
solve 0 _ _ _ = []
solve _ 1 _ s = s
solve n k d s
    | (not uniformCur && d == 0) = [letter]
    | ((d /= 0 && hypothesis /= s) || not uniformCur && d /= 0) = solve n 1 (d + 1) s
    | (uniformCur && d == 0) = (letter : (solve n' k (d + 1) $ rem))
    | otherwise = take (div (n + k - 1) k) s
    where
        hypothesis = replicate n letter
        uniformCur = (cur == take (n - n') hypothesis)
        cur = take k s
        rem = drop k s
        n' = length rem
        letter = maximum cur

handleTest :: Int -> IO ()
handleTest 0 = return ()
handleTest t = do
    [n, k] <- readInts
    s <- getLine
    putStrLn $ solve n k 0 $ L.sort s
    handleTest $ t - 1

main = do
    t <- getLine
    handleTest $ read t

import qualified Data.List as L

removeFirstK :: Int -> [(Char, Int)] -> Maybe [(Char, Int)]
removeFirstK _ [] = Nothing
removeFirstK k ((c,cc):rest)
    | k == cc   = Just rest
    | k < cc    = Just $ (c,cc-k):rest
    | k > cc    = removeFirstK (k-cc) rest

getMin :: Int -> String -> [(Char, Int)] -> String
getMin k sorted ((c,cc):rest)
    | k == cc   = c: getMinLevel2 k (drop k sorted) rest
    | k < cc    = c: getMinLevel2 k (drop k sorted) ((c,cc-k):rest)
    | otherwise = (sorted L.!! (k-1)) : ""

getMinLevel2 :: Int -> String -> [(Char,Int)] -> String
getMinLevel2 k sorted [] = ""
getMinLevel2 k _ [(c,cc)] = L.replicate (ceiling (fromIntegral cc/ fromIntegral k)) c
getMinLevel2 k sorted _ = sorted

possibleMin1 :: Int -> String -> [(Char, Int)] -> String
possibleMin1 k sorted [] = ""
possibleMin1 k sorted ((c,cc):rest)
    | k == cc = c : possibleMin1 k sorted rest
    | k > cc    = L.replicate 1000000 'z'
    | otherwise = c : possibleMin1 k sorted ((c,cc-k):rest)

{-
    | k == cc   = c: getMin k rest
    | k < cc    = c: getMin k ((c,cc-k):rest)
    | null rest = c:""
    | otherwise = fst (head rest) : ""
-}

solve :: Int -> String -> String
solve k s = getMin k sorted counts
    where
        sorted = L.sort s
        counts = map counterF $ L.group sorted
        counterF l = (head l, length l)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:k:_) <- readInts
    s <- getLine
    putStrLn $ solve k s
    testCases (t-1)

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

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

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

main = getLine >>= flip replicateM_ test . read

test = do
    (n:k:_) <- map read . words <$> getLine
    s <- sort <$> getLine
    if all (== head s) (take k s)
        then putStrLn [head s]
        else putStrLn $ head s : drop k s

import Data.List
import Control.Monad

main :: IO ()
main = readLn >>= flip replicateM_ routine

routine :: IO ()
routine = do
  [n,k] <- (map read.words) <$> getLine
  s <- getLine
  putStrLn $ solve n k s

solve ::Int ->  Int -> String -> String
solve n k s
  |k == 1 = s
  |head start == lstart =
    lstart :
    if head end == lend
      then replicate ((n `div` k) +(if n `mod` k == 0 then 0 else 1)-1) (head end)
      else end
  |otherwise = [lstart]
  where
    sorted = sort s
    (start, end) = splitAt k sorted
    lstart = last start
    lend = last end

import qualified Data.List as L

readInts :: IO [Int]
readInts = do
    line <- getLine
    return $  map read . words $ line

solve :: Int -> Int -> Int -> String -> String
solve 0 _ _ _ = []
solve _ 1 _ s = s
solve n k d s
    | (not uniformCur && d == 0) = [letter]
    | ((d /= 0 && hypothesis /= s) || not uniformCur && d /= 0) = solve n 1 (d + 1) s
    | otherwise = take (div (n + k - 1) k) s
    where
        hypothesis = replicate n letter
        uniformCur = (cur == take (n - n') hypothesis)
        cur = take k s
        rem = drop k s
        n' = length rem
        letter = maximum cur

handleTest :: Int -> IO ()
handleTest 0 = return ()
handleTest t = do
    [n, k] <- readInts
    s <- getLine
    putStrLn $ solve n k 0 $ L.sort s
    handleTest $ t - 1

main = do
    t <- getLine
    handleTest $ read t

import qualified Data.List as L

removeFirstK :: Int -> [(Char, Int)] -> Maybe [(Char, Int)]
removeFirstK _ [] = Nothing
removeFirstK k ((c,cc):rest)
    | k == cc   = Just rest
    | k < cc    = Just $ (c,cc-k):rest
    | k > cc    = removeFirstK (k-cc) rest

getMin :: Int -> String -> [(Char, Int)] -> String
getMin k sorted [] = ""
getMin k _ [(c,cc)] = L.replicate (ceiling (fromIntegral cc/ fromIntegral k)) c
getMin k sorted g@((c,cc):rest)
    | k <= cc = drop (k-1) sorted
    | otherwise = (sorted L.!! (k-1)) : ""

possibleMin1 :: Int -> String -> [(Char, Int)] -> String
possibleMin1 k sorted [] = ""
possibleMin1 k sorted ((c,cc):rest)
    | k == cc = c : possibleMin1 k sorted rest
    | k > cc    = L.replicate 1000000 'z'
    | otherwise = c : possibleMin1 k sorted ((c,cc-k):rest)

{-
    | k == cc   = c: getMin k rest
    | k < cc    = c: getMin k ((c,cc-k):rest)
    | null rest = c:""
    | otherwise = fst (head rest) : ""
-}

solve :: Int -> String -> String
solve k s = min (getMin k sorted counts) (possibleMin1 k sorted counts)
    where
        sorted = L.sort s
        counts = map counterF $ L.group sorted
        counterF l = (head l, length l)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:k:_) <- readInts
    s <- getLine
    putStrLn $ solve k s
    testCases (t-1)

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

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


Igor found out discounts in a shop and decided to buy n items. Discounts at the store will last for a week and Igor knows about each item that its price now is ai, and after a week of discounts its price will be bi.Not all of sellers are honest, so now some products could be more expensive than after a week of discounts.Igor decided that buy at least k of items now, but wait with the rest of the week in order to save money as much as possible. Your task is to determine the minimum money that Igor can spend to buy all n items.

In the first line there are two positive integer numbers n and k (1 ≤ n ≤ 2·105, 0 ≤ k ≤ n) — total number of items to buy and minimal number of items Igor wants to by right now. The second line contains sequence of integers a1, a2, ..., an (1 ≤ ai ≤ 104) — prices of items during discounts (i.e. right now). The third line contains sequence of integers b1, b2, ..., bn (1 ≤ bi ≤ 104) — prices of items after discounts (i.e. after a week).

Print the minimal amount of money Igor will spend to buy all n items. Remember, he should buy at least k items right now.

NoteIn the first example Igor should buy item 3 paying 6. But items 1 and 2 he should buy after a week. He will pay 3 and 1 for them. So in total he will pay 6 + 3 + 1 = 10.In the second example Igor should buy right now items 1, 2, 4 and 5, paying for them 3, 4, 10 and 3, respectively. Item 3 he should buy after a week of discounts, he will pay 5 for it. In total he will spend 3 + 4 + 10 + 3 + 5 = 25.

{-# LANGUAGE BangPatterns #-}

import System.IO
import Data.List

main :: IO ()
main = do
  (n:k:_) <- readLineNum
  as <- readLineNum
  bs <- readLineNum
  let ttt = (sortBy compare' $ zipWith (\a b -> (a, b, a-b)) as bs)
  print $ summer k ttt 0
    where
      readLineNum :: IO [Int]
      readLineNum = getLine >>= return . words >>= return . map (read :: String -> Int)

      compare' (_, _, t1) (_, _, t2) = t1 `compare` t2

      summer :: Int -> [(Int, Int, Int)] -> Int -> Int
      summer _ [] !acc = acc
      summer !i !((a, b, c):es) acc = summer (i-1) es (if i>0 then (acc+a) else (acc+(if a<=b then a else b)))

{-# LANGUAGE BangPatterns #-}

import System.IO
import Data.List

main :: IO ()
main = do
  (n:k:_) <- readLineNum
  as <- readLineNum
  bs <- readLineNum
  let ttt = (sortBy compare' $ zipWith (\a b -> (a, b, a-b)) as bs)
  print $ summer k ttt 0
    where
      readLineNum :: IO [Int]
      readLineNum = getLine >>= return . words >>= return . map (read :: String -> Int)

      compare' (_, _, t1) (_, _, t2) = t1 `compare` t2

      summer :: Int -> [(Int, Int, Int)] -> Int -> Int
      summer _ [] !acc = acc
      summer !i !((a, b, c):es) !acc = summer (i-1) es (if i>0 then (acc+a) else (acc+(if a<=b then a else b)))

{-# LANGUAGE BangPatterns #-}

import System.IO
import Data.List

main :: IO ()
main = do
  (n:k:_) <- readLineNum
  (as:bs:_) <- getContents >>= return . lines >>= return . (map (map read . words))
  let ttt = (sortBy compare' $ zipWith (\a b -> (a, b, a-b)) as bs)
  print $ summer k ttt 0
    where
      readLineNum :: IO [Int]
      readLineNum = getLine >>= return . words >>= return . map (read :: String -> Int)

      compare' (!_, !_, !t1) (!_, !_, !t2) = t1 `compare` t2

      summer :: Int -> [(Int, Int, Int)] -> Int -> Int
      summer !_ [] !acc = acc
      summer !i !((a, b, c):es) !acc = summer (i-1) es (if i>0 then (acc+a) else (acc+(if a<=b then a else b)))

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import           Data.List
import           Data.List.Split
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
  [n,k] <- map readInt.B.words <$> B.getLine
  xs <- map readInt.B.words <$> B.getLine
  ys <- map readInt.B.words <$> B.getLine
  print $ solve k xs ys

solve :: Int -> [Int] -> [Int] -> Int64
solve k xs ys = sum[fromIntegral x | (d,x)<-zs0++zs2] + sum[fromIntegral $ x +d| (d,x)<-zs3]
  where
    diffs = reverse.sort $ zipWith(\x y->(y-x,x)) xs ys
    (zs0, zs1) = splitAt k diffs
    (zs2, zs3) = span ((>0).fst) zs1

import Data.List
import Data.Maybe ( fromJust )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

main = do
    [n,k] <- fast_read_Int
    a <- fast_read_Int
    b <- fast_read_Int
    let bf =  sortBy (\(a, b) (a', b') -> compare (a - b) (a' - b'))  $ zip a b
    let pozzitive = takeWhile (\(a, b) -> a < b) bf
    --print pozzitive
    let cate = max k $ length pozzitive
    let sum1 = sum $ map fst $ take cate bf
    let sum2 = sum $ map snd $ take (n-cate) $ reverse bf
    print $ sum1 + sum2

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Ord

main = do
  [n, k] <- fmap readInts B.getLine
  as <- fmap readInts B.getLine
  bs <- fmap readInts B.getLine
  print $ solve n k as bs

solve n k as bs = (\(f, s) -> sum (map fst f) + sum (map (uncurry min) s)) $ splitAt k $ sortBy (comparing (uncurry (-))) $ zip as bs

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

import System.IO
import Data.List

main :: IO ()
main = do
  (n:k:_) <- readLineNum
  as <- readLineNum
  bs <- readLineNum
  let ttt = (sort $ zipWith (\a b -> (a, b, a-b)) as bs)
  print $ summer k ttt 0
    where
      readLineNum :: IO [Int]
      readLineNum = getLine >>= return . words >>= return . map (read :: String -> Int)

      sort :: [(Int, Int, Int)] -> [(Int, Int, Int)]
      sort [] = []
      sort ((t@(ta, tb, tc)):remain) = former ++ [t] ++ latter
        where
          former = [tmp | tmp@(tmpa, tmpb, tmpc) <- remain, tmpc <= tc]
          latter = [tmp | tmp@(tmpa, tmpb, tmpc) <- remain, tmpc > tc]

      summer :: Int -> [(Int, Int, Int)] -> Int -> Int
      summer _ [] acc = acc
      summer i ((a, b, c):es) acc = summer (i-1) es (if i>0 then (acc+a) else (acc+(if a<b then a else b)))

{-# LANGUAGE BangPatterns #-}

import System.IO
import Data.List

main :: IO ()
main = do
  (n:k:_) <- readLineNum
  as <- readLineNum
  bs <- readLineNum
  let ttt = (sort $ zipWith (\a b -> (a, b, a-b)) as bs)
  print $ summer k ttt 0
    where
      readLineNum :: IO [Int]
      readLineNum = getLine >>= return . words >>= return . map (read :: String -> Int)

      sort :: [(Int, Int, Int)] -> [(Int, Int, Int)]
      sort [] = []
      sort (t@(ta, tb, tc):remain) = former ++ [t] ++ latter
        where
          former = [tmp | tmp@(tmpa, tmpb, tmpc) <- remain, tmpc <= tc]
          latter = [tmp | tmp@(tmpa, tmpb, tmpc) <- remain, tmpc > tc]

      summer :: Int -> [(Int, Int, Int)] -> Int -> Int
      summer _ [] acc = acc
      summer i ((a, b, c):es) acc = summer (i-1) es (if i>0 then (acc+a) else (acc+(if a<=b then a else b)))

import Data.List
import Data.Maybe ( fromJust )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

main = do
    [n,k] <- fast_read_Int
    a <- fast_read_Int
    b <- fast_read_Int
    let bf =  sortBy (\(a, b) (a', b') -> compare (a - b) (a' - b'))  $ zip a b
    let pozzitive = takeWhile (\(a, b) -> a < b) bf
    --print pozzitive
    let cate = max k $ length pozzitive
    print cate
    print bf
    let sum1 = sum $ map fst $ take cate bf
    let sum2 = sum $ map snd $ take (n-cate) $ reverse bf
    print $ sum1 + sum2

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B

main = do
  [n, k] <- fmap readInts B.getLine
  as <- fmap readInts B.getLine
  bs <- fmap readInts B.getLine
  print $ solve n k as bs

solve n k as bs = sum $ zipWith min as bs

readInt = maybe undefined fst . B.readInteger
readInts = fmap readInt . B.words


You are given two integer arrays $$$a$$$ and $$$b$$$ of length $$$n$$$.You can reverse at most one subarray (continuous subsegment) of the array $$$a$$$. Your task is to reverse such a subarray that the sum $$$\sum\limits_{i=1}^n a_i \cdot b_i$$$ is maximized.

The first line contains one integer $$$n$$$ ($$$1 \le n \le 5000$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^7$$$). The third line contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$1 \le b_i \le 10^7$$$).

Print single integer — maximum possible sum after reversing at most one subarray (continuous subsegment) of $$$a$$$.

NoteIn the first example, you can reverse the subarray $$$[4, 5]$$$. Then $$$a = [2, 3, 2, 3, 1]$$$ and $$$2 \cdot 1 + 3 \cdot 3 + 2 \cdot 2 + 3 \cdot 4 + 1 \cdot 2 = 29$$$.In the second example, you don't need to use the reverse operation. $$$13 \cdot 2 + 37 \cdot 4 = 174$$$.In the third example, you can reverse the subarray $$$[3, 5]$$$. Then $$$a = [1, 8, 3, 6, 7, 6]$$$ and $$$1 \cdot 5 + 8 \cdot 9 + 3 \cdot 6 + 6 \cdot 8 + 7 \cdot 8 + 6 \cdot 6 = 235$$$.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}

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

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.STRef(STRef, newSTRef, readSTRef, writeSTRef)
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, filterM, forM) -- foldM est un foldl
import Data.Maybe
import Data.Int

type Output = Int64

solve :: Int64 -> [Int64] -> [Int64] -> Output
solve n a b = baseValue + max val1 val0 where
	aA = A.listArray (0, n-1) a
	bA = A.listArray (0, n-1) b

	baseValue :: Int64
	baseValue = foldr (\(i, j) v -> i*j+v) 0 (zip a b)

	aux0 c i
		| c + i >= n = 0
		| c - i < 0 = 0
		| otherwise = max val $ val + aux0 c (i+1)
		where
			val = (a_j*b_i+a_i*b_j) - (a_i*b_i+a_j*b_j)
			a_i = aA ! (c+i)
			a_j = aA ! (c-i)
			b_i = bA ! (c+i)
			b_j = bA ! (c-i)

	aux1 c i
		| c + 1 + i >= n = 0
		| c - i < 0 = 0
		| otherwise = max val $ val + aux1 c (i+1)
		where
			val = (a_j*b_i+a_i*b_j) - (a_i*b_i+a_j*b_j)
			a_i = aA ! (c+i+1)
			a_j = aA ! (c-i)
			b_i = bA ! (c+i+1)
			b_j = bA ! (c-i)

	val0 = maximum $ fmap ((flip aux0) 0) [0..n]
	val1 = maximum $ fmap ((flip aux1) 0) [0..n]

plotResult :: Output -> IO ()
plotResult = print

main :: IO ()
main = do
	let t = 1 -- t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[n] <- getLine >>= return . (fmap read) . words :: IO [Int64]
		a <- getLine >>= return . (fmap read) . words :: IO [Int64]
		b <- getLine >>= return . (fmap read) . words :: IO [Int64]
		plotResult $ solve n a b
	return ()


Vasya wants to turn on Christmas lights consisting of m bulbs. Initially, all bulbs are turned off. There are n buttons, each of them is connected to some set of bulbs. Vasya can press any of these buttons. When the button is pressed, it turns on all the bulbs it's connected to. Can Vasya light up all the bulbs?If Vasya presses the button such that some bulbs connected to it are already turned on, they do not change their state, i.e. remain turned on.

The first line of the input contains integers n and m (1 ≤ n, m ≤ 100) — the number of buttons and the number of bulbs respectively.  Each of the next n lines contains xi (0 ≤ xi ≤ m) — the number of bulbs that are turned on by the i-th button, and then xi numbers yij (1 ≤ yij ≤ m) — the numbers of these bulbs.

If it's possible to turn on all m bulbs print "YES", otherwise print "NO".

NoteIn the first sample you can press each button once and turn on all the bulbs. In the 2 sample it is impossible to turn on the 3-rd lamp.

module Main where

import Control.Monad
import Data.List

sortUnique :: (Ord a) => [a] -> [a]
sortUnique = map head . group . sort

solve :: Int -> [[Int]] -> Bool
solve n lss = ls == [1 .. n]
    where ls = sortUnique $ concat lss

readInts :: IO [Int]
readInts = liftM (map read . words) getLine

main :: IO ()
main = do
  [n, m] <- readInts
  lss <- replicateM n $ liftM tail readInts
  putStrLn $ if solve m lss then "YES" else "NO"

import Data.List

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

transform :: [Int] -> [Int]
transform [] = []
transform (x:s) = let (ys, zs) = splitAt x s in ys ++ transform zs

solve :: [Int] -> Bool
solve (_:m:x) = length (nub $ transform x) == m

output :: Bool -> IO()
output b = putStrLn $ if b then "YES" else "NO"

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m] <- getInts
  xs <- replicateM n (tail <$> getInts)

  let r = [1..m] == (map head $ group $ sort $ concat xs)

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

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  [n, m] <- fmap (map read . words) getLine
  inp <- forM [1..n] $ \_ -> do
         (_:m) <- fmap (map read . words) getLine
         return m
  putStrLn $ solve inp m

solve :: [[Int]] -> Int -> String
solve inp n | (length . nub) (concat inp) == n = "YES"
            | otherwise = "NO"

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = C.getLine >>= \ns -> let [n,m] = map rIn $ C.words ns in (solve.((:) m).concat=<<forM [1..n] (\i->tail.map rIn.C.words <$>C.getLine) )
solve (x:xs)= let xs1=nub xs;l=length xs1 in if l==x then putStr "YES" else putStr "NO"

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

main::IO ()
main=do
   [n,m]<- map read <$> words <$> getLine ::IO [Int]
   x <- map head <$> group <$> sort <$> concatMap (map (fromIntegral.fst.fromJust.C.readInteger)) <$>map tail <$>   map  C.words <$> C.lines <$> C.getContents::IO [Int]
   putStrLn $ if x==[1..m] then "YES" else "NO"

import Data.List (nub)
main = do
  [_,m] <- fmap (map read . words) getLine
  bs <- fmap (nub . concat . map (tail . words) . lines) getContents
  putStrLn $ if length bs == m then "YES" else "NO"

import Data.Map as M
import Prelude as P
import Control.Monad

parse f str = P.map read (f $ words str) :: [Int]
fillMap b bu inputs = P.foldl (\ mmap x -> M.insert x True mmap)(newMap) inputs
						where newMap = M.fromList $ zip [1..bu] (repeat False)

main = do
	num <- getLine
	let (b : bu : []) = parse id num
	inputs <- replicateM b getLine
	let ans = M.foldr (\ a b -> a && b) True (fillMap b bu (concat $ P.map (parse tail) inputs))
	if ans == True then putStrLn "YES" else putStrLn "NO"

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

main= do
	[n,m]<- map read.words  <$> getLine ::IO [Int]
	s<- concat.map tail. map (map read). map words . lines <$> getContents::IO [Int]
	let t=   S.toList $ foldr (S.insert) S.empty s
	putStrLn $ if length t ==m then "YES" else "NO"

import Data.List (nub, union)

process :: Int -> [[Int]] -> Bool
process m xss = (==) m $ length $ foldl union (nub (head xss)) (tail xss)

readInt :: String -> Int
readInt = read

showPair :: (Int, Int) -> String
showPair (x,y) = show x ++ " " ++ show y

main :: IO ()
main = do
    [n,m] <- fmap (map readInt.words) getLine
    ts <- fmap (map (map readInt.words).lines) getContents
    if process m $ map tail ts
        then putStrLn "YES"
        else putStrLn "NO"

module Main where

import Control.Monad
import Data.List

sortUnique :: (Ord a) => [a] -> [a]
sortUnique = map head . group . sort

solve :: Int -> [[Int]] -> Bool
solve n lss = ls == [1 .. n]
    where ls = sortUnique $ concat lss

readInts :: IO [Int]
readInts = liftM (map read . words) getLine

main :: IO ()
main = do
  [n, m] <- readInts
  lss <- replicateM n readInts
  putStrLn $ if solve m lss then "YES" else "NO"

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = C.getLine >>= \ns -> let n = rIn $ head $ C.words ns in (solve.((:) n).concat=<<forM [1..n] (\i->tail.map rIn.C.words <$>C.getLine) )
solve (x:xs)= let xs1=nub xs;l=length xs1 in if l==x then putStr "YES" else putStr "NO"

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

main::IO ()
main=do
   [n,m]<- map read <$> words <$> getLine ::IO [Int]
   x <- map head <$> group <$> sort <$> concatMap (map (fromIntegral.fst.fromJust.C.readInteger)) <$> map C.words <$> C.lines <$> C.getContents::IO [Int]
   putStrLn $ if x==[1..m] then "YES" else "NO"

import Data.Map as M
import Prelude as P
import Control.Monad

parse str = P.map read $ words str :: [Int]
fillMap b bu inputs = P.foldl (\ mmap x -> M.insert x True mmap)(newMap) inputs
						where newMap = M.fromList $ zip [1..bu] (repeat False)

main = do
	num <- getLine
	let (b : bu : []) = parse num
	inputs <- replicateM b getLine
	print $ M.foldr (\ a b -> a && b) True (fillMap b bu (concat $ P.map parse inputs))

import Data.Map as M
import Prelude as P
import Control.Monad

parse str = P.map read $ words str :: [Int]
fillMap b bu inputs = P.foldl (\ mmap x -> M.insert x True mmap)(newMap) inputs
						where newMap = M.fromList $ zip [1..bu] (repeat False)

main = do
	num <- getLine
	let (b : bu : []) = parse num
	inputs <- replicateM b getLine
	let ans = M.foldr (\ a b -> a && b) True (fillMap b bu (concat $ P.map parse inputs))
	if ans == True then print "YES" else print "NO"

import Data.Map as M
import Prelude as P
import Control.Monad

parse str = P.map read $ words str :: [Int]
fillMap b bu inputs = P.foldl (\ mmap x -> M.insert x True mmap)(newMap) inputs
						where newMap = M.fromList $ zip [1..bu] (repeat False)

main = do
	num <- getLine
	let (b : bu : []) = parse num
	inputs <- replicateM b getLine
	let ans = M.foldr (\ a b -> a && b) True (fillMap b bu (concat $ P.map parse inputs))
	if ans == True then putStrLn "YES" else putStrLn "NO"


You are given an integer $$$n$$$. Check if $$$n$$$ has an odd divisor, greater than one (does there exist such a number $$$x$$$ ($$$x > 1$$$) that $$$n$$$ is divisible by $$$x$$$ and $$$x$$$ is odd).For example, if $$$n=6$$$, then there is $$$x=3$$$. If $$$n=4$$$, then such a number does not exist.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case contains one integer $$$n$$$ ($$$2 \le n \le 10^{14}$$$). Please note, that the input for some test cases won't fit into $$$32$$$-bit integer type, so you should use at least $$$64$$$-bit integer type in your programming language.

For each test case, output on a separate line:    "YES" if $$$n$$$ has an odd divisor, greater than one;  "NO" otherwise.  You can output "YES" and "NO" in any case (for example, the strings yEs, yes, Yes and YES will be recognized as positive).

{-main :: IO()
main = do
       putStrLn "Ingrese una Lista : ";
       xs <- readLn;
       print (todosPares xs)

--Import Data.Char

--main = do
--    contents <- getContents
--    putStr (map toUpper contents)

leerLista :: [Double] ->[String]
leerLista [] = []
leerLista (x:xs) = poTenciaDEDos x : leerLista xs

poTenciaDEDos :: Double -> [Char]
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

todosPares :: [Int] ->Bool
todosPares [] = True
todosPares (x:xs) = even x && todosPares xs-}

{-# LANGUAGE LambdaCase #-}

import Data.Bits(Bits, (.&.))
import Data.Int(Int64)

main :: IO ()
main = interact $ format . solve . parse

parse :: String -> [Int64]
parse input = case lines input of
    [] -> undefined
    (w:ws) -> readN (read w) ws
    where
        readN :: Int -> [String] -> [Int64]
        readN 0 _ = []
        readN n (w:ws) = read w : readN (n-1) ws
        readN _ _ = undefined

format :: [Bool] -> String
format = unlines . map (\case
        True -> "YES"
        False -> "NO"
    )

solve :: [Int64] -> [Bool]
solve = map (not . isPower2)

isPower2 :: (Bits i, Integral i) => i -> Bool
isPower2 n = n /= 1 && n .&. (n-1) == 0

{-# LANGUAGE LambdaCase #-}

import Data.Bits(Bits, (.&.))
import Data.Int(Int64)

main :: IO ()
main = interact $ format . solve . parse

parse :: String -> [Int64]
parse input = case lines input of
    [] -> undefined
    (w:ws) -> readN (read w) ws
    where
        readN :: Int64 -> [String] -> [Int64]
        readN 0 _ = []
        readN n (w:ws) = read w : readN (n-1) ws
        readN _ _ = undefined

format :: [Bool] -> String
format = unlines . map (\case
        True -> "YES"
        False -> "NO"
    )

solve :: [Int64] -> [Bool]
solve = map (not . isPower2)

isPower2 :: (Bits i, Integral i) => i -> Bool
isPower2 n = n /= 1 && n .&. (n-1) == 0

{-# LANGUAGE LambdaCase #-}

import Data.Bits(Bits, (.&.))

main :: IO ()
main = interact $ format . solve . parse

parse :: String -> [Integer]
parse input = case lines input of
    [] -> undefined
    (w:ws) -> readN (read w) ws
    where
        readN :: Integer -> [String] -> [Integer]
        readN 0 _ = []
        readN n (w:ws) = read w : readN (n-1) ws
        readN _ _ = undefined

format :: [Bool] -> String
format = unlines . map (\case
        True -> "YES"
        False -> "NO"
    )

solve :: [Integer] -> [Bool]
solve = map (not . isPower2)

isPower2 :: (Bits i, Integral i) => i -> Bool
isPower2 n = n /= 1 && n .&. (n-1) == 0

module Main where

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

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

--------------------------------------------------------------------------------

process :: IO ()
process = do
    x <- readLn :: IO Integer
    putStrLn $ yesOrNo . (>1) $ head . filter odd $ iterate (`div` 2) $ x

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Array
import Data.Char
import Data.List
import Data.Int
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Control.Applicative
import System.IO
import Data.Bits

-- import qualified Data.Set as Set

readInt :: String -> Int
readInt = read

printArr :: (Show a) => String -> [a] -> IO ()
printArr sep arr = do
    putStrLn . intercalate sep $ (show <$> arr)

print2DArr :: (Show a) => String -> [[a]] -> IO ()
print2DArr sep arr = sequence_ (printArr sep <$> arr)

every n xs = case drop (n-1) xs of
            (y:ys) -> y : every n ys
            [] -> []

yon True = "YES"
yon False = "NO"

main = do
    -- input <- openFile "in" ReadMode
    let input = stdin
    hSetBuffering input (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- hGetContents input
    -- printArr (readIntArr $ head q) " "
    solve contents

solve inp = sequence do
    x :: Int64 <- read <$> tail (lines inp)
    let x' = 1 `shift` countTrailingZeros x
    [putStrLn $ yon (x /= x')]

import Control.Monad
import Data.Bits

oddDivisor :: Integer -> Bool
oddDivisor n = ((.&.) n $ n-1) /= 0

main :: IO()
main = do
  t <- readLn :: IO Integer
  forM_ [1..t] $ \x -> do
    n <- readLn :: IO Integer
    if oddDivisor n then
      putStrLn "YES"
    else putStrLn "NO"

import Data.Bits

solve :: String -> String
solve s = if popCount n == 1 then "NO" else "YES"
  where n = read s :: Integer

process :: [String] -> String
process (_ : inp) = unlines $ map solve inp

main :: IO ()
main = interact (process . lines)

module Main where

import Data.Bool ( bool )

haveOddDivisor :: Int -> String
haveOddDivisor number = bool "NO" "YES" isAnyOdd
  where
    isAnyOdd = any odd $ takeWhile ((/=) 1) $ iterate (`div` 2) number

solve :: Int -> IO ()
solve 0    = return ()
solve test = do
  number <- getLine
  putStrLn $ haveOddDivisor (read number)
  solve (test - 1)

main :: IO ()
main = do
  tests <- getLine
  solve (read tests)

import Control.Monad
import Data.Bool

check 1 = False
check 2 = False
check n
  | odd n = True
  | even n = check (n `div` 2)

main = do
  n <- read <$> getLine
  replicateM_ n $ do
    i <- read <$> getLine
    putStrLn $ bool "NO" "YES" $ check i

import Data.List
import System.IO
import Control.Monad
convert :: Read a => String -> [a]
convert = map read . words

solve::Integer->Integer
solve n = if n`rem`2 == 0 then solve (n`div`2) else n

printSolve:: Integer -> IO()
printSolve n = if (n`rem`2>0) then putStrLn "YES" else printSolve2 n

printSolve2:: Integer->IO()
printSolve2 n = if (solve n == 1) then putStrLn "NO" else putStrLn "YES"

loop :: Integer -> IO ()
loop 0 = putStr ""
loop t = do{
    nn <- getLine;
    printSolve (read nn);
    loop(t-1);
}

main = do
    line <- getLine
    let t = read line :: Integer
    loop t

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

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))

import Data.Array((!))
import Control.Monad(replicateM)
import Data.Maybe

solve n
	| n == 1 = False
	| n > 1 && mod n 2 /= 0 = True
	| n > 1 && mod n 2 == 0 = solve $ div n 2

plotResult True = putStrLn "YES"
plotResult False = putStrLn "NO"

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[n] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve n

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

solve n
    | any odd . takeWhile (>1) $ iterate (`div` 2) n = "YES"
	| otherwise = "NO"

-- Trying to use only ByteString I/O with a state monad this contest

import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.ByteString.Lazy.Char8 as P

import Data.Bits

getSLine :: Monad m => StateT P.ByteString m P.ByteString
getSLine = do
  (out, next) <- P.break (== '\n') <$> get
  put $ P.tail next
  pure out

readInts :: Monad m => StateT P.ByteString m [Int]
readInts = do
  currLine <- getSLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

readIntegers :: Monad m => StateT P.ByteString m [Integer]
readIntegers = do
  currLine <- getSLine
  pure [x | Just (x, _) <- P.readInteger <$> P.words currLine]

outLine :: P.ByteString -> StateT P.ByteString IO ()
outLine v = StateT $ \s -> ((), s) <$ P.putStrLn v

main :: IO ()
main = (P.getContents >>=) $ evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readIntegers
    outLine . P.pack $ if  popCount n > 1
      then  "YES"
      else  "NO"

import Data.Char

main = do
       contents <- getContents
       putStr (map toUpper contents)

leerLista :: [Double] -> [[Char]]
leerLista [] = []
leerLista (x:xs) = poTenciaDEDos x : leerLista xs

poTenciaDEDos :: Double -> [Char]
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

import Data.Char

main = do
       contents <- getContents
       putStr (map toUpper contents)

leerLista :: [Double] -> [[Char]]
leerLista [] = []
leerLista (x:xs) = poTenciaDEDos x : leerLista xs

poTenciaDEDos :: Double -> [Char]
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "YES"
escribeBool False = "NO"

log_2 :: Double -> Double
log_2 n = log n/log 2

import Data.Char

main = do
  lineas <- getContents
  let (n:resto) = lines lineas
      datos = take (read n) resto
  mapM_ putStrLn $ leerLista (map read resto)

leerLista :: [Double] -> [String]
leerLista [] = []
leerLista (x:xs) = poTenciaDEDos x : leerLista xs

poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

-- ejemplos de prueba
--2
--3 jdjdjdjdjdjjdjdjdjdjdjdjdjddj
--4 jdjdjdjdjdjdjjdjdjdjdjdjdjdjjdj
--5
--998244353
--1099511627776

import Data.Char

main = do
  lineas <- getContents
  let (n:resto) = lines lineas
      datos = resto          --take (read n) resto
  mapM_ putStrLn $ leerLista (map read resto)

leerLista :: [Double] -> [String]
leerLista [] = []
leerLista (x:xs) = poTenciaDEDos x : leerLista xs

poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

-- ejemplos de prueba
--2
--3 jdjdjdjdjdjjdjdjdjdjdjdjdjddj
--4 jdjdjdjdjdjdjjdjdjdjdjdjdjdjjdj
--5
--998244353
--1099511627776

import Data.Char

main = do
    leerLista <- getContents
    putStr (map toUpper leerLista)

leerLista :: [Double] ->[String]
leerLista [] = []
leerLista (x:xs) = poTenciaDEDos x : leerLista xs

poTenciaDEDos :: Double -> [Char]
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

-- ejemplos de prueba
--2
--3 jdjdjdjdjdjjdjdjdjdjdjdjdjddj
--4 jdjdjdjdjdjdjjdjdjdjdjdjdjdjjdj
--5
--998244353
--1099511627776

import Data.Char

main = do
    leerLista <- getContents
    putStr (map toUpper leerLista)

leerLista :: [Double] ->[String]
leerLista [] = []
leerLista (x:xs) = poTenciaDEDos x : leerLista xs

poTenciaDEDos :: Double -> [Char]
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

-- ejemplos de prueba
--2
--3
--4
--5
--998244353
--1099511627776

main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

-- ejemplos de prueba
--2
--3
--4
--5
--998244353
--1099511627776

poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

-- ejemplos de prueba
--2
--3
--4
--5
--998244353
--1099511627776

module Main where
poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

log_2 :: Double -> Double
log_2 n = log n/log 2

escribeBool True = "NO"
escribeBool False = "YES"

main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

-- ejemplos de prueba
--2
--3
--4
--5
--998244353
--1099511627776

module Main where

log_2 :: Double -> Double
log_2 n = log n/log 2

poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

-- ejemplos de prueba
--2
--3
--4
--5
--998244353
--1099511627776

main :: IO ()
main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

--main = do putStrLn "is Odd! ?"
--          x <- readLn
--          print (poTenciaDEDos x)

-- ejemplos de prueba
--2
--3
--4
--5
--998244353
--1099511627776

module Main where

main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

-- ejemplos de prueba
--2
--3
--4
--5
--998244353
--1099511627776

module Main where

escribeBool True = "YES"
escribeBool False = "NO"

log_2 :: Double -> Double
log_2 n = log n/log 2

poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

-- ejemplos de prueba
--2
--3
--4
--5
--998244353
--1099511627776

module Main where

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

poTenciaDEDos :: Double -> String
poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

module Main where

escribeBool True = "NO"
escribeBool False = "YES"

log_2 :: Double -> Double
log_2 n = log n/log 2

poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

module Main where

escribeBool True = "NO"
escribeBool False = "YES"

log_2 n = log n/log 2

poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

--main :: IO ()
--main = print (poTenciaDEDos n)

main = do putStrLn "is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

module Main where
escribeBool True = "No"
escribeBool False = "Yes"

log_2 n = log n/log 2

poTenciaDEDos n = escribeBool (floor (log_2 n) == ceiling (log_2 n))

--main :: IO ()
--main = print (poTenciaDEDos n)

main = do putStrLn "What is Odd! ?"
          x <- readLn
          print (poTenciaDEDos x)

module Main where

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

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

--------------------------------------------------------------------------------

process :: IO ()
process = do
    x <- readLn :: IO Integer
    putStrLn $ yesOrNo . odd $ x

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array
import Data.Char
import Data.List
import Data.Int
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Control.Applicative
import System.IO
import Data.Bits

-- import qualified Data.Set as Set

readInt :: String -> Int
readInt = read

printArr :: (Show a) => String -> [a] -> IO ()
printArr sep arr = do
    putStrLn . intercalate sep $ (show <$> arr)

print2DArr :: (Show a) => String -> [[a]] -> IO ()
print2DArr sep arr = sequence_ (printArr sep <$> arr)

every n xs = case drop (n-1) xs of
            (y:ys) -> y : every n ys
            [] -> []

yon True = "YES"
yon False = "NO"

main = do
    -- input <- openFile "in" ReadMode
    let input = stdin
    hSetBuffering input (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- hGetContents input
    -- printArr (readIntArr $ head q) " "
    solve contents

solve inp = sequence do
    x <- readInt <$> tail (lines inp)
    let x' = 1 `shift` countTrailingZeros x
    [putStrLn $ yon (x /= x')]

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array
import Data.Char
import Data.List
import Data.Int
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Control.Applicative
import System.IO
import Data.Bits

-- import qualified Data.Set as Set

readInt :: String -> Int
readInt = read

printArr :: (Show a) => String -> [a] -> IO ()
printArr sep arr = do
    putStrLn . intercalate sep $ (show <$> arr)

print2DArr :: (Show a) => String -> [[a]] -> IO ()
print2DArr sep arr = sequence_ (printArr sep <$> arr)

every n xs = case drop (n-1) xs of
            (y:ys) -> y : every n ys
            [] -> []

yon True = "YES"
yon False = "NO"

main = do
    -- input <- openFile "in" ReadMode
    let input = stdin
    hSetBuffering input (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- hGetContents input
    -- printArr (readIntArr $ head q) " "
    solve contents

solve inp = sequence do
    x <- readInt <$> tail (lines inp)
    let x' = 1 `shift` countTrailingZeros x
    [putStrLn $ yon (x == x')]

import Control.Monad
import Data.Bits

oddDivisor :: Int -> Bool
oddDivisor n = ((.&.) n $ n-1) /= 0

main :: IO()
main = do
  t <- readLn :: IO Int
  forM_ [1..t] $ \x -> do
    n <- readLn :: IO Int
    if oddDivisor n then
      putStrLn "YES"
    else putStrLn "NO"

import Data.Bits

solve :: String -> String
solve s = if popCount n == 1 then "NO" else "YES"
  where n = read s :: Int

process :: [String] -> String
process (_ : inp) = unlines $ map solve inp

main :: IO ()
main = interact (process . lines)


Recall that string $$$a$$$ is a subsequence of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly zero or all) characters. For example, for the string $$$a$$$="wowwo", the following strings are subsequences: "wowwo", "wowo", "oo", "wow", "", and others, but the following are not subsequences: "owoo", "owwwo", "ooo".The wow factor of a string is the number of its subsequences equal to the word "wow". Bob wants to write a string that has a large wow factor. However, the "w" key on his keyboard is broken, so he types two "v"s instead. Little did he realise that he may have introduced more "w"s than he thought. Consider for instance the string "ww". Bob would type it as "vvvv", but this string actually contains three occurrences of "w":   "vvvv"  "vvvv"  "vvvv" For example, the wow factor of the word "vvvovvv" equals to four because there are four wows:  "vvvovvv"  "vvvovvv"  "vvvovvv"  "vvvovvv" Note that the subsequence "vvvovvv" does not count towards the wow factor, as the "v"s have to be consecutive.For a given string $$$s$$$, compute and output its wow factor. Note that it is not guaranteed that it is possible to get $$$s$$$ from another string replacing "w" with "vv". For example, $$$s$$$ can be equal to "vov".

The input contains a single non-empty string $$$s$$$, consisting only of characters "v" and "o". The length of $$$s$$$ is at most $$$10^6$$$.

Output a single integer, the wow factor of $$$s$$$.

NoteThe first example is explained in the legend.

{-# OPTIONS_GHC -O2 #-}

go :: String -> [Integer]
go = count 0 [] False
  where
    count n r b [] = r
    count n r False ('v':s) = count n (0 : r) True s
    count n r True ('v':s) = count (n + 1) (0 : r) True s
    count n r b ('o':s) = count n (n : r) False s

main = do
  s <- getLine
  let left = go s
      right = reverse . go . reverse $ s
  print (sum (zipWith (*) left right))


You have a long fence which consists of $$$n$$$ sections. Unfortunately, it is not painted, so you decided to hire $$$q$$$ painters to paint it. $$$i$$$-th painter will paint all sections $$$x$$$ such that $$$l_i \le x \le r_i$$$.Unfortunately, you are on a tight budget, so you may hire only $$$q - 2$$$ painters. Obviously, only painters you hire will do their work.You want to maximize the number of painted sections if you choose $$$q - 2$$$ painters optimally. A section is considered painted if at least one painter paints it.

The first line contains two integers $$$n$$$ and $$$q$$$ ($$$3 \le n, q \le 5000$$$) — the number of sections and the number of painters availible for hire, respectively. Then $$$q$$$ lines follow, each describing one of the painters: $$$i$$$-th line contains two integers $$$l_i$$$ and $$$r_i$$$ ($$$1 \le l_i \le r_i \le n$$$).

Print one integer — maximum number of painted sections if you hire $$$q - 2$$$ painters.

import Data.Array
import Control.Monad
import Data.List

main :: IO ()
main = do
  [n,q] <- (map read.words) <$> getLine
  qs <- replicateM q ((map read.words) <$> getLine)
  print $ solve n qs

solve :: Int -> [[Int]] -> Int
solve n qs = maximum [f q (q':qss) | (q:q':qss) <- tails qs]
  where
    arr = array (1,n) ((1,ar!0):[ (i,arr!(i-1)+ar!(i-1)) | i <- [2..n]])
    ar = accumArray (+) 0 (0,n) asss :: Array Int Int
    asss =concat [ [(l-1,1),(r,-1)]  | [l,r] <- qs ]
    f :: [Int] -> [[Int]] -> Int
    f [l,r] rest = n - zeros - minimum [ onespref!rr - onespref!(lr-1) | [lr,rr] <- rest ]
      where
        arr' = accum (+) arr [ (i,-1) | i <- [l..r]]
        zeros = length $ filter (==0) $ elems arr'
        ones = array (1,n) [ (i, if arr'!i == 1 then 1 else 0) | i <- [1..n]]
        onespref = array (0,n) ((0,0):[ (i,onespref!(i-1) + ones!i) | i <- [1..n]])
    f _ _ = undefined


You are given a grid, consisting of $$$2$$$ rows and $$$n$$$ columns. Each cell of this grid should be colored either black or white.Two cells are considered neighbours if they have a common border and share the same color. Two cells $$$A$$$ and $$$B$$$ belong to the same component if they are neighbours, or if there is a neighbour of $$$A$$$ that belongs to the same component with $$$B$$$.Let's call some bicoloring beautiful if it has exactly $$$k$$$ components.Count the number of beautiful bicolorings. The number can be big enough, so print the answer modulo $$$998244353$$$.

The only line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 1000$$$, $$$1 \le k \le 2n$$$) — the number of columns in a grid and the number of components required.

Print a single integer — the number of beautiful bicolorings modulo $$$998244353$$$.

NoteOne of possible bicolorings in sample $$$1$$$:

{-# LANGUAGE Safe #-}

import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.IntMap as IM
import Data.Array.IO.Safe
import Data.Int

main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  let m = 998244353

  --      UL
  -- 1 => BB
  -- 2 => BW
  -- 3 => WB
  -- 4 => WW

  dp <- newArray ((0,0,1),(n,k+2,4)) 0 :: IO (IOUArray (Int,Int,Int) Int64)

  writeArray dp (1,1,1) 1
  writeArray dp (1,2,2) 1
  writeArray dp (1,2,3) 1
  writeArray dp (1,1,4) 1

  forM_ [2..n] $ \i -> do
    forM_ [1..k] $ \j -> do
      --BB
      writeArray dp (i,j,1) =<< (\a b c d -> (a+b+c+d)`mod`m) <$>
        readArray dp (i-1,j,1) <*> readArray dp (i-1,j,2) <*> readArray dp (i-1,j,3) <*> readArray dp (i-1,j-1,4)
      --BW
      when (j>1) $ do
        writeArray dp (i,j,2) =<< (\a b c d -> (a+b+c+d)`mod`m) <$>
          readArray dp (i-1,j-1,1) <*> readArray dp (i-1,j,2) <*> readArray dp (i-1,j-2,3) <*> readArray dp (i-1,j-1,4)
      --WB
      when (j>1) $ do
        writeArray dp (i,j,3) =<< (\a b c d -> (a+b+c+d)`mod`m) <$>
          readArray dp (i-1,j-1,1) <*> readArray dp (i-1,j-2,2) <*> readArray dp (i-1,j,3) <*> readArray dp (i-1,j-1,4)
      --WW
      writeArray dp (i,j,4) =<< (\a b c d -> (a+b+c+d)`mod`m) <$>
        readArray dp (i-1,j-1,1) <*> readArray dp (i-1,j,2) <*> readArray dp (i-1,j,3) <*> readArray dp (i-1,j,4)

  print =<< (\a b c d -> (a+b+c+d)`mod`m) <$> readArray dp (n,k,1) <*> readArray dp (n,k,2) <*> readArray dp (n,k,3) <*> readArray dp (n,k,4)

{-# LANGUAGE Safe #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Text.Printf
import qualified Data.IntMap as IM
import Data.Ratio
import Control.Monad.State
import Data.Array.IO.Safe
import Data.Int

readIntBS = fst . fromJust . BS.readInt

main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  let m = 998244353

  --      UL
  -- 1 => BB
  -- 2 => BW
  -- 3 => WB
  -- 4 => WW

  dp <- newArray ((0,0,1),(n,k+2,4)) 0 :: IO (IOUArray (Int,Int,Int) Int64)

  writeArray dp (1,1,1) 1
  writeArray dp (1,2,2) 1
  writeArray dp (1,2,3) 1
  writeArray dp (1,1,4) 1

  forM_ [2..n] $ \i -> do
    forM_ [1..k] $ \j -> do
      --BB
      writeArray dp (i,j,1) =<< (\a b c d -> (a+b+c+d)`mod`m) <$>
        readArray dp (i-1,j,1) <*> readArray dp (i-1,j,2) <*> readArray dp (i-1,j,3) <*> readArray dp (i-1,j-1,4)
      --BW
      when (j>1) $ do
        writeArray dp (i,j,2) =<< (\a b c d -> (a+b+c+d)`mod`m) <$>
          readArray dp (i-1,j-1,1) <*> readArray dp (i-1,j,2) <*> readArray dp (i-1,j-2,3) <*> readArray dp (i-1,j-1,4)
      --WB
      when (j>1) $ do
        writeArray dp (i,j,3) =<< (\a b c d -> (a+b+c+d)`mod`m) <$>
          readArray dp (i-1,j-1,1) <*> readArray dp (i-1,j-2,2) <*> readArray dp (i-1,j,3) <*> readArray dp (i-1,j-1,4)
      --WW
      writeArray dp (i,j,4) =<< (\a b c d -> (a+b+c+d)`mod`m) <$>
        readArray dp (i-1,j-1,1) <*> readArray dp (i-1,j,2) <*> readArray dp (i-1,j,3) <*> readArray dp (i-1,j,4)

  --print =<< (forM [1..n] $ \i -> (forM [1..k] $ \j -> forM [1..4] $ \l -> readArray dp (i,j,l)))

  print =<< (\a b c d -> (a+b+c+d)`mod`m) <$> readArray dp (n,k,1) <*> readArray dp (n,k,2) <*> readArray dp (n,k,3) <*> readArray dp (n,k,1)