Ari the monster is not an ordinary monster. She is the hidden identity of Super M, the Byteforces’ superhero. Byteforces is a country that consists of n cities, connected by n - 1 bidirectional roads. Every road connects exactly two distinct cities, and the whole road system is designed in a way that one is able to go from any city to any other city using only the given roads. There are m cities being attacked by humans. So Ari... we meant Super M have to immediately go to each of the cities being attacked to scare those bad humans. Super M can pass from one city to another only using the given roads. Moreover, passing through one road takes her exactly one kron - the time unit used in Byteforces.   However, Super M is not on Byteforces now - she is attending a training camp located in a nearby country Codeforces. Fortunately, there is a special device in Codeforces that allows her to instantly teleport from Codeforces to any city of Byteforces. The way back is too long, so for the purpose of this problem teleportation is used exactly once.You are to help Super M, by calculating the city in which she should teleport at the beginning in order to end her job in the minimum time (measured in krons). Also, provide her with this time so she can plan her way back to Codeforces.

The first line of the input contains two integers n and m (1 ≤ m ≤ n ≤ 123456) - the number of cities in Byteforces, and the number of cities being attacked respectively. Then follow n - 1 lines, describing the road system. Each line contains two city numbers ui and vi (1 ≤ ui, vi ≤ n) - the ends of the road i. The last line contains m distinct integers - numbers of cities being attacked. These numbers are given in no particular order.

First print the number of the city Super M should teleport to. If there are many possible optimal answers, print the one with the lowest city number. Then print the minimum possible time needed to scare all humans in cities being attacked, measured in Krons. Note that the correct answer is always unique.

NoteIn the first sample, there are two possibilities to finish the Super M's job in 3 krons. They are: and .However, you should choose the first one as it starts in the city with the lower number.

import Control.Applicative
import Data.Array.IArray
import Data.Function
import Data.Maybe
import Data.Tuple
import qualified Data.ByteString.Char8 as BS

main = do
    (n : _ : input) <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getContents
    let (edges, attacked) = (\(x, y) -> (empair x, y)) . splitAt (2 * n - 2) $ input
    let graph = accumArray (flip (:)) [] (1, n) (edges ++ (map swap edges)) :: Array Int [Int]
    let isAttacked = accumArray (||) False (1, n) . zip attacked . repeat $ True :: Array Int Bool
    let root = minimum attacked
    let maxPath = let u = dfsMaxPath graph isAttacked 0 $ root in max (fst . fst $ u, -root) $ snd u
    putStrLn . show $ - snd maxPath
    putStrLn . show $ (dfsTotal graph isAttacked 0 $ root) - fst maxPath

empair []           = []
empair (a : b : ls) = (a, b) : (empair ls)

max2 []         = ((0, minBound :: Int), (0, minBound :: Int))
max2 (x : xs)   = let (m1, m2) = max2 xs in if x > m1 then (x, m1) else (m1, max x m2)

dfsTotal graph isAttacked p n = sum . map f . filter (p /=) $ (graph ! n)
    where
        f x = let ans = dfsTotal graph isAttacked n x in if ans /= 0 || isAttacked ! x then ans + 2 else 0

dfsMaxPath graph isAttacked p n = f . filter (\((_, x), _) -> x /= 0) . map (dfsMaxPath graph isAttacked n) . filter (p /=) $ (graph ! n)
    where
        f []            = ((0, if isAttacked ! n then -n else 0), (0, -n))
        f [(v1, v2)]    = let ans1 = (fst v1 + 1, snd v1) in (ans1, max ans1 v2)
        f ls            = let (mp1, mp2) = max2 . map fst $ ls
                          in ((fst mp1 + 1, snd mp1), max (maximum . map snd $ ls) (fst mp1 + fst mp2 + 2, (max `on` snd) mp1 mp2))

import Control.Applicative
import Data.Array.IArray
import Data.Graph
import Data.Maybe
import Data.Tuple
import qualified Data.ByteString.Char8 as BS

main = do
    {-(n : _ : input) <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getContents
    let (edges, attacked) = splitAt (2 * n) input
    let graph = accumArray (flip (:)) [] (1, n) (edges ++ (map swap edges))
    putStrLn . show $ graph-}
    putStrLn . show $ 1

import Control.Applicative
import Data.Array.IArray
import Data.Function
import Data.Maybe
import Data.Tuple
import qualified Data.ByteString.Char8 as BS

main = do
    (n : _ : input) <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getContents
    let (edges, attacked) = (\(x, y) -> (empair x, y)) . splitAt (2 * n - 2) $ input
    let graph = accumArray (flip (:)) [] (1, n) (edges ++ (map swap edges)) :: Array Int [Int]
    let isAttacked = accumArray (||) False (1, n) . zip attacked . repeat $ True :: Array Int Bool
    let maxPath = snd $ dfsMaxPath graph isAttacked 0 . head $ attacked
    putStrLn . show $ - snd maxPath
    putStrLn . show $ (dfsTotal graph isAttacked 0 . head $ attacked) - fst maxPath

empair []           = []
empair (a : b : ls) = (a, b) : (empair ls)

max2 []         = ((0, minBound :: Int), (0, minBound :: Int))
max2 (x : xs)   = let (m1, m2) = max2 xs in if x > m1 then (x, m1) else (m1, max x m2)

dfsTotal graph isAttacked p n = sum . map f . filter (p /=) $ (graph ! n)
    where
        f x = let ans = dfsTotal graph isAttacked n x in if ans /= 0 || isAttacked ! x then ans + 2 else 0

dfsMaxPath graph isAttacked p n = f . filter (\((_, x), _) -> x /= 0) . map (dfsMaxPath graph isAttacked n) . filter (p /=) $ (graph ! n)
    where
        u = if isAttacked ! n then -n else minBound :: Int
        f []            = ((0, if isAttacked ! n then -n else 0), (0, -n))
        f [(v1, v2)]    = let ans1 = (fst v1 + 1, max u $ snd v1) in (ans1, max ans1 v2)
        f ls            = let (mp1, mp2) = max2 . map fst $ ls
                          in ((fst mp1 + 1, max u $ snd mp1), max (maximum . map snd $ ls) (fst mp1 + fst mp2 + 2, maximum [u, snd mp1, snd mp2]))


Ksusha the Squirrel is standing at the beginning of a straight road, divided into n sectors. The sectors are numbered 1 to n, from left to right. Initially, Ksusha stands in sector 1. Ksusha wants to walk to the end of the road, that is, get to sector n. Unfortunately, there are some rocks on the road. We know that Ksusha hates rocks, so she doesn't want to stand in sectors that have rocks.Ksusha the squirrel keeps fit. She can jump from sector i to any of the sectors i + 1, i + 2, ..., i + k. Help Ksusha! Given the road description, say if she can reach the end of the road (note, she cannot stand on a rock)?

The first line contains two integers n and k (2 ≤ n ≤ 3·105, 1 ≤ k ≤ 3·105). The next line contains n characters — the description of the road: the i-th character equals ".", if the i-th sector contains no rocks. Otherwise, it equals "#". It is guaranteed that the first and the last characters equal ".".

Print "YES" (without the quotes) if Ksusha can reach the end of the road, otherwise print "NO" (without the quotes).

import Data.List

solve _ i j [] = if (j == i - 1) then "YES" else "NO"
solve k i j (x:xs) = solve k (i+1) u xs
    where u = if j + k >= i && x == '.' then i else j

main = do
    p <- getLine
    r <- getLine
    let [n, k] = map read . words $ p in putStrLn $ solve k 0 0 r

import qualified Data.Set as S
import Data.List

f s = if S.null s then "NO" else "YES"
solve k (_:xs) = walk k 1 xs (S.singleton 0)

deleteLT k s
    | S.null s = s
    | otherwise = if (S.findMin s >= k) then s else deleteLT k . S.deleteMin $ s

walk _ _ []      s = s
walk k i (x:xs)  s = if S.null ds || x == '#' then walk k (i + 1) xs ds
                     else walk k (i + 1) xs (S.insert i ds)
    where ds = deleteLT (i - k) s

main = do
    p <- getLine
    r <- getLine
    let [n, k] = map read. words $ p in putStrLn $ f (solve k r)

import Control.Monad (liftM)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Int -> String -> Bool
solve k s  =  solve' k s
  where
    solve' _ ""  =  True
    solve' 0 _  =  False
    solve' k' (c:s)  =  if c == '.'
        then solve' k s
        else solve' (k' - 1) s

main :: IO ()
main  =  do
    [n, k]  <-  reads
    s  <-  getLine
    if solve k s
        then putStrLn "YES"
        else putStrLn "NO"

main::IO()
main = do
	input<-getLine
	s<-getLine
	let
		k=( map read (words input) ::[Int] ) !! 1
		cc = foldl (\(a,b) s -> if s=='#' then ((max a (b+1)),(b+1)) else (a,0)) (0,0) s
	putStrLn $ if (fst cc)>=k then "NO" else "YES"

import qualified Data.Set as S

f s = if S.null s then "NO" else "YES"
solve k r = fst $ walk k (k + 1) ((\x -> if x == [] then [] else init x) (drop (k + 1)  r)) $ preproc k 0 r
--solve k r = preproc k 0 $ r

preproc k i r
    | i == (k + 1) || r == [] = S.empty
    | otherwise = if head r == '.' then S.insert i next else next
    where next = preproc k (i + 1) $ tail r

deleteLE k s
    | S.null s = s
    | otherwise = if (S.findMin s > k) then s else deleteLE k . S.deleteMin $ s

walk k i r s = foldl proc (s, i) r
    where proc (s, i) x = (step s i x, i + 1)
          step s i x = if S.null s || x == '#' then (nx s i) else S.insert i (nx s i)
          nx   s i   = deleteLE (i - k) s

main = do
    p <- getLine
    r <- getLine
    --let [n, k] = map read . words $ p in putStrLn $ solve k r
    let [n, k] = map read . words $ p in putStrLn $ f (deleteLE (n - k - 1) (solve k r))

import qualified Data.Set as S

