The R1 company has recently bought a high rise building in the centre of Moscow for its main office. It's time to decorate the new office, and the first thing to do is to write the company's slogan above the main entrance to the building.The slogan of the company consists of n characters, so the decorators hung a large banner, n meters wide and 1 meter high, divided into n equal squares. The first character of the slogan must be in the first square (the leftmost) of the poster, the second character must be in the second square, and so on.Of course, the R1 programmers want to write the slogan on the poster themselves. To do this, they have a large (and a very heavy) ladder which was put exactly opposite the k-th square of the poster. To draw the i-th character of the slogan on the poster, you need to climb the ladder, standing in front of the i-th square of the poster. This action (along with climbing up and down the ladder) takes one hour for a painter. The painter is not allowed to draw characters in the adjacent squares when the ladder is in front of the i-th square because the uncomfortable position of the ladder may make the characters untidy. Besides, the programmers can move the ladder. In one hour, they can move the ladder either a meter to the right or a meter to the left.Drawing characters and moving the ladder is very tiring, so the programmers want to finish the job in as little time as possible. Develop for them an optimal poster painting plan!

The first line contains two integers, n and k (1 ≤ k ≤ n ≤ 100) — the number of characters in the slogan and the initial position of the ladder, correspondingly. The next line contains the slogan as n characters written without spaces. Each character of the slogan is either a large English letter, or digit, or one of the characters: '.', '!', ',', '?'.

In t lines, print the actions the programmers need to make. In the i-th line print:   "LEFT" (without the quotes), if the i-th action was "move the ladder to the left";  "RIGHT" (without the quotes), if the i-th action was "move the ladder to the right";  "PRINT x" (without the quotes), if the i-th action was to "go up the ladder, paint character x, go down the ladder".  The painting time (variable t) must be minimum possible. If there are multiple optimal painting plans, you can print any of them.

RIGHT
RIGHT
PRINT !
LEFT
PRINT O
LEFT
PRINT G
LEFT
PRINT ?
LEFT
PRINT O
LEFT
PRINT G

NoteNote that the ladder cannot be shifted by less than one meter. The ladder can only stand in front of some square of the poster. For example, you cannot shift a ladder by half a meter and position it between two squares. Then go up and paint the first character and the second character.

import Control.Applicative

step1 n k s
	| k == 0 = forward n k s
	| k == n - 1 = backward n k s
	| k + k < n = "LEFT\n" ++ step1 n (k - 1) s
	| otherwise = "RIGHT\n" ++ step1 n (k + 1) s

forward n k s
	| k == n - 1 = "PRINT " ++ [s !! k] ++ "\n"
	| otherwise = "PRINT " ++ [s !! k] ++ "\nRIGHT\n" ++ forward n (k + 1) s

backward n k s
	| k == 0 = "PRINT " ++ [s !! k] ++ "\n"
	| otherwise = "PRINT " ++ [s !! k] ++ "\nLEFT\n" ++ backward n (k - 1) s

main = do
	[n, k] <- map read . words <$> getLine
	s <- getLine
	putStr $ step1 n (k - 1) s

strToList = (map (read :: String -> Int)).words

f k n s | k - 1 > n - k = (concat $ replicate (n - k) "RIGHT\n") ++ g (reverse s) "LEFT\n"
        | otherwise = (concat $ replicate (k - 1) "LEFT\n") ++ g s "RIGHT\n"
        where g [s] _ = ("PRINT " ++ [s] ++ "\n")
              g (s:xs) phrase = ("PRINT " ++ [s] ++ "\n") ++ phrase ++ g xs phrase

main = do
    s <- getLine
    let [n, k] = strToList s
    t <- getLine
    putStrLn $ f k n t


Businessman Divan loves chocolate! Today he came to a store to buy some chocolate. Like all businessmen, Divan knows the value of money, so he will not buy too expensive chocolate. At the same time, too cheap chocolate tastes bad, so he will not buy it as well.The store he came to has $$$n$$$ different chocolate bars, and the price of the $$$i$$$-th chocolate bar is $$$a_i$$$ dollars. Divan considers a chocolate bar too expensive if it costs strictly more than $$$r$$$ dollars. Similarly, he considers a bar of chocolate to be too cheap if it costs strictly less than $$$l$$$ dollars. Divan will not buy too cheap or too expensive bars.Divan is not going to spend all his money on chocolate bars, so he will spend at most $$$k$$$ dollars on chocolates.Please determine the maximum number of chocolate bars Divan can buy.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The description of each test case consists of two lines. The first line contains integers $$$n$$$, $$$l$$$, $$$r$$$, $$$k$$$ ($$$1 \le n \le 100$$$, $$$1 \le l \le r \le 10^9$$$, $$$1 \le k \le 10^9$$$) — the lowest acceptable price of a chocolate, the highest acceptable price of a chocolate and Divan's total budget, respectively. The second line contains a sequence $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) integers — the prices of chocolate bars in the store.

For each test case print a single integer — the maximum number of chocolate bars Divan can buy.

NoteIn the first example Divan can buy chocolate bars $$$1$$$ and $$$3$$$ and spend $$$100$$$ dollars on them.In the second example Divan can buy chocolate bars $$$3$$$ and $$$4$$$ and spend $$$7$$$ dollars on them.In the third example Divan can buy chocolate bars $$$3$$$, $$$4$$$, and $$$5$$$ for $$$12$$$ dollars.In the fourth example Divan cannot buy any chocolate bar because each of them is either too cheap or too expensive.In the fifth example Divan cannot buy any chocolate bar because he considers the first bar too cheap, and has no budget for the second or third.In the sixth example Divan can buy all the chocolate bars in the shop.

module Main where

import Data.List(sort, findIndices)

(|>) = flip ($)

-- why does CF not have Data.List.Split??
chunksOf :: Int -> [a] -> [[a]]
chunksOf n [] = []
chunksOf n xs = (take n xs) : (chunksOf n $ drop n xs)

lastOr ::  a -> [a] -> a
lastOr def [] = def
lastOr _def xs = last xs

between :: Integer -> Integer -> [Integer] -> [Integer]
between l r =
    filter (<= r)
    . filter (>= l)

solve :: [[Integer]] -> Int
solve [[n, l, r, k], values] =
    values
    |> between l r
    |> sort
    |> scanl1 (+)
    |> filter (<= k)
    |> length

main :: IO ()
main = interact $
    unlines
    . map (show . solve . map (map read . words))
    . chunksOf 2
    . tail
    . lines

import Data.List

main :: IO ()
main = interact $ unlines . map (show . solve . input) . batch . tail . lines

batch :: [a] -> [(a, a)]
batch [] = []
batch (a:b:cs) = (a, b) : batch cs

input :: (String, String) -> (Int, Int, Int, Int, [Int])
input (i, j) = let [n, l, r, k] = map read $ words i
                   as = map read $ words j
               in (n, l, r, k, as)

solve :: (Int, Int, Int, Int, [Int]) -> Int
solve (n, l, r, k, as) = snd $ foldl' accum (k, 0) $ sort $ filter inPriceRange as
  where
    accum :: (Int, Int) -> Int -> (Int, Int)
    accum (k', b') p
      | p <= k' = (k' - p, succ b')
      | otherwise = (k', b')

    inPriceRange :: Int -> Bool
    inPriceRange p = l <= p && p <= r

{-# OPTIONS_GHC -O2 #-}

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

solve :: IO ()
solve = do
  ~[n,l,r,k] <- readv
  xs <- readv
  let
    ys = DL.sort xs
    zs = DL.takeWhile (<=r) $ DL.dropWhile (<l) ys
    us = DL.scanl' (-) k zs
    vs = tail $ DL.takeWhile (>=0) us
    ans = length vs
  print ans

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat $  map (\x->DBB.intDec x <> DBB.char8 ' ') 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

import Data.List
import Control.Monad
main = readLn >>= flip replicateM (
 map read <$> words <$> getLine >>= \(n:l:r:k:_) ->
 map read <$> words <$> getLine >>= \x ->
 print $ length $ takeWhile (<=k) $ scanl1 (+) $ sort $ filter (\i -> (i >= l) && (i <= r)) x)

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

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

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

data TC = TC {n :: Int, l :: Int, r :: Int, k :: Int, as :: [Int]}

type Output = Int

input :: Scanner TC
input = do
  n <- int
  l <- int
  r <- int
  k <- int
  as <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..} =
  length
    . takeWhile (<= k)
    . scanl1 (+)
    . filter (>= l)
    . filter (<= r)
    . sort
    $ as

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

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- 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 RecordWildCards #-}
module Main where

import Data.List (sort)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

data InType  = In { n :: Integer
                  , l :: Integer
                  , r :: Integer
                  , k :: Integer
                  , a :: [Integer]
                  }
type OutType = Integer

ps :: [Integer] -> [Integer]
ps = go 0
  where go :: Integer -> [Integer] -> [Integer]
        go _ [] = []
        go acc (x : xs) = let acc' = x + acc
                          in acc' : go acc' xs

solve :: InType -> OutType
solve In {..} =
  let av = sort $ filter (\x -> x >= l && x <= r) a
      p  = ps av
  in fromIntegral $ length $ takeWhile (<= k) p

receive :: [String] -> InType
receive [nlrk, sArr] =
  case toArr nlrk of
    [n, l, r, k] -> In n l r k (toArr sArr)
    _            -> error "parse error on input"
receive _ = error "parse error on input"

main :: IO ()
main = interact $ unlines . map (show . solve . receive) . chunksOf 2 . tail . lines


Let's say string $$$s$$$ has period $$$k$$$ if $$$s_i = s_{i + k}$$$ for all $$$i$$$ from $$$1$$$ to $$$|s| - k$$$ ($$$|s|$$$ means length of string $$$s$$$) and $$$k$$$ is the minimum positive integer with this property.Some examples of a period: for $$$s$$$="0101" the period is $$$k=2$$$, for $$$s$$$="0000" the period is $$$k=1$$$, for $$$s$$$="010" the period is $$$k=2$$$, for $$$s$$$="0011" the period is $$$k=4$$$.You are given string $$$t$$$ consisting only of 0's and 1's and you need to find such string $$$s$$$ that:  String $$$s$$$ consists only of 0's and 1's;  The length of $$$s$$$ doesn't exceed $$$2 \cdot |t|$$$;  String $$$t$$$ is a subsequence of string $$$s$$$;  String $$$s$$$ has smallest possible period among all strings that meet conditions 1—3. Let us recall that $$$t$$$ is a subsequence of $$$s$$$ if $$$t$$$ can be derived from $$$s$$$ by deleting zero or more elements (any) without changing the order of the remaining elements. For example, $$$t$$$="011" is a subsequence of $$$s$$$="10101".

The first line contains single integer $$$T$$$ ($$$1 \le T \le 100$$$) — the number of test cases. Next $$$T$$$ lines contain test cases — one per line. Each line contains string $$$t$$$ ($$$1 \le |t| \le 100$$$) consisting only of 0's and 1's.

