Fishing Prince loves trees, and he especially loves trees with only one centroid. The tree is a connected graph without cycles.A vertex is a centroid of a tree only when you cut this vertex (remove it and remove all edges from this vertex), the size of the largest connected component of the remaining graph is the smallest possible.For example, the centroid of the following tree is $$$2$$$, because when you cut it, the size of the largest connected component of the remaining graph is $$$2$$$ and it can't be smaller.  However, in some trees, there might be more than one centroid, for example:  Both vertex $$$1$$$ and vertex $$$2$$$ are centroids because the size of the largest connected component is $$$3$$$ after cutting each of them.Now Fishing Prince has a tree. He should cut one edge of the tree (it means to remove the edge). After that, he should add one edge. The resulting graph after these two operations should be a tree. He can add the edge that he cut.He wants the centroid of the resulting tree to be unique. Help him and find any possible way to make the operations. It can be proved, that at least one such way always exists.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1\leq t\leq 10^4$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$3\leq n\leq 10^5$$$) — the number of vertices. Each of the next $$$n-1$$$ lines contains two integers $$$x, y$$$ ($$$1\leq x,y\leq n$$$). It means, that there exists an edge connecting vertices $$$x$$$ and $$$y$$$. It's guaranteed that the given graph is a tree. It's guaranteed that the sum of $$$n$$$ for all test cases does not exceed $$$10^5$$$.

For each test case, print two lines. In the first line print two integers $$$x_1, y_1$$$ ($$$1 \leq x_1, y_1 \leq n$$$), which means you cut the edge between vertices $$$x_1$$$ and $$$y_1$$$. There should exist edge connecting vertices $$$x_1$$$ and $$$y_1$$$. In the second line print two integers $$$x_2, y_2$$$ ($$$1 \leq x_2, y_2 \leq n$$$), which means you add the edge between vertices $$$x_2$$$ and $$$y_2$$$. The graph after these two operations should be a tree. If there are multiple solutions you can print any.

NoteNote that you can add the same edge that you cut.In the first test case, after cutting and adding the same edge, the vertex $$$2$$$ is still the only centroid.In the second test case, the vertex $$$2$$$ becomes the only centroid after cutting the edge between vertices $$$1$$$ and $$$3$$$ and adding the edge between vertices $$$2$$$ and $$$3$$$.

{-# LANGUAGE OverloadedStrings, FlexibleContexts, RankNTypes #-}
import Control.Monad
import Control.Applicative
import Control.Monad.ST
import Data.Int
import Data.Maybe
import Data.List
import Data.Functor
import Data.Ix
import Data.Bool
import Data.Array.Unboxed as UA
import Data.Array.IArray as IA
import Data.Array.IO.Safe as IOA
import Data.Array.ST.Safe as SA
import Data.Array.MArray.Safe as MA
import Data.Array as A
import qualified Data.ByteString.Char8 as B8
import Text.Printf

-- import Debug.Trace
-- debug = flip trace

readIntB8 :: B8.ByteString -> Int
readIntB8 = fst . fromJust . B8.readInt

readInt64B8 :: B8.ByteString -> Int64
readInt64B8 = fromIntegral . fst . fromJust . B8.readInteger

modifyArray :: (MA.MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray array i func = do
    e <- MA.readArray array i
    MA.writeArray array i $ func e

type Vertex = Int
type Vertices = [Vertex]
data Graph = Graph {
    getN :: Int,
    getAdjacents :: A.Array Int Vertices }

findSizes :: forall s. Int -> Graph -> A.Array Int Int
findSizes v graph = SA.runSTArray $ do
    let n = getN graph
    let adjacents = getAdjacents graph

    weights <- SA.newArray (1, n) 0 :: ST s (STArray s Int Int)
    let dfsWeights weights v parent = do
        childWeights <- forM (adjacents UA.! v) $ \u -> do
            if (u /= parent)
                then dfsWeights weights u v
                else return 0

        let weight = 1 + (sum childWeights)
        SA.writeArray weights v weight
        return $ weight
    dfsWeights weights v (-1)

    sizes <- SA.newArray (1, n) 0
    let dfsSizes sizes v parent upSize = do
        vWeight <- SA.readArray weights v
        childSizes <- forM (adjacents IA.! v) $ \u -> do
            uWeight <- SA.readArray weights u
            if (u /= parent)
                then do
                    dfsSizes sizes u v (upSize + vWeight - uWeight)
                    return uWeight
                else return 0
        let vSize = (foldr1 max $ upSize : childSizes) -- `debug` ("v = " ++ (show v) ++ ", sizes = " ++ (show $ upSize : childSizes))
        SA.writeArray sizes v vSize
        return vSize
    dfsSizes sizes v (-1) 0
    return sizes

findLeafEdge :: Int -> Int -> Graph -> (Int, Int)
findLeafEdge v parent graph = edge
    where
        n = getN graph
        adjacents = getAdjacents graph
        dfs v parent
            | (length $ adjacents IA.! v) /= 1 =
                let childEdges = (flip map) (adjacents IA.! v) $ \u ->
                        if u /= parent
                            then dfs u v
                            else Nothing
                    childEdge = msum childEdges
                in childEdge
            | otherwise = Just (v, parent)
        edge = fromJust $ dfs v parent

readGraph :: IO Graph
readGraph = do
    n <- B8.getLine <&> readIntB8
    adjacents <- MA.newArray (1, n) [] :: IO (IOA.IOArray Int Vertices)
    forM_ [2..n] $ \_ -> do
        [a, b] <- B8.getLine <&> B8.words <&> map readIntB8
        modifyArray adjacents a ((:) b)
        modifyArray adjacents b ((:) a)
    adjacentsA <- MA.freeze adjacents
    return $ Graph n adjacentsA

solve :: Graph -> ((Int, Int), (Int, Int))
solve graph = answer
--        `debug` ("sizes = " ++ show sizes)
    where
        n = getN graph
        sizes = findSizes 1 graph
        minSize = foldr1 min sizes
        centroids = map fst . filter (\(i, e) -> e == minSize) $ UA.assocs sizes

        defaultEdge = (1, head $ (getAdjacents graph) IA.! 1)
        leafEdge = findLeafEdge (centroids !! 0) (centroids !! 1) graph
        answer
            | (length centroids) == 1 = (defaultEdge, defaultEdge)
            | otherwise = (leafEdge, (centroids !! 1, fst leafEdge))

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        graph <- readGraph
        let ((a, b), (c, d)) = solve graph
        printf "%d %d\n" a b
        printf "%d %d\n" c d

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

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

main :: IO ()
main = do
  [caseNum] <- getInts
  forM_ [1..caseNum] $ \_ -> do
    [n] <- getInts
    edges <- map (\[x, y] -> (x, y)) <$> replicateM (n - 1) getInts
    let es = listArray (1, n) $ map (map snd) $
                groupBy (\(a, _) (b, _) -> a == b) $ sortBy (\(a, _) (b, _) -> compare a b) $
                concat $ map (\(x, y) -> [(x, y), (y, x)]) edges
        dfs par u = let ps = map (dfs u) $ filter (/= par) $ es ! u
                        rr = join $ find isJust $ map (\(r, _, _) -> r) ps
                        result = if isJust rr
                                   then rr
                                   else find (\(_, _, sz) -> 2 * sz == n) ps >>= (\(_, v, _) -> Just (u, v))
                    in (result, u, sum (1 : map (\(_, _, sz) -> sz) ps))
        ans = let (result, _, _) = dfs 1 1
              in case result of
                Nothing -> [edges !! 0, edges !! 0]
                Just (u, v) -> let w = fromJust $ find (/= v) (es ! u) in [(u, w), (v, w)]
    forM_ ans (\(x, y) -> printf "%d %d\n" x y)


This week Arkady wanted to cook some pancakes (to follow ancient traditions) and make a problem about that. But then he remembered that one can't make a problem about stacking pancakes without working at a specific IT company, so he decided to bake the Napoleon cake instead.To bake a Napoleon cake, one has to bake $$$n$$$ dry layers first, and then put them on each other in one stack, adding some cream. Arkady started with an empty plate, and performed the following steps $$$n$$$ times:   place a new cake layer on the top of the stack;  after the $$$i$$$-th layer is placed, pour $$$a_i$$$ units of cream on top of the stack. When $$$x$$$ units of cream are poured on the top of the stack, top $$$x$$$ layers of the cake get drenched in the cream. If there are less than $$$x$$$ layers, all layers get drenched and the rest of the cream is wasted. If $$$x = 0$$$, no layer gets drenched.  The picture represents the first test case of the example. Help Arkady determine which layers of the cake eventually get drenched when the process is over, and which don't.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 20\,000$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of layers in the cake. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le n$$$) — the amount of cream poured on the cake after adding each layer. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print a single line with $$$n$$$ integers. The $$$i$$$-th of the integers should be equal to $$$1$$$ if the $$$i$$$-th layer from the bottom gets drenched, and $$$0$$$ otherwise.

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

readInts = fmap (map read.words) getLine :: IO [Integer]

printArray [] = ""
printArray (x:xs) = show(x) ++" " ++ printArray xs

solve [] cnt r = r
solve (x:xs) cnt r = if (x>0) then solve xs (max (cnt-1) (x-1)) (1:r)
    else do
        if (cnt > 0) then solve xs (cnt-1) (1:r)
        else (solve xs cnt (0:r) )

printS = do
    n<-readLn :: IO Int
    a<-readInts
    let b = reverse a
    putStrLn $ printArray $ solve b 0 []

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

f :: Int -> IO()
f 0 = return ()
f n = do {
    x <- getLine;
    l <- getLine;
    putStrLn (concatMap ( (  ++ [' ']).show ) ( sol (read x) (map read (words l)) ));
    f (n-1)
}

sol2 :: Int -> [Int] -> [Int] -> [Int]
sol2 _ li [] = li
sol2 n li (x:xs)
    | n > x = sol2 (n-1) (1:li) xs
    | x > 0 = sol2 (x-1) (1:li) xs
    | otherwise = sol2 0 (0:li) xs

sol :: Int -> [Int] -> [Int]
sol n li = sol2 0 [] (reverse li)

main = do {
    x <- getLine;
    f (read x)
}


This is the hard version of the problem. The only difference is that in this version $$$q = n$$$.You are given an array of integers $$$a_1, a_2, \ldots, a_n$$$.The cost of a subsegment of the array $$$[l, r]$$$, $$$1 \leq l \leq r \leq n$$$, is the value $$$f(l, r) = \operatorname{sum}(l, r) - \operatorname{xor}(l, r)$$$, where $$$\operatorname{sum}(l, r) = a_l + a_{l+1} + \ldots + a_r$$$, and $$$\operatorname{xor}(l, r) = a_l \oplus a_{l+1} \oplus \ldots \oplus a_r$$$ ($$$\oplus$$$ stands for bitwise XOR).You will have $$$q$$$ queries. Each query is given by a pair of numbers $$$L_i$$$, $$$R_i$$$, where $$$1 \leq L_i \leq R_i \leq n$$$. You need to find the subsegment $$$[l, r]$$$, $$$L_i \leq l \leq r \leq R_i$$$, with maximum value $$$f(l, r)$$$. If there are several answers, then among them you need to find a subsegment with the minimum length, that is, the minimum value of $$$r - l + 1$$$.

Each test consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$q$$$ ($$$1 \leq n \leq 10^5$$$, $$$q = n$$$) — the length of the array and the number of queries. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \leq a_i \leq 10^9$$$) — array elements. $$$i$$$-th of the next $$$q$$$ lines of each test case contains two integers $$$L_i$$$ and $$$R_i$$$ ($$$1 \leq L_i \leq R_i \leq n$$$) — the boundaries in which we need to find the segment. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$. It is guaranteed that $$$L_1 = 1$$$ and $$$R_1 = n$$$.

