import Data.List

isPali s = s == reverse s

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

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

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

main = interact $ s . words

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

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

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

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

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

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

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

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

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

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

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

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

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

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

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

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

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

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

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

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

module Main where

import Control.Monad
import Data.Char

import Debug.Trace

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

import           Data.List
import           Numeric

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

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

main = interact $ unlines . solverLoop . lines

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

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

import Control.Monad
import Data.List

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

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

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

import Control.Monad
import Data.List

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

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

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

import Data.List (sortBy)

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

readInt :: String -> Int
readInt = read

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

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

import Data.List as L

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

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

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

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

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

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


import Data.List

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

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

main = interact foo

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

module Main where

import Data.List (find)

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

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

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

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

module Main where

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

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

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

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

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

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

ok :: Parser ()
ok = return ()

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

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

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

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

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

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

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

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

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

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

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

import Data.List
import Data.Array

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

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

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

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

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

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

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

import Control.Monad

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

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

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

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

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

--ghc 7.10

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

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

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

module Main where

import Data.List

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

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

import Control.Monad
import Data.List

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

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

module Main where

import Data.List (find)

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

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

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

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

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

module Main where

import Data.List (find)

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

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

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

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

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

module Main where

import Data.List

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

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


import Control.Monad

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

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

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

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

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

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

import Control.Monad

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

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

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

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

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

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

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

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

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

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

{-# LANGUAGE ParallelListComp #-}

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

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

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

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

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

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

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

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

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

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

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

type SIO = StateT P.ByteString IO

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


module Main where

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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


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

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

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

import Data.List

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

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

import Control.Monad

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

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

import Control.Monad

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

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

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

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

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


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

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

------

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

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

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

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

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

module Main where

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

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

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

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

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

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

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

main :: IO ()
main = tCase process

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

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

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

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

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

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

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

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

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

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

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

type SIO = StateT P.ByteString IO

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

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

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

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

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

------

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

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

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

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

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


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

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

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

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

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

main :: IO ()
main = solve

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

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

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

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

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

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

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

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

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

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

main :: IO ()
main = solve

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

type SIO = StateT P.ByteString IO

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

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

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

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

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

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

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

main :: IO ()
main = solve

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

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

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

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

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

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

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

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

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

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

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

main :: IO ()
main = solve

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

type SIO = StateT P.ByteString IO

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

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


import Debug.Trace (trace)

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

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

type Range = (Double, Double)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Control.Applicative

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

type Range = (Double, Double)

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

main = getLine >>= flip replicateM_ test . read

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

import Data.List
import Control.Monad

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

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

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

import qualified Data.List as L

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

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

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

main = do
    t <- getLine
    handleTest $ read t

import qualified Data.List as L

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

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

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

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

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

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

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

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

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

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

main = getLine >>= flip replicateM_ test . read

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

import Data.List
import Control.Monad

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

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

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

import qualified Data.List as L

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

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

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

main = do
    t <- getLine
    handleTest $ read t

import qualified Data.List as L

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

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

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

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

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

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

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

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