A championship is held in Berland, in which $$$n$$$ players participate. The player with the number $$$i$$$ has $$$a_i$$$ ($$$a_i \ge 1$$$) tokens.The championship consists of $$$n-1$$$ games, which are played according to the following rules:  in each game, two random players with non-zero tokens are selected;  the player with more tokens is considered the winner of the game (in case of a tie, the winner is chosen randomly);  the winning player takes all of the loser's tokens; The last player with non-zero tokens is the winner of the championship.All random decisions that are made during the championship are made equally probable and independently.For example, if $$$n=4$$$, $$$a = [1, 2, 4, 3]$$$, then one of the options for the game (there could be other options) is:   during the first game, the first and fourth players were selected. The fourth player has more tokens, so he takes the first player's tokens. Now $$$a = [0, 2, 4, 4]$$$;  during the second game, the fourth and third players were selected. They have the same number of tokens, but in a random way, the third player is the winner. Now $$$a = [0, 2, 8, 0]$$$;  during the third game, the second and third players were selected. The third player has more tokens, so he takes the second player's tokens. Now $$$a = [0, 0, 10, 0]$$$;  the third player is declared the winner of the championship. Championship winners will receive personalized prizes. Therefore, the judges want to know in advance which players have a chance of winning, i.e have a non-zero probability of winning the championship. You have been asked to find all such players.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case consists of one positive integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of players in the championship. The second line of each test case contains $$$n$$$ positive integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the number of tokens the players have. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print the number of players who have a nonzero probability of winning the championship. On the next line print the numbers of these players in increasing order. Players are numbered starting from one in the order in which they appear in the input.

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

import Data.Map((!))

minus x = -x

result list' = aux list $ sumPartial list where
	list = L.sortOn (minus . snd) $ zip [0..] list'

	sumPartial :: [(Integer, Integer)] -> [Integer]
	sumPartial [] = [0]
	sumPartial (x:[]) = [0]
	sumPartial (x:y:xs) = (snd y) + head l : l where l = sumPartial (y:xs)

	aux [] [] = []
	aux (x:xs) (y:ys)
		| (snd x) > y = [fst x]
		| otherwise = fst x : aux xs ys

showR (x:xs) = show (x+1) ++ " " ++ showR xs
showR [] = []

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		let val = result a
		print $ length val
		putStrLn $ showR $ L.sort val
		loop $ t - 1
	loop t

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

import Data.Int
import qualified Data.Map.Strict as M

type SIO = StateT P.ByteString IO

(*!) :: Int -> Int -> Int64
x *! y = fromIntegral x * fromIntegral y
infixl 7 *!

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    let
      --valCtMap = [(head vs, length vs) | vs <- group $ sort a]
      valCtMap = M.assocs $ M.fromListWith (+) $ zip a $ repeat 1
      totsBelow = scanl (\x (v, ct) -> x + v *! ct) 0 valCtMap
      cutoff = last
        $ [v | ((v, _ct), tot) <- zip valCtMap totsBelow, fromIntegral v > tot]
      ans = [i | (i, ai) <- zip [1..] a, ai >= cutoff]
    putInts [length ans]
    putInts ans

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

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

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

import 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

import Data.Int

type SIO = StateT P.ByteString IO

(*!) :: Int -> Int -> Int64
x *! y = fromIntegral x * fromIntegral y
infixl 7 *!

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    let
      valCtMap = [(head vs, length vs) | vs <- group $ sort a]
      totsBelow = scanl (\x (v, ct) -> x + v *! ct) 0 valCtMap
      cutoff = last
        $ [v | ((v, _ct), tot) <- zip valCtMap totsBelow, fromIntegral v > tot]
      ans = [i | (i, ai) <- zip [1..] a, ai >= cutoff]
    putInts [length ans]
    putInts ans

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

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

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

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

import Control.Applicative
import Control.Exception (assert)
import Control.Monad
import Control.Monad.State
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Bits
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ord
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.concat <$> replicateM t run1

run1 = do
  n <- popInt
  as <- popIntegers
  let ans = solve n as
  return $ B.unlines [bshow (length ans), B.unwords $ map bshow ans]

solve :: Int -> [Integer] -> [Int]
solve n as = map fst $ filter ((>= thre) . snd) $ zip [1..] as
  where
    counts :: Array Int (Integer, Int)
    counts = let l = countList as in
               listArray (0, length l - 1) l

    ncounts = snd (bounds counts) + 1

    thre | ok 0 = fst $ counts ! 0
         | otherwise = go 0 (ncounts - 1)

    go i j | j - i == 1 = fst $ counts ! j
           | otherwise = let k = (i + j) `quot` 2 in
                           if ok k
                           then go i k
                           else go k j

    ok i = let s = sum $
                   map ((\(a, c) -> a * (fromIntegral c)) . (counts !)) $
                   [0 .. i] in
             okgo s $ map (counts !) [i + 1 .. ncounts - 1]

    okgo _ [] = True
    okgo s ((a, c) : as) | s >= a = okgo (s + a * (fromIntegral c)) as
                         | otherwise = False

countList :: (Ord a) => [a] -> [(a, Int)]
countList xs = Map.assocs $ foldl' addm Map.empty xs
  where
    addm m x | Map.member x m = Map.adjust (+ 1) x m
             | otherwise = Map.insert x 1 m

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.List
import Data.Int

--getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

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

solve' :: Builder -> Int -> [Int] -> Builder
solve' buf 0 _ = buf
solve' buf nt (n:a) = solve' (buf <> f <> char7 '\n') (pred nt) c
  where
    (b, c) = splitAt n a
    d = sort $ zip b [1 ..]
    e :: [Int64]
    e = scanl1 (+) $ map (fromIntegral . fst) d
    f :: Builder
    l = succ $ length $ takeWhile (\((u, j), v) -> (fromIntegral u) <= v) $ zip (reverse d) (tail $ reverse e)
    g' = map snd $ take l $ reverse d
    --g' = map (snd.fst) $ takeWhile (\((u, j), v) -> (fromIntegral u) <= v) $ zip (reverse d) (tail $ reverse e)
    --u = snd $ last d
    g = map intDec $ sort g'
    --g = map intDec $ map (snd.fst) $ takeWhile (\((u, j), v) -> (fromIntegral u ) >= v) $ reverse $ zip d (e ++ [-1])
    f = intDec (length g) <> char7 '\n' <> (mconcat $ intersperse (char7 ' ') g)

solve :: [Int] -> Builder
solve (n:a) = solve' mempty n a

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents

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

import Data.Map((!))

type PrioQueue = M.Map Integer [Integer]
insert :: Integer -> Integer -> PrioQueue -> PrioQueue
insert prio val queue = case M.lookup prio queue of
	Just l -> M.insert prio (val:l) queue
	Nothing -> M.insert prio [val] queue

delete :: Integer -> Integer -> PrioQueue -> PrioQueue
delete prio val queue = case M.lookup prio queue of
	Just (x:[]) -> M.delete prio queue
	Just l -> M.insert prio (L.delete val l) queue

findMax :: PrioQueue -> (Integer, Integer)
findMax queue = case M.findMax queue of
	(k, v:l) -> (k, v)

result arrayM
	| v > sumOther = [(k, v)]
	| otherwise = (k, v) : result arrayM'
	where
		(v, k) = findMax arrayM
		sumOther = M.foldrWithKey (\k l i ->i + k * toInteger (length l) ) 0 arrayM'
		arrayM' = delete v k arrayM

showR ((x, _):xs) = show (x+1) ++ " " ++ showR xs
showR [] = []

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		let val = result $ foldr (\(ai, i) m -> insert ai i m) M.empty $ zip a [0..]
		print $ length val
		putStrLn $ showR val
		loop $ t - 1
	loop t

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

import Data.Map((!))

result arrayM
	| null arrayM = []
	| v > sumOther = [(k, v)]
	| otherwise = (k, v) : result arrayM'
	where
		(k, v) = M.findMin arrayM
		sumOther = foldr (+) 0 arrayM'
		arrayM' = M.delete k arrayM

showR ((x, _):xs) = show (x+1) ++ " " ++ showR xs
showR [] = []

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		let val = result $ M.fromList $ zip [0..] a
		print $ length val
		putStrLn $ showR val
		loop $ t - 1
	loop t


A country called Berland consists of n cities, numbered with integer numbers from 1 to n. Some of them are connected by bidirectional roads. Each road has some length. There is a path from each city to any other one by these roads. According to some Super Duper Documents, Berland is protected by the Super Duper Missiles. The exact position of the Super Duper Secret Missile Silos is kept secret but Bob managed to get hold of the information. That information says that all silos are located exactly at a distance l from the capital. The capital is located in the city with number s.The documents give the formal definition: the Super Duper Secret Missile Silo is located at some place (which is either city or a point on a road) if and only if the shortest distance from this place to the capital along the roads of the country equals exactly l.Bob wants to know how many missile silos are located in Berland to sell the information then to enemy spies. Help Bob.

The first line contains three integers n, m and s (2 ≤ n ≤ 105, , 1 ≤ s ≤ n) — the number of cities, the number of roads in the country and the number of the capital, correspondingly. Capital is the city no. s.  Then m lines contain the descriptions of roads. Each of them is described by three integers vi, ui, wi (1 ≤ vi, ui ≤ n, vi ≠ ui, 1 ≤ wi ≤ 1000), where vi, ui are numbers of the cities connected by this road and wi is its length. The last input line contains integer l (0 ≤ l ≤ 109) — the distance from the capital to the missile silos. It is guaranteed that:    between any two cities no more than one road exists;  each road connects two different cities;  from each city there is at least one way to any other city by the roads.

Print the single number — the number of Super Duper Secret Missile Silos that are located in Berland.

NoteIn the first sample the silos are located in cities 3 and 4 and on road (1, 3) at a distance 2 from city 1 (correspondingly, at a distance 1 from city 3).In the second sample one missile silo is located right in the middle of the road (1, 2). Two more silos are on the road (4, 5) at a distance 3 from city 4 in the direction to city 5 and at a distance 3 from city 5 to city 4.