Print one string for each test case — string $$$s$$$ you needed to find. If there are multiple solutions print any one of them.

NoteIn the first and second test cases, $$$s = t$$$ since it's already one of the optimal solutions. Answers have periods equal to $$$1$$$ and $$$2$$$, respectively.In the third test case, there are shorter optimal solutions, but it's okay since we don't need to minimize the string $$$s$$$. String $$$s$$$ has period equal to $$$1$$$.

module Main where

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

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

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

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

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

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        s <- getLine
        let n = length s
        putStrLn $ take (2 * n) $ f s

f :: String -> String
f s = case (length . group . sort $ s) of
    1 -> repeat . head $ s
    2 -> cycle "10"

import Control.Monad

main = readLn >>= flip replicateM_ test

test = do
    t <- getLine
    if all (== head t) t
        then putStrLn t
        else putStrLn $ take (2 * length t) (cycle "01")

import qualified Data.List as L

solve :: String -> String
solve s
  | s == (take n $ repeat $ (s!!0)) = s
  | otherwise = concat $ take n $ repeat "01"
  where n = length s

main = interact $ unlines . map solve . tail . lines

import Control.Monad

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

routine :: IO ()
routine = do
  s <-  getLine
  putStrLn $ if all (== head s) s then s else concat $ replicate (length s) "10"

import Control.Monad

main :: IO ()
main = do
  tt <- read <$> getLine
  replicateM_ tt $ do
    t <- getLine
    putStrLn $ if any (=='0') t && any (=='1') t
      then concat $ map (\_ -> "01") t
      else t

import Data.List

allEqual :: String -> Bool
allEqual s = length (group s) == 1

solve1 :: String -> String
solve1 (s:ss)
    | allEqual (s:ss)       = s:ss
    | otherwise             = solveHelper s (s:ss)

switch :: Char -> Char
switch '1' = '0'
switch '0' = '1'

solveHelper :: Char -> String -> String
solveHelper _ "" = ""
solveHelper c (s:ss)
    | s == c        = s: solveHelper (switch c) ss
    | otherwise     = c: solveHelper (switch c) (s:ss)

solveTestCases :: Int -> IO ()
solveTestCases 0 = return ()
solveTestCases t = do
    s <- getLine
    putStrLn $ solve1 s
    solveTestCases (t-1)

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

import Control.Monad

main :: IO ()
main = do
  tt <- read <$> getLine
  replicateM_ tt $ do
    t <- getLine
    putStrLn $ concat $ map (\_ -> "01") t


Once Petya was in such a good mood that he decided to help his mum with the washing-up. There were n dirty bowls in the sink. From the geometrical point of view each bowl looks like a blunted cone. We can disregard the width of the walls and bottom. Petya puts the clean bowls one on another naturally, i. e. so that their vertical axes coincide (see the picture). You will be given the order in which Petya washes the bowls. Determine the height of the construction, i.e. the distance from the bottom of the lowest bowl to the top of the highest one.

The first input line contains integer n (1 ≤ n ≤ 3000). Each of the following n lines contains 3 integers h, r and R (1 ≤ h ≤ 10000, 1 ≤ r < R ≤ 10000). They are the height of a bowl, the radius of its bottom and the radius of its top. The plates are given in the order Petya puts them on the table.

Output the height of the plate pile accurate to at least 10 - 6.

import Control.Monad
import Data.Array
import IO

gao n l = elems a where
	a = listArray (1, n) [maximum $ 0:[a!j + s (b!j) (b!i) | j <- [1 .. i - 1]] | i <- [1 .. n]]
	b = listArray (1, n) l
	s [x,a,b] [y,c,d] = min x $ maximum $ 0:[f, g, h] where
		i = (b - a) / x
		j = (d - c) / y
		f = (c - a) / i
		g = if d <= b then (d - a) / i - y else 0
		h = if b <= d then x - (b - c) / j else 0

main = do
	i <- openFile "input.txt" ReadMode
	o <- openFile "output.txt" WriteMode
	n <- fmap read $ hGetLine i
	l <- replicateM n $ fmap (map read . words) $ hGetLine i
	hPutStrLn o $ show $ maximum $ zipWith (+) (map head l) (gao n l)
	hClose i
	hClose o

main = do
  x <- readFile "input.txt"
  writeFile "output.txt" (f x)
f theInput = show answer where
  n:bowl0 = lines theInput
  bowl = reverse $ map (map (read::String->Float)) $ map words bowl0
  height [x] = [(x,0)]
  height (x:xs) = (x,foldl1 max (map (h0 x) ys)):ys where ys = height xs
  h0 [h1,rb1,rt1] ([h2,rb2,rt2],h3)
    | rb1 > rt2 = h2 + h3
    | h1*(rt2-rb2) > h2*(rt1-rb1) = if rb1 < rb2 then h3 else (rb1-rb2)*h2/(rt2-rb2)+h3
    | rt1 < rt2 = max 0 ((rt1-rb2)*h2/(rt2-rb2)-h1) + h3
    | otherwise = max 0 (h2-(rt2-rb1)*h1/(rt1-rb1)) + h3
  answer = foldl1 max [h1 + h2|([h1,_,_],h2)<-height bowl]

import Array
import Monad (liftM)

(?) :: Bool -> a -> a -> a
(?) True   =  const
(?) False  =  flip const

parse :: Read a => String -> (a, a, a)
parse line  =  case words line of
    [s1, s2, s3]  ->  (read s1, read s2, read s3)

getHeight :: (Int, Int, Int) -> Int
getHeight (h, _, _)  =  h

solve :: Int -> Array Int (Int, Int, Int) -> Double
solve n xs  =  maximum [hs ! i + fromIntegral (getHeight (xs ! i)) | i <- [1..n]]
  where
    hs  =  array (1, n) ((1, 0) :
        [(i, maximum [height (xs ! i) (xs ! j) (hs ! j) | j <- [1..i-1]]) | i <- [2..n]])

    height t1@(h1, a1, b1) t2@(h2, a2, b2) d2
      | a1 >= b2   =  d2 + fromIntegral h2
      | otherwise  =  case compareDelta t1 t2 of
        LT  ->  d2 + max 0 (fromIntegral h2 - fromIntegral (b2 - a1) * tanDelta t1)
        _   ->  (a1 <= a2) ? d2 $ d2 + fromIntegral (a1 - a2) * tanDelta t2

    tanDelta (h, a, b)  =  fromIntegral h / fromIntegral (b - a)
    compareDelta (h1, a1, b1) (h2, a2, b2)  =  compare (h1 * (b2 - a2)) (h2 * (b1 - a1))

main :: IO ()
main  =  do
    ls  <-  liftM lines $ readFile "input.txt"
    let n   =  read $ head ls
    let xs  =  listArray (1,n) $ take n $ map parse $ tail ls
    writeFile "output.txt" $ show $ solve n xs

main = do
  x <- readFile "input.txt"
  writeFile "output.txt" (f x)
f theInput = show answer where
  n:bowl0 = lines theInput
  bowl = reverse $ map (map (read::String->Float)) $ map words bowl0
  height [x] = [(x,0)]
  height (x:xs) = (x,foldl1 max (map (h0 x) ys)):ys where ys = height xs
  h0 [h1,rb1,rt1] ([h2,rb2,rt2],h3)
    | rb1 > rt2 = h2 + h3
    | h1*(rt2-rb2) > h2*(rt1-rb1) = if rb1 < rb2 then h3 else (rb1-rb2)*h2/(rt2-rb2)+h3
    | rt1 < rt2 = max 0 ((rt1-rb2)*h2/(rt2-rb2)-h1) + h3
    | otherwise = max 0 (h2-(rt2-rb1)*h1/(rt1-rb1)) + h3
  answer = h1 + h2 where ([h1,_,_],h2):_ = height bowl


Hanh lives in a shared apartment. There are $$$n$$$ people (including Hanh) living there, each has a private fridge. $$$n$$$ fridges are secured by several steel chains. Each steel chain connects two different fridges and is protected by a digital lock. The owner of a fridge knows passcodes of all chains connected to it. A fridge can be open only if all chains connected to it are unlocked. For example, if a fridge has no chains connected to it at all, then any of $$$n$$$ people can open it.    For exampe, in the picture there are $$$n=4$$$ people and $$$5$$$ chains. The first person knows passcodes of two chains: $$$1-4$$$ and $$$1-2$$$. The fridge $$$1$$$ can be open by its owner (the person $$$1$$$), also two people $$$2$$$ and $$$4$$$ (acting together) can open it. The weights of these fridges are $$$a_1, a_2, \ldots, a_n$$$. To make a steel chain connecting fridges $$$u$$$ and $$$v$$$, you have to pay $$$a_u + a_v$$$ dollars. Note that the landlord allows you to create multiple chains connecting the same pair of fridges. Hanh's apartment landlord asks you to create exactly $$$m$$$ steel chains so that all fridges are private. A fridge is private if and only if, among $$$n$$$ people living in the apartment, only the owner can open it (i.e. no other person acting alone can do it). In other words, the fridge $$$i$$$ is not private if there exists the person $$$j$$$ ($$$i \ne j$$$) that the person $$$j$$$ can open the fridge $$$i$$$.For example, in the picture all the fridges are private. On the other hand, if there are $$$n=2$$$ fridges and only one chain (which connects them) then both fridges are not private (both fridges can be open not only by its owner but also by another person).Of course, the landlord wants to minimize the total cost of all steel chains to fulfill his request. Determine whether there exists any way to make exactly $$$m$$$ chains, and if yes, output any solution that minimizes the total cost.

Each test contains multiple test cases. The first line contains the number of test cases $$$T$$$ ($$$1 \le T \le 10$$$). Then the descriptions of the test cases follow. The first line of each test case contains two integers $$$n$$$, $$$m$$$ ($$$2 \le n \le 1000$$$, $$$1 \le m \le n$$$) — the number of people living in Hanh's apartment and the number of steel chains that the landlord requires, respectively. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^4$$$) — weights of all fridges.

For each test case:   If there is no solution, print a single integer $$$-1$$$.  Otherwise, print a single integer $$$c$$$ — the minimum total cost. The $$$i$$$-th of the next $$$m$$$ lines contains two integers $$$u_i$$$ and $$$v_i$$$ ($$$1 \le u_i, v_i \le n$$$, $$$u_i \ne v_i$$$), meaning that the $$$i$$$-th steel chain connects fridges $$$u_i$$$ and $$$v_i$$$. An arbitrary number of chains can be between a pair of fridges.  If there are multiple answers, print any.

import Control.Monad

solve :: Int -> Int -> [Int] -> Maybe (Int,[[Int]])
solve a b l
  |a/=b || a <3 = Nothing
  | otherwise = Just (2*sum l,[[x,1+mod x a]|x <- [1..a]])

