Petya likes horse racing very much. Horses numbered from l to r take part in the races. Petya wants to evaluate the probability of victory; for some reason, to do that he needs to know the amount of nearly lucky horses' numbers. A nearly lucky number is an integer number that has at least two lucky digits the distance between which does not exceed k. Petya learned from some of his mates from Lviv that lucky digits are digits 4 and 7. The distance between the digits is the absolute difference between their positions in the number of a horse. For example, if k = 2, then numbers 412395497, 404, 4070400000070004007 are nearly lucky and numbers 4, 4123954997, 4007000040070004007 are not.Petya prepared t intervals [li, ri] and invented number k, common for all of them. Your task is to find how many nearly happy numbers there are in each of these segments. Since the answers can be quite large, output them modulo 1000000007 (109 + 7).

The first line contains two integers t and k (1 ≤ t, k ≤ 1000) — the number of segments and the distance between the numbers correspondingly. Next t lines contain pairs of integers li and ri (1 ≤ l ≤ r ≤ 101000). All numbers are given without the leading zeroes. Numbers in each line are separated by exactly one space character.

Output t lines. In each line print one integer — the answer for the corresponding segment modulo 1000000007 (109 + 7).

NoteIn the first sample, the four nearly lucky numbers are 44, 47, 74, 77.In the second sample, only 74 and 77 are in the given segment.

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

import Debug.Trace

parseInput = do
    t <- readInt
    k <- readInt
    querys <- replicateM t $ (,) <$> readInteger <*> readInteger
    return (k, querys)
  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 (k, querys) = BS.unlines [ BS.pack . show $ solveCase k countWays query | query <- querys]
  where
    countWays :: (Int,Int) -> ModP
    countWays = (cache!)
      where
        bnds = ((0,0),(1024,1024))
        cache = listArray bnds $ map go $ range bnds :: Array (Int,Int) ModP

        go (prev, 0) = ModP 1
        go (prev, left) = ans47 + ansOther
          where
            ans47 = if prev == 0 || prev > k then ModP 2 * countWays (1, left - 1) else ModP 0
            ansOther = ModP 8 * countWays (if prev == 0 then 0 else prev + 1, left - 1)

solveCase k countWays (lo, hi) = solveNumber k countWays (hi + 1) - solveNumber k countWays lo

-- calculate the answer for [0,n)
solveNumber k countWays n = fromInteger n - go str 0 (length str - 1)
  where
    str = show n

    go [] _ _ = ModP 0
    go (x:xs) prev left = sum lst + if x /= '4' && x /= '7' || prev > k || prev == 0 then  go xs (trans x prev) (left - 1) else 0
      where
        lst = [ countWays (trans i prev, left)
              | i <- ['0'..pred x]
              , i /= '4' && i /= '7' || prev > k || prev == 0
              ]

    trans '4' _ = 1
    trans '7' _ = 1
    trans _ 0   = 0
    trans _ prev = prev + 1

modulo :: Integral a => a
modulo = 1000000007

newtype ModP = ModP Integer deriving Eq

instance Show ModP where
    show (ModP n) = show n

instance Num ModP where
    ModP a + ModP b = ModP $ (a + b) `mod` modulo
    ModP a - ModP b = ModP $ (a - b) `mod` modulo
    ModP a * ModP b = ModP $ fromIntegral ((fromIntegral a * fromIntegral b :: Int64) `mod` modulo)
    abs = undefined
    signum = undefined
    fromInteger = ModP . fromInteger . (`mod` modulo)

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

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

import Debug.Trace

parseInput = do
    t <- readInt
    k <- readInt
    querys <- replicateM t $ (,) <$> readInteger <*> readInteger
    return (k, querys)
  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 (k, querys) = BS.unlines [ BS.pack . show $ solveCase k countWays query | query <- querys]
  where
    countWays :: (Int,Int) -> ModP
    countWays = (cache!)
      where
        bnds = ((0,0),(1024,1024))
        cache = listArray bnds $ map go $ range bnds :: Array (Int,Int) ModP

        go (prev, 0) = ModP 1
        go (prev, left) = ans47 + ansOther
          where
            ans47 = if prev == 0 || prev > k then ModP 2 * countWays (1, left - 1) else ModP 0
            ansOther = ModP 8 * countWays (if prev == 0 then 0 else prev + 1, left - 1)

solveCase k countWays (lo, hi) = solveNumber k countWays (hi + 1) - solveNumber k countWays lo

-- calculate the answer for [0,n)
solveNumber k countWays n = fromInteger n - go str 0 (length str - 1)
  where
    str = show n

    go [] _ _ = ModP 0
    go (x:xs) prev left = sum lst + if x /= '4' && x /= '7' || prev > k || prev == 0 then  go xs (trans x prev) (left - 1) else 0
      where
        lst = [ countWays (trans i prev, left)
              | i <- ['0'..pred x]
              , i /= '4' && i /= '7' || prev > k || prev == 0
              ]

    trans '4' _ = 1
    trans '7' _ = 1
    trans _ 0   = 0
    trans _ prev = prev + 1

