{-# LANGUAGE ScopedTypeVariables #-}
module Main where

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

main :: IO ()
main = do
    line <- getLine >> getLine
    let nums :: [Int] = sortBy (flip compare) . map read . words $ line
    putStrLn . unwords . map show . S.toDescList . solve . S.fromDescList $ nums

-- possibilities :: Int -> [Int]
-- possibilities = possibilities' []

-- possibilities' :: [Int] -> Int-> [Int]
-- possibilities' acc n | n == 1    = reverse acc
--                      | even n    = possibilities' (n `div` 2 : acc) (n `div` 2)
--                      | otherwise = possibilities' ((n-1) `div` 2 : acc) ((n-1) `div` 2)
possibilities :: Int -> [Int]
possibilities n | n == 1    = [1]
                | even n    = n : possibilities (n     `div` 2)
                | otherwise = n : possibilities ((n-1) `div` 2)

reduce :: S.Set Int -> Maybe (S.Set Int)
-- reduce xs = case maxNonMember of
--     Nothing -> Nothing
--     Just e -> Just $ S.insert e $ S.delete maxElem xs
reduce xs = maxNonMember >>= (\e -> Just . S.insert e $ S.delete maxElem xs)
    where
        maxElem = S.findMax xs
        maxNonMember = find (`S.notMember` xs) $ possibilities maxElem

solve :: S.Set Int -> S.Set Int
solve xs = case reduce xs of
    Nothing -> xs
    Just ys -> solve ys

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

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

main :: IO ()
main = do
    line2 <- getLine >> getLine
    let nums :: [Int] = sortBy (flip compare) $ map read $ words line2
    putStrLn $ unwords $ map show $ S.toDescList $ solve $ S.fromDescList nums

possibilities :: Int -> [Int]
possibilities = possibilities' []

possibilities' :: [Int] -> Int-> [Int]
possibilities' acc n | n == 1    = reverse acc
                     | even n    = possibilities' (n `div` 2 : acc) (n `div` 2)
                     | otherwise = possibilities' ((n-1) `div` 2 : acc) ((n-1) `div` 2)

reduce :: S.Set Int -> Maybe (S.Set Int)
reduce xs = case maxNonMember of
    Nothing -> Nothing
    Just e -> Just $ S.insert e $ S.delete maxElem xs
    where
        maxElem = S.findMax xs
        maxNonMember = find (\x -> x `S.notMember` xs) $ possibilities maxElem

solve :: S.Set Int -> S.Set Int
solve xs = case reduce xs of
    Nothing -> xs
    Just ys -> solve ys

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as B
import qualified Data.IntSet           as IS

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  putStrLn.unwords.map show $ solve xs

solve :: [Int] -> [Int]
solve xs = go $ IS.fromList xs
  where
    go set = case filter (`IS.notMember`set') ms of
        (y:_) -> go $ IS.insert y set'
        [] -> IS.toList set
      where
        (m, set') = IS.deleteFindMax set
        ms = tail.takeWhile (>0) $ iterate (`quot`2) m

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

import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S

readInt s = let Just (a, _) = BS.readInt s in a

main = BS.interact $ BS.unwords . map (BS.pack . show) . solve . map readInt . BS.words

solve (n:rest) = S.toList $ relax_all $ S.fromList $ take n rest
  where relax_all s = let rv = relax s in
          if rv > 0 then relax_all $ S.insert rv $ S.deleteMax s
          else s

relax s = relax_ $ S.findMax s
  where relax_ v = if S.notMember v s then v else relax_ $ v `div` 2

{-
██╗  ██╗ █████╗ ███████╗██╗  ██╗███████╗██╗     ██╗         ███████╗████████╗██╗    ██╗
██║  ██║██╔══██╗██╔════╝██║ ██╔╝██╔════╝██║     ██║         ██╔════╝╚══██╔══╝██║    ██║
███████║███████║███████╗█████╔╝ █████╗  ██║     ██║         █████╗     ██║   ██║ █╗ ██║
██╔══██║██╔══██║╚════██║██╔═██╗ ██╔══╝  ██║     ██║         ██╔══╝     ██║   ██║███╗██║
██║  ██║██║  ██║███████║██║  ██╗███████╗███████╗███████╗    ██║        ██║   ╚███╔███╔╝
╚═╝  ╚═╝╚═╝  ╚═╝╚══════╝╚═╝  ╚═╝╚══════╝╚══════╝╚══════╝    ╚═╝        ╚═╝    ╚══╝╚══╝

                                    $$\                  $$$$$$\  $$\         $$\   $$$$$$\        $$\      $$\   $$\ $$\
                                    \__|                $$  __$$\ $$ |      $$$$ | $$  __$$\       $$ |     $$ |  $$ |$$ |
 $$$$$$$\  $$$$$$\   $$$$$$\        $$\ $$$$$$$\        \__/  $$ |$$ |  $$\ \_$$ | $$ /  $$ |      $$ |     $$ |  $$ |$$ |
$$  _____|$$  __$$\ $$  __$$\       $$ |$$  __$$\        $$$$$$  |$$ | $$  |  $$ | \$$$$$$$ |      $$ |     $$ |  $$ |$$ |
$$ /      $$ /  $$ |$$ /  $$ |      $$ |$$ |  $$ |      $$  ____/ $$$$$$  /   $$ |  \____$$ |      $$ |     $$ |  $$ |$$ |
$$ |      $$ |  $$ |$$ |  $$ |      $$ |$$ |  $$ |      $$ |      $$  _$$<    $$ | $$\   $$ |      $$ |     $$ |  $$ |$$ |
\$$$$$$$\ $$$$$$$  |$$$$$$$  |      $$ |$$ |  $$ |      $$$$$$$$\ $$ | \$$\ $$$$$$\\$$$$$$  |      $$$$$$$$\\$$$$$$  |$$$$$$$$\
 \_______|$$  ____/ $$  ____/       \__|\__|  \__|      \________|\__|  \__|\______|\______/       \________|\______/ \________|
          $$ |      $$ |
          $$ |      $$ |
          \__|      \__|
-}

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

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

main :: IO ()
main = do
    line <- getLine >> getLine
    let nums :: [Int] = sortBy (flip compare) . map read . words $ line
    putStrLn . unwords . map show . S.toDescList . solve . S.fromDescList $ nums

possibilities :: Int -> [Int]
possibilities n | n == 1    = [1]
                | even n    = n : possibilities (n     `div` 2)
                | otherwise = n : possibilities ((n-1) `div` 2)

reduce :: S.Set Int -> Maybe (S.Set Int)
reduce  xs           = maxNonMember >>= (\e -> Just . S.insert e . S.delete maxElem $ xs) where
        maxElem      = S.findMax xs
        maxNonMember = find (`S.notMember` xs) $ possibilities maxElem

solve :: S.Set Int -> S.Set Int
solve xs = case reduce xs of
    Nothing -> xs
    Just ys -> solve ys

import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S

readInt s = let Just (a, _) = BS.readInt s in a

main = BS.interact $ BS.unwords . map (BS.pack . show) . solve . map readInt . BS.words

solve (n:rest) = S.toList $ relax_all $ S.fromList $ take n rest
  where relax_all s = let rv = relax s in
          if rv > 0 then S.insert rv $ S.deleteMax s
          else s

relax s = relax_ $ S.findMax s
  where relax_ v = if S.notMember v s then v else relax_ $ v `div` 2

import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S

readInt s = let Just (a, _) = BS.readInt s in a

main = BS.interact $ BS.unwords . map (BS.pack . show) . solve . map readInt . BS.words

solve (n:rest) = S.toList $ relax_all $ S.fromList $ take n rest
  where relax_all s = let rv = relax s in
          if rv > 0 then S.insert rv $ S.deleteMax s
          else s

relax s = relax_ $ S.findMax s
  where relax_ v = if S.member v s then v else relax_ $ v `div` 2


{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace

----- <Solution> --------------------------------------------------------------
data TC = TC {as :: [Int64]}

type Output = Int64

input :: Scanner TC
input = do
  as <- numberOf int64
  return TC {..}

solve :: TC -> Output
solve = as >>> sum >>> abs

output :: Int -> Output -> C.ByteString
output ix = showB

----- </Solution> -------------------------------------------------------------

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map solve >>> zip [1 ..] >>> map (uncurry output) >>> C.unlines

----- Template ----------------------------------------------------------------

-- Debug
debug :: Show a => a -> a

#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- helpers
(>$>) = flip ($)

infixl 0 >$>

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

-- pragmas.hs {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad         (replicateM_)
import           Data.Array            (Array, (!))
import qualified Data.ByteString.Char8 as C
import           Data.Ix               (Ix)
import           Data.List             (unfoldr)

solve :: [Int] -> Int
solve xs = abs (abs psum - abs nsum)
  where
  psum = sum $ filter (>=0) xs
  nsum = sum $ filter (<0) xs

docase :: IO ()
docase = do
  _ <- getInt
  xs <- getInts
  print $ solve xs

main :: IO ()
main = getInt >>= flip replicateM_ docase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts = unfoldr go where
    go s = do
        (n,s1) <- C.readInt s
        let s2 = C.dropWhile (==' ') s1
        pure (n,s2)

getInt :: IO Int
getInt  = readInt <$> C.getLine

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

getInts :: IO [Int]
getInts = readInts <$> C.getLine


import Data.List

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

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

solve :: [Int] -> Bool
solve (na:nb:k:m:x) =
    let a = (sort $ take na x) !! (k - 1)
        b = (sort $ drop na x) !! (nb - m)
    in  a < b

import Control.Applicative
import Data.List

main::IO ()
main=do
    [n,m]<- map read <$> words <$>  getLine
    [a,b]<- map read <$> words <$> getLine ::IO [Int]
    a1<- head <$> drop (a-1) <$>  map read <$>   words   <$> getLine:: IO Int
    b1<- head <$> drop (m-b) <$> map read <$> words <$> getLine::IO Int
    putStrLn $ if a1 <b1 then "YES" else "NO"

main :: IO ()
main = putStrLn . yesno . solve . map (map read . words) . lines =<< getContents

solve :: [[Int]] -> Bool
solve [ [ _, nb ], [ k, m ], as, bs ] = as !! (k - 1) < bs !! (nb - m)
solve _ = undefined

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

readInts = fmap (map read . words) getLine
main = do
  getLine
  [k,m] <- readInts
  as <- readInts
  bs <- readInts
  putStrLn $ if as !! (k-1) < bs !! (length bs - m) then "YES" else "NO"

f :: [Int] -> [Int] -> Int -> Int -> Int -> Bool
f xs ys k m n2 = xs !! (k-1) < ys !! (n2-m)

main = do
    [n1,n2] <- getList
    [k,m] <- getList
    xs <- getList
    ys <- getList
    putStrLn $ if f xs ys k m n2 then "YES"
                                 else "NO"

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

main=interact $ solve . map read . words
solve (la:lb:m:k:x) = if x!!(m-1)<x!!(la+lb-k) then "YES" else "NO"

parseLine :: String -> [Int]
parseLine str = map (read :: String -> Int) $ words str

main :: IO ()
main = do
    sizes <- getLine -- ignore
    counts <- getLine
    let [k, m] = map (+ (-1)) $ parseLine counts
    input <- getLine
    let a = parseLine input
    input <- getLine
    let b = parseLine input
    putStrLn $ if a !! k < (reverse b) !! m
                   then "YES"
                   else "NO"

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

main=do
	[na,nb]<-  map read.words  <$> getLine:: IO  [Int]
	[k,m]<-  map read.words  <$> getLine:: IO  [Int]
	a<-  sort.map (fst.fromJust.C.readInt). C.words <$> C.getLine ::IO [Int]
	b<-  reverse.sort.map (fst.fromJust.C.readInt). C.words <$> C.getLine ::IO [Int]
	let a1 = head $ drop (k-1) a
	let b1 = head $ drop (m-1) b
	putStrLn $ if a1 <b1 then "YES" else "NO"

ans (a,b)
  | a < b = "YES"
  | otherwise = "NO"

readRow = do
  input <- getLine
  return [read x::Int | x <- words input]

main = do
  input <- getLine
  input <- getLine
  let [k,m] = [read x::Int | x <- words input]
  a <- readRow
  b <- readRow
  putStrLn(ans((a !! (k-1),(b !! (length b - m)))))

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Control.Applicative

-- Meat
solve :: Int -> Int -> [Int] -> [Int] -> String
solve k m as bs
  | length btail >= m = "YES"
  | otherwise = "NO"
    where amax = last $ take k as
          btail = dropWhile (<= amax) bs

-- Shit
main :: IO ()
main = do
        [_, [k,m], as, bs] <- readShit
        printShit [solve k m as bs]

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

parseInput input = (na, nb, k, m, xs, ys) where
    ls = lines input
    [na, nb] = map read $ words $ head ls :: [Int]
    [k, m] = map read $ words $ head $ tail ls :: [Int]
    xs = map read $ words $ ls !! 2 :: [Int]
    ys = map read $ words $ last ls :: [Int]

solve _ nb k m xs ys = case last as < head bs of
                            True -> "YES"
                            _    -> "NO"
                       where
                            as = take k xs
                            bs = drop (nb - m) ys

main = do
    input <- getContents
    let (na, nb, k, m, xs, ys) = parseInput input
    putStrLn $ solve na nb k m xs ys

main :: IO()
main = do
    [a,b] <- fmap (map (\x -> read x::Int) . words) getLine
    [m,k] <- fmap (map (\x -> read x::Int) . words) getLine
    a1 <- fmap (map (\x -> read x::Int) . words) getLine
    a2 <- fmap (map (\x -> read x::Int) . words) getLine
    let det = a1!!(m-1)
    if length ([x | x<-a2 , x>det]) >= k then putStrLn "YES" else putStrLn "NO"

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

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

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

main = do
  getLine
  [a, b] <- getInts
  xs <- getInts
  ys <- getInts

  putStrLn $ if xs!!(a-1) < ys!!(length ys - b) then "YES" else "NO"

answer::Int->Int->[Int]->[Int]->String
answer k m na nb = btos ((na !! (k-1)) < (nb !! ((length nb)-m)))
btos::Bool -> String
btos True = "YES"
btos False = "NO"
main = do
       w0 <- getLine
       w1 <- getLine
       w2 <- getLine
       w3 <- getLine
       let w = words w1
       let k = read (w !! 0)::Int
       let m = read (w !! 1)::Int
       let na = [read n::Int|n <-(words w2)]
       let nb = [read n::Int|n <-(words w3)]
       putStrLn $ answer k m na nb

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

main = do
    let int = fst . fromJust . B.readInt
        ints = map int . B.words
    B.getLine
    [n, m] <- ints <$> B.getLine
    as <- ints <$> B.getLine
    bs <- ints <$> B.getLine
    putStrLn $ if (last $ take n $ sort as) < ( head $ drop (length bs - m ) $ sort bs) then "YES" else "NO"

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

main = do
    let int = fst . fromJust . B.readInt
        ints = map int . B.words
    B.getLine
    [n, m] <- ints <$> B.getLine
    as <- ints <$> B.getLine
    bs <- ints <$> B.getLine
    putStrLn $ if (last $ take n as) < ( head $ drop (length bs - m ) bs) then "YES" else "NO"

-- Codeforces 572A

main :: IO ()
main = do
    [na, nb] <- readAndSplit
    [k, m] <- readAndSplit
    a <- readAndSplit
    b <- readAndSplit
    putStrLn $ if (a!!(k-1)) < (b!!(nb-m)) then "YES" else "NO" where
        readAndSplit = fmap (map read . words) getLine

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

getIntList :: IO [Int]
getIntList = map fst . mapMaybe C.readInt . C.words <$> C.getLine

main :: IO ()
main = do
  _:n:_ <- getIntList
  k:m:_ <- getIntList
  as <- getIntList
  bs <- getIntList
  let a = last $ take k as
  let b = head $ if n>m then drop (n-m) bs else bs
  putStrLn $ if a<b then "YES" else "NO"

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

main = do
    let int = fst . fromJust . B.readInt
        ints = map int . B.words
    B.getLine
    [n, m] <- ints <$> B.getLine
    as <- ints <$> B.getLine
    bs <- ints <$> B.getLine
    putStrLn $ if (last $ take n $ sort as) < (head $ sort bs) then "YES" else "NO"

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

getIntList :: IO [Int]
getIntList = map fst . mapMaybe C.readInt . C.words <$> C.getLine

main :: IO ()
main = do
  _ <- C.getLine
  k:m:_ <- getIntList
  as <- getIntList
  bs <- getIntList
  let a = maximum $ take k as
  let b = minimum $ take m bs
  putStrLn $ if a<b then "YES" else "NO"

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

getIntList :: IO [Int]
getIntList = map fst . mapMaybe C.readInt . C.words <$> C.getLine

main :: IO ()
main = do
  _ <- C.getLine
  k:m:_ <- getIntList
  as <- getIntList
  bs <- getIntList
  let a = as!!k
  let b = head bs
  putStrLn $ if a<b then "YES" else "NO"

import Control.Applicative
import Data.List

main::IO ()
main=do
    n<-   getLine
    [a,b]<- map read <$> words <$> getLine ::IO [Int]
    a1<- head <$> drop (b-1) <$>  map read <$>   words   <$> getLine:: IO Int
    b1<- head <$> map read <$> words <$> getLine::IO Int
    putStrLn $ if a1 <b1 then "YES" else "NO"


{-# LANGUAGE BangPatterns #-}

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

import qualified Data.Array as A

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

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

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

solve :: Integer -> Integer -> Integer
solve a b = a * b

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

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

import Control.Monad

answer :: Int -> Int -> Int
answer x y = x * y

solve line = x * y
    where (x:y:_) = map read $ words line

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


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

check l = if sort l == l then Just l else Nothing

solve (_ : moneys) = check $ zipWith (\x y -> y - x) [0..] $ sort (zipWith (+) [0..] moneys)

pp Nothing = [":("]
pp (Just l) = [unwords $ map show l]

main = B.interact $ B.unlines . map B.pack . pp . solve . map readInt . B.words

readInt = fst . fromJust . B.readInt

import Data.Char (ord)
import Data.List

type Input  = [Int]
type Output = Maybe [Int]

readInt :: String -> Int
readInt = foldl' (\s d -> s * 10 + ord d - 48) 0

parse :: String -> Input
parse contents = a where [_, a] = map (map readInt . words) . lines $ contents

check :: [Int] -> Maybe [Int]
check a | sorted    = Just a
        | otherwise = Nothing
        where sorted = and $ zipWith (<=) (0 : a) a

solve :: Input -> Output
solve = check . add (map negate nats) . sort . add nats
        where nats = [0..]
              add  = zipWith (+)

format :: Output -> String
format Nothing  = ":("
format (Just a) = unwords . map show $ a

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents


{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
main = interact $ unlines . g . tail . lines
        where
            aux1 :: String -> Int
            aux1 ss = read . last . words $ ss
            aux2 :: String -> [Int]
            aux2 ss = map read . words $ ss
            g :: [String] -> [String]
            g (x:y:sss) = f' (aux2 y) (aux1 x): g sss
            g [] = []

f' :: [Int] -> Int -> String
f' (s:ss) d = show . (\(x, _, _) -> x) . foldl ff (0, s, s) $ ss
                where
                    twiceD = 2*d
                    ff (accum, smin, smax) x
                        | x > smax = if x - smin > twiceD then
                                        (accum+1, x, x)
                                     else
                                        (accum, smin, x)
                        | x < smin = if smax - x > twiceD then
                                        (accum+1, x, x)
                                     else
                                        (accum, x, smax)
                        | otherwise = (accum, smin, smax)

f :: [Int] -> Int -> String
f (s:ss) d = show (aux s s 0 ss)
    where
        twiceD = 2*d
        aux :: Int -> Int -> Int -> [Int] -> Int
        aux smin smax accum (x:xs)
            | x > smax = if x - smin > twiceD then
                            aux x x (accum+1) xs
                         else
                            aux smin x accum xs
            | x < smin = if smax - x > twiceD then
                            aux x x (accum+1) xs
                         else
                            aux x smax accum xs
            | otherwise = aux smin smax accum xs
        aux _ _ accum [] = accum

{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM
                                                , replicateM_
                                                )
import           Data.Bits                      ( Bits(..) )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( elemIndex
                                                , findIndex
                                                , foldl'
                                                , unfoldr
                                                )
import           Data.Maybe                     ( fromMaybe )
import           Text.Printf                    ( printf )

-- arrange :: [a] -> Int -> [[a]]
-- arrange xs n = mapM (const xs) [1 .. n]

-- data Tree a = Null | Branch a (Tree a) (Tree a)
--   deriving (Show, Eq, Functor)

-- makeBaseFunctor ''Tree

-- x :: Tree Int
-- x = Branch 1 (Branch 2 Null Null) (Branch 3 Null Null)

-- y :: Tree Int -> Int
-- y = cata $ \case
--     NullF         -> 0
--     BranchF x a b -> x + a + b

-- >>> y x
-- 6

-- z :: Tree Int -> Int
-- z = para $ \case
--     NullF                     -> 0
--     BranchF x (x1, a) (x2, b) -> x + a + b + y x1 + y x2

-- >>> z x
-- 11

-- quicksort :: Ord a => [a] -> [a]
-- quicksort = hylo merge split  where
--     split []       = NullF
--     split (x : xs) = let (l, r) = partition (< x) xs in BranchF x l r

--     merge NullF           = []
--     merge (BranchF x l r) = l ++ [x] ++ r

-- >>> quicksort ([5,4,6,7,8,6,4,2])
-- [2,4,4,5,6,6,7,8]

-- fibSeq :: [Int]
-- fibSeq = futu phi Nil
--   where
--     phi Nil                    = Cons 0 (Pure (Cons 0 Nil))
--     phi x@(Cons _ Nil        ) = Cons 1 (Pure (Cons 1 (Cons 0 Nil)))
--     phi t@(Cons x (Cons y xs)) = Cons (x + y) (Pure (Cons (x + y) (Cons x Nil)))

-- >>> take 20 fibSeq
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

-- f1 :: [Int] -> Int
-- f1 = flip runReader 0 . cataA phi
--   where
--     phi Nil        = return 0
--     phi (Cons x t) = do
--         n <- ask
--         if n >= 10 then return 0 else (x +) <$> local succ t

-- f2 :: [Int]
-- f2 = apo phi 1
--   where
--     phi n | n < 100   = Cons (n * 2) (Right (n + 1))
--           | otherwise = Cons (n * 2) (Left [1, 2, 3])

-- >>> f1 fibSeq
-- 88

-- >>> f2
-- [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198]

-- urlParser :: Parser String
-- urlParser = argument str (metavar "URL")

-- segmented :: Int -> Int -> [(Int, Int)]
-- segmented total blocksize = (id &&& (min (total - 1) . (+ (blocksize - 1)))) <$> takeWhile (< total) [0, blocksize ..]

-- main :: IO ()
-- main = do
--     manager <- newManager tlsManagerSettings
--     url     <- execParser opts
--     req     <- parseRequest url
--     res     <- httpNoBody req manager
--     let len = maybe 0 fst (readInt =<< (lookup "Content-Length" (requestHeaders req) <|> lookup "content-length" (responseHeaders res)))
--     if len == 0
--         then do
--             res <- httpLbs req manager
--             print $ responseStatus res
--             print $ responseBody res
--         else do
--             pool <- createPool (pure ()) (const (pure ())) 2 0.5 5
--             mapConcurrently_
--                 (\(s, e) -> withResource pool $ \_ -> do
--                     res <- httpLbs (req { requestHeaders = ("Range", BS.pack $ formatToString ("bytes=" % int % "-" % int) s e) : requestHeaders req }) manager
--                     print $ responseStatus res
--                     -- print $ responseBody res
--                 )
--                 (segmented len tenMegabytes)
--   where
--     opts         = info urlParser fullDesc
--     tenMegabytes = 10485760

-- eigenvector :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a)) => r (r a) -> r a
-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue :: (Fractional a, Foldable t, Additive t, Conjugate a) => t (t a) -> t a -> a
-- eigenvalue m x = (let V1 (V1 p) = (helper x!*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q)
--     where
--         helper :: (Functor t, Conjugate a) => t a -> V1 (t a)
--         helper = adjoint . fmap V1

-- eigenvalues :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a), Finite r, KnownNat (Size r), Traversable r, Num (r (r a)), Applicative r, Eq a, Distributive r, Conjugate a, R1 r) => r (r a) -> [a]
-- eigenvalues m = go [e0] (m - e0 *!! identity)
--     where
--         c0 = eigenvector m
--         e0 = eigenvalue m c0
--         go acc ma | luDetFinite (m - ev *!! identity) /= 0 = acc
--                   | otherwise = go (ev : acc) (ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec))
--                   where ec = eigenvector ma
--                         ev = eigenvalue ma ec
--                         ec' = (<$ unit _x) <$> ec

-- >>> eigenvalues (V2 (V2 1 2) (V2 3 4))
-- []

data Break = Break
    deriving Show

instance Exception Break

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine where parse s = let Just (n, _) = C.readInt s in n

readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
  where
    parse = unfoldr go
    go s = do
        (n, s1) <- C.readInt s
        let s2 = C.dropWhile (== ' ') s1
        return (fromIntegral n, s2)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, m] <- readChar8'
        xs     <- readChar8'
        print $ fst $ foldl'
            (\(acc, (mx, mi)) x ->
                let mx' = max mx x
                    mi' = min mi x
                in  if mx' - mi' > 2 * m then (acc + 1, (x, x)) else (acc, (mx', mi'))
            )
            (0, (head xs, head xs))
            xs

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
import qualified Data.ByteString.Char8 as B
import Data.Maybe ( fromJust )

main :: IO ()
main = B.interact $ B.unlines . g . tail . B.lines
        where
            aux1 ss = fst . fromJust . B.readInt . last . B.words $ ss
            aux2 ss = map (fst . fromJust . B.readInt) . B.words $ ss
            g (x:y:sss) = f' (aux2 y) (aux1 x): g sss
            g [] = []

f' :: (Ord c, Num c) => [c] -> c -> B.ByteString
f' (s:ss) d =  B.pack . show . (\(x, _, _) -> x) . foldl ff (0, s, s) $ ss
                where
                    twiceD = 2*d
                    ff (accum, smin, smax) x
                        | x > smax = if x - smin > twiceD then
                                        (accum+1, x, x)
                                     else
                                        (accum, smin, x)
                        | x < smin = if smax - x > twiceD then
                                        (accum+1, x, x)
                                     else
                                        (accum, x, smax)
                        | otherwise = (accum, smin, smax)


{-# LANGUAGE BlockArguments #-}

import Control.Monad
import Data.List

solve xs = show' if ones <= len `div` 2 then (len - ones, 0) else (ones - if even ones then 0 else 1, 1)
  where
    len = length xs
    ones = sum xs
    show' (l, x) = show l ++ "\n" ++ intercalate " " (replicate l $ show x)

main = mkMain solve

mkMain f = do
  n <- readLn
  replicateM_ n do
    void $ getLine
    a <- map read . words <$> getLine
    putStrLn $ f a

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInt
	as <- readInts
	let
		k = n `div` 2
		ones = length $ filter ( == 1 ) as
	if  | as == [ 1, 1 ] -> do
			print n
			printList as
		| ones <= n `div` 2 -> do
			print k
			printList $ replicate k 0
		| otherwise -> do
			let
				k' = if odd ones then ones - 1 else ones
			print $ k'
			printList $ replicate k' 1

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInt
	as <- readInts
	let
		k = n `div` 2
		ones = length ( filter odd as )
	if n == 2 && as == [ 1, 1 ]
		then do
			print n
			printList as
		else do
			print $ k
			printList $ replicate k ( which 0 1 $ ones <= k )

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInt
	as <- readInts
	let
		k = n `div` 2
		ones = length $ filter ( == 1 ) as
	if  | as == [ 1, 1 ] -> do
			print n
			printList as
		|  ones <= n `div` 2  ->  do
			print k
			printList $ replicate k 0
		| otherwise -> do
			let
				k' = if odd k then k - 1 else k
			print $ k'
			printList $ replicate k' 1

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInt
	as <- readInts
	let
		k = n `div` 2
		ones = length ( filter odd as )
	print $ k
	printList $ replicate k ( which 0 1 $ ones <= k )


import Data.List

main = getLine >>= test . read

test 0 = return ()
test i = do
    getLine
    as <- map read . words <$> getLine
    print $ solve (head as) as
    test (i - 1)

solve _ [] = 0
solve a (d:ds) = max (binaryLength (a - d)) (solve (max a d) ds)

binaryLength x = until ((> x) . (2 ^)) (+ 1) 0

import Control.Monad

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ getLine >> getLine >>= print . solve . map read . words

bitcnt :: Int -> Int
bitcnt 0 = 0
bitcnt n = succ . bitcnt $ n `div` 2

solve :: [Int] -> Int
solve a = maximum . map bitcnt $ zipWith (-) (scanl1 max a) a

import Control.Monad
import Data.Bits

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ getLine >> getLine >>= print . solve . map read . words

bitcnt :: Int -> Int
bitcnt x = finiteBitSize x - countLeadingZeros x

solve :: [Int] -> Int
solve a = maximum . map bitcnt $ zipWith (-) (scanl1 max a) a

import Control.Monad
import Data.Bits
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    _ <- getLine
    xs <- (map read.words) <$> getLine
    print $ solve xs

solve :: [Int] -> Int
solve xs =maximum $ map (\x -> if x<=0 then 0 else 1 + logBase2 x) $ f (head xs) xs

f :: Int -> [Int] -> [Int]
f prev (x:xs) = (prev-x) : f (max prev x) xs
f prev [] = []

logBase2 :: Int -> Int
logBase2 x = finiteBitSize x - 1 - countLeadingZeros x

{-# LANGUAGE ScopedTypeVariables #-}

everySecond []           = []
everySecond (a : b : xs) = b : everySecond xs

-- https://stackoverflow.com/a/14359943/61394
log2 n = length (takeWhile (< n) (iterate (* 2) 1))

f xs =
  let runningMax = scanl1 max xs
      maxDiff    = maximum $ zipWith (-) runningMax xs
  in  if maxDiff <= 0 then 0 else log2 (maxDiff + 1)

main =
  interact
    $ unlines
    . map (show . f . map read . words)
    . everySecond
    . tail
    . lines

{-# LANGUAGE ScopedTypeVariables #-}

everySecond []           = []
everySecond (a : b : xs) = b : everySecond xs

-- https://stackoverflow.com/a/14359943/61394
log2 n = length (takeWhile (< n) (iterate (* 2) 1))

f xs =
  let runningMax = scanl1 max xs
      maxDiff    = maximum $ zipWith (-) runningMax xs
  in  if maxDiff <= 0 then 0 else 1 + log2 maxDiff

main =
  interact
    $ unlines
    . map (show . f . map read . words)
    . everySecond
    . tail
    . lines

import Data.List

main = getLine >>= test . read

test 0 = return ()
test i = do
    getLine
    as <- map read . words <$> getLine
    let ds = zipWith (-) as (tail as)
    print $ solve 0 $ sort $ filter (> 0) ds
    test (i - 1)

solve x [] = x
solve x (d:ds)
    | 2 ^ x < d = solve (x + 1) ((d - 2 ^ x):ds)
    | otherwise = solve (x + 1) ds

import Data.List

main = getLine >>= test . read

test 0 = return ()
test i = do
    getLine
    as <- map read . words <$> getLine
    print $ solve 0 as
    test (i - 1)

solve _ [] = 0
solve a (d:ds) = max (binaryLength (a - d)) (solve (max a d) ds)

binaryLength x
    | x <= 0 = 0
    | otherwise = until ((> x) . (2 ^)) (+ 1) 0

import Control.Monad

main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    _ <- getLine
    xs <- (map read.words) <$> getLine
    print $ solve xs

solve :: [Int] -> Int
solve [_] = 0
solve [x,y] = f2 (x-y)
solve xs = f3. map f2 . f1 $ xs

f1 :: [Int] -> [Int]
f1 xs = zipWith (-) xs (tail xs)

f2 :: Int -> Int
f2 x = floor $ if x<=0 then 0 else 1+ logBase 2 (fromIntegral x)

f3 :: [Int] -> Int
f3 xs =maximum $ zipWith (\x y -> if x==y && x>0 then x+1 else max x y) xs (tail xs)

import Control.Monad
import Data.Bits
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    _ <- getLine
    xs <- (map read.words) <$> getLine
    print $ solve xs

solve :: [Int] -> Int
solve xs =maximum $ map (\x -> if x<=0 then 0 else 1 + logBase2 x) $ f 0 xs

f :: Int -> [Int] -> [Int]
f prev (x:xs) = (prev-x) : f (max prev x) xs
f prev [] = []

logBase2 :: Int -> Int
logBase2 x = finiteBitSize x - 1 - countLeadingZeros x


{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    pts <- replicateM n ((,) <$> readInt <*> readInt)
    return (n, pts)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    pts2 = map head . group . sort $ solveInterval (sort pts)

solveInterval [] = []
solveInterval xs = solveInterval lo ++ solveInterval (tail hi) ++ [ (x, y) | (_, y) <- xs]
  where
    len = length xs
    (lo, hi) = splitAt (len `div` 2) xs

    x = fst $ head hi

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

module Main where

import Control.Monad
import Data.List
import Data.Ord

main = do
    n <- read `liftM` getLine
    points <- sortBy (comparing fst) `liftM` replicateM n ( do
        [x, y] <- ( map read . words ) `liftM` getLine :: IO [Int]
        return (x, y) )

    let resPoints = fst $ fill points
    putStrLn $ show $ length resPoints
    putStr $ unlines $ map (\(x, y) -> show x ++ " " ++ show y) resPoints

fill :: [(Int, Int)] -> ([(Int, Int)], [Int])
fill pts =
    let n = length pts
        x0 = fst $ pts !! ( n `div` 2 )
        (left, middle, right) = foldr (\p@(x, _) (left, middle, right) ->
                case compare x x0 of
                    LT -> (p:left, middle, right)
                    EQ -> (left, p:middle, right)
                    GT -> (left, middle, p:right)
            ) ([], [], []) pts
        middleY = sort $ map snd middle

        (left', leftY) = fill left
        (right', rightY) = fill right

        y = merge3 leftY middleY rightY

        middle' = map (\y -> (x0, y)) y

    in if n == 0 then ([], []) else (left' ++ middle' ++ right', y)

merge3 :: (Bounded a, Ord a) => [a] -> [a] -> [a] -> [a]
merge3 as bs cs =
    let a = if null as then maxBound else head as
        b = if null bs then maxBound else head bs
        c = if null cs then maxBound else head cs
        ta = tail as
        tb = tail bs
        tc = tail cs
    in case compare a b of
        LT -> case compare a c of
            LT -> a : merge3 ta bs cs
            EQ -> a : merge3 ta bs tc
            GT -> c : merge3 as bs tc
        EQ -> case compare a c of
            LT -> a : merge3 ta tb cs
            EQ -> if a == maxBound then [] else a : merge3 ta tb tc
            GT -> c : merge3 as bs tc
        GT -> case compare b c of
            LT -> b : merge3 as tb cs
            EQ -> b : merge3 as tb tc
            GT -> c : merge3 as bs tc

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    pts <- replicateM n ((,) <$> readInt <*> readInt)
    return (n, pts)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    pts2 = map head . group . sort $ solveInterval (sort pts)

solveInterval [] = []
solveInterval [a] = [a]
solveInterval xs = solveInterval lo ++ solveInterval (tail hi) ++ [ (x, y) | (_, y) <- xs]
  where
    len = length xs
    (lo, hi) = splitAt (len `div` 2) xs

    x = snd $ head hi

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    pts <- replicateM n ((,) <$> readInt <*> readInt)
    return (n, pts)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    pts2 = map head . group . sort $ solveInterval (sort pts)

solveInterval [] = []
solveInterval [a] = [a]
solveInterval xs = solveInterval lo ++ solveInterval hi ++ [ (x, y) | (_, y) <- xs]
  where
    len = length xs
    (lo, hi) = splitAt (len `div` 2) xs

    x = snd $ head hi

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    pts <- replicateM n ((,) <$> readInt <*> readInt)
    return (n, pts)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    pts2 = map head . group . sort $ solveInterval (sort pts)

solveInterval [] = []
solveInterval [a] = [a]
solveInterval xs = solveInterval lo ++ solveInterval hi ++ [ (x, y) | (x, _) <- xs]
  where
    len = length xs
    (lo, hi) = splitAt (len `div` 2) xs

    y = snd $ head hi

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    pts <- replicateM n ((,) <$> readInt <*> readInt)
    return (n, pts)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

solve (n, pts) = BS.pack ((show $ length pts2) ++ "\n") `BS.append` BS.unlines [ BS.pack (show x ++ " " ++ show y) | (x, y) <- pts2]
  where
    ptsGrouped = groupBy ((==) `on` fst) $ sort pts
    ptsMerged = concat $ zipWith mergeLine ptsGrouped (tail ptsGrouped) :: [(Int,Int)]

    xs = map head . group . sort $ map fst pts
    ys = map head . group . sort $ map snd pts

    borderX = [ (x, y) | x <- xs, y <- [minimum ys, maximum ys]]
    borderY = [ (x, y) | y <- ys, x <- [minimum xs, maximum xs]]

    pts2 = map head . group . sort $ ptsMerged ++ borderX ++ borderY :: [(Int,Int)]

mergeLine :: [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)]
mergeLine [] x = x
mergeLine x [] = x
mergeLine x y = [(xVal, val) | val <- lst, inRange rangeX val] ++ [(yVal, val) | val <- lst, inRange rangeY val]
  where
    xVal = fst $ head x
    yVal = fst $ head y
    lst = IntSet.toList . IntSet.fromList $ map snd x ++ map snd y

    rangeX = (minimum $ map snd x, maximum $ map snd x)
    rangeY = (minimum $ map snd y, maximum $ map snd y)

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State


{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

f o n
  | o < 0 = print $ -1
  | otherwise = print $ min o n

inspect 0 = putStr ""
inspect linenum = do
  line <- getLine
  let
    k:n:a:b:_ = map read $ words line
    m = a * n
    d = a - b
    e = m - k
    q = (div e d) + 1
    o = n - q
  f o n
  inspect $ linenum - 1

main = do
  line <- getLine
  inspect $ read line

readInt :: String -> Integer
readInt = read

main = interact $ solve . (map ((map readInt) . words)) . tail . lines

solve :: [[Integer]] -> String
solve [] = ""
solve (l:ls) = solveInstance l ++ solve ls

solveInstance :: [Integer] -> String
solveInstance [k, n, a, b]
    | n*b >= k = "-1\n"
    | otherwise = let t = (k - n*b - 1) `div` (a - b) in (++"\n") $ show (min n t)

readInt :: String -> Int
readInt = read

main = interact $ solve . (map ((map readInt) . words)) . tail . lines

solve :: [[Int]] -> String
solve [] = ""
solve (l:ls) = solveInstance l ++ solve ls

solveInstance :: [Int] -> String
solveInstance [k, n, a, b]
    | n*b >= k = "-1\n"
    | otherwise = let t = (k - n*b - 1) `div` (a - b) in (++"\n") $ show (min n t)


import Control.Monad
import Data.List
import Data.Ord (comparing)

main = do
    n <- fmap read getLine
    strings <- replicateM n getLine
    let sort_strings = lsort strings
    let len = length sort_strings
    if (check sort_strings len || (len == 1))
    then do
         putStrLn "YES"
         mapM_ putStrLn sort_strings
    else do
         putStr "NO"
         --mapM_ putStrLn sort_strings

lsort :: [String] -> [String]
lsort = sortBy (comparing length)

check :: [String] -> Int -> Bool
check _ 1 = True
check (x:y:xs) l = if isInfixOf x y
                   then check (y:xs) (l-1)
                   else False

module Main where

import Data.List
import Control.Monad

main :: IO ()
main = do
  n <- fmap read getLine
  strings <- sequence $ take n $ repeat getLine
  let sortedByLength = sortBy (\str str' -> compare (length str) (length str')) strings
      grouped = group sortedByLength
      groupedByLength = groupBy (\str str' -> length str == length str') sortedByLength
  if length grouped /= length groupedByLength then do
    putStrLn "NO"
  else do
    let (_,satisfy) = foldl (\(preceeding,flag) current ->
                                 let newFlag = all id $ map (flip isInfixOf current) preceeding
                                 in (current:preceeding,flag && newFlag)) ([],True) $ map head grouped
    if satisfy then do
      putStrLn "YES"
      forM_ (concat grouped) (\str -> putStrLn str)
    else
      putStrLn "NO"

import Control.Monad
import qualified Data.Map as M
import Data.Map(Map)
import Data.List
import Data.Ord (comparing)

sort_str :: [String] -> [String]
sort_str = sortBy (comparing length)

rec :: [String] -> Int -> Bool
rec _ 1 = True
rec (x : y : xs) l = if isInfixOf x y
                     then rec (y : xs) (l - 1)
                     else False

main = do
    n <- fmap read getLine
    a <- replicateM n getLine
    let arr = sort_str a
    let len = length arr
    if (rec arr len || (len == 1))
    then do
         putStrLn "YES"
         mapM_ putStrLn arr
    else do
         putStr "NO"

module Main where

import           Control.Monad (replicateM)
import           Data.List     (isInfixOf, sort)

newtype MyString = MyString String
    deriving (Eq)

instance Show MyString where
    show (MyString a) = a

instance Ord MyString where
    (<=) (MyString a) (MyString b) = length a <= length b && isInfixOf a b

checkInvariant :: [MyString] -> Bool
checkInvariant l@(x : xs) = all (\(MyString a, MyString b) -> isInfixOf a b) (zip l xs)
checkInvariant _          = True

main :: IO ()
main = do
    nStr <- getLine
    let n = read nStr :: Int
    s <- replicateM n getLine
    let answer = sort (map MyString s)
    if checkInvariant answer
    then do
        putStrLn "YES"
        mapM_ print answer
    else putStrLn "NO"

import Control.Monad
import Data.List
import Data.Ord
import Data.String

subpair t = isInfixOf (fst t) (snd t)

main = do
  fline <- getLine
  let n = read fline::Int
  strs <- replicateM n getLine
  let sstrs = sortBy (comparing length) strs
  let pstrs = zip (take (n-1) sstrs) (tail sstrs)
  let judge = foldl (&&) True $ map subpair pstrs
  if judge
    then do putStrLn "YES";
	        mapM_ putStrLn sstrs
    else do putStrLn "NO"

module Main where

import           Control.Monad (replicateM)
import           Data.List     (isInfixOf, sort)

newtype MyString = MyString String
    deriving (Eq)

instance Show MyString where
    show (MyString a) = a

instance Ord MyString where
    (<=) (MyString a) (MyString b) = isInfixOf a b

checkInvariant :: [MyString] -> Bool
checkInvariant l@(x : xs) = all (\(MyString a, MyString b) -> a <= b) (zip l xs)
checkInvariant _          = True

main :: IO ()
main = do
    nStr <- getLine
    let n = read nStr :: Int
    s <- replicateM n getLine
    let answer = sort (map MyString s)
    if checkInvariant answer
    then do
        putStrLn "YES"
        mapM_ print answer
    else putStrLn "NO"


import Data.List

isPali s = s == reverse s

hasPali3 s = any isPali (take 2 $ drop 2 $ inits s)

increment :: Char -> String -> Maybe String
increment p [] = Nothing
increment p (c : cs)
  | c == p = do
    withA <- fmap ('a' :) $ increment p cs
    if hasPali3 withA
      then increment p withA
      else return withA
  | otherwise =
    let tmp = succ c : cs in
    if hasPali3 tmp
       then increment p tmp
       else return tmp

s [ns,ps,s] = case increment (iterate succ 'a' !! (read ps - 1)) (reverse s) of
  Nothing -> "NO"
  Just s' -> reverse s'

main = interact $ s . words

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

prefix :: [Int] -> Int -> [Int]
prefix (h : t@(th : tth : _)) p | h + 1 /= th && h + 1 /= tth && h + 1 < p = (h + 1) : t
                                | h + 2 /= th && h + 2 /= tth && h + 2 < p = (h + 2) : t
                                | h + 3 /= th && h + 3 /= tth && h + 3 < p = (h + 3) : t
                                | otherwise = prefix t p
prefix [h, t] p | h + 1 /= t && h + 1 < p = [h + 1, t]
                | h + 2 /= t && h + 2 < p = [h + 2, t]
                | otherwise = prefix [t] p
prefix [h] p | h + 1 < p = [h + 1]
             | otherwise = []
prefix _ _ = undefined

append :: [Int] -> Int -> [Int]
append s n | length s == n = s
           | otherwise = append (case s of
                           [] -> [0]
                           [h] -> if h /= 0 then [0, h] else [1, h]
                           h : ht : _ -> if h == 0 || ht == 0 then if h == 1 || ht == 1 then 2 : s else 1 : s else 0 : s) n

solve :: [Int] -> Int -> Maybe [Int]
solve s p =
  if p == 1
    then Nothing
    else if (p == 2)
           then if s == [0] then Just [1] else if s == [1, 0] then Just [0, 1] else Nothing
           else let prefix' = prefix s p
                in if null prefix'
                     then Nothing
                     else Just $ append prefix' $ length s

main :: IO ()
main =
  do [_, p] <- liftM (map read . words) getLine
     s <- liftM (reverse . map (\c -> ord c - ord 'a')) getLine
     case solve s p of
       Just solution -> putStrLn $ map (\i -> chr (i + ord 'a')) $ reverse solution
       Nothing -> putStrLn "NO"

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

prefix :: [Int] -> Int -> [Int]
prefix (h : t@(th : tth : _)) p | h + 1 /= th && h + 1 /= tth && h + 1 < p = (h + 1) : t
                                | h + 2 /= th && h + 2 /= tth && h + 2 < p = (h + 2) : t
                                | h + 3 /= th && h + 3 /= tth && h + 3 < p = (h + 3) : t
                                | otherwise = prefix t p
prefix [h, t] p | h + 1 /= t && h + 1 < p = [h + 1, t]
                | h + 2 /= t && h + 2 < p = [h + 2, t]
                | otherwise = prefix [t] p
prefix [h] p | h + 1 < p = [h + 1]
             | otherwise = []
prefix _ _ = undefined

append :: [Int] -> Int -> [Int]
append s n | length s == n = s
           | otherwise = append (case s of
                           [] -> [0]
                           [h] -> if h /= 0 then [0, h] else [1, h]
                           h : ht : _ -> if h == 0 || ht == 0 then if h == 1 || ht == 1 then 2 : s else 1 : s else 0 : s) n

solve :: [Int] -> Int -> Maybe [Int]
solve s p =
  let prefix' = prefix s p
  in if null prefix'
       then Nothing
       else Just $ append prefix' $ length s

main :: IO ()
main =
  do [_, p] <- liftM (map read . words) getLine
     s <- liftM (reverse . map (\c -> ord c - ord 'a')) getLine
     case solve s p of
       Just solution -> putStrLn $ map (\i -> chr (i + ord 'a')) $ reverse solution
       Nothing -> putStrLn "NO"

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

prefix :: [Int] -> Int -> [Int]
prefix (h : t@(th : tth : _)) p | h + 1 /= th && h + 1 /= tth && h + 1 < p = (h + 1) : t
                                | h + 2 /= th && h + 2 /= tth && h + 2 < p = (h + 2) : t
                                | h + 3 /= th && h + 3 /= tth && h + 3 < p = (h + 3) : t
                                | otherwise = prefix t p
prefix (h : t : []) p | h + 1 /= t && h + 1 < p = [h + 1, t]
                      | h + 2 /= t && h + 2 < p = [h + 1, t]
                      | t + 1 < p = [t + 1]
                      | otherwise = []
prefix _ _ = undefined

append :: [Int] -> Int -> [Int]
append s n | length s == n = s
           | otherwise = append (case s of
                           [] -> [0]
                           [h] -> if h /= 0 then [0, h] else [1, h]
                           h : ht : _ -> if h == 0 || ht == 0 then if h == 1 || ht == 1 then 2 : s else 1 : s else 0 : s) n

solve :: [Int] -> Int -> Maybe [Int]
solve s p =
  if p < 3
    then Nothing
    else let prefix' = prefix s p
         in if null prefix'
              then Nothing
              else Just $ append prefix' $ length s

main :: IO ()
main =
  do [_, p] <- liftM (map read . words) getLine
     s <- liftM (reverse . map (\c -> ord c - ord 'a')) getLine
     case solve s p of
       Just solution -> putStrLn $ map (\i -> chr (i + ord 'a')) $ reverse solution
       Nothing -> putStrLn "NO"

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

prefix :: [Int] -> Int -> [Int]
prefix (h : t@(th : tth : _)) p | h + 1 /= th && h + 1 /= tth && h + 1 < p = (h + 1) : t
                                | h + 2 /= th && h + 2 /= tth && h + 2 < p = (h + 2) : t
                                | h + 3 /= th && h + 3 /= tth && h + 3 < p = (h + 3) : t
                                | otherwise = prefix t p
prefix (h : t : []) p | h + 1 /= t && h + 1 < p = [h + 1, t]
                      | h + 2 /= t && h + 2 < p = [h + 1, t]
                      | t + 1 < p = [t + 1]
                      | otherwise = []
prefix _ _ = undefined

append :: [Int] -> Int -> [Int]
append s n | length s == n = s
           | otherwise = append (case s of
                           [] -> [0]
                           [h] -> if h /= 0 then [0, h] else [1, h]
                           h : ht : _ -> if h == 0 || ht == 0 then if h == 1 || ht == 1 then 2 : s else 1 : s else 0 : s) n

solve :: [Int] -> Int -> Maybe [Int]
solve s p =
  if p == 1
    then Nothing
    else if (p == 2)
           then if s == [1, 0] then Just [0, 1] else Nothing
           else let prefix' = prefix s p
                in if null prefix'
                     then Nothing
                     else Just $ append prefix' $ length s

main :: IO ()
main =
  do [_, p] <- liftM (map read . words) getLine
     s <- liftM (reverse . map (\c -> ord c - ord 'a')) getLine
     case solve s p of
       Just solution -> putStrLn $ map (\i -> chr (i + ord 'a')) $ reverse solution
       Nothing -> putStrLn "NO"

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

prefix :: [Int] -> Int -> [Int]
prefix (h : t@(th : tth : _)) p | h + 1 /= th && h + 1 /= tth && h + 1 < p = (h + 1) : t
                                | h + 2 /= th && h + 2 /= tth && h + 2 < p = (h + 2) : t
                                | h + 3 /= th && h + 3 /= tth && h + 3 < p = (h + 3) : t
                                | otherwise = prefix t p
prefix [h, t] p | h + 1 /= t && h + 1 < p = [h + 1, t]
                | h + 2 /= t && h + 2 < p = [h + 1, t]
                | otherwise = prefix [t] p
prefix [h] p | h + 1 < p = [h + 1]
             | otherwise = []
prefix _ _ = undefined

append :: [Int] -> Int -> [Int]
append s n | length s == n = s
           | otherwise = append (case s of
                           [] -> [0]
                           [h] -> if h /= 0 then [0, h] else [1, h]
                           h : ht : _ -> if h == 0 || ht == 0 then if h == 1 || ht == 1 then 2 : s else 1 : s else 0 : s) n

solve :: [Int] -> Int -> Maybe [Int]
solve s p =
  if p == 1
    then Nothing
    else if (p == 2)
           then if s == [0] then Just [1] else if s == [1, 0] then Just [0, 1] else Nothing
           else let prefix' = prefix s p
                in if null prefix'
                     then Nothing
                     else Just $ append prefix' $ length s

main :: IO ()
main =
  do [_, p] <- liftM (map read . words) getLine
     s <- liftM (reverse . map (\c -> ord c - ord 'a')) getLine
     case solve s p of
       Just solution -> putStrLn $ map (\i -> chr (i + ord 'a')) $ reverse solution
       Nothing -> putStrLn "NO"


main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO[Int]
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let (_,l) = unzip . filter (\(x,y) -> x==0) $ zip a [1..]
        solve ls = zipWith (\x y -> y-x-1) ls (drop (m+1) ls)
        (mx,idx) = getIndex 0 0 (zip (dropWhile (==0) (solve (0:(l++[n+1])))) l)
    --print ((dropWhile (==0) (solve (0:(l++[n+1])))) , l)
    if m>=n
        then do
            print n
            putStr . unwords . map show . take n $ repeat 1
        else if l==[]
            then do
                print n
                putStr . unwords . map show $ a
        else do
            print mx
            putStr . unwords . map show $ paint a 1 idx m

getIndex mx idx [] = (mx,idx)
getIndex mx idx ((a,b):xs)
 |a>mx = getIndex a b xs
 |otherwise = getIndex mx idx xs

paint l _ _ 0 = l
paint [] _ _ _ = []
paint (x:xs) i idx c
 |i>=idx = if x==0 then 1:paint xs (i+1) idx (c-1) else 1:paint xs (i+1) idx c
 |otherwise = x:paint xs (i+1) idx c

import Control.Applicative ((<$>))
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Data.List (maximumBy)
import Data.Ord (comparing)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n, k] <- readInts
  as <- readInts

  let
    cs = listArray (0, n) $ scanl (+) 0 as :: UArray Int Int

    rs = map find [1..n]
      where
        find i = (find' 1 i, i)
          where
            find' l r
              | l >= r = if v then l else i+1
              | v = find' l m
              | otherwise= find' (m+1) r
              where
                m = (l+r) `div` 2
                v = f m

            f j = cs!i - cs!(j-1) + k >= i-j+1

    (i, j) = maximumBy (comparing (\(i, j) -> j-i+1)) rs

  print $ j-i+1
  putStrLn $ unwords $ map show $ map (\(k, a) -> if i <= k && k <= j then 1 else a) $ zip [1..] as

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO[Int]
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let (_,l) = unzip . filter (\(x,y) -> x==0) $ zip a [1..]
        solve ls = zipWith (\x y -> y-x-1) ls (drop (m+1) ls)
        (mx,idx) = getIndex 0 0 (zip (dropWhile (==0) (solve (0:(l++[n+1])))) l)
    --print ((dropWhile (==0) (solve (0:(l++[n+1])))) , l)
    if m>=n
        then do
            print n
            putStr . unwords . map show . take n $ repeat 1
        else if l==[]
            then mapM_ print (solve (0:(l++[n+1])))
        else do
            print mx
            putStr . unwords . map show $ paint a 1 idx m

getIndex mx idx [] = (mx,idx)
getIndex mx idx ((a,b):xs)
 |a>mx = getIndex a b xs
 |otherwise = getIndex mx idx xs

paint l _ _ 0 = l
paint [] _ _ _ = []
paint (x:xs) i idx c
 |i>=idx = if x==0 then 1:paint xs (i+1) idx (c-1) else 1:paint xs (i+1) idx c
 |otherwise = x:paint xs (i+1) idx c

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO[Int]
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let (_,l) = unzip . filter (\(x,y) -> x==0) $ zip a [1..]
        solve ls = zipWith (\x y -> y-x-1) ls (drop (m+1) ls)
        (mx,idx) = getIndex 0 0 (zip (dropWhile (==0) (solve (0:(l++[n+1])))) l)
    --print ((dropWhile (==0) (solve (0:(l++[n+1])))) , l)
    if m>=n
        then do
            print n
            putStr . unwords . map show . take n $ repeat 1
        else if l==[]
            then do
                mapM_ print (solve (0:(l++[n+1])))
                putStr . unwords . map show $ a
        else do
            print mx
            putStr . unwords . map show $ paint a 1 idx m

getIndex mx idx [] = (mx,idx)
getIndex mx idx ((a,b):xs)
 |a>mx = getIndex a b xs
 |otherwise = getIndex mx idx xs

paint l _ _ 0 = l
paint [] _ _ _ = []
paint (x:xs) i idx c
 |i>=idx = if x==0 then 1:paint xs (i+1) idx (c-1) else 1:paint xs (i+1) idx c
 |otherwise = x:paint xs (i+1) idx c

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO[Int]
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let (_,l) = unzip . filter (\(x,y) -> x==0) $ zip a [1..]
        solve ls = zipWith (\x y -> y-x-1) ls (drop (m+1) ls)
        (mx,idx) = getIndex 0 0 (zip (solve (0:(l++[n+1]))) l)
    if l==[]
        then mapM_ print (solve (0:(l++[n+1])))
        else print mx
    putStr . unwords . map show $ paint a 1 idx m

getIndex mx idx [] = (mx,idx)
getIndex mx idx ((a,b):xs)
 |a>mx = getIndex a b xs
 |otherwise = getIndex mx idx xs

paint l _ _ 0 = l
paint [] _ _ _ = []
paint (x:xs) i idx c
 |i>=idx = if x==0 then 1:paint xs (i+1) idx (c-1) else 1:paint xs (i+1) idx c
 |otherwise = x:paint xs (i+1) idx c

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO[Int]
    a <- fmap ((map read) . words) getLine :: IO[Int]
    if m==0
        then do
            print n
            putStr . unwords . map show $ a
        else do
            let (_,l) = unzip . filter (\(x,y) -> x==0) $ zip a [1..]
                solve l = zipWith (\x y -> y-x-1) l (drop (m+1) l)
                (mx,idx) = getIndex 0 0 (zip (solve (0:(l++[n+1]))) l)
            print mx
            putStr . unwords . map show $ paint a 1 idx m

getIndex mx idx [] = (mx,idx)
getIndex mx idx ((a,b):xs)
 |a>mx = getIndex a b xs
 |otherwise = getIndex mx idx xs

paint l _ _ 0 = l
paint [] _ _ _ = []
paint (x:xs) i idx c
 |i>=idx = if x==0 then 1:paint xs (i+1) idx (c-1) else 1:paint xs (i+1) idx c
 |otherwise = x:paint xs (i+1) idx c

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO[Int]
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let (_,l) = unzip . filter (\(x,y) -> x==0) $ zip a [1..]
        solve ls = zipWith (\x y -> y-x-1) ls (drop (m+1) ls)
        (mx,idx) = getIndex 0 0 (zip (dropWhile (==0) (solve (0:(l++[n+1])))) l)
    if l==[]
        then mapM_ print (solve (0:(l++[n+1])))
        else print mx
    putStr . unwords . map show $ paint a 1 idx m

getIndex mx idx [] = (mx,idx)
getIndex mx idx ((a,b):xs)
 |a>mx = getIndex a b xs
 |otherwise = getIndex mx idx xs

paint l _ _ 0 = l
paint [] _ _ _ = []
paint (x:xs) i idx c
 |i>=idx = if x==0 then 1:paint xs (i+1) idx (c-1) else 1:paint xs (i+1) idx c
 |otherwise = x:paint xs (i+1) idx c

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO[Int]
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let (_,l) = unzip . filter (\(x,y) -> x==0) $ zip a [1..]
        solve l = zipWith (\x y -> y-x-1) l (drop (m+1) l)
        (mx,idx) = getIndex 0 0 (zip (solve (0:(l++[n+1]))) l)
    print mx
    putStr . unwords . map show $ paint a 1 idx m

getIndex mx idx [] = (mx,idx)
getIndex mx idx ((a,b):xs)
 |a>mx = getIndex a b xs
 |otherwise = getIndex mx idx xs

paint l _ _ 0 = l
paint [] _ _ _ = []
paint (x:xs) i idx c
 |i>=idx = if x==0 then 1:paint xs (i+1) idx (c-1) else 1:paint xs (i+1) idx c
 |otherwise = x:paint xs (i+1) idx c


import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

onecase = do
		getLine
		k<- reverse <$> sort <$> map read <$> words <$> getLine:: IO [Int]
		print $ length $ takeWhile (\(a,b)-> a>=b) $ zip k [1..]

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

import Data.List
main=interact$unlines.l.lines
l=g.tail where g(n:a:x)=show(s(read n)(map read$words a)):g x;g a=a
s n=maximum.zipWith min[n,n-1..1].sort

import Data.List
main=interact$unlines.l.lines
l=go.tail where go[]=[];go(n:a:x)=show(s(read n)(map read$words a)):go x
s n=maximum.zipWith min[n,n-1..1].sort

import           Data.List
import           Numeric

int :: (Eq a, Num a) => String -> a
int x = fst $ readDec x !! 0

ints :: (Eq a, Num a) => String -> [a]
ints = map int . words

main = interact $ unlines . solverLoop . lines

solverLoop (_:xs) = go xs
  where
    go []       = []
    go (n:a:xs) = show (solve (int n) (ints a)) : go xs

solve n xs = maximum $ zipWith min [n,n-1..1] $ sort xs

import Control.Monad
import Data.List

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        getLine
        a <- getList
        print $ f a

f :: [Int] -> Int
f a = maximum $ map (\p -> (min (fst p) (snd p))) $ zip [1..] $ reverse . sort $ a

import Control.Monad
import Data.List

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        _ <- getLine
        a <- getList
        print $ f a

f :: [Int] -> Int
f a = maximum $ map (\p -> min (fst p) $ snd p) $ zip [1..] $ reverse . sort $ a

import Data.List (sortBy)

process :: [Int] -> Int
process = maximum . zipWith min [1..] . sortBy (flip compare)

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    n <- fmap readInt getLine
    a <- fmap (map readInt.words) getLine
    print $ process a
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

import Data.List as L

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n strings = (L.take n strings):(groupByNLines n (L.drop n strings))

stringToIntegerArray :: String -> [Integer]
stringToIntegerArray = L.map (\x -> read x :: Integer) . words

main :: IO ()
main = interact (unlines . map parse . groupByNLines 2 . tail . lines)

parse :: [String] -> String
parse [_, arr'] = show $ solve arr
  where arr = stringToIntegerArray arr'

solve' :: [Integer] -> Integer -> Integer
solve' arr idx
  | currentMin >= idx = solve' arr (idx+1)
  | otherwise = (idx-1)
  where currentMin = minimum $ take (fromIntegral idx) arr

solve :: [Integer] -> Integer
solve arr = solve' (reverse $ L.sort arr) 1


import Data.List

data Gem = Power | Time | Space | Soul | Reality | Mind deriving (Show, Read, Eq)

gemFromString :: String -> Gem
gemFromString "purple" = Power
gemFromString "green" = Time
gemFromString "blue" = Space
gemFromString "orange" = Soul
gemFromString "red" = Reality
gemFromString "yellow" = Mind

main = interact foo

foo :: String -> String
foo i =
    let gems = map gemFromString $ tail . lines $ i
        o = map show $ filter (\g -> not $ g`elem` gems) [Power, Time, Space, Soul, Reality, Mind]
    in unlines $ (show $ length o) : o

module Main where

import Data.List (find)

colors = [("red","Reality"), ("purple","Power"), ("yellow","Mind"), ("orange","Soul"), ("blue","Space"), ("green","Time")]

main :: IO ()
main = do
  x <- getLine
  lst <- readWords ((read :: String -> Int) x)
  print ((length colors) - (length lst))
  solveW lst

readWords :: Int -> IO [String]
readWords 0 = return []
readWords n = do
  lst <- readWords(n-1)
  name <- getLine
  return (name : lst)

solveW :: [String] -> IO ()
solveW lst = foldl (\a (b,name) -> case find (== b) lst of
                                      Just _  ->  a
                                      Nothing -> do putStrLn name
                                                    a
                  ) (return ())  colors

module Main where

import Data.Maybe (fromJust)
import Control.Applicative
import Control.Monad (guard, liftM2, replicateM, (>=>), forM_)
import Data.Char (digitToInt, isDigit, isSpace)
import Data.Functor ((<$>))

newtype Parser a = Parser
  { runParser :: String -> Maybe (a, String)
  }

instance Functor Parser where
    fmap f x = pure f <*> x

instance Applicative Parser where
  pure = return
  (<*>) = liftM2 ($)

instance Monad Parser where
  return x = Parser $ \s -> Just (x, s)
  ma >>= f = Parser $ runParser ma >=> (\(x, rest) -> runParser (f x) rest)

instance Alternative Parser where
  empty = Parser $ const Nothing
  (Parser p) <|> (Parser q) = Parser $ \s -> p s <|> q s

ok :: Parser ()
ok = return ()

eof :: Parser ()
eof = Parser $ \s -> guard (null s) >> Just ((), s)

satisfy :: (Char -> Bool) -> Parser Char
satisfy p =
  Parser $ \x ->
                  case x of
                    (c:cs) -> guard (p c) >> Just (c, cs)
                    _ -> Nothing

isNot :: Parser a -> Parser ()
isNot (Parser p) =
  Parser $ \s ->
    case p s of
      Just _  -> Nothing
      Nothing -> Just ((), s)

readP :: Read a => Parser a
readP = read <$> some (satisfy $ not . isSpace)

skipSpace :: Parser ()
skipSpace = () <$ many (satisfy isSpace)

parse :: Read a => String -> Maybe a
parse = fmap fst . runParser readP

stones = [("purple", "Power"), ("green", "Time"), ("blue", "Space")
                , ("orange", "Soul"), ("red", "Reality"), ("yellow", "Mind")]

main :: IO ()
main = do
    l <- getLine
    let n = fromJust $ parse l
    present <- replicateM n getLine
    let ans = filter (\p -> not $ elem (fst p) present) stones
    print $ length ans
    forM_ ans $ putStrLn . snd

g::String->String
g "purple"="Power"
g "green"="Time"
g "blue"="Space"
g "orange"="Soul"
g "red"="Reality"
g "yellow"="Mind"

f::[String]->[String]->[String]
f [] _=[]
f (y:ys) xs
   |(y `elem` xs)==True=f ys xs
   |otherwise=(g y):(f ys xs)

main = do
       e1<-getLine
       es<-getContents
       let x=read e1::Int
           xs=lines es
       putStr $ if x==6 then "0" else show(6-x)++"\n"++unlines (f ["purple","green","blue","orange","red","yellow"] xs)

import Data.List
import Data.Array

readColors :: Int -> IO [Int]
readColors 0 = return []
readColors n = do
    s <- getLine
    tail <- readColors $ n - 1
    return ((case s of
                "purple" -> 0
                "green" -> 1
                "blue" -> 2
                "orange" -> 3
                "red" -> 4
                "yellow" -> 5) : tail)

printAns :: [Int] -> IO ()
printAns [] = return ()
printAns (a : tail) = do
    putStrLn $ case a of
        0 -> "Power"
        1 -> "Time"
        2 -> "Space"
        3 -> "Soul"
        4 -> "Reality"
        5 -> "Mind"
    printAns tail
    return ()

main = do
    s <- getLine
    let n = read s :: Int
    arr <- readColors n
    let ans = filter (\x -> not $ elem x arr) [0..5]
    print $ length ans
    printAns ans

import Data.List
import Data.Maybe
m = [ ("purple","Power"),
      ("green","Time"),
      ("blue","Space"),
      ("orange","Soul"),
      ("red","Reality"),
      ("yellow","Mind") ]
main = do
  getLine
  cs <- lines <$> getContents
  let r = map snd m \\ catMaybes (map (flip lookup m) cs)
  print (length r)
  mapM_ putStrLn r

import Control.Monad
import Data.List
import qualified Data.Map.Strict as Map

import Data.Set (Set)
import qualified Data.Set as Set

main = do
    let c = ["purple", "green", "blue", "orange", "red", "yellow"]
    let h = Map.fromList [("purple", "Power"),
                          ("green", "Time"),
                          ("blue", "Space"),
                          ("orange", "Soul"),
                          ("red", "Reality"),
                          ("yellow", "Mind")]
    n <- fmap read getLine
    a <- replicateM n getLine
    let xs = c \\ a
    print $ length xs
    mapM_ putStrLn (map (\k -> Map.findWithDefault "def" k h) xs)

import Control.Monad

gems :: [(String, String)]
gems = [
    ("Power", "purple"),
    ("Time",  "green"),
    ("Space", "blue"),
    ("Soul", "orange"),
    ("Reality", "red"),
    ("Mind", "yellow")
    ]

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    present <- replicateM n getLine
    let result = map fst . filter (not . flip elem present . snd) $ gems
    print $ length result
    forM_ result putStrLn

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

mas= S.fromList ["purple", "green" , "blue","orange","red", "yellow"]
masmap = M.fromList $ zip ["purple", "green" , "blue","orange","red", "yellow"] ["Power","Time","Space","Soul","Reality","Mind"]

main= do
		a<- read <$> getLine ::IO Int
		s<- S.fromList <$> replicateM a getLine
		let s1 = S.difference mas s
		let s2 = catMaybes $ map (\z-> M.lookup z masmap) $ S.toList  s1
		print $ S.size s1
		mapM_ putStrLn s2

--ghc 7.10

assocs :: [(String, String)]
assocs = [("Power","purple"),("Time","green"),("Space","blue"),("Soul","orange"),("Reality","red"),("Mind","yellow")]

findAbsentGems :: [String] -> [String]
findAbsentGems colors = map fst . filter (\(_,c) -> not (c `elem` colors)) $ assocs

main = do
    nStr <- getLine
    contents <- getContents
    let colors = words contents
    let gems = findAbsentGems colors
    let m = length gems
    print m
    putStrLn . unlines $ gems

module Main where

import Data.List

stones :: [(String,String)]
stones = [
    ("green", "Time"),
    ("purple", "Power"),
    ("blue", "Space"),
    ("orange", "Soul"),
    ("red","Reality"),
    ("yellow","Mind")
    ]

main :: IO ()
main = do
  n <- fmap (read) getLine
  colors <- sequence $ Prelude.take n . repeat $ getLine
  let allColors = map fst stones
      remaining = Prelude.filter (\(color,_) -> not . isInfixOf [color] $ colors) stones
  print $ length remaining
  mapM_ (\(_,name) -> putStrLn name) remaining

import Control.Monad
import Data.List

stoneMap :: String -> String
stoneMap "red"    = "Reality"
stoneMap "purple" = "Power"
stoneMap "green"  = "Time"
stoneMap "blue"   = "Space"
stoneMap "orange" = "Soul"
stoneMap "yellow" = "Mind"

main :: IO ()
main = do
    inp <- getLine
    let n = read inp :: Int
    inpp <- replicateM n getLine
    print (6 - n)
    let stones = ["Power", "Space", "Soul", "Mind", "Time", "Reality"]
    let have = map stoneMap inpp
    mapM (putStrLn) (stones \\ have)
    return ()

module Main where

import Data.List (find)

colors = [("red","Reality"), ("purple","Power"), ("yellow","Mind"), ("orange","Soul"), ("blue","Space"), ("green","Time")]

main :: IO ()
main = do
  x <- getLine
  lst <- readWords ((read :: String -> Int) x)
  print $ solve lst

readWords :: Int -> IO [String]
readWords 0 = return []
readWords n = do
  lst <- readWords(n-1)
  name <- getLine
  return (name : lst)

solve :: [String] -> String
solve lst = (show ((length colors) - (length lst))) ++ solveW lst

solveW :: [String] -> String
solveW lst = foldl (\a (b,name) -> case find (== b) lst of
                                      Just _  ->  a
                                      Nothing -> a ++ "/n" ++ name) "" colors

module Main where

import Data.List (find)

colors = [("red","Reality"), ("purple","Power"), ("yellow","Mind"), ("orange","Soul"), ("blue","Space"), ("green","Time")]

main :: IO ()
main = do
  x <- getLine
  lst <- readWords ((read :: String -> Int) x)
  putStr $ solve lst

readWords :: Int -> IO [String]
readWords 0 = return []
readWords n = do
  lst <- readWords(n-1)
  name <- getLine
  return (name : lst)

solve :: [String] -> String
solve lst = (show ((length colors) - (length lst))) ++ solveW lst

solveW :: [String] -> String
solveW lst = foldl (\a (b,name) -> case find (== b) lst of
                                      Just _  ->  a
                                      Nothing -> a ++ "/n" ++ name) "" colors

module Main where

import Data.List

stones :: [(String,String)]
stones = [
    ("green", "Time"),
    ("purple", "Power"),
    ("blue", "Space"),
    ("orange", "Soul"),
    ("red","Reality"),
    ("yellow","Mind")
    ]

main :: IO ()
main = do
  n <- fmap (read) getLine
  colors <- sequence $ Prelude.take n . repeat $ getLine
  let allColors = map fst stones
      remaining = Prelude.filter (\(color,_) -> not . isInfixOf [color] $ colors) stones
  mapM_ (\(_,name) -> putStrLn name) remaining


import Control.Monad

solve1 [] _ = 10
solve1 ((x,i):xs) t
            | t > 5 - div (i-1) 2 = i-1
            | otherwise = solve1 xs (t+x)

solve2 [] _ = 10
solve2 ((x,i):xs) t
            | t > 5 - div i 2 = i-1
            | otherwise = solve2 xs (t+x)

zip1 (x,i)
        | x /= '0' && odd i = (1,i)
        | x == '1' && even i = (-1,i)
        | otherwise = (0,i)

zip2 (x,i)
        | x /= '0' && even i = (1,i)
        | x == '1' && odd i = (-1,i)
        | otherwise = (0,i)

printResult = do
    s <- getLine
    let z = zip s [1..]
        z1 = map zip1 z
        z2 = map zip2 z
    print $ min (solve1 z1 0) (solve2 z2 0)

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import Control.Monad

solve1 [] _ = 10
solve1 ((x,i):xs) t
            | t > 5 - div (2*(i-1)) 4 = i-1
            | otherwise = solve1 xs (t+x)

solve2 [] _ = 10
solve2 ((x,i):xs) t
            | t > 5 - div i 2 = i-1
            | otherwise = solve2 xs (t+x)

zip1 (x,i)
        | x /= '0' && odd i = (1,i)
        | x == '1' && even i = (-1,i)
        | otherwise = (0,i)

zip2 (x,i)
        | x /= '0' && even i = (1,i)
        | x == '1' && odd i = (-1,i)
        | otherwise = (0,i)

printResult = do
    s <- getLine
    let z = zip s [1..]
        z1 = map zip1 z
        z2 = map zip2 z
    print $ min (solve1 z1 0) (solve2 z2 0)

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

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

minKicks :: [Int] -> Int
minKicks = go (0, 0) 0 where
  remaining i = let d = 10 - i in (d `div` 2, d `div` 2 + d `rem` 2)
  gameEnds (t1, t2) i = let (remT1, remT2) = remaining i in
    t1 > t2 + remT2 || t2 > t1 + remT1
  go (t1, t2) _ [] = 10
  go (t1, t2) i (x : xs)
    | gameEnds (t1, t2) i = i
    | even i = go (t1 + x, t2) (i + 1) xs
    | otherwise = go (t1, t2 + x) (i + 1) xs

solve :: String -> Int
solve s = min (minKicks scoresT1) (minKicks scoresT2) where
  switch team i c
    | c == '?' = if i `rem` 2 == team then 1 else 0
    | otherwise = digitToInt c
  scoresT1 = zipWith (switch 0) [0..] s
  scoresT2 = zipWith (switch 1) [0..] s

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    scores <- getLine
    print $ solve scores

{-# LANGUAGE ParallelListComp #-}

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

main :: IO ()
main = interact $ words >>> drop 1 >>> map (solve >>> show) >>> unlines

solve :: String -> Int
solve s = min (compute '0' '1') (compute '1' '0')
  where
    compute atOdd atEven = cost . replaceAt odd atOdd . replaceAt even atEven $ s

replaceAt :: (Int -> Bool) -> Char -> String -> String
replaceAt p v xs = [if x == '?' && p i then v else x | x <- xs | i <- [0 ..]]

cost :: String -> Int
cost = rec (0, 5) (0, 5)
  where
    rec _ _ [] = 0
    rec (s0, r0) (s1, r1) (p : ps)
      | s0' + r0' < s1 = 1
      | s1 + r1 < s0' = 1
      | otherwise = 1 + rec (s1, r1) (s0', r0') ps
      where
        s0' = s0 + bool 0 1 (p == '1')
        r0' = r0 - 1

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

lmargins :: [Int]
lmargins = scanl' (+) (0-5) $ cycle [1, 0]
rmargins :: [Int]
rmargins = scanl' (-) 5 $ cycle [0, 1]

sim :: String -> [(Int, Int)]
sim = let
  go :: [Int] -> (Int, Int) -> String -> [(Int, Int)]
  go (_:xs) (p, q) ('0':cs) = (p, q) : go xs (p, q) cs
  go (x:xs) (p, q) ('1':cs) = (p, q) : go xs (p + x, q + x) cs
  go (x:xs) (p, q) ('?':cs) = (p, q) : go xs (p + min 0 x, q + max 0 x) cs
  go _ (p, q) [] = [(p, q)]
  go _ _ _ = error "invalid input"
  in  go (cycle [1, 0-1]) (0, 0)

result :: String -> Int
result str = let
  opts = 10 : do
    (i, (p,  q), lv, rv) <- zip4 [0..] (sim str) lmargins rmargins
    [i | p < lv || q > rv]
  in  minimum opts

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    s <- P.unpack <$> readLine
    putInts [result s]

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