For each test case print $$$q$$$ pairs of numbers $$$L_i \leq l \leq r \leq R_i$$$ such that the value $$$f(l, r)$$$ is maximum and among such the length $$$r - l + 1$$$ is minimum. If there are several correct answers, print any of them.

NoteIn all test cases, the first query is considered.In the first test case, $$$f(1, 1) = 0 - 0 = 0$$$.In the second test case, $$$f(1, 1) = 5 - 5 = 0$$$, $$$f(2, 2) = 10 - 10 = 0$$$. Note that $$$f(1, 2) = (10 + 5) - (10 \oplus 5) = 0$$$, but we need to find a subsegment with the minimum length among the maximum values of $$$f(l, r)$$$. So, only segments $$$[1, 1]$$$ and $$$[2, 2]$$$ are the correct answers.In the fourth test case, $$$f(2, 3) = (12 + 8) - (12 \oplus 8) = 16$$$. There are two correct answers in the fifth test case, since $$$f(2, 3) = f(3, 4)$$$ and their lengths are equal.

{-# LANGUAGE CPP #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif
-- {-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

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

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

-- use int here to confuse checker )
type SolutionState = (Int, UA.Array Int Int, UA.UArray Int Int, UA.UArray Int Int, UA.UArray Int Int)

preSolve :: Int -> [Int] -> SolutionState
preSolve n as = (n, arrAs, prefixSumAs, prefixXorAs, nextNonZeroIndices)
    where
        arrAs = UA.listArray (1, n) $ L.map fromIntegral as
        prefixSumAs = tracing "prefixSumAs" $ UA.listArray (0, n) . L.map fromIntegral . L.scanl (+) 0 $ as
        prefixXorAs = tracing "prefixXorAs" $ UA.listArray (0, n) . L.map fromIntegral . L.scanl xor 0 $ as
        nextNonZeroIndices = tracing "nextNonZeroIndices" $ UA.listArray (1, n + 1) . L.scanr (\(i, e) c -> if e == 0 then c else i) (n + 1) $ L.zip [1..] as

leftestBinarySearch :: (Int, Int) -> (Int -> Bool) -> Int
leftestBinarySearch (l, r) f = binarySearch' (l, r)
    where
        binarySearch' (l, r) | l == r = l
        binarySearch' (l, r) = if f c
                then binarySearch' (l, c)
                else binarySearch' (c + 1, r)
            where
                c = (l + r) `div` 2

solve :: (Int, Int) -> S.State SolutionState (Int, Int)
solve (l, r) = do
    (_, as, prefixSumAs, prefixXorAs, nextNonZeroIndices) <- S.get
    let rIndices = trace ("as = " ++ show as) $ tracing "rIndices" $ [l .. r]
        rangeSum l r = tracing "rangeSum" $ trace ("l = " ++ show l ++ ", r = " ++ show r) $ (prefixSumAs UA.! r) - (prefixSumAs UA.! (l - 1))
        rangeXor l r = tracing "rangeSum" $ trace ("l = " ++ show l ++ ", r = " ++ show r) $ (prefixXorAs UA.! r) `xor` (prefixXorAs UA.! (l - 1))
        rangeF l r = tracing "rangeF" $ trace ("l = " ++ show l ++ ", r = " ++ show r) $ rangeSum l r - rangeXor l r

        isRangeGood :: (Int, Int) -> (Int, Int) -> Bool
        isRangeGood (l', r') (l, r) = rangeF l' r' == rangeF l r

        findBestR' :: Int -> Int
        findBestR' l' = leftestBinarySearch (l', r) $ (\r' -> isRangeGood (l', r) (l', r'))

        nonZeroLs = tracing "nonZeroLs" $ L.take 32 . L.takeWhile (<= r) . iterate ((nextNonZeroIndices UA.!) . succ) $ l

        rankedRanges :: [(Int, (Int, Int))] = tracing "rankedRanges" $ L.map (\(l', r') -> (rangeF l' r', (l', r'))) . L.map (\l' -> (l', findBestR' l')) $ nonZeroLs
        answer :: (Int, Int) = snd . L.minimumBy (compare `on` (\(f, (l, r)) -> (f, (r - l + 1), l))) . L.filter (\(f', _) -> f' == rangeF l r) $ rankedRanges

    return $ answer

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, q] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        let state = preSolve n as
        replicateM_ q $ do
            [l, r] <- B8.getLine <&> readIntB8s
            let (answerL, answerR) = S.evalState (solve (l, r)) state
            printf "%d %d\n" answerL answerR

{-# LANGUAGE CPP #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

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

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

type SolutionState = (Int, UA.Array Int Int64, UA.UArray Int Int64, UA.UArray Int Int64)

preSolve :: Int -> [Int] -> SolutionState
preSolve n as = (n, arrAs, prefixSumAs, prefixXorAs)
    where
        arrAs = UA.listArray (1, n) $ L.map fromIntegral as
        prefixSumAs = tracing "prefixSumAs" $ UA.listArray (0, n) . L.map fromIntegral . L.scanl (+) 0 $ as
        prefixXorAs = tracing "prefixXorAs" $ UA.listArray (0, n) . L.map fromIntegral . L.scanl xor 0 $ as

leftestBinarySearch :: (Int, Int) -> (Int -> Bool) -> Int
leftestBinarySearch (l, r) f = binarySearch' (l, r)
    where
        binarySearch' (l, r) | l == r = l
        binarySearch' (l, r) = if f c
                then binarySearch' (l, c)
                else binarySearch' (c + 1, r)
            where
                c = (l + r) `div` 2

rightestBinarySearch :: (Int, Int) -> (Int -> Bool) -> Int
rightestBinarySearch (l, r) f = binarySearch' (l, r)
    where
        binarySearch' (l, r) | l == r = l
        binarySearch' (l, r) = if f c
                then binarySearch' (c, r)
                else binarySearch' (l, c - 1)
            where
                c = (l + r + 1) `div` 2

solve :: (Int, Int) -> S.State SolutionState (Int, Int)
solve (l, r) = do
    (_, as, prefixSumAs, prefixXorAs) <- S.get
    let rIndices = trace ("as = " ++ show as) $ tracing "rIndices" $ [l .. r]
        rangeSum l r = tracing "rangeSum" $ trace ("l = " ++ show l ++ ", r = " ++ show r) $ (prefixSumAs UA.! r) - (prefixSumAs UA.! (l - 1))
        rangeXor l r = tracing "rangeSum" $ trace ("l = " ++ show l ++ ", r = " ++ show r) $ (prefixXorAs UA.! r) `xor` (prefixXorAs UA.! (l - 1))
        rangeF l r = tracing "rangeF" $ trace ("l = " ++ show l ++ ", r = " ++ show r) $ rangeSum l r - rangeXor l r

        isRangeGood :: (Int, Int) -> (Int, Int) -> Bool
        isRangeGood (l', r') (l, r) = rangeF l' r' == rangeF l r

        findBestR' :: Int -> Int -> Int
        findBestR' l' r = leftestBinarySearch (l', r) $ (\r' -> isRangeGood (l', r) (l', r'))

        findBestL' :: Int -> Int -> Int
        findBestL' l r' = rightestBinarySearch (l, r') $ (\l' -> isRangeGood (l, r') (l', r'))

        bestL = findBestL' l r
        bestR = findBestR' bestL r

        answer :: (Int, Int) = (bestL, bestR)

    return $ answer

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, q] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        let state = preSolve n as
        replicateM_ q $ do
            [l, r] <- B8.getLine <&> readIntB8s
            let (answerL, answerR) = S.evalState (solve (l, r)) state
            printf "%d %d\n" answerL answerR

{-# LANGUAGE CPP #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

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

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

-- Use int here to confuse checker :)
type SolutionState = (Int, UA.Array Int Int, UA.UArray Int Int, UA.UArray Int Int)

preSolve :: Int -> [Int] -> SolutionState
preSolve n as = (n, UA.listArray (1, n) as, prefixSumAs, prefixXorAs)
    where
        prefixSumAs = tracing "prefixSumAs" $ UA.listArray (0, n) . L.scanl (+) 0 $ as
        prefixXorAs = tracing "prefixXorAs" $ UA.listArray (0, n) . L.scanl xor 0 $ as

leftestBinarySearch :: (Int, Int) -> (Int -> Bool) -> Int
leftestBinarySearch (l, r) f = binarySearch' (l, r)
    where
        binarySearch' (l, r) | l == r = l
        binarySearch' (l, r) = if f c
                then binarySearch' (l, c)
                else binarySearch' (c + 1, r)
            where
                c = (l + r) `div` 2

rightestBinarySearch :: (Int, Int) -> (Int -> Bool) -> Int
rightestBinarySearch (l, r) f = binarySearch' (l, r)
    where
        binarySearch' (l, r) | l == r = l
        binarySearch' (l, r) = if f c
                then binarySearch' (c, r)
                else binarySearch' (l, c - 1)
            where
                c = (l + r + 1) `div` 2

solve :: (Int, Int) -> S.State SolutionState (Int, Int)
solve (l, r) = do
    (_, as, prefixSumAs, prefixXorAs) <- S.get
    let rIndices = trace ("as = " ++ show as) $ tracing "rIndices" $ [l .. r]
        rangeSum l r = tracing "rangeSum" $ trace ("l = " ++ show l ++ ", r = " ++ show r) $ (prefixSumAs UA.! r) - (prefixSumAs UA.! (l - 1))
        rangeXor l r = tracing "rangeSum" $ trace ("l = " ++ show l ++ ", r = " ++ show r) $ (prefixXorAs UA.! r) `xor` (prefixXorAs UA.! (l - 1))
        rangeF l r = tracing "rangeF" $ trace ("l = " ++ show l ++ ", r = " ++ show r) $ rangeSum l r - rangeXor l r

        isRangeGood :: (Int, Int) -> (Int, Int) -> Bool
        isRangeGood (l', r') (l, r) = rangeF l' r' == rangeF l r

        findBestR' :: Int -> Int -> Int
        findBestR' l' r = leftestBinarySearch (l', r) $ (\r' -> isRangeGood (l', r) (l', r'))

        findBestL' :: Int -> Int -> Int
        findBestL' l r' = rightestBinarySearch (l, r') $ (\l' -> isRangeGood (l, r') (l', r'))

        bestL = findBestL' l r
        bestR = findBestR' bestL r

        answer :: (Int, Int) = (bestL, bestR)

    return $ answer

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, q] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        let state = preSolve n as
        replicateM_ q $ do
            [l, r] <- B8.getLine <&> readIntB8s
            let (answerL, answerR) = S.evalState (solve (l, r)) state
            printf "%d %d\n" answerL answerR


You are given two strings $$$s$$$ and $$$t$$$. The string $$$s$$$ consists of lowercase Latin letters and at most one wildcard character '*', the string $$$t$$$ consists only of lowercase Latin letters. The length of the string $$$s$$$ equals $$$n$$$, the length of the string $$$t$$$ equals $$$m$$$.The wildcard character '*' in the string $$$s$$$ (if any) can be replaced with an arbitrary sequence (possibly empty) of lowercase Latin letters. No other character of $$$s$$$ can be replaced with anything. If it is possible to replace a wildcard character '*' in $$$s$$$ to obtain a string $$$t$$$, then the string $$$t$$$ matches the pattern $$$s$$$.For example, if $$$s=$$$"aba*aba" then the following strings match it "abaaba", "abacaba" and "abazzzaba", but the following strings do not match: "ababa", "abcaaba", "codeforces", "aba1aba", "aba?aba".If the given string $$$t$$$ matches the given string $$$s$$$, print "YES", otherwise print "NO".

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 2 \cdot 10^5$$$) — the length of the string $$$s$$$ and the length of the string $$$t$$$, respectively. The second line contains string $$$s$$$ of length $$$n$$$, which consists of lowercase Latin letters and at most one wildcard character '*'. The third line contains string $$$t$$$ of length $$$m$$$, which consists only of lowercase Latin letters.

Print "YES" (without quotes), if you can obtain the string $$$t$$$ from the string $$$s$$$. Otherwise print "NO" (without quotes).

NoteIn the first example a wildcard character '*' can be replaced with a string "force". So the string $$$s$$$ after this replacement is "codeforces" and the answer is "YES".In the second example a wildcard character '*' can be replaced with an empty string. So the string $$$s$$$ after this replacement is "vkcup" and the answer is "YES".There is no wildcard character '*' in the third example and the strings "v" and "k" are different so the answer is "NO".In the fourth example there is no such replacement of a wildcard character '*' that you can obtain the string $$$t$$$ so the answer is "NO".

import Data.List

toint s = (read s) :: Int

doit s t =
  case (dropWhile (/='*') s) of
    "" -> s == t
    bb ->
      let b = tail bb in
      let a = takeWhile (/='*') s in
      (isPrefixOf a t) && (isSuffixOf b t) && length a + length b <= length t

solve::String -> String
solve ss =
  let [_,_,s,t] = words ss in
  if doit s t then
    "YES\n"
  else
    "No\n"

main = interact solve

main :: IO ()
main = interact  ((\stdin -> solve (stdin !! 1) (stdin !! 2)) . lines)

solve :: String -> String -> String
solve pattern str =
    if any (=='*') pattern then
    let p = prefix pattern
        s = suffix pattern in
    if (length p) + (length s) > (length str) then "NO" else
    if (and (zipWith (==) p str)) && (and (zipWith (==) s (reverse str))) then
    "YES" else "NO" else if pattern == str then "YES" else "NO"

prefix :: String -> String
prefix str = takeWhile (/='*') str

suffix = prefix . reverse

import Control.Monad
import Data.Bool
import Data.Function
import Data.Tuple
import Data.Maybe
import Data.Tree
import Data.Graph
import Data.Array.IArray
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as B

iogetints :: IO [Int]
iogetints = getLine >>= (return . map read . words)

freadEdgeList :: IO [Edge]
freadEdgeList = B.getContents >>= (return . pairify . map (fst . fromJust . B.readInt) . B.words)

indexed :: [a] -> [(Int, a)]
indexed = go 0 where
	go :: Int -> [a] -> [(Int, a)]
	go _ [] = []
	go i (x:xs) = (i, x) : (go (succ i) xs)

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

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

buildTree :: Int -> Vertex -> [Edge] -> Tree Vertex
buildTree n r es = fdfs (-1) r where
	g = accumArray (flip (:)) [] (1, n) $ ap (++) (map swap) $ es :: Graph
	fdfs :: Vertex -> Vertex -> Tree Vertex
	fdfs p v = Node v $ map (fdfs v) $ delete p $ g!v

both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)

solve :: String -> String -> Bool
solve s1 s2 = ans where
	ss = split (dropDelims $ oneOf "*") s1
	ans = if(length ss == 1 || (length s1) > (succ $ length s2)) then (s1 == s2) else
		(&&) (all id $ zipWith (==) (head ss) s2) (all id $ zipWith (==) (reverse $ last ss) (reverse s2))

main :: IO ()
main = do
	[n, m] <- iogetints
	s1 <- getLine
	s2 <- getLine
	putStrLn $ bool "NO" "YES" $ solve s1 s2

import Data.List

toint s = (read s) :: Int

doit s t =
  case (dropWhile (/='*') s) of
    "" -> s == t
    bb ->
      let b = tail bb in
      let a = takeWhile (/='*') s in
      (isPrefixOf a t) && (isSuffixOf b t)

solve::String -> String
solve ss =
  let [_,_,s,t] = words ss in
  if doit s t then
    "YES\n"
  else
    "No\n"

main = interact solve

main :: IO ()
main = interact  ((\stdin -> solve (stdin !! 1) (stdin !! 2)) . lines)

solve :: String -> String -> String
solve pattern str =
    let p = prefix pattern
        s = suffix pattern in
    if (length p) + (length s) > (length str) then "NO" else
    if (and (zipWith (==) p str)) && (and (zipWith (==) s (reverse str))) then
    "YES" else "NO"

prefix :: String -> String
prefix str = takeWhile (/='*') str

suffix = prefix . reverse

import Control.Monad
import Data.Bool
import Data.Function
import Data.Tuple
import Data.Maybe
import Data.Tree
import Data.Graph
import Data.Array.IArray
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as B

iogetints :: IO [Int]
iogetints = getLine >>= (return . map read . words)

freadEdgeList :: IO [Edge]
freadEdgeList = B.getContents >>= (return . pairify . map (fst . fromJust . B.readInt) . B.words)

indexed :: [a] -> [(Int, a)]
indexed = go 0 where
	go :: Int -> [a] -> [(Int, a)]
	go _ [] = []
	go i (x:xs) = (i, x) : (go (succ i) xs)

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

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

buildTree :: Int -> Vertex -> [Edge] -> Tree Vertex
buildTree n r es = fdfs (-1) r where
	g = accumArray (flip (:)) [] (1, n) $ ap (++) (map swap) $ es :: Graph
	fdfs :: Vertex -> Vertex -> Tree Vertex
	fdfs p v = Node v $ map (fdfs v) $ delete p $ g!v

both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)

solve :: String -> String -> Bool
solve s1 s2 = ans where
	ss = split (dropDelims $ oneOf "*") s1
	ans = if(length ss == 1) then (s1 == s2) else
		(&&) (all id $ zipWith (==) (head ss) s2) (all id $ zipWith (==) (reverse $ last ss) (reverse s2))

main :: IO ()
main = do
	[n, m] <- iogetints
	s1 <- getLine
	s2 <- getLine
	putStrLn $ bool "NO" "YES" $ solve s1 s2

import Control.Monad
import Data.Bool
import Data.Function
import Data.Tuple
import Data.Maybe
import Data.Tree
import Data.Graph
import Data.Array.IArray
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as B

iogetints :: IO [Int]
iogetints = getLine >>= (return . map read . words)

freadEdgeList :: IO [Edge]
freadEdgeList = B.getContents >>= (return . pairify . map (fst . fromJust . B.readInt) . B.words)

indexed :: [a] -> [(Int, a)]
indexed = go 0 where
	go :: Int -> [a] -> [(Int, a)]
	go _ [] = []
	go i (x:xs) = (i, x) : (go (succ i) xs)

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

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

buildTree :: Int -> Vertex -> [Edge] -> Tree Vertex
buildTree n r es = fdfs (-1) r where
	g = accumArray (flip (:)) [] (1, n) $ ap (++) (map swap) $ es :: Graph
	fdfs :: Vertex -> Vertex -> Tree Vertex
	fdfs p v = Node v $ map (fdfs v) $ delete p $ g!v

both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)

solve :: String -> String -> Bool
solve s1 s2 = ans where
	ss = split (dropDelims $ oneOf "*") s1
	ans = if(length ss == 1) then (s1 == s2) else
		(&&) (all id $ zipWith (==) (head ss) s2) (all id $ zipWith (==) (reverse $ last ss) (reverse s2))

main :: IO ()
main = do
	[n, m] <- iogetints
	s1 <- getLine
	s2 <- getLine
	print $ bool "NO" "YES" $ solve s1 s2


Let's define a function $$$f(x)$$$ ($$$x$$$ is a positive integer) as follows: write all digits of the decimal representation of $$$x$$$ backwards, then get rid of the leading zeroes. For example, $$$f(321) = 123$$$, $$$f(120) = 21$$$, $$$f(1000000) = 1$$$, $$$f(111) = 111$$$.Let's define another function $$$g(x) = \dfrac{x}{f(f(x))}$$$ ($$$x$$$ is a positive integer as well).Your task is the following: for the given positive integer $$$n$$$, calculate the number of different values of $$$g(x)$$$ among all numbers $$$x$$$ such that $$$1 \le x \le n$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Each test case consists of one line containing one integer $$$n$$$ ($$$1 \le n < 10^{100}$$$). This integer is given without leading zeroes.

For each test case, print one integer — the number of different values of the function $$$g(x)$$$, if $$$x$$$ can be any integer from $$$[1, n]$$$.

NoteExplanations for the two first test cases of the example:  if $$$n = 4$$$, then for every integer $$$x$$$ such that $$$1 \le x \le n$$$, $$$\dfrac{x}{f(f(x))} = 1$$$;  if $$$n = 37$$$, then for some integers $$$x$$$ such that $$$1 \le x \le n$$$, $$$\dfrac{x}{f(f(x))} = 1$$$ (for example, if $$$x = 23$$$, $$$f(f(x)) = 23$$$,$$$\dfrac{x}{f(f(x))} = 1$$$); and for other values of $$$x$$$, $$$\dfrac{x}{f(f(x))} = 10$$$ (for example, if $$$x = 30$$$, $$$f(f(x)) = 3$$$, $$$\dfrac{x}{f(f(x))} = 10$$$). So, there are two different values of $$$g(x)$$$.

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), (<|), (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

infixl 0 >$>
(>$>) = flip ($)

main = interact $
  lines >>> drop 1 >>> map (length >>> show) >>> unlines

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	n <- readInteger
	print $ 1 + length ( takeWhile ( <= n ) [ 10 ^ i | i <- [ 1 .. ] ] )


Sasha is taking part in a programming competition. In one of the problems she should check if some rooted trees are isomorphic or not. She has never seen this problem before, but, being an experienced participant, she guessed that she should match trees to some sequences and then compare these sequences instead of trees. Sasha wants to match each tree with a sequence a0, a1, ..., ah, where h is the height of the tree, and ai equals to the number of vertices that are at distance of i edges from root. Unfortunately, this time Sasha's intuition was wrong, and there could be several trees matching the same sequence. To show it, you need to write a program that, given the sequence ai, builds two non-isomorphic rooted trees that match that sequence, or determines that there is only one such tree.Two rooted trees are isomorphic, if you can reenumerate the vertices of the first one in such a way, that the index of the root becomes equal the index of the root of the second tree, and these two trees become equal.The height of a rooted tree is the maximum number of edges on a path from the root to any other vertex.

The first line contains a single integer h (2 ≤ h ≤ 105) — the height of the tree. The second line contains h + 1 integers — the sequence a0, a1, ..., ah (1 ≤ ai ≤ 2·105). The sum of all ai does not exceed 2·105. It is guaranteed that there is at least one tree matching this sequence.

If there is only one tree matching this sequence, print "perfect". Otherwise print "ambiguous" in the first line. In the second and in the third line print descriptions of two trees in the following format: in one line print  integers, the k-th of them should be the parent of vertex k or be equal to zero, if the k-th vertex is the root. These treese should be non-isomorphic and should match the given sequence.

NoteThe only tree in the first example and the two printed trees from the second example are shown on the picture:

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  xs <- replicateM (n + 1) poi
  return $ maybe "perfect" (\(a, b) -> "ambiguous\n" ++ unwords (map show a) ++ "\n" ++ unwords (map show b)) $ solve n xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n xs0
  | and $ zipWith (\u p -> not $ u >= 2 && p >= 2) xs0 (0:xs0) = Nothing
  | (_:xs) <- xs0
    = Just ( (0:) $ concat $ snd $ mapAccumL (\i u -> (i + u, replicate u (i - 1))) 2 xs
           , (0:) $ concat $ snd $ mapAccumL (\(p, i, d) u -> if not d && p >= 2 && u >= 2 then ((u, i + u, True), (i - 2):replicate (u - 1) (i - 1)) else ((u, i + u, d), replicate u (i - 1))) (1, 2, False) xs
           )


$$$n$$$ heroes fight against each other in the Arena. Initially, the $$$i$$$-th hero has level $$$a_i$$$.Each minute, a fight between two different heroes occurs. These heroes can be chosen arbitrarily (it's even possible that it is the same two heroes that were fighting during the last minute).When two heroes of equal levels fight, nobody wins the fight. When two heroes of different levels fight, the one with the higher level wins, and his level increases by $$$1$$$.The winner of the tournament is the first hero that wins in at least $$$100^{500}$$$ fights (note that it's possible that the tournament lasts forever if no hero wins this number of fights, then there is no winner). A possible winner is a hero such that there exists a sequence of fights that this hero becomes the winner of the tournament.Calculate the number of possible winners among $$$n$$$ heroes.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases. Each test case consists of two lines. The first line contains one integer $$$n$$$ ($$$2 \le n \le 100$$$) — the number of heroes. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 100$$$), where $$$a_i$$$ is the initial level of the $$$i$$$-th hero.

For each test case, print one integer — the number of possible winners among the given $$$n$$$ heroes.

NoteIn the first test case of the example, the only possible winner is the first hero.In the second test case of the example, each fight between the heroes results in nobody winning it, so the tournament lasts forever and there is no winner.

module Main where

    del :: Eq a => [a] -> a -> [a]
    del s x = filter (/= x) s

    solve :: IO ()
    solve = do
        getLine
        s <- getLine
        let a = map (\x -> read x :: Integer) $ words s
        print $ length $ del a $ minimum a

    iter :: Integer -> IO ()
    iter 1 = solve
    iter x = do
        solve
        iter $ x - 1

    main = do
        q <- getLine
        iter (read q :: Integer)

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

main = interact $ unlines.map show.f.tail.lines

f :: [String] -> [Int]
f [] = []
f (_:b:xs) = g (read <$> words b) : f xs

g :: [Int] -> Int
g [] = 0
g b = let m = minimum b in length $ filter (> m) b

import Data.List (sort)
import Control.Monad (mapM_)

discardSmallest :: Eq a => [a] -> [a]       -- list must be sorted
discardSmallest []     = []
discardSmallest (x:xs) = dropWhile (== x) xs

solution :: [Int] -> Int
solution = length . discardSmallest . sort

main = do
	numTests <- read <$> getLine
	tests <- sequence $ replicate numTests $ do
		_ <- getLine 		-- length of list
		map read . words <$> getLine
	mapM_ (putStrLn . show . solution) tests

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    _ <- C.getLine
    as <- getInts
    let minValue = minimum as
    C.putStrLn $ C.pack $ show $ length $ filter (/= minValue) as

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

import Control.Monad
import Control.Monad.State
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

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

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

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

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

------

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

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

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

------

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

run1 = do
  n <- popInt
  as <- popInts
  return $ bshow (solve n as)

solve n as = length $ filter (/= minimum as) as

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

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

type SIO = StateT P.ByteString IO

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    let  v = minimum a
    putInts [length $ filter (> v) a]

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

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

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

module Main where

    del :: Eq a => [a] -> a -> [a]
    del s x = filter (/= x) s

    solve :: IO ()
    solve = do
        getLine
        s <- getLine
        let a = map (\x -> read x :: Integer) $ words s
        print $ length $ del a $ maximum a

    iter :: Integer -> IO ()
    iter 1 = solve
    iter x = do
        solve
        iter $ x - 1

    main = do
        q <- getLine
        iter (read q :: Integer)


A permutation of size n is an array of size n such that each integer from 1 to n occurs exactly once in this array. An inversion in a permutation p is a pair of indices (i, j) such that i > j and ai < aj. For example, a permutation [4, 1, 3, 2] contains 4 inversions: (2, 1), (3, 1), (4, 1), (4, 3).You are given a permutation a of size n and m queries to it. Each query is represented by two indices l and r denoting that you have to reverse the segment [l, r] of the permutation. For example, if a = [1, 2, 3, 4] and a query l = 2, r = 4 is applied, then the resulting permutation is [1, 4, 3, 2].After each query you have to determine whether the number of inversions is odd or even.

The first line contains one integer n (1 ≤ n ≤ 1500) — the size of the permutation.  The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ n) — the elements of the permutation. These integers are pairwise distinct. The third line contains one integer m (1 ≤ m ≤ 2·105) — the number of queries to process. Then m lines follow, i-th line containing two integers li, ri (1 ≤ li ≤ ri ≤ n) denoting that i-th query is to reverse a segment [li, ri] of the permutation. All queries are performed one after another.

Print m lines. i-th of them must be equal to odd if the number of inversions in the permutation after i-th query is odd, and even otherwise.

NoteThe first example:  after the first query a = [2, 1, 3], inversion: (2, 1);  after the second query a = [2, 3, 1], inversions: (3, 1), (3, 2). The second example:  a = [1, 2, 4, 3], inversion: (4, 3);  a = [3, 4, 2, 1], inversions: (3, 1), (4, 1), (3, 2), (4, 2), (4, 3);  a = [1, 2, 4, 3], inversion: (4, 3);  a = [1, 4, 2, 3], inversions: (3, 2), (4, 2).

main :: IO ()
main = do
    getLine
    nums <- fmap (map read . words) getLine :: IO [Int]
    let isOdd = odd $ countInv nums
    getLine
    invs <- fmap (map readPair . lines) getContents :: IO [(Int, Int)]
    main' isOdd invs
    where
        main' :: Bool -> [(Int, Int)] -> IO ()
        main' _ [] = return ()
        main' isOdd (i:is) = do
            let tmp = process isOdd i
            putStrLn (if tmp then "odd" else "even")
            main' tmp is

readPair :: String -> (Int, Int)
readPair s = let (a:b:_) = map read $ words s
    in (a, b)
process :: Bool -> (Int, Int) -> Bool
process inp (l, r) = case (r-l+1) `div` 2 `mod` 2 of
    0 -> inp
    1 -> not inp

countInv :: [Int] -> Int
countInv nums = countInv' nums 0
    where
        countInv' (n:ns) ans = countInv' ns (ans + sum (map (\x -> if x < n then 1 else 0) ns))
        countInv' _ ans = ans

import Data.Bits (xor)

countInv :: [Int] -> Int
countInv [] = 0
countInv (x:xs) = countInv xs `xor` (length (filter (< x) xs) `mod` 2)

process :: Int -> Int -> IO ()
process 0 _ = return ()
process m inv = do
    [l, r] <- fmap (map read . words) getLine
    let c = r - l + 1
    let newInv = inv `xor` ((c * (c - 1) `div` 2) `mod` 2)
    putStrLn $ if newInv == 0 then "even" else "odd"
    process (m - 1) newInv

main :: IO ()
main = do
    n <- readLn :: IO Int
    a <- fmap (map read . words) getLine
    m <- readLn :: IO Int
    let inv = countInv a
    process m inv

main :: IO ()
main = do
    getLine
    nums <- fmap (map read . words) getLine :: IO [Int]
    let isOdd = odd $ countInv nums
    getLine
    invs <- fmap (map readPair . lines) getContents :: IO [(Int, Int)]
    main' isOdd invs
    where
        main' :: Bool -> [(Int, Int)] -> IO ()
        main' _ [] = return ()
        main' isOdd (i:is) = do
            let tmp = process isOdd i
            putStrLn (if tmp then "odd" else "even")
            main' tmp is

readPair :: String -> (Int, Int)
readPair s = let (a:b:_) = map read $ words s
    in (a, b)
process :: Bool -> (Int, Int) -> Bool
process inp (l, r) = case (r-l+1) `div` 2 `mod` 2 of
    0 -> inp
    1 -> not inp

countInv :: [Int] -> Int
countInv nums = countInv' nums 0
    where
        countInv' (n:ns) ans = countInv' ns (ans + sum (map (\x -> if x > n then 1 else 0) ns))
        countInv' _ ans = ans

import Data.Bits (xor)

countInv :: [Int] -> Int
countInv [] = 0
countInv (x:xs) = countInv xs + length (filter (< x) xs)

process :: Int -> Int -> IO ()
process 0 _ = return ()
process m inv = do
    [l, r] <- fmap (map read . words) getLine
    let c = r - l + 1
    let newInv = inv `xor` ((c * (c - 1) `div` 2) `mod` 2)
    putStrLn $ if newInv == 0 then "even" else "odd"
    process (m - 1) newInv

main :: IO ()
main = do
    n <- readLn :: IO Int
    a <- fmap (map read . words) getLine
    m <- readLn :: IO Int
    let inv = countInv a
    process m inv


Right now you are to solve a very, very simple problem — to crack the safe. Four positive integers stand one by one on a circle protecting the safe. You know that to unlock this striking safe you have to make all four numbers equal to one. Operations are as follows: you may choose two adjacent numbers and increase both by one; you may choose two adjacent even numbers and divide both by two. Nothing else. Crack the safe!

The single line of the input contains four space-separated integer positive numbers not greater than 109 each — four numbers on the circle in consecutive order.

The output should contain "-1" (quotes for clarity) if the safe is secure, that is it's impossible to crack it. Otherwise, output should contain the sequence of operations (one operations per line) leading to unlocking the safe. You don't have to minimize the number of operations, but it should not exceed 1000. To make things clear, assume numbers stand on positions 1 through 4. Each operation is encoded by two symbols. If the following operation is dividing then first symbol is '/'; otherwise it's '+' (addition). The second symbol is the position of the first number in pair in consecutive order. (see samples for clarification). If there are several solutions, output any of them.

main = interact solve
solve input = output where
  four = map (read::String->Integer) $ words input
  output = if (not $ null a) && (last a == 'x') then "-1\n" else a
    where a = answer four
  answer xs
    | m == 1 = ""
    | even m && even (xs!!ni)
                = "/" ++ show (i + 1) ++ "\n" ++ answer (dv i xs)
    | even m && even (xs!!pi)
                = "/" ++ show (pi + 1) ++ "\n" ++ answer (dv pi xs)
    | even m    = "+" ++ show (pi + 1) ++ "\n" ++
                  "+" ++ show (i + 1) ++ "\n" ++ answer (pl i (pl pi xs))
    | even (xs!!ni)
                = "+" ++ show (pi + 1) ++ "\n" ++ answer (pl pi xs)
    | otherwise = "+" ++ show (i + 1) ++ "\n" ++ answer (pl i xs)
    where
      pi = mod (i+3) 4
      ni = mod (i+1) 4
      s = sum xs
      (m,i) = maximum $ zip xs [0..3]
  dv i xs = [if j==i || j==mod (i+1) 4 then div (xs!!j) 2 else xs!!j|j<-[0..3]]
  pl i xs = [if j==i || j==mod (i+1) 4 then (xs!!j)+1 else xs!!j|j<-[0..3]]

main = interact solve
solve input = output where
  four = map (read::String->Integer) $ words input
  output = if (not $ null a) && (last a == 'x') then "-1\n" else a
    where a = answer four
  answer xs
    | s == 4 = ""
    | s == 5 = "x"
    | even m && even (xs!!ni)
                   = "/" ++ show (i + 1) ++ "\n" ++ answer (dv i xs)
    | even m && even (xs!!pi)
                   = "/" ++ show (pi + 1) ++ "\n" ++ answer (dv pi xs)
    | even m       = "+" ++ show (ni + 1) ++ "\n" ++ answer (pl ni xs)
    | even (xs!!ni)    = "+" ++ show (i + 1) ++ "\n" ++ answer (pl pi xs)
    | otherwise    = "+" ++ show (i + 1) ++ "\n" ++ answer (pl i xs)
    where
      pi = mod (i+3) 4
      ni = mod (i+1) 4
      s = sum xs
      (m,i) = maximum $ zip xs [0..3]
  dv i xs = [if j==i || j==mod (i+1) 4 then div (xs!!j) 2 else xs!!j|j<-[0..3]]
  pl i xs = [if j==i || j==mod (i+1) 4 then (xs!!j)+1 else xs!!j|j<-[0..3]]

main = interact solve
solve input = output where
  four = map (read::String->Integer) $ words input
  output = if (not $ null a) && (last a == 'x') then "-1" else a
    where a = answer four
  answer xs
    | s == 4 = ""
    | s == 5 = "x"
    | even m && even (xs!!ni)
                   = "/" ++ show (i + 1) ++ "\n" ++ answer (dv i xs)
    | even m && even (xs!!pi)
                   = "/" ++ show (pi + 1) ++ "\n" ++ answer (dv pi xs)
    | even m       = "+" ++ show (ni + 1) ++ "\n" ++ answer (pl ni xs)
    | even (xs!!ni)    = "+" ++ show (i + 1) ++ "\n" ++ answer (pl pi xs)
    | otherwise    = "+" ++ show (i + 1) ++ "\n" ++ answer (pl i xs)
    where
      pi = mod (i+3) 4
      ni = mod (i+1) 4
      s = sum xs
      (m,i) = maximum $ zip xs [0..3]
  dv i xs = [if j==i || j==mod (i+1) 4 then div (xs!!j) 2 else xs!!j|j<-[0..3]]
  pl i xs = [if j==i || j==mod (i+1) 4 then (xs!!j)+1 else xs!!j|j<-[0..3]]


Vanya and his friends are walking along the fence of height h and they do not want the guard to notice them. In order to achieve this the height of each of the friends should not exceed h. If the height of some person is greater than h he can bend down and then he surely won't be noticed by the guard. The height of the i-th person is equal to ai.Consider the width of the person walking as usual to be equal to 1, while the width of the bent person is equal to 2. Friends want to talk to each other while walking, so they would like to walk in a single row. What is the minimum width of the road, such that friends can walk in a row and remain unattended by the guard?

The first line of the input contains two integers n and h (1 ≤ n ≤ 1000, 1 ≤ h ≤ 1000) — the number of friends and the height of the fence, respectively. The second line contains n integers ai (1 ≤ ai ≤ 2h), the i-th of them is equal to the height of the i-th person.

Print a single integer — the minimum possible valid width of the road.

NoteIn the first sample, only person number 3 must bend down, so the required width is equal to 1 + 1 + 2 = 4.In the second sample, all friends are short enough and no one has to bend, so the width 1 + 1 + 1 + 1 + 1 + 1 = 6 is enough.In the third sample, all the persons have to bend, except the last one. The required minimum width of the road is equal to 2 + 2 + 2 + 2 + 2 + 1 = 11.

module Main
    where

import System.IO

solve first second =
    foldr (\a s -> s + if a <= h then 1 else 2) 0 friends
    --sum . map (\a -> if a <= h then 1 else 2) $ friends
    where
        h =
            case words first of
                _ : h' : _ ->
                    read h' :: Int
        friends =
            map read . words $ second

main = do
    first <- getLine
    second <- getLine
    print $ solve first second

module Main
    where

import System.IO

solve first second =
    sum . map (\a -> if a <= h then 1 else 2) $ friends
    where
        h =
            case words first of
                _ : h' : _ ->
                    read h' :: Int
        friends =
            map read . words $ second

main = do
    first <- getLine
    second <- getLine
    print $ solve first second

import Control.Monad

sol :: [Int] -> Int -> Int
sol [] h = 0
sol heights h = if (head heights) > h
  then 2 + (sol (tail heights) h)
  else 1 + (sol (tail heights) h)

main :: IO ()
main = do
  [n, h] <- fmap (map read.words) getLine
  heights <- fmap (map read.words) getLine
  print (sol heights h)

module Main where

main :: IO ()
main = do
    [n, h] <- getInts
    as <- getInts
    print $ totWidth h as

getInts :: IO [Int]
getInts = fmap (map read . words) getLine

--totWidth :: Num a => a -> [a] -> a
totWidth _ [] = 0
totWidth h (a : as) = singleWidth h a + totWidth h as

--singleWidth :: Num a => a -> a -> a
singleWidth h a = if a <= h then 1 else 2

test :: Bool
test = totWidth 10 [2, 2, 5] == 3 && totWidth 10 [9, 10, 11, 3] == 5 && totWidth 10 [11, 12, 23, 14] == 8 && totWidth 7 [4, 5, 14] == 4 && totWidth 1 [1, 1, 1, 1, 1, 1] == 6 && totWidth 5 [7, 6, 8, 9, 10, 5] == 11

import Data.Functor

main :: IO()
main = do
    [n, h] <- map read . words <$> getLine
    a <- map read . words <$> getLine
    let m = length $ filter (> h) a
    print $ n + m

conv lst uu
  | (null lst) = uu
  | otherwise = conv (tail lst) (uu ++ [(read (head lst))::Int])

findwidth lst height width
  | (null lst) = width
  | otherwise = if (head lst) > height
                then findwidth (tail lst) height (width + 2)
                else findwidth (tail lst) height (width + 1)

main = do
  ff <- getLine
  gg <- getLine
  let aa = (read (head (words ff)))::Int
      bb = (read (last (words ff)))::Int
      cc = conv (words gg) []

      ans = findwidth cc bb 0
  putStrLn (show ans)

f :: Int -> Int -> Int
f x h =
  if x > h
    then 2
    else 1

result :: [Int] -> Int -> Int
result xs h =
  if null xs
    then 0
    else (f (head xs) h) + result (tail xs) h

main = do
  line <- getLine
  let [n, h] = take 2 (map read $ words line :: [Int])
  line2 <- getLine
  let xs = take n (map read $ words line2 :: [Int])
  let p = result xs h
  print p

main = do
    [n, h] <- fmap (map read . words) getLine
    elems <- fmap (map read . words) getLine
    print (solve h elems)

value :: Int -> Int -> Int
value h x = if x > h then 2 else 1

solve :: Int -> [Int] -> Int
solve h elems = sum (map (value h) elems)

import Data.Char
import Control.Monad

readIntImpl :: Int -> Bool -> IO Int
readIntImpl x flag = do
    c <- getChar
    if c `elem` ['0'..'9']
        then do
            let d = digitToInt c
            y <- readIntImpl (x*10+d) True
            return y
    else if flag
        then
            return x
        else do
            y <- readIntImpl x False
            return y

readInt = readIntImpl 0 False
readArr n readFunc = replicateM n readFunc

main = do
    n <- readInt
    h <- readInt
    arr <- readArr n readInt
    let ans = sum [ if x > h then 2 else 1 | x <- arr]
    putStrLn (show(ans))

main = do
  [n, h] <- fmap (map read . words) getLine
  xs <- fmap (map read . words) getLine :: IO [Int]

  print $ sum $ map (\x -> if x <= h then 1 else 2) xs

solve :: [[Int]] -> Int
solve [[_,h],a] = (length $ filter (<=h) a) + 2*(length $ filter (>h) a)
main = interact $ show . solve . map (map read . words) . take 2 . lines

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  [n,h] <- fmap (map read . words) getLine
  inp <- fmap (map read . words) getLine
  print $ solve h inp

solve :: Int -> [Int] -> Int
solve h = sum . map f
    where
      f a | a > h = 2
          | otherwise = 1

solve :: Int -> [Int] -> Int
solve h (x:xs) = if x > h then 2 + solve h xs else 1 + solve h xs
solve h _ = 0

main = do
    firstLine <- getLine
    secondLine <- getLine
    let h = read $ (tail $ words firstLine) !! 0
    let friends = map read $ words secondLine
    putStrLn . show $ solve h friends

solve :: [Int] -> Int
solve (_ : h : xs) = sum $ map (\x -> if x <= h then 1 else 2) xs

main :: IO ()
main = interact $ show . solve . map read . words

module Main where

solve (h:xs) = length  $ xs ++ filter (>h) xs

main :: IO ()
main = print . solve . drop 1 . map (read:: String -> Int) . words =<< getContents

module Main where

solve (h:xs) = length (xs ++ filter (>h) xs)

main :: IO ()
main = print . solve . drop 1 . map (read:: String -> Int) . words =<< getContents

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  solve. tail.concat =<< forM [1..2] (\i-> (map (fst.fromJust.C.readInt).C.words) <$> C.getLine)
solve::[Int]->IO ()
solve (x:xs) = print $ foldr (\a b -> if a>x then 2+b else 1+b) 0 xs

import Control.Applicative

solve :: Int -> [Int] -> Int
solve h = sum.fmap f
    where f a
            | a > h = 2
            | otherwise = 1
main = do
    _:h:as <- fmap read.concatMap words.lines <$> getContents
    print $ solve h as

{-#LANGUAGE OverloadedStrings#-}
module Main where
import Data.Text (pack, unpack, splitOn)
main :: IO ()
main = do
    [_,h] <- readInts
    hs <- readInts
    putStrLn $ show (solve h hs)
    where
        readInts :: IO [Int]
        readInts = fmap (map ((read ::String ->Int). unpack)
                    . splitOn " " . pack) getLine

solve :: Int -> [Int] -> Int
solve h = foldr (\x acc -> if x > h then acc + 2 else acc + 1) 0

import Control.Monad

main = readInput >>= putStrLn . show . count

readInput :: IO (Int, [Int])
readInput = liftM2 toTuple getLine getLine
  where toTuple a b = (h, map read $ words b)
          where fstL = words a
                h = read $ fstL !! 1

count :: (Int, [Int]) -> Int
count (h, hs) = foldr (\curr ans -> if h < curr
                                    then ans + 2
                                    else ans + 1)
                      0 hs

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

width :: Int -> Int -> Int
width x h
    | x > h     = 2
    | otherwise = 1

main :: IO ()
main = do
    [n, h] <- (map readInt . words) <$> getLine
    arr <- (map readInt . words) <$> getLine
    let answer = sum . map (`width` h) $ arr
    printf "%d\n" answer

import Control.Monad

main = do
    firstLine <- getLine
    let [_, h] = map read (words firstLine)

    secondLine <- getLine
    let arr = map read (words secondLine)

    print $ sum $ map (process h) arr
        where
            process :: Int -> Int -> Int
            process h a
                | a <= h = 1
                | otherwise = 2

import Control.Applicative
import Data.List
import Data.Char

main=do
   [a,b]<- map read <$> words <$> getLine ::IO [Int]
   c<- map read <$> words <$> getLine ::IO [Int]
   putStrLn $ show $ (length c) + length (filter (>b) c)

main = print . solve . map read . words =<< getContents
solve (n:h:ns) = length (ns ++ filter (>h) ns :: [Int])

main :: IO ()
main = do
  [n, h] <- map read . words <$> getLine
  a <- map read . words <$> getLine
  print $ solve h a

solve :: Int -> [Int] -> Int
solve h = sum . map f
  where
    f a =
      if a > h
        then 2
        else 1

import Control.Monad
import Control.Applicative

main = do [n, h] <- map read . words <$> getLine
          as <- map read . words <$> getLine
          print $ solve n h as

solve :: Int -> Int -> [Int] -> Int
solve n h as = foldr (+) 0 $ map (\a -> if h < a then 2 else 1) as

import Control.Monad
import Control.Applicative

main = do [n, h] <- map read . words <$> getLine
          as <- map read . words <$> getLine
          print $ solve n h as

solve :: Int -> Int -> [Int] -> Int
solve n h as = n + (length $ filter (\a -> h < a) as)

-- Vicfred
-- https://codeforces.com/problemset/problem/677/A

main :: IO ()
main = do
    [n,h] <- map read . words <$> getLine
    a <- map read . words <$> getLine
    let m = length $ filter (>h) a
    print $ n + m

zabor :: [Int] -> Int -> Int
zabor [] _ = 0
zabor (x:xs) n
    | (x <= n) = 1 + zabor xs n
    | otherwise = 2 + zabor xs n
func :: [String] -> [Int]
func list = map (\x -> read x::Int) list

main :: IO()
main = do
    inputOne <- getLine
    inputTwo <- getLine
    a <- return $ (func $ words inputOne)!!1
    b <- return $ func $ words inputTwo
    putStrLn $ show $ zabor b a

import Control.Applicative( (<$>))
main = do
    tokens <- return . words =<< getContents
    let n:fence:heights = read <$> tokens
    print $ sum $ (\h->if h>fence then 2 else 1) <$> take n heights

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

ans a b c d k  | z >k = "-1"
               | otherwise = show z1 ++ " " ++ show z2

	where 	z1= (div (a-1) c )+1
		z2 = (div (b-1) d) +1
		z= z1+z2

main= do
	   [a,b]<-map read <$> words <$> getLine::IO [Int]
           c<- map read <$> words<$> getLine::IO [Int]
	   let d = length $ filter (>b) c
           print $ a+d

main :: IO ()
main = do
    [n, h] <- map (read :: String -> Int) . words <$> getLine
    print =<< sum . map ((1+) . fromEnum . (h<) . (read :: String -> Int)) . words <$> getLine

getResult _ [] = 0
getResult h (x:xs) = cur + getResult h xs
    where cur = if x > h then 2 else 1

main = do
    nh_ln <- getLine
    nums_ln <- getLine

    let nh = map (read :: String -> Int) (words nh_ln)
    let nums = map (read :: String -> Int) (words nums_ln)

    putStrLn . show $ getResult (nh !! 1) nums

--ghc 7.10

minRoadWidth :: (Ord a, Integral b) => a -> [a] -> b
minRoadWidth h a = sum . map (\x -> if x > h then 2 else 1) $ a

main = do
    nhStr <- getLine
    let [n,h] = map read . words $ nhStr :: [Int]
    aStr <- getLine
    let a = map read .words $ aStr :: [Int]
    print $ minRoadWidth h a

main :: IO ()
main = do
        [[_,h],a] <- readLoL :: IO [[Int]]
        print $ answer h a

answer :: Int -> [Int] -> Int
answer h = sum . fmap (\a -> if a <= h then 1 else 2)

-- Boilerplate
readLoL :: (Read a) => IO [[a]]
readLoL = fmap parseMatrix getContents

parseMatrix :: (Read a) => String -> [[a]]
parseMatrix = (fmap.fmap) read . tokenizeMatrix

tokenizeMatrix :: String -> [[String]]
tokenizeMatrix = fmap words . lines

main = interact $ show . f . tail . map read . words

f :: [Int] -> Int
f (b : xs) = sum (map (\x -> if x > b then 2 else 1) xs)


You are given two arrays of integers $$$a_1,\ldots,a_n$$$ and $$$b_1,\ldots,b_m$$$.Your task is to find a non-empty array $$$c_1,\ldots,c_k$$$ that is a subsequence of $$$a_1,\ldots,a_n$$$, and also a subsequence of $$$b_1,\ldots,b_m$$$. If there are multiple answers, find one of the smallest possible length. If there are still multiple of the smallest possible length, find any. If there are no such arrays, you should report about it.A sequence $$$a$$$ is a subsequence of a sequence $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero) elements. For example, $$$[3,1]$$$ is a subsequence of $$$[3,2,1]$$$ and $$$[4,3,1]$$$, but not a subsequence of $$$[1,3,3,7]$$$ and $$$[3,10,4]$$$.

The first line contains a single integer $$$t$$$ ($$$1\le t\le 1000$$$)  — the number of test cases. Next $$$3t$$$ lines contain descriptions of test cases. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1\le n,m\le 1000$$$)  — the lengths of the two arrays. The second line of each test case contains $$$n$$$ integers $$$a_1,\ldots,a_n$$$ ($$$1\le a_i\le 1000$$$)  — the elements of the first array. The third line of each test case contains $$$m$$$ integers $$$b_1,\ldots,b_m$$$ ($$$1\le b_i\le 1000$$$)  — the elements of the second array. It is guaranteed that the sum of $$$n$$$ and the sum of $$$m$$$ across all test cases does not exceed $$$1000$$$ ($$$\sum\limits_{i=1}^t n_i, \sum\limits_{i=1}^t m_i\le 1000$$$).

For each test case, output "YES" if a solution exists, or "NO" otherwise. If the answer is "YES", on the next line output an integer $$$k$$$ ($$$1\le k\le 1000$$$)  — the length of the array, followed by $$$k$$$ integers $$$c_1,\ldots,c_k$$$ ($$$1\le c_i\le 1000$$$)  — the elements of the array. If there are multiple solutions with the smallest possible $$$k$$$, output any.

NoteIn the first test case, $$$[4]$$$ is a subsequence of $$$[10, 8, 6, 4]$$$ and $$$[1, 2, 3, 4, 5]$$$. This array has length $$$1$$$, it is the smallest possible length of a subsequence of both $$$a$$$ and $$$b$$$.In the third test case, no non-empty subsequences of both $$$[3]$$$ and $$$[2]$$$ exist, so the answer is "NO".

import Data.List
import Control.Monad

solve :: ([Int], [Int]) -> Maybe [Int]
solve (xs, ys)
  | null is = Nothing
  | otherwise = Just is
  where
    is = xs `intersect` ys

printS :: Maybe [Int] -> IO ()
printS Nothing = putStrLn "NO"
printS (Just (x:_)) = putStrLn "YES" >> putStrLn ("1 " ++ show x)

getTest :: IO ([Int], [Int])
getTest = getLine >> do
  xs <- map read . words <$> getLine
  ys <- map read . words <$> getLine
  return (xs, ys)

main :: IO ()
main = do
  t <- read <$> getLine
  tests <- replicateM t getTest
  mapM_ (printS . solve) tests

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

onecase = do
		getLine
		x<- map read <$> words <$> getLine ::IO [Int]
		y<- map read <$> words <$> getLine ::IO [Int]
		let xx = S.fromList x
		let yy = S.fromList y
		let zz = S.intersection xx yy
		putStrLn $ if S.null zz then "NO" else "YES\n1 " ++ show (head (S.elems zz))

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


Little Paul wants to learn how to play piano. He already has a melody he wants to start with. For simplicity he represented this melody as a sequence $$$a_1, a_2, \ldots, a_n$$$ of key numbers: the more a number is, the closer it is to the right end of the piano keyboard.Paul is very clever and knows that the essential thing is to properly assign fingers to notes he's going to play. If he chooses an inconvenient fingering, he will then waste a lot of time trying to learn how to play the melody by these fingers and he will probably not succeed.Let's denote the fingers of hand by numbers from $$$1$$$ to $$$5$$$. We call a fingering any sequence $$$b_1, \ldots, b_n$$$ of fingers numbers. A fingering is convenient if for all $$$1\leq i \leq n - 1$$$ the following holds:  if $$$a_i < a_{i+1}$$$ then $$$b_i < b_{i+1}$$$, because otherwise Paul needs to take his hand off the keyboard to play the $$$(i+1)$$$-st note;  if $$$a_i > a_{i+1}$$$ then $$$b_i > b_{i+1}$$$, because of the same;  if $$$a_i = a_{i+1}$$$ then $$$b_i\neq b_{i+1}$$$, because using the same finger twice in a row is dumb. Please note that there is $$$\neq$$$, not $$$=$$$ between $$$b_i$$$ and $$$b_{i+1}$$$. Please provide any convenient fingering or find out that there is none.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) denoting the number of notes. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 2\cdot10^5$$$) denoting the positions of notes on the keyboard.