modulo :: Integral a => a
modulo = 1000000007

newtype ModP = ModP Int deriving Eq

instance Show ModP where
    show (ModP n) = show n

instance Num ModP where
    ModP a + ModP b = ModP $ (a + b) `mod` modulo
    ModP a - ModP b = ModP $ (a - b) `mod` modulo
    ModP a * ModP b = ModP $ fromIntegral (fromIntegral a * fromIntegral b :: Int64) `mod` modulo
    abs = undefined
    signum = undefined
    fromInteger = ModP . fromInteger . (`mod` modulo)

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

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


Paul hates palindromes. He assumes that string s is tolerable if each its character is one of the first p letters of the English alphabet and s doesn't contain any palindrome contiguous substring of length 2 or more.Paul has found a tolerable string s of length n. Help him find the lexicographically next tolerable string of the same length or else state that such string does not exist.

The first line contains two space-separated integers: n and p (1 ≤ n ≤ 1000; 1 ≤ p ≤ 26). The second line contains string s, consisting of n small English letters. It is guaranteed that the string is tolerable (according to the above definition).

If the lexicographically next tolerable string of the same length exists, print it. Otherwise, print "NO" (without the quotes).

NoteString s is lexicographically larger (or simply larger) than string t with the same length, if there is number i, such that s1 = t1, ..., si = ti, si + 1 > ti + 1.The lexicographically next tolerable string is the lexicographically minimum tolerable string which is larger than the given one.A palindrome is a string that reads the same forward or reversed.

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"

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


You are given an array a with n elements. Each element of a is either 0 or 1.Let's denote the length of the longest subsegment of consecutive elements in a, consisting of only numbers one, as f(a). You can change no more than k zeroes to ones to maximize f(a).

The first line contains two integers n and k (1 ≤ n ≤ 3·105, 0 ≤ k ≤ n) — the number of elements in a and the parameter k. The second line contains n integers ai (0 ≤ ai ≤ 1) — the elements of a.

On the first line print a non-negative integer z — the maximal value of f(a) after no more than k changes of zeroes to ones. On the second line print n integers aj — the elements of the array a after the changes. If there are multiple answers, you can print any one of them.

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


Ujan decided to make a new wooden roof for the house. He has $$$n$$$ rectangular planks numbered from $$$1$$$ to $$$n$$$. The $$$i$$$-th plank has size $$$a_i \times 1$$$ (that is, the width is $$$1$$$ and the height is $$$a_i$$$).Now, Ujan wants to make a square roof. He will first choose some of the planks and place them side by side in some order. Then he will glue together all of these planks by their vertical sides. Finally, he will cut out a square from the resulting shape in such a way that the sides of the square are horizontal and vertical.For example, if Ujan had planks with lengths $$$4$$$, $$$3$$$, $$$1$$$, $$$4$$$ and $$$5$$$, he could choose planks with lengths $$$4$$$, $$$3$$$ and $$$5$$$. Then he can cut out a $$$3 \times 3$$$ square, which is the maximum possible. Note that this is not the only way he can obtain a $$$3 \times 3$$$ square.  What is the maximum side length of the square Ujan can get?

The first line of input contains a single integer $$$k$$$ ($$$1 \leq k \leq 10$$$), the number of test cases in the input. For each test case, the first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 1\,000$$$), the number of planks Ujan has in store. The next line contains $$$n$$$ integers $$$a_1, \ldots, a_n$$$ ($$$1 \leq a_i \leq n$$$), the lengths of the planks.

For each of the test cases, output a single integer, the maximum possible side length of the square.

NoteThe first sample corresponds to the example in the statement.In the second sample, gluing all $$$4$$$ planks will result in a $$$4 \times 4$$$ square.In the third sample, the maximum possible square is $$$1 \times 1$$$ and can be taken simply as any of the planks.

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


Our old friend Alexey has finally entered the University of City N — the Berland capital. Alexey expected his father to get him a place to live in but his father said it was high time for Alexey to practice some financial independence. So, Alexey is living in a dorm. The dorm has exactly one straight dryer — a 100 centimeter long rope to hang clothes on. The dryer has got a coordinate system installed: the leftmost end of the dryer has coordinate 0, and the opposite end has coordinate 100. Overall, the university has n students. Dean's office allows i-th student to use the segment (li, ri) of the dryer. However, the dean's office actions are contradictory and now one part of the dryer can belong to multiple students!Alexey don't like when someone touch his clothes. That's why he want make it impossible to someone clothes touch his ones. So Alexey wonders: what is the total length of the parts of the dryer that he may use in a such way that clothes of the others (n - 1) students aren't drying there. Help him! Note that Alexey, as the most respected student, has number 1.

The first line contains a positive integer n (1 ≤ n ≤ 100). The (i + 1)-th line contains integers li and ri (0 ≤ li < ri ≤ 100) — the endpoints of the corresponding segment for the i-th student.