f s = if S.null s then "NO" else "YES"
solve k r = fst $ walk k (k + 1) ((\x -> if x == [] then [] else init x) (drop (k + 1)  r)) $ preproc k 0 r
--solve k r = preproc k 0 $ r

preproc k i r
    | i == (k + 1) || r == [] = S.empty
    | otherwise = if head r == '.' then S.insert i next else next
    where next = preproc k (i + 1) $ tail r

deleteLE k s
    | S.null s = s
    | otherwise = if (S.findMin s > k) then s else deleteLE k . S.deleteMin $ s

walk k i r s = foldl proc (s, i) r
    where proc (s, i) x = (step s i x, i + 1)
          step s i x = if S.null s || x == '#' then (nx s i) else S.insert i (nx s i)
          nx   s i   = deleteLE (i - k) s

main = do
    p <- getLine
    r <- getLine
    --let [n, k] = map read . words $ p in putStrLn $ solve k r
    let [n, k] = map read . words $ p in putStrLn $ f (solve k r)


Keshi is throwing a party and he wants everybody in the party to be happy.He has $$$n$$$ friends. His $$$i$$$-th friend has $$$i$$$ dollars. If you invite the $$$i$$$-th friend to the party, he will be happy only if at most $$$a_i$$$ people in the party are strictly richer than him and at most $$$b_i$$$ people are strictly poorer than him.Keshi wants to invite as many people as possible. Find the maximum number of people he can invite to the party so that every invited person would be happy.

The first line contains a single integer $$$t$$$ $$$(1\le t\le 10^4)$$$ — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ $$$(1\le n\le 2 \cdot 10^5)$$$ — the number of Keshi's friends. The $$$i$$$-th of the following $$$n$$$ lines contains two integers $$$a_i$$$ and $$$b_i$$$ $$$(0 \le a_i, b_i < n)$$$. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case print the maximum number of people Keshi can invite.

NoteIn the first test case, he invites the first and the second person. If he invites all of them, the third person won't be happy because there will be more than $$$1$$$ person poorer than him.

module Main (howManyCanInvite, FriendPreferences, main) where

import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = unfoldr (B.readInt . B.dropWhile isSpace)

module Main (howManyCanInvite, FriendPreferences, main) where

import Data.Char (isSpace)
import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as B

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = unfoldr (B.readInt . B.dropWhile isSpace)

module Main (howManyCanInvite, FriendPreferences, main) where

import Prelude

import Data.Char (isSpace)
import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as B

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = unfoldr (B.readInt . B.dropWhile isSpace)

module Main (howManyCanInvite, FriendPreferences, main) where

import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as B

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = map readInt . B.words

module Main (howManyCanInvite, FriendPreferences, main) where

import Prelude

import Data.Function ((&))
import Data.List (unfoldr)
import Data.Maybe (fromJust)

import qualified Data.ByteString.Char8 as B

type FriendPreferences = (Int, Int)

