{-# OPTIONS_GHC -O2 -optc-O2 #-}
{-# LANGUAGE BangPatterns #-}
import Prelude hiding (getLine)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B

import Data.List (group, sort)
import Control.Arrow ((&&&))
import Data.Function (on)

solve :: [Int] -> [Int] -> String
solve = loop 0 `on` (reverse . count)
    where
    count = map (head &&& length) . group . sort
    loop acc _ _
        | acc < 0 = "YES"
    loop _ [] _ = "NO"
    loop acc ((i,x):xs') [] = loop (acc - x) xs' []
    loop acc xs@((i, x):xs') ys@((j, y):ys') = case i `compare` j of
        LT -> loop (acc + y) xs ys'
        EQ -> loop (acc - x + y) xs' ys'
        GT -> loop (acc - x) xs' ys

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

main :: IO ()
main = do
    getLine
    a <- parse <$> getLine
    getLine >>= putStrLn . solve a . parse

import Data.List
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO()
main = output . solve . map (fst . fromJust . C.readInt) . C.words =<< B.getContents

output :: Bool -> IO()
output True = putStrLn "YES"
output False = putStrLn "NO"

solve :: [Int] -> Bool
solve (n:_:k:s) = let (a, b) = splitAt n s
                      sa = reverse $ sort a
                      sb = reverse $ sort b
                  in solve' k sa sb 0 0
                  where solve' :: Int -> [Int] -> [Int] -> Int -> Int -> Bool
                        solve' 0 _ _ _ _ = False
                        solve' k [] [] na nb = na > nb
                        solve' k (a:sa) [] na nb = na + (length (a:sa)) > nb
                        solve' k [] (b:sb) na nb | k == b = solve' k [] sb na (nb + 1)
                                                 | otherwise = na > nb
                        solve' k (a:sa) (b:sb) na nb | k == a = solve' k sa (b:sb) (na + 1) nb
                                                     | k == b = solve' k (a:sa) sb na (nb + 1)
                                                     | na > nb = True
                                                     | otherwise = solve' (min (k - 1) (max a b)) (a:sa) (b:sb) na nb

--{-# OPTIONS -O2 -v0 #-}

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

solve :: [Int] -> [Int] -> Int -> String
solve xxs yys c | c > 0 = "YES" | null xxs = "NO"
    | null yys = solve xs [] (c + 1)
    | otherwise = if x == y then solve xs ys c
                  else (if x > y then solve xs yys (c + 1) else solve xxs ys (c - 1))
        where (x:xs) = xxs
              (y:ys) = yys

readi :: B.ByteString -> Int
readi = fst . fromJust . B.readInt

main = do
    --ls <- sequence $ replicate 3 getLine
    --let [[n, m, k], a, b] = map (map read . words :: String -> [Int]) ls
    ls <- sequence $ replicate 3 B.getLine
    let [[n,m,k],a,b] = map (map readi . B.words) ls
    putStrLn $ solve (sorty a) (sorty b) 0
        where sorty = sortBy (flip compare)--U.toList . U.modify (I.sortBy (flip compare)) . U.fromList

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

solve :: [Int] -> [Int] -> Int -> String
solve xxs yys c | c > 0 = "YES" | null xxs = "NO"
    | null yys = solve xs [] (c + 1)
    | otherwise = if x == y then eqc else (if x > y then gtc else ltc)
        where (x:xs) = xxs
              (y:ys) = yys
              eqc = solve xs ys c
              gtc = solve xs yys (c + 1)
              ltc = solve xxs ys (c - 1)

main = do
    [[n,m,k],a,b] <- fmap (map (map (fst . fromJust . B.readInt) . B.words) . B.lines) B.getContents
    putStrLn $ solve (sorty a) (sorty b) 0
        where sorty = sortBy (flip compare)


module Main where

data Skier = Skier Int Int Int Int Int
    deriving (Eq, Show)

instance Ord Skier where
    compare (Skier n1 _ _ t1 _) (Skier n2 _ _ t2 _) =
        if t1 == t2 && n1 == n2 then EQ else
            if t1 < t2 || (t1 == t2 && n1 > n2) then LT
                else GT

isRun :: Int -> Skier -> Bool
isRun num (Skier _ l r _ _) = l <= num && num <= r

solve :: Int -> [Skier] -> Int
solve 0 _ = 0
solve n skiers = current + solve (n-1) skiers where
    current = cost winner
    cost (Just (Skier _ _ _ _ c)) = c
    cost Nothing = 0
    winner = if length rn == 0 then Nothing else Just (minimum rn)
    rn = filter (isRun n) skiers

readSkiers :: Int -> IO [Skier]
readSkiers 0 = return []
readSkiers n = do
    sk <- getLine
    let x = map read $ words sk
    let skier = Skier n (x!!0) (x!!1) (x!!2) (x!!3)
    follow <- readSkiers $ n-1
    return (skier:follow)

main = do
    sNM <- getLine
    let nm = map read $ words sNM
    let n = nm !! 0
    let m = nm !! 1
    lst <- readSkiers m
--    print lst
    print $ solve n lst

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

profit i = snd . foldl (\(x, y) [l,r,t,c] -> if l <= i && i <= r && t < x then (t, c) else (x, y)) (10000, 0)

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let [n, m] = map (fst . fromJust . C.readInt) . C.words $ head input
	let lrtcs = map (map (fst . fromJust . C.readInt) . C.words) . take m $ tail input
	print $ sum [ profit i lrtcs | i <- [1..n] ]

data Runner
  = Runner
  {
    left   :: Int,
    right  :: Int,
    time   :: Int,
    count  :: Int,
    number :: Int
  } deriving Show

readRunner :: Int -> IO Runner
readRunner n = do
  line <- getLine
  let [l, r, t, c] = map read $ words line
  return (Runner l r t c n)

runnerInEtap :: Int -> Maybe Runner -> Bool
runnerInEtap _    Nothing  =  False
runnerInEtap etap (Just (Runner l r t c n))
  |  l <= etap && etap <= r  =  True
  |  otherwise               =  False

bestRunner' :: Int -> Maybe Runner -> Runner -> Maybe Runner
bestRunner' etap Nothing r@(Runner l2 r2 t2 c2 n2)
  | runnerInEtap etap (Just r)  =  Just r
  | otherwise                   =  Nothing
bestRunner' etap (Just runner1@(Runner l1 r1 t1 c1 n1)) runner2@(Runner l2 r2 t2 c2 n2)
  | not (runnerInEtap etap (Just runner1))  =  bestRunner' etap Nothing runner2
  | not (runnerInEtap etap (Just runner2))  =  bestRunner' etap Nothing runner1
  | t1 < t2                                 =  Just runner1
  | t2 < t1                                 =  Just runner2
  | n1 < n2                                 =  Just runner1
  | n2 < n1                                 =  Just runner2
  | otherwise                               =  error "XM..."

bestRunner :: Int -> [Runner] -> Maybe Runner
bestRunner etap runners = foldl (bestRunner' etap) Nothing runners

countRunner :: Maybe Runner -> Int
countRunner Nothing   = 0
countRunner (Just r)  = count r

main = do
  line <- getLine
  let [n, m] = map read (words line)
  runners <- sequence (map readRunner [1..m])
  print $ sum (map (\n -> countRunner (bestRunner n runners)) [1..n])

import Data.List
import Data.Function
main = do
    [n, m] <- (map read . words) `fmap` getLine
    l <- mapM (\_ -> (map read . words) `fmap` getLine) [1..m]
    let f' i [l, r, t, c] | i >= l && i <= r = (t, c)
                          | otherwise = (1001, 0)
        f = map (\i -> min1 $ map (f' i) l) [1..n]
        min1 = foldl (\m x -> if fst x < fst m then x else m) (1001, 0)
        s = foldl (\s (_, x) -> s + x) 0 f
    print s


{-# LANGUAGE GADTs, DeriveFunctor, OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B8
import Text.Printf
import Data.Functor ( (<&>) )
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Data.Maybe (fromJust)
import Data.Traversable (forM)
import qualified Control.Monad.State.Strict as S
import qualified Data.IntMap as IM
import Control.Monad (foldM_)
import Data.Int

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

solve :: B8.ByteString -> [[Int]] -> [Bool]
solve str qs = do
    [l, r] <- qs
    let Just li = B8.elemIndex (str `B8.index` l) str
    let Just ri = B8.elemIndexEnd (str `B8.index` r) str
    return $ (li, ri) /= (l, r)

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ \_ -> do
        [n, q] <- B8.getLine <&> B8.words <&> map (readIntB8 >>> fromJust)
        str <- B8.getLine
        qs <- forM [1 .. q] $ \_ -> B8.getLine <&> B8.words <&> map (readIntB8 >>> fromJust >>> (+ (-1)))
        let answers = solve str qs
        forM_ answers $ \answer ->
            B8.putStrLn $ if answer then "YES" else "NO"

import Control.Arrow ((>>>))
import Data.Bool (bool)

main :: IO ()
main =
  interact $
  lines >>> drop 1 >>> process >>> concat >>> map (bool "NO" "YES") >>> unlines

process :: [String] -> [[Bool]]
process [] = []
process (nq:s:xss) = map (solve s) qs : process xss'
  where
    q = words >>> last >>> read $ nq
    (xs, xss') = splitAt q xss
    qs = map (words >>> map read) xs

solve :: String -> [Int] -> Bool
solve s [l, r] =
  elem (s !! (l - 1)) (take (l - 1) s) || elem (s !! (r - 1)) (drop r s)


-- https://codeforces.com/contest/1428/problem/A
import Control.Monad (mapM_)

solution :: Integral a => (a,a) -> (a,a) -> a
solution (x1,y1) (x2,y2)
  | x1 == x2  = abs (y2 - y1)
  | y1 == y2  = abs (x2 - x1)
  | otherwise = abs (x2 - x1) + abs (y2 - y1) + 2

main = do
  numTests <- read <$> getLine
  tests <- sequence $ replicate numTests $ do
    [x1,y1,x2,y2] <- map read . words <$> getLine
    return $ solution (x1,y1) (x2,y2)
  mapM_ (putStrLn . show) tests

import Data.List

main = interact $ concat . intersperse "\n" . map (show . pull) . drop 1 . (map . map) read . map words . lines

pull :: [Int] -> Int
pull (fx:fy:tx:ty:_)
  | fx == tx = abs (fy - ty)
  | fy == ty = abs (fx - tx)
  | fx == tx && fy == ty = 0
  | otherwise = abs (fy - ty) + abs (fx - tx) + 2

import Control.Monad

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

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [x1, y1, x2, y2] <- readInts
    let
      ans = (abs (x2 - x1) + abs (y2 - y1) ) + if ( x1 == x2 || y1 == y2 ) then  0  else  2
    print ans

import Control.Monad

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

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [x1, y1, x2, y2] <- readInts
    let
      x' = abs (x2 - x1)
      y' = abs (y2 - y1)
      ans = x' + y' + if  x' > 0 && y' > 0  then  2  else  0
    print ans

-- https://codeforces.com/contest/1428/problem/A

solution :: Integral a => (a,a) -> (a,a) -> a
solution (x1,y1) (x2,y2) = abs (x2 - x1) + abs (y2 - y1) + 2

main = do
  numTests <- read <$> getLine
  sequence_ $ replicate numTests $ do
    [x1,y1,x2,y2] <- map read . words <$> getLine
    print $ solution (x1,y1) (x2,y2)


{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    FlexibleInstances, ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Exception (assert)
import Control.Monad hiding (mapM, mapM_, forM, forM_)
import Control.Monad.State hiding (mapM, mapM_, forM, forM_)
import Data.Array.IArray
import Data.Array.ST
import Data.Array.Unboxed (UArray)
import Data.Bits
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Foldable
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Ix
import Data.List hiding (and, or, any, all, foldr, foldl')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.STRef
import Data.Traversable
import Prelude hiding (and, or, any, all, mapM, mapM_)
import System.IO

------

data P a b = P !a !b
  deriving (Show, Eq, Ord)

data T a b c = T !a !b !c
  deriving (Show, Eq, Ord)

data Q a b c d = Q !a !b !c !d
  deriving (Show, Eq, Ord)

class HasFirst a t | t -> a where
  first :: t -> a

instance HasFirst a (P a b) where
  first (P x _) = x

instance HasFirst a (T a b c) where
  first (T x _ _) = x

instance HasFirst a (Q a b c d) where
  first (Q x _ _ _) = x

instance HasFirst a (a, b) where
  first (x, _) = x

instance HasFirst a (a, b, c) where
  first (x, _, _) = x

instance HasFirst a (a, b, c, d) where
  first (x, _, _, _) = x

class HasSecond b t | t -> b where
  second :: t -> b

instance HasSecond b (P a b) where
  second (P _ x) = x

instance HasSecond b (T a b c) where
  second (T _ x _) = x

instance HasSecond b (Q a b c d) where
  second (Q _ x _ _) = x

instance HasSecond b (a, b) where
  second (_, x) = x

instance HasSecond b (a, b, c) where
  second (_, x, _) = x

instance HasSecond b (a, b, c, d) where
  second (_, x, _, _) = x

class HasThird c t | t -> c where
  third :: t -> c

instance HasThird c (T a b c) where
  third (T _ _ x) = x

instance HasThird c (Q a b c d) where
  third (Q _ _ x _) = x

instance HasThird c (a, b, c) where
  third (_, _, x) = x

instance HasThird c (a, b, c, d) where
  third (_, _, x, _) = x

class HasFourth d t | t -> d where
  fourth :: t -> d

instance HasFourth d (Q a b c d) where
  fourth (Q _ _ _ x) = x

instance HasFourth d (a, b, c, d) where
  fourth (_, _, _, x) = x

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: (Functor m, MonadHopper r m) => m r
popJust = fromJust <$> pop

------

popInt :: (Functor m, MonadHopper B.ByteString m) => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: (Functor m, MonadHopper B.ByteString m) => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: (Functor m, MonadHopper B.ByteString m) => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: (Functor m, MonadHopper B.ByteString m) => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = do
  ~[n, u, r, d, l] <- popInts
  return $ bool "NO" "YES" $ solve n u r d l

solve n u r d l = or $ map test [Q tl tr br bl |
                                 tl <- [0, 1], tr <- [0, 1],
                                 br <- [0, 1], bl <- [0, 1]]
  where
    test (Q tl tr br bl) = and $ map test1 $
                           [T u tl tr, T r tr br, T d br bl, T l bl tl]

    test1 (T m a b) | m == n               = a == 1 && b == 1
                    | m == 0               = a == 0 && b == 0
                    | m == n - 1 && m == 1 = a + b == 1
                    | m == n - 1           = a + b >= 1
                    | m == 1               = a + b <= 1
                    | otherwise            = True

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
    [n, u, r, d, l] <- getIntList
    putStrLn $ yesOrNo $ f n [u, r, d, l]

f :: Int -> [Int] -> Bool
f n s = or . map (check n s) $ ways
    where ways = map change [0..15]

check :: Int -> [Int] -> [Int] -> Bool
check n [u, r, d, l] [ul, ur, dl, dr] = and [
    ul + ur + n - 2 >= u && u >= ul + ur,
    dl + dr + n - 2 >= d && d >= dl + dr,
    ul + dl + n - 2 >= l && l >= ul + dl,
    ur + dr + n - 2 >= r && r >= ur + dr]

change :: Int -> [Int]
change = map (`mod` 2) . take 4 . iterate (`div` 2)

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n, u, r, d, l] <- getInts
    let
      xs = [0, 1]
      checkRange x = 0 <= x && x <= n - 2
      check (x, y, z, w) = checkRange (u - x - y) && checkRange (r - y - w) && checkRange (d - z - w) && checkRange (l - x - z)
      results = filter id $ map check $ [(x, y, z, w) | x <- xs, y <- xs, z <- xs, w <- xs]
    C.putStrLn $ C.pack $ if null results then "NO" else "YES"

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, u, r, d, le] <- readInts
    let
      opts = foldr (liftM2 (:)) [[]] $ replicate 4 [0, 1]
      isOk opt = let
        up = opt !! 0 + opt !! 1
        rp = opt !! 1 + opt !! 2
        dp = opt !! 2 + opt !! 3
        lep = opt !! 3 + opt !! 0
        ok (v, p) = 0 <= v - p && v - p <= (n - 2)
        in  all ok $ zip [u, r, d, le] [up, rp, dp, lep]
      ans = any isOk opts
    lift $ P.putStrLn $ P.pack $ if  ans  then  "YES"  else  "NO"

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]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    FlexibleInstances, ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Exception (assert)
import Control.Monad hiding (mapM, mapM_, forM, forM_)
import Control.Monad.State hiding (mapM, mapM_, forM, forM_)
import Data.Array.IArray
import Data.Array.ST
import Data.Array.Unboxed (UArray)
import Data.Bits
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Foldable
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Ix
import Data.List hiding (and, or, any, all, foldr, foldl')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.STRef
import Data.Traversable
import Prelude hiding (and, or, any, all, mapM, mapM_)
import System.IO

------

data P a b = P !a !b
  deriving (Show, Eq, Ord)

data T a b c = T !a !b !c
  deriving (Show, Eq, Ord)

data Q a b c d = Q !a !b !c !d
  deriving (Show, Eq, Ord)

class HasFirst a t | t -> a where
  first :: t -> a

instance HasFirst a (P a b) where
  first (P x _) = x

instance HasFirst a (T a b c) where
  first (T x _ _) = x

instance HasFirst a (Q a b c d) where
  first (Q x _ _ _) = x

instance HasFirst a (a, b) where
  first (x, _) = x

instance HasFirst a (a, b, c) where
  first (x, _, _) = x

instance HasFirst a (a, b, c, d) where
  first (x, _, _, _) = x

class HasSecond b t | t -> b where
  second :: t -> b

instance HasSecond b (P a b) where
  second (P _ x) = x

instance HasSecond b (T a b c) where
  second (T _ x _) = x

instance HasSecond b (Q a b c d) where
  second (Q _ x _ _) = x

instance HasSecond b (a, b) where
  second (_, x) = x

instance HasSecond b (a, b, c) where
  second (_, x, _) = x

instance HasSecond b (a, b, c, d) where
  second (_, x, _, _) = x

class HasThird c t | t -> c where
  third :: t -> c

instance HasThird c (T a b c) where
  third (T _ _ x) = x

instance HasThird c (Q a b c d) where
  third (Q _ _ x _) = x

instance HasThird c (a, b, c) where
  third (_, _, x) = x

instance HasThird c (a, b, c, d) where
  third (_, _, x, _) = x

class HasFourth d t | t -> d where
  fourth :: t -> d

instance HasFourth d (Q a b c d) where
  fourth (Q _ _ _ x) = x

instance HasFourth d (a, b, c, d) where
  fourth (_, _, _, x) = x

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: (Functor m, MonadHopper r m) => m r
popJust = fromJust <$> pop

------

popInt :: (Functor m, MonadHopper B.ByteString m) => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: (Functor m, MonadHopper B.ByteString m) => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: (Functor m, MonadHopper B.ByteString m) => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: (Functor m, MonadHopper B.ByteString m) => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = do
  ~[n, u, r, d, l] <- popInts
  return $ bool "NO" "YES" $ solve n u r d l

solve n u r d l = or $ map test [Q tl tr br bl |
                                 tl <- [0, 1], tr <- [0, 1],
                                 br <- [0, 1], bl <- [0, 1]]
  where
    test (Q tl tr br bl) = and $ map test1 $
                           [T u tl tr, T r tr br, T d br bl, T l bl tl]

    test1 (T m a b) | m == n = a == 1 && b == 1
                    | m == 0 = a == 0 && b == 0
                    | m == n - 1 = a + b >= 1
                    | m == 1 = a + b <= 1
                    | otherwise = True


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

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

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

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]


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

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

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


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


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


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


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

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


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

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

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

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)