If there is no convenient fingering, print $$$-1$$$. Otherwise, print $$$n$$$ numbers $$$b_1, b_2, \ldots, b_n$$$, each from $$$1$$$ to $$$5$$$, denoting a convenient fingering, separated by spaces.

NoteThe third sample test is kinda "Non stop" song by Reflex.

import Data.List
import Data.Maybe

toint s = (read s) :: Integer

-- buscar mas chico
do0 i [] k = -1
do0 i (x:xs) k =
    if i < k && x >= 0 then
        i
    else
        do0 (i+1) xs k

-- buscar mas grande
do1 i [] k = -1
do1 i (x:xs) k =
    if i > k && x >= 0 then
        i
    else
        do1 (i+1) xs k

-- buscar distinto
do2 i [] k = -1
do2 i (x:xs) k =
    if i /= k && x >= 0 then
        i
    else
        do2 (i+1) xs k

go l [t] = [l]
go l (x:y:xs) =
    if x < y then
        let l2 = map (do0 0 l) [0..4] in
        l: (go l2 $ y:xs)
    else if x > y then
        let l2 = map (do1 0 l) [0..4] in
        l: (go l2 $ y:xs)
    else
        let l2 = map (do2 0 l) [0..4] in
        l: (go l2 $ y:xs)

concha :: Int -> [[Int]] -> [Int]
concha t [] = [t+1]
concha t (x:xs) =
    let t2 = x !! t in
    (t+1):(concha t2 xs)