import Prelude
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.String
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe
import Data.Array.IO
import qualified Data.Foldable as F
--import Debug.Trace

type AdjMap = M.Map Int [(Int, Int)]

adjacencyList :: [[Int]] -> AdjMap
adjacencyList edges = F.foldl' insertEdge M.empty edges
  where insertEdge m [u, v, w] = let m1 = M.insertWith' (\[a] b -> (a:b)) u [(v, w)] m
                                 in M.insertWith' (\[a] b -> (a:b)) v [(u, w)] m1

twomil :: Int
twomil = 2000000000

updateNodeDist :: Int -> IOArray Int Int -> IOArray Int Bool -> S.Set (Int, Int) -> (Int, Int) -> IO (S.Set (Int, Int))
updateNodeDist currDist distances isVisited prioQ (node, wt) = do isVis <- readArray isVisited node
                                                                  oldDist <- readArray distances node
                                                                  if isVis || (currDist + wt >= oldDist)
                                                                    then return prioQ
                                                                    else do writeArray distances node (currDist + wt)
                                                                            let newPrio = S.insert (currDist + wt, node) prioQ
                                                                            return newPrio

getMinNode :: S.Set (Int, Int) -> IOArray Int Bool -> IO ((Int, Int), S.Set (Int, Int))
getMinNode prioQ isVisited = do if S.null prioQ
                                  then return ((-1, -1), S.empty)
                                  else do let ((minDist, minNode), newPrioQ) = S.deleteFindMin prioQ
                                          isVis <- readArray isVisited minNode
                                          if isVis
                                            then getMinNode newPrioQ isVisited
                                            else return ((minDist, minNode), newPrioQ)

-- strict version of foldlM taken from stackoverflow.com
foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

dijkstra' :: AdjMap -> IOArray Int Int -> IOArray Int Bool -> S.Set (Int, Int) -> IO ()
dijkstra' adjmap distances isVisited prioQ = do
  ((currDist, minNode), newPrioQ) <- getMinNode prioQ isVisited
  if minNode == (-1)
    then return ()
    else do let nbhrs = M.findWithDefault [] minNode adjmap
            updatedPrioQ <- foldM' (updateNodeDist currDist distances isVisited) newPrioQ nbhrs
            writeArray isVisited minNode True
            dijkstra' adjmap distances isVisited updatedPrioQ

dijkstra :: AdjMap -> Int -> Int -> IO (IOArray Int Int)
dijkstra adjmap capital n = do let prioQ = S.insert (0, capital) $ S.fromList [(twomil, k) | k <- [1..n], k /= capital]
                               isVisited <- newArray (1, n) False
                               distances <- newArray (1, n) twomil
                               writeArray distances capital 0
                               dijkstra' adjmap distances isVisited prioQ
                               return distances

solve :: Int -> Int -> [[Int]] -> Int -> IO Int
solve n capital edges dist = do
  let adjmap = adjacencyList edges
  distances <- dijkstra adjmap capital n -- find shortest paths to all nodes from capital
  myDists <- getAssocs distances
  let eq = length $ filter (\(a, b) -> b == dist) myDists
      myTuple u v wt distU = if u < v
                             then (u, v, dist - distU)
                             else (v, u, wt - (dist - distU))
      processEdge [u, v, w] = do
        distU <- readArray distances u
        distV <- readArray distances v
        let uTov = [myTuple u v w distU]
        if distU < dist && dist < distU + w && dist <= distU + w - dist + distV
          then return uTov
          else return []
  candidates <- mapM (\[u, v, w] -> do a1 <- processEdge [u, v, w]
                                       a2 <- processEdge [v, u, w]
                                       return $ a1 ++ a2) edges
  let nubbedValid = S.toList $ S.fromList $ concat candidates
  return $ eq + length nubbedValid

readInts :: BS.ByteString -> [Int]
readInts bs = map (fst.fromJust.BS.readInt) myWords
  where myWords = BS.words bs

main = do
  input <- BS.getContents
  let inputLines = BS.lines input
      [n, m, capital] = readInts $ head inputLines
      edges = map readInts $ take m $ tail inputLines
      dist = fst $ fromJust $ BS.readInt $ last inputLines
  silos <- solve n capital edges dist
  putStrLn $ show silos

  -- [n, m, capital] <- fmap (map read.words) getLine
  -- edges <- replicateM m $ fmap (map read.words) getLine
  -- dist <- fmap read getLine
  -- silos <- solve n capital edges dist
  -- putStrLn $ show silos

import Control.Monad
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe
import Data.Array.IO
import qualified Data.Foldable as F

type AdjMap = M.Map Int [(Int, Int)]

adjacencyList :: [[Int]] -> AdjMap
adjacencyList edges = foldl insertEdge M.empty edges
  where insertEdge m [u, v, w] = let m1 = M.insertWith' (\[a] b -> (a:b)) u [(v, w)] m
                                 in M.insertWith' (\[a] b -> (a:b)) v [(u, w)] m1

twomil :: Int
twomil = 2000000000

updateNodeDist :: Int -> IOArray Int Int -> IOArray Int Bool -> S.Set (Int, Int) -> (Int, Int) -> IO (S.Set (Int, Int))
updateNodeDist currDist distances isVisited prioQ (node, wt) = do isVis <- readArray isVisited node
                                                                  oldDist <- readArray distances node
                                                                  if isVis || (currDist + wt >= oldDist)
                                                                    then return prioQ
                                                                    else do writeArray distances node (currDist + wt)
                                                                            let newPrio = S.insert (currDist + wt, node) prioQ
                                                                            return newPrio

getMinNode :: S.Set (Int, Int) -> IOArray Int Bool -> IO ((Int, Int), S.Set (Int, Int))
getMinNode prioQ isVisited = do if S.null prioQ
                                  then return ((-1, -1), S.empty)
                                  else do let ((minDist, minNode), newPrioQ) = S.deleteFindMin prioQ
                                          isVis <- readArray isVisited minNode
                                          if isVis
                                            then getMinNode newPrioQ isVisited
                                            else return ((minDist, minNode), newPrioQ)

dijkstra' :: AdjMap -> IOArray Int Int -> IOArray Int Bool -> S.Set (Int, Int) -> IO ([(Int, Int)])
dijkstra' adjmap distances isVisited prioQ = do
  ((currDist, minNode), newPrioQ) <- getMinNode prioQ isVisited
  if minNode == (-1)
    then getAssocs distances
    else do let nbhrs = M.findWithDefault [] minNode adjmap
            updatedPrioQ <- F.foldlM (updateNodeDist currDist distances isVisited) newPrioQ nbhrs
            writeArray isVisited minNode True
            dijkstra' adjmap distances isVisited updatedPrioQ

dijkstra :: AdjMap -> Int -> Int -> IO ([(Int, Int)])
dijkstra adjmap capital n = do let prioQ = S.insert (0, capital) $ S.fromList [(twomil, k) | k <- [1..n], k /= capital]
                               isVisited <- newArray (1, n) False
                               distances <- newArray (1, n) twomil
                               writeArray distances capital 0
                               dijkstra' adjmap distances isVisited prioQ

solve :: Int -> Int -> [[Int]] -> Int -> IO Int
solve n capital edges dist = do
  let adjmap = adjacencyList edges
  distances <- dijkstra adjmap capital n
  let candidatesT = filter (\(a, b) -> b <= dist) distances
      eq = length $ filter (\(a, b) -> b == dist) candidatesT
      candidates = filter (\(a, b) -> b < dist) distances
      validCandidates = do
        (c, minDist) <- candidates
        let myEdges = M.findWithDefault [(0,0)] c adjmap
            myTuple u v wt minDist dist = if u < v
                                          then (u, v, dist - minDist)
                                          else (v, u, wt - (dist - minDist))
        v <- map (\(node, wt) -> if minDist + wt > dist
                                 then myTuple c node wt minDist dist
                                 else (0, 0, 0)) myEdges
        guard $ v /= (0, 0, 0)
        return [v]
      nubbedValid = S.toList $ S.fromList validCandidates
  return $ eq + length nubbedValid

main = do
  [n, m, capital] <- fmap (map read.words) getLine
  edges <- replicateM m $ fmap (map read.words) getLine
  dist <- fmap read getLine
  silos <- solve n capital edges dist
  putStrLn $ show silos


Skier rides on a snowy field. Its movements can be described by a string of characters 'S', 'N', 'W', 'E' (which correspond to $$$1$$$ meter movement in the south, north, west or east direction respectively).It is known that if he moves along a previously unvisited segment of a path (i.e. this segment of the path is visited the first time), then the time of such movement is $$$5$$$ seconds. If he rolls along previously visited segment of a path (i.e., this segment of the path has been covered by his path before), then it takes $$$1$$$ second.Find the skier's time to roll all the path.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. Each set is given by one nonempty string of the characters 'S', 'N', 'W', 'E'. The length of the string does not exceed $$$10^5$$$ characters. The sum of the lengths of $$$t$$$ given lines over all test cases in the input does not exceed $$$10^5$$$.

For each test case, print the desired path time in seconds.

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

type Coord = (Int,Int)
type Path = (Coord,Coord)
type Cost = Int
type State =  (S.Set Path, Coord)
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    s <- getLine
    print $ solve s

f :: State -> Char -> (State, Cost)
f (set ,(x,y)) char
  | path `S.member` set || (swap path `S.member` set) = ((set,newCoord),1)
  | otherwise = ((S.insert path set,newCoord),5)
  where
    newCoord = case char of
      'W' -> (x-1,y)
      'E' -> (x+1,y)
      'S' -> (x,y-1)
      'N' -> (x,y+1)
      _ -> undefined
    path = ((x,y),newCoord)
solveWith :: State -> String -> Int
solveWith _ [] = 0
solveWith s (x:xs) = cost + solveWith state xs
  where
    (state,cost) = f s x

solve :: String -> Int
solve = solveWith (S.empty,(0,0))


