It is lunch time for Mole. His friend, Marmot, prepared him a nice game for lunch.Marmot brought Mole n ordered piles of worms such that i-th pile contains ai worms. He labeled all these worms with consecutive integers: worms in first pile are labeled with numbers 1 to a1, worms in second pile are labeled with numbers a1 + 1 to a1 + a2 and so on. See the example for a better understanding.Mole can't eat all the worms (Marmot brought a lot) and, as we all know, Mole is blind, so Marmot tells him the labels of the best juicy worms. Marmot will only give Mole a worm if Mole says correctly in which pile this worm is contained.Poor Mole asks for your help. For all juicy worms said by Marmot, tell Mole the correct answers.

The first line contains a single integer n (1 ≤ n ≤ 105), the number of piles. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 103, a1 + a2 + ... + an ≤ 106), where ai is the number of worms in the i-th pile. The third line contains single integer m (1 ≤ m ≤ 105), the number of juicy worms said by Marmot. The fourth line contains m integers q1, q2, ..., qm (1 ≤ qi ≤ a1 + a2 + ... + an), the labels of the juicy worms.

Print m lines to the standard output. The i-th line should contain an integer, representing the number of the pile where the worm labeled with the number qi is.

NoteFor the sample input:  The worms with labels from [1, 2] are in the first pile.  The worms with labels from [3, 9] are in the second pile.  The worms with labels from [10, 12] are in the third pile.  The worms with labels from [13, 16] are in the fourth pile.  The worms with labels from [17, 25] are in the fifth pile.

module Main (main)
    where

import Data.Maybe (mapMaybe)
import Data.Array (Ix, Array, listArray, bounds, (!))
import Control.Monad (mapM_)

type Bucket = (Int,Int)

pile :: (Integral i, Ix i) => Int -> Array i (Int,Bucket) -> Maybe Int
pile i a = search a i 0 $ snd $ bounds a
    where search xs needle lo hi
            | hi <= lo   = Nothing
            | needle < a = search xs needle lo mid
            | needle > b = search xs needle (mid + 1) hi
            | otherwise  = Just p
                where mid = lo + (hi - lo) `div` 2
                      (p,(a,b)) = xs!mid

buckets :: [Int] -> [Bucket]
buckets xs = zipWith (\a b -> (a + 1, b)) s $ tail s
    where s = 0:scanl1 (+) xs

main :: IO ()
main = do
    a <- getLine >> getLine
    q <- getLine >> getLine
    let [as,qs] = map (map read . words) [a,q]
    let bs = listArray (0, length as) $ zip [1..] $ buckets as
    mapM_ print $ mapMaybe (flip pile bs) qs

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

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

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

main = do
  getLine
  cs <- getInts

  let
    s = sum cs
    is = listArray (1, s) $ concat $ zipWith (\c i -> replicate c i) cs [1..] :: UArray Int Int

  getLine
  qs <- getInts

  putStrLn $ unlines $ map show $ map (is!) qs

import Control.Monad
import Text.Printf
import Data.List
import Data.Array

bisearch :: Array Int Int -> (Int, Int) -> Int -> Int
bisearch a (lb, rb) q
   | rb-lb == 1= rb
   | me >= q   = bisearch a (lb, md) q
   | otherwise = bisearch a (md, rb) q
   where md = (lb+rb) `div` 2
         me = a ! md

solve = bisearch

main = do
   n <- getLine >>= return . (read :: String -> Int)
   a <- getLine >>= return . listArray (0,100010) .  scanl (+) 0 . map (read :: String -> Int) . words
   m <- getLine >>= return . (read :: String -> Int)
   q <- getLine >>= return . map (read :: String -> Int) . words
   forM_ (q >>= return . solve a (0, n)) print

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine>>= \n-> (solve.(\[a,b,c]->[[read n], a,c]) =<< forM [1 ..3] ( \i -> map (fst.fromJust.C.readInteger).C.words <$> C.getLine))
solve [n,xs,ys] =let m = slv1 xs; tr=slv2 1 (head n) m in forM_ ys $ \i -> print $ slv3 i tr
slv1 xs = let s= scanl (+) 0 xs in Map.fromList $ zip [1..] $ zip s (tail s)
slv2 x1 x2 m = unfoldTree f (x1,x2)
  where
  f (b1,b2)=let z=((b2-b1) `div`2)+b1 in if b1==b2 then ((b1,m Map.!b1),[]) else if z==b1 then ((z,m Map.!z),[(b2,b2)]) else ((z,m Map.!z), [(b1, z-1),(z+1,b2)] )
slv3 n (Node (z,(x,y)) []) = z
slv3 n (Node (z,(x,y)) fs) | n> x && n<=y =z
                           | n==x         =z-1
                           | n==y+1       =z+1
                           | n<x          = slv3 n (head fs)
                           | n>y+1        = slv3 n (last fs)

import Control.Applicative
import Data.Array

solve :: [Int] -> [Int] -> [Int]
solve as ms =
    binSearch 0 (length as) <$> ms
    where as' = listArray (0, length as) $ scanl (+) 0 as
          binSearch :: Int -> Int -> Int -> Int
          binSearch l r v
               | l == r = r
               | v <= d = binSearch l m v
               | d < v = binSearch (m + 1) r v
               where m = l + (div (r-l) 2)
                     d = as' ! m

main = do
    getLine
    as <- fmap read.words <$> getLine
    getLine
    ms <- fmap read.words <$> getLine
    let q = solve as ms
    mapM_ print q

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

main = do
  C.getLine
  s<- scanl1 (+) <$> map (fst.fromJust.C.readInt) <$> C.words <$> C.getLine ::IO [Int]
  let s1 = M.fromList $ zip s [1..]
  C.getLine
  t<- map (fst.fromJust.C.readInt) <$> C.words <$> C.getLine ::IO [Int]
  mapM_ print $  map (\z->snd $ fromJust $ M.lookupGE z s1) t

import qualified Data.Array as A

main :: IO ()
main = getContents >>= mapM_ print . solve . map (map read . words) . lines

solve :: [[Int]] -> [Int]
solve [[n], as, _, qs] = map (binsearch (A.listArray (0, n) (scanl (+) 0 as))) qs
solve _ = undefined

binsearch :: A.Array Int Int -> Int -> Int
binsearch xs x = go (A.bounds xs)
  where go (a, b) | a + 1 == b = b
                  | x <= xs A.! c = go (a, c)
                  | otherwise = go (c, b)
          where c = (a + b) `div` 2

import Data.Array
main = do
  n <- readLn
  as <- fmap (listArray (0,n) . scanl (+) 0 . map read . words) getLine
  let bsearch l r i | r - l <= 1 = r
                    | as!m < i = bsearch m r i
                    | otherwise = bsearch l m i
        where m = div (l + r + 1) 2
  getLine
  sequence . map (print . bsearch 0 n . read) . words =<< getLine

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
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, range, unsafeIndex)
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;_->error$"readInt error : bs = "++show bs;}
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 #-}

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

main :: IO ()
main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  _m<-getLine
  qs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show $ solve n xs qs

solve :: Int -> [Int] -> [Int] -> [Int]
solve n xs qs = map query qs
   where
     arr :: UArray Int Int
     !arr = listArray(0,n)$scanl1(+)$0:xs
     query q = lowerBound (\i->unsafeAt arr i>=q) 0 n

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

process s ls t =  map (process1 1 ls) t
	where process1 le ri m| s!mi ==m = mi
			      | s!mi >m && s!(mi-1)<m = mi
			      | s!mi >m = process1 le (mi-1) m
			      | otherwise = process1 (mi+1) ri m
		where mi = div (le +ri) 2
main=do
	getLine
	s<-map (fst. fromJust.C.readInt) . C.words <$>C.getLine:: IO [Int]
	let ls = length s
	let s1 =  listArray (0,ls)  $ scanl (+) 0 s
	getLine
	t<-map (fst. fromJust.C.readInt) . C.words <$>C.getLine:: IO [Int]
	mapM_ print $   process s1 ls t

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.ByteString.Builder

main :: IO ()
main = do
        [[n], as,_,qs ]  <- getIntLoLBs
        BS.putStrLn $ printMatrixBS $ matrixIntToBs $ solve n as qs

readMatrixBS :: BS.ByteString -> [[BS.ByteString]]
readMatrixBS = fmap BS.words . BS.lines

matrixToNumBs :: (Num a) => [[BS.ByteString]] ->[[a]]
matrixToNumBs = fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger

solve :: Int -> [Int] -> [Int] -> [[Int]]
solve n as qs =
    let sums = scanl (+) 1 as
        zipped = sums `zip` [1 ..]
        tree = fst $ buildT zipped n
        find v = findLabel v tree 0
        answers = map find qs
     in map return answers

data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show)

buildT :: [a] -> Int -> (Tree a, [a])
buildT xs 0 = (Nil, xs)
buildT xs n = (Node val leftSon rightSon, rightRems)
    where leftCount = n `div` 2
          (leftSon, leftRems) = buildT xs leftCount
          val = head leftRems
          (rightSon, rightRems) = buildT (tail leftRems) (n - leftCount - 1)

findLabel :: (Ord value) => value -> Tree (value, label) -> label -> label
findLabel _ Nil prevGuess = prevGuess
findLabel v' (Node (v,label) left right)  prevGuess
    | v' > v = findLabel v' right  label
    | v' < v = findLabel v' left  prevGuess
    | otherwise = label

getIntLoLBs :: IO [[Int]]
getIntLoLBs = do
               c <- BS.getContents
               return . matrixToNumBs . readMatrixBS $ c

matrixIntToBs :: (Integral a) => [[a]] -> [[BS.ByteString]]
matrixIntToBs = fmap.fmap $ (toLazyByteString . integerDec . toInteger)

printMatrixBS :: [[BS.ByteString]] -> BS.ByteString
printMatrixBS = BS.unlines . fmap BS.unwords

import Control.Monad
import Text.Printf
import Data.List
import Data.Array

bisearch :: Array Int Int -> (Int, Int) -> Int -> Int
bisearch a (lb, rb) q
   | rb-lb == 1= rb
   | q < me    = bisearch a (lb, md) q
   | otherwise = bisearch a (md, rb) q
   where md = (lb+rb) `div` 2
         me = a ! md

solve = bisearch

main = do
   n <- getLine >>= return . (read :: String -> Int)
   a <- getLine >>= return . listArray (0,100010) .  scanl (+) 0 . map (read :: String -> Int) . words
   m <- getLine >>= return . (read :: String -> Int)
   q <- getLine >>= return . map (read :: String -> Int) . words
   forM_ (q >>= return . solve a (0, n)) print

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
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, range, unsafeIndex)
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;_->error$"readInt error : bs = "++show bs;}
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 #-}

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = assert (low>=0 && p high) $ go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

main :: IO ()
main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  _m<-getLine
  qs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show $ solve n xs qs

solve :: Int -> [Int] -> [Int] -> [Int]
solve n xs qs = map (succ.query.pred) qs
   where
     arr :: UArray Int Int
     !arr = listArray(0,n-1)$scanl1(+)xs
     query q = lowerBound (\i->unsafeAt arr i>=q) 0 (n-1)