solve::String -> String
solve ss =
    let n:x = map toint $ words ss in
    let pingo = reverse $ go [0,0,0,0,0] x in
    if (maximum $ head pingo) == -1 then
        "-1\n"
    else
        let t = fromJust $ findIndex (>=0) $ head pingo in
        let ans = tail$ reverse $ concha t pingo in
        (intercalate " " $ map show ans)++"\n"

main = do
  interact $ solve


AmShZ has traveled to Italy from Iran for the Thom Yorke concert. There are $$$n$$$ cities in Italy indexed from $$$1$$$ to $$$n$$$ and $$$m$$$ directed roads indexed from $$$1$$$ to $$$m$$$. Initially, Keshi is located in the city $$$1$$$ and wants to go to AmShZ's house in the city $$$n$$$. Since Keshi doesn't know the map of Italy, AmShZ helps him to see each other as soon as possible.In the beginning of each day, AmShZ can send one of the following two messages to Keshi: AmShZ sends the index of one road to Keshi as a blocked road. Then Keshi will understand that he should never use that road and he will remain in his current city for the day. AmShZ tells Keshi to move. Then, Keshi will randomly choose one of the cities reachable from his current city and move there. (city $$$B$$$ is reachable from city $$$A$$$ if there's an out-going road from city $$$A$$$ to city $$$B$$$ which hasn't become blocked yet). If there are no such cities, Keshi will remain in his current city.Note that AmShZ always knows Keshi's current location. AmShZ and Keshi want to find the smallest possible integer $$$d$$$ for which they can make sure that they will see each other after at most $$$d$$$ days. Help them find $$$d$$$.