On a single line print a single number k, equal to the sum of lengths of the parts of the dryer which are inside Alexey's segment and are outside all other segments.

NoteNote that it's not important are clothes drying on the touching segments (e.g. (0, 1) and (1, 2)) considered to be touching or not because you need to find the length of segments.In the first test sample Alexey may use the only segment (0, 1). In such case his clothes will not touch clothes on the segments (1, 6) and (2, 8). The length of segment (0, 1) is 1.In the second test sample Alexey may dry his clothes on segments (0, 1) and (5, 7). Overall length of these segments is 3.

import Data.List

f::Int->[[Int]]->Int
f _ []=1
f x ((l:r:[]):xs)
    |l<=x && x<r=0
    |otherwise=f x xs

main =do
      e<-getLine
      es<-getContents
      let n=read e::Int
          xs=lines es
          ys=map (map read) (map words xs)::[[Int]]
          (l:r:[])=head ys
          ys2=tail ys
          zs=map length $ filter ((== 1) . head ) $ group ([f e ys2|e<-[l..(r-1)]])
      print $ (sum zs)

import Data.List

f::Int->[[Int]]->Int
f _ []=1
f x ((l:r:[]):xs)
    |l<x && x<r=0
    |otherwise=f x xs

main =do
      e<-getLine
      es<-getContents
      let n=read e::Int
          xs=lines es
          ys=map (map read) (map words xs)::[[Int]]
          (l:r:[])=head ys
          ys2=tail ys
          zs=map length $ filter ((== 1) . head ) $ group ([f e ys2|e<-[l..r]])
      print $ (sum zs)-(length zs)


You took a peek on Thanos wearing Infinity Gauntlet. In the Gauntlet there is a place for six Infinity Gems:  the Power Gem of purple color,  the Time Gem of green color,  the Space Gem of blue color,  the Soul Gem of orange color,  the Reality Gem of red color,  the Mind Gem of yellow color. Using colors of Gems you saw in the Gauntlet determine the names of absent Gems.

In the first line of input there is one integer $$$n$$$ ($$$0 \le n \le 6$$$) — the number of Gems in Infinity Gauntlet. In next $$$n$$$ lines there are colors of Gems you saw. Words used for colors are: purple, green, blue, orange, red, yellow. It is guaranteed that all the colors are distinct. All colors are given in lowercase English letters.

In the first line output one integer $$$m$$$ ($$$0 \le m \le 6$$$) — the number of absent Gems. Then in $$$m$$$ lines print the names of absent Gems, each on its own line. Words used for names are: Power, Time, Space, Soul, Reality, Mind. Names can be printed in any order. Keep the first letter uppercase, others lowercase.

NoteIn the first sample Thanos already has Reality, Power, Mind and Soul Gems, so he needs two more: Time and Space.In the second sample Thanos doesn't have any Gems, so he needs all six.

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

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

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


Consider a simplified penalty phase at the end of a football match.A penalty phase consists of at most $$$10$$$ kicks, the first team takes the first kick, the second team takes the second kick, then the first team takes the third kick, and so on. The team that scores more goals wins; if both teams score the same number of goals, the game results in a tie (note that it goes against the usual football rules). The penalty phase is stopped if one team has scored more goals than the other team could reach with all of its remaining kicks. For example, if after the $$$7$$$-th kick the first team has scored $$$1$$$ goal, and the second team has scored $$$3$$$ goals, the penalty phase ends — the first team cannot reach $$$3$$$ goals.You know which player will be taking each kick, so you have your predictions for each of the $$$10$$$ kicks. These predictions are represented by a string $$$s$$$ consisting of $$$10$$$ characters. Each character can either be 1, 0, or ?. This string represents your predictions in the following way:  if $$$s_i$$$ is 1, then the $$$i$$$-th kick will definitely score a goal;  if $$$s_i$$$ is 0, then the $$$i$$$-th kick definitely won't score a goal;  if $$$s_i$$$ is ?, then the $$$i$$$-th kick could go either way. Based on your predictions, you have to calculate the minimum possible number of kicks there can be in the penalty phase (that means, the earliest moment when the penalty phase is stopped, considering all possible ways it could go). Note that the referee doesn't take into account any predictions when deciding to stop the penalty phase — you may know that some kick will/won't be scored, but the referee doesn't.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1\,000$$$) — the number of test cases. Each test case is represented by one line containing the string $$$s$$$, consisting of exactly $$$10$$$ characters. Each character is either 1, 0, or ?.

For each test case, print one integer — the minimum possible number of kicks in the penalty phase.