howManyCanInvite :: [FriendPreferences] -> Int
howManyCanInvite friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences
        max_invitations_n = binarySearch canInvite (0, friends_n)
        canInvite mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> [FriendPreferences] -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        invited_n = foldl updateInvitedN 0 friends_preferences
        result = invited_n >= target_friends_n

        updateInvitedN invited_before friend_preferences = new_invited_n
            where
                new_invited_n = invited_before & applyIf can_invite_current (+1)
                (l, r) = friend_preferences
                can_invite_current = invited_before <= l && invited_after <= r
                invited_after = target_friends_n - (invited_before + 1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

binarySearch :: (Integral i) => (i -> Bool) -> (i, i) -> i
binarySearch isEnough (l, r)
    | not (l <= r) = binarySearch isEnough (r, l)
    | l == r = mid
    | isEnough mid = binarySearch isEnough (mid, r)
    | otherwise = binarySearch isEnough (l, mid - 1)
    where mid = l + div (r - l + 1) 2

-- IO section

main :: IO ()
main = B.interact processInput

type ByteString = B.ByteString

processInput :: ByteString -> ByteString
processInput = B.unlines . map processTest . groupInputByTests

groupInputByTests :: ByteString -> [ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeTestLines
        takeTestLines [] = Nothing
        takeTestLines (t:ts) = Just $ splitAt (readInt t) ts

processTest :: ByteString -> ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map readInts (B.lines input)]
        max_invitations_n = howManyCanInvite friends_preferences
        output = B.pack $ show max_invitations_n

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

readInts :: ByteString -> [Int]
readInts = map readInt . B.words

import Prelude
import qualified Data.ByteString.Char8 as B

import Data.Maybe (fromJust)
import Data.Function ((&))

main :: IO ()
main = B.interact processInput

processInput :: B.ByteString -> B.ByteString
processInput = B.unlines . map processTest . parseTests

parseTests :: B.ByteString -> [B.ByteString]
parseTests input = tests
    where
        tests_lines = drop 1 $ B.lines input
        tests = parseLines tests_lines

        parseLines [] = []
        parseLines tests_lines = current_test : parseLines next_tests_lines
            where
                x : xs = tests_lines
                tests_n = readInt x
                (current_test_lines, next_tests_lines) = splitAt tests_n xs
                current_test = B.unlines current_test_lines

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

processTest :: B.ByteString -> B.ByteString
processTest input = output
    where
        friends_preferences = [(l, r) | [r, l] <- map (map readInt . B.words) (B.lines input)]
        max_invitations_n = findMaxInvitationsN friends_preferences
        output = B.pack $ show max_invitations_n

type PartyPreferences = [(Int, Int)]

findMaxInvitationsN :: PartyPreferences -> Int
findMaxInvitationsN friends_preferences = max_invitations_n
    where
        friends_n = length friends_preferences

        max_invitations_n = binarySearch 0 friends_n

        binarySearch l r
            | l == r = mid
            | can_invite_mid = binarySearch mid r
            | otherwise = binarySearch l (mid - 1)
            where
                mid = l + div (r - l + 1) 2
                can_invite_mid = canInviteSuchFriendsNumber mid friends_preferences

canInviteSuchFriendsNumber :: Int -> PartyPreferences -> Bool
canInviteSuchFriendsNumber target_friends_n friends_preferences = result
    where
        result = _canInvite friends_preferences 0

        _canInvite preferences invited_n =
            case preferences of
                [] -> invited_n >= target_friends_n
                (l, r) : next_preferences -> _canInvite next_preferences new_invited_n
                    where
                        invited_after = target_friends_n - (invited_n + 1)
                        can_take_current = invited_n <= l && invited_after <= r
                        new_invited_n = invited_n & applyIf can_take_current (+1)

applyIf :: Bool -> (a -> a) -> a -> a
applyIf predicate function = if predicate then function else id

--{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import System.IO

binarySearch :: Integral t => (t->Bool) -> t -> t -> t
binarySearch can lo hi   -- Assumption: f <$> [lo,hi] === [False,True]. Suggestion: Start with hi = n+1
  | lo + 1 == hi = lo
  | otherwise = if can mid then binarySearch can mid hi else binarySearch can lo mid
                where  mid = lo + (hi-lo) `div` 2

canFulfil :: [[Int]] -> Int  -> Int -> Bool
canFulfil _ _ 0 = True
canFulfil [] _ _ = False
canFulfil ([a,b]:rest) got need = canFulfil rest (got + this) (need - this)
  where this = fromEnum $ got<=b && need-1<=a

solve :: IO ()
solve = do
  ~[n] <- readv
  asbs <- CM.replicateM n readv
  let
    ans = binarySearch (canFulfil asbs 0) 1 (n+1)
  print ans

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat $  map (\x->DBB.intDec x <> DBB.char7 ' ') xs

readv :: IO [Int]
readv = map (maybe 0 fst . DBC.readInt) <$> (DBC.words <$> DBC.getLine)

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ nTc solve

--{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO
import Debug.Trace
import Data.Maybe (fromMaybe)

binarySearch :: Integral t => (t->Bool) -> t -> t -> t
binarySearch can lo hi   -- Assumption: f <$> [lo,hi] === [False,True]. Suggestion: Start with hi = n+1
  | lo + 1 == hi = lo
  | otherwise = if can mid then binarySearch can mid hi else binarySearch can lo mid
                where  mid = lo + (hi-lo) `div` 2

canFulfil :: [[Int]] -> Int  -> Int -> Bool
canFulfil _ _ 0 = True
canFulfil [] got need = False
canFulfil ([a,b]:rest) got need = canFulfil rest (got + this) (need - this)
  where this = fromEnum $ got<=b && need-1<=a

solve :: IO ()
solve = do
  ~[n] <- readv
  asbs <- CM.replicateM n readv
  let
    ans = binarySearch (canFulfil asbs 0) 1 (n+1)
  print ans

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: IO [Int]
readv = do
  bWords <- DBC.words <$> DBC.getLine
  let toInt x = fst $ fromMaybe (0,mempty) $ DBC.readInt x
  return $ toInt <$> bWords

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ nTc solve

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

solve :: IO ()
solve = do
    ~[n] <- readInts
    xys <- replicateM n readInts
    let inviteOk m = go xys m where
            go _  0 = True
            go [] _ = False
            go (~[x, y]:xys) m'
                | x >= m' - 1 && y >= m - m' = go xys (m' - 1)
                | otherwise                  = go xys m'
    print $ binSearch (not . inviteOk) 1 n - 1

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

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

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

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
import Data.Array.Unboxed

canUse :: Array Int (Int, Int) -> Int -> Bool
canUse arr k = let
  (1, n) = bounds arr
  go !i !lc !rc
    | i > n  = rc < 0
    | otherwise = let
        (ai, bi) = arr ! i
        in  if  lc <= bi && rc <= ai
            then  go (i + 1) (lc + 1) (rc - 1)
            else  go (i + 1) lc rc
  in  go 1 0 (k - 1)

binSearch :: (Int -> Bool) -> Int -> Int -> Int
{-# INLINE binSearch #-}
binSearch fun = let
  go !li !ri = if  li == ri
    then  li
    else  let
    mi = li + div (ri - li) 2
    in  if  fun mi
    then  go li mi
    else  go (mi + 1) ri
  in  go

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    abLi <- replicateM n $ do
      ~[ai, bi] <- getInts 2
      pure (ai, bi)
    let
      abs :: Array Int (Int, Int)
      abs = listArray (1, n) abLi
      ans = binSearch (not . canUse abs) 0 (n + 10) - 1
    pure $ putInts [ans]

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

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


In this problem you have to simulate the workflow of one-thread server. There are n queries to process, the i-th will be received at moment ti and needs to be processed for di units of time. All ti are guaranteed to be distinct.When a query appears server may react in three possible ways:   If server is free and query queue is empty, then server immediately starts to process this query.  If server is busy and there are less than b queries in the queue, then new query is added to the end of the queue.  If server is busy and there are already b queries pending in the queue, then new query is just rejected and will never be processed. As soon as server finished to process some query, it picks new one from the queue (if it's not empty, of course). If a new query comes at some moment x, and the server finishes to process another query at exactly the same moment, we consider that first query is picked from the queue and only then new query appears.For each query find the moment when the server will finish to process it or print -1 if this query will be rejected.

The first line of the input contains two integers n and b (1 ≤ n, b ≤ 200 000) — the number of queries and the maximum possible size of the query queue. Then follow n lines with queries descriptions (in chronological order). Each description consists of two integers ti and di (1 ≤ ti, di ≤ 109), where ti is the moment of time when the i-th query appears and di is the time server needs to process it. It is guaranteed that ti - 1 < ti for all i > 1.

Print the sequence of n integers e1, e2, ..., en, where ei is the moment the server will finish to process the i-th query (queries are numbered in the order they appear in the input) or  - 1 if the corresponding query will be rejected.

NoteConsider the first sample.   The server will start to process first query at the moment 2 and will finish to process it at the moment 11.  At the moment 4 second query appears and proceeds to the queue.  At the moment 10 third query appears. However, the server is still busy with query 1, b = 1 and there is already query 2 pending in the queue, so third query is just rejected.  At the moment 11 server will finish to process first query and will take the second query from the queue.  At the moment 15 fourth query appears. As the server is currently busy it proceeds to the queue.  At the moment 19 two events occur simultaneously: server finishes to proceed the second query and the fifth query appears. As was said in the statement above, first server will finish to process the second query, then it will pick the fourth query from the queue and only then will the fifth query appear. As the queue is empty fifth query is proceed there.  Server finishes to process query number 4 at the moment 21. Query number 5 is picked from the queue.  Server finishes to process query number 5 at the moment 22.

import Control.Monad
import Data.Int (Int64)
import Data.Sequence (Seq)
import qualified Data.ByteString.Char8 as C
import qualified Data.Sequence as Seq

gao :: [(Int, Int)] -> Int -> Int64 -> Seq Int64 -> [Int64]
gao [] _ _ _ = []
gao r@((t, d): r') b m q
  | not (Seq.null q) && t' <= fromIntegral t = gao r (b+1) m q'
  | b /= 0 = end: gao r' (b-1) end (q Seq.|> begin)
  | otherwise = (-1): gao r' b m q
  where
  begin = max m $ fromIntegral t
  end = begin + fromIntegral d
  t' Seq.:< q' = Seq.viewl q

main :: IO ()
main = do
  (n:b:_) <- fmap (map readInt . C.words) C.getLine
  r <- replicateM n $ do
    (t:d:_) <- fmap (map readInt . C.words) C.getLine
    return (t, d)
  let ans = gao r b 0 Seq.empty
  putStrLn $ unwords $ map show ans
  where
  readInt s = let Just (i, _) = C.readInt s in i

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative      ((<$>))
import           Control.Monad
import           Control.Monad.RWS.Strict
import           Data.Foldable            (toList)
import           Data.Sequence            (Seq, ViewL (..), (|>))
import qualified Data.Sequence            as Seq

type Index = Int
type Time = Integer
type Queue = Seq (Index, Time)
type Serve = (Time, Queue)
type Events a = RWS Int Queue Serve  a

dispatch::MonadWriter Queue m=>Int->Integer->m ()
dispatch = (tell.). (Seq.singleton.). (,)

rollout::(MonadWriter Queue m, MonadState Serve m)=>Maybe Time->m ()
rollout now = do
  (time, q) <- get
  let happen d = maybe True (>= time + d) now
  case Seq.viewl q of
    Seq.EmptyL -> case now of
      Nothing -> return ()
      Just time' -> put (time' ,q)
    (idx, duration) :< rest
      | happen duration -> do
        let time' = time + duration
        dispatch idx time'
        put (time', rest)
        rollout now
      | otherwise  -> return ()

handle::(MonadReader Int m, MonadWriter Queue m, MonadState Serve m)=>((Time,Time),Index)->m ()
handle ((time, duration), idx) = do
  rollout (Just time)
  b  <- ask
  (t', q') <- get
  if Seq.length q' > b then dispatch idx (-1)
  else put (t',  q' |> (idx, duration) )

walk::Int->[((Time,Time),Index)]->[Time]
walk b queries = let
  go = mapM_ handle queries >> rollout Nothing::Events ()
  res = snd $ execRWS go b (0, Seq.empty)
  in toList $ snd <$> Seq.sort res

readPair::Read a=>IO (a,a)
readPair = fmap (unlist . map read . words) getLine where
    unlist [x,y] = (x,y)
    unlist _     = error "trouble input"

main::IO ()
main = do
  (n,b) <- readPair
  nums <- replicateM n readPair
  let queries =  nums `zip` [1..]
  putStrLn $ unwords $ show <$> walk b queries

import Control.Monad
import Data.Int (Int64)
import Data.Sequence (Seq)
import qualified Data.ByteString.Char8 as C
import qualified Data.Sequence as Seq

gao :: [(Int, Int)] -> Int -> Int64 -> Seq Int64 -> [Int64]
gao [] _ _ _ = []
gao r@((t, d): r') b m q
  | not (Seq.null q) && t' <= fromIntegral t = gao r (b+1) m q'
  | b /= 0 = end: gao r' (b-1) end (begin Seq.<| q)
  | otherwise = (-1): gao r' b m q
  where
  begin = max m $ fromIntegral t
  end = begin + fromIntegral d
  t' Seq.:< q' = Seq.viewl q

main :: IO ()
main = do
  (n:b:_) <- fmap (map readInt . C.words) C.getLine
  r <- replicateM n $ do
    (t:d:_) <- fmap (map readInt . C.words) C.getLine
    return (t, d)
  let ans = gao r b 0 Seq.empty
  putStrLn $ unwords $ map show ans
  where
  readInt s = let Just (i, _) = C.readInt s in i

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

gao :: [(Int, Int)] -> Int -> Int -> Queue Int -> [Int]
gao [] _ _ _ = []
gao r@((t, d): r') b m q
  | q /= queue [] && t' <= t = gao r (b+1) m q'
  | b /= 0 = end: gao r' (b-1) end (push begin q)
  | otherwise = (-1): gao r' b m q
  where
  begin = max t m
  end = begin + d
  (t', q') = pop q

main :: IO ()
main = do
  (n:b:_) <- fmap (map readInt . C.words) C.getLine
  r <- replicateM n $ do
    (t:d:_) <- fmap (map readInt . C.words) C.getLine
    return (t, d)
  let ans = gao r b 0 $ queue []
  putStrLn $ unwords $ map show ans
  where
  readInt s = let Just (i, _) = C.readInt s in i

data Queue a = Queue [a] [a]
  deriving (Eq, Show)

queue :: [a] -> Queue a
queue = Queue []

push :: a -> Queue a -> Queue a
push a (Queue r q) = Queue (a:r) q

pop :: Queue a -> (a, Queue a)
pop (Queue r (a:q)) = (a, Queue r q)
pop (Queue r []) = pop $ Queue [] (reverse r)

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative ((<$>))
import           Control.Monad
import           Control.Monad.RWS.Strict
import           Data.Foldable       (toList)
import           Data.Sequence       (Seq, ViewL (..), (|>))
import qualified Data.Sequence       as Seq

type Queue = Seq (Int,Int)
type Serve = (Int, Queue)
type Events a = RWS Int Queue Serve  a

dispatch::MonadWriter Queue m=>Int->Int->m ()
dispatch = (tell.). (Seq.singleton.). (,)

rollout::(MonadWriter Queue m, MonadState Serve m)=>Maybe Int->m ()
rollout now = do
  (time,q) <- get
  let happen d = maybe True (>= time + d) now
  case Seq.viewl q of
    Seq.EmptyL -> case now of
      Nothing -> return ()
      Just time' -> put (time' ,q)
    (duration, idx) :< rest
      | happen duration -> do
        let time' = time + duration
        dispatch idx time'
        put (time', rest)
        rollout now
      | otherwise  -> return ()

handle::(MonadReader Int m, MonadWriter Queue m, MonadState Serve m)=>((Int,Int),Int)->m ()
handle ((time, duration), idx) = do
  rollout (Just time)
  b  <- ask
  (t', q') <- get
  if Seq.length q' > b then dispatch idx (-1)
  else put (t',  q' |> (duration, idx) )

walk::Int->[((Int,Int),Int)]->[Int]
walk b queries = let
  go = mapM_ handle queries >> rollout Nothing::Events ()
  res = snd $ execRWS go b (0, Seq.empty)
  in toList $ snd <$> Seq.sort res

main::IO ()
main = do
  let readPair = fmap (unlist . map read . words) getLine
      unlist [x,y] = (x,y)
      unlist _     = error "trouble input"
  (n,b) <- readPair
  nums <- replicateM n readPair
  let queries =  nums `zip` [1..]
  putStrLn $ unwords $ show <$> walk b queries


In 2013, the writers of Berland State University should prepare problems for n Olympiads. We will assume that the Olympiads are numbered with consecutive integers from 1 to n. For each Olympiad we know how many members of the jury must be involved in its preparation, as well as the time required to prepare the problems for her. Namely, the Olympiad number i should be prepared by pi people for ti days, the preparation for the Olympiad should be a continuous period of time and end exactly one day before the Olympiad. On the day of the Olympiad the juries who have prepared it, already do not work on it.For example, if the Olympiad is held on December 9th and the preparation takes 7 people and 6 days, all seven members of the jury will work on the problems of the Olympiad from December, 3rd to December, 8th (the jury members won't be working on the problems of this Olympiad on December 9th, that is, some of them can start preparing problems for some other Olympiad). And if the Olympiad is held on November 3rd and requires 5 days of training, the members of the jury will work from October 29th to November 2nd.In order not to overload the jury the following rule was introduced: one member of the jury can not work on the same day on the tasks for different Olympiads. Write a program that determines what the minimum number of people must be part of the jury so that all Olympiads could be prepared in time.

The first line contains integer n — the number of Olympiads in 2013 (1 ≤ n ≤ 100). Each of the following n lines contains four integers mi, di, pi and ti — the month and day of the Olympiad (given without leading zeroes), the needed number of the jury members and the time needed to prepare the i-th Olympiad (1 ≤ mi ≤ 12, di ≥ 1, 1 ≤ pi, ti ≤ 100), di doesn't exceed the number of days in month mi. The Olympiads are given in the arbitrary order. Several Olympiads can take place in one day. Use the modern (Gregorian) calendar in the solution. Note that all dates are given in the year 2013. This is not a leap year, so February has 28 days. Please note, the preparation of some Olympiad can start in 2012 year.

Print a single number — the minimum jury size.

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import System.IO
import Data.Array.Base
import Data.Array.IO (IOUArray)
import qualified Data.ByteString.Char8 as B
import Data.Function
import Data.List

readInt bs = case B.readInt bs of Just (n,_) -> n
getIntLn  handle = fmap (map readInt.B.words) $ B.hGetLine handle
getIntAll handle = fmap (map readInt.B.words) $ B.hGetContents handle

main = do
  hin  <- openFile "input.txt"  ReadMode
  hout <- openFile "output.txt" WriteMode

  n <- getIntLn hin
  xpts <- parse <$> getIntAll hin

  arr <- newArray (0,1000) 0 :: IO (IOUArray Int Int)

  forM_ xpts $ \ (x,p,t) -> do
    forM_ [x-t..x-1] $ \d -> do
      old <- unsafeRead arr d
      unsafeWrite arr d $ old + p

  mapM (unsafeRead arr) [0..1000] >>= hPrint hout . maximum

  hClose hin
  hClose hout

parse (m:d:p:t:rest) = (x,p,t) : parse rest
   where
     !x = 400 + d + [0,0,31,59,90,120,151,181,212,243,273,304,334,346] !! m
parse _ = []


You're given an array of $$$n$$$ integers between $$$0$$$ and $$$n$$$ inclusive.In one operation, you can choose any element of the array and replace it by the MEX of the elements of the array (which may change after the operation).For example, if the current array is $$$[0, 2, 2, 1, 4]$$$, you can choose the second element and replace it by the MEX of the present elements  — $$$3$$$. Array will become $$$[0, 3, 2, 1, 4]$$$.You must make the array non-decreasing, using at most $$$2n$$$ operations.It can be proven that it is always possible. Please note that you do not have to minimize the number of operations. If there are many solutions, you can print any of them. –An array $$$b[1 \ldots n]$$$ is non-decreasing if and only if $$$b_1 \le b_2 \le \ldots \le b_n$$$.The MEX (minimum excluded) of an array is the smallest non-negative integer that does not belong to the array. For instance:  The MEX of $$$[2, 2, 1]$$$ is $$$0$$$, because $$$0$$$ does not belong to the array.  The MEX of $$$[3, 1, 0, 1]$$$ is $$$2$$$, because $$$0$$$ and $$$1$$$ belong to the array, but $$$2$$$ does not.  The MEX of $$$[0, 3, 1, 2]$$$ is $$$4$$$ because $$$0$$$, $$$1$$$, $$$2$$$ and $$$3$$$ belong to the array, but $$$4$$$ does not. It's worth mentioning that the MEX of an array of length $$$n$$$ is always between $$$0$$$ and $$$n$$$ inclusive.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 200$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$3 \le n \le 1000$$$) — length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, \ldots, a_n$$$ ($$$0 \le a_i \le n$$$) — elements of the array. Note that they don't have to be distinct. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$1000$$$.

For each test case, you must output two lines: The first line must contain a single integer $$$k$$$ ($$$0 \le k \le 2n$$$)  — the number of operations you perform. The second line must contain $$$k$$$ integers $$$x_1, \ldots, x_k$$$ ($$$1 \le x_i \le n$$$), where $$$x_i$$$ is the index chosen for the $$$i$$$-th operation. If there are many solutions, you can find any of them. Please remember that it is not required to minimize $$$k$$$.

NoteIn the first test case, the array is already non-decreasing ($$$2 \le 2 \le 3$$$).Explanation of the second test case (the element modified by each operation is colored in red):   $$$a = [2, 1, 0]$$$ ; the initial MEX is $$$3$$$.  $$$a = [2, 1, \color{red}{3}]$$$ ; the new MEX is $$$0$$$.  $$$a = [\color{red}{0}, 1, 3]$$$ ; the new MEX is $$$2$$$.  The final array is non-decreasing: $$$0 \le 1 \le 3$$$. Explanation of the third test case:   $$$a = [0, 7, 3, 1, 3, 7, 7]$$$ ; the initial MEX is $$$2$$$.  $$$a = [0, \color{red}{2}, 3, 1, 3, 7, 7]$$$ ; the new MEX is $$$4$$$.  $$$a = [0, 2, 3, 1, \color{red}{4}, 7, 7]$$$ ; the new MEX is $$$5$$$.  $$$a = [0, 2, 3, 1, \color{red}{5}, 7, 7]$$$ ; the new MEX is $$$4$$$.  $$$a = [0, 2, 3, \color{red}{4}, 5, 7, 7]$$$ ; the new MEX is $$$1$$$.  The final array is non-decreasing: $$$0 \le 2 \le 3 \le 4 \le 5 \le 7 \le 7$$$.

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_: ns : rest) = (isstolines . solve . linetois) ns ++ tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: [Int] -> [[Int]]
solve ns = [[length ns'], ns'] where ns' = solve' ns

solve' :: [Int] -> [Int]
solve' ns | null $ diff [0..] ns = []
          | mex ns == length ns = (p+1) : (solve' $ update ns p (mex ns))
          | otherwise = (mex ns + 1) : (solve' $ update ns (mex ns) (mex ns)) where
  p = head $ diff [0..] ns
  diff as bs =  [x| (x,y)<- zip as bs, x/=y]
  mex ns = head $ diff [0..] $ ((map head).group.sort) ((maximum ns + 2):ns)
  update as pos val = [(if y==pos then val else x) | (x,y)<- zip as [0..]]

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_: ns : rest) = (isstolines . solve . linetois) ns ++ tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: [Int] -> [[Int]]
solve ns = [[length ns'], ns'] where ns' = solve' ns

solve' :: [Int] -> [Int]
solve' ns | null $ diff [0..] ns = []
          | mex ns == length ns = p : (solve' $ update ns p (mex ns))
          | otherwise = (mex ns + 1) : (solve' $ update ns (mex ns) (mex ns)) where
  p = head $ diff [0..] ns
  diff as bs =  [x| (x,y)<- zip as bs, x/=y]
  mex ns = head $ diff [0..] $ ((map head).group.sort) ((maximum ns + 2):ns)
  update as pos val = [(if y==pos then val else x) | (x,y)<- zip as [0..]]


You are given a string $$$s$$$ of length $$$n$$$ consisting of characters a and/or b.Let $$$\operatorname{AB}(s)$$$ be the number of occurrences of string ab in $$$s$$$ as a substring. Analogically, $$$\operatorname{BA}(s)$$$ is the number of occurrences of ba in $$$s$$$ as a substring.In one step, you can choose any index $$$i$$$ and replace $$$s_i$$$ with character a or b.What is the minimum number of steps you need to make to achieve $$$\operatorname{AB}(s) = \operatorname{BA}(s)$$$?Reminder:The number of occurrences of string $$$d$$$ in $$$s$$$ as substring is the number of indices $$$i$$$ ($$$1 \le i \le |s| - |d| + 1$$$) such that substring $$$s_i s_{i + 1} \dots s_{i + |d| - 1}$$$ is equal to $$$d$$$. For example, $$$\operatorname{AB}($$$aabbbabaa$$$) = 2$$$ since there are two indices $$$i$$$: $$$i = 2$$$ where aabbbabaa and $$$i = 6$$$ where aabbbabaa.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1000$$$). Description of the test cases follows. The first and only line of each test case contains a single string $$$s$$$ ($$$1 \le |s| \le 100$$$, where $$$|s|$$$ is the length of the string $$$s$$$), consisting only of characters a and/or b.

For each test case, print the resulting string $$$s$$$ with $$$\operatorname{AB}(s) = \operatorname{BA}(s)$$$ you'll get making the minimum number of steps. If there are multiple answers, print any of them.

NoteIn the first test case, both $$$\operatorname{AB}(s) = 0$$$ and $$$\operatorname{BA}(s) = 0$$$ (there are no occurrences of ab (ba) in b), so can leave $$$s$$$ untouched.In the second test case, $$$\operatorname{AB}(s) = 2$$$ and $$$\operatorname{BA}(s) = 2$$$, so you can leave $$$s$$$ untouched. In the third test case, $$$\operatorname{AB}(s) = 1$$$ and $$$\operatorname{BA}(s) = 0$$$. For example, we can change $$$s_1$$$ to b and make both values zero.In the fourth test case, $$$\operatorname{AB}(s) = 2$$$ and $$$\operatorname{BA}(s) = 1$$$. For example, we can change $$$s_6$$$ to a and make both values equal to $$$1$$$.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
--import Data.Array.Unboxed

prefMins :: Ord t => (a -> t) -> [a] -> [t]
prefMins f li = tail $ scanl' min (f $ head li) $ map f li

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[s] <- map P.unpack <$> getNext 1
    let
      t = (if ((head s) == 'a') then "b" else "a") ++ (tail s)
    pure $ string7 $ (if ((head s) == (last s)) then s else t) ++ "\n"

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

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

main :: IO ()
main = interact solve

solve :: String -> String
solve = foldl (++) "". map (++ "\n") . map str_solve . tail . lines

str_solve :: String -> String
str_solve s = if (head $ s) /= (last $ s) then (last $ s) : (tail s) else s

import Control.Monad

aba :: String -> Int -> Int -> (Int, Int)
aba [] ab ba = (ab, ba)
aba [a] ab ba = (ab, ba)
aba ('a':'b':xs) ab ba = aba ('b':xs) (ab+1) ba
aba ('b':'a':xs) ab ba = aba ('a':xs) ab (ba+1)
aba (x:xs) ab ba = aba xs ab ba

calc :: String -> String
calc line =
  let (ab,ba) = aba line 0 0 in
    if ab==ba then line
    else
      case line of
        ('b':'b':xs) -> if ab < ba then ('a':'b':xs) else ('b':'a':xs)
        ('a':'a':xs) -> if ab < ba then ('a':'b':xs) else ('b':'a':xs)
        ('a':'b':xs) -> ('b':'b':xs)
        ('b':'a':xs) -> ('a':'a':xs)

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    --print $ aba line 0 0
    putStrLn $ calc line

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

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

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC { s :: String }

input :: Scanner TC
input = do
  s <- str
  return TC {..}

-- type Output = String

-- output :: Output -> C.ByteString
output = C.pack

-- solve :: TC -> Output
solve TC {..} = last s : tail s

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

{-# LANGUAGE BangPatterns #-}

import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as C (getLine, readInt, words)
import Data.List (foldl', sort)
import Data.Maybe (fromJust)

main :: IO ()
main = do
  [t] <- readInts
  replicateM_ t $ do
      s <- getLine
      putStrLn $ solve s

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

solve :: [a] -> [a]
solve (a:as)
    | null as = [a]
    | otherwise = last as:as


The main city magazine offers its readers an opportunity to publish their ads. The format of the ad should be like this:There are space-separated non-empty words of lowercase and uppercase Latin letters.There are hyphen characters '-' in some words, their positions set word wrapping points. Word can include more than one hyphen. It is guaranteed that there are no adjacent spaces and no adjacent hyphens. No hyphen is adjacent to space. There are no spaces and no hyphens before the first word and after the last word. When the word is wrapped, the part of the word before hyphen and the hyphen itself stay on current line and the next part of the word is put on the next line. You can also put line break between two words, in that case the space stays on current line. Check notes for better understanding.The ad can occupy no more that k lines and should have minimal width. The width of the ad is the maximal length of string (letters, spaces and hyphens are counted) in it.You should write a program that will find minimal width of the ad.

The first line contains number k (1 ≤ k ≤ 105). The second line contains the text of the ad — non-empty space-separated words of lowercase and uppercase Latin letters and hyphens. Total length of the ad don't exceed 106 characters.

NoteHere all spaces are replaced with dots.In the first example one of possible results after all word wraps looks like this:garage.for.sa-leThe second example:Edu-ca-tion-al.Ro-unds.are.so.fun

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

main = do
  k <- fmap readInt B.getLine
  s <- fmap (B.filter (/= '\r')) B.getLine
  print $ solve k s

solve k s = go 1 (B.length s)
  where
    cmp m = maybe GT ((`compare` k) . snd) $ foldM (\(!cll, !lc) wl -> if wl > m then Nothing else let cll' = cll + wl in Just $ if cll' > m then (wl, lc + 1) else (cll', lc)) (0, 0) wls
    wls = go $ B.splitWith (\c -> c == ' ' || c == '-') s
      where
        go [l] = [B.length l]
        go (l:ls) = (B.length l + 1):go ls
    go l r
      | l >= r = l
      | otherwise = case cmp m of
          LT -> go l m
          _ -> go (m + 1) r
      where m = (l + r) `div` 2

chunks n = takeWhile (not . null) . map (take n) . iterate (drop n)

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

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words, reverse, dropWhile, unpack)
import qualified Data.Maybe as M (fromJust)
import Data.Char (isSpace)

readInt = fst . M.fromJust . C.readInt
rstrip = C.reverse . C.dropWhile isSpace . C.reverse

split (x:xs) cp ans | x == ' ' || x == '-' = split xs [] (length (x:cp):ans)
                    | otherwise = split xs (x:cp) ans
split [] cp ans = reverse (length cp:ans)

test (x:xs) w c ans | x + c > w = test (x:xs) w 0 (ans + 1) | otherwise = test xs w (x + c) ans
test [] _ _ ans = ans + 1

run xs a b k | a + 1 == b = b
             | m >= mxs && test xs m 0 0 <= k = run xs a m k
             | otherwise = run xs m b k where
    m = (a + b) `div` 2
    mxs = maximum xs

main = do
    (readInt -> k) <- B.getLine
    (C.unpack . rstrip -> x) <- B.getLine
    putStrLn $ show $ run (split x [] []) 0 (length x) k

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

main = do
  k <- fmap readInt B.getLine
  s <- fmap (B.filter (/= '\r')) B.getLine
  print $ solve k s

solve k s
  | r == 0 = maximum $ map sum $ chunks q ls
  | q == 0 = maximum ls
  | otherwise = minimum $ map (\b -> let (h, t) = splitAt b ls; (h', t') = splitAt (q + r) t in maximum $ map sum $ chunks q h ++ [h'] ++ chunks q t') [0,q..nw - q - r]
  where
    nw = length ls
    ls = go $ B.splitWith (\c -> c == ' ' || c == '-') s
      where
        go [l] = [B.length l]
        go (l:ls) = (B.length l + 1):go ls
    (q, r) = nw `quotRem` k

chunks n = takeWhile (not . null) . map (take n) . iterate (drop n)

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


Furlo and Rublo play a game. The table has n piles of coins lying on it, the i-th pile has ai coins. Furlo and Rublo move in turns, Furlo moves first. In one move you are allowed to:  choose some pile, let's denote the current number of coins in it as x;  choose some integer y (0 ≤ y < x; x1 / 4 ≤ y ≤ x1 / 2) and decrease the number of coins in this pile to y. In other words, after the described move the pile will have y coins left. The player who can't make a move, loses. Your task is to find out, who wins in the given game if both Furlo and Rublo play optimally well.

The first line contains integer n (1 ≤ n ≤ 77777) — the number of piles. The next line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 777777777777) — the sizes of piles. The numbers are separated by single spaces. Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

If both players play optimally well and Furlo wins, print "Furlo", otherwise print "Rublo". Print the answers without the quotes.

import Data.Bits
f::Integer -> Int
f x | x < 4  = 0
    | x < 16 = 1
    | x <= 81  = 2
    | x < 82^2 = 0
    | x <= 15^4  = 3
    | x < 50626^2 = 1
    | otherwise   = 2
solve l = if (0==) . foldr1 xor . map f $ l then "Rublo" else "Furlo"
main = interact $ solve . map read . tail . words


Xenia the mathematician has a sequence consisting of n (n is divisible by 3) positive integers, each of them is at most 7. She wants to split the sequence into groups of three so that for each group of three a, b, c the following conditions held:  a < b < c;  a divides b, b divides c. Naturally, Xenia wants each element of the sequence to belong to exactly one group of three. Thus, if the required partition exists, then it has  groups of three.Help Xenia, find the required partition or else say that it doesn't exist.

The first line contains integer n (3 ≤ n ≤ 99999) — the number of elements in the sequence. The next line contains n positive integers, each of them is at most 7. It is guaranteed that n is divisible by 3.

If the required partition exists, print  groups of three. Print each group as values of the elements it contains. You should print values in increasing order. Separate the groups and integers in groups by whitespaces. If there are multiple solutions, you can print any of them. If there is no solution, print -1.

import Control.Applicative
import Data.List
main :: IO ()
main = getLine >> map read <$> words <$> getLine >>= putStr . solve

solve :: [Int] -> String
solve xs
    | cnt !! 2 >= cnt !! 4 &&
      cnt !! 1 == cnt !! 4 + cnt !! 6 &&
      cnt !! 2 + cnt !! 3 == cnt !! 4 + cnt !! 6 &&
      cnt !! 5 == 0 &&
      cnt !! 7 == 0 = answer
    | otherwise = "-1\n"
    where
        -- cnt !! i = the number of times i shows up
        cnt = map (subtract 1 . length) $ group $ sort $ [0, 1, 2, 3, 4, 5, 6, 7] ++ xs
        answer = concat $
                replicate (cnt !! 3) "1 3 6\n" ++
                replicate (cnt !! 6 - cnt !! 3) "1 2 6\n" ++
                replicate (cnt !! 4) "1 2 4\n"

{-# OPTIONS_GHC -O2 -Wall -fno-warn-missing-signatures -fno-warn-type-defaults #-}
{-# LANGUAGE ViewPatterns #-}
import Data.List(transpose)

main=interact $ unlines.sv.(!!1).lines
sv (words->xs)
  | x>=0 && y>=0 && z>=0 && x+y+z==a1 && x+y==a2 && z==a3 && x==a4 && 0==a5 && y+z==a6 && 0==a7 = replicate x "1 2 4" ++ replicate y "1 2 6" ++ replicate z "1 3 6"
  | otherwise = ["-1"]
  where
    (a1:a2:a3:a4:a5:a6:a7:_)= foldr (\a as -> ( length.filter (==a)) xs :as) [] (transpose [['1'..'7']])
    x = a1-a6
    z = a1-a2
    y = a6-a3

import Control.Monad(liftM, forM, forM_)
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe(fromJust)

data StateT s x = State (s -> (s, x))
ffunc (State f) = f
instance (Monad (StateT s)) where
--	return :: (StateT s) a => a -> (StateT s) a
	return x = State (\a -> (a, x))
	(State f1) >> (State f2) = State $ \s -> f2 $ fst (f1 s)
	(State f1) >>= b = State $ \s -> let (st, val) = f1 s in ffunc (b val) st

getf f = State (\s -> (s, f s))
--put x = State \s -> (s, x)
mmap f = State (\s -> (f s, ()))
modf f 0 (x:xs) = (f x):xs
modf f i (x:xs) = x:(modf f (i - 1) xs)

pprint [] = return ()
pprint ([a, b, c]:ls) = B.putStrLn ( B.pack (show a ++ " " ++ show b ++ " " ++ show c)) >> pprint ls

readi = fst . fromJust . B.readInt

rev3 = concat . map (concat . map concat)

solve a = if maximum st == 0 then rev3 val else []
	where
		(st, val) = (ffunc zz) (map ((flip count) a) [0..7])
		count x = length . (filter (==x))
		check xs = do
			as <- minimum `liftM` forM [1..7] (\x -> do
					bs <- getf (!!x)
					return $ let as = count x xs in if as == 0 then 10^9 else div bs as)
			forM_ xs (\x -> mmap $ modf (+(-as)) x)
			return $ replicate as xs
		zz = do
			forM [7,6..1] (\i -> do
				forM (filter ((==0).(mod i)) [i-1,(i-2)..1]) (\j-> do
					forM (filter ((==0).(mod j)) [j-1,(j-2)..1]) (\k -> do
						check [k, j, i] >>= return)))

main = do
	n <- readi `liftM` B.getLine
	a <- (map readi . B.words) `liftM` B.getLine
	let as = solve a in if as == [] then putStr "-1" else pprint $ solve a

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

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

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

main = do
  n <- readLn
  xs <- getInts

  let
    cs = accumArray (+) 0 (1, 7) $ zip xs $ repeat 1 :: UArray Int Int
    n' = n `div` 3

    ls = replicate (cs!4) [1, 2, 4] ++
      replicate (cs!6 - cs!3) [1, 2, 6] ++
      replicate (cs!3) [1, 3, 6]

  putStrLn $
    if cs!1 == n' && (cs!2 + cs!3 == n') && (cs!4 + cs!6 == n') && cs!3 <= cs!6 && cs!5 == 0 && cs!7 == 0
      then unlines $ map (unwords . map show) ls
      else show $ -1

--  342A

import Control.Monad (liftM, replicateM_)
import Prelude hiding (print, reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Int -> [Int] -> Maybe (Int, Int, Int)
solve n as
  | solveIsExists  =  Just (a, b, c)
  | otherwise  =  Nothing
  where
    z i  =  length $ filter (== i) as
    a  =  z 4
    b  =  z 2 - a
    c  =  z 3
    solveIsExists
      =  b >= 0
      && z 1 == n
      && z 1 == a + b + c
      && z 5 == 0
      && z 6 == b + c
      && z 7 == 0

print :: Maybe (Int, Int, Int) -> IO ()
print Nothing  =  putStrLn "-1"
print (Just (a, b, c))  =  do
    replicateM_ a $ putStrLn "1 2 4"
    replicateM_ b $ putStrLn "1 2 6"
    replicateM_ c $ putStrLn "1 3 6"

main :: IO ()
main  =  do
    n  <-  liftM (\m -> div m 3) readLn
    as  <-  reads
    print $ solve n as

{-
1 2 4  -  a
1 2 6  -  b
1 3 6  -  c

a+b+c  =  z1  =  n
a+b    =  z2
    c  =  z3
a      =  z4
  0    =  z5
  b+c  =  z6
  0    =  z7
-}

import Prelude
import Data.String
import Text.Printf
import Control.Monad

readNums:: Int -> [Int] -> IO [Int]
readNums 0 numbers = return numbers
readNums n numbers = do
                        c <- getChar
                        if (c /= ' ')
                            then
                                readNums (n - 1) ((read [c] :: Int):numbers)
                            else
                                readNums n numbers

solver:: Int -> Int -> Int -> Int -> Int -> Int -> IO [Int]
solver 0 c1 c2 c3 c4 c6 = return [c1, c2, c3, c4, c6]
solver n c1 c2 c3 c4 c6 = do
                            c <- getChar
                            if (c /= ' ')
                                then
                                    case read [c] :: Int of
                                        1 -> solver (n - 1) (c1 + 1) c2 c3 c4 c6
                                        2 -> solver (n - 1) c1 (c2 + 1) c3 c4 c6
                                        3 -> solver (n - 1) c1 c2 (c3 + 1) c4 c6
                                        4 -> solver (n - 1) c1 c2 c3 (c4 + 1) c6
                                        6 -> solver (n - 1) c1 c2 c3 c4 (c6 + 1)
                                        _ -> return [0, 0, 0, 0, 0]
                                else
                                    solver n c1 c2 c3 c4 c6

printAnswer:: Int -> Int -> Int -> Int -> Int -> String
printAnswer 0 0 0 0 0 = "\n"
printAnswer c1 c2  0 c4  0 = "1 2 4\n" ++ printAnswer (c1 - 1) (c2 - 1)  0 (c4 - 1)  0
printAnswer c1 c2  0 c4 c6 = "1 2 6\n" ++ printAnswer (c1 - 1) (c2 - 1)  0 c4 (c6 - 1)
printAnswer c1 c2 c3 c4 c6 = "1 3 6\n" ++ printAnswer (c1 - 1) c2 (c3 - 1) c4 (c6 - 1)

main = do
        str <- getLine
        let n = read str :: Int
        [c1, c2, c3, c4, c6] <- solver n 0 0 0 0 0
        if ((c1 /= 0) && (c3 <= c6) && (c2 == (c4 + c6 - c3)) && (c1 == (c2 + c3)))
            then
                printf (printAnswer c1 c2 c3 c4 c6)
            else
                printf "-1"
        return ()

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Array.Base
import Data.Array.ST (runSTUArray)

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main :: IO ()
main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  maybe (print $ -1) (putStr.unlines.map(unwords.map show)) $ solve n xs

solve :: Int -> [Int] -> Maybe [[Int]]
solve n xs
  | cnt5>0 || cnt7>0 = Nothing
  | cnt1-cnt3-cnt4 == cnt2-cnt4 && cnt2-cnt4==cnt6-cnt3 && cnt2-cnt4>=0 = Just $ replicate cnt4 [1,2,4] ++ replicate (cnt2-cnt4) [1,2,6] ++ replicate cnt3 [1,3,6]
  | otherwise = Nothing
   where
     [cnt1,cnt2,cnt3,cnt4,cnt5,cnt6,cnt7] = map (unsafeAt cnt) [1..7]
     cnt = runSTUArray $ do
       arr <- newArray (0,10) 0 :: ST s (STUArray s Int Int)
       forM_ xs $ \x -> do
         unsafeRead arr x>>=unsafeWrite arr x.(1+)
       return arr

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char
import Data.Ratio
import qualified Data.ByteString.Char8 as BS

getInteger = (\(Just (x,_)) -> x). BS.readInteger
getInt = (\(Just (x,_)) -> x). BS.readInt

filter' func = foldl' (\acc x -> if func x then x:acc else acc) []
map' func = foldl' (\acc x -> func x: acc) []

solve [] = (0, 0, 0, 0, 0)
solve (x:xs)
  | x == 1 = (a+1, b, c, d, e)
  | x == 2 = (a, b+1, c, d, e)
  | x == 3 = (a, b, c+1, d, e)
  | x == 4 = (a, b, c, d+1, e)
  | x == 6 = (a, b, c, d, e+1)
  | otherwise = (0, 0, 0, 0, 0)
    where
      (a, b, c, d, e) = solve xs

solution (0, 0, 0, 0, 0) = []
solution (a, b, c, d, e)
  | a > 0 && b > 0 && d > 0 = (1, 2, 4):solution (a-1, b-1, c, d-1, e)
  | a > 0 && b > 0 && e > 0 = (1, 2, 6) : solution (a-1, b-1, c, d, e-1)
  | a > 0 && c > 0 && e > 0 = (1, 3, 6) : solution (a-1, b, c-1, d, e-1)
  | otherwise = []

main :: IO ()
main = do
  _n <- BS.getLine
  _arr <- BS.getLine
  let
    n = getInt _n
    arr = solution. solve. map' getInt. BS.words $ _arr
  if length arr /= n`div` 3 then print (-1) else (mapM_ (\(a, b, c) -> putStrLn $ (show a) ++ " "++ (show b) ++ " " ++ (show c)) arr)

import Control.Applicative
import Data.List
main :: IO ()
main = getLine >> map read <$> words <$> getLine >>= putStr . solve

solve :: [Int] -> String
solve xs
    | cnt !! 2 >= cnt !! 4 &&
      cnt !! 1 == cnt !! 4 + cnt !! 6 &&
      cnt !! 2 + cnt !! 3 == cnt !! 4 + cnt !! 6 = answer
    | otherwise = "-1\n"
    where
        -- cnt !! i = the number of times i shows up
        cnt = map (subtract 1 . length) $ group $ sort $ [0, 1, 2, 3, 4, 5, 6] ++ xs
        answer = concat $
                replicate (cnt !! 3) "1 3 6\n" ++
                replicate (cnt !! 6 - cnt !! 3) "1 2 6\n" ++
                replicate (cnt !! 4) "1 2 4\n"

{-# OPTIONS_GHC -O2 -Wall -fno-warn-missing-signatures -fno-warn-type-defaults #-}
{-# LANGUAGE ViewPatterns #-}
import Data.List(transpose)

main=interact $ unlines.sv.(!!1).lines
sv (words->xs)
  | x+y+z==a1 && x+y==a2 && z==a3 && x==a4 && 0==a5 && y+z==a6 && 0==a7 = replicate x "1 2 4" ++ replicate y "1 2 6" ++ replicate z "1 3 6"
  | otherwise = ["-1"]
  where
    (a1:a2:a3:a4:a5:a6:a7:_)=foldr (\a as -> ( length.filter (==a)) xs :as) [] (transpose [['1'..'7']])
    x = a1-a6
    z = a1-a2
    y = a6-a3

{-# OPTIONS_GHC -O2 -Wall -fno-warn-missing-signatures -fno-warn-type-defaults #-}
{-# LANGUAGE ViewPatterns #-}
import Data.List(transpose)

main=interact $ unlines.sv.(!!1).lines
sv (words->xs)
  | x==a4 && z==a3 && a5==0 && a7==0 = replicate x "1 2 4" ++ replicate y "1 2 6" ++ replicate z "1 3 6"
  | otherwise = ["-1"]
  where
    (a1:a2:a3:a4:a5:a6:a7:_)=foldr (\a as -> ( length.filter (==a)) xs :as) [] (transpose [['1'..'7']])
    x = a1-a6
    z = a1-a2
    y = a6-a3

import Control.Monad(liftM)

main = do
    n <- (read :: [Char] -> Int) `liftM` getLine
    putStr $ show $ n

import Prelude
import Data.String
import Text.Printf
import Control.Monad

solver (x:xs) c1 c2 c3 c4 c6 = case x of
                                    1 -> solver xs (c1+1) c2 c3 c4 c6
                                    2 -> solver xs c1 (c1+2) c3 c4 c6
                                    3 -> solver xs c1 c2 (c3+1) c4 c6
                                    4 -> solver xs c1 c2 c3 (c4+1) c6
                                    6 -> solver xs c1 c2 c3 c4 (c6+1)
                                    _ -> solver xs c1 c2 c3 c4 c6

solver [] c1 c2 c3 c4 c6 = [c1, c2, c3, c4, c6]

printAnswer str 0 0 0 0 0 = (putStr str)
printAnswer str c1 c2  0 c4  0 = printAnswer (str ++ "1 2 4\n") (c1-1) (c2-1) 0 (c4-1) 0
printAnswer str c1 c2  0 c4 c6 = printAnswer (str ++ "1 2 6\n") (c1-1) (c2-1) 0  c4 (c6-1)
printAnswer str c1 c2 c3 c4 c6 = printAnswer (str ++ "1 3 6\n") (c1-1) c2 (c3-1) c4 (c6-1)

main = do
        str1 <- getLine
        str2 <- getLine
        let n = read str1 :: Int
        let numbers = map (\x -> read x :: Int) $ words str2
        let [c1, c2, c3, c4, c6] = solver numbers 0 0 0 0 0
        result <- if ((c1 == (div n 3))&&(c3 <= c6)&&(c2 == (c4 + c6 - c3)))
                        then printAnswer "" c1 c2 c3 c4 c6
                        else putStr "-1\n"
        return ()

import Prelude
import Data.String
import Text.Printf
import Control.Monad

solver (x:xs) c1 c2 c3 c4 c6 = case x of
                                    1 -> solver xs (c1+1) c2 c3 c4 c6
                                    2 -> solver xs c1 (c1+2) c3 c4 c6
                                    3 -> solver xs c1 c2 (c3+1) c4 c6
                                    4 -> solver xs c1 c2 c3 (c4+1) c6
                                    6 -> solver xs c1 c2 c3 c4 (c6+1)
                                    _ -> solver xs c1 c2 c3 c4 c6

solver [] c1 c2 c3 c4 c6 = [c1, c2, c3, c4, c6]

printAnswer str 0 0 0 0 0 = (putStr str)
printAnswer str c1 c2  0 c4  0 = printAnswer (str ++ "1 2 4\n") (c1-1) (c2-1) 0 (c4-1) 0
printAnswer str c1 c2  0 c4 c6 = printAnswer (str ++ "1 2 6\n") (c1-1) (c2-1) 0  c4 (c6-1)
printAnswer str c1 c2 c3 c4 c6 = printAnswer (str ++ "1 3 6\n") (c1-1) c2 (c3-1) c4 (c6-1)

main = do
        str1 <- getLine
        str2 <- getLine
        let n = read str1 :: Int
        let numbers = map (\x -> read x :: Int) $ words str2
        let [c1, c2, c3, c4, c6] = solver numbers 0 0 0 0 0
        result <- if ((c1 == (c2 + c3))&&(c3 <= c6)&&(c2 == (c4 + c6 - c3))&&(c1 /= 0))
                        then printAnswer "" c1 c2 c3 c4 c6
                        else putStr "-1\n"
        return ()

import Prelude
import Data.String
import Text.Printf
import Control.Monad

solver (x:xs) c1 c2 c3 c4 c6 = case x of
                                    1 -> solver xs (c1+1) c2 c3 c4 c6
                                    2 -> solver xs c1 (c1+2) c3 c4 c6
                                    3 -> solver xs c1 c2 (c3+1) c4 c6
                                    4 -> solver xs c1 c2 c3 (c4+1) c6
                                    6 -> solver xs c1 c2 c3 c4 (c6+1)
                                    _ -> solver xs c1 c2 c3 c4 c6

solver [] c1 c2 c3 c4 c6 = [c1, c2, c3, c4, c6]

printAnswer str 0 0 0 0 0 = (putStr str)
printAnswer str c1 c2  0 c4  0 = printAnswer (str ++ "1 2 4\n") (c1-1) (c2-1) 0 (c4-1) 0
printAnswer str c1 c2  0 c4 c6 = printAnswer (str ++ "1 2 6\n") (c1-1) (c2-1) 0  c4 (c6-1)
printAnswer str c1 c2 c3 c4 c6 = printAnswer (str ++ "1 3 6\n") (c1-1) c2 (c3-1) c4 (c6-1)

main = do
        str1 <- getLine
        str2 <- getLine
        let n = read str1 :: Int
        let numbers = map (\x -> read x :: Int) $ words str2
        let [c1, c2, c3, c4, c6] = solver numbers 0 0 0 0 0
        result <- if ((c1 == (c2 + c3))&&(c3 <= c6)&&(c2 == (c4 + c6 - c3)))
                        then printAnswer "" c1 c2 c3 c4 c6
                        else putStr "-1\n"
        return ()

import Prelude
import Data.String
import Text.Printf
import Control.Monad

solver (x:xs) c1 c2 c3 c4 c6 = case x of
                                    1 -> solver xs (c1+1) c2 c3 c4 c6
                                    2 -> solver xs c1 (c2+1) c3 c4 c6
                                    3 -> solver xs c1 c2 (c3+1) c4 c6
                                    4 -> solver xs c1 c2 c3 (c4+1) c6
                                    6 -> solver xs c1 c2 c3 c4 (c6+1)
                                    _ -> solver xs c1 c2 c3 c4 c6

solver [] c1 c2 c3 c4 c6 = [c1, c2, c3, c4, c6]

printAnswer str 0 0 0 0 0 = (putStr str)
printAnswer str c1 c2  0 c4  0 = printAnswer (str ++ "1 2 4\n") (c1-1) (c2-1) 0 (c4-1) 0
printAnswer str c1 c2  0 c4 c6 = printAnswer (str ++ "1 2 6\n") (c1-1) (c2-1) 0  c4 (c6-1)
printAnswer str c1 c2 c3 c4 c6 = printAnswer (str ++ "1 3 6\n") (c1-1) c2 (c3-1) c4 (c6-1)

main = do
        str1 <- getLine
        str2 <- getLine
        let n = read str1 :: Int
        let numbers = map (\x -> read x :: Int) $ words str2
        let [c1, c2, c3, c4, c6] = solver numbers 0 0 0 0 0
        print [c1, c2, c3, c4, c6]
        result <- if ((c1 == (c2 + c3))&&(c3 <= c6)&&(c2 == (c4 + c6 - c3))&&(c1 /= 0))
                        then printAnswer "" c1 c2 c3 c4 c6
                        else putStr "-1\n"
        return ()


Cat Noku has obtained a map of the night sky. On this map, he found a constellation with n stars numbered from 1 to n. For each i, the i-th star is located at coordinates (xi, yi). No two stars are located at the same position.In the evening Noku is going to take a look at the night sky. He would like to find three distinct stars and form a triangle. The triangle must have positive area. In addition, all other stars must lie strictly outside of this triangle. He is having trouble finding the answer and would like your help. Your job is to find the indices of three stars that would form a triangle that satisfies all the conditions. It is guaranteed that there is no line such that all stars lie on that line. It can be proven that if the previous condition is satisfied, there exists a solution to this problem.

The first line of the input contains a single integer n (3 ≤ n ≤ 100 000). Each of the next n lines contains two integers xi and yi ( - 109 ≤ xi, yi ≤ 109). It is guaranteed that no two stars lie at the same point, and there does not exist a line such that all stars lie on that line.

Print three distinct integers on a single line — the indices of the three points that form a triangle that satisfies the conditions stated in the problem. If there are multiple possible answers, you may print any of them.

NoteIn the first sample, we can print the three indices in any order.In the second sample, we have the following picture.   Note that the triangle formed by starts 1, 4 and 3 doesn't satisfy the conditions stated in the problem, as point 5 is not strictly outside of this triangle (it lies on it's border).

import Data.Int (Int64)
import Data.Monoid (mappend)
import Data.Maybe (fromJust)
import Data.List (minimumBy, sortBy)
import qualified Data.ByteString.Char8 as B

data Point = Point Int64 Int64 Int deriving (Eq)

getId (Point _ _ id) = id

diff (Point x1 y1 id1) (Point x2 y2 _) = Point (x1 - x2) (y1 - y2) id1

vecProd (Point x1 y1 _) (Point x2 y2 _) = x1 * y2 - x2 * y1

len2 (Point x y _) = x * x + y * y

cmpAngle p1 p2 = (compare (vecProd p1 p2) 0) `mappend` compare (len2 p1) (len2 p2)

cmpCoords (Point x1 y1 _) (Point x2 y2 _) = compare x1 x2 `mappend` compare y1 y2

leftAndRest ps = (p0, sortBy cmpAngle $ map (flip diff $ p0) (filter (/= p0) ps))
    where p0 = minimumBy cmpCoords ps

firstNonColinear ps = head $ (filter (\p -> p `vecProd` (head ps) /= 0) ps)

solve ps = (getId p0, getId $ head rest, getId $ firstNonColinear rest)
    where (p0, rest) = leftAndRest ps

makePoints coords = map (\(i, (x, y)) -> Point x y i) $ zip [1..n] coords
    where n = length coords

getInt = fromIntegral . fst . fromJust . B.readInt

getCoords line = (getInt x, getInt y)
    where [x, y] = B.words line

main = do
    input <- B.getContents
    let (line:lines) = B.lines input
    let points = makePoints $ map getCoords lines
    let (i0, i1, i2) = solve points
    putStrLn $ show i0 ++ " " ++ show i1 ++ " " ++ show i2

import Data.Int (Int64)
import Data.Monoid (mappend)
import Data.List (minimumBy, sortBy)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

data Point = Point Int64 Int64 Int deriving (Show)

getId (Point _ _ id) = id

instance Eq Point where
    (Point x1 y1 _) == (Point x2 y2 _) = x1 == x2 && y1 == y2

diff (Point x1 y1 id1) (Point x2 y2 _) = Point (x1 - x2) (y1 - y2) id1

vecProd (Point x1 y1 _) (Point x2 y2 _) = x1 * y2 - x2 * y1

len2 (Point x y _) = x * x + y * y

cmpAngle p1 p2 = (compare (vecProd p1 p2) 0) `mappend` compare (len2 p1) (len2 p2)

cmpCoords (Point x1 y1 _) (Point x2 y2 _) = compare x1 x2 `mappend` compare y1 y2

leftAndRest ps = (p0, sortBy cmpAngle $ map (flip diff $ p0) (filter (/= p0) ps))
    where p0 = minimumBy cmpCoords ps

firstNonColinear ps = head $ (filter (\p -> p `vecProd` (head ps) /= 0) ps)

solve ps =
    let (p0, rest) = leftAndRest ps
    in (getId p0, getId $ head rest, getId $ firstNonColinear rest)

makePoints coords = map (\(i, (x, y)) -> Point (fromIntegral x) (fromIntegral y) i) $ zip [1..n] coords
    where n = length coords

main = do
    input <- B.getContents
    let (line:lines) = B.lines input
    let coords = map (\l -> let [x, y] = B.words l in (fst . fromJust $ B.readInt x, fst . fromJust $ B.readInt y)) lines
    let points = makePoints coords
    let (i0, i1, i2) = solve points
    putStrLn $ show i0 ++ " " ++ show i1 ++ " " ++ show i2


The polar bears are going fishing. They plan to sail from (sx, sy) to (ex, ey). However, the boat can only sail by wind. At each second, the wind blows in one of these directions: east, south, west or north. Assume the boat is currently at (x, y).  If the wind blows to the east, the boat will move to (x + 1, y).  If the wind blows to the south, the boat will move to (x, y - 1).  If the wind blows to the west, the boat will move to (x - 1, y).  If the wind blows to the north, the boat will move to (x, y + 1). Alternatively, they can hold the boat by the anchor. In this case, the boat stays at (x, y). Given the wind direction for t seconds, what is the earliest time they sail to (ex, ey)?

The first line contains five integers t, sx, sy, ex, ey (1 ≤ t ≤ 105,  - 109 ≤ sx, sy, ex, ey ≤ 109). The starting location and the ending location will be different. The second line contains t characters, the i-th character is the wind blowing direction at the i-th second. It will be one of the four possibilities: "E" (east), "S" (south), "W" (west) and "N" (north).

If they can reach (ex, ey) within t seconds, print the earliest time they can achieve it. Otherwise, print "-1" (without quotes).

NoteIn the first sample, they can stay at seconds 1, 3, and move at seconds 2, 4.In the second sample, they cannot sail to the destination.

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = putStrLn . show . solve . B.words =<< B.getContents

solve :: [B.ByteString] -> Int
solve [_, sx', sy', ex', ey', ws]
  | any (> 0) ts = -1
  | otherwise = i
  where
  (i, ts) = B.foldl' f (0, [e, s, w, n]) ws
  [sx, sy, ex, ey] = map (maybe 0 fst . B.readInt) [sx', sy', ex', ey']
  e = ex - sx
  s = sy - ey
  w = -e
  n = -s
  f x@(i, [e, s, w, n]) c
    | any (> 0) [e, s, w, n] = case fromEnum c of
      69 -> (i + 1, [e - 1, s, w, n])
      83 -> (i + 1, [e, s - 1, w, n])
      87 -> (i + 1, [e, s, w - 1, n])
      78 -> (i + 1, [e, s, w, n - 1])
    | otherwise = x

import Data.List
main = interact $ show . rd . lines
rd (s1:s2:[]) = go (pt1 . map read . words $ s1) s2
pt1 (t:sx:sy:ex:ey:[]) = [(sx,sy),(ex,ey)]
go ((sx,sy):(ex,ey):[]) l | all (True==) $ map (\c -> (length $ filter (c==) l) >= (get c)) dirs = (1+) . maximum $ map (\c -> (elemIndices c l)!!((get c)-1)) dirs
                          | otherwise = -1
                            where hd = abs $ (sx-ex)
                                  vd = abs $ (sy-ey)
                                  get c = if c`elem`"EW" then hd else vd
                                  dirs = todir (signum $ sx-ex,signum $ sy-ey)
todir (-1,0) = "E"
todir (1,0)  = "W"
todir (0,-1) = "N"
todir (0,1)  = "S"
todir (a,b)  = (todir (a,0)) ++ (todir (0,b))

wind 'E' = (1,0)
wind 'W' = (-1,0)
wind 'N' = (0,1)
wind 'S' = (0,-1)

vadd (x0, y0) (x1, y1) = (x0 + x1, y0 + y1)

norm (x, y) = (abs x) + (abs y)

solve i (0,0) _        =  i
solve i _     []       = -1
solve i d@(_,_) (x:xs) = if norm n < norm d then solve (i + 1) n xs else solve (i + 1) d xs
    where n = d `vadd` (wind x)

main = do
    p <- getLine
    w <- getLine
    let [n, sx, sy, ex, ey] = map (read :: [Char]->Int). words $ p
        in putStrLn $ show $ solve 0 (sx - ex, sy - ey) w

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate)

solve :: [Int] -> String -> Int
solve [_, sx, sy, ex, ey] s  =  solve' 0 sx sy s
  where
    solve' t x y s
      | x == ex && y == ey  =  t
      | null s  =  -1
      | head s == 'E' && x < ex  =  solve' (t+1) (x+1) y (tail s)
      | head s == 'S' && y > ey  =  solve' (t+1) x (y-1) (tail s)
      | head s == 'W' && x > ex  =  solve' (t+1) (x-1) y (tail s)
      | head s == 'N' && y < ey  =  solve' (t+1) x (y+1) (tail s)
      | otherwise  =  solve' (t+1) x y (tail s)

main :: IO ()
main  =  do
    ps  <-  reads
    s   <-  getLine
    print $ solve ps s

  where
    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

gao::(Int,Int)->(Int,Int)->Char->(Int,Int)
gao (sx,sy) (tx,ty) wind | wind=='E' && tx>sx = (sx+1,sy)
						 | wind=='S' && ty<sy = (sx,sy-1)
						 | wind=='W' && tx<sx = (sx-1,sy)
						 | wind=='N' && ty>sy = (sx,sy+1)
						 | otherwise = (sx,sy)

main::IO()
main = do
	input<-getContents
	let
		(input2,wind)=splitAt 5 $ words input
		(t:xx)=map read input2 :: [Int]
		sx=xx!!0
		sy=xx!!1
		ex=xx!!2
		ey=xx!!3
		check sx sy = if sx==ex && sy==ey then True else False
		doit::Int->Int->Int->String->Int
		doit x y now wind = if (check x y) then now
							else if null wind then -1
							else doit nx ny (now+1) (tail wind)
								where (nx,ny)=gao (x,y) (ex,ey) (wind!!0)
	print $ doit sx sy 0 (wind!!0)

data R=R Integer | NOR deriving (Eq, Ord)
s[l1,w]=max(go sx ex 'W' 'E')(go sy ey 'S' 'N') where
  [t,sx,sy,ex,ey]=map read $ words l1
  go a b dec inc
    | b < a = gogo dec (a-b)
    | otherwise = gogo inc (b-a)
  gogo c 0 = R 0
  gogo c n = case drop (n-1) $ filter (\(_,x)->x==c) (zip [1..] w) of
    ((i, _) : _) -> R i
    [] -> NOR
p NOR="-1"
p(R x)=show x
main=interact$p.s.lines

-- returns the number of elements from xs consumed
-- to turn s1 to s2
gen :: Eq s => s -> s -> (s -> a -> s) -> [a] -> Maybe Int
gen s1 s2 f xs | s1 == s2  = Just 0
               | null xs   = Nothing
               | otherwise = fmap (+1) (gen (f s1 (head xs)) s2 f (tail xs))

next :: (Int, Int) -> Char -> (Int, Int)
next s@(x,y) c | c == 'E' && x < 0 = (x+1,y)
               | c == 'S' && y > 0 = (x,y-1)
               | c == 'W' && x > 0 = (x-1,y)
               | c == 'N' && y < 0 = (x,y+1)
               | otherwise = s

main = do
   [_, sx, sy, ex, ey] <- fmap (map read.words) getLine :: IO [Int]
   wind <- getLine
   case gen (sx-ex,sy-ey) (0,0) next wind of
      Nothing -> putStrLn "-1"
      Just x -> putStrLn.show $ x

import Data.List
main = interact $ show . rd . lines
rd (s1:s2:[]) = go (pt1 . map read . words $ s1) s2
pt1 (t:sx:sy:ex:ey:[]) = [(sx,sy),(ex,ey)]
go ((sx,sy):(ex,ey):[]) l | all (True==) $ map (\c -> (length $ filter (c==) l) >= (get c)) dirs = (1+) . maximum $ map (\c -> last $ elemIndices c l) dirs
                          | otherwise = -1
                            where hd = abs $ (sx-ex)
                                  vd = abs $ (sy-ey)
                                  md = hd+vd
                                  get c = if c`elem`"EW" then hd else vd
                                  dirs = todir (signum $ sx-ex,signum $ sy-ey)
todir (-1,0) = "E"
todir (1,0)  = "W"
todir (0,-1) = "N"
todir (0,1)  = "S"
todir (a,b)  = (todir (a,0)) ++ (todir (0,b))