As usual, Sereja has array a, its elements are integers: a[1], a[2], ..., a[n]. Let's introduce notation:A swap operation is the following sequence of actions:  choose two indexes i, j (i ≠ j);  perform assignments tmp = a[i], a[i] = a[j], a[j] = tmp. What maximum value of function m(a) can Sereja get if he is allowed to perform at most k swap operations?

The first line contains two integers n and k (1 ≤ n ≤ 200; 1 ≤ k ≤ 10). The next line contains n integers a[1], a[2], ..., a[n] ( - 1000 ≤ a[i] ≤ 1000).

In a single line print the maximum value of m(a) that Sereja can get if he is allowed to perform at most k swap operations.

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

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i
    where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

main = do
    (n,k) <- readIntPair
    as <- readInts
    print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve n k as = maximum $ [ sub l r | l <- [1..n], r <- [l..n] ]
    where
    sub l r = sum (zipWith max xs1 ys ++ xs2)
        where
        (a,as') = splitAt (l-1) as
        (b,c) = splitAt (r - l + 1) as'
        k' = minimum [k,(length b),(length $ a ++ c)]
        (xs1,xs2) = splitAt k' (sort $ b)
        ys = take k' $ reverse $ sort $ a ++ c

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Data.List

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

solve :: Int -> Int -> [Int] -> Int
solve n k xs = maximum[calc (sort xs1) (sortBy(flip compare)$xs0++xs2)|i<-[0..n-1],j<-[i..n-1],let(xs0,xs')=splitAt i xs,let(xs1,xs2)=splitAt(j-i+1)xs']
 where
   calc :: [Int] ->[Int] -> Int
   calc xs ys = go k 0 xs ys
    where
      go 0 !acc xs ys = acc + sum xs
      go k acc (x:xs) (y:ys)
        | x < y = go (k-1) (acc+y) xs ys
        | otherwise = acc + sum (x:xs)
      go k acc xs _ = acc + sum xs

import Text.Printf
import Data.List as List

combinations list1 list2 = [(a, b) | a <- list1, b <- list2]

splitAt2 :: [Int] -> (Int, Int) -> ([Int], [Int], [Int])
splitAt2 list (s1, s2) =
    let
        (l1, l23) = splitAt s1 list
        (l2, l3) = splitAt (s2 - s1) l23
    in
        (l1, l2, l3)

solve :: Int -> Int -> [Int] -> Int
solve n k input =
    let
        subsegments = filter (\(l, r) -> l < r) $ combinations [0..n] [0..n]

        test (l1, l2, l3) =
            let
                taken = sort l2
                rest = reverse $ sort $ l1 ++ l3

                takenSum = sum taken

                substitutes = takeWhile (\(old, new) -> old < new) $ take k $ zip taken rest
            in
                takenSum + foldl (\acc (old, new) -> acc + new - old) 0 substitutes
    in
        maximum $ map test $ map (splitAt2 input) $ subsegments

main :: IO ()
main = do
  --n <- readLn :: IO Int
  content <- getContents
  let
    input = map (read::String->Int) $ words $ unwords $ lines content
    ans = solve (head input) (head $ tail input) (tail $ tail input)
  putStrLn $ show $ ans


Vika has n jars with paints of distinct colors. All the jars are numbered from 1 to n and the i-th jar contains ai liters of paint of color i.Vika also has an infinitely long rectangular piece of paper of width 1, consisting of squares of size 1 × 1. Squares are numbered 1, 2, 3 and so on. Vika decided that she will start painting squares one by one from left to right, starting from the square number 1 and some arbitrary color. If the square was painted in color x, then the next square will be painted in color x + 1. In case of x = n, next square is painted in color 1. If there is no more paint of the color Vika wants to use now, then she stops.Square is always painted in only one color, and it takes exactly 1 liter of paint. Your task is to calculate the maximum number of squares that might be painted, if Vika chooses right color to paint the first square.

The first line of the input contains a single integer n (1 ≤ n ≤ 200 000) — the number of jars with colors Vika has. The second line of the input contains a sequence of integers a1, a2, ..., an (1 ≤ ai ≤ 109), where ai is equal to the number of liters of paint in the i-th jar, i.e. the number of liters of color i that Vika has.

The only line of the output should contain a single integer — the maximum number of squares that Vika can paint if she follows the rules described above.

NoteIn the first sample the best strategy is to start painting using color 4. Then the squares will be painted in the following colors (from left to right): 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5.In the second sample Vika can start to paint using any color.In the third sample Vika should start painting using color number 5.

import Data.List
main = do
    n <- readLn :: IO Integer
    a <- fmap ((map read) . words) getLine :: IO[Integer]
    let mn = minimum a
        (_,ls) = unzip . filter (\(x,y) -> x==mn) . zip a $ [1..]
        zl = zipWith (\x y -> y-x-1) ls $ (tail ls)
        lmx = if zl==[] then 0 else maximum zl
        fst = head ls
        lst = last ls
        ans = max lmx (n-(lst-fst+1))
    print $ n*mn + ans

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

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

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

main = do
  n <- readLn
  as :: [Int64] <- map fromIntegral <$> getInts

  let
    m = minimum as
    bs = map (\x -> x-m) as

    p = min n $ maximum $ map genericLength $ splitOn [0] $ bs ++ bs

  print $ m*n + p

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8       as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap                 as IM
import qualified Data.IntSet                 as IS
import           Data.List
import qualified Data.Map                    as M
import           Data.Ord
import qualified Data.Set                    as S
import           Data.STRef
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Data.Word
import           Debug.Trace

main :: IO ()
main = do
    n <- readLn :: IO Int
    xs <- U.unfoldrN n (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print $ solve $ U.map fromIntegral xs

solve :: U.Vector Int64 -> Int64
solve xs = len * m + U.maximum zs
  where
    len = fromIntegral $ U.length xs
    m = U.minimum xs
    ys = U.map (subtract m) xs
    zs = U.scanl (\acc x->if x==0 then 0 else acc+1) 0 $ ys U.++ ys

readInt :: String -> Int
readInt = read

f :: [Int] -> Integer
f a = l*m' + extra
    where
        l = toInteger $ length a
        m = minimum a
        m' = toInteger m
        b = map (\x->x-m) a
        c = scanl (\acc x -> if x == 0 then 0 else acc+1) 0 $ b ++ b
        extra = toInteger $ maximum c

main = do
    n <- readLn :: IO Int
    line <-  getLine
    let a = map readInt $ words line
    print (f a)

import Data.List
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let mn = minimum a
        (_,ls) = unzip . filter (\(x,y) -> x==mn) . zip a $ [1..]
        zl = zipWith (\x y -> y-x-1) ls $ (tail ls)
        lmx = if zl==[] then 0 else maximum zl
        fst = head ls
        lst = last ls
        ans = max lmx (n-(lst-fst+1))
    print $ n*mn + ans

import Data.List
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let mn = minimum a
        (_,ls) = unzip . filter (\(x,y) -> x==mn) . zip a $ [1..]
        ans = n*mn + (fn n (ls ++ [head ls]) 0)
    print ans

fn n (x:y:[]) mx = max mx (n + (y-x-1))
fn n (x:y:xs) mx =
    let seglen = (y-x-1)
    in fn n (y:xs) (max seglen mx)

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

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

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

main = do
  n <- readLn
  as <- getInts

  let
    m = minimum as
    bs = map (\x -> x-m) as

    p = min n $ maximum $ map length $ splitOn [0] $ bs ++ bs

  print $ m*n + p

readInt :: String -> Int
readInt = read

f :: [Int] -> Int
f a = l*m + extra
    where
        l = length a
        m = minimum a
        b = map (\x->x-m) a
        c = scanl (\acc x -> if x == 0 then 0 else acc+1) 0 $ b ++ b
        extra = maximum c

main = do
    n <- readLn :: IO Int
    line <-  getLine
    let a = map readInt $ words line
    print (f a)


Polycarp likes numbers that are divisible by 3.He has a huge number $$$s$$$. Polycarp wants to cut from it the maximum number of numbers that are divisible by $$$3$$$. To do this, he makes an arbitrary number of vertical cuts between pairs of adjacent digits. As a result, after $$$m$$$ such cuts, there will be $$$m+1$$$ parts in total. Polycarp analyzes each of the obtained numbers and finds the number of those that are divisible by $$$3$$$.For example, if the original number is $$$s=3121$$$, then Polycarp can cut it into three parts with two cuts: $$$3|1|21$$$. As a result, he will get two numbers that are divisible by $$$3$$$.Polycarp can make an arbitrary number of vertical cuts, where each cut is made between a pair of adjacent digits. The resulting numbers cannot contain extra leading zeroes (that is, the number can begin with 0 if and only if this number is exactly one character '0'). For example, 007, 01 and 00099 are not valid numbers, but 90, 0 and 10001 are valid.What is the maximum number of numbers divisible by $$$3$$$ that Polycarp can obtain?

The first line of the input contains a positive integer $$$s$$$. The number of digits of the number $$$s$$$ is between $$$1$$$ and $$$2\cdot10^5$$$, inclusive. The first (leftmost) digit is not equal to 0.

Print the maximum number of numbers divisible by $$$3$$$ that Polycarp can get by making vertical cuts in the given number $$$s$$$.

NoteIn the first example, an example set of optimal cuts on the number is 3|1|21.In the second example, you do not need to make any cuts. The specified number 6 forms one number that is divisible by $$$3$$$.In the third example, cuts must be made between each pair of digits. As a result, Polycarp gets one digit 1 and $$$33$$$ digits 0. Each of the $$$33$$$ digits 0 forms a number that is divisible by $$$3$$$.In the fourth example, an example set of optimal cuts is 2|0|1|9|201|81. The numbers $$$0$$$, $$$9$$$, $$$201$$$ and $$$81$$$ are divisible by $$$3$$$.

import Data.List

toint s = (read s) :: Integer

doit [] t = 0
doit (x:xs) t
    | mod x 3 == 0            = 1 + doit xs 0
    | t == 3                  = 1 + doit xs 0
    | mod x 3 == 1 && t == 0  = doit xs 1
    | mod x 3 == 1 && t == 1  = doit xs 3
    | mod x 3 == 1 && t == 2  = 1 + doit xs 0
    | mod x 3 == 2 && t == 0  = doit xs 2
    | mod x 3 == 2 && t == 1  = 1 + doit xs 0
    | mod x 3 == 2 && t == 2  = doit xs 3

solve::String -> String
solve ss =
    let d = map (\x -> toint [x]) (reverse (tail (reverse ss))) in
    let r = doit d 0 in
    (show r) ++ "\n"

main = do
  interact $ solve

import Data.Char as Char

g :: [Int] -> Int
g [] = 0
g [0] = 1
g [_] = 0
g (0:xs) = 1+(g xs)
g [_,0] = 1
g [x,y] = fromEnum $ (x+y)==3
g (_:0:lat) = 1 + (g lat)
g (x:y:z:lat)
 |(x+y)==3 = 1 + (g (z:lat))
 |otherwise = 1 + (g lat)

main :: IO ()
main = do
  line <- getLine
  let line' = map ((flip mod 3).(Char.digitToInt)) line
  print $ g line'


You are given $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$, where $$$n$$$ is odd. You are allowed to flip the sign of some (possibly all or none) of them. You wish to perform these flips in such a way that the following conditions hold:  At least $$$\frac{n - 1}{2}$$$ of the adjacent differences $$$a_{i + 1} - a_i$$$ for $$$i = 1, 2, \dots, n - 1$$$ are greater than or equal to $$$0$$$.  At least $$$\frac{n - 1}{2}$$$ of the adjacent differences $$$a_{i + 1} - a_i$$$ for $$$i = 1, 2, \dots, n - 1$$$ are less than or equal to $$$0$$$. Find any valid way to flip the signs. It can be shown that under the given constraints, there always exists at least one choice of signs to flip that satisfies the required condition. If there are several solutions, you can find any of them.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \le t \le 500$$$)  — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$3 \le n \le 99$$$, $$$n$$$ is odd)  — the number of integers given to you. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$)  — the numbers themselves. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10000$$$.