routine :: IO ()
routine = do
  [a,b] <-(map read.words) <$> getLine
  l <- (map read.words) <$> getLine
  case solve a b l of
    Just x -> f x
    _ -> putStrLn "-1"

f :: (Int,[[Int]]) -> IO ()
f (a,l) = do
  print a
  forM_ l (putStrLn . unwords . map show)

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

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad(forM_, liftM, replicateM, replicateM_)
import Data.List(sortBy, intercalate)

-- Input parsing
parseInts :: String -> [Int]
parseInts str = map read (words str)

parseIntsM :: IO [Int]
parseIntsM = parseInts <$> getLine

-- Solution

data Edge = Edge (Int, Int)
type EdgeWithCost = (Edge, Int)

data Solution = Solution {
  cost :: Int,
  edgeCount :: Int,
  edges :: [Edge]
}

data Query = Query {
  vertexCount :: Int,
  edgeLimit :: Int,
  weights :: [Int]
}

data Vertex = Vertex {
  ix :: Int,
  weight :: Int
}

instance Show Edge where
  show (Edge (src, dst)) = show src ++ " " ++ show dst

instance Show Solution where
  show (Solution cost count edges) =
    let edgeString =  intercalate "\n" . map show $ edges in
      show cost ++ "\n" ++ edgeString

mapOrd :: Ord b => (a -> b) -> a -> a -> Ordering
mapOrd f lhs rhs = compare (f lhs) (f rhs)

vertexOrd :: Ord Int => Vertex -> Vertex -> Ordering
vertexOrd = mapOrd weight

x :: Vertex -> Vertex -> EdgeWithCost
x v1 v2 = (Edge (ix v1, ix v2), weight v1 + weight v2)

rotate :: Int -> [a] -> [a]
rotate n l = (drop n l) ++ (take n l)

x2 :: [Vertex] -> [EdgeWithCost]
x2 vs = zipWith x vs (rotate 1 vs)

fridgeSolve :: Query -> Maybe Solution
fridgeSolve q =
  let v = vertexCount q in
    let e = edgeLimit q in
      let dummyEdges = e - v in
        if dummyEdges < 0 || v < 3 then Nothing else
          let s@(v1:v2:rest) :: [Vertex] = sortBy vertexOrd $ zipWith Vertex [1..v] $ weights q in
            let p :: [EdgeWithCost] = (x2 s) ++ (replicate dummyEdges (x v1 v2)) in
              Just $ Solution (foldr (+) 0 $ map snd p) e (map fst p)

taskM :: IO ()
taskM = do
  [n, m] <- parseIntsM
  ws <- parseIntsM
  case (fridgeSolve (Query n m ws)) of
    Nothing -> print $ -1
    Just s -> print $ s

main :: IO ()
main = do
  [t] <- parseIntsM
  replicateM_ t taskM

import Control.Monad

solve :: Int -> Int -> [Int] -> Maybe (Int,[[Int]])
solve a b l
  |a/=b = Nothing
  | otherwise = Just (2*sum l,[[x,1+mod x a]|x <- [1..a]])

routine :: IO ()
routine = do
  [a,b] <-(map read.words) <$> getLine
  l <- (map read.words) <$> getLine
  case solve a b l of
    Just x -> f x
    _ -> putStrLn "-1"

f :: (Int,[[Int]]) -> IO ()
f (a,l) = do
  print a
  forM_ l (\x -> putStrLn $ unwords $ map show x)

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

import Control.Monad

solve :: Int -> Int -> [Int] -> Maybe (Int,[[Int]])
solve a b l
  |a/=b = Nothing
  | otherwise = Just (2*sum l,[[x,mod (x+1) (a+1)]|x <- [1..a]])

routine :: IO ()
routine = do
  [a,b] <-(map read.words) <$> getLine
  l <- (map read.words) <$> getLine
  case solve a b l of
    Just x -> f x
    _ -> putStrLn "-1"

f :: (Int,[[Int]]) -> IO ()
f (a,l) = do
  print a
  forM_ l (\x -> putStrLn $ unwords $ map show x)

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


High school student Vasya got a string of length n as a birthday present. This string consists of letters 'a' and 'b' only. Vasya denotes beauty of the string as the maximum length of a substring (consecutive subsequence) consisting of equal letters.Vasya can change no more than k characters of the original string. What is the maximum beauty of the string he can achieve?

The first line of the input contains two integers n and k (1 ≤ n ≤ 100 000, 0 ≤ k ≤ n) — the length of the string and the maximum number of characters to change. The second line contains the string, consisting of letters 'a' and 'b' only.

Print the only integer — the maximum beauty of the string Vasya can achieve by changing no more than k characters.

NoteIn the first sample, Vasya can obtain both strings "aaaa" and "bbbb".In the second sample, the optimal answer is obtained with the string "aaaaabaa" or with the string "aabaaaaa".

solve [s1, s2] =
  let [_,k] = map read $ words $ s1 :: [Integer]
      update ('a':_) (a,b) d = (a + d, b)
      update ('b':_) (a,b) d = (a, b + d)
      helper x y (a, b) res
          | min a b > k = helper (tail x) y (update x (a, b) (-1)) res
          | y == [] = max (a + b) res
          | otherwise = helper x (tail y) (update y (a, b) 1) (max res (a + b))
  in helper s2 s2 (0, 0) 0
main = getContents >>= putStrLn . show . solve . lines

solve s =
  let [s1,s2] = lines s
      [_,k] = map read $ words $ s1 :: [Integer]
      update ('a':_) (a,b) d = (a + d, b)
      update ('b':_) (a,b) d = (a, b + d)
      helper x y (a, b) dis res
          | min a b > k = helper (tail x) y (update x (a, b) (-1)) (dis - 1) res
          | y == [] = max dis res
          | otherwise = helper x (tail y) (update y (a, b) 1) (dis + 1) (max res dis)
  in helper s2 s2 (0, 0) 0 0
main :: IO()
main = getContents >>= putStrLn . show . solve

import Data.List
import Data.Functor

main :: IO()
main = do
    [_, k] <- map read . words <$> getLine
    s <- getLine
    print $ maximum $ map (\x -> solve (== x) s k) "ab"

solve :: (Char -> Bool) -> String -> Int -> Int
solve f s k = solve' s s 0 0
    where solve' :: String -> String -> Int -> Int -> Int
          solve' []     []     _   _   = 0
          solve' []     (t:ts) cnt len | cnt <= k  = len
                                       | f t       = solve' [] ts cnt (len - 1)
                                       | otherwise = solve' [] ts (cnt - 1) (len - 1)
          solve' (h:hs) (t:ts) cnt len | cnt <= k  = max len (solve' hs (t:ts) (cnt + if f h then 0 else 1) (len + 1))
                                       | otherwise = solve' (h:hs) ts (cnt - if f t then 0 else 1) (len - 1)

pp = putStrLn

aaa (a : bb) (c : dd)  k used len mx
  | a == 'a' =
    aaa bb (c : dd) k used (succ len) (maximum [(succ len), mx])
  | a == 'b' && used < k =
    aaa bb (c : dd) k (succ used) (succ len) (maximum [(succ len),mx])
  | a == 'b' && used == k && c == 'b' =
    aaa (a : bb) dd k (pred used) (pred len) mx
  | a == 'b' && used == k && c == 'a' =
    aaa (a : bb) dd k used (pred len) mx
aaa mpt something k used len mx = mx

invert (a : bb)
 | a == 'a' = 'b' : (invert bb)
 | a == 'b' = 'a' : (invert bb)
invert mpt = []

-- do one pass for a and one for b
main = do
  fff <- getLine
  let nnn = (read (head (words fff)))::Int
      kkk = (read (last (words fff)))::Int

  gg <- getLine

  let one = aaa gg gg kkk 0 0 0
      two = aaa (invert gg) (invert gg) kkk 0 0 0

  pp (show (maximum [one,two]))

pp = putStrLn

aaa (a : bb) (c : dd)  k used len mx
  | a == 'a' =
    aaa bb (c : dd) k used (succ len) (maximum [(succ len), mx])
  | a == 'b' && used < k =
    aaa bb (c : dd) k (succ used) (succ len) (maximum [(succ len),mx])
  | a == 'b' && used == k && c == 'b' =
    aaa (a : bb) dd k (pred used) (pred len) mx
  | a == 'b' && used == k && c == 'a' =
    aaa (a : bb) dd k used (pred len) mx
aaa mpt something k used len mx = mx

invert (a : bb)
 | a == 'a' = 'b' : (invert bb)
 | a == 'b' = 'a' : (invert bb)
invert mpt = []

-- do one pass for a and one for b
main = do
  ff <- getLine
  let n = (read (head (words ff)))::Int
      k = (read (last (words ff)))::Int

  gg <- getLine

  let one = aaa gg gg k 0 0 0
      two = aaa (invert gg) (invert gg) k 0 0 0

  pp (show (maximum [one,two]))

import Data.List
import Control.Applicative

_distList :: Char -> [Int] -> [Int]
_distList 'a' (x:xs) = (x+1):xs
_distList 'b' xs = 0:xs

distList :: String -> [Int]
distList = foldr _distList [0]

partialSums :: Int -> [Int] -> [Int]
partialSums sz lst =
    zipWith (-) (drop sz initsSums) initsSums
        where initsSums = 0:(scanl1 (+) lst)

solve :: Int -> String -> Int
solve k str =
    let dList = distList str in
        case partialSums (k+1) dList of
            [] -> sum [length dList, (-1), sum dList]
            pSums -> (k+) . maximum $ pSums

main :: IO()
main = do
    k <- (read . (!!1) . words) <$> getLine
    s <- getLine
    print . maximum $
        [solve k] <*> (
            [id, map (\x -> case x of {'a' -> 'b'; 'b' -> 'a'})] <*> [s]
        )


There are n cities numbered from 1 to n in Berland. Some of them are connected by two-way roads. Each road has its own length — an integer number from 1 to 1000. It is known that from each city it is possible to get to any other city by existing roads. Also for each pair of cities it is known the shortest distance between them. Berland Government plans to build k new roads. For each of the planned road it is known its length, and what cities it will connect. To control the correctness of the construction of new roads, after the opening of another road Berland government wants to check the sum of the shortest distances between all pairs of cities. Help them — for a given matrix of shortest distances on the old roads and plans of all new roads, find out how the sum of the shortest distances between all pairs of cities changes after construction of each road.

The first line contains integer n (2 ≤ n ≤ 300) — amount of cities in Berland. Then there follow n lines with n integer numbers each — the matrix of shortest distances. j-th integer in the i-th row — di, j, the shortest distance between cities i and j. It is guaranteed that di, i = 0, di, j = dj, i, and a given matrix is a matrix of shortest distances for some set of two-way roads with integer lengths from 1 to 1000, such that from each city it is possible to get to any other city using these roads. Next line contains integer k (1 ≤ k ≤ 300) — amount of planned roads. Following k lines contain the description of the planned roads. Each road is described by three space-separated integers ai, bi, ci (1 ≤ ai, bi ≤ n, ai ≠ bi, 1 ≤ ci ≤ 1000) — ai and bi — pair of cities, which the road connects, ci — the length of the road. It can be several roads between a pair of cities, but no road connects the city with itself.