NoteConsider the example test:In the first test case, consider the situation when the $$$1$$$-st, $$$5$$$-th and $$$7$$$-th kicks score goals, and kicks $$$2$$$, $$$3$$$, $$$4$$$ and $$$6$$$ are unsuccessful. Then the current number of goals for the first team is $$$3$$$, for the second team is $$$0$$$, and the referee sees that the second team can score at most $$$2$$$ goals in the remaining kicks. So the penalty phase can be stopped after the $$$7$$$-th kick.In the second test case, the penalty phase won't be stopped until all $$$10$$$ kicks are finished.In the third test case, if the first team doesn't score any of its three first kicks and the second team scores all of its three first kicks, then after the $$$6$$$-th kick, the first team has scored $$$0$$$ goals and the second team has scored $$$3$$$ goals, and the referee sees that the first team can score at most $$$2$$$ goals in the remaining kicks. So, the penalty phase can be stopped after the $$$6$$$-th kick.In the fourth test case, even though you can predict the whole penalty phase, the referee understands that the phase should be ended only after the $$$9$$$-th kick.

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


Mike has a frog and a flower. His frog is named Xaniar and his flower is named Abol. Initially(at time 0), height of Xaniar is h1 and height of Abol is h2. Each second, Mike waters Abol and Xaniar.  So, if height of Xaniar is h1 and height of Abol is h2, after one second height of Xaniar will become  and height of Abol will become  where x1, y1, x2 and y2 are some integer numbers and  denotes the remainder of a modulo b.Mike is a competitive programmer fan. He wants to know the minimum time it takes until height of Xania is a1 and height of Abol is a2.Mike has asked you for your help. Calculate the minimum time or say it will never happen.

The first line of input contains integer m (2 ≤ m ≤ 106). The second line of input contains integers h1 and a1 (0 ≤ h1, a1 < m). The third line of input contains integers x1 and y1 (0 ≤ x1, y1 < m). The fourth line of input contains integers h2 and a2 (0 ≤ h2, a2 < m). The fifth line of input contains integers x2 and y2 (0 ≤ x2, y2 < m). It is guaranteed that h1 ≠ a1 and h2 ≠ a2.

Print the minimum number of seconds until Xaniar reaches height a1 and Abol reaches height a2 or print -1 otherwise.

NoteIn the first sample, heights sequences are following:Xaniar: Abol:

main = getContents >>= print . solve . lines

solve inputs =
    let m = read (head inputs)
        pairs = get_pairs (tail inputs)
        (h1, a1) = head pairs
        (x1, y1) = head (tail pairs)
        (h2, a2) = head (drop 2 pairs)
        (x2, y2) = head (drop 3 pairs)
        f1 = get_first x1 y1 h1 a1 m 0
        f2 = get_first x2 y2 h2 a2 m 0
        l1 = get_loop x1 y1 a1 m
        l2 = get_loop x2 y2 a2 m
    in solve' f1 f2 l1 l2 m 0
        where
            get_pair s =
                let p = map read (words s)
                in ((head p), (head (tail p)))

            get_pairs [] = []
            get_pairs (x:xs) = (get_pair x):(get_pairs xs)

            get_first x y h a m i | i > m = 0 - m - m
                                  | h == a = 0
                                  | otherwise = 1 + (get_first x y (rem (h * x + y) m) a m (i+1))

            get_loop x y a m = 1 + (get_first x y (rem (a * x + y) m) a m 0)

            solve' f1 f2 l1 l2 m i | f1 < 0 || f2 < 0 || i > 2 * m = -1
                                   | f1 == f2 = f1
                                   | f1 < f2 = solve' (f1+l1) f2 l1 l2 m (i+1)
                                   | otherwise = solve' f1 (f2+l2) l1 l2 m (i+1)


It is known that there are k fish species in the polar ocean, numbered from 1 to k. They are sorted by non-decreasing order of their weight, which is a positive number. Let the weight of the i-th type of fish be wi, then 0 < w1 ≤ w2 ≤ ... ≤ wk holds.Polar bears Alice and Bob each have caught some fish, and they are guessing who has the larger sum of weight of the fish he/she's caught. Given the type of the fish they've caught, determine whether it is possible that the fish caught by Alice has a strictly larger total weight than Bob's. In other words, does there exist a sequence of weights wi (not necessary integers), such that the fish caught by Alice has a strictly larger total weight?

The first line contains three integers n, m, k (1 ≤ n, m ≤ 105, 1 ≤ k ≤ 109) — the number of fish caught by Alice and Bob respectively, and the number of fish species. The second line contains n integers each from 1 to k, the list of fish type caught by Alice. The third line contains m integers each from 1 to k, the list of fish type caught by Bob. Note that one may have caught more than one fish for a same species.

Output "YES" (without quotes) if it is possible, and "NO" (without quotes) otherwise.

NoteIn the first sample, if w1 = 1, w2 = 2, w3 = 2.5,  then Alice has a total of 2 + 2 + 2 = 6 weight units, while Bob only has 1 + 1 + 2.5 = 4.5.In the second sample, the fish that Alice caught is a subset of Bob's. Therefore, the total weight of Bob’s fish is always not less than the total weight of Alice’s fish.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