For each test case, print $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$, corresponding to the integers after flipping signs. $$$b_i$$$ has to be equal to either $$$a_i$$$ or $$$-a_i$$$, and of the adjacent differences $$$b_{i + 1} - b_i$$$ for $$$i = 1, \dots, n - 1$$$, at least $$$\frac{n - 1}{2}$$$ should be non-negative and at least $$$\frac{n - 1}{2}$$$ should be non-positive. It can be shown that under the given constraints, there always exists at least one choice of signs to flip that satisfies the required condition. If there are several solutions, you can find any of them.

NoteIn the first test case, the difference $$$(-4) - (-2) = -2$$$ is non-positive, while the difference $$$3 - (-4) = 7$$$ is non-negative.In the second test case, we don't have to flip any signs. All $$$4$$$ differences are equal to $$$0$$$, which is both non-positive and non-negative.In the third test case, $$$7 - (-4)$$$ and $$$4 - (-6)$$$ are non-negative, while $$$(-4) - (-2)$$$ and $$$(-6) - 7$$$ are non-positive.

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

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  putStrLn $ unwords . map show $ solve as

solve (a1 : a2 : as) = abs a1 : - abs a2 : solve as
solve as = abs <$> as

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

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  putStrLn $ unwords . map show $ solve as

solve (a1 : a2 : as) = abs a1 : - abs a2 : solve as
solve as = as


The New Year holidays are over, but Resha doesn't want to throw away the New Year tree. He invited his best friends Kerim and Gural to help him to redecorate the New Year tree.The New Year tree is an undirected tree with n vertices and root in the vertex 1.You should process the queries of the two types:  Change the colours of all vertices in the subtree of the vertex v to the colour c.  Find the number of different colours in the subtree of the vertex v.

The first line contains two integers n, m (1 ≤ n, m ≤ 4·105) — the number of vertices in the tree and the number of the queries. The second line contains n integers ci (1 ≤ ci ≤ 60) — the colour of the i-th vertex. Each of the next n - 1 lines contains two integers xj, yj (1 ≤ xj, yj ≤ n) — the vertices of the j-th edge. It is guaranteed that you are given correct undirected tree. The last m lines contains the description of the queries. Each description starts with the integer tk (1 ≤ tk ≤ 2) — the type of the k-th query. For the queries of the first type then follows two integers vk, ck (1 ≤ vk ≤ n, 1 ≤ ck ≤ 60) — the number of the vertex whose subtree will be recoloured with the colour ck. For the queries of the second type then follows integer vk (1 ≤ vk ≤ n) — the number of the vertex for which subtree you should find the number of different colours.

For each query of the second type print the integer a — the number of different colours in the subtree of the vertex given in the query. Each of the numbers should be printed on a separate line in order of query appearing in the input.

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, liftM2, when, foldM, liftM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (accumArray, elems, (!), array, listArray, elems, bounds)
import Data.Array (Array)
import Data.Array.MArray.Safe (newArray, newArray_, readArray, writeArray, freeze, getBounds)
import Data.Array.ST.Safe (STUArray, runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftR, xor, bit, popCount)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64, Int8)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Tuple (swap)
import Data.List (unfoldr)
import Data.Char (isSpace)

data Op = UpdateOp !Int !Int8 | QueryOp !Int

op [1, v, c] = UpdateOp v (fromIntegral c)
op [2, v] = QueryOp v

type STree s = (STUArray s Int Int64, STUArray s Int Int8)

forceM :: Monad m => m a -> m a
forceM m = do v <- m; return $! v

(<$!>) :: Monad m => (a -> b) -> m a -> m b
f <$!> m = liftM f (forceM m)

build :: UArray Int Int -> ST s (STree s)
build l = do
  let n = snd (bounds l)

  a <- newArray_ (1, 2*n-1)
  forM_ [n..2*n-1] $ \i -> writeArray a i (bit (l!(i-n+1)))

  forM_ [n-1,n-2..1] $ \i ->
    liftM2 (.|.) (readArray a $ 2*i) (readArray a $ 2*i+1) >>= writeArray a i

  b <- newArray (1, 2*n-1) 0

  return (a, b)

size :: (STree s) -> ST s Int
size t@(a, _) = do
  (_, l) <- getBounds a
  return $ l`div`2 + 1

pushDown :: (STree s) -> Int -> ST s ()
pushDown t@(a, b) i0 = push $ m-2
  where
    m = until (\s -> i0 `shiftR` s == 1) (+1) 0

    push (-2) = return ()
    push (-1) = return ()
    push s = do
      let i = i0 `shiftR` s
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then do
          let
            vv = bit $ fromIntegral v
            ii = i `xor` 1
          writeArray a i vv >> writeArray a ii vv
          writeArray b i v >> writeArray b ii v
          writeArray b j 0
      else return ()

      push $ s-1

update :: (STree s) -> Int -> Int -> Int8 -> ST s ()
update t@(a, b) l r v = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)

    pushDown t l' >> pushDown t r' >>
      loop l' r' >>
        popUp l' >> popUp r'
  where
    loop l r
      | l > r = return ()
      | odd l = write l v >> loop (l+1) r
      | even r = write r v >> loop l (r-1)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)
      where
        write i v = writeArray a i (bit $ fromIntegral v) >> writeArray b i (fromIntegral v)

    popUp 1 = return ()
    popUp i = do
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then writeArray a j (bit $ fromIntegral v)
        else liftM2 (.|.) (readArray a i) (readArray a (i `xor` 1)) >>= writeArray a j
      popUp $ i `shiftR` 1

query :: (STree s) -> Int -> Int -> ST s Int64
query t@(a, b) l r = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)
    pushDown t l' >> pushDown t r' >> loop l' r'
  where
    loop l r
      | l > r = return 0
      | odd l = liftM2 (.|.) (readArray a l) (loop (l+1) r)
      | even r = liftM2 (.|.) (loop l (r-1)) (readArray a r)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)

readInts = unfoldr (B.readInt . B.dropWhile isSpace)
getInts = readInts <$> B.getLine

main = do
  [n, m] <- getInts
  cs <- getInts
  es <- replicateM (n-1) $ ((\[a, b] -> (a, b)) <$> getInts)
  qs <- replicateM m $ (op <$> getInts)

  let
    p :: (UArray Int Int, UArray Int Int)
    p@(ins, outs) = runST $ do
        ins <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        outs <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        cr <- newSTRef 0

        let
          dfs w u = do
              modifySTRef cr (+1)
              readSTRef cr >>= \c -> writeArray ins u c
              mapM_ (dfs u) vs
              readSTRef cr >>= \c -> writeArray outs u c
            where
              vs = filter (/= w) $ g!u

        dfs 0 1

        liftM2 (,) (freeze ins) (freeze outs)
      where
        g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es :: Array Int [Int]

    range v = (ins!v, outs!v)

    cs' = array (1, n) $ map swap $ zip cs (elems ins) :: UArray Int Int

    solve :: [Int8]
    solve = runST $ do
      t <- build cs' :: ST s ((STUArray s Int Int64), (STUArray s Int Int8))

      let
        handle [] = return []
        handle ((UpdateOp v c):ops) = do
            update t l r c
            handle ops
          where (l, r) = range v
        handle ((QueryOp v):ops) = do
            c <- query t l r
            let !r = fromIntegral $ popCount c
            (r:) <$> handle ops
          where (l, r) = range v

      handle qs

  putStrLn . unlines . map show $ filter (/= 0) solve

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, liftM2, when, foldM, liftM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (accumArray, elems, (!), array, listArray, elems, bounds)
import Data.Array (Array)
import Data.Array.MArray.Safe (newArray, newArray_, readArray, writeArray, freeze, getBounds)
import Data.Array.ST.Safe (STUArray, runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftR, xor, bit, popCount)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64, Int8)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Tuple (swap)
import Data.List (unfoldr)
import Data.Char (isSpace)

data Op = UpdateOp !Int !Int8 | QueryOp !Int

op [1, v, c] = UpdateOp v (fromIntegral c)
op [2, v] = QueryOp v

type STree s = (STUArray s Int Int64, STUArray s Int Int8)