The first line of the input contains two integers $$$n$$$ and $$$m$$$ $$$(2 \le n \le 2 \cdot 10^5, 1 \le m \le 2 \cdot 10^5)$$$  — the number of cities and roads correspondingly. The $$$i$$$-th line of the following $$$m$$$ lines contains two integers $$$v_i$$$ and $$$u_i$$$ $$$(1 \le v_i , u_i \le n,v_i \neq u_i)$$$, denoting a directed road going from city $$$v_i$$$ to city $$$u_i$$$. It is guaranteed that there is at least one route from city $$$1$$$ to city $$$n$$$. Note that there may be more than one road between a pair of cities in each direction.

Output the smallest possible integer $$$d$$$ to make sure that AmShZ and Keshi will see each other after at most $$$d$$$ days.

NoteIn the first sample, it's enough for AmShZ to send the second type of message.In the second sample, on the first day, AmShZ blocks the first road. So the only reachable city from city $$$1$$$ will be city $$$4$$$. Hence on the second day, AmShZ can tell Keshi to move and Keshi will arrive at AmShZ's house.It's also possible for AmShZ to tell Keshi to move for two days.

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray)

-- road map in reverse, and the number of cities, init pen state
type Road = Map Int (Map Int Int)
type Domain = (Road, Int, IOUArray Int Int, IOUArray Int Bool)
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