In Chelyabinsk lives a much respected businessman Nikita with a strange nickname "Boss". Once Nikita decided to go with his friend Alex to the Summer Biathlon World Cup. Nikita, as a very important person, received a token which allows to place bets on each section no more than on one competitor.To begin with friends learned the rules: in the race there are n sections of equal length and m participants. The participants numbered from 1 to m. About each participant the following is known: li — the number of the starting section,  ri — the number of the finishing section (li ≤ ri), ti — the time a biathlete needs to complete an section of the path, ci — the profit in roubles. If the i-th sportsman wins on one of the sections, the profit will be given to the man who had placed a bet on that sportsman. The i-th biathlete passes the sections from li to ri inclusive. The competitor runs the whole way in (ri - li + 1)·ti time units. It takes him exactly ti time units to pass each section. In case of the athlete's victory on k sections the man who has betted on him receives k·ci roubles.In each section the winner is determined independently as follows: if there is at least one biathlete running this in this section, then among all of them the winner is the one who has ran this section in minimum time (spent minimum time passing this section). In case of equality of times the athlete with the smaller index number wins. If there are no participants in this section, then the winner in this section in not determined. We have to say that in the summer biathlon all the participants are moving at a constant speed.We should also add that Nikita can bet on each section and on any contestant running in this section.Help the friends find the maximum possible profit.

The first line contains two integers n and m (1 ≤ n, m ≤ 100). Then follow m lines, each containing 4 integers li, ri, ti, ci (1 ≤ li ≤ ri ≤ n, 1 ≤ ti, ci ≤ 1000).

Print a single integer, the maximal profit in roubles that the friends can get. In each of n sections it is not allowed to place bets on more than one sportsman.

NoteIn the first test the optimal bet is: in the 1-2 sections on biathlete 1, in section 3 on biathlete 3, in section 4 on biathlete 4. Total: profit of 5 rubles for 1 section, the profit of 5 rubles for 2 section, profit of 30 rubles for a 3 section, profit of 20 rubles for 4 section. Total profit 60 rubles.In the second test the optimal bet is: on 1 and 5 sections on biathlete 1, in the 2-4 sections on biathlete 2, in the 6-7 sections on athlete 4. There is no winner in the 8 section. Total: profit of 10 rubles for 1 section, the profit of 15 rubles for 2,3,4 section, profit of 10 rubles for a 5 section, profit of 20 rubles for 6, 7 section. Total profit 105 rubles.

module Main where

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


Hr0d1y has $$$q$$$ queries on a binary string $$$s$$$ of length $$$n$$$. A binary string is a string containing only characters '0' and '1'.A query is described by a pair of integers $$$l_i$$$, $$$r_i$$$ $$$(1 \leq l_i \lt r_i \leq n)$$$. For each query, he has to determine whether there exists a good subsequence in $$$s$$$ that is equal to the substring $$$s[l_i\ldots r_i]$$$.   A substring $$$s[i\ldots j]$$$ of a string $$$s$$$ is the string formed by characters $$$s_i s_{i+1} \ldots s_j$$$. String $$$a$$$ is said to be a subsequence of string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deleting some characters without changing the order of the remaining characters. A subsequence is said to be good if it is not contiguous and has length $$$\ge 2$$$. For example, if $$$s$$$ is "1100110", then the subsequences $$$s_1s_2s_4$$$ ("1100110") and $$$s_1s_5s_7$$$ ("1100110") are good, while $$$s_1s_2s_3$$$ ("1100110") is not good. Can you help Hr0d1y answer each query?

The first line of the input contains a single integer $$$t$$$ ($$$1\leq t \leq 100$$$) — the number of test cases. The description of each test case is as follows. The first line contains two integers $$$n$$$ ($$$2 \leq n \leq 100$$$) and $$$q$$$ ($$$1\leq q \leq 100$$$) — the length of the string and the number of queries.  The second line contains the string $$$s$$$. The $$$i$$$-th of the next $$$q$$$ lines contains two integers $$$l_i$$$ and $$$r_i$$$ ($$$1 \leq l_i \lt r_i \leq n$$$).

For each test case, output $$$q$$$ lines. The $$$i$$$-th line of the output of each test case should contain "YES" if there exists a good subsequence equal to the substring $$$s[l_i...r_i]$$$, and "NO" otherwise. You may print each letter in any case (upper or lower).

NoteIn the first test case,   $$$s[2\ldots 4] = $$$ "010". In this case $$$s_1s_3s_5$$$ ("001000") and $$$s_2s_3s_6$$$ ("001000") are good suitable subsequences, while $$$s_2s_3s_4$$$ ("001000") is not good.  $$$s[1\ldots 3] = $$$ "001". No suitable good subsequence exists.  $$$s[3\ldots 5] = $$$ "100". Here $$$s_3s_5s_6$$$ ("001000") is a suitable good subsequence.

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

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

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

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

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

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

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

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

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