build :: UArray Int Int -> ST s (STree s)
build l = do
  let n = snd (bounds l)

  a <- newArray_ (1, 2*n-1)
  forM_ [n..2*n-1] $ \i -> writeArray a i (bit (l!(i-n+1)))

  forM_ [n-1,n-2..1] $ \i ->
    liftM2 (.|.) (readArray a $ 2*i) (readArray a $ 2*i+1) >>= writeArray a i

  b <- newArray (1, 2*n-1) 0

  return (a, b)

size :: (STree s) -> ST s Int
size t@(a, _) = do
  (_, l) <- getBounds a
  return $ l`div`2 + 1

pushDown :: (STree s) -> Int -> ST s ()
pushDown t@(a, b) i0 = push $ m-2
  where
    m = until (\s -> i0 `shiftR` s == 1) (+1) 0

    push (-2) = return ()
    push (-1) = return ()
    push s = do
      let i = i0 `shiftR` s
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then do
          let
            vv = bit $ fromIntegral v
            ii = i `xor` 1
          writeArray a i vv >> writeArray a ii vv
          writeArray b i v >> writeArray b ii v
          writeArray b j 0
      else return ()

      push $ s-1

update :: (STree s) -> Int -> Int -> Int8 -> ST s ()
update t@(a, b) l r v = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)

    pushDown t l' >> pushDown t r' >>
      loop l' r' >>
        popUp l' >> popUp r'
  where
    loop l r
      | l > r = return ()
      | odd l = write l v >> loop (l+1) r
      | even r = write r v >> loop l (r-1)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)
      where
        write i v = writeArray a i (bit $ fromIntegral v) >> writeArray b i (fromIntegral v)

    popUp 1 = return ()
    popUp i = do
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then writeArray a j (bit $ fromIntegral v)
        else liftM2 (.|.) (readArray a i) (readArray a (i `xor` 1)) >>= writeArray a j
      popUp $ i `shiftR` 1

query :: (STree s) -> Int -> Int -> ST s Int64
query t@(a, b) l r = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)
    pushDown t l' >> pushDown t r' >> loop l' r'
  where
    loop l r
      | l > r = return 0
      | odd l = liftM2 (.|.) (readArray a l) (loop (l+1) r)
      | even r = liftM2 (.|.) (loop l (r-1)) (readArray a r)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)

readInts = unfoldr (B.readInt . B.dropWhile isSpace)
getInts = readInts <$> B.getLine

main = do
  [n, m] <- getInts
  cs <- getInts
  es <- replicateM (n-1) $ ((\[a, b] -> (a, b)) <$> getInts)
  qs <- replicateM m $ (op <$> getInts)

  let
    rs = runST $ do
        t <- build cs' :: ST s ((STUArray s Int Int64), (STUArray s Int Int8))

        let
          handle [] = return []
          handle ((UpdateOp v c):ops) = do
              update t l r c
              handle ops
            where (l, r) = range v
          handle ((QueryOp v):ops) = do
              c <- query t l r
              let !r = fromIntegral $ popCount c
              (r:) <$> handle ops
            where (l, r) = range v

        handle qs
      where
        cs' = array (1, n) $ map swap $ zip cs (elems ins) :: UArray Int Int

        p :: (UArray Int Int, UArray Int Int)
        p@(ins, outs) = runST $ do
            ins <- newArray_ (1, n) :: ST s (STUArray s Int Int)
            outs <- newArray_ (1, n) :: ST s (STUArray s Int Int)
            cr <- newSTRef 0

            let
              dfs w u = do
                  modifySTRef cr (+1)
                  readSTRef cr >>= \c -> writeArray ins u c
                  mapM_ (dfs u) vs
                  readSTRef cr >>= \c -> writeArray outs u c
                where
                  vs = filter (/= w) $ g!u

            dfs 0 1

            liftM2 (,) (freeze ins) (freeze outs)
          where
            g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es :: Array Int [Int]

        range v = (ins!v, outs!v)

  putStrLn . unlines . map show $ filter (/= 0) rs

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, liftM2, when, foldM, liftM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (accumArray, elems, (!), array, listArray, elems, bounds)
import Data.Array (Array)
import Data.Array.MArray.Safe (newArray, newArray_, readArray, writeArray, freeze, getBounds)
import Data.Array.ST.Safe (STUArray, runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftR, xor, bit, popCount)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64, Int8)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Tuple (swap)
import Data.List (unfoldr)
import Data.Char (isSpace)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)

type STree s = (STUArray s Int Int64, STUArray s Int Int8)

forceM :: Monad m => m a -> m a
forceM m = do v <- m; return $! v

(<$!>) :: Monad m => (a -> b) -> m a -> m b
f <$!> m = liftM f (forceM m)

build :: UArray Int Int -> ST s (STree s)
build l = do
  let n = snd (bounds l)

  a <- newArray_ (1, 2*n-1)
  forM_ [n..2*n-1] $ \i -> writeArray a i (bit (l!(i-n+1)))

  forM_ [n-1,n-2..1] $ \i ->
    liftM2 (.|.) (readArray a $ 2*i) (readArray a $ 2*i+1) >>= writeArray a i

  b <- newArray (1, 2*n-1) 0

  return (a, b)

size :: (STree s) -> ST s Int
size t@(a, _) = do
  (_, l) <- getBounds a
  return $ l`div`2 + 1

pushDown :: (STree s) -> Int -> ST s ()
pushDown t@(a, b) i0 = push $ m-2
  where
    m = until (\s -> i0 `shiftR` s == 1) (+1) 0

    push (-2) = return ()
    push (-1) = return ()
    push s = do
      let i = i0 `shiftR` s
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then do
          let
            vv = bit $ fromIntegral v
            ii = i `xor` 1
          writeArray a i vv >> writeArray a ii vv
          writeArray b i v >> writeArray b ii v
          writeArray b j 0
      else return ()

      push $ s-1

update :: (STree s) -> Int -> Int -> Int -> ST s ()
update t@(a, b) l r v = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)

    pushDown t l' >> pushDown t r' >>
      loop l' r' >>
        popUp l' >> popUp r'
  where
    loop l r
      | l > r = return ()
      | odd l = write l v >> loop (l+1) r
      | even r = write r v >> loop l (r-1)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)
      where
        write i v = writeArray a i (bit $ fromIntegral v) >> writeArray b i (fromIntegral v)

    popUp 1 = return ()
    popUp i = do
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then writeArray a j (bit $ fromIntegral v)
        else liftM2 (.|.) (readArray a i) (readArray a (i `xor` 1)) >>= writeArray a j
      popUp $ i `shiftR` 1

query :: (STree s) -> Int -> Int -> ST s Int64
query t@(a, b) l r = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)
    pushDown t l' >> pushDown t r' >> loop l' r'
  where
    loop l r
      | l > r = return 0
      | odd l = liftM2 (.|.) (readArray a l) (loop (l+1) r)
      | even r = liftM2 (.|.) (loop l (r-1)) (readArray a r)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)

readInts = unfoldr (B.readInt . B.dropWhile isSpace)

takeTwo [] rs = rs
takeTwo (u:v:xs) rs = takeTwo xs ((u, v):rs)

main = do
  c <- readInts <$> B.getContents

  let
    (n:m:r1) = c
    (cs, r2) = splitAt n r1
    (p1, r3) = splitAt (2*n-2) r2
    es = takeTwo p1 []
    qs = r3

  let
    p :: (UArray Int Int, UArray Int Int)
    p@(ins, outs) = runST $ do
        ins <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        outs <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        cr <- newSTRef 0

        let
          dfs w u = do
              modifySTRef cr (+1)
              readSTRef cr >>= \c -> writeArray ins u c
              mapM_ (dfs u) vs
              readSTRef cr >>= \c -> writeArray outs u c
            where
              vs = filter (/= w) $ g!u

        dfs 0 1

        liftM2 (,) (freeze ins) (freeze outs)
      where
        g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es :: Array Int [Int]

    range v = (ins!v, outs!v)

    cs' = array (1, n) $ map swap $ zip cs (elems ins) :: UArray Int Int

    solve :: [Int8]
    solve = runST $ do
      t <- build cs' :: ST s ((STUArray s Int Int64), (STUArray s Int Int8))

      let
        f [] = return []

        f (1:v:c:qs) = update t l r c >> f qs where (l, r) = range v

        f (2:v:qs) = ((fromIntegral . popCount) <$!> query t l r) >>= \r -> (r:) <$> f qs where (l, r) = range v

      f qs

  putStrLn $ unlines $ map show $ filter (/= 0) solve
  -- let rs = filter (/= 0) solve

  -- let unwords_ = mconcat . map (<> charUtf8 '\n')
  -- hPutBuilder stdout $ unwords_ $ map intDec (rs

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, liftM2, when, foldM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (accumArray, elems, (!), array, listArray, elems, bounds)
import Data.Array (Array)
import Data.Array.MArray.Safe (newArray, newArray_, readArray, writeArray, freeze, getBounds)
import Data.Array.ST.Safe (STUArray, runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftR, xor, bit, popCount)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64, Int8)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Tuple (swap)
import Data.List (unfoldr)
import Data.Char (isSpace)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)

type STree s = (STUArray s Int Int64, STUArray s Int Int8)

build :: UArray Int Int -> ST s (STree s)
build l = do
  let n = snd (bounds l)

  a <- newArray_ (1, 2*n-1)
  forM_ [n..2*n-1] $ \i -> writeArray a i (bit (l!(i-n+1)))

  forM_ [n-1,n-2..1] $ \i ->
    liftM2 (.|.) (readArray a $ 2*i) (readArray a $ 2*i+1) >>= writeArray a i

  b <- newArray (1, 2*n-1) 0

  return (a, b)

size :: (STree s) -> ST s Int
size t@(a, _) = do
  (_, l) <- getBounds a
  return $ l`div`2 + 1