pairToElem :: (Int, Int) -> (Int, Map Int Int)
pairToElem (a, b) = (a, Map.singleton b 1)

pairToRevElem :: (Int, Int) -> (Int, Map Int Int)
pairToRevElem (a, b) = (b, Map.singleton a 1)

insertAll :: IOUArray Int Int -> [(Int, Int)] -> IO ()
insertAll arr = mapM_ (uncurry $ writeArray arr)

parse :: IO Domain
parse = do
  [cities, roadsNumber] <- readChar8
  pairs <- replicateM roadsNumber getPair
  visited <- newArray (1,cities) False
  let roads = fromListWith (Map.unionWith (+)) $ pairToElem <$> pairs
  pen <- newArray (1, cities) 0
  insertAll pen $ Map.toList $ ((+1) . sum . Map.elems) <$> roads
  let revRoads = fromListWith (Map.unionWith (+)) $ pairToRevElem <$> pairs
  return $ (revRoads, cities, pen, visited)

-- (dist, target)
dij :: Road -> (Set (Int, Int), IOUArray Int Int, IOUArray Int Bool) -> IO Int
dij roads (a, pen, visited) = go a-- traceShow ((d, i), newPen, que) $
  where
    go ::  Set (Int, Int) -> IO Int
    go que = do
       ((d, i), nQue) <- deleteFindMinNotMeet visited que
       writeArray visited i True
       let children = fromMaybe empty $ roads !? i
       -- reduce children penetration if visiting
       _ <- traverseWithKey (\k v -> writeArray pen k =<< (flip (-) v) <$> readArray pen k) children
       childQue <- mapM (\j -> do
                  c <- readArray pen j
                  return (d + c, j)) $ Map.keys children
       let newQue = union nQue (Set.fromList childQue)
       if i == 1 then return d else go newQue