There are $$$n$$$ consecutive seat places in a railway carriage. Each place is either empty or occupied by a passenger.The university team for the Olympiad consists of $$$a$$$ student-programmers and $$$b$$$ student-athletes. Determine the largest number of students from all $$$a+b$$$ students, which you can put in the railway carriage so that:  no student-programmer is sitting next to the student-programmer;  and no student-athlete is sitting next to the student-athlete. In the other words, there should not be two consecutive (adjacent) places where two student-athletes or two student-programmers are sitting.Consider that initially occupied seat places are occupied by jury members (who obviously are not students at all).

The first line contain three integers $$$n$$$, $$$a$$$ and $$$b$$$ ($$$1 \le n \le 2\cdot10^{5}$$$, $$$0 \le a, b \le 2\cdot10^{5}$$$, $$$a + b > 0$$$) — total number of seat places in the railway carriage, the number of student-programmers and the number of student-athletes. The second line contains a string with length $$$n$$$, consisting of characters "." and "*". The dot means that the corresponding place is empty. The asterisk means that the corresponding place is occupied by the jury member.

Print the largest number of students, which you can put in the railway carriage so that no student-programmer is sitting next to a student-programmer and no student-athlete is sitting next to a student-athlete.

NoteIn the first example you can put all student, for example, in the following way: *.AB*In the second example you can put four students, for example, in the following way: *BAB*BIn the third example you can put seven students, for example, in the following way: B*ABAB**A*BThe letter A means a student-programmer, and the letter B — student-athlete.

main = getContents >>= print . solve . parse . words . map toblank
    where parse (_:a:b:xs) = (read a, read b, map length xs)
          toblank c = if c == '*' then ' ' else c

solve (a,b,xs) = solve_ (swap a b) $ map oddEven xs
    where swap a b = if a > b then (a,b) else (b,a)
          oddEven x = let a = x `div` 2 in (x - a, a)

solve_ (0,0) _ = 0
solve_ (a,b) [] = 0
solve_ (a,b) ((x,y):xs)
    | a - a' > b - b' = a' + b' + solve_ (a - a', b - b') xs
    | otherwise       = a' + b' + solve_ (b - b', a - a') xs
    where a' = min a x
          b' = min b y

main = fmap (map read . words) getLine >>= \[_,a,b] -> getLine >>= print . solve a b

solve a b = solve_ (swap a b) . map oddEven . countDot
    where swap a b = if a > b then (a,b) else (b,a)

solve_ (0,0) _ = 0
solve_ (a,b) [] = 0
solve_ (a,b) ((x,y):xs)
    | a - a' > b - b' = a' + b' + solve_ (a - a', b - b') xs
    | otherwise       = a' + b' + solve_ (b - b', a - a') xs
    where a' = min a x
          b' = min b y

oddEven x
   | even x = (x `div` 2, x `div` 2)
   | otherwise = (x `div` 2 + 1, x `div` 2)

countDot = count . break (=='*')
    where count (a,[]) = [length a]
          count (a,(_:bs)) = length a : countDot bs

main = fmap (map read . words) getLine >>= \[_,a,b] -> getLine >>= print . run a b

run a b = solve (swap_ a b) . map f . free
    where
    f x = let mid = x `div` 2 in  let t = if even x then mid else mid + 1 in (t, mid)
    swap_ a b = if a > b then (a,b) else (b,a)
    solve a1 b1 = case (a1, b1) of
        ((0,0), _) -> 0
        ((a,b), []) -> 0
        ((a,b), ((x,y):xs)) ->
            let a_ = min a x
                b_ = min b y in
                a_ + b_ + solve (swap_ (a - a_) (b - b_)) xs
    free = count . break (=='*')
        where count (a1, b1) = case (a1, b1) of
                    (a,[]) -> [length a]
                    (a,(_:bs)) -> length a : free bs


A permutation of length $$$n$$$ is an array $$$p=[p_1,p_2,\dots, p_n]$$$ which contains every integer from $$$1$$$ to $$$n$$$ (inclusive) exactly once. For example, $$$p=[4, 2, 6, 5, 3, 1]$$$ is a permutation of length $$$6$$$.You are given three integers $$$n$$$, $$$a$$$ and $$$b$$$, where $$$n$$$ is an even number. Print any permutation of length $$$n$$$ that the minimum among all its elements of the left half equals $$$a$$$ and the maximum among all its elements of the right half equals $$$b$$$. Print -1 if no such permutation exists.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$), the number of test cases in the test. The following $$$t$$$ lines contain test case descriptions. Each test case description contains three integers $$$n$$$, $$$a$$$, $$$b$$$ ($$$2 \le n \le 100$$$; $$$1 \le a,b \le n$$$; $$$a \ne b$$$), where $$$n$$$ is an even number (i.e. $$$n \bmod 2 = 0$$$).

For each test case, print a single line containing any suitable permutation. Print -1 no such permutation exists. If there are multiple answers, print any of them.

import Data.List (delete)

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [n, a, b] = map read $ words input
        result = findSpecialPermutation n a b
        output = case result of
            Just permutation -> unwords $ map show permutation
            Nothing -> "-1"

findSpecialPermutation :: Integer -> Integer -> Integer -> Maybe [Integer]
findSpecialPermutation n a b = result
    where
        free_elements = delete a $ delete b $ [1..n]
        permutation = [a] ++ reverse free_elements ++ [b]
        result = if isPermutationGood permutation a b then Just permutation else Nothing

isPermutationGood :: [Integer] -> Integer -> Integer -> Bool
isPermutationGood permutation a b = minimum first_half == a && maximum second_half == b
    where
        half_size = length permutation `div` 2
        (first_half, second_half) = splitAt half_size permutation


The only difference with E1 is the question of the problem.Vlad built a maze out of $$$n$$$ rooms and $$$n-1$$$ bidirectional corridors. From any room $$$u$$$ any other room $$$v$$$ can be reached through a sequence of corridors. Thus, the room system forms an undirected tree.Vlad invited $$$k$$$ friends to play a game with them.Vlad starts the game in the room $$$1$$$ and wins if he reaches a room other than $$$1$$$, into which exactly one corridor leads. Friends are placed in the maze: the friend with number $$$i$$$ is in the room $$$x_i$$$, and no two friends are in the same room (that is, $$$x_i \neq x_j$$$ for all $$$i \neq j$$$). Friends win if one of them meets Vlad in any room or corridor before he wins.For one unit of time, each participant of the game can go through one corridor. All participants move at the same time. Participants may not move. Each room can fit all participants at the same time.Friends know the plan of a maze and intend to win. They don't want to waste too much energy. They ask you to determine if they can win and if they can, what minimum number of friends must remain in the maze so that they can always catch Vlad.In other words, you need to determine the size of the minimum (by the number of elements) subset of friends who can catch Vlad or say that such a subset does not exist.

The first line of the input contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the input. The input contains an empty string before each test case. The first line of the test case contains two numbers $$$n$$$ and $$$k$$$ ($$$1 \le k < n \le 2\cdot 10^5$$$) — the number of rooms and friends, respectively. The next line of the test case contains $$$k$$$ integers $$$x_1, x_2, \dots, x_k$$$ ($$$2 \le x_i \le n$$$) — numbers of rooms with friends. All $$$x_i$$$ are different. The next $$$n-1$$$ lines contain descriptions of the corridors, two numbers per line $$$v_j$$$ and $$$u_j$$$ ($$$1 \le u_j, v_j \le n$$$) — numbers of rooms that connect the $$$j$$$ corridor. All corridors are bidirectional. From any room, you can go to any other by moving along the corridors. It is guaranteed that the sum of the values $$$n$$$ over all test cases in the test is not greater than $$$2\cdot10^5$$$.

Print $$$t$$$ lines, each line containing the answer to the corresponding test case. The answer to a test case should be $$$-1$$$ if Vlad wins anyway and a minimal number of friends otherwise.

NoteIn the first set of inputs, even if all the friends stay in the maze, Vlad can still win. Therefore, the answer is "-1".In the second set of inputs it is enough to leave friends from rooms $$$6$$$ and $$$7$$$. Then Vlad will not be able to win. The answer is "2".In the third and fourth sets of inputs Vlad cannot win only if all his friends stay in the maze. Therefore the answers are "1" and "2".

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as String
import qualified Data.ByteString.Builder.Prim as Prim
import Data.ByteString.Builder
import Control.Monad
import Control.Monad.ST
--import Control.Monad.Trans.State
import Data.Array.Base
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.MArray as Vector
import Data.Bits
import Data.Bool
import Data.Char
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import Data.Function
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe
import System.Exit

import Data.IORef
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Fail
import Control.Applicative
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (msum)
import Data.Char (isNumber, isPunctuation)

import Control.Monad.Identity (Identity(..))

printLog :: Show a => a -> a
printLog a = unsafePerformIO $ do putStrLn $ "{отладка[ "++show a ++ " ]отладка}"
                                  pure a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

printArray = putStrLn . unwords . map show . elems

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

type WEdge w = (Vertex, (w, Vertex))
type WGraph w = Array Vertex [(w, Vertex)]
data WTree w a = WNode { rootLabelW :: a
                       , subForestW :: [(w, WTree w a)]
                       } deriving Show

buildWG :: Bounds -> [WEdge w] -> WGraph w
buildWG = accumArray (flip (:)) []

dfsWTree :: WGraph w -> Vertex -> WTree w Vertex
dfsWTree g u = go u u where
    go p u = WNode u [(w, go u v) | (w, v) <- g!u, v /= p]

instance Functor (WTree w) where
    fmap f = go where
        go (WNode a ts) = WNode (f a) [(w, go t) | (w, t) <- ts]