pushDown :: (STree s) -> Int -> ST s ()
pushDown t@(a, b) i0 = push $ m-2
  where
    m = until (\s -> i0 `shiftR` s == 1) (+1) 0

    push (-2) = return ()
    push (-1) = return ()
    push s = do
      let i = i0 `shiftR` s
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then do
          let
            vv = bit $ fromIntegral v
            ii = i `xor` 1
          writeArray a i vv >> writeArray a ii vv
          -- writeArray b i v >> writeArray b ii v
          writeArray b j 0
      else return ()

      push (s-1)

update :: (STree s) -> Int -> Int -> Int -> ST s ()
update t@(a, b) l r v = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)

    pushDown t l' >> pushDown t r' >>
      loop l' r' >>
        popUp l' >> popUp r'
  where
    loop l r
      | l > r = return ()
      | odd l = write l v >> loop (l+1) r
      | even r = write r v >> loop l (r-1)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)
      where
        write i v = writeArray a i (bit $ fromIntegral v) >> writeArray b i (fromIntegral v)

    popUp 1 = return ()
    popUp i = do
      let j = i `shiftR` 1
      v <- readArray b j
      if v /= 0
        then writeArray a j (bit $ fromIntegral v)
        else liftM2 (.|.) (readArray a i) (readArray a (i `xor` 1)) >>= writeArray a j
      popUp $ i `shiftR` 1

query :: (STree s) -> Int -> Int -> ST s Int64
query t@(a, b) l r = do
    n <- size t
    let (l', r') = (l+n-1, r+n-1)
    pushDown t l' >> pushDown t r' >> loop l' r'
  where
    loop l r
      | l > r = return 0
      | odd l = liftM2 (.|.) (readArray a l) (loop (l+1) r)
      | even r = liftM2 (.|.) (loop l (r-1)) (readArray a r)
      | otherwise = loop (l `shiftR` 1) (r `shiftR` 1)

readInts = unfoldr (B.readInt . B.dropWhile isSpace)

takeTwo [] rs = rs
takeTwo (u:v:xs) rs = takeTwo xs ((u, v):rs)

main = do
  c <- readInts <$> B.getContents

  let
    (n:m:r1) = c
    (cs, r2) = splitAt n r1
    (p1, r3) = splitAt (2*n-2) r2
    es = takeTwo p1 []
    qs = r3

  let
    p :: (UArray Int Int, UArray Int Int)
    p@(ins, outs) = runST $ do
        ins <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        outs <- newArray_ (1, n) :: ST s (STUArray s Int Int)
        cr <- newSTRef 0

        let
          dfs w u = do
              modifySTRef cr (+1)
              readSTRef cr >>= \c -> writeArray ins u c
              mapM_ (dfs u) vs
              readSTRef cr >>= \c -> writeArray outs u c
            where
              vs = filter (/= w) $ g!u

        dfs 0 1

        liftM2 (,) (freeze ins) (freeze outs)
      where
        g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es :: Array Int [Int]

    range v = (ins!v, outs!v)

    cs' = array (1, n) $ map swap $ zip cs (elems ins) :: UArray Int Int

    solve = runST $ do
      t <- build cs' :: ST s ((STUArray s Int Int64), (STUArray s Int Int8))

      let
        f [] = return []

        f (1:v:c:qs) = update t l r c >> f qs where (l, r) = range v

        f (2:v:qs) = (popCount <$> query t l r) >>= \r -> (r:) <$> f qs where (l, r) = range v

      f qs

  -- putStrLn $ unlines $ map show $ filter (/= 0) solve
  let rs = filter (/= 0) solve

  let unwords_ = mconcat . map (<> charUtf8 '\n')
  hPutBuilder stdout $ unwords_ $ map intDec rs


Monocarp wrote down two numbers on a whiteboard. Both numbers follow a specific format: a positive integer $$$x$$$ with $$$p$$$ zeros appended to its end.Now Monocarp asks you to compare these two numbers. Can you help him?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. The first line of each testcase contains two integers $$$x_1$$$ and $$$p_1$$$ ($$$1 \le x_1 \le 10^6; 0 \le p_1 \le 10^6$$$) — the description of the first number. The second line of each testcase contains two integers $$$x_2$$$ and $$$p_2$$$ ($$$1 \le x_2 \le 10^6; 0 \le p_2 \le 10^6$$$) — the description of the second number.

For each testcase print the result of the comparison of the given two numbers. If the first number is smaller than the second one, print '<'. If the first number is greater than the second one, print '>'. If they are equal, print '='.

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

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

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[x1, p1] <- getInts 2
    ~[x2, p2] <- getInts 2
    let
      scale = min p1 p2
      s1 = min 7 $ p1 - scale
      s2 = min 7 $ p2 - scale
      y1 = x1 `quot` 10 ^ s2
      y2 = x2 `quot` 10 ^ s1
      z1 = toInteger x1 * 10 ^ s1
      z2 = toInteger x2 * 10 ^ s2
      ans = compare y1 y2 <> compare z1 z2
    pure $ string7 $ case ans of
      LT -> "<\n"
      EQ -> "=\n"
      GT -> ">\n"

type SP = State [P.ByteString]

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

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

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

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

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

getInput :: IO (C.ByteString, Int)
getInput = do
  [x, p] <- fmap C.words C.getLine
  return $ (C.reverse $ C.dropWhile (=='0') $ C.reverse x, C.length x + parseInt p)

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    (s1, n1) <- getInput
    (s2, n2) <- getInput
    let result = case compare n1 n2 of
          EQ -> compare s1 s2
          other -> other
        toChar LT = '<'
        toChar GT = '>'
        toChar _ = '='
    return $ charUtf8 (toChar result) <> charUtf8 '\n'
  hPutBuilder stdout output

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

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 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,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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 -}

solve :: (Int, Int) -> (Int, Int) -> Ordering
solve (x1, p1) (x2, p2) | p1 /= 0 && p2 /= 0 = let p = min p1 p2 in solve (x1, p1 - p) (x2, p2 - p)
solve (x1, p1) (x2, p2) | p2 > 8 = LT
solve (x1, p1) (x2, p2) | p1 > 8 = GT
solve (x1, p1) (x2, p2) = solve' xx1 xx2
    where
        xx1 = show x1 ++ replicate p1 '0'
        xx2 = show x2 ++ replicate p2 '0'

        solve' :: String -> String -> Ordering
        solve' s1 s2 | L.length s1 < L.length s2 = solve' ("0" ++ s1) s2
        solve' s1 s2 | L.length s1 > L.length s2 = solve' s1 ("0" ++ s2)
        solve' s1 s2 = compare s1 s2

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    replicateM_ n $ do
        [x1, p1] <- B8.getLine <&> readIntB8s
        [x2, p2] <- B8.getLine <&> readIntB8s

        let answer = solve (x1, p1) (x2, p2)
        case answer of
            LT -> putStrLn "<"
            GT -> putStrLn ">"
            EQ -> putStrLn "="


The city of D consists of n towers, built consecutively on a straight line. The height of the tower that goes i-th (from left to right) in the sequence equals hi. The city mayor decided to rebuild the city to make it beautiful. In a beautiful city all towers are are arranged in non-descending order of their height from left to right.The rebuilding consists of performing several (perhaps zero) operations. An operation constitutes using a crane to take any tower and put it altogether on the top of some other neighboring tower. In other words, we can take the tower that stands i-th and put it on the top of either the (i - 1)-th tower (if it exists), or the (i + 1)-th tower (of it exists). The height of the resulting tower equals the sum of heights of the two towers that were put together. After that the two towers can't be split by any means, but more similar operations can be performed on the resulting tower. Note that after each operation the total number of towers on the straight line decreases by 1.Help the mayor determine the minimum number of operations required to make the city beautiful.

The first line contains a single integer n (1 ≤ n ≤ 5000) — the number of towers in the city. The next line contains n space-separated integers: the i-th number hi (1 ≤ hi ≤ 105) determines the height of the tower that is i-th (from left to right) in the initial tower sequence.

Print a single integer — the minimum number of operations needed to make the city beautiful.

hsum [] = [(0, 0)]
hsum (h:hs) = headpart:rec
    where rec = hsum hs
          s = snd (head rec) + h
          headpart = head [(s - snd r, s) | r <- rec, s - snd r >= fst r]
res [] xs q = 0
res (h:hs) (x:xs) q
    | q == h = res hs xs x
    | otherwise = 1 + res hs xs (q-h)
solve l1 l2 = show (res rh (tail xs) (head xs))
    where rh = reverse [read x :: Int | x <- words l2]
          xs = [fst z | z <- hsum rh]
main = do
    l1 <- getLine
    l2 <- getLine
    putStrLn (solve l1 l2)

solve l1
    | n == 1 = 1
    | otherwise = maximum [m*(m-1)*head [k | k <- reverse [1..m], gcd k (m*(m-1)) == 1] | m <- [1..n]]
    where n = read l1 :: Integer
main = do
    l1 <- getLine
    putStrLn (show (solve l1))

mymin [] = (1000000, -1)
mymin x = minimum x

solve l1 l2 = show (fst (mymin (rec h)))
    where n = read l1 :: Int
          h = [read x :: Int | x <- words l2]
          rec (x:[]) = [(0, x)]
          rec (x:xs) = headpart:tailpart
            where headpart = (fst (mymin [z | z <- r, snd z >= x]), x)
                  tailpart = [(fst z + 1, snd z + x) | z <- r]
                  r = rec xs
main = do
    l1 <- getLine
    l2 <- getLine
    putStrLn (solve l1 l2)