deleteFindMinNotMeet :: IOUArray Int Bool -> Set (Int, Int) -> IO ((Int, Int), Set (Int, Int))
deleteFindMinNotMeet visited que = do
  flag <- readArray visited i
  if flag then deleteFindMinNotMeet visited nQue else return ans
  where ans@((d, i), nQue) = deleteFindMin que

solve :: Solver
solve (roads, n, pen, visited) = dij roads (Set.singleton (0, n), pen, visited)

main :: IO ()
main = do
  printAns =<< solve =<< parse

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray)

-- road map in reverse, and the number of cities, init pen state
type Road = Map Int (Map Int Int)
type Domain = (Road, Int, IOUArray Int Int, IOUArray Int Bool)
type Dist = Map Int Int
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

pairToElem :: (Int, Int) -> (Int, Map Int Int)
pairToElem (a, b) = (a, Map.singleton b 1)

pairToRevElem :: (Int, Int) -> (Int, Map Int Int)
pairToRevElem (a, b) = (b, Map.singleton a 1)

insertAll :: IOUArray Int Int -> [(Int, Int)] -> IO ()
insertAll arr [] = return ()
insertAll arr ((i, e):xs) = writeArray arr i e >> insertAll arr xs

parse :: IO Domain
parse = do
  [cities, roadsNumber] <- readChar8
  pairs <- replicateM roadsNumber getPair
  -- let [cities, roadsNumber] = [20000,20000]
  -- pairs <- gen
  visited <- newArray (1,cities) False
  let roads = fromListWith (Map.unionWith (+)) $ pairToElem <$> pairs
  pen <- newArray (1, cities) 0
  insertAll pen $ Map.toList $ ((+1) . sum . Map.elems) <$> roads
  let revRoads = fromListWith (Map.unionWith (+)) $ pairToRevElem <$> pairs
  return $ (revRoads, cities, pen, visited)