Output k space-separated integers qi (1 ≤ i ≤ k). qi should be equal to the sum of shortest distances between all pairs of cities after the construction of roads with indexes from 1 to i. Roads are numbered from 1 in the input order. Each pair of cities should be taken into account in the sum exactly once, i. e. we count unordered pairs.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Data.Maybe
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import qualified Data.ByteString.Char8 as BS
import Text.Printf
import Data.Int
import Data.Array.IO
import Data.IORef

{-# INLINE for_ #-}
for_ :: Int -> Int -> (Int -> IO ()) -> IO ()
for_ m !n f = loop m where
  loop i | i <= n    = f i >> loop (i + 1)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : _ <- readData
  xs <- concat <$> replicateM n (take n <$> readData)
  table <- newListArray (1, n * n) xs :: IO (IOUArray Int Int)
  r <- newIORef 0 :: IO (IORef Int64)
  k : _ <- readData
  for_ 1 (n - 1) $ \i -> do
    for_ (i + 1) n $ \j -> do
      v <- readArray table ((i - 1) * n + j)
      modifyIORef r $ (+ (fromIntegral v))
  for_ 1 k $ \_ -> do
    a : b : c : _ <- readData
    let a' = min a b
        b' = max a b
    c' <- readArray table ((a' - 1) * n + b')
    when (c < c') $ do
      modifyIORef r $ (subtract (fromIntegral (c' - c)))
      writeArray table ((a' - 1) * n + b') c
      for_ 1 (n - 1) $ \i -> do
        for_ (i + 1) n $ \j -> do
          v1 <- readArray table ((min i a' - 1) * n + max i a')
          v2 <- readArray table ((min j b' - 1) * n + max j b')
          w1 <- readArray table ((min i b' - 1) * n + max i b')
          w2 <- readArray table ((min j a' - 1) * n + max j a')
          v  <- readArray table ((i - 1) * n + j)
          let v' = min (v1 + v2) (w1 + w2) + c
          when (v' < v) $ do
            modifyIORef r $ subtract (fromIntegral (v - v'))
            writeArray table ((i - 1) * n + j) v'
    readIORef r >>=  printf "%d "

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Data.Maybe
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import qualified Data.ByteString.Char8 as BS
import Text.Printf
import Data.Int
import Data.Array.IO
import Data.IORef

{-# INLINE for_ #-}
for_ :: Int -> Int -> (Int -> IO ()) -> IO ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (i + 1)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : _ <- readData
  xs <- concat <$> replicateM n (take n <$> readData)
  table <- newListArray ((1, 1), (n, n)) xs :: IO (IOUArray (Int, Int) Int)
  r <- newIORef 0 :: IO (IORef Int64)
  k : _ <- readData
  for_ 1 n $ \i -> do
    for_ (i + 1) n $ \j -> do
      v <- readArray table (i, j)
      modifyIORef r $ (+ (fromIntegral v))
  for_ 1 k $ \_ -> do
    a : b : c : _ <- readData
    c' <- readArray table (a, b)
    when (c < c') $ do
      modifyIORef r $ (subtract (fromIntegral (c' - c)))
      writeArray table (a, b) c
      for_ 1 n $ \i -> do
        for_ (i + 1) n $ \j -> do
          v1 <- readArray table (i, a)
          v2 <- readArray table (b, j)
          w1 <- readArray table (i, b)
          w2 <- readArray table (a, j)
          v  <- readArray table (i, j)
          let v' = min (v1 + v2) (w1 + w2) + c
          when (v' < v) $ do
            modifyIORef r $ subtract (fromIntegral (v - v'))
            writeArray table (i, j) v'
            writeArray table (j, i) v'
    readIORef r >>=  printf "%d "

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Text.Printf
import Data.Array.IO
import Data.IORef

{-# INLINE for_ #-}
for_ :: Int -> Int -> (Int -> IO ()) -> IO ()
for_ m !n f = loop m where
  loop i | i <= n    = f i >> loop (i + 1)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : _ <- readData
  xs <- concat <$> replicateM n (take n <$> readData)
  table <- newListArray (1, n * n) xs :: IO (IOUArray Int Int)
  r <- newIORef 0 :: IO (IORef Int)
  k : _ <- readData
  for_ 1 (n - 1) $ \i -> do
    for_ (i + 1) n $ \j -> do
      v <- readArray table ((i - 1) * n + j)
      modifyIORef r $ (+ v)
  for_ 1 k $ \_ -> do
    a : b : c : _ <- readData
    let a' = min a b
        b' = max a b
    c' <- readArray table ((a' - 1) * n + b')
    when (c < c') $ do
      modifyIORef r $ (subtract (c' - c))
      writeArray table ((a' - 1) * n + b') c
      for_ 1 (n - 1) $ \i -> do
        for_ (i + 1) n $ \j -> do
          v1 <- readArray table ((min i a' - 1) * n + max i a')
          v2 <- readArray table ((min j b' - 1) * n + max j b')
          w1 <- readArray table ((min i b' - 1) * n + max i b')
          w2 <- readArray table ((min j a' - 1) * n + max j a')
          v  <- readArray table ((i - 1) * n + j)
          let v' = min (v1 + v2) (w1 + w2) + c
          when (v' < v) $ do
            modifyIORef r $ subtract (v - v')
            writeArray table ((i - 1) * n + j) v'
    readIORef r >>=  printf "%d "

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Data.Maybe
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import qualified Data.ByteString.Char8 as BS
import Text.Printf
import Data.Int
import Data.Array.IO
import Data.IORef

{-# INLINE for_ #-}
for_ :: Int -> Int -> (Int -> IO ()) -> IO ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (i + 1)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : _ <- readData
  xs <- concat <$> replicateM n (take n <$> readData)
  table <- newListArray ((1, 1), (n, n)) xs :: IO (IOUArray (Int, Int) Int)
  r <- newIORef 0 :: IO (IORef Int64)
  k : _ <- readData
  for_ 1 (n - 1) $ \i -> do
    for_ (i + 1) n $ \j -> do
      v <- readArray table (i, j)
      modifyIORef r $ (+ (fromIntegral v))
  for_ 1 k $ \_ -> do
    a : b : c : _ <- readData
    c' <- readArray table (a, b)
    when (c < c') $ do
      modifyIORef r $ (subtract (fromIntegral (c' - c)))
      writeArray table (a, b) c
      for_ 1 (n - 1) $ \i -> do
        for_ (i + 1) n $ \j -> do
          v1 <- readArray table (i, a)
          v2 <- readArray table (b, j)
          w1 <- readArray table (i, b)
          w2 <- readArray table (a, j)
          v  <- readArray table (i, j)
          let v' = min (v1 + v2) (w1 + w2) + c
          when (v' < v) $ do
            modifyIORef r $ subtract (fromIntegral (v - v'))
            writeArray table (i, j) v'
            writeArray table (j, i) v'
    readIORef r >>=  printf "%d "


You have two positive integers $$$a$$$ and $$$b$$$.You can perform two kinds of operations:  $$$a = \lfloor \frac{a}{b} \rfloor$$$ (replace $$$a$$$ with the integer part of the division between $$$a$$$ and $$$b$$$)  $$$b=b+1$$$ (increase $$$b$$$ by $$$1$$$) Find the minimum number of operations required to make $$$a=0$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The only line of the description of each test case contains two integers $$$a$$$, $$$b$$$ ($$$1 \le a,b \le 10^9$$$).

For each test case, print a single integer: the minimum number of operations required to make $$$a=0$$$.

NoteIn the first test case, one of the optimal solutions is:  Divide $$$a$$$ by $$$b$$$. After this operation $$$a = 4$$$ and $$$b = 2$$$.  Divide $$$a$$$ by $$$b$$$. After this operation $$$a = 2$$$ and $$$b = 2$$$.  Increase $$$b$$$. After this operation $$$a = 2$$$ and $$$b = 3$$$.  Divide $$$a$$$ by $$$b$$$. After this operation $$$a = 0$$$ and $$$b = 3$$$.

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

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
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.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
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.Traversable
import System.IO

------

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 :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

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

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

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

popIntegers :: 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
  ~[a, b] <- popInts
  return $ bshow (solve (fromIntegral a) (fromIntegral b))

solve :: Int64 -> Int64 -> Int64
solve a 1 = solve a 2 + 1
solve a b
  | a < b = 1
  | a < b ^ 2 = 2
  | otherwise = minimum $ map (\(i, b') -> i + f b') $ zip [0..] $
                takeWhile (\b' -> a >= (b' - 1) ^ 2) [b..]

  where
    f b' = head $ dropWhile (\i -> a >= b' ^ i) $ [2..]

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

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
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.Traversable
import System.IO

------

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 :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

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

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

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

popIntegers :: 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
  ~[a, b] <- popIntegers
  return $ bshow (solve a b)

solve a 1 = solve a 2 + 1
solve a b
  | a < b = 1
  | a < b ^ 2 = 2
  | otherwise = minimum $ map (\(i, b') -> i + f b') $ zip [0..] $
                takeWhile (\b' -> a >= (b' - 1) ^ 2) [b..]

  where
    f b' = head $ dropWhile (\i -> a >= b' ^ i) $ [2..]

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

type SIO = StateT P.ByteString IO

steps :: Int -> Int -> Int
steps = let
  go k 0 _ = k
  go _ _ 1 = maxBound
  go k p q = let k' = k+1  in  k' `seq` go k' (quot p q) q
  in  go 0

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [a, b] <- readInts
    let
      opts = zipWith (\x y -> steps a x + y) [b..] [0..]
      ans = head [x | (x, y) <- zip opts $ tail opts, x < y]
    putInts [ans]

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

import Data.Int
import Control.Monad

main :: IO ()
main = do
  t <- fmap read getLine
  replicateM_ t $ do
    [a, b] <- map read . words <$> getLine
    let
      f :: (Int64, Int64) -> Int64 -> Int64
      f (0, _) _ = 0
      f (x, y) c = 1 + f (x `div` (y + c), y) c
      solve :: Int64 -> Int64 -> Int64
      solve low high
        | high - low < 10 = fst $ minimum $ zip (map g [low .. high]) [low .. high]
        | g m1 <= g m2 = solve low m2
        | otherwise = solve m1 high
        where
        m1 = low + (high - low) * 1 `div` 3
        m2 = low + (high - low) * 2 `div` 3
        g x = x + f (a, b) x
    putStrLn $ show $ solve (if b == 1 then 1 else 0) 10000000000


You are a coach at your local university. There are $$$n$$$ students under your supervision, the programming skill of the $$$i$$$-th student is $$$a_i$$$.You have to create a team for a new programming competition. As you know, the more students some team has the more probable its victory is! So you have to create a team with the maximum number of students. But you also know that a team should be balanced. It means that the programming skill of each pair of students in a created team should differ by no more than $$$5$$$.Your task is to report the maximum possible number of students in a balanced team.

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of students. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is a programming skill of the $$$i$$$-th student.

Print one integer — the maximum possible number of students in a balanced team.

NoteIn the first example you can create a team with skills $$$[12, 17, 15]$$$.In the second example you can take all students in a team because their programming skills are equal.In the third example you can create a team consisting of a single student (and you cannot create a team consisting of at least two students).

{-# LANGUAGE Safe #-}
{-# Options_GHC -O3 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Char
import Data.Array.Unboxed
import qualified Data.Sequence as S
import Data.Foldable
import Data.List

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

test :: Int -> [Int] -> Int
test n = f . listArray (0, n - 1) . toList . S.unstableSort . S.fromList
  where
    f :: UArray Int Int -> Int
    f arr = loop 0 0 minBound
      where
        loop i j r
          | i >= n = r
          | otherwise = loop (succ i) j' (max r (j' - i))
          where j' = until (\k -> k >= n || ((arr ! k) > (arr ! i) + 5)) succ j

main = do
  s <- C.getContents
  let (n:a) = map ru $ C.words s
  print $ test n $ take n a

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

process :: [Int] -> Int
process students = maximum teamCnts where
    n = length students
    studentsArr = listArray (1, n) $ sort students :: Array Int Int
    teamCnts = map snd $ scanl foldFn (1, 0) [1..n]
    foldFn (i, _) j = (i', j - i' + 1) where
        x = studentsArr ! j
        i' = until (\_i -> (studentsArr ! _i) >= x-5) (+ 1) i

main = do
    n <- getInt
    students <- getInts
    print $ process students

{-# LANGUAGE Safe #-}
{-# Options_GHC -O3 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Char
import Data.Int
import Data.Array.Unboxed
import qualified Data.Sequence as S
import Data.Foldable
import Data.List

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

e x y = abs (x - y) <= 5

test :: Int -> [Int] -> Int
test n = maximum . map length . groupBy e . toList . S.unstableSort . S.fromList

main = do
  s <- C.getContents
  let (n:a) = map ru $ C.words s
  print $ test n $ take n a


Today, Yasser and Adel are at the shop buying cupcakes. There are $$$n$$$ cupcake types, arranged from $$$1$$$ to $$$n$$$ on the shelf, and there are infinitely many of each type. The tastiness of a cupcake of type $$$i$$$ is an integer $$$a_i$$$. There are both tasty and nasty cupcakes, so the tastiness can be positive, zero or negative.Yasser, of course, wants to try them all, so he will buy exactly one cupcake of each type.On the other hand, Adel will choose some segment $$$[l, r]$$$ $$$(1 \le l \le r \le n)$$$ that does not include all of cupcakes (he can't choose $$$[l, r] = [1, n]$$$) and buy exactly one cupcake of each of types $$$l, l + 1, \dots, r$$$.After that they will compare the total tastiness of the cupcakes each of them have bought. Yasser will be happy if the total tastiness of cupcakes he buys is strictly greater than the total tastiness of cupcakes Adel buys regardless of Adel's choice.For example, let the tastinesses of the cupcakes be $$$[7, 4, -1]$$$. Yasser will buy all of them, the total tastiness will be $$$7 + 4 - 1 = 10$$$. Adel can choose segments $$$[7], [4], [-1], [7, 4]$$$ or $$$[4, -1]$$$, their total tastinesses are $$$7, 4, -1, 11$$$ and $$$3$$$, respectively. Adel can choose segment with tastiness $$$11$$$, and as $$$10$$$ is not strictly greater than $$$11$$$, Yasser won't be happy :(Find out if Yasser will be happy after visiting the shop.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). The description of the test cases follows. The first line of each test case contains $$$n$$$ ($$$2 \le n \le 10^5$$$). The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$), where $$$a_i$$$ represents the tastiness of the $$$i$$$-th type of cupcake. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$10^5$$$.

For each test case, print "YES", if the total tastiness of cupcakes Yasser buys will always be strictly greater than the total tastiness of cupcakes Adel buys regardless of Adel's choice. Otherwise, print "NO".

NoteIn the first example, the total tastiness of any segment Adel can choose is less than the total tastiness of all cupcakes.In the second example, Adel will choose the segment $$$[1, 2]$$$ with total tastiness $$$11$$$, which is not less than the total tastiness of all cupcakes, which is $$$10$$$.In the third example, Adel can choose the segment $$$[3, 3]$$$ with total tastiness of $$$5$$$. Note that Yasser's cupcakes' total tastiness is also $$$5$$$, so in that case, the total tastiness of Yasser's cupcakes isn't strictly greater than the total tastiness of Adel's cupcakes.

maxSum []     _ acc = acc
maxSum (x:xs) soFar acc = maxSum xs soFar' acc'
  where soFar' = max (soFar + x) 0
        acc'   = max soFar' acc

process :: Int -> IO ()
process _ = do
  l <- map read . words <$> (getLine >> getLine)
  let ans = max (maxSum (tail l) 0 0) (maxSum (init l) 0 0)
  putStrLn $ if sum l > ans then "YES" else "NO"

main :: IO ()
main = (enumFromTo 1 . read <$> getLine) >>= mapM_ process

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

main = getLine >>= process.read

process 0 = return ()
process n = do
	getLine
	as <- map read.words <$> getLine
	if any (<= 0) (scanl1 (+) as) || any (<= 0) (scanl1 (+) $ reverse as)
		then putStrLn "NO"
		else putStrLn "YES"
	process $ n - 1

import Control.Monad
import Data.Foldable

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

routine :: IO ()
routine = do
  _ <- getLine
  l <- (map read.words) <$> getLine
  putStrLn $ if solve l
    then "NO"
    else "YES"

solve :: [Integer] -> Bool
solve l = solve' l || solve' (reverse l)

solve' :: [Integer] -> Bool
solve' (x:xs) =
  case foldUntill (<=0) (+) x xs of
    Left _ -> True
    Right _ -> False

foldUntill :: Foldable t => (b -> Bool)-> (b -> a -> b) -> b -> t a -> Either (b,Maybe b,Maybe a) b
foldUntill predicate binary accumulator foldable =
  if predicate accumulator
    then Left (accumulator,Nothing,Nothing)
    else foldlM f accumulator foldable
  where
    f acc val =
      let
        newValue = binary acc val
        bool = predicate newValue
      in
        if bool
          then Left (newValue,Just acc,Just val)
          else Right newValue

gs' :: [Integer] -> Integer -> Integer -> Integer
gs' [] curr ans = max curr ans
gs' (x:xs) curr ans = if x+curr >= x
                      then gs' xs (x+curr) (max (x+curr) ans)
                      else gs' xs x (max x ans)

gs :: [Integer] -> Integer
gs [] = 0
gs (x:xs) = gs' xs x x

parse :: [String] -> String
parse [_, input] = if sum' > ans then "YES" else "NO"
  where numbers = stringToIntegerArray input
        ans = max (gs $ tail numbers) (gs $ init numbers)
        sum' = sum numbers

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

-- helpers

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

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

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

main = getLine >>= process.read

process 0 = return ()
process n = do
	getLine
	as <- map read.words <$> getLine
	if any (<= 0) (scanl (+) 0 as) || any (<= 0) (scanl (+) 0 $ reverse as)
		then putStrLn "NO"
		else putStrLn "YES"
	process $ n - 1

import Control.Monad
import Data.Foldable

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

routine :: IO ()
routine = do
  _ <- getLine
  l <- (map read.words) <$> getLine
  putStrLn $ if solve l
    then "NO"
    else "YES"

solve :: [Int] -> Bool
solve l = solve' l || solve' (reverse l)

solve' :: [Int] -> Bool
solve' (x:xs) =
  case foldUntill (<=0) (+) x xs of
    Left _ -> True
    Right _ -> False

foldUntill :: Foldable t => (b -> Bool)-> (b -> a -> b) -> b -> t a -> Either (b,Maybe b,Maybe a) b
foldUntill predicate binary accumulator foldable =
  if predicate accumulator
    then Left (accumulator,Nothing,Nothing)
    else foldlM f accumulator foldable
  where
    f acc val =
      let
        newValue = binary acc val
        bool = predicate newValue
      in
        if bool
          then Left (newValue,Just acc,Just val)
          else Right newValue

gs' :: [Int] -> Int -> Int -> Int
gs' [] curr ans = max curr ans
gs' (x:xs) curr ans = if x+curr >= x
                      then gs' xs (x+curr) (max (x+curr) ans)
                      else gs' xs x (max x ans)

gs :: [Int] -> Int
gs [] = 0
gs (x:xs) = gs' xs x x

parse :: [String] -> String
parse [_, input] = if sum' > ans then "YES" else "NO"
  where numbers = stringToIntegerArray input
        ans = max (gs $ tail numbers) (gs $ init numbers)
        sum' = sum numbers

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

-- helpers

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

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


Email address in Berland is a string of the form A@B, where A and B are arbitrary strings consisting of small Latin letters. Bob is a system administrator in «Bersoft» company. He keeps a list of email addresses of the company's staff. This list is as a large string, where all addresses are written in arbitrary order, separated by commas. The same address can be written more than once.Suddenly, because of unknown reasons, all commas in Bob's list disappeared. Now Bob has a string, where all addresses are written one after another without any separators, and there is impossible to determine, where the boundaries between addresses are. Unfortunately, on the same day his chief asked him to bring the initial list of addresses. Now Bob wants to disjoin addresses in some valid way. Help him to do that.

The first line contains the list of addresses without separators. The length of this string is between 1 and 200, inclusive. The string consists only from small Latin letters and characters «@».

If there is no list of the valid (according to the Berland rules) email addresses such that after removing all commas it coincides with the given string, output No solution. In the other case, output the list. The same address can be written in this list more than once. If there are several solutions, output any of them.

--  31B

import Data.List (intercalate)
import Maybe (fromMaybe)

check  =  const True

solve :: String -> Maybe String
solve xs
  | null res  =  Nothing
  | otherwise  =  Just (intercalate "," res)
  where
    res  =  before "" [] xs
    before start acc []
      | null start  =  acc
      | otherwise  =  []
    before start acc ('@':s)
      | null start  =  []
      | otherwise  =  after start "" acc s
    before start acc (c:s)  =  before (start ++ [c]) acc s
    after begin end acc []
      | null end  =  []
      | otherwise  =  acc ++ [begin ++ "@" ++ end]
    after begin end acc ('@':s)  =  []
    after begin end acc (c:'@':s)
      | null end  =  []
      | otherwise  =  before [c] (acc ++ [begin ++ "@" ++ end]) ('@':s)
    after begin end acc (c:s)  =  after begin (end ++ [c]) acc s

main :: IO ()
main  =  getLine >>= putStrLn . fromMaybe "No solution" . solve

import Data.Functor ((<$>))
import Data.List (intercalate)

main :: IO ()
main = getLine >>= putStrLn . maybe "No solution" (intercalate ",") . solve

solve :: String -> Maybe [String]
solve xs | null xs = Just []
         | null ys || all (=='@') (take 2 zs) = Nothing
         | '@' `notElem` tail zs = Just [ xs ]
         | otherwise = (:) (ys ++ take 2 zs) <$> solve (drop 2 zs)
  where (ys, zs) = break (=='@') xs

import Data.List
import Data.Functor
main=getLine>>=putStrLn.maybe"No solution"(intercalate",").f
f x|null x=Just[]|null y||all(=='@')(take 2 z)=Nothing|'@'`notElem`tail z=Just[x]|1>0=(:)(y++take 2 z)<$>f(drop 2 z)where(y,z)=break(=='@')x

import Data.Functor ((<$>))
import Data.List (intercalate)

main :: IO ()
main = getLine >>= putStrLn . maybe "No solution" (intercalate ",") . solve

solve :: String -> Maybe [String]
solve xs | null xs = Just []
         | null ys || all (=='@') (take 2 zs) = Nothing
         | '@' `notElem` tail zs = Just [ xs ]
         | otherwise = ((ys ++ take 2 zs):) <$> solve (drop 2 zs)
  where (ys, zs) = break (=='@') xs

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Text.Printf

main :: IO ()
main = do
  let split s = do
        let (as, s1) = span (/= '@') s
            (atMark, s2) = splitAt 1 s1
            (bs, s') = span (/= '@') s2
        case () of
          _ | null as                 -> Nothing
            | atMark /= "@"           -> Nothing
            | null s'                 -> if null bs then Nothing else Just $ as ++ "@" ++ bs
            | null bs                 -> Nothing
            | head bs == '@'          -> Nothing
            | length (take 2 bs) /= 2 -> Nothing
            | otherwise               -> do
                let (bs1, bs2) = splitAt (length bs - 1) bs
                    cs = as ++ "@" ++ bs1 ++ ","
                fmap (cs ++) $ split (bs2 ++ s')
      no = putStrLn ""
  m <- split <$> getLine
  putStrLn $ maybe "No solution" id m

main = interact (ans)
ans theInput = answer address where
	address = split $ head $ lines theInput
	split xs = if y==	[] then [xs] else x:(split $ tail y) where
		(x,y) = break (=='@') xs
	check (x:xs) = ((length x) > 0):checkTail xs
	checkTail [x] = [length x > 0]
	checkTail (x:xs) = (length x > 1):checkTail xs
	answer xs = if (length xs > 1) && (and (check xs))
		then solution address else "No solution"
	solution [x,y] = ad x y
	solution (x:y:xs) = (ad x [head y]) ++ "," ++ solution ((tail y):xs)
	ad x y = x ++ "@" ++ y

import Control.Monad(guard)
main = do
  s <- getLine
  case solve s of
    Nothing -> putStrLn "No solution"
    Just r  -> putStrLn r

solve ('@':_) = Nothing
solve s | last s == '@' = Nothing
solve s =
  do
  let strings = lines . map f $ s
      first = head strings
      lst   = last strings
      mids  = tail . init $ strings
      f '@' = '\n'
      f x   = x
      insert (c:s) = c:',':s
  guard $ length strings > 1
  guard $ all ((>1) . length) mids
  Just $ first ++
           (concatMap ('@':) . map insert $ mids) ++
           "@" ++ lst

import Data.Maybe

email_recovery' [] = Just []
email_recovery' ('@':_) = Nothing
email_recovery' (x:'@':'@':_) = Nothing
email_recovery' (x:'@':y:xs) = (email_recovery' xs) >>= (\a -> Just (',':x:'@':y:a))
email_recovery' (x:xs) = (email_recovery' xs) >>= (\a -> Just (x : a))

email_recovery'' [] = Nothing
email_recovery'' ('@':_) = Nothing
email_recovery'' (x:'@':xs) = (email_recovery' (x:'@':xs)) >>= (\a -> Just(tail a))
email_recovery'' (x:xs) = (email_recovery'' xs) >>= (\a -> Just (x : a))

erec [] = ""
erec x = if isNothing result then "No solution"
         else fromJust (result)
         where result = email_recovery'' x

main = do
  inpStr <- getLine
  putStrLn (erec inpStr)

import Data.List
import Data.Functor
main=interact$maybe"No solution"(intercalate",").f
f x|null x=Just[]|null y||all(=='@')(take 2 z)=Nothing|'@'`notElem`tail z=Just[x]|1>0=(:)(y++take 2 z)<$>f(drop 2 z)where(y,z)=break(=='@')x

import Data.List
import Data.Functor
main=interact$maybe"Nosolution"(intercalate",").f
f x|null x=Just[]|null y||all(=='@')(take 2 z)=Nothing|'@'`notElem`tail z=Just[x]|1>0=(:)(y++take 2 z)<$>f(drop 2 z)where(y,z)=break(=='@')x

main = interact (ans)
ans theInput = answer where
	address = split $ head $ lines theInput
	split :: String -> [String]
	split "" = []
	split xs = if snd(break (=='@') u)=="" then [xs]
		else (x ++ (take 2 y)):(split u)
		where
			(x,y) = break (=='@') xs
			u = drop 2 y
	check = [(head x /= '@') && (last x /='@') | x<- address]
	answer = if and check then solution address else "No solution"
	solution [x] = x
	solution (x:xs) = x ++ "," ++ solution xs

main = interact (ans)
ans theInput = answer where
	line0 = head $ lines theInput
	address = split line0
	split :: String -> [String]
	split "" = []
	split xs = if snd(break (=='@') u)=="" then [xs]
		else (x ++ (take 2 y)):(split u)
		where
			(x,y) = break (=='@') xs
			u = drop 2 y
	check = [(head x /= '@') && (last x /='@') | x<- address]
	answer = if (snd(break (=='@') line0)/="") && (and check) then solution address
		else "No solution"
	solution [x] = x
	solution (x:xs) = x ++ "," ++ solution xs

main = interact (ans)
ans theInput = answer where
	line0 = head $ lines theInput
	address = split line0
	split :: String -> [String]
	split xs = if elem '@' u then (x ++ (take 2 y)):(split u) else [xs] where
		(x,y) = break (=='@') xs
		u = drop 2 y
	check = [(head x /= '@') && (last x /='@') | x<- address]
	answer = if (elem '@' line0) && (and check) then solution address else "No solution"
	solution [x] = x
	solution (x:xs) = x ++ "," ++ solution xs

import Data.Maybe

email_recovery' [] = Just []
email_recovery' ('@':_) = Nothing
email_recovery' (x:'@':'@':_) = Nothing
email_recovery' (x:'@':y:xs) = (email_recovery' xs) >>= (\a -> Just (',':x:'@':y:a))
email_recovery' (x:xs) = (email_recovery' xs) >>= (\a -> Just (x : a))

email_recovery'' [] = Nothing
email_recovery'' ('@':_) = Nothing
email_recovery'' (x:'@':xs) = (email_recovery' (x:'@':xs)) >>= (\a -> Just(tail a))
email_recovery'' (x:xs) = (email_recovery'' xs) >>= (\a -> Just (x : a))

erec [] = ""
erec x = if isNothing result then "No solution."
         else fromJust (result)
         where result = email_recovery'' x

main = do
  inpStr <- getLine
  putStrLn (erec inpStr)


There is an easy way to obtain a new task from an old one called "Inverse the problem": we give an output of the original task, and ask to generate an input, such that solution to the original problem will produce the output we provided. The hard task of Topcoder Open 2014 Round 2C, InverseRMQ, is a good example.Now let's create a task this way. We will use the task: you are given a tree, please calculate the distance between any pair of its nodes. Yes, it is very easy, but the inverse version is a bit harder: you are given an n × n distance matrix. Determine if it is the distance matrix of a weighted tree (all weights must be positive integers).

The first line contains an integer n (1 ≤ n ≤ 2000) — the number of nodes in that graph. Then next n lines each contains n integers di, j (0 ≤ di, j ≤ 109) — the distance between node i and node j.

If there exists such a tree, output "YES", otherwise output "NO".

NoteIn the first example, the required tree exists. It has one edge between nodes 1 and 2 with weight 2, another edge between nodes 1 and 3 with weight 7.In the second example, it is impossible because d1, 1 should be 0, but it is 1.In the third example, it is impossible because d1, 2 should equal d2, 1.

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
import Debug.Trace
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  n <- readLn
  mat <- listArray((0,0),(n-1,n-1)).map readInt.B.words <$> B.getContents
  putStrLn.bool"YES""NO" $ solve n mat

solve :: Int -> UArray (Vertex,Vertex) Cost -> Bool
solve n mat
  | and [precheck i j|i<-[0..n-1],j<-[i..n-1]] = all check [0..n-1]
  | otherwise = False
   where
     precheck i j = if i /= j then sym i j && pos i j else diag i
     diag i = unsafeAt mat (i*n+i) == 0
     sym i j = unsafeAt mat (i*n+j) == unsafeAt mat (j*n+i)
     pos i j = unsafeAt mat (i*n+j) > 0
     !mst = prim n mat
     check root = and [unsafeAt mat (root*n+i) == unsafeAt cost i | i<-[0..n-1]]
       where
        !cost = treeDFS root mst

inf :: Int
inf = 0x3f3f3f3f

nothing :: Int
nothing = (-1)

type Vertex = Int
type Cost = Int

prim :: Int -> UArray (Vertex,Vertex) Cost -> Array Vertex [(Cost, Vertex)]
prim numV cost = runSTArray $ do
  parent  <- newArray (0,numV-1) nothing :: ST s (STUArray s Vertex Vertex)
  minCost <- newArray (0,numV-1) inf     :: ST s (STUArray s Vertex Cost)
  used    <- newArray (0,numV-1) False   :: ST s (STUArray s Vertex Bool)

  let root = 0
  unsafeWrite minCost root 0

  fix $ \loop -> do
    let go !i !minV
          | i < numV = do
             isUsed <- unsafeRead used i
             if isUsed then go (i+1) minV
             else if minV == nothing then go (i+1) i
             else do
               ci <- unsafeRead minCost i
               cv <- unsafeRead minCost minV
               go (i+1) $ if ci < cv then i else minV
          | otherwise = unless (minV == nothing) $ do
              unsafeWrite used minV True
              rep numV $ \v -> do
                old <- unsafeRead minCost v
                let !new = unsafeAt cost (minV * numV + v)
                when (new < old && minV /= v) $ do
                  unsafeWrite minCost v new
                  isUsed <- unsafeRead used v
                  unless isUsed $ do
                    unsafeWrite parent v minV
              loop
    go root nothing

  gr <- newArray (0,numV-1) [] :: ST s (STArray s Vertex [(Cost, Vertex)])

  for 1 (< numV) (1+) $ \v -> do
    p <- unsafeRead parent v
    let !c = unsafeAt cost (p * numV + v)
    unsafeModify gr v ((c, p):)
    unsafeModify gr p ((c, v):)

  return gr

treeDFS :: Vertex -> Array Vertex [(Cost, Vertex)] -> UArray Vertex Cost
treeDFS root tree = runSTUArray $ do
  cost <- newArray (bounds tree) inf  :: ST s (STUArray s Vertex Cost)
  vis <- newArray (bounds tree) False :: ST s (STUArray s Vertex Bool)

  unsafeWrite cost root 0
  unsafeWrite vis root True

  let dfs v = do
        !cv <- unsafeRead cost v
        forM_ (unsafeAt tree v) $ \(c,nv) -> do
          visited <- unsafeRead vis nv
          unless visited $ do
            unsafeWrite vis nv True
            unsafeWrite cost nv $ cv + c
            dfs nv
  dfs root

  return cost

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
import Debug.Trace
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  n <- readLn
  mat <- listArray((0,0),(n-1,n-1)).map readInt.B.words <$> B.getContents
  putStrLn.bool"YES""NO" $ solve n mat

solve :: Int -> UArray (Vertex,Vertex) Cost -> Bool
solve n mat
  | and [precheck i j|i<-[0..n-1],j<-[i..n-1]] = all check [0..n-1]
  | otherwise = False
   where
     precheck i j = if i /= j then sym i j && pos i j else diag i
     diag i = unsafeAt mat (i*n+i) == 0
     sym i j = unsafeAt mat (i*n+j) == unsafeAt mat (j*n+i)
     pos i j = unsafeAt mat (i*n+j) > 0
     !mst = prim n mat
     check root = and [unsafeAt mat (root*n+i) == unsafeAt cost i | i<-[0..n-1]]
       where
        !cost = treeDFS root mst

inf :: Int
inf = 0x3f3f3f3f

nothing :: Int
nothing = (-1)

type Vertex = Int
type Cost = Int

prim :: Int -> UArray (Vertex,Vertex) Cost -> Array Vertex [(Cost, Vertex)]
prim numV cost = runSTArray $ do
  parent  <- newArray (0,numV-1) nothing :: ST s (STUArray s Vertex Vertex)
  minCost <- newArray (0,numV-1) inf     :: ST s (STUArray s Vertex Cost)
  used    <- newArray (0,numV-1) False   :: ST s (STUArray s Vertex Bool)

  let root = 0
  unsafeWrite minCost root 0

  fix $ \loop -> do
    let go !i !minV
          | i < numV = do
             isUsed <- unsafeRead used i
             if isUsed then go (i+1) minV
             else if minV == nothing then go (i+1) i
             else do
               ci <- unsafeRead minCost i
               cv <- unsafeRead minCost minV
               go (i+1) $ if ci < cv then i else minV
          | otherwise = unless (minV == nothing) $ do
              unsafeWrite used minV True
              rep numV $ \v -> do
                old <- unsafeRead minCost v
                let !new = unsafeAt cost (minV * numV + v)
                when (new < old && minV /= v) $ do
                  unsafeWrite minCost v new
                  unsafeWrite parent v minV
              loop
    go root nothing

  gr <- newArray (0,numV-1) [] :: ST s (STArray s Vertex [(Cost, Vertex)])

  for 1 (< numV) (1+) $ \v -> do
    p <- unsafeRead parent v
    let !c = unsafeAt cost (p * numV + v)
    unsafeModify gr v ((c, p):)
    unsafeModify gr p ((c, v):)

  return gr

treeDFS :: Vertex -> Array Vertex [(Cost, Vertex)] -> UArray Vertex Cost
treeDFS root tree = runSTUArray $ do
  cost <- newArray (bounds tree) inf  :: ST s (STUArray s Vertex Cost)
  vis <- newArray (bounds tree) False :: ST s (STUArray s Vertex Bool)

  unsafeWrite cost root 0
  unsafeWrite vis root True

  let dfs v = do
        !cv <- unsafeRead cost v
        forM_ (unsafeAt tree v) $ \(c,nv) -> do
          visited <- unsafeRead vis nv
          unless visited $ do
            unsafeWrite vis nv True
            unsafeWrite cost nv $ cv + c
            dfs nv
  dfs root

  return cost


You are given a string $$$s$$$, consisting only of Latin letters 'a', and a string $$$t$$$, consisting of lowercase Latin letters.In one move, you can replace any letter 'a' in the string $$$s$$$ with a string $$$t$$$. Note that after the replacement string $$$s$$$ might contain letters other than 'a'.You can perform an arbitrary number of moves (including zero). How many different strings can you obtain? Print the number, or report that it is infinitely large.Two strings are considered different if they have different length, or they differ at some index.

The first line contains a single integer $$$q$$$ ($$$1 \le q \le 10^4$$$) — the number of testcases. The first line of each testcase contains a non-empty string $$$s$$$, consisting only of Latin letters 'a'. The length of $$$s$$$ doesn't exceed $$$50$$$. The second line contains a non-empty string $$$t$$$, consisting of lowercase Latin letters. The length of $$$t$$$ doesn't exceed $$$50$$$.

For each testcase, print the number of different strings $$$s$$$ that can be obtained after an arbitrary amount of moves (including zero). If the number is infinitely large, print -1. Otherwise, print the number.

NoteIn the first example, you can replace any letter 'a' with the string "a", but that won't change the string. So no matter how many moves you make, you can't obtain a string other than the initial one.In the second example, you can replace the second letter 'a' with "abc". String $$$s$$$ becomes equal to "aabc". Then the second letter 'a' again. String $$$s$$$ becomes equal to "aabcbc". And so on, generating infinitely many different strings.In the third example, you can either leave string $$$s$$$ as is, performing zero moves, or replace the only 'a' with "b". String $$$s$$$ becomes equal to "b", so you can't perform more moves on it.

import Control.Monad

solve (x,y) | (y=="a") = 1
            | (any (=='a') y) = -1
            | otherwise = 2 ^ length x

main = do
  t <- getLine
  cases <- replicateM (read t) readCase
  putStrLn (unwords $ map (show . solve) cases)

readCase = do
  x <- getLine
  y <- getLine
  return (x, y)

import Control.Monad

solve (x,y) | (y=="a") = 1
            | (any (=='a') y) = -1
            | otherwise = 1 + sum (map (\k -> (toInteger n) `choose` k) (take n [1..]))
  where n = length x

main = do
  t <- getLine
  cases <- replicateM (read t) readCase
  putStrLn (unwords $ map (show . solve) cases)

readCase = do
  x <- getLine
  y <- getLine
  return (x, y)

n `choose` k
    | k < 0     = 0
    | k > n     = 0
    | otherwise = factorial n `div` (factorial k* factorial (n-k))

factorial n = product [1..n]

import Control.Monad (replicateM_)

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

main = do
    testCases <- getLine
    replicateM_ (read testCases) (runCase >>= putStrLn)

runCase = do
    lin <- getLine
    show . solve lin <$> getLine

solve inp subst | ('a' `notElem` inp) || (subst == "a") = 1
solve inp subst | (length subst > 1) && (elem 'a' subst) = if ('a' `elem` inp) then -1 else 1
solve inp _ = 2^(length $ filter (=='a') inp)

import Control.Monad

solve (x,y) | (y=="a") = 1
            | (any (=='a') y) = -1
            | otherwise = 1 + sum (map (\k -> n `choose` k) (take n [1..]))
  where n = length x

main = do
  t <- getLine
  cases <- replicateM (read t) readCase
  putStrLn (unwords $ map (show . solve) cases)

readCase = do
  x <- getLine
  y <- getLine
  return (x, y)

n `choose` k
    | k < 0     = 0
    | k > n     = 0
    | otherwise = factorial n `div` (factorial k * factorial (n-k))

factorial n = product [1..n]

import Control.Monad

solve (x,y) | (y=="a") = 1
            | (any (=='a') y) = -1
            | otherwise = length x + 1

main = do
  t <- getLine
  cases <- replicateM (read t) readCase
  putStrLn (unwords $ map (show . solve) cases)

readCase = do
  x <- getLine
  y <- getLine
  return (x, y)


Vova's house is an array consisting of $$$n$$$ elements (yeah, this is the first problem, I think, where someone lives in the array). There are heaters in some positions of the array. The $$$i$$$-th element of the array is $$$1$$$ if there is a heater in the position $$$i$$$, otherwise the $$$i$$$-th element of the array is $$$0$$$.Each heater has a value $$$r$$$ ($$$r$$$ is the same for all heaters). This value means that the heater at the position $$$pos$$$ can warm up all the elements in range $$$[pos - r + 1; pos + r - 1]$$$.Vova likes to walk through his house while he thinks, and he hates cold positions of his house. Vova wants to switch some of his heaters on in such a way that each element of his house will be warmed up by at least one heater. Vova's target is to warm up the whole house (all the elements of the array), i.e. if $$$n = 6$$$, $$$r = 2$$$ and heaters are at positions $$$2$$$ and $$$5$$$, then Vova can warm up the whole house if he switches all the heaters in the house on (then the first $$$3$$$ elements will be warmed up by the first heater and the last $$$3$$$ elements will be warmed up by the second heater).Initially, all the heaters are off.But from the other hand, Vova didn't like to pay much for the electricity. So he wants to switch the minimum number of heaters on in such a way that each element of his house is warmed up by at least one heater.Your task is to find this number of heaters or say that it is impossible to warm up the whole house.

The first line of the input contains two integers $$$n$$$ and $$$r$$$ ($$$1 \le n, r \le 1000$$$) — the number of elements in the array and the value of heaters. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 1$$$) — the Vova's house description.

Print one integer — the minimum number of heaters needed to warm up the whole house or -1 if it is impossible to do it.

NoteIn the first example the heater at the position $$$2$$$ warms up elements $$$[1; 3]$$$, the heater at the position $$$3$$$ warms up elements $$$[2, 4]$$$ and the heater at the position $$$6$$$ warms up elements $$$[5; 6]$$$ so the answer is $$$3$$$.In the second example the heater at the position $$$1$$$ warms up elements $$$[1; 3]$$$ and the heater at the position $$$5$$$ warms up elements $$$[3; 5]$$$ so the answer is $$$2$$$.In the third example there are no heaters so the answer is -1.In the fourth example the heater at the position $$$3$$$ warms up elements $$$[1; 5]$$$, the heater at the position $$$6$$$ warms up elements $$$[4; 8]$$$ and the heater at the position $$$10$$$ warms up elements $$$[8; 10]$$$ so the answer is $$$3$$$.

{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Data.List

import Data.Array

solve :: Int -> Int -> [Int] -> Int
solve n r as = iter 0 1
  where
    aa = listArray (1, n) as

    iter !k i
        | i > n     = k
        | otherwise = case findHeater i of
            Nothing -> -1
            Just h  -> iter (k + 1) (h + r)
      where
        ai = aa ! i

    findHeater i
        | null as   = Nothing
        | otherwise = Just (maximum as)
      where
        as = do
            j <- [max 1 (i - r + 1) .. min n (i + r - 1)]
            guard $ (aa ! j) == 1
            return j

main :: IO ()
main = do
    [n, r] <- fmap read . words <$> getLine :: IO [Int]
    as <- fmap read . words <$> getLine :: IO [Int]
    print $ solve n r as

{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Data.List

import Data.Array

solve :: Int -> Int -> [Int] -> Int
solve n r as = iter 0 1
  where
    iter !k i
        | i > n   = k
        | ai == 0 = case findh i of
            Nothing -> -1
            Just h  -> iter (k + 1) (h + r)
        | otherwise = iter k (i + 1)
      where
        ai = aa ! i
    aa = listArray (1, n) as
    findh i
        | null as   = Nothing
        | otherwise = Just (maximum as)
      where
        as = do
            j <- [max 1 (i - r + 1) .. min n (i + r - 1)]
            guard $ (aa ! j) == 1
            return j

main :: IO ()
main = do
    [n, r] <- fmap read . words <$> getLine :: IO [Int]
    as <- fmap read . words <$> getLine :: IO [Int]
    print $ solve n r as


You are given a book with $$$n$$$ chapters.Each chapter has a specified list of other chapters that need to be understood in order to understand this chapter. To understand a chapter, you must read it after you understand every chapter on its required list.Currently you don't understand any of the chapters. You are going to read the book from the beginning till the end repeatedly until you understand the whole book. Note that if you read a chapter at a moment when you don't understand some of the required chapters, you don't understand this chapter.Determine how many times you will read the book to understand every chapter, or determine that you will never understand every chapter no matter how many times you read the book.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 2\cdot10^4$$$). The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2\cdot10^5$$$) — number of chapters. Then $$$n$$$ lines follow. The $$$i$$$-th line begins with an integer $$$k_i$$$ ($$$0 \le k_i \le n-1$$$) — number of chapters required to understand the $$$i$$$-th chapter. Then $$$k_i$$$ integers $$$a_{i,1}, a_{i,2}, \dots, a_{i, k_i}$$$ ($$$1 \le a_{i, j} \le n, a_{i, j} \ne i, a_{i, j} \ne a_{i, l}$$$ for $$$j \ne l$$$) follow — the chapters required to understand the $$$i$$$-th chapter. It is guaranteed that the sum of $$$n$$$ and sum of $$$k_i$$$ over all testcases do not exceed $$$2\cdot10^5$$$.

For each test case, if the entire book can be understood, print how many times you will read it, otherwise print $$$-1$$$.

NoteIn the first example, we will understand chapters $$$\{2, 4\}$$$ in the first reading and chapters $$$\{1, 3\}$$$ in the second reading of the book.In the second example, every chapter requires the understanding of some other chapter, so it is impossible to understand the book.In the third example, every chapter requires only chapters that appear earlier in the book, so we can understand everything in one go.In the fourth example, we will understand chapters $$$\{2, 3, 4\}$$$ in the first reading and chapter $$$1$$$ in the second reading of the book.In the fifth example, we will understand one chapter in every reading from $$$5$$$ 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.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

type Graph = Array Int [Int]

newSTUArray :: (Int, Int) -> Int -> ST s (STUArray s Int Int)
newSTUArray = newArray

modifyArray :: STUArray s Int Int -> Int -> (Int -> Int) -> ST s ()
modifyArray arr ix fun = readArray arr ix >>= writeArray arr ix . fun

data SQ a = SQ ![a] ![a] -- sequential queue

pop :: SQ a -> Maybe (a, SQ a)
pop (SQ (x : xs) ys) = Just (x, SQ xs ys)
pop (SQ [] ys) = do
  (x, xs) <- uncons $ reverse ys
  pure (x, SQ xs [])

push :: SQ a -> a -> SQ a
push (SQ xs ys) y = SQ xs (y : ys)

skip :: a -> SQ a -> SQ a
skip x (SQ xs ys) = SQ (x : xs) ys

solve :: Graph -> Int
solve adj = runST $ do
  let bnds = bounds adj
  inDegs <- newSTUArray bnds 0
  forM_ adj $ \outs ->
    forM_ outs $ \jj ->
      modifyArray inDegs jj (+ 1)
  initAccessible <- filterM (fmap (== 0) . readArray inDegs) $ indices adj
  costArr <- newSTUArray bnds 1
  (\fun -> foldM_ fun (SQ initAccessible []) (indices adj))
    $ \queue _ -> case  pop queue  of
    Nothing -> pure queue
    Just (x, xs) -> do
      currCost <- readArray costArr x
      (\fun -> foldM fun xs (adj ! x)) $ \cqueue y -> do
        prevycost <- readArray costArr y
        let  newycost = max prevycost $ currCost + if  y < x  then  1  else  0
        writeArray costArr y newycost
        yin <- readArray inDegs y
        writeArray inDegs y $ yin - 1
        pure $ if  yin /= 1
          then  cqueue
          else  if  newycost == currCost
          then  skip y cqueue
          else  push cqueue y
  finalCosts <- getElems costArr
  finalInDegs <- getElems inDegs
  pure $ if  any (/= 0) finalInDegs
    then  0-1 -- no solution
    else  foldl' max 0 finalCosts

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    reqs <- replicateM n $ do
      ~[ki] <- getInts 1
      getInts ki
    let
      fwd :: Graph
      fwd = accumArray (flip (:)) [] (1, n)
        $ [(ii, jj) | (jj, ins) <- zip [1..] reqs, ii <- ins]
    pure $ putInts [solve fwd]

type SP = State [P.ByteString]
type SO = SP Builder

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

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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


A telephone number is a sequence of exactly $$$11$$$ digits such that its first digit is 8.Vasya and Petya are playing a game. Initially they have a string $$$s$$$ of length $$$n$$$ ($$$n$$$ is odd) consisting of digits. Vasya makes the first move, then players alternate turns. In one move the player must choose a character and erase it from the current string. For example, if the current string 1121, after the player's move it may be 112, 111 or 121. The game ends when the length of string $$$s$$$ becomes 11. If the resulting string is a telephone number, Vasya wins, otherwise Petya wins.You have to determine if Vasya has a winning strategy (that is, if Vasya can win the game no matter which characters Petya chooses during his moves).

The first line contains one integer $$$n$$$ ($$$13 \le n < 10^5$$$, $$$n$$$ is odd) — the length of string $$$s$$$. The second line contains the string $$$s$$$ ($$$|s| = n$$$) consisting only of decimal digits.

If Vasya has a strategy that guarantees him victory, print YES. Otherwise print NO.

NoteIn the first example Vasya needs to erase the second character. Then Petya cannot erase a character from the remaining string 880011223344 so that it does not become a telephone number.In the second example after Vasya's turn Petya can erase one character character 8. The resulting string can't be a telephone number, because there is no digit 8 at all.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = do
	n <- readInt
	s <- getLine
	let
		turn = ( n - 11 ) `div` 2
		prefix = vasya turn s
		num8 = length $ takeWhile ( == '8' ) prefix
	putStrLn $ which "YES" "NO" $ turn < num8

vasya _ [] = []
vasya 0 s = s
vasya k (c:s)
	| c == '8' = c : vasya k s
	| otherwise = vasya ( pred k ) s

--import Data.Bits
--import Control.Monad
import Data.List
--import Control.Monad.Writer
--import Data.Maybe
main :: IO ()
main = do
	mm <- getLine
	let n=read mm
	s <- getLine

	putStrLn $ if f n s then "YES" else "NO"
	return ()

f :: Int -> String -> Bool
f n s = let m = (n-11) in
        if (length $ fst (partition (==1) $ take (m+1) $ concat $ group (map h s)))>(m `div` 2)  then True else False

h :: Char -> Int
h '8' = 1
h _   = 0

t :: [Int] -> [Int]
t s =(delete 1 (delete 0 s))


You're given an array $$$a$$$ of length $$$2n$$$. Is it possible to reorder it in such way so that the sum of the first $$$n$$$ elements isn't equal to the sum of the last $$$n$$$ elements?

The first line contains an integer $$$n$$$ ($$$1 \le n \le 1000$$$), where $$$2n$$$ is the number of elements in the array $$$a$$$. The second line contains $$$2n$$$ space-separated integers $$$a_1$$$, $$$a_2$$$, $$$\ldots$$$, $$$a_{2n}$$$ ($$$1 \le a_i \le 10^6$$$) — the elements of the array $$$a$$$.

If there's no solution, print "-1" (without quotes). Otherwise, print a single line containing $$$2n$$$ space-separated integers. They must form a reordering of $$$a$$$. You are allowed to not change the order.

NoteIn the first example, the first $$$n$$$ elements have sum $$$2+1+3=6$$$ while the last $$$n$$$ elements have sum $$$1+1+2=4$$$. The sums aren't equal.In the second example, there's no solution.

import Data.List
import Control.Monad
main = interact $ format . solve . map read . tail . words
solve as = guard (sum ls /= sum rs) *> pure ss where
  ss = sort as
  (ls,rs) = splitAt (length ss `div` 2) ss
format Nothing = "-1"
format (Just xs) = unwords $ map show xs

module Main where
import Data.List

main = interact $ (\(n:xs) -> maybe "-1" (unwords . map show) $ ok n $ sort xs) . map read . words
ok n xs
  | sum zs == sum ys = Nothing
  | True = Just xs
  where (ys, zs) = splitAt n xs

module Main where

main = interact $ (\(n:xs) -> if rep xs then "-1" else unwords $ map show $ uncurry (mix [] []) $ splitAt n xs ) . map read . words
rep (x:xs) = all (== x) xs
mix xs' ys' [] [] = xs' ++ ys'
mix xs' ys' (x:xs) (y:ys)
  | x /= y = mix (y:xs') (x:ys') xs ys
  | True = mix (x:xs') (y:ys') xs ys

module Main where

main = interact $ (\(n:xs) -> unwords $ map show $ uncurry go $ splitAt n xs) . map read . words
go xs ys
  | sum xs /= sum ys = xs ++ ys
  | True = mix False [] [] xs ys
mix False _ _ [] [] = [-1]
mix True xs' ys' [] [] = xs' ++ ys'
mix b xs' ys' (x:xs) (y:ys)
  | not b && x /= y = mix True (y:xs') (x:ys') xs ys
  | True = mix b (x:xs') (y:ys') xs ys