Alice and Bob have received three big piles of candies as a gift. Now they want to divide these candies as fair as possible. To do this, Alice takes one pile of candies, then Bob takes one of the other two piles. The last pile is split between Alice and Bob as they want: for example, it is possible that Alice takes the whole pile, and Bob gets nothing from it.After taking the candies from the piles, if Alice has more candies than Bob, she discards some candies so that the number of candies she has is equal to the number of candies Bob has. Of course, Bob does the same if he has more candies.Alice and Bob want to have as many candies as possible, and they plan the process of dividing candies accordingly. Please calculate the maximum number of candies Alice can have after this division process (of course, Bob will have the same number of candies).You have to answer $$$q$$$ independent queries.Let's see the following example: $$$[1, 3, 4]$$$. Then Alice can choose the third pile, Bob can take the second pile, and then the only candy from the first pile goes to Bob — then Alice has $$$4$$$ candies, and Bob has $$$4$$$ candies.Another example is $$$[1, 10, 100]$$$. Then Alice can choose the second pile, Bob can choose the first pile, and candies from the third pile can be divided in such a way that Bob takes $$$54$$$ candies, and Alice takes $$$46$$$ candies. Now Bob has $$$55$$$ candies, and Alice has $$$56$$$ candies, so she has to discard one candy — and after that, she has $$$55$$$ candies too.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 1000$$$) — the number of queries. Then $$$q$$$ queries follow. The only line of the query contains three integers $$$a, b$$$ and $$$c$$$ ($$$1 \le a, b, c \le 10^{16}$$$) — the number of candies in the first, second and third piles correspondingly.

Print $$$q$$$ lines. The $$$i$$$-th line should contain the answer for the $$$i$$$-th query — the maximum number of candies Alice can have after the division, if both Alice and Bob act optimally (of course, Bob will have the same number of candies).

import Control.Monad
import Data.List

bestSplit :: [Integer] -> Integer
bestSplit xs =
    let sorted = sort xs
        startA = sorted !! 0
        startB = sorted !! 1
        commonPile = sorted !! 2
        takeA = min commonPile (startB - startA)
        toSplit = commonPile - takeA
        finalA = startA + takeA + (toSplit `div` 2)
        finalB = startB + (commonPile - takeA) + (toSplit `div` 2)
    in min finalA finalB

readNums :: (Num a, Read a) => IO [a]
readNums = map read . words <$> getLine

solve :: IO Integer
solve = do
    piles <- readNums :: IO [Integer]
    return (bestSplit piles)

main = do
    [tests] <- readNums :: IO [Int]
    results <- replicateM tests $ solve
    putStrLn . unlines . map show $ results

import Control.Monad

solve_case a b c = (a + b + c) `div` 2

solve [] = []
solve ([a, b, c]:xs) = (solve_case a b c : solve xs)

read_input = do
  q <- getLine
  strings <- replicateM (read q) getLine
  return $ map get_ints $ map words $ strings
  where get_ints = map read

main = do
  q <- read_input
  mapM print (solve q)

cal :: Int -> IO ()
cal 0 = return ()
cal n = do
  line <- getLine
  let (a:b:c:[]) = map (read :: String -> Integer) $ words line
  putStrLn $ show $ (a + b + c) `div` 2
  cal (n - 1)

main :: IO ()
main = do
  n <- getLine
  cal $ read n

main = interact $ unlines
        . map ( show
               . (`div` 2)
               . sum
               .  map (read :: String -> Integer)
               .  words )
        . tail
        . lines

import Control.Monad (replicateM_)

findAliceCandies :: [Integer] -> Integer
findAliceCandies xs = sum xs `div` 2

readCandies :: IO [Integer]
readCandies = (map read) . words <$> getLine

main =
    read <$> getLine >>= \q ->
    replicateM_ q (readCandies >>= print . findAliceCandies)

import Data.Int
main = interact $ unlines . map (show . solve) . triplets . map read . tail . words
triplets (a:b:c:xs) = (a,b,c) : triplets xs
triplets [] = []
solve (a,b,c) = (a+b+c) `div` 2 :: Int64

import Control.Monad
import Data.Typeable
import Data.Int
import Data.List

solve [a,b,c] = minimum [a+c, b+c, (a+b+c) `quot` 2]

main = do
    n <- fmap read getLine :: IO Int
    inputs <- replicateM n getLine :: IO [String]
    let int_inputs = map (solve . sort . map read . words) inputs :: [Int64]

    mapM print int_inputs
    --print $ int_inputs

main = interact $ unlines . map show . map ((`div` 2) . sum . map read . words) . tail . lines

import Data.Char
import System.IO

split :: String -> Char -> [String]
split [] _ = []
split (x:xs) c| x==c = split xs c
              | otherwise = first (x:xs) c: split (rest (x:xs) c) c where
                    first [] c = []
                    first (x:xs) c| x==c = []
                                  | otherwise = x : first xs c
                    rest [] c = []
                    rest (x:xs) c | x==c = xs
                                  | otherwise = rest xs c

strToIntList :: String -> [Integer]
strToIntList xs = map toInt (split xs ' ')

toInt :: String -> Integer
toInt [] = 0
toInt (x:xs) = toInteger (digitToInt x) * 10^(length xs) + toInt xs

solve :: [Integer] -> Integer
solve xs = div (sum xs) 2

solveN :: Integer -> Handle -> IO ()
solveN 0 h = return ()
solveN n h = do
                abc <- hGetLine h
                (putStrLn . show . solve . strToIntList) abc
                solveN (n-1) h

main :: IO ()
main = do
            -- h <- openFile "A.in" ReadMode
            n <- hGetLine stdin
            solveN (toInt n) stdin
            -- hClose h
            return()

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

onecase=do
		c<-sum <$> map read <$> words <$>getLine ::IO Integer
		print $ div c 2

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

--ghc 7.10

distribute :: (Integral a) => a -> [a] -> a
distribute n xs = (sum xs) `div` n

main = do
    qStr <- getLine
    contents <- getContents
    let xss = map (map read . words) . lines $ contents :: [[Integer]]
    let ds = map (distribute 2) xss
    sequence (map print ds)

import Control.Monad
import Data.Typeable

solve [a,b,c] = minimum [a+c, b+c, (a+b+c) `quot` 2]

main = do
    n <- fmap read getLine :: IO Int
    inputs <- replicateM n getLine :: IO [String]
    let int_inputs = map (solve . map read . words) inputs :: [Int]

    mapM print int_inputs
    --print $ int_inputs

import Control.Monad
import Data.Typeable
import Data.Int

solve [a,b,c] = minimum [a+c, b+c, (a+b+c) `quot` 2]

main = do
    n <- fmap read getLine :: IO Int
    inputs <- replicateM n getLine :: IO [String]
    let int_inputs = map (solve . map read . words) inputs :: [Int64]

    mapM print int_inputs
    --print $ int_inputs

import Data.Char
import System.IO

split :: String -> Char -> [String]
split [] _ = []
split (x:xs) c| x==c = split xs c
              | otherwise = first (x:xs) c: split (rest (x:xs) c) c where
                    first [] c = []
                    first (x:xs) c| x==c = []
                                  | otherwise = x : first xs c
                    rest [] c = []
                    rest (x:xs) c | x==c = xs
                                  | otherwise = rest xs c

strToIntList :: String -> [Int]
strToIntList xs = map toInt (split xs ' ')

toInt :: String -> Int
toInt [] = 0
toInt (x:xs) = (digitToInt x) * 10^(length xs) + toInt xs

solve :: [Int] -> Int
solve xs = div (sum xs) 2

solveN :: Int -> Handle -> IO ()
solveN 0 h = return ()
solveN n h = do
                abc <- hGetLine h
                (putStrLn . show . solve . strToIntList) abc
                solveN (n-1) h

main :: IO ()
main = do
            -- h <- openFile "A.in" ReadMode
            n <- hGetLine stdin
            solveN (toInt n) stdin
            -- hClose h
            return()

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

onecase=do
		c<-sum <$> map read <$> words <$>getLine ::IO Int
		print $ div c 2

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


Shubham has a binary string $$$s$$$. A binary string is a string containing only characters "0" and "1".He can perform the following operation on the string any amount of times:   Select an index of the string, and flip the character at that index. This means, if the character was "0", it becomes "1", and vice versa. A string is called good if it does not contain "010" or "101" as a subsequence  — for instance, "1001" contains "101" as a subsequence, hence it is not a good string, while "1000" doesn't contain neither "010" nor "101" as subsequences, so it is a good string.What is the minimum number of operations he will have to perform, so that the string becomes good? It can be shown that with these operations we can make any string good.A string $$$a$$$ is a subsequence of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) characters.

The first line of the input contains a single integer $$$t$$$ $$$(1\le t \le 100)$$$ — the number of test cases. Each of the next $$$t$$$ lines contains a binary string $$$s$$$ $$$(1 \le |s| \le 1000)$$$.

For every string, output the minimum number of operations required to make it good.

NoteIn test cases $$$1$$$, $$$2$$$, $$$5$$$, $$$6$$$ no operations are required since they are already good strings.For the $$$3$$$rd test case: "001" can be achieved by flipping the first character  — and is one of the possible ways to get a good string.For the $$$4$$$th test case: "000" can be achieved by flipping the second character  — and is one of the possible ways to get a good string.For the $$$7$$$th test case: "000000" can be achieved by flipping the third and fourth characters  — and is one of the possible ways to get a good string.

import Data.Array
import Data.Foldable
import Control.Monad
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
  s <- getLine
  print $ solve s

solve :: String -> Int
solve s = min (minimum $ zipWith (+) (tl zeroprefix) (tl onesuffix)) (minimum $ zipWith (+) (tl oneprefix) (tl zerosuffix))
  where
    tl = toList
    arr = listArray (1,length s) s
    zeroprefix = array (0,length s) ((0,0):[ (i,(if arr!i == '0' then (+1) else id) $ zeroprefix!(i-1)) |  i <- [1..(length s)]])
    oneprefix =  array (0,length s) ((0,0):[ (i,(if arr!i == '1' then (+1) else id) $ oneprefix!(i-1)) |  i <- [1..(length s)]])
    zerosuffix = array (0,length s) ((length s, 0):[ (i,(if arr!(i+1) == '0' then (+1) else id) $ zerosuffix!(i+1)) |  i <- [0..(length s - 1)]])
    onesuffix =  array (0,length s) ((length s, 0):[ (i,(if arr!(i+1) == '1' then (+1) else id) $ onesuffix!(i+1)) |  i <- [0..(length s - 1)]])