Iahub wants to enhance his multitasking abilities. In order to do this, he wants to sort n arrays simultaneously, each array consisting of m integers.Iahub can choose a pair of distinct indices i and j (1 ≤ i, j ≤ m, i ≠ j). Then in each array the values at positions i and j are swapped only if the value at position i is strictly greater than the value at position j.Iahub wants to find an array of pairs of distinct indices that, chosen in order, sort all of the n arrays in ascending or descending order (the particular order is given in input). The size of the array can be at most  (at most  pairs). Help Iahub, find any suitable array.

The first line contains three integers n (1 ≤  n ≤ 1000), m (1 ≤ m ≤  100) and k. Integer k is 0 if the arrays must be sorted in ascending order, and 1 if the arrays must be sorted in descending order. Each line i of the next n lines contains m integers separated by a space, representing the i-th array. For each element x of the array i, 1 ≤ x ≤ 106 holds.

On the first line of the output print an integer p, the size of the array (p can be at most ). Each of the next p lines must contain two distinct integers i and j (1 ≤ i, j ≤ m, i ≠ j), representing the chosen indices. If there are multiple correct answers, you can print any.

NoteConsider the first sample. After the first operation, the arrays become [1, 3, 2, 5, 4] and [1, 2, 3, 4, 5]. After the second operation, the arrays become [1, 2, 3, 5, 4] and [1, 2, 3, 4, 5]. After the third operation they become [1, 2, 3, 4, 5] and [1, 2, 3, 4, 5].

main = fmap (\x -> f (map read (words x))) getLine >>= mapM putStrLn
f [n, m, k] = show (div (m * (m - 1)) 2) : [show x ++ " " ++ show y | x <- [1..m], y <- [1..m], if k == 0 then x < y else y < x]


Petya loves lucky numbers. Everybody knows that lucky numbers are positive integers whose decimal representation contains only the lucky digits 4 and 7. For example, numbers 47, 744, 4 are lucky and 5, 17, 467 are not.Petya has a number consisting of n digits without leading zeroes. He represented it as an array of digits without leading zeroes. Let's call it d. The numeration starts with 1, starting from the most significant digit. Petya wants to perform the following operation k times: find the minimum x (1 ≤ x < n) such that dx = 4 and dx + 1 = 7, if x is odd, then to assign dx = dx + 1 = 4, otherwise to assign dx = dx + 1 = 7. Note that if no x was found, then the operation counts as completed and the array doesn't change at all.You are given the initial number as an array of digits and the number k. Help Petya find the result of completing k operations.

The first line contains two integers n and k (1 ≤ n ≤ 105, 0 ≤ k ≤ 109) — the number of digits in the number and the number of completed operations. The second line contains n digits without spaces representing the array of digits d, starting with d1. It is guaranteed that the first digit of the number does not equal zero.

In the single line print the result without spaces — the number after the k operations are fulfilled.

NoteIn the first sample the number changes in the following sequence: 4727447 → 4427447 → 4427477 → 4427447 → 4427477.In the second sample: 4478 → 4778 → 4478.

proc :: Bool -> Int -> String -> String
proc _ 0 s  = s
proc _ _ [] = []
proc True k z@('4':'4':'7':str) = if even k then z else ('4':'7':'7':str)
proc b k s = case s of
    ('4':'7':str) -> let x = if b then '4' else '7'
                      in proc b (k - 1) (x:x:str)
    (c:cs) -> c : proc (not b) k cs
parse s = case map read (words s) of [_, n] -> proc True n
main = getLine >>= \s -> getLine >>= return . parse s >>= putStrLn


Wabbit is trying to move a box containing food for the rest of the zoo in the coordinate plane from the point $$$(x_1,y_1)$$$ to the point $$$(x_2,y_2)$$$.He has a rope, which he can use to pull the box. He can only pull the box if he stands exactly $$$1$$$ unit away from the box in the direction of one of two coordinate axes. He will pull the box to where he is standing before moving out of the way in the same direction by $$$1$$$ unit.   For example, if the box is at the point $$$(1,2)$$$ and Wabbit is standing at the point $$$(2,2)$$$, he can pull the box right by $$$1$$$ unit, with the box ending up at the point $$$(2,2)$$$ and Wabbit ending at the point $$$(3,2)$$$.Also, Wabbit can move $$$1$$$ unit to the right, left, up, or down without pulling the box. In this case, it is not necessary for him to be in exactly $$$1$$$ unit away from the box. If he wants to pull the box again, he must return to a point next to the box. Also, Wabbit can't move to the point where the box is located.Wabbit can start at any point. It takes $$$1$$$ second to travel $$$1$$$ unit right, left, up, or down, regardless of whether he pulls the box while moving.Determine the minimum amount of time he needs to move the box from $$$(x_1,y_1)$$$ to $$$(x_2,y_2)$$$. Note that the point where Wabbit ends up at does not matter.

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ $$$(1 \leq t \leq 1000)$$$: the number of test cases. The description of the test cases follows. Each of the next $$$t$$$ lines contains four space-separated integers $$$x_1, y_1, x_2, y_2$$$ $$$(1 \leq x_1, y_1, x_2, y_2 \leq 10^9)$$$, describing the next test case.