calcDP' :: forall s. [Int] -> Bounds -> WTree Int Vertex -> ST s (STUArray s Int Int)
calcDP' friends bnds t = do
  isFriend <- (newArray bnds 0) :: ST s (STUArray s Int Int)
  forM_ friends $ \f -> writeArray isFriend f 1

  dp <- (newArray bnds (-1)) :: ST s (STUArray s Int Int)

  let dfs :: WTree Int Vertex -> ST s ()
      dfs (WNode v subt) = do
        mapM_ (\(w, (WNode to subt')) -> do
          dfs (WNode to subt')
          dpTo <- readArray dp to
          dpV <- readArray dp v
          when ((dpTo /= -1) && (dpV == -1 || dpTo+1<dpV)) (writeArray dp v (dpTo+1)) ) subt

        f <- readArray isFriend v
        when (f==1) (writeArray dp v 0)
  dfs t
  return dp
calcDp a b c = runSTUArray $ calcDP' a b c

getAns :: UArray Int Int -> Int -> WTree Int Vertex  -> Int
getAns dp h (WNode v subt)
  | (dp!v) == -1 = -1
  | (dp!v) <= h = 1
  | otherwise = foldr fun 0 subt
    where fun _ (-1) = -1
          fun (w,(WNode to subt')) suf = let cur = getAns dp (h+1) (WNode to subt') in
                                          if (cur == -1) then (-1) else cur+suf

fita :: IO ()
fita = do
  emptyLine <- String.getLine
  [n,k] <- readInts
  friends <- readInts
  edges <- concat <$> (replicateM (n-1) $ do
    [v,u] <- readInts
    return [(v,(0,u)),(u,(0,v))])
  let tree = flip dfsWTree 1 $ buildWG (1,n) edges
      dp = calcDp friends (1,n) tree
  --printArray dp
  print $ getAns dp 0 tree

main :: IO ()
main = flip replicateM_ fita =<< readLn

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as String
import qualified Data.ByteString.Builder.Prim as Prim
import Data.ByteString.Builder
import Control.Monad
import Control.Monad.ST
--import Control.Monad.Trans.State
import Data.Array.Base
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.MArray as Vector
import Data.Bits
import Data.Bool
import Data.Char
import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import Data.Function
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe
import System.Exit

import Data.IORef
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Fail
import Control.Applicative
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (msum)
import Data.Char (isNumber, isPunctuation)

import Control.Monad.Identity (Identity(..))

printLog :: Show a => a -> a
printLog a = unsafePerformIO $ do putStrLn $ "{отладка[ "++show a ++ " ]отладка}"
                                  pure a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

printArray = putStrLn . unwords . map show . elems

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

type WEdge w = (Vertex, (w, Vertex))
type WGraph w = Array Vertex [(w, Vertex)]
data WTree w a = WNode { rootLabelW :: a
                       , subForestW :: [(w, WTree w a)]
                       } deriving Show

buildWG :: Bounds -> [WEdge w] -> WGraph w
buildWG = accumArray (flip (:)) []

dfsWTree :: WGraph w -> Vertex -> WTree w Vertex
dfsWTree g u = go u u where
    go p u = WNode u [(w, go u v) | (w, v) <- g!u, v /= p]

instance Functor (WTree w) where
    fmap f = go where
        go (WNode a ts) = WNode (f a) [(w, go t) | (w, t) <- ts]

calcDP' :: forall s. [Int] -> Bounds -> WTree () Vertex -> ST s (STUArray s Int Int)
calcDP' friends bnds tree  = do
  isFriend <- (newArray bnds False) :: ST s (STUArray s Int Bool)
  forM_ friends $ \el -> do
    writeArray isFriend el True

  dp <- (newArray bnds (-1)) :: ST s (STUArray s Int Int)
  let dfs :: WTree () Vertex -> ST s ()
      dfs (WNode v ts) = do
        mapM_ (\(_,ful@(WNode to ts')) -> do
          dfs ful
          dpTo <- readArray dp to
          dpV <- readArray dp v
          when (dpTo /= (-1) && (dpV == (-1) || dpTo+1 < dpV)) $ do
            writeArray dp v (dpTo+1)
          ) ts
        fl <- readArray isFriend v
        when fl $ writeArray dp v 0
  dfs tree
  return dp
calcDP a b c = runSTUArray $ calcDP' a b c

fita :: IO ()
fita = do
  _ <- getLine
  [n,k] <- readInts
  friends <- readInts
  edges <- concat <$> (replicateM (n-1) $ do
    [v,u] <- readInts
    return [(v,((),u)),(u,((),v))])
  let tree = flip dfsWTree 1 . buildWG (-1000,1000) $ edges
      dp = calcDP friends (-1000,1000) tree
      dfs h (WNode v ts)
        | dp!v == (-1) = -1
        | dp!v <= h = 1
        | otherwise = if minimum subs == (-1) then (-1) else sum subs
          where subs = map (\(_,to) -> dfs (h+1) to) ts
  putStrLn $ if (dfs 0 tree)==(-1) then "YES" else "NO"

main :: IO ()
main = flip replicateM_ fita =<< readLn


The year of 2012 is coming...According to an ancient choradrican legend in this very year, in 2012, Diablo and his brothers Mephisto and Baal will escape from hell, and innumerable hordes of demons will enslave the human world. But seven brave heroes have already gathered on the top of a mountain Arreat to protect us mere mortals from the effect of this terrible evil.The seven great heroes are: amazon Anka, barbarian Chapay, sorceress Cleo, druid Troll, necromancer Dracul, paladin Snowy and a professional hit girl Hexadecimal. Heroes already know how much experience will be given for each of the three megabosses: a for Mephisto, b for Diablo and c for Baal.Here's the problem: heroes are as much as seven and megabosses are only three! Then our heroes decided to split into three teams, where each team will go to destroy their own megaboss. Each team member will receive a  of experience, rounded down, where x will be the amount of experience for the killed megaboss and y — the number of people in the team.Heroes do not want to hurt each other's feelings, so they want to split into teams so that the difference between the hero who received the maximum number of experience and the hero who received the minimum number of experience were minimal. Since there can be several divisions into teams, then you need to find the one in which the total amount of liking in teams were maximum.It is known that some heroes like others. But if hero p likes hero q, this does not mean that the hero q likes hero p. No hero likes himself.The total amount of liking in teams is the amount of ordered pairs (p, q), such that heroes p and q are in the same group, and hero p likes hero q (but it is not important if hero q likes hero p). In case of heroes p and q likes each other and they are in the same group, this pair should be counted twice, as (p, q) and (q, p).A team can consist even of a single hero, but it is important that every megaboss was destroyed. All heroes must be involved in the campaign against evil. None of the heroes can be in more than one team.It is guaranteed that every hero is able to destroy any megaboss alone.

The first line contains a single non-negative integer n (0 ≤ n ≤ 42) — amount of liking between the heroes. Next n lines describe liking in the form "p likes q", meaning that the hero p likes the hero q (p  ≠  q). Every liking is described in the input exactly once, no hero likes himself. In the last line are given three integers a, b and c (1 ≤ a, b, c ≤ 2·109), separated by spaces: the experience for Mephisto, the experience for Diablo and experience for Baal. In all the pretests, except for examples from the statement, the following condition is satisfied: a = b = c.

Print two integers — the minimal difference in the experience between two heroes who will receive the maximum and minimum number of experience points, and the maximal total amount of liking in teams (the number of friendships between heroes that end up in one team). When calculating the second answer, the team division should satisfy the difference-minimizing contraint. I.e. primary you should minimize the difference in the experience and secondary you should maximize the total amount of liking.

3
Troll likes Dracul
Dracul likes Anka
Snowy likes Hexadecimal
210 200 180

2
Anka likes Chapay
Chapay likes Anka
10000 50 50

NoteA note to first example: it the first team should be Dracul, Troll and Anka, in the second one Hexadecimal and Snowy, and in the third Cleo и Chapay.

main=interact$p.minimum.t(words "An Ch Cl Tr Dr Sn He")[][][].i.tail.lines
i x=(map(map(take 2).words)$init x,map read.words$last x)
t(a:b)x y z r=concat [t b(a:x)y z r,t b x(a:y)z r,t b x y(a:z)r]
t[]x y z(l,b)|any null w=[]|1>0=[(maximum d-minimum d,-sum e)]
 where
 (d,e)=unzip (zipWith f b w)
 w=[x, y, z]
 f b i=(b`div`length i,length$filter(\[g,_,h]->elem g i&&elem h i)l)
p(a,b)=show a++" "++show(-b)

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

findId name = fromJust $ elemIndex name names
  where
    names = ["Anka", "Chapay", "Cleo", "Troll", "Dracul", "Snowy", "Hexadecimal"]

parseLine line = (findId (ws !! 0), findId (ws !! 2))
  where
    ws = words line

solve :: Array (Int,Int) Bool -> [Int] -> (Int, Int)
solve arr exp = minimum $ map score seps
  where
    r = [0..6]
    seps :: [[[Int]]]
    seps = [ [x \\ y, y, r \\ x]
           | x <- subsequences r
           , x /= r && x /= []
           , y <- subsequences x
           , y /= x && y /= []
           ]
    score sep = (maximum scores - minimum scores, negate . sum $ map likes sep)
      where
        scores = zipWith div exp $ map length sep
    likes grp = length [True | a <- grp , b <- grp, arr ! (a, b)]

main = do
    n <- read <$> getLine :: IO Int
    likes <- replicateM n (parseLine <$> getLine)
    let arr = accumArray (||) False ((0,0),(6,6)) $ map (\x -> (x,True)) likes
    exp <- map read . words <$> getLine :: IO [Int]
    let (minv, maxv) =  solve arr exp
    putStrLn $ show minv ++ " " ++ show (negate maxv)

import Data.Char

import Control.Monad
import Data.Int(Int64)
import Data.List
import Data.Maybe
import Control.Applicative

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

unsafeReadInt :: String -> Int
unsafeReadInt = read
readLiking = do
    [a,_,b] <- words <$> getLine
    return (read a, read b)

data Boss = A | B | C deriving (Eq, Show)
data Hero = Anka | Chapay | Cleo | Troll | Dracul | Snowy | Hexadecimal deriving (Read, Eq)

allHeroes = [Anka, Chapay, Cleo, Troll, Dracul, Snowy, Hexadecimal]

assignments :: Int -> [[Boss]]
assignments 0 = [[]]
assignments i = let next = assignments (i-1) in (map (A :) next) ++ (map (B :) next) ++ (map (C :) next)

allAssignments = assignments 7

likes likings i j = any (\(a, b) -> a == (allHeroes !! i) && b == (allHeroes !! j)) likings

liking likings assignment = length [() | p <- [0..6], q <- [0..6], likes likings p q, assignment !! p == assignment !! q]

expFrom :: Boss -> Int -> [Boss] -> Int
expFrom boss totalExp assignment = totalExp `div` length (filter (==boss) assignment)

maxDiff :: [Int] -> Int
maxDiff l = maximum l - minimum l

expdiff (a,b,c) assignment = maxDiff [
            expFrom A a assignment ,
            expFrom B b assignment ,
            expFrom C c assignment ]

allBossesDead assignment = any (==A) assignment && any (==B) assignment && any (==C) assignment

main = do
    [n] <- readInts
    likings <- sequence $ replicate n readLiking
    [a,b,c] <- readInts
    let exps = (a,b,c)
    let cmp a1 a2 = let md1 = expdiff exps a1
                        md2 = expdiff exps a2
                    in if md1 < md2 then LT else if md1 > md2 then GT else
                        compare (liking likings a2) (liking likings a1)
    let bestAssignment = minimumBy cmp (filter allBossesDead allAssignments)
    putStrLn (unwords [show (expdiff exps bestAssignment), show (liking likings bestAssignment)])


There's a chip in the point $$$(0, 0)$$$ of the coordinate plane. In one operation, you can move the chip from some point $$$(x_1, y_1)$$$ to some point $$$(x_2, y_2)$$$ if the Euclidean distance between these two points is an integer (i.e. $$$\sqrt{(x_1-x_2)^2+(y_1-y_2)^2}$$$ is integer).Your task is to determine the minimum number of operations required to move the chip from the point $$$(0, 0)$$$ to the point $$$(x, y)$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 3000$$$) — number of test cases. The single line of each test case contains two integers $$$x$$$ and $$$y$$$ ($$$0 \le x, y \le 50$$$) — the coordinates of the destination point.

For each test case, print one integer — the minimum number of operations required to move the chip from the point $$$(0, 0)$$$ to the point $$$(x, y)$$$.

NoteIn the first example, one operation $$$(0, 0) \rightarrow (8, 6)$$$ is enough. $$$\sqrt{(0-8)^2+(0-6)^2}=\sqrt{64+36}=\sqrt{100}=10$$$ is an integer.In the second example, the chip is already at the destination point.In the third example, the chip can be moved as follows: $$$(0, 0) \rightarrow (5, 12) \rightarrow (9, 15)$$$. $$$\sqrt{(0-5)^2+(0-12)^2}=\sqrt{25+144}=\sqrt{169}=13$$$ and $$$\sqrt{(5-9)^2+(12-15)^2}=\sqrt{16+9}=\sqrt{25}=5$$$ are integers.

parseInt :: String -> Int
parseInt number = (read number) :: Int

readInt :: IO Int
readInt = do
    number <- getLine
    pure $ parseInt number

readIntArr :: IO [Int]
readIntArr = do
    numbers <- getLine
    pure $ map parseInt $ words numbers

isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

solveSingle :: IO()
solveSingle = do
    arr <- readIntArr
    let x = arr !! 0
    let y = arr !! 1
    if (x == 0 && y == 0)
        then
            print(0)
        else if (isqrt(x * x + y * y) * isqrt(x * x + y * y) == x * x + y * y)
            then print(1)
            else print(2)

solve :: Int -> IO ()
solve n = if (n == 0)
    then
        pure()
    else do
        solveSingle
        solve(n - 1)

main :: IO ()
main = do
    n <- readInt
    solve $ n

parseInt :: String -> Int
parseInt number = (read number) :: Int

readInt :: IO Int
readInt = do
    number <- getLine
    pure $ parseInt number

readIntArr :: IO [Int]
readIntArr = do
    numbers <- getLine
    pure $ map parseInt $ words numbers

isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

solve :: IO()
solve = do
    (x: y: _) <- readIntArr
    if (x == 0 && y == 0)
        then print 0
        else let s = isqrt (x * x + y * y)
            in if (s * s == x * x + y * y)
                then print 1
                else print 2

for :: Int -> IO () -> IO ()
for 0 _ = pure ()
for i f = do
    f
    for (i - 1) f

main :: IO ()
main = do
    t <- readInt
    for t solve


Amugae is in a very large round corridor. The corridor consists of two areas. The inner area is equally divided by $$$n$$$ sectors, and the outer area is equally divided by $$$m$$$ sectors. A wall exists between each pair of sectors of same area (inner or outer), but there is no wall between the inner area and the outer area. A wall always exists at the 12 o'clock position.  The inner area's sectors are denoted as $$$(1,1), (1,2), \dots, (1,n)$$$ in clockwise direction. The outer area's sectors are denoted as $$$(2,1), (2,2), \dots, (2,m)$$$ in the same manner. For a clear understanding, see the example image above.Amugae wants to know if he can move from one sector to another sector. He has $$$q$$$ questions.For each question, check if he can move between two given sectors.

The first line contains three integers $$$n$$$, $$$m$$$ and $$$q$$$ ($$$1 \le n, m \le 10^{18}$$$, $$$1 \le q \le 10^4$$$) — the number of sectors in the inner area, the number of sectors in the outer area and the number of questions. Each of the next $$$q$$$ lines contains four integers $$$s_x$$$, $$$s_y$$$, $$$e_x$$$, $$$e_y$$$ ($$$1 \le s_x, e_x \le 2$$$; if $$$s_x = 1$$$, then $$$1 \le s_y \le n$$$, otherwise $$$1 \le s_y \le m$$$; constraints on $$$e_y$$$ are similar). Amague wants to know if it is possible to move from sector $$$(s_x, s_y)$$$ to sector $$$(e_x, e_y)$$$.

For each question, print "YES" if Amugae can move from $$$(s_x, s_y)$$$ to $$$(e_x, e_y)$$$, and "NO" otherwise. You can print each letter in any case (upper or lower).

NoteExample is shown on the picture in the statement.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = do
	[ n, m, q ] <- readIntegers
	let
		units = lcm n m
		width = units `div` gcd n m
-- 	print units
-- 	print width
-- 	putStrLn "=========="
	replicateM ( fromIntegral q ) $ do
		[ sx, sy', ex, ey' ] <- readIntegers
		let
			sy = pred sy'
			ey = pred ey'
			u1 = units `div` ( which n m $ sx == 1 ) * sy `div` width
			u2 = units `div` ( which n m $ ex == 1 ) * ey `div` width
-- 		print u1
-- 		print u2
		putStrLn $ which "YES" "NO" $ u1 == u2

import Control.Monad

type Sector = (Integer, Integer)

main = do
    [n, m, tests] <- readNums
    let common = gcd n m
        realN = n `div` common
        realM = m `div` common

    results <- replicateM (fromInteger tests) $ (solve realN realM)
    putStr . unlines $ results

readNums :: IO [Integer]
readNums = map (\tok -> read tok :: Integer) . words <$> getLine

solve :: Integer -> Integer -> IO String
solve n m = do
    [x1, y1, x2, y2] <- readNums
    let source = (x1, y1)
        dest = (x2, y2)
    return (if canReach source dest (n, m) then "YES" else "NO")

canReach :: Sector -> Sector -> (Integer, Integer) -> Bool
canReach source dest (n, m) =
    let indexSource = index source (n, m)
        indexDest = index dest (n, m)
    in indexSource == indexDest

index :: Sector -> (Integer, Integer) -> Integer
index (x, y) (n, m) = (y - 1) `div` (if x == 1 then n else m)

import Control.Monad

--
-- UTILITIES
--
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)

getInt :: IO Int
getInt = read <$> getLine

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

getInteger :: IO Integer
getInteger = read <$> getLine

getIntegers :: IO [Integer]
getIntegers = fmap (fst . fromJust . C.readInteger) . C.words <$> C.getLine

--
-- MAIN
--

main :: IO ()
main = do
  [n,m,q] <- getIntegers
  let d = gcd n m
      rn = n `div` d
      rm = m `div` d
  replicateM_ (fromIntegral q) $ do
    [sx,sy,ex,ey] <- getIntegers
    putStrLn $ if solve rn rm sx sy ex ey then "YES" else "NO"

solve :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Bool
solve rn rm 1 sy 1 ey = pred sy `div` rn == pred ey `div` rn
solve rn rm 1 sy 2 ey = pred sy `div` rn == pred ey `div` rm
solve rn rm 2 sy 1 ey = pred sy `div` rm == pred ey `div` rn
solve rn rm 2 sy 2 ey = pred sy `div` rm == pred ey `div` rm

import Control.Monad

--
-- UTILITIES
--
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)

getInt :: IO Int
getInt = read <$> getLine

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

--
-- MAIN
--

main :: IO ()
main = do
  [n,m,q] <- getInts
  let d = gcd n m
      rn = n `div` d
      rm = m `div` d
  replicateM_ q $ do
    [sx,sy,ex,ey] <- getInts
    putStrLn $ if solve rn rm sx sy ex ey then "YES" else "NO"

solve :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
solve rn rm 1 sy 1 ey = pred sy `div` rn == pred ey `div` rn
solve rn rm 1 sy 2 ey = pred sy `div` rn == pred ey `div` rm
solve rn rm 2 sy 1 ey = pred sy `div` rm == pred ey `div` rn
solve rn rm 2 sy 2 ey = pred sy `div` rm == pred ey `div` rm


Ivan had string s consisting of small English letters. However, his friend Julia decided to make fun of him and hid the string s. Ivan preferred making a new string to finding the old one. Ivan knows some information about the string s. Namely, he remembers, that string ti occurs in string s at least ki times or more, he also remembers exactly ki positions where the string ti occurs in string s: these positions are xi, 1, xi, 2, ..., xi, ki. He remembers n such strings ti.You are to reconstruct lexicographically minimal string s such that it fits all the information Ivan remembers. Strings ti and string s consist of small English letters only.

The first line contains single integer n (1 ≤ n ≤ 105) — the number of strings Ivan remembers. The next n lines contain information about the strings. The i-th of these lines contains non-empty string ti, then positive integer ki, which equal to the number of times the string ti occurs in string s, and then ki distinct positive integers xi, 1, xi, 2, ..., xi, ki in increasing order — positions, in which occurrences of the string ti in the string s start. It is guaranteed that the sum of lengths of strings ti doesn't exceed 106, 1 ≤ xi, j ≤ 106, 1 ≤ ki ≤ 106, and the sum of all ki doesn't exceed 106. The strings ti can coincide. It is guaranteed that the input data is not self-contradictory, and thus at least one answer always exists.

Print lexicographically minimal string that fits all the information Ivan remembers.

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

main = do
  n <- fmap readInt B.getLine
  siss <- replicateM n $ flip fmap B.getLine $ (\(w:_:r) -> (w, map readInt r)) . B.words
  putStr $ solve siss

solve siss = elems (accumArray (flip const) 'a' (1, maximum [i + B.length s - 1 | (s, is) <- siss, i <- is]) $ concatMap (\(s, is) -> concat $ snd $ mapAccumL (\e i -> let b = max (e - i) 0 in (i + B.length s, zip [i + b..] $ B.unpack $ B.drop b s)) 0 is) siss :: UArray Int Char)
readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words


A group of n merry programmers celebrate Robert Floyd's birthday. Polucarpus has got an honourable task of pouring Ber-Cola to everybody. Pouring the same amount of Ber-Cola to everybody is really important. In other words, the drink's volume in each of the n mugs must be the same.Polycarpus has already began the process and he partially emptied the Ber-Cola bottle. Now the first mug has a1 milliliters of the drink, the second one has a2 milliliters and so on. The bottle has b milliliters left and Polycarpus plans to pour them into the mugs so that the main equation was fulfilled.Write a program that would determine what volume of the drink Polycarpus needs to add into each mug to ensure that the following two conditions were fulfilled simultaneously:   there were b milliliters poured in total. That is, the bottle need to be emptied;  after the process is over, the volumes of the drink in the mugs should be equal.

The first line contains a pair of integers n, b (2 ≤ n ≤ 100, 1 ≤ b ≤ 100), where n is the total number of friends in the group and b is the current volume of drink in the bottle. The second line contains a sequence of integers a1, a2, ..., an (0 ≤ ai ≤ 100), where ai is the current volume of drink in the i-th mug.

Print a single number "-1" (without the quotes), if there is no solution. Otherwise, print n float numbers c1, c2, ..., cn, where ci is the volume of the drink to add in the i-th mug. Print the numbers with no less than 6 digits after the decimal point, print each ci on a single line. Polycarpus proved that if a solution exists then it is unique. Russian locale is installed by default on the testing computer. Make sure that your solution use the point to separate the integer part of a real number from the decimal, not a comma.

main = do interact (unlines . gao . map read . words)
gao (n:m:a) = if d <= m then map (\i -> show $ i + (m - d) / n) c else ["-1"] where
    b = maximum a
    c = map (b-) a
    d = sum c

import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import System.IO
import System.IO.Error

hReadMany :: (Char -> Bool) -> Handle -> IO String
hReadMany p h = do b <- (p <$> hLookAhead h) `catch` const (return False)
                   if b
                     then (:) <$> hGetChar h <*> hReadMany p h
                     else return ""

hSkipSpaces  = hReadMany isSpace
hReadNumeric = hReadMany (\c -> isDigit c || c `elem` ['.', '-', '+'])

readNum :: (Num a, Read a) => IO a
readNum = do hSkipSpaces stdin
             read <$> hReadNumeric stdin

readTerm :: IO String
readTerm = do hSkipSpaces stdin
              hReadMany (not . isSpace) stdin

main = do n <- readNum :: IO Double
          b <- readNum :: IO Double

          mugs <- replicateM (round n) readNum

          let max_ml = maximum mugs -- 最大に合わせる
          let need_more = [ max_ml - m | m <- mugs] -- 後それぞれ、これだけ入れれば平等
          let total_filling = sum need_more -- 平等のために必要な送料
          let redundant_each = (b - total_filling) / n
          let actual_value = [ redundant_each + m | m <- need_more] -- 余りを平等にわけてからの、各々必要な量

          if total_filling > b then print (-1)
                               else mapM_ print actual_value

{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Maybe

readWords = map read . words <$> getLine

solve n b as =
		if any (\a → s < a * n) as
			then Nothing
			else Just $ map (\a → s/n - a) as
	where
		s = b + sum as

main = do
	[n, b] ← readWords
	as ← readWords

	let r = solve n b as
	if isNothing r
		then putStrLn "-1"
		else mapM_ print $ fromJust r

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

solve :: Int -> Int -> [Int] -> Maybe [Double]
solve n b' as
  | b < n * maximum as  =  Nothing
  | otherwise  =  Just $ map (\a -> d - fromIntegral a) as
  where
    b  =  b' + sum as
    d  =  fromIntegral b / fromIntegral n

printAns :: Maybe [Double] -> IO ()
printAns Nothing  =  print (-1)
printAns (Just as)  =  mapM_ print as

main :: IO ()
main  =  do
    [n, b] <- Main.reads
    as <- Main.reads
    printAns $ solve n b as

import Text.Printf

main = getContents >>= solve.map read.words

solve :: [Int] -> IO ()
solve (n:b:xs)
  | b < y = print $ -1
  | otherwise = mapM_ (printf "%.6f\n".(z-).fromIntegral) xs
   where x = maximum xs
         y = sum $ map (x-) xs
         z :: Double
         z = (fromIntegral$b-y)/(fromIntegral n) + (fromIntegral x)

import Text.Printf

solve :: (Double, [Double]) -> Maybe [Double]
solve (b, as) =
    if all (>= 0) res
    then Just res
    else Nothing
    where
      one = (b + sum as) / (fromIntegral $ length as)
      res = map (\x -> one - x) as

pprint :: Maybe [Double] -> String
pprint (Just foo) = unlines $ map (printf "%.7f") foo
pprint Nothing = "-1"

parse :: String -> (Double, [Double])
parse foo =
    let [first, rest] = lines foo
        (_:nn:_) = words first
        n = read nn
        stuff = map read (words rest)
    in (n, stuff)

main = interact (pprint . solve . parse)

import Text.Printf

solve :: (Float, [Float]) -> Maybe [Float]
solve (b, as) =
    if all (>= 0) res
    then Just res
    else Nothing
    where
      one = (b + sum as) / (fromIntegral $ length as)
      res = map (\x -> one - x) as

pprint :: Maybe [Float] -> String
pprint (Just foo) = unlines $ map (printf "%.7f") foo
pprint Nothing = "-1"

parse :: String -> (Float, [Float])
parse foo =
    let [first, rest] = lines foo
        (_:nn:_) = words first
        n = read nn
        stuff = map read (words rest)
    in (n, stuff)

main = interact (pprint . solve . parse)


There is a programing contest named SnakeUp, 2n people want to compete for it. In order to attend this contest, people need to form teams of exactly two people. You are given the strength of each possible combination of two people. All the values of the strengths are distinct.Every contestant hopes that he can find a teammate so that their team’s strength is as high as possible. That is, a contestant will form a team with highest strength possible by choosing a teammate from ones who are willing to be a teammate with him/her. More formally, two people A and B may form a team if each of them is the best possible teammate (among the contestants that remain unpaired) for the other one. Can you determine who will be each person’s teammate?

There are 2n lines in the input.  The first line contains an integer n (1 ≤ n ≤ 400) — the number of teams to be formed. The i-th line (i > 1) contains i - 1 numbers ai1, ai2, ... , ai(i - 1). Here aij (1 ≤ aij ≤ 106, all aij are distinct) denotes the strength of a team consisting of person i and person j (people are numbered starting from 1.)

Output a line containing 2n numbers. The i-th number should represent the number of teammate of i-th person.

NoteIn the first sample, contestant 1 and 2 will be teammates and so do contestant 3 and 4, so the teammate of contestant 1, 2, 3, 4 will be 2, 1, 4, 3 respectively.

import Data.List (intercalate, sort)
import Data.Set hiding (map)
main=interact $ solve. map read. words

solve (n:xs) = ret
         where score = map snd $ reverse $ sort $ zip xs [(x,y) | x<-[2..2*n], y<-[1..x-1]]
               f [] _ = []
               f _ set | size set == 2*n = []
               f ((pair@(x,y)):ss) set | member x set || member y set = f ss set
                                       | otherwise = [pair, (y,x)] ++ f ss (insert y $ insert x set)
               ret = intercalate " " $ map (show.snd) $ sort $ f score empty

import Data.List (intercalate, sort)
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative

main = do  putStrLn. solve =<< map (fst . fromJust . B.readInt) . B.words <$> B.getContents
solve (n:xs) = ret
         where score = map snd $ reverse $ sort $ zip xs [(x,y) | x<-[2..2*n], y<-[1..x-1]]
               f [] _ = []
               f _ set | S.size set == 2*n = []
               f ((pair@(x,y)):ss) set | S.member x set || S.member y set = f ss set
                                       | otherwise = [pair, (y,x)] ++ f ss (S.insert y $ S.insert x set)
               ret = intercalate " " $ map (show.snd) $ sort $ f score S.empty

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

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

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

main = do
  n <- readLn

  cs <- replicateM (2*n-1) getInts

  let ps = reverse $ sort $ concat $ zipWith (\cs i -> zipWith (\j c -> (c, (i, j))) [1..i] cs) cs [2..2*n]

  let
    f [] l s = l
    f ((c, (i, j)):ps) l s
      | i `Set.member` s || j `Set.member` s = f ps l s
      | otherwise = f ps ((i, j):(j, i):l) (i `Set.insert` (j `Set.insert` s))

    a = array (1, 2*n) $ f ps [] Set.empty :: Array Int Int

  putStrLn $ unwords $ map show $ elems a

import Data.List (intercalate, sort)
import Data.Map (elems, fromList)
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

process []          teamed = []
process ((c, r):vs) teamed
    | inTeam    = process vs teamed
    | otherwise = (c, r):(r, c):process vs newA
    where inTeam = Set.member c teamed || Set.member r teamed
          newA   = Set.insert c $ Set.insert r teamed

solve (n:vs) = process scores (Set.empty)
    where coords = [(y, x) | x <- [1..n*2], y <- [1..x-1]]
          scores = map snd . reverse . sort $ zip vs coords

showResult result = putStrLn . s $ result
    where s = intercalate " " . map show . elems . fromList

main = do
    contents <- B.getContents
    let values = map (fst . fromJust . B.readInt) . B.words $ contents
    showResult $ solve values

import Data.List
import Data.Map (elems, fromList)
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as B

{-
solve n = 1 + floor rem
    where root = logBase 2 n
          btm = floor root
          rem = if 2 ^ btm == n then 0 else n - (2 ^ btm)
-}

-- [(val, (t1, t2))]
sorted :: [(Int, (Int, Int))] -> [(Int, (Int, Int))]
sorted = reverse . sortBy sortFn
    where sortFn x y = compare (fst x) (fst y)

process_ []     end teamed = end
process_ (v:vs) end teamed
    | inTeam    = process_ vs end teamed
    | otherwise = process_ vs (end ++ [(c, r)]) newA
    where c = (fst . snd) v
          r = (snd . snd) v
          inTeam = Set.member c teamed || Set.member r teamed
          newA = Set.insert c $ Set.insert r teamed

solve_ n values = process_ (sorted values) [] (Set.empty)

main :: IO ()
main = do
    n <- readLn
    let nl = n * 2 - 1
    strengths <- sequence $ replicate nl $ do
      line <- B.getLine
      return $ map (maybe (error "a") fst) . map B.readInt . B.words $ line
    let coords = [(y, x) | x <- [1..n*2], y <- [1..x-1]]
    let withRow = zip (concat strengths) coords
    let result = solve_ n $ withRow
    -- let vvv = [(6,(1,2)),(1,(1,3)),(2,(2,3)),(3,(1,4)),(4,(2,4)),(5,(3,4))]
    let showResult = concat . intersperse " " . map show . elems. fromList
    putStrLn $ showResult $ result ++ (map swap result)

        where swap (x, y) = (y, x)

-- Codeforces 579B

import Control.Monad
import Data.List
import Data.Function
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as B

-- Hint: get all combinations of (i, j), then sort it by the value of `d` in decreasing order.

main :: IO ()
main = B.getContents >>= putStrLn . intercalate " " . map show . solve . map (fst . fromJust . B.readInt) . B.words

solve :: [Int] -> [Int]
solve (n:xs) = map snd $ sort $ fst $ foldl (\(now, acc) (x, y) -> if (Set.member x acc) || (Set.member y acc) then (now, acc) else ((x,y):(y,x):now, (Set.insert x $ Set.insert y acc))) ([], Set.empty) $ map snd $ reverse $ sort $ zip xs [(i,j) | i <- [1..2*n], j <- [1..i-1]]

import Data.List (intersperse, sort)
import Data.Set (insert, member, empty)
main=interact $ solve. map read. words

solve (n:xs) = ret
         where score = map snd $ reverse $ sort $ zip xs [[x,y] | x<-[2..2*n], y<-[1..x-1]]
               f [] _ = []
               f ((pair@[x,y]):ss) set | member x set || member y set = f ss set
                                       | otherwise = [pair, reverse pair] ++ f ss (insert y $ insert x set)
               ret = intersperse ' ' $ concatMap (show.head.tail) $ sort $ f score empty

import Data.List (intersperse, sort)
import Data.Set hiding (map)
main=interact $ solve. map read. words

solve (n:xs) = ret
         where score = map snd $ reverse $ sort $ zip xs [[x,y] | x<-[2..2*n], y<-[1..x-1]]
               f [] _ = []
               f _ set | size set == 2*n = []
               f ((pair@[x,y]):ss) set | member x set || member y set = f ss set
                                       | otherwise = [pair, reverse pair] ++ f ss (insert y $ insert x set)
               ret = intersperse ' ' $ concatMap (show.head.tail) $ sort $ f score empty

import Data.List
main=interact $ solve. map read. words

solve (n:xs) = ret
         where score = sort $ zip xs [[x,y] | x<-[2..2*n], y<-[1..x-1]]
               f _ 0 = []
               f score n  = let (_,pair) = head score
                                score' = filter ((==4) . length . nub . (pair++) . snd)  score
                            in [pair, reverse pair] ++ f score' (n-1)
               ret = intersperse ' ' $ concatMap (show.head.tail) $ sort $ f score n

import Data.List
import Data.Map (elems, fromList)
import qualified Data.Set as Set

{-
solve n = 1 + floor rem
    where root = logBase 2 n
          btm = floor root
          rem = if 2 ^ btm == n then 0 else n - (2 ^ btm)
-}

-- [(val, (t1, t2))]
sorted :: [(Int, (Int, Int))] -> [(Int, (Int, Int))]
sorted = reverse . sortBy sortFn
    where sortFn x y = compare (fst x) (fst y)

process_ []     end teamed = end
process_ (v:vs) end teamed
    | inTeam    = process_ vs end teamed
    | otherwise = process_ vs (end ++ [(c, r)]) newA
    where c = (fst . snd) v
          r = (snd . snd) v
          inTeam = Set.member c teamed || Set.member r teamed
          newA = Set.insert c $ Set.insert r teamed

solve_ n values = process_ (sorted values) [] (Set.empty)

main :: IO ()
main = do
    n <- readLn
    let nl = n * 2 - 1
    strengths <- sequence $ replicate nl $ do
      line <- getLine
      return (map read . words $ line :: [Int])
    let coords = [(y, x) | x <- [1..nl], y <- [1..x-1]]
    let withRow = zip (concat strengths) coords
    let result = solve_ n $ withRow
    -- let vvv = [(6,(1,2)),(1,(1,3)),(2,(2,3)),(3,(1,4)),(4,(2,4)),(5,(3,4))]
    let showResult = concat . intersperse " " . map show . elems. fromList
    putStrLn $ showResult $ result ++ (map swap result)

        where swap (x, y) = (y, x)

import Data.List
import Data.Map (elems, fromList)

{-
solve n = 1 + floor rem
    where root = logBase 2 n
          btm = floor root
          rem = if 2 ^ btm == n then 0 else n - (2 ^ btm)
-}

-- [(val, (t1, t2))]
sorted :: [(Int, (Int, Int))] -> [(Int, (Int, Int))]
sorted = reverse . sortBy sortFn
    where sortFn x y = compare (fst x) (fst y)

-- get largest
process [] start end = end
process (v:vs) start end = process (newvs) nstart nend
    where (nstart, nend) = groupUp start end t1 t2
          t1 = (fst . snd) v
          t2 = (snd . snd) v
          newvs = filter fn vs
          fn = \(v, (t3, t4)) -> and [t1/=t3, t1/=t4, t2/=t3, t2/=t4]

groupUp [] end _ _ = ([], end)
groupUp start end t1 t2 = (news, newe)
    where news = filter (\s -> s /= t1 && s /= t2) start
          newe = end ++ [(t1, t2)]

solve values = process (sorted values) [1..n] []
    where n = (div (length values) 2 - 1) * 2

main :: IO ()
main = do
    n <- readLn
    let nl = n * 2 - 1
    strengths <- sequence $ replicate nl $ do
      line <- getLine
      return (map read . words $ line :: [Int])
    let zipper = zipWith3 (\c r v -> (v, (c, r)))
    let withRow = zipWith (\r l -> zipper [1..] (repeat r) l) [2..] strengths
    let result = solve $ concat withRow
    putStrLn $ intersperse ' ' . concatMap show . elems . fromList $ result ++ (map swap result)
        where swap (x, y) = (y, x)


Arkady's morning seemed to be straight of his nightmare. He overslept through the whole morning and, still half-asleep, got into the tram that arrived the first. Some time after, leaving the tram, he realized that he was not sure about the line number of the tram he was in.During his ride, Arkady woke up several times and each time he saw the tram stopping at some stop. For each stop he knows which lines of tram stop there. Given this information, can you help Arkady determine what are the possible lines of the tram he was in?

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 100$$$) — the number of stops Arkady saw. The next $$$n$$$ lines describe the stops. Each of them starts with a single integer $$$r$$$ ($$$1 \le r \le 100$$$) — the number of tram lines that stop there. $$$r$$$ distinct integers follow, each one between $$$1$$$ and $$$100$$$, inclusive, — the line numbers. They can be in arbitrary order. It is guaranteed that Arkady's information is consistent, i.e. there is at least one tram line that Arkady could take.

Print all tram lines that Arkady could be in, in arbitrary order.

NoteConsider the first example. Arkady woke up three times. The first time he saw a stop with lines $$$1$$$, $$$4$$$, $$$6$$$. The second time he saw a stop with lines $$$1$$$, $$$4$$$. The third time he saw a stop with lines $$$10$$$, $$$5$$$, $$$6$$$, $$$4$$$ and $$$1$$$. He can be in a tram of one of two lines: $$$1$$$ or $$$4$$$.

import System.IO
import Control.Monad (replicateM)

count x xs = (length . filter (== x)) xs

readStations = do
  line <- fmap (fmap read . words) getLine :: IO [Int]
  return $ tail line

main = do
  n <- fmap read getLine :: IO Int
  all <- replicateM n readStations
  putStrLn $ unwords . (fmap show) $ filter (\x -> count x (concat all) == n) [1..100]

import System.IO
import Data.List
import Control.Monad

numTimesFound xs x = (length . filter (== x)) xs

get = fmap read getLine

gets = fmap (fmap read . words) getLine

readStations = do
  line <- gets :: IO [Int]
  return $ tail line

main = do
  n <- get :: IO Int
  all <- replicateM n readStations
  putStrLn $ unwords . (fmap show) $ filter (\x -> numTimesFound (concat all) x == n) [1..100]

import Prelude
import Control.Monad

str2Ints str = [read x::Int | x <- words str]
getLineN n = replicateM n getLine

intersect a b = [x| x<-a, elem x a, elem x b]

popfront (x:xs) = xs

main = do
    str <- getLine;
    let n = read str::Int;
    strs <- getLineN n;
    mapM (putStr.(++ " ").show) (foldr1 intersect (map (popfront.str2Ints) strs));

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import Data.Char
import qualified Data.Set as S

process s n m k | n>k || m>k = s
                | n<m = process (s+1) (n+m) m k
                | otherwise = process (s+1) n (m+n) k

onecase = do
		[n,m,k]<-map read <$> words <$> getLine ::IO [Int]
		print $ process 0 n m k

main = do
		n<-read <$> getLine ::IO Int
		x<-map tail <$> map (map read) <$> map words <$> replicateM n getLine :: IO [[Int]]
		putStrLn $ intercalate " "$ map show $ S.toList $ foldl1 (S.intersection) $ map (S.fromList) x

import System.IO
import Data.Char
import Data.List
import Control.Applicative
import Control.Monad
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: BS.ByteString -> [Int]
construct str
    | BS.null str = []
    | isSpace (BS8.head str) = construct (BS8.tail str)
    | otherwise = let Just (i, other) = BS8.readInt str in i : construct other

getInts :: IO [Int]
getInts = construct <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

main = do
    [n] <- getInts
    stops <- forM [1..n] (\_ -> getInts)
    let cand = filter (\x -> all (\s -> x `elem` s) (map (drop 1) $ stops)) [1..100]
    printInts cand


There are $$$n$$$ people who want to participate in a boat competition. The weight of the $$$i$$$-th participant is $$$w_i$$$. Only teams consisting of two people can participate in this competition. As an organizer, you think that it's fair to allow only teams with the same total weight.So, if there are $$$k$$$ teams $$$(a_1, b_1)$$$, $$$(a_2, b_2)$$$, $$$\dots$$$, $$$(a_k, b_k)$$$, where $$$a_i$$$ is the weight of the first participant of the $$$i$$$-th team and $$$b_i$$$ is the weight of the second participant of the $$$i$$$-th team, then the condition $$$a_1 + b_1 = a_2 + b_2 = \dots = a_k + b_k = s$$$, where $$$s$$$ is the total weight of each team, should be satisfied.Your task is to choose such $$$s$$$ that the number of teams people can create is the maximum possible. Note that each participant can be in no more than one team.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 50$$$) — the number of participants. The second line of the test case contains $$$n$$$ integers $$$w_1, w_2, \dots, w_n$$$ ($$$1 \le w_i \le n$$$), where $$$w_i$$$ is the weight of the $$$i$$$-th participant.

For each test case, print one integer $$$k$$$: the maximum number of teams people can compose with the total weight $$$s$$$, if you choose $$$s$$$ optimally.

NoteIn the first test case of the example, we can reach the optimal answer for $$$s=6$$$. Then the first boat is used by participants $$$1$$$ and $$$5$$$ and the second boat is used by participants $$$2$$$ and $$$4$$$ (indices are the same as weights).In the second test case of the example, we can reach the optimal answer for $$$s=12$$$. Then first $$$6$$$ participants can form $$$3$$$ pairs.In the third test case of the example, we can reach the optimal answer for $$$s=3$$$. The answer is $$$4$$$ because we have $$$4$$$ participants with weight $$$1$$$ and $$$4$$$ participants with weight $$$2$$$.In the fourth test case of the example, we can reach the optimal answer for $$$s=4$$$ or $$$s=6$$$.In the fifth test case of the example, we can reach the optimal answer for $$$s=3$$$. Note that participant with weight $$$3$$$ can't use the boat because there is no suitable pair for him in the list.

{-# LANGUAGE Safe #-}

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

main :: IO ()
main =
  interact $
    lines >>> drop 1
      >>> map (words >>> map read)
      >>> process
      >>> map show
      >>> unlines

process :: [[Int]] -> [Int]
process [] = []
process ([_] : xs : rest) = solve xs : process rest

solve :: [Int] -> Int
solve [_] = 0
solve xs =
  maximum $
    (map length . group . sort . map (uncurry (+)) . filter (uncurry (<=)) . concatMap dropEqDup)
      (zip <$> gs <*> gs)
  where
    gs = group . sort $ xs

    dropEqDup :: [(Int, Int)] -> [(Int, Int)]
    dropEqDup xs
      | uncurry (==) (head xs) = take (length xs `div` 2) xs
      | otherwise = xs

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

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  ws <- sort . map read . words <$> getLine
  print $ maximum [teamsWithSum s ws | s <- [2 .. 2 * n]]

teamsWithSum s ws = f ws (reverse ws) `div` 2
  where
    f (a : as) (b : bs)
      | a + b < s = f as (b : bs)
      | a + b == s = 1 + f as bs
      | otherwise = f (a : as) bs
    f _ _ = 0

import Control.Monad
import Data.List

teamsWithSum :: Int -> [Int] -> Int
teamsWithSum s ws = f ws (reverse ws) `div` 2
  where
    f (a : as) (b : bs)
      | a + b < s = f as (b : bs)
      | a + b == s = 1 + f as bs
      | otherwise = f (a : as) bs
    f _ _ = 0

solve :: IO ()
solve = do
  n <- read <$> getLine
  ws <- sort . map read . words <$> getLine
  print $ maximum [teamsWithSum s ws | s <- [2 .. 2 * n]]

main :: IO ()
main = do
  getLine >>= flip replicateM_ solve . read

import Control.Monad
import Data.List

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

mkArray :: a -> [(Int, a)] -> [a]
mkArray def = helper 0
  where
    helper _ [] = []
    helper n l@((i, x):xs)
      | i == n = x : helper (succ n) xs
      | otherwise = def : helper (succ n) l

solve :: [Int] -> Int
solve w = maximum $ map ((`div` 2) . sum . zipWith min l) (tails lrev)
  where
    l = mkArray 0 . map (\a -> (head a, length a)) . group . sort $ w
    lrev = replicate (length w) 0 ++ reverse l

import Control.Monad
import Data.List

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

mkArray :: a -> [(Int, a)] -> [a]
mkArray def = helper 0
  where
    helper _ [] = []
    helper n l@((i, x):xs)
      | i == n = x : helper (succ n) xs
      | otherwise = def : helper (succ n) l

solve :: [Int] -> Int
solve w =  maximum $ map ((`div` 2) . sum . zipWith min l) (tails lr)
  where
    n = length w
    l = mkArray 0 . map (\a -> (head a, length a)) .  group . sort $ w
    lr = replicate n 0 ++ reverse l

import GHC.Stack
import Control.Monad
import Data.List (group, sort)
import Data.Map (Map)
import qualified Data.Map as M

maximumOn :: (Ord b) => (a -> b) -> [a] -> a
maximumOn f [] = error "Data.List.Extra.maximumOn: empty list"
maximumOn f (x:xs) = g x (f x) xs
    where
        g v mv [] = v
        g v mv (x:xs) | mx > mv = g x mx xs
                      | otherwise = g v mv xs
            where mx = f x

dropAt 0 (x:xs) = xs
dropAt i (x:xs) = dropAt (i-1) xs

combinations 0 xs = [[]]
combinations k xs = do
  (i, x) <- zip [0..] xs
  (x:) <$> combinations (k-1) (dropAt i xs)

decrement :: (HasCallStack, Ord k) => k -> Map k Int -> Map k Int
decrement = M.alter f
  where
    f Nothing = error "Tried to decrement key that isn't there!"
    f (Just x)
      | x-1 > 0 = Just (x-1)
      | otherwise = Nothing

increment :: (HasCallStack, Ord k) => k -> Map k Int -> Map k Int
increment = M.alter f
  where
    f Nothing = Just 1
    f (Just x) = Just (x+1)

numTeams :: HasCallStack => [Int] -> Int -> Int
numTeams weights target = snd $ foldr f (M.empty, 0) weights
  where
    f weight (counts, ans)
      | (target - weight) `M.member` counts = (decrement (target-weight) counts, ans+1)
      | otherwise                           = (increment weight counts, ans)

uniq :: Ord a => [a] -> [a]
uniq = map head . group . sort

solve :: HasCallStack => [Int] -> Int
solve [] = 0
solve [_] = 0
solve weights = maximum . map (numTeams weights) . uniq $ targets
  where targets = map sum $ combinations 2 weights

main = do
  numCases <- readLn
  replicateM_ numCases $ do
    getLine
    print =<< solve <$> fmap read <$> words <$> getLine

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: Int -> [Int] -> Int
solve goal xs = f xs (reverse xs) `div` 2
    where
        f (x:xs) (y:ys)
            | x + y < goal = f xs (y:ys)
            | x + y == goal = 1 + f xs ys
            | otherwise = f (x:xs) ys
        f _ _ = 0

deal :: IO()
deal = do
    n <- read <$> getLine
    a <- sort . map read . words <$> getLine
    putStrLn $ show $ maximum [solve s a | s <- [2 .. 2*n]]

main :: IO()
main = getLine >>= flip replicateM_ deal . read

import Control.Monad (replicateM_)
import Data.List (group, groupBy, sort, tails) --'
import Data.Function (on)

solve :: [Int] -> Int
solve li = let
  sli = [(head x, length x) | x <- group (sort li)]
  pairSums = do
    ys <- tails sli
    let  (x, kx) = head ys
    (y, ky) <- ys
    pure (x + y, if  x == y  then  div kx 2  else  min kx ky)
  counts = [sum ks | ks <- map (map snd) . groupBy ((==) `on` fst) $ sort pairSums]
  in  maximum counts

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    _nStr <- getLine
    ws <- map read . words <$> getLine :: IO [Int]
    print $ solve ws

import Control.Monad
import Data.List

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

mkArray :: [(Int, a)] -> [a]
mkArray = helper 0
  where
    helper _ [] = []
    helper n l@((i, x):xs)
      | i == n = x : helper (succ n) xs
      | otherwise = helper (succ n) l

solve :: [Int] -> Int
solve w = (`div` 2) . maximum $ map (sum . zipWith min l) (tails lr)
  where
    n = length w
    l = mkArray . map (\a -> (head a, length a)) .  group . sort $ w
    lr = replicate n 0 ++ reverse l


As Gerald sets the table, Alexander sends the greeting cards, and Sergey and his twins create an army of clone snowmen, Gennady writes a New Year contest.The New Year contest begins at 18:00 (6.00 P.M.) on December 31 and ends at 6:00 (6.00 A.M.) on January 1. There are n problems for the contest. The penalty time for each solved problem is set as the distance from the moment of solution submission to the New Year in minutes. For example, the problem submitted at 21:00 (9.00 P.M.) gets penalty time 180, as well as the problem submitted at 3:00 (3.00 A.M.). The total penalty time is calculated as the sum of penalty time for all solved problems. It is allowed to submit a problem exactly at the end of the contest, at 6:00 (6.00 A.M.).Gennady opened the problems exactly at 18:00 (6.00 P.M.) and managed to estimate their complexity during the first 10 minutes of the contest. He believes that writing a solution for the i-th problem will take ai minutes. Gennady can submit a solution for evaluation at any time after he completes writing it. Probably he will have to distract from writing some solution to send the solutions of other problems for evaluation. The time needed to send the solutions can be neglected, i.e. this time can be considered to equal zero. Gennady can simultaneously submit multiple solutions. Besides, he can move at any time from writing one problem to another, and then return to the first problem from the very same place, where he has left it. Thus the total solution writing time of the i-th problem always equals ai minutes. Of course, Gennady does not commit wrong attempts, and his solutions are always correct and are accepted from the first attempt. He can begin to write the solutions starting from 18:10 (6.10 P.M.).Help Gennady choose from the strategies that help him solve the maximum possible number of problems, the one with which his total penalty time will be minimum.

The first line contains an integer n (1 ≤ n ≤ 100) — the number of the problems. The next line contains n space-separated integers ai (1 ≤ ai ≤ 720) — each number shows how much time in minutes Gennady will spend writing a solution to the problem.

Print two integers — the number of problems Gennady will solve and the total penalty time considering that he chooses the optimal strategy.

NoteIn the sample, one of Gennady's possible optimal strategies is as follows. At 18:10 (6:10 PM) he begins to write the first problem and solves it in 30 minutes (18:40 or 6.40 P.M.). At 18:40 (6.40 P.M.) he begins to write the second problem. There are 320 minutes left before the New Year, so Gennady does not have the time to finish writing the second problem before the New Year. At 0:00 (12.00 A.M.) he distracts from the second problem, submits the first one, and returns immediately to writing the second problem. At 0:10 (0.10 A.M.), he completes the solution for the second problem, submits it and gets 10 minute penalty time. Note that as the total duration of the contest is 720 minutes and Gennady has already spent 10 minutes on reading the problems, he will not have time to solve the third problem during the contest. Yes, such problems happen to exist.Competitions by the given rules are held annually on the site http://b23.ru/3wvc

module Main where

import Data.Array
import Data.List
import Data.Char

import Data.Time.Calendar

main = interact (unwords . map show . solve . map read . words . (!! 1) . lines)

startTime = 10
middleTime = (24 - 18) * 60
endTime = (6 - 18 + 24) * 60

solve :: [Int] -> [Int]
solve times = result where
    result = cutProblems bestOrder
    bestOrder = sort times

cutProblems :: [Int] -> [Int]
cutProblems = cutProblems' startTime 0 0
cutProblems' _ result tasks [] = [tasks, result]
cutProblems' sm result tasks (x : xs) = if sm + x <= endTime
    then cutProblems' (sm + x) (result + if sm + x < middleTime then 0 else sm + x - middleTime) (tasks + 1) xs
    else [tasks, result]

import Control.Monad
import Data.List (sort)

main = do
  getLine
  lengths <- (liftM (map read . words)) getLine
  let solveTimes = tail . takeWhile (<= 710) $ scanl (+) 0 (sort lengths)
  putStrLn $ show (length solveTimes) ++ " " ++ (show . sum $ map (\x -> max 0 (x-350)) solveTimes)

{-# LANGUAGE BangPatterns #-}

import Data.List

end = 720 -- end time

cost t = max 0 (t-360)

solve :: [Int] -> (Int,Int)
solve as = go 0 0 10 (sort as)
  where
    go !n c t [] = (n,c)
    go !n c t (a:as) | t+a <= end = go (n+1) (c+cost (t+a)) (t+a) as
                     | otherwise = (n,c)

main = do
  n <- fmap read getLine :: IO Int
  as <- fmap (map read . words) getLine
  let (n,c) = solve as
  putStrLn $ show n ++ " " ++ show c
  return ()

import Control.Monad (liftM)
import Data.List (sort)
import Prelude hiding (print, reads)

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

solve :: [Int] -> (Int, Int)
solve xs  =  ((flip (-) 1) $ length $ takeWhile (<= 720) $ scanl (+) 10 $ sort xs, solve' 10 $ sort xs)
  where
    solve' time []  =  0
    solve' time (x:xs)
      | time' <= 360  =  solve' time' xs
      | time' <= 720  =  (time' - 360) + solve' time' xs
      | otherwise  =  0
      where
        time'  =  time + x

print :: (Int, Int) -> IO ()
print (a, b)  =  putStrLn $ concat [show a, " ", show b]

main :: IO ()
main  =  getLine >> reads >>= print . solve

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

main :: IO ()
main = do
  _ <- getLine
  xs <- sort . map read . words <$> getLine
  let (n,p) = foldl (\(n,p) y -> (n+1, p + penalty y)) (0::Int,0) $ takeWhile (<= 710) $ scanl1 (+) xs
  printf "%d %d\n" n p

penalty :: Int -> Int
penalty t
  | t <= 350 = 0
  | otherwise = t - 350

import Data.List(scanl,sort)
import Control.Applicative

main = do n <- read <$> getLine
          ts <- map read <$> words <$> getLine
          putStrLn $ solve n ts

solve :: Int -> [Int] -> String
solve _ ts = let (n,p) = fst $ last $ takeWhile ((<=710).snd) $ scanl f ((0,0),0) $ zip [1..] $ sort ts
             in (show n) ++ " " ++ (show p)

f ((_,p),t) (n,s) = ((n, p + max 0 (s+t-350)), s+t)

import Control.Monad

main = do
  getLine
  lengths <- (liftM (map read . words)) getLine
  let solveTimes = tail . takeWhile (<= 710) $ scanl (+) 0 lengths
  putStrLn $ show (length solveTimes) ++ " " ++ (show . sum $ map (\x -> max 0 (x-350)) solveTimes)

import Data.List(scanl1,sort)
import Control.Applicative

main = do n <- read <$> getLine
          ts <- map read <$> words <$> getLine
          putStrLn $ unwords $ map show $ solve n ts

solve :: Int -> [Int] -> [Int]
solve _ ts = let (n,t) = last $ takeWhile ((<=710).snd) $ zip [0..] $ scanl1 (+) $ 0:sort ts
             in [n,max 0 (t-350)]


You are given a tree (a graph with n vertices and n - 1 edges in which it's possible to reach any vertex from any other vertex using only its edges).A vertex can be destroyed if this vertex has even degree. If you destroy a vertex, all edges connected to it are also deleted.Destroy all vertices in the given tree or determine that it is impossible.

The first line contains integer n (1 ≤ n ≤ 2·105) — number of vertices in a tree. The second line contains n integers p1, p2, ..., pn (0 ≤ pi ≤ n). If pi ≠ 0 there is an edge between vertices i and pi. It is guaranteed that the given graph is a tree.

If it's possible to destroy all vertices, print "YES" (without quotes), otherwise print "NO" (without quotes). If it's possible to destroy all vertices, in the next n lines print the indices of the vertices in order you destroy them. If there are multiple correct answers, print any.

NoteIn the first example at first you have to remove the vertex with index 1 (after that, the edges (1, 2) and (1, 4) are removed), then the vertex with index 2 (and edges (2, 3) and (2, 5) are removed). After that there are no edges in the tree, so you can remove remaining vertices in any order.

import Data.Int
import Data.Tree
import Data.Char
import Data.List
import Data.Maybe
import Data.Tuple
import Data.Foldable (toList)
import Control.Monad (when)
import Data.Array.IArray
import qualified Data.Sequence as S
import qualified Data.ByteString.Char8 as C
f2read' :: Int -> Char -> Int
f2read' x y = 10 * x + ord y - ord '0'

f2read :: C.ByteString -> Int
f2read x = C.foldl' f2read' 0 x

f2show :: Int -> C.ByteString
f2show x = C.reverse $ C.cons ' ' $ fst $ C.unfoldrN 8 (\x -> if x /= 0 then Just (chr $ rem x 10 + ord '0', div x 10) else Nothing) x

f2lines :: C.ByteString -> [C.ByteString]
f2lines x = map (\x -> if (C.last x == '\r') then (C.init x) else x) (C.lines x)

indexed :: Int -> [a] -> [(Int, a)]
indexed _ [] = []
indexed i (x:xs) = (i, x) : (indexed (i+1) xs)

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
    go (Node x ts) = f x (map go ts)

f2folder :: Int -> [(Int, (S.Seq Int, S.Seq Int))] -> (Int, (S.Seq Int, S.Seq Int))
f2folder v ls = (s, (bef, aft))
              where s = rem ((+1) $ sum $ map fst ls) 2
                    bef' = foldl (S.><) S.empty $ map (fst . snd) ls
                    aft' = foldl (S.><) S.empty $ map (snd . snd) ls
                    bef = if s == 0 then (v S.<| bef') else bef'
                    aft = if s == 1 then (v S.<| aft') else aft'

solve :: Tree Int -> Maybe [Int]
solve t = if s == 1 then Just $ toList ((S.reverse bef) S.>< aft) else Nothing
        where ans = foldTree f2folder t
              s = fst ans
              bef = fst (snd ans)
              aft = snd (snd ans)

f2buildTree :: [Int] -> Tree Int
f2buildTree xs = unfoldTree (\x -> (x, a!x)) (head $ a!0)
               where n = length xs
                     a = accumArray (\x y -> y : x) [] (0, n) (map swap (indexed 1 xs)) :: Array Int [Int]

main :: IO ()
main = do dat <- C.getContents
          let ans = solve $ f2buildTree $ map f2read $ C.words $ last $ f2lines dat
          C.putStrLn $ C.pack $ (if isJust ans then "YES" else "NO")
          when (isJust ans) $ C.putStrLn $ C.concat $ map f2show $ fromJust ans

import Data.Int
import Data.Tree
import Data.Char
import Data.List
import Data.Maybe
import Data.Tuple
import Data.Foldable (toList)
import Control.Monad (when)
import Data.Array.IArray
import qualified Data.Sequence as S
import qualified Data.ByteString.Char8 as C
f2read' :: Int -> Char -> Int
f2read' x y = 10 * x + ord y - ord '0'

f2read :: C.ByteString -> Int
f2read x = C.foldl' f2read' 0 x

f2show :: Int -> C.ByteString
f2show x = C.reverse $ C.cons ' ' $ fst $ C.unfoldrN 8 (\x -> if x /= 0 then Just (chr $ rem x 10 + ord '0', div x 10) else Nothing) x

f2lines :: C.ByteString -> [C.ByteString]
f2lines x = map (\x -> if (C.last x == '\r') then (C.init x) else x) (C.lines x)

indexed :: Int -> [a] -> [(Int, a)]
indexed _ [] = []
indexed i (x:xs) = (i, x) : (indexed (i+1) xs)

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
    go (Node x ts) = f x (map go ts)

f2folder :: Int -> [(Int, (S.Seq Int, S.Seq Int))] -> (Int, (S.Seq Int, S.Seq Int))
f2folder v ls = (s, (bef, aft))
              where s = rem ((+1) $ sum $ map fst ls) 2
                    bef' = foldl' (S.><) S.empty $ map (fst . snd) ls
                    aft' = foldl' (S.><) S.empty $ map (snd . snd) ls
                    bef = if s == 0 then (v S.<| bef') else bef'
                    aft = if s == 1 then (v S.<| aft') else aft'

solve :: Tree Int -> Maybe [Int]
solve t = if s == 1 then Just $ toList ((S.reverse bef) S.>< aft) else Nothing
        where ans = foldTree f2folder t
              s = fst ans
              bef = fst (snd ans)
              aft = snd (snd ans)

f2buildTree :: [Int] -> Tree Int
f2buildTree xs = unfoldTree (\x -> (x, a!x)) (head $ a!0)
               where n = length xs
                     a = accumArray (\x y -> y : x) [] (0, n) (map swap (indexed 1 xs)) :: Array Int [Int]

main :: IO ()
main = do dat <- C.getContents
          let ans = solve $ f2buildTree $ map f2read $ C.words $ last $ f2lines dat
          C.putStrLn $ C.pack $ (if isJust ans then "YES" else "NO")
          when (isJust ans) $ C.putStrLn $ C.concat $ map f2show $ fromJust ans


Valera loves to participate in competitions. Especially in programming contests. Today he has participated in the contest with his team, consisting of n students (including Valera). This contest was an individual competition, so each student in the team solved problems individually.After the contest was over, Valera was interested in results. He found out that:  each student in the team scored at least l points and at most r points;  in total, all members of the team scored exactly sall points;  the total score of the k members of the team who scored the most points is equal to exactly sk; more formally, if a1, a2, ..., an is the sequence of points earned by the team of students in the non-increasing order (a1 ≥ a2 ≥ ... ≥ an), then sk = a1 + a2 + ... + ak. However, Valera did not find out exactly how many points each of n students scored. Valera asked you to recover any distribution of scores between the students of the team, such that all the conditions above are met.

The first line of the input contains exactly six integers n, k, l, r, sall, sk (1 ≤ n, k, l, r ≤ 1000; l ≤ r; k ≤ n; 1 ≤ sk ≤ sall ≤ 106). It's guaranteed that the input is such that the answer exists.

Print exactly n integers a1, a2, ..., an — the number of points each student scored. If there are multiple solutions, you can print any of them. You can print the distribution of points in any order.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k,l,r,sa,sk] <- readInts
    let v = div sk k
        w = mod sk k
        ans1 = take k $ f w
        f w = let x = min r (v+w) in x:f (w-(x-v))
        s = div (sa-sk) (n-k)
        t = mod (sa-sk) (n-k)
        ans2 = take (n-k) $ g t
        g w = let x = min v (s+w) in x:g (w-(x-s))
    putStrLn $ unwords $ map show $ ans1 ++ ans2

getlist :: Int -> Int -> [Int]
getlist 0 _ = []
getlist n s = (map (+1) (take (s `mod` n) rep)) ++ (drop (s `mod` n) rep)
  where
    rep = replicate n (s `div` n)

main :: IO ()
main = do
  line <- getLine
  let [n,k,l,r,sall,sk] = map (read :: String -> Int) (words line)

  let r = (getlist k sk) ++ (getlist (n-k) (sall-sk))

  putStrLn $ concatMap (\x -> show x ++ " ") r

main=getContents>>=putStrLn.unwords.map show.solve.map read.words
solve[n,k,_,_,sall,sk]=f sk k++f(sall-sk)(n-k)
 where f _ 0=[];f s m=replicate(s`mod`m)((s+m-1)`div`m)++replicate(m-s`mod`m)(s`div`m)

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve [n, k, _, _, sall, sk] = replicate (sk `mod` k) ((sk + k - 1) `div` k)
                            ++ replicate (k - sk `mod` k) (sk `div` k)
     ++ if n == k then [] else replicate ((sall - sk) `mod` (n - k)) (((sall - sk) + (n - k) - 1) `div` (n - k))
                            ++ replicate ((n - k) - (sall - sk) `mod` (n - k)) ((sall - sk) `div` (n - k))
solve _ = undefined

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve [n, k, _, _, sall, sk] = f sk k ++ f (sall - sk) (n - k)
  where f _ 0 = []; f s m = replicate (s `mod` m) ((s + m - 1) `div` m) ++ replicate (m - s `mod` m) (s `div` m)
solve _ = undefined

import Data.List

main :: IO ()
main = getContents >>= putStrLn. intercalate " ". map show. (\[n, k, l, r, sall, sk] -> (getArr k sk) ++ (getArr (n-k) (sall - sk))). map read. words
  where
    getArr n s
      | n == 0 = []
      | otherwise =
          let
            mre = s`rem`n
            lss = n - mre
          in
            (replicate mre (s`div`n + 1)) ++ (replicate lss (s`div`n))

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k,l,r,sa,sk] <- readInts
    let v = div sk k
        w = mod sk k
        ans1 = take k $ f w
        f w = let x = min r (v+w) in x:f (w-(x-v))
        s = div (sa-sk) (n-k)
        t = mod (sa-sk) (n-k)
        ans2 = take (n-k) $ g t
        g w = let x = min r (s+w) in x:g (w-(x-s))
    putStrLn $ unwords $ map show $ ans1 ++ ans2