Baby Ehab is known for his love for a certain operation. He has an array $$$a$$$ of length $$$n$$$, and he decided to keep doing the following operation on it:   he picks $$$2$$$ adjacent elements; he then removes them and places a single integer in their place: their bitwise XOR. Note that the length of the array decreases by one. Now he asks you if he can make all elements of the array equal. Since babies like to make your life harder, he requires that you leave at least $$$2$$$ elements remaining.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 15$$$) — the number of test cases you need to solve. The first line of each test case contains an integers $$$n$$$ ($$$2 \le n \le 2000$$$) — the number of elements in the array $$$a$$$. The second line contains $$$n$$$ space-separated integers $$$a_1$$$, $$$a_2$$$, $$$\ldots$$$, $$$a_{n}$$$ ($$$0 \le a_i < 2^{30}$$$) — the elements of the array $$$a$$$.

If Baby Ehab can make all elements equal while leaving at least $$$2$$$ elements standing, print "YES". Otherwise, print "NO".

NoteIn the first sample, he can remove the first $$$2$$$ elements, $$$0$$$ and $$$2$$$, and replace them by $$$0 \oplus 2=2$$$. The array will be $$$[2,2]$$$, so all the elements are equal.In the second sample, there's no way to make all the elements equal.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BlockArguments #-}

import Data.Bits
import Data.List
import Data.Array
import Prelude
import Data.Bool
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import Data.Maybe

precalc :: Int -> [Int] -> Int -> Int -> Int
precalc len x = \l r -> (arr ! (l - 1)) `xor` (arr ! r)
  where
    arr = listArray (0, len) $ scanl' xor 0 x

solve :: Int -> [Int] -> Bool
solve len x = any (\m -> get 1 m == get (m + 1) len || any (\m' -> get 1 m == get (m + 1) m' && get m m' == get (m' + 1) len) [m..len - 1]) [1..len - 1]
  where
    get = precalc len x

main :: IO ()
main = readLn >>= flip replicateM_ do putStrLn . bool "NO" "YES" =<< liftA2 solve readLn readInts

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

{-# LANGUAGE BlockArguments #-}

import Data.Bits
import Data.List
import Data.Array
import Prelude
import Data.Bool
import Control.Monad
import Control.Applicative

precalc :: Int -> [Int] -> Int -> Int -> Int
precalc len x = \l r -> (arr ! (l - 1)) `xor` (arr ! r)
  where
    arr = listArray (0, len) $ scanl' xor 0 x

solve :: Int -> [Int] -> Bool
solve len x = any (\m -> get 1 m == get (m + 1) len || any (\m' -> get 1 m == get (m + 1) m' && get m m' == get (m' + 1) len) [m..len - 1]) [1..len - 1]
  where
    get = precalc len x

main :: IO ()
main = readLn >>= flip replicateM_ do putStrLn . bool "NO" "YES" =<< liftA2 solve readLn (fmap read . words <$> getLine)

import Data.Bits
import Data.List
import Data.Array
import Prelude
import Data.Bool

precalc :: [Int] -> Int -> Int -> Int
precalc x = \l r -> (arr ! (l - 1)) `xor` (arr ! r)
  where
    arr = listArray (0, len) $ scanl' xor 0 x
    len = length x

solve :: [Int] -> Bool
solve x = any (\m -> get 1 m == get (m + 1) len || any (\m' -> get 1 m == get (m + 1) m' && get m m' == get (m' + 1) len) [m..len - 1]) [1..len - 1]
  where
    len = length x
    get = precalc x

main :: IO ()
main = interact $ unlines . fmap (bool "NO" "YES" . solve . fmap read . words) . evens . tail . lines

evens :: [a] -> [a]
evens (_:x:xs) = x:evens xs
evens _        = []

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import Data.Bits(xor)

import Data.Array((!))

result2 list = 0 == foldr xor 0 list

result3 [x, y] = False
result3 [x, y, z] = x == y && x == z

result3 list = foldr aux0 False [1..(n-2)] where
	xorList [] = []
	xorList [x] = [x]
	xorList (x:y:xs) = let l = xorList $ y:xs in (xor x $ head l) : l
	xorA = A.listArray (0, n) $ xorList list

	n = toInteger $ length list

	aux0 i b = foldr (aux1 i) b [(i+1)..(n-1)]

	aux1 i j b = (||) b $ x0 == x1 && x0 == x2 where
		x0 = xor v0 vi
		x1 = xor vi vj
		x2 = vj

		v0 = xorA ! 0
		vi = xorA ! i
		vj = xorA ! j

showR True = "YES"
showR False = "NO"

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		putStrLn $ showR $ result2 a || result3 a
		loop $ t - 1
	loop t