-- (dist, target)
dij :: Road -> (Set (Int, Int), IOUArray Int Int, IOUArray Int Bool) -> IO Int
dij roads (a, pen, visited) = go a-- traceShow ((d, i), newPen, que) $
  where
    go ::  Set (Int, Int) -> IO Int
    go que = do
       ((d, i), nQue) <- deleteFindMinNotMeet visited que
       writeArray visited i True
       let children = fromMaybe empty $ roads !? i
       _ <- traverseWithKey (\k v -> (\u -> writeArray pen k (u - v)) =<< readArray pen k) children
       childQue <- mapM (\j -> do
                  c <- readArray pen j
                  return (d + c, j)) $  Map.keys children
       let newQue = union nQue (Set.fromList childQue)
       if i == 1 then return d else go newQue

deleteFindMinNotMeet :: IOUArray Int Bool -> Set (Int, Int) -> IO ((Int, Int), Set (Int, Int))
deleteFindMinNotMeet visited que = do
  flag <- readArray visited i
  if flag then deleteFindMinNotMeet visited nQue else return ans
  where ans@((d, i), nQue) = deleteFindMin que

solve :: Solver
solve (roads, n, pen, visited) = dij roads (Set.singleton (0, n), pen, visited)

-- gen :: IO [(Int,Int)]
-- gen = do
--   xs :: [(Int, Int)] <- replicateM 20000 $ liftM2 (,) (randomRIO (1, 2*10^5)) (randomRIO (1, 2*10^5))
--   let path = take 19999 $ zip [1..] [2..]
--   return $ xs ++ path

main :: IO ()
main = do
  printAns =<< solve =<< parse

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)

-- road map in reverse, and the number of cities, init pen state
type Road = Map Int (Map Int Int)
type Domain = (Road, Int, Dist)
type Dist = Map Int Int
type CoDomain = Int
type Solver  = Domain -> CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

pairToElem :: (Int, Int) -> (Int, Map Int Int)
pairToElem (a, b) = (a, Map.singleton b 1)

pairToRevElem :: (Int, Int) -> (Int, Map Int Int)
pairToRevElem (a, b) = (b, Map.singleton a 1)

parse :: IO Domain
parse = do
  [cities, roadsNumber] <- readChar8
  pairs <- replicateM roadsNumber getPair
  let roads = fromListWith (Map.unionWith (+)) $ pairToElem <$> pairs
  let revRoads = fromListWith (Map.unionWith (+)) $ pairToRevElem <$> pairs
  return $ (revRoads, cities, ((+1) . sum . Map.elems) <$> roads)

-- (dist, target)
dij :: Road -> (Set (Int, Int), Dist, Set Int) -> Int
dij roads (que, pen, visited) = -- traceShow ((d, i), newPen, que) $
  if i == 1 then d else dij roads (newQue, newPen, Set.insert i visited)
  where ((d, i), nQue) = deleteFindMinNotMeet visited que
        children = Map.filter (`Set.notMember` visited) $ fromMaybe empty $ roads !? i
        childrenSet = Set.fromList $ Map.keys children
        newPen = Map.unionWith (-) pen children
        newQue = union (Set.map (\j -> (d + findWithDefault 0 j newPen, j)) childrenSet) nQue

deleteFindMinNotMeet :: Set Int -> Set (Int, Int) -> ((Int, Int), Set (Int, Int))
deleteFindMinNotMeet visited que = if i `Set.notMember` visited then ans else deleteFindMinNotMeet visited nQue
  where ans@((d, i), nQue) = deleteFindMin que

solve :: Solver
solve (roads, n, pen) = dij roads (Set.singleton (0, n), pen, Set.empty)

main :: IO ()
main = printAns <$> solve =<< parse


You are given two sequences $$$a_1, a_2, \dots, a_n$$$ and $$$b_1, b_2, \dots, b_n$$$. Each element of both sequences is either $$$0$$$, $$$1$$$ or $$$2$$$. The number of elements $$$0$$$, $$$1$$$, $$$2$$$ in the sequence $$$a$$$ is $$$x_1$$$, $$$y_1$$$, $$$z_1$$$ respectively, and the number of elements $$$0$$$, $$$1$$$, $$$2$$$ in the sequence $$$b$$$ is $$$x_2$$$, $$$y_2$$$, $$$z_2$$$ respectively.You can rearrange the elements in both sequences $$$a$$$ and $$$b$$$ however you like. After that, let's define a sequence $$$c$$$ as follows:$$$c_i = \begin{cases} a_i b_i & \mbox{if }a_i > b_i \\ 0 & \mbox{if }a_i = b_i \\ -a_i b_i & \mbox{if }a_i < b_i \end{cases}$$$You'd like to make $$$\sum_{i=1}^n c_i$$$ (the sum of all elements of the sequence $$$c$$$) as large as possible. What is the maximum possible sum?

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Each test case consists of two lines. The first line of each test case contains three integers $$$x_1$$$, $$$y_1$$$, $$$z_1$$$ ($$$0 \le x_1, y_1, z_1 \le 10^8$$$) — the number of $$$0$$$-s, $$$1$$$-s and $$$2$$$-s in the sequence $$$a$$$. The second line of each test case also contains three integers $$$x_2$$$, $$$y_2$$$, $$$z_2$$$ ($$$0 \le x_2, y_2, z_2 \le 10^8$$$; $$$x_1 + y_1 + z_1 = x_2 + y_2 + z_2 > 0$$$) — the number of $$$0$$$-s, $$$1$$$-s and $$$2$$$-s in the sequence $$$b$$$.

For each test case, print the maximum possible sum of the sequence $$$c$$$.

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

solve :: [Int] -> [Int] -> Int
solve a b = 2 * a2b1min - 2 * fuck
    where
        a2b1min = min a2 b1
        fuck = min mya1 myb2
        a0 = head a
        a1 = last $ take 2 a
        a2 = last a
        b0 = head b
        b1 = last $ take 2 b
        b2 = last b
        mya1 = a1 - min a1 b0
        myb2 = b2 - min a0 b2

deal :: IO()
deal = do
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    putStrLn $ show $ solve a b

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

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

testCase :: IO a -> IO ()
testCase f = do
  t <- read <$> getLine
  replicateM_ t f

main = testCase $ do
  [a0, a1, a2] <- map read . words <$> getLine
  [b0, b1, b2] <- map read . words <$> getLine
  print $ 2 * (min a2 b1 - max (b2 - max (a2 - b1) 0 - a0) 0)

import Control.Monad (replicateM_)

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [x1, y1, z1] <- map read . words <$> getLine :: IO [Int]
    [x2, y2, z2] <- map read . words <$> getLine
    let
      plus = min z1 y2 -- greedily pair a-2s with b-1s
      soaks = x1 + z1 - plus -- options for wasting a b-2
      minus = max 0 $ z2 - soaks
    print $ 2 * (plus - minus)

module Main where

import Control.Monad

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    let readSeq = fmap read . words <$> getLine
    firstSeq <- readSeq
    secondSeq <- readSeq
    print $ solve firstSeq secondSeq

solve :: [Int] -> [Int] -> Int
solve [x1, y1, z1] [x2, y2, z2] =
  let a = min z1 y2 -- number of pairs (2, 1)
      b = y1 - (x2 + y2 - a) -- minimum number of pairs (1, 2)
   in 2 * (a - max b 0)

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

solve :: [Int] -> [Int] -> Int
solve a b = 2 * a2b1min - 2 * fuck
    where
        a2b1min = min a2 b1
        fuck = min mya1 myb2
        a0 = head a
        a1 = last $ take 2 a
        a2 = last a
        b0 = head b
        b1 = last $ take 2 b
        b2 = last b
        mya1 = a1 - min a1 a0
        myb2 = b2 - min a0 b2

deal :: IO()
deal = do
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    putStrLn $ show $ solve a b

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

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

solve :: [Int] -> [Int] -> Int
solve a b = 2 * a2b1min
    where
        a2b1min = min a2 b1
        a2 = last a
        b1 = last $ take 2 b

deal :: IO()
deal = do
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    putStrLn $ show $ solve a b

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

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

solve :: [Int] -> [Int] -> Int
solve a b = 2 * a2b1min - 2 * fuck
    where
        a2b1min = min a2 b1
        fuck = min a1 b2 - min paira1  pairb2
        a0 = head a
        a1 = last $ take 2 a
        a2 = last a
        b0 = head b
        b1 = last $ take 2 b
        b2 = last b
        paira1 = min a1 b0
        pairb2 = min a0 b2

deal :: IO()
deal = do
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    putStrLn $ show $ solve a b

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