For each test case, print a single integer: the minimum time in seconds Wabbit needs to bring the box from $$$(x_1,y_1)$$$ to $$$(x_2,y_2)$$$.

NoteIn the first test case, the starting and the ending points of the box are $$$(1,2)$$$ and $$$(2,2)$$$ respectively. This is the same as the picture in the statement. Wabbit needs only $$$1$$$ second to move as shown in the picture in the statement.In the second test case, Wabbit can start at the point $$$(2,1)$$$. He pulls the box to $$$(2,1)$$$ while moving to $$$(3,1)$$$. He then moves to $$$(3,2)$$$ and then to $$$(2,2)$$$ without pulling the box. Then, he pulls the box to $$$(2,2)$$$ while moving to $$$(2,3)$$$. It takes $$$4$$$ seconds.

import Data.List

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

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

import Control.Monad

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

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

import Control.Monad

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

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

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

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

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

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

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

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


One of my most productive days was throwing away 1,000 lines of code.— Ken ThompsonFibonacci addition is an operation on an array $$$X$$$ of integers, parametrized by indices $$$l$$$ and $$$r$$$. Fibonacci addition increases $$$X_l$$$ by $$$F_1$$$, increases $$$X_{l + 1}$$$ by $$$F_2$$$, and so on up to $$$X_r$$$ which is increased by $$$F_{r - l + 1}$$$.$$$F_i$$$ denotes the $$$i$$$-th Fibonacci number ($$$F_1 = 1$$$, $$$F_2 = 1$$$, $$$F_{i} = F_{i - 1} + F_{i - 2}$$$ for $$$i > 2$$$), and all operations are performed modulo $$$MOD$$$.You are given two arrays $$$A$$$ and $$$B$$$ of the same length. We will ask you to perform several Fibonacci additions on these arrays with different parameters, and after each operation you have to report whether arrays $$$A$$$ and $$$B$$$ are equal modulo $$$MOD$$$.

The first line contains 3 numbers $$$n$$$, $$$q$$$ and $$$MOD$$$ ($$$1 \le n, q \le 3\cdot 10^5, 1 \le MOD \le 10^9+7$$$) — the length of the arrays, the number of operations, and the number modulo which all operations are performed. The second line contains $$$n$$$ numbers — array $$$A$$$ ($$$0 \le A_i < MOD$$$). The third line also contains $$$n$$$ numbers — array $$$B$$$ ($$$0 \le B_i < MOD$$$). The next $$$q$$$ lines contain character $$$c$$$ and two numbers $$$l$$$ and $$$r$$$ ($$$1 \le l \le r \le n$$$) — operation parameters. If $$$c$$$ is "A", Fibonacci addition is to be performed on array $$$A$$$, and if it is is "B", the operation is to be performed on $$$B$$$.

After each operation, print "YES" (without quotes) if the arrays are equal and "NO" otherwise. Letter case does not matter.