import Control.Monad (replicateM_)
import Data.Bits (xor)
import Data.List (foldl')

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

countSegment :: (Int, Int, Int) -> Int -> (Int, Int, Int)
countSegment (xored, cnt, y) x = (xored', cnt', y) where
  (xored', cnt') = if xored `xor` x == y
    then (0, cnt + 1)
    else (xored `xor` x, cnt)

isPossible :: [Int] -> Bool
isPossible xs = xored == 0 || let (_, cnt, _) = getCnt xs in cnt >= 3 where
  xored = foldl' xor 0 xs
  getCnt :: [Int] -> (Int, Int, Int)
  getCnt = foldl' countSegment (0, 0, xored)

solve :: IO ()
solve =
  getLine  >>
  isPossible <$> readInts >>= \ans ->
  putStrLn $ if ans then "YES" else "NO"

main :: IO ()
main = do
  t <- readLn
  replicateM_ t solve

import Data.Bits
import Data.List
import Data.Array
import Prelude
import Data.Bool

precalc :: [Int] -> Int -> Int -> Int
precalc x = \l r -> (arr ! l) `xor` (arr ! r - 1)
  where
    arr = listArray (0, len) $ scanl' xor 0 x
    len = length x

solve :: [Int] -> Bool
solve x = any (\m -> get 1 m == get m len || any (\m' -> get 1 m == get m m' && get m m' == get m' len) [m..len]) [1..len]
  where
    len = length x
    get = precalc x

main :: IO ()
main = interact $ unlines . fmap (bool "NO" "YES" . solve . fmap read . words) . evens . tail . lines

evens :: [a] -> [a]
evens (_:x:xs) = x:evens xs
evens _        = []

import Data.Bits
import Data.List
import Data.Array
import Prelude
import Data.Bool

precalc :: [Int] -> Int -> Int -> Int
precalc x = \l r -> (arr ! l) `xor` (arr ! r)
  where
    arr = listArray (0, len) $ scanl' xor 0 x
    len = length x

solve :: [Int] -> Bool
solve x = any (\m -> get 1 m == get m len || any (\m' -> get 1 m == get m m' && get m m' == get m' len) [m..len]) [1..len]
  where
    len = length x
    get = precalc x

main :: IO ()
main = interact $ unlines . fmap (bool "NO" "YES" . solve . fmap read . words) . evens . tail . lines

evens :: [a] -> [a]
evens (_:x:xs) = x:evens xs
evens _        = []

import Control.Monad (replicateM_)
import Data.Bits (xor)
import Data.List (foldl')

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

countSegment :: (Int, Int, Int) -> Int -> (Int, Int, Int)
countSegment (xored, cnt, y) x = (xored', cnt', y) where
  (xored', cnt') = if xored `xor` x == y
    then (xored `xor` x, cnt + 1)
    else (0, cnt)

isPossible :: [Int] -> Bool
isPossible xs = xored == 0 || let (_, cnt, _) = getCnt xs in cnt >= 3 where
  xored = foldl' xor 0 xs
  getCnt :: [Int] -> (Int, Int, Int)
  getCnt = foldl' countSegment (0, 0, xored)

solve :: IO ()
solve =
  getLine  >>
  isPossible <$> readInts >>= \ans ->
  putStrLn $ if ans then "YES" else "NO"

main :: IO ()
main = do
  t <- readLn
  replicateM_ t solve

import Control.Monad (replicateM_)
import Data.Bits (xor)
import Data.List (foldl')

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

countSegment :: (Int, Int, Int) -> Int -> (Int, Int, Int)
countSegment (xored, cnt, y) x = (xored', cnt', y) where
  xored' = xored `xor` x
  cnt' = if xored' == y then cnt + 1 else 0

isPossible :: [Int] -> Bool
isPossible xs = xored == 0 || let (_, cnt, _) = getCnt xs in cnt >= 3 where
  xored = foldl' xor 0 xs
  getCnt :: [Int] -> (Int, Int, Int)
  getCnt = foldl' countSegment (0, 0, xored)

solve :: IO ()
solve =
  getLine  >>
  isPossible <$> readInts >>= \ans ->
  putStrLn $ if ans then "YES" else "NO"

main :: IO ()
main = do
  t <- readLn
  replicateM_ t solve


String x is an anagram of string y, if we can rearrange the letters in string x and get exact string y. For example, strings "DOG" and "GOD" are anagrams, so are strings "BABA" and "AABB", but strings "ABBAC" and "CAABA" are not.You are given two strings s and t of the same length, consisting of uppercase English letters. You need to get the anagram of string t from string s. You are permitted to perform the replacing operation: every operation is replacing some character from the string s by any other character. Get the anagram of string t in the least number of replacing operations. If you can get multiple anagrams of string t in the least number of operations, get the lexicographically minimal one.The lexicographic order of strings is the familiar to us "dictionary" order. Formally, the string p of length n is lexicographically smaller than string q of the same length, if p1 = q1, p2 = q2, ..., pk - 1 = qk - 1, pk < qk for some k (1 ≤ k ≤ n). Here characters in the strings are numbered from 1. The characters of the strings are compared in the alphabetic order.

The input consists of two lines. The first line contains string s, the second line contains string t. The strings have the same length (from 1 to 105 characters) and consist of uppercase English letters.

In the first line print z — the minimum number of replacement operations, needed to get an anagram of string t from string s. In the second line print the lexicographically minimum anagram that could be obtained in z operations.

NoteThe second sample has eight anagrams of string t, that can be obtained from string s by replacing exactly two letters: "ADBADC", "ADDABC", "CDAABD", "CDBAAD", "CDBADA", "CDDABA", "DDAABC", "DDBAAC". These anagrams are listed in the lexicographical order. The lexicographically minimum anagram is "ADBADC".

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

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

get arr i = unsafeRead arr i
put arr i x = unsafeWrite arr i x
modify arr i f = unsafeRead arr i >>= unsafeWrite arr i.f

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

  s <- hGetLine hin
  t <- hGetLine hin

  cnt   <- newArray (0,300) 0 :: IO (IOUArray Int Int)
  change <- newArray (0,300) 0 :: IO (IOUArray Int Int)

  forM_ s $ \c-> do
    modify cnt (fromEnum c) (1+)

  let diff xxs@(x:xs) yys@(y:ys)
        | x==y = diff xs ys
        | x<y  = Right x : diff xs yys
        | otherwise = Left y : diff xxs ys
      diff [] ys = map (Left$) ys
      diff xs [] = map (Right$) xs
      diff _ _ = []

  let diffAll = diff (sort s) (sort t)

  forM_ (rights diffAll) $ \c-> do
    modify change (fromEnum c) (1+)

  let solve xxs@(x:xs) yys@(y:ys) = do
        let !i = fromEnum x
        cnti <- get cnt i
        ri   <- get change i
        if ri==0
           then do
             hPutChar hout x
             solve xs yys
           else do
             if cnti == ri
                then do
                  hPutChar hout y
                  modify cnt i (subtract 1)
                  modify change i (subtract 1)
                  solve xs ys
                else do
                  if x <= y
                     then do
                       hPutChar hout x
                       modify cnt i (subtract 1)
                       solve xs yys
                     else do
                       hPutChar hout y
                       modify cnt i (subtract 1)
                       modify change i (subtract 1)
                       solve xs ys
      solve xs [] = hPutStrLn hout xs
      solve _ _ = return ()

  hPrint hout $ length $ lefts diffAll
  solve s $ lefts diffAll

  hClose hin
  hClose hout

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

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

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

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

  s <- hGetLine hin
  t <- hGetLine hin

  cnt   <- newArray (0,300) 0 :: IO (IOUArray Int Int)
  change <- newArray (0,300) 0 :: IO (IOUArray Int Int)

  forM_ s $ \c-> do
    let !i = fromEnum c
    unsafeRead cnt i >>= unsafeWrite cnt i.(1+)

  let diff xxs@(x:xs) yys@(y:ys)
        | x==y = diff xs ys
        | x<y  = Right x : diff xs yys
        | otherwise = Left y : diff xxs ys
      diff [] ys = map (Left$) ys
      diff _ _ = []

  let diffAll = diff (sort s) (sort t)

  forM_ [c | Right c <-diffAll ] $ \c-> do
    let !i = fromEnum c
    unsafeRead change i >>= unsafeWrite change i.(1+)

  let solve xxs@(x:xs) yys@(y:ys) = do
        let !i = fromEnum x
        cnti <- unsafeRead cnt i
        ri   <- unsafeRead change i -- ri<=cnti
        if cnti == ri
           then do
             hPutChar hout y
             unsafeRead cnt i>>=unsafeWrite cnt i.(subtract 1)
             unsafeRead change i>>=unsafeWrite change i.(subtract 1)
             solve xs ys
           else do
             if x <= y
                then do
                  hPutChar hout x
                  unsafeRead cnt i>>=unsafeWrite cnt i.(subtract 1)
                  solve xs yys
                else do
                  hPutChar hout y
                  unsafeRead cnt i>>=unsafeWrite cnt i.(subtract 1)
                  unsafeRead change i>>=unsafeWrite change i.(subtract 1)
                  solve xs ys
      solve xs [] = hPutStrLn hout xs
      solve _ _ = return ()

  hPrint hout $ sum [ 1 | Left c<-diffAll]
  solve s [c | Left c<-diffAll]

  hClose hin
  hClose hout

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

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

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

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

  s <- hGetLine hin
  t <- hGetLine hin

  cnt   <- newArray (0,300) 0 :: IO (IOUArray Int Int)
  change <- newArray (0,300) 0 :: IO (IOUArray Int Int)

  forM_ s $ \c-> do
    let !i = fromEnum c
    unsafeRead cnt i >>= unsafeWrite cnt i.(1+)

  let diff xxs@(x:xs) yys@(y:ys)
        | x==y = diff xs ys
        | x<y  = Right x : diff xs yys
        | otherwise = Left y : diff xxs ys
      diff [] ys = map (Left$) ys
      diff _ _ = []

  let diffAll = diff (sort s) (sort t)

  forM_ [c | Right c <-diffAll ] $ \c-> do
    let !i = fromEnum c
    unsafeRead change i >>= unsafeWrite change i.(1+)

  let solve xxs@(x:xs) yys@(y:ys) = do
        let !i = fromEnum x
        cnti <- unsafeRead cnt i
        ri   <- unsafeRead change i -- ri<=cnti
        if cnti == ri
           then do
             hPutChar hout y
             unsafeRead cnt i>>=unsafeWrite cnt i.(subtract 1)
             unsafeRead change i>>=unsafeWrite change i.(subtract 1)
             solve xs ys
           else do
             if x <= y
                then do
                  hPutChar hout x
                  unsafeRead cnt i>>=unsafeWrite cnt i.(subtract 1)
                  when (x==y) $ unsafeRead change i>>=unsafeWrite change i.(subtract 1)
                  solve xs yys
                else do
                  hPutChar hout y
                  unsafeRead cnt i>>=unsafeWrite cnt i.(subtract 1)
                  unsafeRead change i>>=unsafeWrite change i.(subtract 1)
                  solve xs ys
      solve xs [] = hPutStrLn hout xs
      solve _ _ = return ()

  hPrint hout $ sum [ 1 | Left c<-diffAll]
  solve s [c | Left c<-diffAll]

  hClose hin
  hClose hout


Recently, Berland faces federalization requests more and more often. The proponents propose to divide the country into separate states. Moreover, they demand that there is a state which includes exactly k towns.Currently, Berland has n towns, some pairs of them are connected by bilateral roads. Berland has only n - 1 roads. You can reach any city from the capital, that is, the road network forms a tree.The Ministry of Roads fears that after the reform those roads that will connect the towns of different states will bring a lot of trouble.Your task is to come up with a plan to divide the country into states such that:  each state is connected, i.e. for each state it is possible to get from any town to any other using its roads (that is, the roads that connect the state towns),  there is a state that consisted of exactly k cities,  the number of roads that connect different states is minimum.

The first line contains integers n, k (1 ≤ k ≤ n ≤ 400). Then follow n - 1 lines, each of them describes a road in Berland. The roads are given as pairs of integers xi, yi (1 ≤ xi, yi ≤ n; xi ≠ yi) — the numbers of towns connected by the road. Assume that the towns are numbered from 1 to n.

The the first line print the required minimum number of "problem" roads t. Then print a sequence of t integers — their indices in the found division. The roads are numbered starting from 1 in the order they follow in the input. If there are multiple possible solutions, print any of them. If the solution shows that there are no "problem" roads at all, print a single integer 0 and either leave the second line empty or do not print it at all.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
import Control.Arrow hiding(loop)
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Tuple
import Control.DeepSeq
import Data.Maybe
import Data.Monoid
import qualified Data.Array as Array
import qualified Data.Array.ST as STArray
import qualified Data.Map as Map
import qualified Data.Set as Set

zip' l b r = go where
  go as [] = map l as
  go [] bs = map r bs
  go (x : xs) (y : ys) = b x y : go xs ys

diagonals [] = []
diagonals (xs : xss) = zip' return (:) id xs ([] : diagonals xss)

convolution f g as bs = map (foldr1 g) $ diagonals (map (\a -> map (f a) bs) as)
type Arr a = Array.Array Int a
alength arr = case Array.bounds arr of
  (0, n) -> n + 1

convolutionArr' f as bs = map (f (head as)) bs ++ map (flip f (head bs)) (tail as)
convolutionArr'' :: NFData c => (a -> b -> c) -> (c -> c -> c) -> Arr a -> Arr b -> Arr c
convolutionArr'' f g as bs = force $ list2arr $ convolutionArr' f (Array.elems as) (Array.elems bs)

loop :: Int -> (Int -> ST s ()) -> ST s ()
loop n f = go 0 where
  go i
    | i == n = return ()
    | otherwise = f i >> go (i + 1)

{- foreach :: STArray.STArray s a b -> ((a, b) -> ST s ()) -> ST s ()
foreach arr f = mapM_ (STArray.range  -}

update arr i f =
  STArray.readArray arr i >>= \x -> let r = f x in deepseq r (STArray.writeArray arr i r)

convolutionArrST :: (NFData a, NFData b, NFData c) => (a -> b -> c) -> (c -> c -> c) -> Arr a -> Arr b -> Arr c
convolutionArrST f g as bs =
  fmap fromJust $
  let an = alength as in
  let bn = alength bs in
  STArray.runSTArray $ do
    arr <- STArray.newArray (0, (an-1)+(bn-1)) Nothing
    loop an (\i ->
      loop bn (\j -> do
        let y = f (as Array.! i) (bs Array.! j)
        update arr (i+j) (Just . maybe y (g y))
        ))
    return arr
-- convolutionArr = convolutionST
convolutionArr = convolutionArrST
convolutionArrL f g as bs = list2arr $ convolution f g (Array.elems as) (Array.elems bs)
convolutionArrAA :: (NFData a, NFData b, NFData c) => (a -> b -> c) -> (c -> c -> c) -> Arr a -> Arr b -> Arr c
convolutionArrAA f g as bs = seq (force (as,bs)) $ force $
  let an = alength as - 1 in
  let bn = alength bs - 1 in
  {- trace (show (alength as * alength bs)) -} (
  fmap fromJust $
  Array.accumArray (\x y -> Just $ maybe y (g y) x) Nothing (0, an+bn) [(i+j,f a b)|(i,a)<- Array.assocs as, (j,b)<- Array.assocs bs])

type Edge = Int

data Forest = Empty | Multi Forest Forest | Node Edge Forest

instance (Eq a, Eq b) => Eq (Tup a b) where
  Tup a b == Tup c d = a == c && b == d
instance (Ord a, Ord b) => Ord (Tup a b) where
  compare (Tup a b) (Tup c d) = case compare a c of
    EQ -> compare b d
    x -> x

data RoadSet =
  NoRoads
  | OneRoad !Edge
  | MultipleRoads !Int !RoadSet !RoadSet deriving Show

instance NFData RoadSet where
  rnf (!x) = ()

rsToList l = go l [] where
  go NoRoads = id
  go (OneRoad r) = (r:)
  go (MultipleRoads _ a b) = go a . go b
rCount NoRoads = 0
rCount (OneRoad _) = 1
rCount (MultipleRoads n _ _) = n

instance Monoid RoadSet where
  mempty = NoRoads
  mappend NoRoads x = x
  mappend x NoRoads = x
  mappend a b = MultipleRoads (rCount a + rCount b) a b

instance Eq RoadSet where
  a == b = rCount a == rCount b
instance Ord RoadSet where
  compare a b = compare (rCount a) (rCount b)

data Tup a b = Tup !a !b
type Cuts = RoadSet

type Roots = Int

list2arr l = deepseq l $ Array.listArray (0, length l - 1) l
-- choose' = zip' id min id
choose a b = force $ Array.listArray (0, max (alength a) (alength b) - 1) (zip' id min id (Array.elems a) (Array.elems b))

solve :: Forest -> Tup (Array.Array Int Cuts) (Array.Array Int Cuts) {- Rooted, rootless -}
solve Empty = Tup (list2arr [mempty]) (list2arr [mempty])
solve (Multi a b) =
  Tup
  (convolutionArr mappend min rootedA rootedB)
  (choose rootlessA rootlessB)
   where
      Tup rootedA rootlessA = solve a
      Tup rootedB rootlessB = solve b
solve (Node e f) =
  Tup
  (acons (OneRoad e) rooted)
  (choose (acons mempty (fmap (mappend (OneRoad e)) rooted)) rootless)
  where
   Tup rooted rootless = solve f

acons x a = Array.listArray (0, alength a) (x : Array.elems a)

ss :: [(Int, Int)] -> Int -> Int -> [Int]
ss [] _ _ = []
ss roads n k =
  let roads' = concat [ [(a,[(b,i)]), (b, [(a,i)])] | (i,(a,b)) <- zip [1..] roads] in
  let Tup rooted rootless = solve (buildTree 1 (Map.fromListWith (++) roads') 0) in
  rsToList (choose rootless (acons NoRoads rooted) Array.! k)
      where
    buildTree x m v =
      (foldr Multi Empty [ Node r $ buildTree y m x | (y,r) <- m Map.! x, y /= v ])

divide d n = replicate (n `mod` d) (n `div` d + 1) ++ replicate (d - n `mod` d) (n `div` d)

balancedTree _ 0 = Empty
balancedTree b n = foldr Multi Empty [Node 0 $ balancedTree b k | k <- divide b (n - 1)]

tfst (Tup x _) = x
tsnd (Tup _ x) = x

foo = alength $ tfst $ solve $ balancedTree 3 3000
zoo = convolutionArr mappend min (list2arr (replicate 3000 (mempty :: Cuts))) (list2arr (replicate 3000 mempty))

main = do
  [n :: Int,k] <- map read . words <$> getLine
  roads <- replicateM (n - 1) $ (\[a,b] -> (a,b)) . map read . words <$> getLine
  let res = ss roads n k
  print $ length res
  mapM_ print res

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Arrow
import Control.Applicative
import Control.Monad
import Data.Tuple
import qualified Data.Array as Array
import qualified Data.Map as Map
import qualified Data.Set as Set

zip' l b r as [] = map l as
zip' l b r [] bs = map r bs
zip' l b r (x : xs) (y : ys) = b x y : zip' l b r xs ys

diagonals [] = []
diagonals (xs : xss) = zip' return (:) id xs ([] : diagonals xss)

convolution f g as bs = map (foldr1 g) $ diagonals (map (\a -> map (f a) bs) as)

type Edge = Int

data Forest = Empty | Multi Forest Forest | Node Edge Forest

data Ignore a = Ignore { unIgnore :: a } deriving Show

instance Eq (Ignore a) where
  _ == _ = True
instance Ord (Ignore a) where
  compare _ _ = EQ

type Cuts = (Int, Ignore [Edge])

type Roots = Int

choose = zip' id min id

rooted :: Forest -> [Cuts] {- Indices are numbers of nodes to take, starting with 0 -}
rooted Empty = [(0, Ignore [])]
rooted (Multi a b) = convolution (\(a,Ignore b) (c,Ignore d) -> (a + c, Ignore $ b ++ d)) min (rooted a) (rooted b)
rooted (Node e f) = (1,Ignore [e]) : rooted f

rootless :: Forest -> [Cuts]
rootless Empty = [(0, Ignore [])]
rootless (Multi a b) = choose (rootless a) (rootless b)
rootless (Node e f) = choose ((0, Ignore []) : map ((1+) *** (Ignore . (e:) . unIgnore)) (rooted f)) (rootless f)

solve :: Forest -> ([Cuts], [Cuts]) {- Rooted, rootless -}
solve Empty = ([(0, Ignore [])], [(0, Ignore [])])
solve (Multi a b) =
      (convolution (\(a,Ignore b) (c,Ignore d) -> (a + c, Ignore $ b ++ d)) min rootedA rootedB,
       choose rootlessA rootlessB)
   where
      (rootedA, rootlessA) = solve a
      (rootedB, rootlessB) = solve b
solve (Node e f) =
  ((1, Ignore [e]) : rooted
  , choose ((0, Ignore []) : map ((1+) *** (Ignore . (e:) . unIgnore)) rooted) rootless)
  where
   (rooted, rootless) = solve f

ss :: [(Int, Int)] -> Int -> Int -> [Int]
ss [] _ _ = []
ss roads n k =
  let roads' = concat [ [(a,[(b,i)]), (b, [(a,i)])] | (i,(a,b)) <- zip [0..] roads] in
  let (rooted, rootless) = solve (buildTree 1 (Map.fromListWith (++) roads') 0) in
  unIgnore (snd (choose rootless ((0, Ignore []) : rooted) !! k))
      where
    buildTree x m v =
      (foldr Multi Empty [ Node r $ buildTree y m x | (y,r) <- m Map.! x, y /= v ])

main = do
  [n :: Int,k] <- map read . words <$> getLine
  roads <- replicateM (n - 1) $ (\[a,b] -> (a,b)) . map read . words <$> getLine
  let res = ss roads n k
  print $ length res
  mapM_ print res


Santa Claus has Robot which lives on the infinite grid and can move along its lines. He can also, having a sequence of m points p1, p2, ..., pm with integer coordinates, do the following: denote its initial location by p0. First, the robot will move from p0 to p1 along one of the shortest paths between them (please notice that since the robot moves only along the grid lines, there can be several shortest paths). Then, after it reaches p1, it'll move to p2, again, choosing one of the shortest ways, then to p3, and so on, until he has visited all points in the given order. Some of the points in the sequence may coincide, in that case Robot will visit that point several times according to the sequence order.While Santa was away, someone gave a sequence of points to Robot. This sequence is now lost, but Robot saved the protocol of its unit movements. Please, find the minimum possible length of the sequence.

The first line of input contains the only positive integer n (1 ≤ n ≤ 2·105) which equals the number of unit segments the robot traveled. The second line contains the movements protocol, which consists of n letters, each being equal either L, or R, or U, or D. k-th letter stands for the direction which Robot traveled the k-th unit segment in: L means that it moved to the left, R — to the right, U — to the top and D — to the bottom. Have a look at the illustrations for better explanation.

The only line of input should contain the minimum possible length of the sequence.

NoteThe illustrations to the first three tests are given below.  The last example illustrates that each point in the sequence should be counted as many times as it is presented in the sequence.

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Int
  readInt s = read s :: Int

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  inv :: Char -> Char
  inv 'L' = 'R'
  inv 'R' = 'L'
  inv 'U' = 'D'
  inv 'D' = 'U'
  inv 'Q' = 'Q'

  separation :: Char -> Char -> String -> Int -> Int
  separation _ _ [] i = i
  separation 'Q' 'Q' (x:xs) i
    | x == 'U' = separation 'Q' 'U' xs i
    | x == 'D' = separation 'Q' 'D' xs i
    | x == 'R' = separation 'R' 'Q' xs i
    | x == 'L' = separation 'L' 'Q' xs i
  separation 'Q' u (x:xs) i
    | x == 'R' = separation 'R' u xs i
    | x == 'L' = separation 'L' u xs i
    | x == inv u = separation 'Q' x xs (i + 1)
    | otherwise = separation 'Q' u xs i
  separation r 'Q' (x:xs) i
    | x == 'U' = separation r 'U' xs i
    | x == 'D' = separation r 'D' xs i
    | x == inv r = separation x 'Q' xs (i + 1)
    | otherwise = separation r 'Q' xs i
  separation r u (x:xs) i
    | x == inv r = separation x 'Q' xs (i + 1)
    | x == inv u = separation 'Q' x xs (i + 1)
    | otherwise = separation r u xs i

  main :: IO()
  main = do
    i <- getLine >>= return . readInt
    moves <- getLine
    putStrLn $ show $ separation 'Q' 'Q' moves 1

import Data.List( nub)
main = do
    n_ <- readLn::IO Int
    direcs_ <- getLine
    let proc (d:[]) stop
	  | d `elem` stop   = 1
	  | otherwise	    = 0
	proc (d1:d2:ds) stop
	  | d1 `elem` stop = 1+(proc (d2:ds) $ nub $ (opp d1):[])
	  | otherwise	    = proc (d2:ds) $ nub $ (opp d1):stop
	opp 'L' = 'R'
	opp 'R' = 'L'
	opp 'D' = 'U'
	opp 'U' = 'D'
    print $ (proc direcs_ [])+1


User ainta decided to paint a wall. The wall consists of n2 tiles, that are arranged in an n × n table. Some tiles are painted, and the others are not. As he wants to paint it beautifully, he will follow the rules below.  Firstly user ainta looks at the wall. If there is at least one painted cell on each row and at least one painted cell on each column, he stops coloring. Otherwise, he goes to step 2.  User ainta choose any tile on the wall with uniform probability.  If the tile he has chosen is not painted, he paints the tile. Otherwise, he ignores it.  Then he takes a rest for one minute even if he doesn't paint the tile. And then ainta goes to step 1.   However ainta is worried if it would take too much time to finish this work. So he wants to calculate the expected time needed to paint the wall by the method above. Help him find the expected time. You can assume that choosing and painting any tile consumes no time at all.

The first line contains two integers n and m (1 ≤ n ≤ 2·103; 0 ≤ m ≤ min(n2, 2·104)) — the size of the wall and the number of painted cells. Next m lines goes, each contains two integers ri and ci (1 ≤ ri, ci ≤ n) — the position of the painted cell. It is guaranteed that the positions are all distinct. Consider the rows of the table are numbered from 1 to n. Consider the columns of the table are numbered from 1 to n.

In a single line print the expected time to paint the wall in minutes. Your answer will be considered correct if it has at most 10 - 4 absolute or relative error.

{-# LANGUAGE BangPatterns #-}

import qualified Data.IntSet as S
import Data.Array.IArray
import Data.Array.MArray
import Data.Array.ST (runSTUArray)
import Data.Array (Array)
import Debug.Trace
import qualified Data.Array.Unboxed as U
import Control.Monad (forM_)

(-->) = flip fmap

test :: Int -> IO (Int,Int)
test 0 = return (0,0)
test n = do
  (x:y:_) <- getLine --> words --> map read
  let _ = x :: Int
  putStrLn $ "-- x: " ++ show x ++ " y: " ++ show y
  test (n-1)

readPairs :: Int -> IO (Int,Int)
readPairs n | n <= 0 = return (0,0)
readPairs n = go n 0 S.empty 0 S.empty
  where
    go :: Int -> Int -> S.IntSet -> Int -> S.IntSet -> IO (Int,Int)
    go 0 !r rset !c cset = return (r,c)
    go n !r rset !c cset = do
      (x:y:_) <- getLine --> words --> map read
      let (r',rset') = if S.member x rset
                         then (r,rset) else (r+1,S.insert x rset)
      let (c',cset') = if S.member y cset
                         then (c,cset) else (c+1,S.insert y cset)
      go (n-1) r' rset' c' cset'

solve :: Int -> Int -> Int -> Array (Int,Int) Double
solve n r c = arr
  where
    arr  = array ((0,0),(r,c)) (corner ++ top ++ side ++ int) :: Array (Int,Int) Double
    corner = [ ((0,0), 0) ] :: [ ((Int,Int),Double) ]
    top  = [ ((0,k),v) | k <- [1..c], let v = (arr ! (0,k-1)) + (n//k) ]
    side = [ ((k,0),v) | k <- [1..r], let v = (arr ! (k-1,0)) + (n//k) ]
    (//) :: Int -> Int -> Double
    a // b = fromIntegral a / fromIntegral b
    int  = [ ((i,j),v) | i <- [1..r], j <- [1..c],
                         let d = (n*n) - (n-i)*(n-j),
                         let v = (n*n) // d
                                 + (arr ! (i-1,j))   * ( (i*(n-j))  // d)
                                 + (arr ! (i,j-1))   * ( ((n-i)*j) // d)
                                 + (arr ! (i-1,j-1)) * ( (i*j) // d)
           ]

solve' :: Int -> Int -> Int -> U.UArray (Int,Int) Double
solve' n r c  = runSTUArray $ do
  arr <- newArray ((0,0),(r,c)) 0
  -- compute the sides
  forM_ [1..c] $ \j -> do
    u <- readArray arr (0,j-1)
    writeArray arr (0,j) (u + (n//j))
  forM_ [1..r] $ \i -> do
    u <- readArray arr (i-1,0)
    writeArray arr (i,0) (u + (n//i))
  -- compute the interior
  forM_ [1..r] $ \i -> do
    forM_ [1..c] $ \j -> do
      a <- readArray arr (i-1,j-1)
      b <- readArray arr (i-1,j)
      c <- readArray arr (i,j-1)
      let i' = n-i
          j' = n-j
          d = (n*n) - i'*j'
          v = ((n*n) // d)
                + a * ( (i*j)  // d )
                + b * ( (i*j') // d )
                + c * ( (i'*j) // d )
      writeArray arr (i,j) v
  return arr
  where
    (//) :: Int -> Int -> Double
    a // b = fromIntegral a / fromIntegral b

main = do
  (n:m:_) <- getLine --> words --> map read
  (r',c') <- readPairs m
  let r = n-r'
      c = n-c'
  -- putStrLn $ "=== n: " ++ show n ++ " r: " ++ show r ++ " c: " ++ show c
  let arr = solve' n r c
  print $ arr ! (r,c)


Convexity of a set of points on the plane is the size of the largest subset of points that form a convex polygon. Your task is to build a set of n points with the convexity of exactly m. Your set of points should not contain three points that lie on a straight line.

The single line contains two integers n and m (3 ≤ m ≤ 100, m ≤ n ≤ 2m).

If there is no solution, print "-1". Otherwise, print n pairs of integers — the coordinates of points of any set with the convexity of m. The coordinates shouldn't exceed 108 in their absolute value.


You're given a list of n strings a1, a2, ..., an. You'd like to concatenate them together in some order such that the resulting string would be lexicographically smallest.Given the list of strings, output the lexicographically smallest concatenation.

The first line contains integer n — the number of strings (1 ≤ n ≤ 5·104). Each of the next n lines contains one string ai (1 ≤ |ai| ≤ 50) consisting of only lowercase English letters. The sum of string lengths will not exceed 5·104.

Print the only string a — the lexicographically smallest string concatenation.

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Data.List (sortBy)
import Data.Ord (comparing)
main = do
  n <- readLn
  ss <- replicateM n getLine

  let
    l = sortBy (\a b -> compare (a ++ b) (b ++ a)) ss

  putStrLn $ concat l


Alice and Bob like games. And now they are ready to start a new game. They have placed n chocolate bars in a line. Alice starts to eat chocolate bars one by one from left to right, and Bob — from right to left. For each chocololate bar the time, needed for the player to consume it, is known (Alice and Bob eat them with equal speed). When the player consumes a chocolate bar, he immediately starts with another. It is not allowed to eat two chocolate bars at the same time, to leave the bar unfinished and to make pauses. If both players start to eat the same bar simultaneously, Bob leaves it to Alice as a true gentleman.How many bars each of the players will consume?

The first line contains one integer n (1 ≤ n ≤ 105) — the amount of bars on the table. The second line contains a sequence t1, t2, ..., tn (1 ≤ ti ≤ 1000), where ti is the time (in seconds) needed to consume the i-th bar (in the order from left to right).

Print two numbers a and b, where a is the amount of bars consumed by Alice, and b is the amount of bars consumed by Bob.

main = do
	dummy <- getLine
	line <- getLine
	putStrLn (let t = map read $ words line; a = gao t; b = length t - a in show a ++ " " ++ show b)

gao a = gao' 0 (length a) where
	b = 0: scanl1 (+) a
	s = last b
	gao' l r
		| l < r		= let m = (l + r) `div` 2 in if b!!m <= s - b!!(m+1) then gao' (m + 1) r else gao' l m
		| otherwise	= r

import Monad (liftM)

solve :: [Int] -> (Int, Int)
solve [x]  =  (1,0)
solve xs  =  solve' 0 0 xs (reverse xs)
  where
    n  =  length xs
    solve' a b (x:xs) (y:ys)
      | a + b >  n  =  error "a + b > n"
      | a + b == n  =  (a, b)
      | x >  y  =  solve' a (b+1) ((x-y):xs) ys
      | x <= y  =  solve' (a+1) b xs ((y-x):ys)

main :: IO ()
main  =  do
    getLine
    xs  <-  liftM (map read . words) getLine
    let (a, b)  =  solve xs
    putStrLn $ concat [show a, " ", show b]

import Data.List

main = do
  n <- readLn
  x <- getLine
  showSolve n x

showSolve :: Int -> String -> IO()
showSolve n x =
  let x1 = solve x
      x2 = n - x1
  in putStrLn ((show x1) ++ " " ++ (show x2))

solve :: String -> Int
solve x =
  let c = map read (words x)
      ct = mapAccumL (\x y -> (x+y, x+y)) 0 c
      avt = (fst ct) `div` 2
      ct2 = filter (<= avt) (snd ct)
      avt2 = if (null ct2) then 0 else (last ct2)
      p1 = length (ct2)
      p2 = if ((fst ct) - ((snd ct) !! p1)) >= avt2 then p1 + 1 else p1
  in p2

import Data.Sequence
import Prelude hiding (null)

type Chocos = Seq Int

data P = P Int Int

solve :: (P, P) -> Chocos -> (P, P)
solve p@(P anum aeating, P bnum beating) cs
    | null cs = p
    | aeating <= beating =
        let (aeating' :< cs') = viewl cs
        in solve (P (anum + 1) aeating', P bnum (beating - aeating)) cs'
    | aeating > beating =
        let (cs' :> beating') = viewr cs
        in solve (P anum (aeating - beating), P (bnum + 1) beating') cs'

main = do
    getLine -- n
    cs <- fmap (fromList . map read . words) getLine
    let (P anum _, P bnum _) = solve (P 0 0, P 0 0) cs
    putStrLn $ show anum ++ " " ++ show bnum

import Control.Applicative
import Control.Monad
import qualified Data.Sequence as Seq
import Text.Printf

type Time = Int
type Bars = Int
type State = (Seq.Seq Time, (Time, Bars), (Time, Bars))

eatThemAll' :: State -> State
eatThemAll' state@(s, alice@(t1, b1), bob@(t2, b2))
  | Seq.null s = state
  | t1 <= t2   = let t Seq.:< s' = Seq.viewl s in
                   eatThemAll' (s', (t1 + t, b1 + 1), bob)
  | otherwise  = let s' Seq.:> t = Seq.viewr s in
                   eatThemAll' (s', alice, (t2 + t, b2 + 1))

eatThemAll :: [Time] -> (Bars, Bars)
eatThemAll = do
  s <- Seq.fromList
  let (_, (_, b1), (_, b2)) = eatThemAll' (s, (0, 0), (0, 0))
  return (b1, b2)

solve :: [String] -> [String]
solve = fmap return $ do
  ts <- map read . words . head . drop 1
  let (b1, b2) = eatThemAll ts
  return $ printf "%d %d" b1 b2

main = interact $ unlines . solve . lines

import Data.List
main = do
    всегоПлиток <- readIO =<< getLine
    шоколадки <- (map read . words) `fmap` getLine
    let времяБоб = tail . reverse . scanl (+) 0 . reverse
        времяАлиса = scanl (+) 0
        съелаАлиса = length $ takeWhile (\(ал, б) -> ал <= б) $ zip (времяАлиса шоколадки)
                (времяБоб шоколадки)
    putStrLn $ unwords $ map show [съелаАлиса, всегоПлиток - съелаАлиса]

import Data.List
main = do
    всегоПлиток <- readIO =<< getLine
    шоколадки <- (map read . words) `fmap` getLine
    let времяБоб = tail . reverse . scanl (+) 0 . reverse
        времяАлиса = scanl (+) 0
        съелаАлиса = length $ takeWhile id $ zipWith (<=) (времяАлиса шоколадки)
                (времяБоб шоколадки)
    putStrLn $ unwords $ map show [съелаАлиса, всегоПлиток - съелаАлиса]

main = do
     dummy <- getLine
     a <- fmap (fmap read . words) getLine
     let b = scanl (+) 0 a
         alice = bsearch b 0 $ length a
         bob = length a - alice
     putStrLn $ show alice ++ " " ++ show bob
     where bsearch b l r
                   | l >= r = l
                   | otherwise = let m = (l+r) `div` 2
                                 in  if b!!m <= last b-b!!(m+1) then bsearch b (m+1) r else bsearch b l m

module Main where

import qualified Data.ByteString.Char8 as BS
import Data.Maybe (fromJust)
import Data.Functor ((<&>))

main :: IO ()
main =  BS.getContents <&> solve . ints >>= putStrLn

ints :: BS.ByteString -> [Int]
ints = map (fst . fromJust . BS.readInt) . BS.words

solve :: [Int] -> String
solve (n:xs) = show x <> " " <> show y
  where
    greedy a b (x, y)
      | null a || null b || x + y == n = (x, y)
      | head a <= head b = greedy (tail a) b (x + 1, y)
      | otherwise = greedy a (tail b) (x, y + 1)
    (x, y) = greedy (scanl1 (+) xs) (scanl1 (+) (reverse xs)) (0, 0)

{-# LANGUAGE TypeApplications #-}
module Main where

main :: IO ()
main = interact solve

solve :: String -> String
solve input = show x <> " " <> show y
  where
    n:xs = map (read @Int) $ words input
    greedy a b (x, y)
      | null a || null b || x + y == n = (x, y)
      | head a <= head b = greedy (tail a) b (x + 1, y)
      | otherwise = greedy a (tail b) (x, y + 1)
    (x, y) = greedy (scanl1 (+) xs) (scanl1 (+) (reverse xs)) (0, 0)

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

solve 0 0 (gotA, remA) (gotB, remB) tot
    | gotA + gotB <= tot - 2    = solve (head remA) (head remB) (gotA + 1, tail remA) (gotB + 1, tail remB) tot
    | gotA + gotB == tot - 1    = (gotA + 1, gotB)
    | otherwise                 = (gotA, gotB)

solve tA 0 (stateA@(gotA, remA)) (gotB, remB) tot
    | gotA + gotB <= tot - 1    = solve tA (head remB) stateA (gotB + 1, tail remB) tot
    | otherwise                 = (gotA, gotB)

solve 0 tB (gotA, remA) (stateB@(gotB, remB)) tot
    | gotA + gotB <= tot - 1    = solve (head remA) tB (gotA + 1, tail remA) stateB tot
    | otherwise                 = (gotA, gotB)

solve tA tB stateA stateB tot
    | tA > tB                   = solve (tA - tB) 0 stateA stateB tot
    | otherwise                 = solve 0 (tB - tA) stateA stateB tot

main =
  do all <- BS.getContents
     let Just (tot, r1) = readInt all
     let (ls, _)  = readMany readInt r1
     let (totA, totB) = solve 0 0 (0, ls) (0, reverse ls) tot
     putStrLn (show totA ++ " " ++ show totB)
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readMany readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import qualified Data.ByteString.Char8 as B
readInt' :: B.ByteString -> Int
readInt' s = case B.readInt s of Just (n, _) -> n
solve :: [Int] -> (Int, Int)
solve (n:xs) = go alice bob (0, 0)
    where alice = scanl1 (+) xs
          bob   = scanl1 (+) (reverse xs)
          go [] _ r = r
          go _ [] r = r
          go a@(x:xs) b@(y:ys) (p, q)
            | p + q == n = (p, q)
            | otherwise = case compare x y of
                GT -> go a ys (p, q + 1)
                _  -> go xs b (p + 1, q)
main = putStrLn . (\(x, y) -> show x ++ " " ++ show y) . solve . map readInt' . B.words =<< B.getContents

import Control.Applicative
import Text.Printf

main :: IO ()
main = do
    n <- read <$> getLine
    ps <- map read . words <$> getLine
    let (alice, chokudai) = calc n ps
    printf "%d %d\n" alice chokudai

calc :: Int -> [Int] -> (Int, Int)
calc n ps = (cnt, n - cnt)
    where
    total = sum ps
    half = ceiling $ fromIntegral total / 2
    cnt = cnt' ps 0 0
    cnt' (x:xs) time c
        | eatAliceTime < half     = cnt' xs eatAliceTime (c + 1)
        | time <= eatChokudaiTime = c + 1
        | otherwise               = c
        where
        eatAliceTime = x + time
        eatChokudaiTime = total - x - time

import Data.List

main = do
  n <- readLn
  x <- getLine
  showSolve n x

showSolve :: Int -> String -> IO()
showSolve n x =
  let x1 = solve x
      x2 = n - x1
  in putStrLn ((show x1) ++ " " ++ (show x2))

solve :: String -> Int
solve x =
  let c = map read (words x)
      ct = mapAccumL (\x y -> (x+y, x+y)) 0 c
      avt = (fst ct) `div` 2
      p1 = length (filter (<= avt) (snd ct))
      p2 = if ((fst ct) - ((snd ct) !! p1)) >= avt then p1 + 1 else p1
  in p2

import Data.List

main = do
  n <- readLn
  x <- getLine
  showSolve n x

showSolve :: Int -> String -> IO()
showSolve n x =
  let x1 = solve x
      x2 = n - x1
  in putStrLn ((show x1) ++ " " ++ (show x2))

solve :: String -> Int
solve x =
  let c = map read (words x)
      ct = mapAccumL (\x y -> (x+y, x+y)) 0 c
      avt = (fst ct) `div` 2
  in length (filter (<= avt) (snd ct))

import Data.List

main = do
  n <- readLn
  x <- getLine
  showSolve n x

showSolve :: Int -> String -> IO()
showSolve n x =
  let x1 = if (n > 1) then solve x else 1
      x2 = n - x1
  in putStrLn ((show x1) ++ " " ++ (show x2))

solve :: String -> Int
solve x =
  let c = map read (words x)
      ct = mapAccumL (\x y -> (x+y, x+y)) 0 c
      avt = (fst ct) `div` 2
  in length (filter (<= avt) (snd ct))

main = do
     dummy <- getLine
     a <- fmap (fmap read . words) getLine
     let b = scanl (+) 0 a
         alice = bsearch b 0 $ length a
         bob = length a - alice
     print $ show alice ++ " " ++ show bob
     where bsearch b l r
                   | l >= r = l
                   | otherwise = let m = (l+r) `div` 2
                                 in  if b!!m <= last b-b!!(m+1) then bsearch b (m+1) r else bsearch b l m

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

solve 0 0 (gotA, remA) (gotB, remB) tot
    | gotA + gotB <= tot - 2    = solve (head remA) (head remB) (gotA + 1, tail remA) (gotB + 1, tail remB) tot
    | gotA + gotB == tot - 1    = (gotA + 1, gotB)
    | otherwise                 = (gotA, gotB)

solve tA 0 (stateA@(gotA, remA)) (gotB, remB) tot
    | gotA + gotB <= tot - 1    = solve tA (head remB) stateA (gotB + 1, tail remB) tot
    | otherwise                 = (gotA, gotB)

solve 0 tB (gotA, remA) (stateB@(gotB, remB)) tot
    | gotA + gotB <= tot - 1    = solve (head remA) tB (gotA + 1, tail remA) stateB tot
    | otherwise                 = (gotA, gotB)

solve tA tB stateA stateB tot
    | tA > tB                   = solve (tA - tB) 0 stateA stateB tot
    | otherwise                 = solve 0 (tA - tB) stateA stateB tot

main =
  do all <- BS.getContents
     let Just (tot, r1) = readInt all
     let (ls, _)  = readMany readInt r1
     let (totA, totB) = solve 0 0 (0, ls) (0, reverse ls) tot
     putStrLn (show totA ++ " " ++ show totB)
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readMany readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

solve 0  0 (stateA@(eatenA, remA)) (stateB@(eatenB, remB)) tot
    | eatenA + 1 + eatenB + 1 < tot - 1 = solve (head remA) (head remB) (eatenA + 1, tail remA) (eatenB + 1, tail remB) tot
    | eatenA + 1 + eatenB + 1 < tot     = (eatenA + 2, eatenB + 1)
    | otherwise                         = (eatenA + 1, eatenB + 1)
solve tA 0  (stateA@(eatenA, remA)) (eatenB, remB) tot
    | eatenA + eatenB + 1 < tot = solve tA (head remB) stateA (eatenB + 1, tail remB) tot
    | otherwise                 = (eatenA, eatenB + 1)
solve 0  tB (eatenA, remA) (stateB@(eatenB, remB)) tot
    | eatenA + 1 + eatenB < tot = solve (head remA) tB (eatenA + 1, tail remA) stateB tot
    | otherwise                 = (eatenA + 1, eatenB)
solve tA tB stateA stateB tot
    | tA > tB = solve (tA - tB) 0 stateA stateB tot
    | tA < tB = solve 0 (tA - tB)  stateA stateB tot

main =
  do all <- BS.getContents
     let Just (tot, r1) = readInt all
     let (ls, _)  = readMany readInt r1
     let (totA, totB) = solve 0 0 (0, ls) (0, reverse ls) tot
     putStrLn (show totA ++ " " ++ show totB)
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readMany readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Control.Applicative
import Text.Printf

main :: IO ()
main = do
    n <- read <$> getLine
    ps <- map read . words <$> getLine
    let (alice, chokudai) = calc n ps
    printf "%d %d\n" alice chokudai

calc :: Int -> [Int] -> (Int, Int)
calc n ps = (cnt, n - cnt)
    where
    total = sum ps
    half = total `div` 2
    cnt = cnt' ps 0 0
    cnt' (x:xs) time c
        | eatAliceTime < half     = cnt' xs eatAliceTime (c + 1)
        | time <= eatChokudaiTime = c + 1
        | otherwise               = c
        where
        eatAliceTime = x + time
        eatChokudaiTime = total - x - time


There are some websites that are accessible through several different addresses. For example, for a long time Codeforces was accessible with two hostnames codeforces.com and codeforces.ru.You are given a list of page addresses being queried. For simplicity we consider all addresses to have the form http://<hostname>[/<path>], where:  <hostname> — server name (consists of words and maybe some dots separating them),  /<path> — optional part, where <path> consists of words separated by slashes. We consider two <hostname> to correspond to one website if for each query to the first <hostname> there will be exactly the same query to the second one and vice versa — for each query to the second <hostname> there will be the same query to the first one. Take a look at the samples for further clarifications.Your goal is to determine the groups of server names that correspond to one website. Ignore groups consisting of the only server name.Please note, that according to the above definition queries http://<hostname> and http://<hostname>/ are different.

The first line of the input contains a single integer n (1 ≤ n ≤ 100 000) — the number of page queries. Then follow n lines each containing exactly one address. Each address is of the form http://<hostname>[/<path>], where:   <hostname> consists of lowercase English letters and dots, there are no two consecutive dots, <hostname> doesn't start or finish with a dot. The length of <hostname> is positive and doesn't exceed 20.  <path> consists of lowercase English letters, dots and slashes. There are no two consecutive slashes, <path> doesn't start with a slash and its length doesn't exceed 20.  Addresses are not guaranteed to be distinct.

First print k — the number of groups of server names that correspond to one website. You should count only groups of size greater than one. Next k lines should contain the description of groups, one group per line. For each group print all server names separated by a single space. You are allowed to print both groups and names inside any group in arbitrary order.

10
http://abacaba.ru/test
http://abacaba.ru/
http://abacaba.com
http://abacaba.com/test
http://abacaba.de/
http://abacaba.ru/test
http://abacaba.de/test
http://abacaba.com/
http://abacaba.com/t
http://abacaba.com/test

14
http://c
http://ccc.bbbb/aba..b
http://cba.com
http://a.c/aba..b/a
http://abc/
http://a.c/
http://ccc.bbbb
http://ab.ac.bc.aa/
http://a.a.a/
http://ccc.bbbb/
http://cba.com/
http://cba.com/aba..b
http://a.a.a/aba..b/a
http://abc/aba..b/a

2
http://cba.com http://ccc.bbbb
http://a.a.a http://a.c http://abc

import Control.Monad
import Data.Char
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  Just (n, _) <- fmap C.readInt C.getLine
  s <- replicateM n $ fmap (C.takeWhile (not . isSpace)) $ C.getLine
  let m = Map.fromListWith Set.union
        [ (domain, Set.singleton path)
        | i <- s
        , let (domain, path) = C.break (=='/') $ C.drop (C.length http) i
        ]
      mm = Map.fromListWith Set.union
        [ ((hash, pathSet), Set.singleton domain)
        | (domain, pathSet) <- Map.toList m
        , let hash = foldl1' (\i j -> i * 97 + j)
                [ B.foldl' (\h b -> h * 29 + fromIntegral b) (7 :: Int) i
                | i <- Set.toList pathSet
                ]
        ]
      ans = [ C.unwords $ map (C.append http) i
            | i <- map Set.toList $ Map.elems mm
            , not $ null $ drop 1 i
            ]
  print $ length ans
  C.putStrLn $ C.unlines ans
  where
  http = C.pack "http://"

import Control.Monad
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  Just (n, _) <- fmap C.readInt C.getLine
  s <- replicateM n C.getLine
  let m = Map.fromListWith Set.union
        [ (domain, Set.singleton path)
        | i <- s
        , let (domain, path) = C.break (=='/') $ C.drop (C.length http) i
        , not $ C.null path
        ]
      mm = Map.fromListWith Set.union
        [ ((hash, pathSet), Set.singleton domain)
        | (domain, pathSet) <- Map.toList m
        , let hash = foldl1' (\i j -> i * 97 + j)
                [ B.foldl' (\h b -> h * 29 + fromIntegral b) (7 :: Int) i
                | i <- Set.toList pathSet
                ]
        ]
      ans = [ C.unwords $ map (C.append http) i
            | i <- map Set.toList $ Map.elems mm
            , not $ null $ drop 1 i
            ]
  print $ length ans
  C.putStrLn $ C.unlines ans
  where
  http = C.pack "http://"

import Control.Monad
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  Just (n, _) <- fmap C.readInt C.getLine
  s <- replicateM n C.getLine
  let m = Map.fromListWith Set.union
        [ (domain, Set.singleton path)
        | i <- s
        , let (domain, path) = C.break (=='/') $ C.drop (C.length http) i
        ]
      mm = Map.fromListWith Set.union
        [ ((hash, pathSet), Set.singleton domain)
        | (domain, pathSet) <- Map.toList m
        , pathSet /= Set.singleton C.empty
        , let hash = foldl1' (\i j -> i * 97 + j)
                [ B.foldl' (\h b -> h * 29 + fromIntegral b) (7 :: Int) i
                | i <- Set.toList pathSet
                ]
        ]
      ans = [ C.unwords $ map (C.append http) i
            | i <- map Set.toList $ Map.elems mm
            , not $ null $ drop 1 i
            ]
  print $ length ans
  C.putStrLn $ C.unlines ans
  where
  http = C.pack "http://"

import Control.Monad
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  Just (n, _) <- fmap C.readInt C.getLine
  s <- replicateM n C.getLine
  let m = Map.fromListWith Set.union
        [ (domain, Set.singleton path)
        | i <- s
        , let (domain, path) = C.break (=='/') $ C.drop (C.length http) i
        ]
      mm = Map.fromListWith Set.union
        [ ((hash, pathSet), Set.singleton domain)
        | (domain, pathSet) <- Map.toList m
        , let hash = foldl1' (\i j -> i * 97 + j)
                [ B.foldl' (\h b -> h * 29 + fromIntegral b) (7 :: Int) i
                | i <- Set.toList pathSet
                ]
        ]
      ans = [ C.unwords $ map (C.append http) i
            | i <- map Set.toList $ Map.elems mm
            , not $ null $ drop 1 i
            ]
  print $ length ans
  C.putStrLn $ C.unlines ans
  where
  http = C.pack "http://"

import Control.Monad
import Data.Char
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  Just (n, _) <- fmap C.readInt C.getLine
  s <- replicateM n C.getLine
  let m = Map.fromListWith Set.union
        [ (domain, Set.singleton path)
        | i <- s
        , let (domain, path) = C.break (=='/') $ C.drop (C.length http) i
        ]
      mm = Map.fromListWith Set.union
        [ ((hash, pathSet), Set.singleton domain)
        | (domain, pathSet) <- Map.toList m
        , not $ Set.foldr (\i j -> C.all isSpace i && j) True pathSet
        , let hash = foldl1' (\i j -> i * 97 + j)
                [ B.foldl' (\h b -> h * 29 + fromIntegral b) (7 :: Int) i
                | i <- Set.toList pathSet
                ]
        ]
      ans = [ C.unwords $ map (C.append http) i
            | i <- map Set.toList $ Map.elems mm
            , not $ null $ drop 1 i
            ]
  print $ length ans
  C.putStrLn $ C.unlines ans
  where
  http = C.pack "http://"


You are given an array $$$a$$$ of size $$$n$$$.You can perform the following operation on the array:   Choose two different integers $$$i, j$$$ $$$(1 \leq i < j \leq n$$$), replace $$$a_i$$$ with $$$x$$$ and $$$a_j$$$ with $$$y$$$. In order not to break the array, $$$a_i | a_j = x | y$$$ must be held, where $$$|$$$ denotes the bitwise OR operation. Notice that $$$x$$$ and $$$y$$$ are non-negative integers. Please output the minimum sum of the array you can get after using the operation above any number of times.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ $$$(1 \leq t \leq 1000)$$$. Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ $$$(2 \leq n \leq 100)$$$ — the size of array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots ,a_n$$$ $$$(0 \leq a_i < 2^{30})$$$.

For each test case, print one number in a line — the minimum possible sum of the array.

NoteIn the first example, you can perform the following operations to obtain the array $$$[1, 0, 2]$$$:1. choose $$$i = 1, j = 2$$$, change $$$a_1 = 1$$$ and $$$a_2 = 2$$$, it's valid since $$$1 | 3 = 1 | 2$$$. The array becomes $$$[1, 2, 2]$$$.2. choose $$$i = 2, j = 3$$$, change $$$a_2 = 0$$$ and $$$a_3 = 2$$$, it's valid since $$$2 | 2 = 0 | 2$$$. The array becomes $$$[1, 0, 2]$$$.We can prove that the minimum sum is $$$1 + 0 + 2 = 3$$$In the second example, We don't need any operations.

-- problem: https://codeforces.com/contest/1635/problem/A
-- origin: https://codeforces.com/contest/1635/submission/147037193

import Control.Monad.State (State, evalState, replicateM, state)
import Data.Bifunctor (first)
import Data.Bits (Bits ((.|.)))
import Data.Char (isDigit, isSpace)

getInt :: State [Char] Int
getInt = state (first (\x -> read x :: Int) . span isDigit . dropWhile isSpace)

mainFunc :: State [Char] [Char]
mainFunc = do
  t <- getInt
  fmap mconcat $
    replicateM t $ do
      n <- getInt
      a <- replicateM n getInt
      let ans = foldl (.|.) 0 a in pure $ show ans ++ "\n"

main :: IO ()
main = do
  inp <- getContents
  putStr $ evalState mainFunc inp

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

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

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

str = string7

solve :: SP Builder
solve = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    pure $ putInts [foldl (.|.) 0 a]

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

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

tst = P.span (> ' ') . dropSpace

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

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

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

import Control.Monad (forM_)
import Data.List (sort)
import Data.Bits ( Bits((.|.)) )

solve = foldr1 (.|.)

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        print $ solve $ reverse (sort arr)

import Data.Bits ((.|.))
import Data.List (foldl')

main :: IO ()
main = interact $ output . map solve . input

input :: String -> [[Integer]]
input = chunks . drop 1 . lines
  where
    chunks [] = []
    chunks (_:nums:ls) = let integers = map read $ words nums
                         in integers : chunks ls

output :: [Integer] -> String
output = unlines . map show

solve :: [Integer] -> Integer
solve = foldl' (.|.) 0

import Data.Bits

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

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

type InType  = [Int]
type OutType = Int

solve :: InType -> OutType
solve = foldr (.|.) 0

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "unknown input"

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

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

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

import Data.Bits

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    pure $ putInts [foldl' (.|.) 0 a]

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

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

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

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

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

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


Bessie and the cows are playing with sequences and need your help. They start with a sequence, initially containing just the number 0, and perform n operations. Each operation is one of the following:  Add the integer xi to the first ai elements of the sequence.  Append an integer ki to the end of the sequence. (And hence the size of the sequence increases by 1)  Remove the last element of the sequence. So, the size of the sequence decreases by one. Note, that this operation can only be done if there are at least two elements in the sequence. After each operation, the cows would like to know the average of all the numbers in the sequence. Help them!

The first line contains a single integer n (1 ≤ n ≤ 2·105) — the number of operations. The next n lines describe the operations. Each line will start with an integer ti (1 ≤ ti ≤ 3), denoting the type of the operation (see above). If ti = 1, it will be followed by two integers ai, xi (|xi| ≤ 103; 1 ≤ ai). If ti = 2, it will be followed by a single integer ki (|ki| ≤ 103). If ti = 3, it will not be followed by anything. It is guaranteed that all operations are correct (don't touch nonexistent elements) and that there will always be at least one element in the sequence.

Output n lines each containing the average of the numbers in the sequence after the corresponding operation. The answer will be considered correct if its absolute or relative error doesn't exceed 10 - 6.

NoteIn the second sample, the sequence becomes

{-# OPTIONS_GHC -O2 -funbox-strict-fields -cpp #-}
{-# LANGUAGE BangPatterns, OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Foreign.C.String

#if __GLASGOW_HASKELL__ < 706
import Data.IORef
#else
import Data.IORef hiding (modifyIORef')
#endif
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}

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

foreign import ccall unsafe "stdio.h printf"
  c_printf_double :: CString -> Double -> IO ()

printDouble :: Double -> IO ()
printDouble x = do
  withCString "%f\n" $ \fmt -> do
    c_printf_double fmt x

data Query = T1 !Int !Int64
           | T2 !Int64
           | T3

parse :: [Int] -> [Query]
parse (1:a:x:rest) = T1 a (fromIntegral x) : parse rest
parse (2:k:rest) = T2 (fromIntegral k) : parse rest
parse (3:rest) = T3 : parse rest
parse _ = []

main = do
  n <- readLn :: IO Int
  qs <- parse.map readInt.B.words <$> B.getContents
  segtree@(Node _ _ aref bref _ _) <- mkSegTree 0 n 0
  cntref <- newIORef 1 :: IO (IORef Int)
  let !len = fromIntegral $ n+1

  let step :: Query -> IO ()
      step (T1 a x) =  do
        updateRange 0 (a-1) x segtree
        cnt <- readIORef cntref
        a <- readIORef aref
        b <- readIORef bref
        printDouble $ fromIntegral (a*len+b) / fromIntegral cnt
      step (T2 k) = do
        cnt <- readIORef cntref
        updateKey cnt k segtree
        cnt <- readIORef cntref
        writeIORef cntref $! cnt+1
        a <- readIORef aref
        b <- readIORef bref
        printDouble $ fromIntegral (a*len+b) / fromIntegral (cnt+1)
      step T3 = do
        cnt <- readIORef cntref
        x <- queryKey (cnt-1) segtree
        updateKey (cnt-1) (fromIntegral$ -x) segtree
        writeIORef cntref $! cnt-1
        a <- readIORef aref
        b <- readIORef bref
        printDouble $ fromIntegral (a*len+b) / fromIntegral (cnt-1)
  mapM_ step qs

data SegTree = Node !Int !Int !(IORef Int64) !(IORef Int64) !SegTree !SegTree
             | Leaf !Int !(IORef Int64)

mkSegTree :: Int -> Int -> Int64 -> IO SegTree
mkSegTree !l !r !x0 = go l r
   where
     go !l !r
       | l<r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           aref <- newIORef x0
           bref <- newIORef x0
           return $! Node l r aref bref lt rt
       | otherwise = do
           !ref <- newIORef x0
           return $! Leaf l ref

updateRange :: Int -> Int -> Int64 -> SegTree -> IO ()
updateRange !kl !kr !x segtree = when (x/=0) $ go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (fromIntegral$min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)
{-# INLINE updateRange #-}

updateKey :: Int -> Int64 -> SegTree -> IO ()
updateKey !key !x segtree = when (x/=0) $ go segtree
   where
     go (Node l r _ bref lt rt) = do
         b <- readIORef bref
         writeIORef bref $! b + x
         if 2*key <= l+r then go lt else go rt
     go (Leaf _ ref) = modifyIORef' ref (x+)
{-# INLINE updateKey #-}

queryRange :: Int -> Int -> SegTree -> IO Int64
queryRange !kl !kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(fromIntegral$r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (fromIntegral$min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0
{-# INLINE queryRange #-}

queryKey :: Int -> SegTree -> IO Int64
queryKey !key segtree = go 0 segtree
   where
     go !acc (Node l r aref bref lt rt) = do
       a <- readIORef aref
       if 2*key <= l+r then go (acc+a) lt else go (acc+a) rt
     go !acc (Leaf _ ref) = do
       r <- readIORef ref
       return $! acc+r
{-# INLINE queryKey #-}

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

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Foreign.C.String

#if __GLASGOW_HASKELL__ < 706
import Data.IORef
#else
import Data.IORef hiding (modifyIORef')
#endif

modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}

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

foreign import ccall unsafe "stdio.h printf"
  c_printf_double :: CString -> Double -> IO ()

main = do
  n <- readLn
  qs <- map readInt.B.words <$> B.getContents
  segtree@(Node _ _ aref bref _ _) <- mkSegTree 0 n 0
  fmt <- newCString "%f\n"

  let !len = fromIntegral $ n+1

  let go !cnt (1:a:x:rest) =  do
        updateRange 0 (a-1) (fromIntegral x) segtree
        a <- readIORef aref
        b <- readIORef bref
        c_printf_double fmt $ fromIntegral (a*len+b) / fromIntegral cnt
        go cnt rest
      go !cnt (2:k:rest) = do
        updateKey cnt (fromIntegral k) segtree
        a <- readIORef aref
        b <- readIORef bref
        c_printf_double fmt  $ fromIntegral (a*len+b) / fromIntegral (cnt+1)
        go (cnt+1) rest
      go !cnt (3:rest) = do
        x <- queryKey (cnt-1) segtree
        updateKey (cnt-1) (fromIntegral $ -x) segtree
        a <- readIORef aref
        b <- readIORef bref
        c_printf_double fmt  $ fromIntegral (a*len+b) / fromIntegral (cnt-1)
        go (cnt-1) rest
      go _ _ = return ()
  go 1 qs

data SegTree = Node !Int !Int !(IORef Int64) !(IORef Int64) !SegTree !SegTree
             | Leaf !Int !(IORef Int64)

mkSegTree :: Int -> Int -> Int64 -> IO SegTree
mkSegTree !l !r !x0 = go l r
   where
     go !l !r
       | l<r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           aref <- newIORef x0
           bref <- newIORef x0
           return $! Node l r aref bref lt rt
       | otherwise = do
           !ref <- newIORef x0
           return $! Leaf l ref

updateRange :: Int -> Int -> Int64 -> SegTree -> IO ()
updateRange !kl !kr !x segtree = when (x/=0) $ go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (fromIntegral$min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)
{-# INLINE updateRange #-}

updateKey :: Int -> Int64 -> SegTree -> IO ()
updateKey !key !x segtree = when (x/=0) $ go segtree
   where
     go (Node l r _ bref lt rt) = do
         b <- readIORef bref
         writeIORef bref $! b + x
         if 2*key <= l+r then go lt else go rt
     go (Leaf _ ref) = modifyIORef' ref (x+)
{-# INLINE updateKey #-}

queryRange :: Int -> Int -> SegTree -> IO Int64
queryRange !kl !kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(fromIntegral$r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (fromIntegral$min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0
{-# INLINE queryRange #-}

queryKey :: Int -> SegTree -> IO Int64
queryKey !key segtree = go 0 segtree
   where
     go !acc (Node l r aref bref lt rt) = do
       a <- readIORef aref
       if 2*key <= l+r then go (acc+a) lt else go (acc+a) rt
     go !acc (Leaf _ ref) = do
       r <- readIORef ref
       return $! acc+r
{-# INLINE queryKey #-}

import Data.Bits
import Data.Maybe
import Control.Monad
import Text.Printf
import qualified Data.ByteString.Char8 as B
import Data.Int

data Tree = Node !Int64 !Int64 !Int !Tree !Tree
          | Leaf !Int64
          deriving (Show)

emptyTree :: Int -> Tree
emptyTree 0 = Leaf 0
emptyTree n = Node 0 0 (n-1) (emptyTree (n-1)) (emptyTree (n-1))

append :: Int -> Int64 -> Tree -> Tree
append n x tree = sub tree
    where
        sub (Node _ a d t1 t2)
            | testBit n d = Node (num t1 + num t2') a d t1  t2'
            | otherwise   = Node (num t1'+ num t2 ) a d t1' t2
            where
                t1' = sub t1
                t2' = sub t2
        sub (Leaf _) = Leaf x

num (Node x a d _ _) = x + a * 2^(d+1)
num (Leaf x)       = x

add :: Int -> Int64 -> Tree -> Tree
add n x tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') a d t1' t2'
            | otherwise   = Node (num t1'' + num t2) a d t1'' t2
            where
                t1' = update x t1
                t1''= sub t1
                t2' = sub t2
        sub (Leaf s) = update x (Leaf s)

update x (Node s a d t1 t2) = Node s (a+x) d t1 t2
update x (Leaf s) = Leaf (s+x)

remove :: Int -> Tree -> Tree
remove n tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') 0 d t1' t2'
            | otherwise   = Node (num t1'') 0 d t1'' t2
            where
                t1' = update a t1
                t2'  = sub (update a t2)
                t1'' = sub t1
        sub (Leaf x) = Leaf 0

main :: IO ()
main = do
    n <- B.getLine >>= return . fromMaybe 0 .fmap (fst). B.readInt
    foldM_ query (1,emptyTree 20) [1..n]

query :: (Int,Tree) -> Int -> IO (Int,Tree)
query (n,tree) _ = do
    l <- B.getLine >>= return . map (fromMaybe 0.fmap (fromIntegral. fst) . B.readInt) . B.words
    let (n',tree') = case l of
            [1,a,x] -> (n,add (a-1) (fromIntegral x) tree)
            [2,x]   -> (n+1,append n (fromIntegral x) tree)
            [3]     -> (n-1,remove (n-1) tree)
    B.putStrLn $ B.pack  $ showDouble ((fromIntegral (num tree') / fromIntegral n'):: Double)
    return (n',tree')

showDouble :: Double -> String
showDouble f | f < 0 = "-"++showDouble (-f)
             | otherwise = printf "%d.%07d" frac small
    where
        frac = floor f :: Int64
        small = round ((f - fromIntegral frac)* 10000000) :: Int64

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

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Text.Printf

#if __GLASGOW_HASKELL__ < 706
import Data.IORef
#else
import Data.IORef hiding (modifyIORef')
#endif
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}

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

data Query = T1 !Int !Int64
           | T2 !Int64
           | T3

parse :: [Int] -> [Query]
parse (1:a:x:rest) = T1 a (fromIntegral x) : parse rest
parse (2:k:rest) = T2 (fromIntegral k) : parse rest
parse (3:rest) = T3 : parse rest
parse _ = []

main = do
  n <- readLn :: IO Int
  qs <- parse.map readInt.B.words <$> B.getContents
  segtree <- mkSegTree 0 n 0
  cntref <- newIORef 1 :: IO (IORef Int)

  let step :: Query -> IO Double
      step (T1 a x) =  do
        updateRange 0 (a-1) x segtree
        s <- getRoot segtree
        cnt <- readIORef cntref
        return $! fromIntegral s / fromIntegral cnt
      step (T2 k) = do
        cnt <- readIORef cntref
        updateKey cnt k segtree
        s <- getRoot segtree
        cnt <- readIORef cntref
        writeIORef cntref $! cnt+1
        return $! fromIntegral s / fromIntegral (cnt+1)
      step T3 = do
        cnt <- readIORef cntref
        x <- queryKey (cnt-1) segtree
        updateKey (cnt-1) (fromIntegral$ -x) segtree
        s <- getRoot segtree
        writeIORef cntref $! cnt-1
        return $! fromIntegral s / fromIntegral (cnt-1)
  putStr.unlines.map show <$> mapM step qs

data SegTree = Node !Int !Int !(IORef Int64) !(IORef Int64) !SegTree !SegTree
             | Leaf !Int !(IORef Int64)

mkSegTree :: Int -> Int -> Int64 -> IO SegTree
mkSegTree !l !r !x0 = go l r
   where
     go !l !r
       | l<r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           aref <- newIORef x0
           bref <- newIORef x0
           return $! Node l r aref bref lt rt
       | otherwise = do
           !ref <- newIORef x0
           return $! Leaf l ref

updateRange :: Int -> Int -> Int64 -> SegTree -> IO ()
updateRange !kl !kr !x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (fromIntegral$min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)
{-# INLINE updateRange #-}

updateKey :: Int -> Int64 -> SegTree -> IO ()
updateKey !key !x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<key || key<l) $ do
         b <- readIORef bref
         writeIORef bref $! b + x
         go lt >> go rt
     go (Leaf k ref) = do
       when (k==key) $ do
          modifyIORef' ref (x+)
{-# INLINE updateKey #-}

queryRange :: Int -> Int -> SegTree -> IO Int64
queryRange !kl !kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(fromIntegral$r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (fromIntegral$min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0
{-# INLINE queryRange #-}

queryKey :: Int -> SegTree -> IO Int64
queryKey !key segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | 2*key <= l+r = (+) <$> go lt <*> readIORef aref
       | otherwise = (+) <$> go rt <*> readIORef aref
     go (Leaf k ref) = readIORef ref
{-# INLINE queryKey #-}

getRoot :: SegTree -> IO Int64
getRoot (Node l r aref bref _ _) = do
  a <- readIORef aref
  b <- readIORef bref
  return $! a*(fromIntegral$r-l+1)+b
{-# INLINE getRoot #-}

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

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Text.Printf

#if __GLASGOW_HASKELL__ < 706
import Data.IORef
#else
import Data.IORef hiding (modifyIORef')
#endif
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}

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

data Query = T1 !Int !Int64
           | T2 !Int64
           | T3

parse :: [Int] -> [Query]
parse (1:a:x:rest) = T1 a (fromIntegral x) : parse rest
parse (2:k:rest) = T2 (fromIntegral k) : parse rest
parse (3:rest) = T3 : parse rest
parse _ = []

main = do
  n <- readLn :: IO Int
  qs <- parse.map readInt.B.words <$> B.getContents
  segtree <- mkSegTree 0 n 0
  cntref <- newIORef 0 :: IO (IORef Int)

  let step (T1 a x) =  do
        updateRange 0 (a-1) x segtree
        s <- getRoot segtree
        cnt <- readIORef cntref
        return $! fromIntegral s / fromIntegral cnt
      step (T2 k) = do
        cnt <- readIORef cntref
        updateKey cnt k segtree
        s <- getRoot segtree
        cnt <- readIORef cntref
        writeIORef cntref $! cnt+1
        return $! fromIntegral s / fromIntegral (cnt+1)
      step T3 = do
        cnt <- readIORef cntref
        x <- queryKey (cnt-1) segtree
        updateKey (cnt-1) (fromIntegral$ -x) segtree
        s <- getRoot segtree
        writeIORef cntref $! cnt-1
        return $! fromIntegral s / fromIntegral (cnt-1)

  putStr.unlines.map show <$> mapM step qs

data SegTree = Node !Int !Int !(IORef Int64) !(IORef Int64) !SegTree !SegTree
             | Leaf !Int !(IORef Int64)

mkSegTree :: Int -> Int -> Int64 -> IO SegTree
mkSegTree !l !r !x0 = go l r
   where
     go !l !r
       | l<r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           aref <- newIORef x0
           bref <- newIORef x0
           return $! Node l r aref bref lt rt
       | otherwise = do
           !ref <- newIORef x0
           return $! Leaf l ref

updateRange :: Int -> Int -> Int64 -> SegTree -> IO ()
updateRange !kl !kr !x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (fromIntegral$min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)
{-# INLINE updateRange #-}

updateKey :: Int -> Int64 -> SegTree -> IO ()
updateKey !key !x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<key || key<l) $ do
         b <- readIORef bref
         writeIORef bref $! b + x
         go lt >> go rt
     go (Leaf k ref) = do
       when (k==key) $ do
          modifyIORef' ref (x+)
{-# INLINE updateKey #-}

queryRange :: Int -> Int -> SegTree -> IO Int64
queryRange !kl !kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(fromIntegral$r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (fromIntegral$min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0
{-# INLINE queryRange #-}

queryKey :: Int -> SegTree -> IO Int64
queryKey !key segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | 2*key <= l+r = (+) <$> go lt <*> readIORef aref
       | otherwise = (+) <$> go rt <*> readIORef aref
     go (Leaf k ref) = readIORef ref
{-# INLINE queryKey #-}

getRoot :: SegTree -> IO Int64
getRoot (Node l r aref bref _ _) = do
  a <- readIORef aref
  b <- readIORef bref
  return $! a*(fromIntegral$r-l+1)+b
{-# INLINE getRoot #-}

import Data.Bits
import Data.Maybe
import Control.Monad
import Text.Printf
import qualified Data.ByteString.Char8 as B

data Tree = Node !Int !Int !Int !Tree !Tree
          | Leaf !Int
          deriving (Show)

emptyTree :: Int -> Tree
emptyTree 0 = Leaf 0
emptyTree n = Node 0 0 (n-1) (emptyTree (n-1)) (emptyTree (n-1))

append :: Int -> Int -> Tree -> Tree
append n x tree = sub tree
    where
        sub (Node _ a d t1 t2)
            | testBit n d = Node (num t1 + num t2') a d t1  t2'
            | otherwise   = Node (num t1'+ num t2 ) a d t1' t2
            where
                t1' = sub t1
                t2' = sub t2
        sub (Leaf _) = Leaf x

num (Node x a d _ _) = x + a * 2^(d+1)
num (Leaf x)       = x

add :: Int -> Int -> Tree -> Tree
add n x tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') a d t1' t2'
            | otherwise   = Node (num t1'' + num t2) a d t1'' t2
            where
                t1' = update x t1
                t1''= sub t1
                t2' = sub t2
        sub (Leaf s) = update x (Leaf s)

update x (Node s a d t1 t2) = Node s (a+x) d t1 t2
update x (Leaf s) = Leaf (s+x)

remove :: Int -> Tree -> Tree
remove n tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') 0 d t1' t2'
            | otherwise   = Node (num t1'') 0 d t1'' t2
            where
                t1' = update a t1
                t2'  = sub (update a t2)
                t1'' = sub t1
        sub (Leaf x) = Leaf 0

main :: IO ()
main = do
    n <- B.getLine >>= return . fromMaybe 0 .fmap fst. B.readInt
    (n,tree) <- foldM query (1,emptyTree 20) [1..n]
    return ()

query :: (Int,Tree) -> Int -> IO (Int,Tree)
query (n,tree) _ = do
    l <- B.getLine >>= return . map (fromMaybe 0.fmap fst . B.readInt) . B.words
    let (n',tree') = case l of
            [1,a,x] -> (n,add (a-1) x tree)
            [2,x]   -> (n+1,append n x tree)
            [3]     -> (n-1,remove (n-1) tree)
    B.putStrLn $ B.pack  $ showDouble ((fromIntegral (num tree') / fromIntegral n'):: Double)
    return (n',tree')

showDouble :: Double -> String
showDouble f | f < 0 = "-"++showDouble (-f)
             | otherwise = printf "%d.%07d" frac small
    where
        frac = floor f :: Int
        small = round ((f - fromIntegral frac)* 10000000) :: Int

import Data.Bits
import Data.Maybe
import Control.Monad
import Text.Printf
import qualified Data.ByteString.Char8 as B

data Tree = Node !Int !Int !Int !Tree !Tree
          | Leaf !Int
          deriving (Show)

emptyTree :: Int -> Tree
emptyTree 0 = Leaf 0
emptyTree n = Node 0 0 (n-1) (emptyTree (n-1)) (emptyTree (n-1))

append :: Int -> Int -> Tree -> Tree
append n x tree = sub tree
    where
        sub (Node _ a d t1 t2)
            | testBit n d = Node (num t1 + num t2') a d t1  t2'
            | otherwise   = Node (num t1'+ num t2 ) a d t1' t2
            where
                t1' = sub t1
                t2' = sub t2
        sub (Leaf _) = Leaf x

num (Node x a d _ _) = x + a * 2^(d+1)
num (Leaf x)       = x

add :: Int -> Int -> Tree -> Tree
add n x tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') a d t1' t2'
            | otherwise   = Node (num t1'' + num t2) a d t1'' t2
            where
                t1' = update x t1
                t1''= sub t1
                t2' = sub t2
        sub (Leaf s) = update x (Leaf s)

update x (Node s a d t1 t2) = Node s (a+x) d t1 t2
update x (Leaf s) = Leaf (s+x)

remove :: Int -> Tree -> Tree
remove n tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') 0 d t1' t2'
            | otherwise   = Node (num t1'') 0 d t1'' t2
            where
                t1' = update a t1
                t2'  = sub (update a t2)
                t1'' = sub t1
        sub (Leaf x) = Leaf 0

main :: IO ()
main = do
    n <- B.getLine >>= return . fromMaybe 0 .fmap fst. B.readInt
    (n,tree) <- foldM query (1,emptyTree 18) [1..n]
    return ()

query :: (Int,Tree) -> Int -> IO (Int,Tree)
query (n,tree) _ = do
    l <- B.getLine >>= return . map (fromMaybe 0.fmap fst . B.readInt) . B.words
    let (n',tree') = case l of
            [1,a,x] -> (n,add (a-1) x tree)
            [2,x]   -> (n+1,append n x tree)
            [3]     -> (n-1,remove (n-1) tree)
    B.putStrLn $ B.pack  $ showDouble ((fromIntegral (num tree') / fromIntegral n'):: Double)
    return (n',tree')

showDouble :: Double -> String
showDouble f | f < 0 = "-"++showDouble (-f)
             | otherwise = printf "%d.%07d" frac small
    where
        frac = floor f :: Int
        small = round ((f - fromIntegral frac)* 10000000) :: Int


The only difference with E2 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. Vlad is a bit afraid of their ardor. Determine if he can guarantee victory (i.e. can he win in any way friends play).In other words, determine if there is such a sequence of Vlad's moves that lets Vlad win in any way friends play.

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 "YES" if Vlad can guarantee himself a victory and "NO" otherwise. You may print every letter in any case you want (so, for example, the strings "yEs", "yes", "Yes" and "YES" will all be recognized as positive answers).

NoteIn the first test case, regardless of the strategy of his friends, Vlad can win by going to room $$$4$$$. The game may look like this:  The original locations of Vlad and friends. Vlad is marked in green, friends — in red.   Locations after one unit of time.   End of the game. Note that if Vlad tries to reach the exit at the room $$$8$$$, then a friend from the $$$3$$$ room will be able to catch him.

{-# 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
  _ <- String.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 (1,n) $ edges
      dp = calcDP friends (1,n) 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