import Data.List (scanl')
import Control.Monad

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

solve :: IO()
solve = do
  s <- getLine
  -- Cumulative count of 0s and 1s
  -- Example: scanl' (count '0') 0 "00110101"
  --          => [0,1,2,2,2,3,3,4,4]
  --                0 0 1 1 0 1 0 1
  --          scanl' (count '1') 0 "00110101"
  --          => [0,0,0,1,2,2,3,3,4]
  --                0 0 1 1 0 1 0 1
  let zeros = scanl' (count '0') 0 s
  let ones = scanl' (count '1') 0 s

  print (minOps zeros ones)

-- Cumulative counter
count :: Char -> Int -> Char -> Int
count c x y = if y == c then x else x+1

-- Solve problem with cumulative counters
-- Get the minimum number of operations needed
--
-- Covers all four possibilities:
--  1) All 0s (00..00) (Typically given as such)
--  2) All 1s (11..11) (Typically given as such)
--  3) 0s followed by 1s (00..01..11)
--  4) 1s followed by 0s (11..10..00)
--
--  Example: using "00110101"
--           numSwitch [0,1,2,2,2,3,3,4,4] [0,0,0,1,2,2,3,3,4]
--                        zeros               ones
--
--           Covering cases 2 and 3:
--           (Cost of switching all zeros to ones -
--            best cost reduction when keeping zeros up to a point)
--           (last zeros - maximum (zipWith (-) zeros ones))
--           ((   4    ) - maximum (  [0,1,2,1,0,1,0,1,0]  )
--           (                  4 - 2 = 2                  )
--
--           Covering cases 1 and 4:
--           (Cost of switching all ones to zeros -
--            best cost reduction when keeping ones up to a point)
--           (last ones - maximum (zipWith (-) ones zeros) )
--           ((   4   ) - maximum ([0,-1,-2,-1,0,-1,0,-1,0])
--           (                  4 - 0 = 4                  )
--
--           solve zeros ones = min 2 4 = 2
--           solution (2) => "00110101" -> "00111111"
--                                ^ ^
minOps :: [Int] -> [Int] -> Int
minOps zeros ones = do
  min (last zeros - maximum (zipWith (-) zeros ones)) $
      (last ones - maximum (zipWith (-) ones zeros))

main :: IO()
main = do
  t <- readLn
  routine t

routine :: Int -> IO()
routine t
  | t > 1 = do
      solve
      routine (t-1)
  | t == 1 = solve

solve :: IO()
solve = do
  s <- getLine
  let zeros = countZeros s
  let ones = countOnes s
  print (min (min (oneZero s 0 ones) (zeroOne s 0 zeros)) (min ones zeros))

oneZero :: [Char] -> Int -> Int -> Int
oneZero s toOne toZero
  | (length s) > 1 = do
    min (toOne + toZero) (oneZero (drop 1 s) (toOne+(if (s !! 0 == '0') then 1 else 0)) (toZero-(if (s !! 0 == '1') then 1 else 0)))
  | (length s) == 1 = toOne + toZero

zeroOne :: [Char] -> Int -> Int -> Int
zeroOne s toZero toOne
  | (length s) > 1 = do
    min (toZero + toOne) (zeroOne (drop 1 s) (toZero+(if (s !! 0 == '1') then 1 else 0)) (toOne-(if (s !! 0 == '0') then 1 else 0)))
  | (length s) == 1 = toZero + toOne

countOnes :: [Char] -> Int
countOnes s = do
  length (filter (=='1') s)

countZeros :: [Char] -> Int
countZeros s = do
  length (filter (=='0') s)

{-# LANGUAGE BangPatterns #-}

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

_prefsums acc [] = reverse acc
_prefsums acc@(curr:_) (x:xs) =
  let !x' = x + curr
  in _prefsums (x':acc) xs
prefsums = _prefsums [0]

main = do
  input <- getContents
  let _:tokens = split input
      res = solve <$> tokens
        where solve = (\str ->
                let ones = read <$> (:[]) <$> str :: [Int]
                    onesR = reverse ones
                    zeros = (1 -) <$> ones
                    zerosR = reverse zeros
                    prefs1 : prefs1R : prefs0 : prefs0R : _ = prefsums <$> [ones, onesR, zeros, zerosR]
                    sufs1 : sufs0 : _ = reverse <$> [prefs1R, prefs0R]
                    cost10 = uncurry (+) <$> zip prefs0 sufs1
                    cost01 = uncurry (+) <$> zip prefs1 sufs0
                in foldl1 min (cost10 ++ cost01)
                )
  sequence_ (putStrLn . show <$> res)

{-# LANGUAGE BangPatterns #-}

import Data.List (scanl')
import Data.Foldable (for_)

costs :: Char -> String -> [Int]
costs c = scanl' (\x y -> if  y == c  then  x  else  x+1) 0

solve :: String -> Int
solve str = min (last c0 - maximum (zipWith (-) c0 c1)) $
                (last c1 - maximum (zipWith (-) c1 c0))  where
  c0 = costs '0' str
  c1 = costs '1' str

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  for_ [1..t] $ \_ -> getLine >>= (print . solve)

{-# LANGUAGE BangPatterns #-}

import Data.Foldable (for_)

solve :: String -> Int
solve [] = 0
solve (c:cs) = go 0 c cs  where
  go !n !c1 [] = n
  go !n !c1 [c2] = n
  go !n !c1 (c2:c3:cs)
    | c1 == c2 || c2 == c3  = go n c2 (c3:cs)
    | otherwise = go (n+1) c3 cs

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  for_ [1..t] $ \_ -> getLine >>= (print . solve)


There are n piles of stones of sizes a1, a2, ..., an lying on the table in front of you.During one move you can take one pile and add it to the other. As you add pile i to pile j, the size of pile j increases by the current size of pile i, and pile i stops existing. The cost of the adding operation equals the size of the added pile.Your task is to determine the minimum cost at which you can gather all stones in one pile. To add some challenge, the stone piles built up conspiracy and decided that each pile will let you add to it not more than k times (after that it can only be added to another pile). Moreover, the piles decided to puzzle you completely and told you q variants (not necessarily distinct) of what k might equal. Your task is to find the minimum cost for each of q variants.

The first line contains integer n (1 ≤ n ≤ 105) — the number of stone piles. The second line contains n space-separated integers: a1, a2, ..., an (1 ≤ ai ≤ 109) — the initial sizes of the stone piles.  The third line contains integer q (1 ≤ q ≤ 105) — the number of queries. The last line contains q space-separated integers k1, k2, ..., kq (1 ≤ ki ≤ 105) — the values of number k for distinct queries. Note that numbers ki can repeat.

Print q whitespace-separated integers — the answers to the queries in the order, in which the queries are given in the input. Please, do not use the %lld specifier to read or write 64-bit integers in C++. It is preferred to use the cin, cout streams or the %I64d specifier.

NoteIn the first sample one way to get the optimal answer goes like this: we add in turns the 4-th and the 5-th piles to the 2-nd one; then we add the 1-st pile to the 3-rd one; we add the 2-nd pile to the 3-rd one. The first two operations cost 1 each; the third one costs 2, the fourth one costs 5 (the size of the 2-nd pile after the first two operations is not 3, it already is 5). In the second sample you can add the 2-nd pile to the 3-rd one (the operations costs 3); then the 1-st one to the 3-th one (the cost is 2); then the 5-th one to the 4-th one (the costs is 1); and at last, the 4-th one to the 3-rd one (the cost is 2).

import qualified Data.List as L
import qualified Data.Array as A
import Data.Int
import Data.Char

solve :: Int64 -> [Int64] -> Int64 -> [Int64] -> [Int64]  -- o(q*log n)
solve 1 al q kl = [0 | _ <- kl]
solve n al q kl = do k <- kl
                     return $ query A.! k -- o(log n)
    where
        array :: A.Array Int64 Int64
        array = A.listArray (0,n-1) $ snd $ L.foldl' (\(s,l) x -> let y = s + x in (y,(y:l))) (0,[]) (L.sort al)
        query :: A.Array Int64 Int64
        query = A.array (1,10^5) (map (\k -> (k,sub k)) [1..(10^5)])
        sub :: Int64 -> Int64
        sub 1 = sum [array A.! i | i <- [1..n-1]]
        sub k = sum [array A.! i | i <- takeWhile (<n) $ geolist k 1 1]
        geolist :: Int64 -> Int64 -> Int64 -> [Int64]
        geolist k a r = let r' = r*k
                            a' = a + r' in a : geolist k a' r'

main :: IO ()
main = do n  <- (getLine >>= return . readInt)
          al <- (getLine >>= return . map readInt . words)
          q  <- (getLine >>= return . readInt)
          kl <- (getLine >>= return . map readInt . words)
          putStrLn . unwords . map show $ solve n al q kl

readInt :: String -> Int64
readInt ('-':xs) = -readInt xs
readInt xs       = L.foldl' (\ e c -> (fromIntegral $digitToInt c) + e * 10) 0 xs

import qualified Data.List as L
import qualified Data.Array as A
import Data.Int

solve :: Int -> [Int] -> Int -> [Int] -> [Int64]  -- o(q*log n)
solve 1 al q kl = [0 | _ <- kl]
solve n al q kl = do k <- kl
                     return $ query A.! k -- o(log n)
    where
        array :: A.Array Int Int64
        array = A.array (0,n-1) $ zip [0..] $ snd $ L.foldl' (\(s,l) x -> let y = s + fromIntegral x in (y,(y:l))) (0,[]) (L.sort al)
        query :: A.Array Int Int64
        query = A.array (1,10^5) (map (\k -> (k,sub k)) [1..(10^5)])
        sub :: Int -> Int64
        sub 1 = sum [array A.! i | i <- [1..n-1]]
        sub k = sum [array A.! ((k^i-1) `div` (k-1)) | i <- takeWhile (\i -> k ^ i - 1 > 0 && k^i -1 <= (n-1) * (k-1)) [1..]]

main :: IO ()
main = do n  <- (getLine >>= return . read)
          al <- (getLine >>= return . map read . words)
          q  <- (getLine >>= return . read)
          kl <- (getLine >>= return . map read . words)
          putStrLn . unwords . map show $ solve n al q kl