{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.STRef
import Control.Monad.ST
import Control.Monad.Trans.Class
import Data.Bool

purifyST :: (forall s. S (ST s) a) -> SP a
purifyST fun = state $ \s -> runST (runStateT fun s)

mainFun :: SP Builder
mainFun = purifyST $ do
  n <- getInt
  nQueries <- getInt
  p <- getInt
  let
    cv :: Int -> Int
    cv x = x - if  x >= p  then  p  else  0
    infixl 6 +!
    x +! y = cv $ x + y
    infixl 6 -!
    x -! y = cv $ x + p - y

    fibLi = 0 : cv 1 : zipWith (+!) fibLi (tail fibLi)
    fibs :: UArray Int Int
    fibs = listArray (0, n+2) $ take (n+3) fibLi

  arr :: STUArray s Int Int
      -- pad by two
      <- lift $ newArray (-1, n+2) 0 :: S (ST s) (STUArray s Int Int)
  nonZeros :: STRef s Int <- lift $ newSTRef 0
  let
    incr :: Int -> Int -> ST s Bool
    incr ix amt = do
      pval <- readArray arr ix
      let  nval = pval +! amt
           weight x = if  x == 0  then  0  else  1
      writeArray arr ix nval
      pct <- readSTRef nonZeros
      let  nct = pct + weight nval - weight pval
      writeSTRef nonZeros nct
      pure $! nct == 0

  -- initialize array
  aLi <- replicateM n getInt
  lift $ forM_ (zip [1..n] aLi) $ \(i, ai) -> do
    v <- readArray arr i
    writeArray arr i (v +! ai)
  bLi <- replicateM n getInt
  lift $ forM_ (zip [1..n] bLi) $ \(i, bi) -> do
    v <- readArray arr i
    writeArray arr i (v -! bi)

  lift $ forM_ [n+2, n+1 .. 1] $ \i -> do
    v0 <- readArray arr i
    v1 <- readArray arr (i - 1)
    v2 <- readArray arr (i - 2)
    writeArray arr i 0
    -- use incr to initialize nonZero at the same time
    incr i (v0 -! v1 -! v2)

  ansArr :: STUArray s Int Bool <- lift $ newArray_ (1, nQueries)
  forM_ [1 .. nQueries] $ \qix -> do
    cs <- getNext
    li <- getInt
    ri <- getInt
    let  f0 = fibs ! (ri - li + 1)
         f1 = fibs ! (ri - li + 2)
         go fun = lift $ do
           _ <- fun li 1
           _ <- fun (ri + 1) (0 -! f1)
           fun (ri + 2) (0 -! f0)
    qans <- case  P.unpack cs  of
      "A" -> go incr
      "B" -> go (\i v -> incr i (0 -! v))
      _ -> error "yikes"
    lift $ writeArray ansArr qix qans
  lift $ foldMap (bool (string7 "NO\n") (string7 "YES\n")) <$> getElems ansArr

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun inp
  P.putStr $ toLazyByteString outp


You are fighting with Zmei Gorynich — a ferocious monster from Slavic myths, a huge dragon-like reptile with multiple heads!   Initially Zmei Gorynich has $$$x$$$ heads. You can deal $$$n$$$ types of blows. If you deal a blow of the $$$i$$$-th type, you decrease the number of Gorynich's heads by $$$min(d_i, curX)$$$, there $$$curX$$$ is the current number of heads. But if after this blow Zmei Gorynich has at least one head, he grows $$$h_i$$$ new heads. If $$$curX = 0$$$ then Gorynich is defeated. You can deal each blow any number of times, in any order.For example, if $$$curX = 10$$$, $$$d = 7$$$, $$$h = 10$$$ then the number of heads changes to $$$13$$$ (you cut $$$7$$$ heads off, but then Zmei grows $$$10$$$ new ones), but if $$$curX = 10$$$, $$$d = 11$$$, $$$h = 100$$$ then number of heads changes to $$$0$$$ and Zmei Gorynich is considered defeated.Calculate the minimum number of blows to defeat Zmei Gorynich!You have to answer $$$t$$$ independent queries.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) – the number of queries. The first line of each query contains two integers $$$n$$$ and $$$x$$$ ($$$1 \le n \le 100$$$, $$$1 \le x \le 10^9$$$) — the number of possible types of blows and the number of heads Zmei initially has, respectively. The following $$$n$$$ lines of each query contain the descriptions of types of blows you can deal. The $$$i$$$-th line contains two integers $$$d_i$$$ and $$$h_i$$$ ($$$1 \le d_i, h_i \le 10^9$$$) — the description of the $$$i$$$-th blow.

For each query print the minimum number of blows you have to deal to defeat Zmei Gorynich.  If Zmei Gorynuch cannot be defeated print $$$-1$$$.

NoteIn the first query you can deal the first blow (after that the number of heads changes to $$$10 - 6 + 3 = 7$$$), and then deal the second blow.In the second query you just deal the first blow three times, and Zmei is defeated. In third query you can not defeat Zmei Gorynich. Maybe it's better to convince it to stop fighting?

{-# LANGUAGE MultiWayIf #-}
import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    [n,x] <- map read . words <$> getLine
    bs <- replicateM n $ (\[d,h] -> (d,d-h)) . map read . words <$> getLine
    let finisher = maximum (map fst bs)
        cruise = maximum (map snd bs)
        blows = (x - finisher + cruise - 1) `div` cruise
    print $ if | x - finisher <= 0 -> 1
               | cruise <= 0 -> -1
               | otherwise -> 1 + blows


Berland crossword is a puzzle that is solved on a square grid with $$$n$$$ rows and $$$n$$$ columns. Initially all the cells are white.To solve the puzzle one has to color some cells on the border of the grid black in such a way that:   exactly $$$U$$$ cells in the top row are black;  exactly $$$R$$$ cells in the rightmost column are black;  exactly $$$D$$$ cells in the bottom row are black;  exactly $$$L$$$ cells in the leftmost column are black. Note that you can color zero cells black and leave every cell white.Your task is to check if there exists a solution to the given puzzle.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of testcases. Then the descriptions of $$$t$$$ testcases follow. The only line of each testcase contains $$$5$$$ integers $$$n, U, R, D, L$$$ ($$$2 \le n \le 100$$$; $$$0 \le U, R, D, L \le n$$$).

For each testcase print "YES" if the solution exists and "NO" otherwise. You may print every letter in any case you want (so, for example, the strings yEs, yes, Yes and YES are all recognized as positive answer).

NoteHere are possible solutions to testcases $$$1$$$, $$$2$$$ and $$$4$$$:

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

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

------

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

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

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

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

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

module Main where

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

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

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

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

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

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

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

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    [n, u, r, d, l] <- getIntList
    putStrLn $ yesOrNo $ f n [u, r, d, l]

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

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

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

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

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

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

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

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

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

type SIO = StateT P.ByteString IO

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

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

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

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

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

------

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

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

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

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

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