Ilya plays a card game by the following rules.A player has several cards. Each card contains two non-negative integers inscribed, one at the top of the card and one at the bottom. At the beginning of the round the player chooses one of his cards to play it. If the top of the card contains number ai, and the bottom contains number bi, then when the player is playing the card, he gets ai points and also gets the opportunity to play additional bi cards. After the playing the card is discarded.More formally: let's say that there is a counter of the cards that can be played. At the beginning of the round the counter equals one. When a card is played, the counter decreases by one for the played card and increases by the number bi, which is written at the bottom of the card. Then the played card is discarded. If after that the counter is not equal to zero, the player gets the opportunity to play another card from the remaining cards. The round ends when the counter reaches zero or the player runs out of cards.Of course, Ilya wants to get as many points as possible. Can you determine the maximum number of points he can score provided that you know his cards?

The first line contains a single integer n (1 ≤ n ≤ 1000) — the number of cards Ilya has. Each of the next n lines contains two non-negative space-separated integers — ai and bi (0 ≤ ai, bi ≤ 104) — the numbers, written at the top and the bottom of the i-th card correspondingly.

Print the single number — the maximum number of points you can score in one round by the described rules.

NoteIn the first sample none of two cards brings extra moves, so you should play the one that will bring more points.In the second sample you should first play the third card that doesn't bring any points but lets you play both remaining cards.

module Main where

import Control.Monad
import Data.List
import Data.Ord

main = do
  n <- liftM read getLine :: IO Int

  cards <- replicateM n $ do
    [a, b] <- liftM ( map read . words ) getLine
    return (a, b)

  let
    (counter, score, pendings) =
      foldl
        ( \(counter, score, pendings) (a, b) ->
          if b == 0
            then (counter, score, a:pendings)
            else (counter+b-1, score+a, pendings) )
        (1, 0, [])
        cards

    ans = score + ( sum $ take counter $ sortBy (comparing (0-)) pendings )

  putStrLn $ show ans

import Control.Monad
import Data.List
solve xs =  s' + s''
      where s' = sum $ map fst xs'
            k = (sum $ map snd xs') - length xs' + 1
            xs' = [x | x <- xs , snd x > 0]
            s'' =sum $ map fst $ take k $ (reverse . sortBy (\a b -> compare (fst a) (fst b)))  (xs \\ xs')
tuplify2 :: [a] -> (a,a)
tuplify2 [x,y] = (x,y)
main=do
        n <- fmap read $ getLine
        xs <-  forM [1..n] (\_ -> getLine >>= (return . tuplify2 . map (read::String->Int) . words))
        print $ solve xs

import List (partition, sortBy)

{-
import HUnit

testOneCard :: Test
testOneCard  =  Test "TestOneCard" $
    assertEq 2 (solve [(2,0)])

testAllCardsZero :: Test
testAllCardsZero  =  Test "TestAllCardsZero" $
    assertEq 3 (solve [(1,0),(3,0),(2,0)])

testInput :: Test
testInput  =  TestList "TestInput"
    [Test "1" $ assertEq 2 (solve [(2,0),(1,0)]),
     Test "2" $ assertEq 3 (solve [(2,0),(1,0),(0,2)])]

test :: IO ()
test  =  mapM_ run
    [testOneCard,
     testAllCardsZero,
     testInput]

--------------------------------------------------------------------------------
-}

type Card  =  (Int, Int)

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

readCard :: IO Card
readCard  =  do
    [a, b]  <-  Main.reads
    return (a, b)

solve :: [Card] -> Int
solve cards  =  sum (map fst notZero)
  + sum (map fst (take (sum (map snd notZero) + 1 - length notZero) zero'))
  where
    (zero, notZero)  =  partition ((== 0) . snd) cards
    zero'  =  reverse (sortBy (\c1 c2 -> compare (fst c1) (fst c2)) zero)

main :: IO ()
main  =  do
    [n]  <-  Main.reads
    cards  <-  mapM (const readCard) [1..n]
    print $ solve cards

import Data.List
type Card = (Integer, Integer)
readCard :: String -> Card
readCard str = ((read suf)::Integer, (read pre)::Integer)
    where (pre, suf) = break (== ' ') str
calc :: [Card] -> Integer
calc xs = sum $map snd $ pre ++ suf'
    where xs' =  reverse . sort $ xs
          (pre, suf) = break ((== 0).fst) xs'
          t = 1 + sum (map fst pre) -  genericLength pre
          suf' = take (fromIntegral t) suf

main = interact $ show . calc . map readCard . tail . lines

import IO
import Data.List
import Debug.Trace

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

getInteger :: IO Int
getInteger = do
    line <- getLine
    return (read line)

getIntegers :: IO [Int]
getIntegers = do
    line <- getLine
    return (map read (words line))

readNumbers :: Int -> IO [(Int, Int)]
readNumbers 0 = return ([])
readNumbers count = do
    --putTraceMsg ("count = " ++ (show count))
    [first, second] <- getIntegers
    --putTraceMsg ("first = " ++ (show first) ++ ", second = " ++ (show second))
    numbers <- (readNumbers $ count - 1)
    return ([(first, second)] ++ numbers)

runAux :: [(Int, Int)] -> Int -> Int
runAux [] stack = 0
runAux (x:xs) stack =
    if stack == 0 then 0
    else fst x + runAux xs (stack - 1 + snd x)

run :: [(Int, Int)] -> Int
run x = runAux sorted 1
    where secondLess = (\a b -> if swap a > swap b  then LT else GT)
          sorted = sortBy secondLess x

main = do
    n <- getInteger
    --putTraceMsg ("N = " ++ show n)
    numbers <- (readNumbers n)
    let result = run numbers
    putStrLn $ show result

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

solve :: [(Int, Int)] -> Int -> Int
solve []          _ = 0
solve _           0 = 0
solve ((a, b):xs) n = a + (solve xs $ n - 1 + b)

main = do
  n <- read <$> getLine
  a <- forM [1..n] $ \x ->
    map read <$> (words <$> getLine)
  let arr = map (\(x, y) -> (-y, -x)) $ sort $ map (\[x,y] -> (-y, -x)) a
  print $ solve arr 1

import Data.List
import Control.Applicative

main = do _ <- getLine
          xys <- map ((\[x,y] -> (y,x)) . map read . words) . lines <$> getContents
          print $ solve xys

solve :: [(Int,Int)] -> Int
solve xys = fst $ foldl' f (0,1) $ sortBy (flip compare) xys

f :: (Int,Int) -> (Int,Int) -> (Int,Int)
f (p,r) (b,a)
  | r == 0    = (p,0)
  | otherwise = (p+a,r+b-1)

import Control.Applicative
import Data.List

getCard :: Int -> IO [(Int, Int)]
getCard 0 = return []
getCard n = do
  (a:b:_) <- map read <$> (words <$> getLine)
  cards <- getCard $ n - 1
  return $ (-b, -a): cards

solve :: [(Int, Int)] -> Int -> Int
solve [] _ = 0
solve _ 0 = 0
solve (c:cs) n = -(snd c) + solve cs (n - (fst c) - 1)

main = do
  n <- read <$> getLine
  xs <- getCard n
  print $ solve (sort xs) 1

import Data.List

main:: IO ()
main = do cs <- getContents
          (putStr .show .solve .parse) cs

parse_step::String->(Int,Int)
parse_step s = (x,y)
               where [x,y] = map (\x -> read x::Int) (words s)

parse::String->[(Int,Int)]
parse s = foldr (\x y->(parse_step x):y ) [] ss
           where ss = (tail .lines) s

splitf :: (a->Bool)-> [a]->([a],[a])
splitf f l = foldr (\x (tr,fa)->if (f x)
                                then ((x:tr),fa)
                                else (tr,x:fa)) ([],[]) l

hasB :: (Int,Int) -> Bool
hasB (_,b) = (b /= 0)

plus_cards::[(Int,Int)]->(Int,Int)
plus_cards = foldl (\(xa,ya) (xb,yb)->(xa+xb,ya+yb)) (0,0)

cardcomp::(Int,Int)->(Int,Int)->Ordering
cardcomp (x1,_) (x2,_) = compare x2 x1

solve::[(Int,Int)] -> Int
solve l =  totalA + totalB
           where
             (bcard,acard) = splitf hasB l
             (totalB,k)    = plus_cards bcard
             (totalA,_)    = plus_cards (take (k+1-(length bcard)) (sortBy cardcomp acard))

import Data.List

main = do
	nS <- getLine
	let n = read nS :: Int
	strs <- getNLines n []
	let css = (map (\(a:b:_) -> (read a, read b)) $ map words strs) :: [(Int,Int)]
	putStrLn.show $ solve css

getNLines 0 acc = return (reverse acc)
getNLines n acc = do
	x <- getLine
	getNLines (n-1) (x:acc)

solve css = sl' (sBysnd css) 1 0

sl' :: [(Int, Int)] -> Int -> Int -> Int
sl' (c:cs) 0 acc = acc
sl' [] n acc = acc
sl' (c:cs) n acc
	| (snd c == 0) = (acc + (sum $ take (n) $ map fst (reverse $ sort (c:cs))))
	| otherwise = sl' cs ((snd c) + n - 1) (acc + (fst c))

sBysnd (a:as) = sortBy (\x y -> compare (snd y) (snd x)) (a:as)

import Data.List

parse :: [String] -> [[Int]]
parse stuff = map parseL stuff
    where parseL line = reverse $ map read (words line)

solve cards = subsolve 0 1 (reverse $ sort cards)
    where subsolve acc 0 _ = acc
          subsolve acc _ [] = acc
          subsolve acc cnt ([b,a]:xs) = subsolve (acc + a) (cnt + b - 1) xs

main = do
  n <- getLine
  cards <- sequence [getLine | _ <- [1.. (read n)]]
  print . solve . parse $ cards

import Data.List

main:: IO ()
main = do cs <- getContents
          (putStr .show .solve .parse) cs

parse_step::String->(Int,Int)
parse_step s = (x,y)
               where [x,y] = map (\x -> read x::Int) (words s)

parse::String->[(Int,Int)]
parse s = foldr (\x y->(parse_step x):y ) [] ss
           where ss = (tail .lines) s

splitf :: (a->Bool)-> [a]->([a],[a])
splitf f l = foldr (\x (tr,fa)->if (f x)
                                then ((x:tr),fa)
                                else (tr,x:fa)) ([],[]) l

hasB :: (Int,Int) -> Bool
hasB (_,b) = (b /= 0)

plus_cards::[(Int,Int)]->(Int,Int)
plus_cards = foldl (\(xa,ya) (xb,yb)->(xa+xb,ya+yb)) (0,0)

cardcomp::(Int,Int)->(Int,Int)->Ordering
cardcomp (x1,_) (x2,_) = compare x2 x1

solve::[(Int,Int)] -> Int
solve l =  totalA + totalB
           where
             (bcard,acard) = splitf hasB l
             (totalB,k)    = plus_cards bcard
             (totalA,_)    = plus_cards (take (k+1) (sortBy cardcomp acard))


It is the hard version of the problem. The only difference is that in this version $$$3 \le k \le n$$$.You are given a positive integer $$$n$$$. Find $$$k$$$ positive integers $$$a_1, a_2, \ldots, a_k$$$, such that:  $$$a_1 + a_2 + \ldots + a_k = n$$$  $$$LCM(a_1, a_2, \ldots, a_k) \le \frac{n}{2}$$$ Here $$$LCM$$$ is the least common multiple of numbers $$$a_1, a_2, \ldots, a_k$$$.We can show that for given constraints the answer always exists.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 10^4)$$$  — the number of test cases. The only line of each test case contains two integers $$$n$$$, $$$k$$$ ($$$3 \le n \le 10^9$$$, $$$3 \le k \le n$$$). It is guaranteed that the sum of $$$k$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print $$$k$$$ positive integers $$$a_1, a_2, \ldots, a_k$$$, for which all conditions are satisfied.

import Control.Monad
import Data.List
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapS

main = do
    t <- readLn
    replicateM_ t testcase

testcase :: IO ()
testcase = do
    firstLine <- getLine
    let [n,k] = map read . words $ firstLine
    putStrLn $ solve n k

solve :: Int -> Int -> String
solve n k = unwords . map show $ sol
    where
        sol = solve3 (n-k+3) ++ replicate (k-3) 1

solve3 :: Int -> [Int]
solve3 n
    | odd n =  [1, (n-1) `div` 2, (n-1) `div` 2]
    | n `mod` 4 == 0 =  [n `div` 2 , n `div` 4, n `div` 4]
    | otherwise = [2, (n-2) `div` 2, (n-2) `div` 2]

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List (group, sort)
import Data.Map ((!))
import qualified Data.Map as M
-- import Debug.Trace

import Data.Maybe (fromJust)
import System.IO
import Text.Read

getNums :: IO [Int]
getNums = do
  line <- B.getLine
  return $ map ((fst . fromJust) . B.readInt) . B.split ' ' $ line

main :: IO ()
main = do
  t <- readLn :: IO Integer
  forM_ [1 .. t] handleCase

handleCase :: Integer -> IO ()
handleCase c = do
  [n, k] <- getNums
  putStrLn $ unwords $ map show $ solve n k

solveEasy :: Int -> [Int]
solveEasy n
  | n `mod` 2 == 1 = [1, (n - 1) `div` 2, (n -1) `div` 2]
  | n `mod` 4 == 0 = [n `div` 2, n `div` 4, n `div` 4]
  | n `mod` 4 == 2 = [2, (n - 1) `div` 2, (n -1) `div` 2]

solve n k = replicate (k - 3) 1 ++ solveEasy (n - (k - 3))

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

solve :: Int -> [Int]
solve n
  | odd n = 1 : replicate 2 (div n 2)
  | mod n 4 == 0 = div n 2 : replicate 2 (div n 4)
  | otherwise = 2 : replicate 2 (div n 2 - 1)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    putInts $ solve (n - (k - 3)) ++ replicate (k - 3) 1

type SIO = StateT P.ByteString IO

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 Control.Monad
import Data.List
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapS

main = do
    t <- readLn
    replicateM_ t testcase

testcase :: IO ()
testcase = do
    firstLine <- getLine
    let [n,k] = map read . words $ firstLine
    putStrLn $ solve n k

solve :: Int -> Int -> String
solve n k = unwords . map show $ sol
    where
        sol = solve3 n ++ replicate (k-3) 1

solve3 :: Int -> [Int]
solve3 n
    | odd n =  [1, (n-1) `div` 2, (n-1) `div` 2]
    | n `mod` 4 == 0 =  [n `div` 2 , n `div` 4, n `div` 4]
    | otherwise = [2, (n-2) `div` 2, (n-2) `div` 2]


Chouti and his classmates are going to the university soon. To say goodbye to each other, the class has planned a big farewell party in which classmates, teachers and parents sang and danced.Chouti remembered that $$$n$$$ persons took part in that party. To make the party funnier, each person wore one hat among $$$n$$$ kinds of weird hats numbered $$$1, 2, \ldots n$$$. It is possible that several persons wore hats of the same kind. Some kinds of hats can remain unclaimed by anyone.After the party, the $$$i$$$-th person said that there were $$$a_i$$$ persons wearing a hat differing from his own.It has been some days, so Chouti forgot all about others' hats, but he is curious about that. Let $$$b_i$$$ be the number of hat type the $$$i$$$-th person was wearing, Chouti wants you to find any possible $$$b_1, b_2, \ldots, b_n$$$ that doesn't contradict with any person's statement. Because some persons might have a poor memory, there could be no solution at all.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$), the number of persons in the party. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le n-1$$$), the statements of people.

If there is no solution, print a single line "Impossible". Otherwise, print "Possible" and then $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$1 \le b_i \le n$$$). If there are multiple answers, print any of them.

NoteIn the answer to the first example, all hats are the same, so every person will say that there were no persons wearing a hat different from kind $$$1$$$.In the answer to the second example, the first and the second person wore the hat with type $$$1$$$ and all other wore a hat of type $$$2$$$.So the first two persons will say there were three persons with hats differing from their own. Similarly, three last persons will say there were two persons wearing a hat different from their own.In the third example, it can be shown that no solution exists.In the first and the second example, other possible configurations are possible.

import Data.List

f::Int->Int->Int->Int->Int->[(Int,Int)]->[(Int,Int)]
f _ _ _ _ _ []=[]
f c n _ a _ _
    |a<n || a<c =[]
f c n 0 a o ((x,y):xs)=f c (n+1) x a x ((x,y):xs)
f c n d a o ((x,y):xs)
       |o/=x=[]
       |otherwise=(y,n):(f (c+1) n (d-1) a o xs)

f2::Int->Int->Int->[Int]->[Int]->Bool
f2 _ _ _ [] _=True
f2 _ 0 _ _ []=True
f2 n c c3 xs []=f2 n c c3 xs [(-1)]
f2 n 0 c3 (x:xs) (c2:ys)=f2 n c2 c2 (x:xs) ys
f2 n c c3 (x:xs) (c2:ys)
     |x+c3/=n=False
     |otherwise=f2 n (c-1) c3 xs (c2:ys)

main = do
       e<-getLine
       es<-getLine
       let n=read e::Int
           xs=map read (words es)::[Int]
           ys=map (n - ) xs
           zs=sort $ zip ys [(1::Int)..(n::Int)]
           ans=sort (f 0 0 0 n 0 zs)
           ans2=(map snd ans)
           t1=group $ sort ans2
           t2=map length t1
--       print t2
--       print (reverse (sort xs))
       putStrLn $ if length(ans)==n && f2 n (head t2) (head t2) (reverse (sort xs)) (tail t2)
                      then "Possible\n"++(unwords ( map show ( ans2)))
                      else "Impossible"

import Data.Maybe
import Data.List
import Data.Function

doit :: Int -> [(Int, Int)] -> Maybe [(Int, Int)]
doit n lst = let sz = length lst
                 k  = n - (snd . head $ lst)
             in if sz `mod` k == 0 then Just $ doit' 0 0 k lst else Nothing

doit' :: Int -> Int -> Int -> [(Int, Int)] -> [(Int, Int)]
doit' _ _ _ [] = []
doit' cur n ma (x:xs)
  | n == ma = doit' (cur + 1) 0 ma (x:xs)
  | otherwise = (fst x, cur) : doit' cur (n + 1) ma xs

summarize :: [Maybe [(Int, Int)]] -> Maybe [Int]
summarize lst
  | any isNothing lst = Nothing
  | otherwise = Just . map snd . sortBy (compare `on` fst) . concat . map fst . scanl f ([], 1) $ lst

f :: ([(Int, Int)], Int) -> Maybe [(Int, Int)] -> ([(Int, Int)], Int)
f (_, start) (Just lst) = (map (\(a, b) -> (a, b + start)) lst, start + maximum (map snd lst) + 1)

main = do
  n <- readLn
  l <- fmap (summarize . map (doit n) . groupBy ((==) `on` snd) . sortBy (compare `on` snd) . zip [0..] . map read . words) getLine
  putStrLn $ case l of
    Nothing -> "Impossible"
    Just x -> "Possible\n" ++ (unwords . map show $ x)

import Data.List

f ::Int->Int->Int->Int->[Int]->[Int]
f _ _ _ _ []=[]
f n _ a _ _
   |n>a=[]
f n 0 a _ (x:xs)=f (n+1) (a-x) a x (x:xs)
f n d a o (x:xs)
     |o/=x=[]
     |otherwise=n:f n (d-1) a o xs

main =do
      e<-getLine
      es<-getLine
      let x=read e::Int
      let xs=map read (words es)::[Int]
          ys=sort xs
          ans=f 0 0 x 0 ys
      putStrLn $ if (length ans)==x then "Possible\n"++(unwords (map show ans)) else "Impossible"

import Data.List

f::Int->Int->Int->Int->Int->[(Int,Int)]->[(Int,Int)]
f _ _ _ _ _ []=[]
f c n _ a _ _
    |a<n || a<c =[]
f c n 0 a o ((x,y):xs)=f c (n+1) x a x ((x,y):xs)
f c n d a o ((x,y):xs)
       |o/=x=[]
       |otherwise=(y,n):(f (c+1) n (d-1) a o xs)

f2::Int->Int->[Int]->[Int]->Bool
f2 _ _ [] _=True
f2 _ _ _ []=True
f2 n 0 (x:xs) (c2:ys)=f2 n c2 (x:xs) ys
f2 n c (x:xs) (c2:ys)
     |x+c2/=n=False
     |otherwise=f2 n (c-1) xs (c2:ys)

main = do
       e<-getLine
       es<-getLine
       let n=read e::Int
           xs=map read (words es)::[Int]
           ys=map (n - ) xs
           zs=sort $ zip ys [(1::Int)..(n::Int)]
           ans=sort (f 0 0 0 n 0 zs)
           ans2=(map snd ans)
           t1=group $ sort ans2
           t2=map length t1
       putStrLn $ if length(ans)==n &&  f2 n (head t2) (reverse (sort xs)) t2
                      then "Possible\n"++(unwords ( map show ( ans2)))
                      else "Impossible"


Sereja has got an array, consisting of n integers, a1, a2, ..., an. Sereja is an active boy, so he is now going to complete m operations. Each operation will have one of the three forms:  Make vi-th array element equal to xi. In other words, perform the assignment avi = xi.  Increase each array element by yi. In other words, perform n assignments ai = ai + yi (1 ≤ i ≤ n).  Take a piece of paper and write out the qi-th array element. That is, the element aqi. Help Sereja, complete all his operations.

The first line contains integers n, m (1 ≤ n, m ≤ 105). The second line contains n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109) — the original array. Next m lines describe operations, the i-th line describes the i-th operation. The first number in the i-th line is integer ti (1 ≤ ti ≤ 3) that represents the operation type. If ti = 1, then it is followed by two integers vi and xi, (1 ≤ vi ≤ n, 1 ≤ xi ≤ 109). If ti = 2, then it is followed by integer yi (1 ≤ yi ≤ 104). And if ti = 3, then it is followed by integer qi (1 ≤ qi ≤ n).

For each third type operation print value aqi. Print the values in the order, in which the corresponding queries follow in the input.

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (forM, liftM)
import Control.Monad.ST
import Data.Array.ST
import Debug.Trace (trace)
import qualified Data.ByteString.Lazy.Char8 as BS

data Query = Set Int Int
           | Add Int
           | Get Int
           deriving (Show)

type Values s      = STArray s Int (Int, Int)
type PartialSums s = STArray s Int Int

readInt :: BS.ByteString -> Int
readInt s = case BS.readInt s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Int"

parseQueries :: [Int] -> [Query]
parseQueries [] = []
parseQueries (1:v:x:qs) = (Set v x) : (parseQueries qs)
parseQueries (2:y:qs)   = (Add y)   : (parseQueries qs)
parseQueries (3:q:qs)   = (Get q)   : (parseQueries qs)

solve :: Int -> Int -> [Int] -> [Query] -> [Int]
solve n m vs qs = runST $ do
  values <- newListArray (1, n) (zip vs [0, 0 ..]) :: ST s (Values s)
  sums   <- newArray (0, m) 0 :: ST s (PartialSums s)
  result <- forM (zip qs [1 .. m]) $ \(query, timestamp) -> do
    cur <- readArray sums (timestamp - 1)
    writeArray sums timestamp cur
    case query of
      Set v x -> writeArray values v (x, timestamp) >> return (-1)
      Add y   -> writeArray sums timestamp (cur + y) >> return (-1)
      Get q   -> do (x, time) <- readArray values q
                    prev      <- readArray sums time
                    return (x + cur - prev)
  return $ filter (>= 0) result

main = do
  (n:m:cs) <- liftM (map readInt . BS.words) BS.getContents
  let (values, qs) = splitAt n cs
      queries      = parseQueries qs
  let result = solve n m values queries
  mapM_ print result

import Control.Monad (liftM, mapM_)
import Data.Array.IO
import Data.Array.MArray
import Data.Array.ST
import Data.Array.Unboxed
import Prelude hiding (read, reads)

read :: String -> Int
read ('-':s)  =  (-1) * read s
read s  =  read' 0 s
  where
    read' a ""  =  a
    read' a (c:s)  =  read' a' s
      where
        a'  =  10*a + fromEnum c - fromEnum '0'

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

solve :: Int -> [Int] -> [Int] -> IO ()
solve n xs ys  =  do
    array  <-  newArray_ (1, n)
    sequence_ [writeArray array i a | (i, a) <- zip [1..] xs]
    solve' array 0 ys
  where
    solve' :: IOUArray Int Int -> Int -> [Int] -> IO ()
    solve' _ _ []  =  return ()
    solve' array acc (1 : i : a : ys)  =  do
        writeArray array i (a - acc)
        solve' array acc ys
    solve' array acc (2 : s : ys)  =  do
        solve' array (acc + s) ys
    solve' array acc (3 : i : ys)  =  do
        a  <-  readArray array i
        print (acc + a)
        solve' array acc ys

main :: IO ()
main  =  do
    ints  <-  reads
    let [n, m]  =  take 2 ints
    let xs  =  take n $ drop 2 ints
    let ys  =  drop (n + 2) ints
    solve n xs ys


You are given two integers $$$a$$$ and $$$b$$$.In one move, you can choose some integer $$$k$$$ from $$$1$$$ to $$$10$$$ and add it to $$$a$$$ or subtract it from $$$a$$$. In other words, you choose an integer $$$k \in [1; 10]$$$ and perform $$$a := a + k$$$ or $$$a := a - k$$$. You may use different values of $$$k$$$ in different moves.Your task is to find the minimum number of moves required to obtain $$$b$$$ from $$$a$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of the test case contains two integers $$$a$$$ and $$$b$$$ ($$$1 \le a, b \le 10^9$$$).

For each test case, print the answer: the minimum number of moves required to obtain $$$b$$$ from $$$a$$$.

NoteIn the first test case of the example, you don't need to do anything.In the second test case of the example, the following sequence of moves can be applied: $$$13 \rightarrow 23 \rightarrow 32 \rightarrow 42$$$ (add $$$10$$$, add $$$9$$$, add $$$10$$$).In the third test case of the example, the following sequence of moves can be applied: $$$18 \rightarrow 10 \rightarrow 4$$$ (subtract $$$8$$$, subtract $$$6$$$).

import Control.Monad

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [a, b] <- map read . words <$> getLine
    putStrLn $ show $ div (abs (a - b) + 9) 10

import Control.Monad

getInt :: IO Int
getInt = readLn

getFloat :: IO Float
getFloat = readLn

getDouble :: IO Double
getDouble = readLn

countMoves :: Int -> Int -> Int
countMoves n1 n2 =
  case abs (n1 - n2) of
    0 -> 0
    n -> if n `mod` 10 == 0 then n `div` 10 else n `div` 10 + 1

main :: IO ()
main = do
  n <- getInt
  replicateM_ n $ do
    n1 : n2 : _ <- map (read :: String -> Int) . words <$> getLine
    print $ countMoves n1 n2

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
module Main (main) where
import System.IO
import Data.Ord
import Data.Int
import Data.Bits
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict (StateT)
import qualified Control.Monad.Trans.State.Strict as StateT
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C

getNewLine :: SIO ByteString
getNewLine = (lift $ C.hGetLine stdin) >>= (\z -> let x = C.dropWhile isSpace z in if C.null x then getNewLine else return x)

getRemain :: ByteString -> SIO ByteString
getRemain b = let bns = C.dropWhile isSpace b in
                if C.null bns then getNewLine >>= liftM2 (>>=) StateT.put (const . return)
                else return bns

data HInt
data HInt64
data HNormal
data HString
data HList

type SIO a = StateT ByteString IO a

class IOInteract a where
    convert :: ByteString -> (a, ByteString)
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convert = convertp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType Int = HInt
    IOType Int64 = HInt64
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertp :: flag -> ByteString -> (a, ByteString)
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertp _ x = let (a, b) = C.break isSpace x in (read $ C.unpack a, b)
    toShowSp _ x = shows x

instance IOInteractp HInt Int where
    convertp _ x = fromMaybe (error "parse") $ C.readInt x
    toShowSp _ x = shows x

instance IOInteractp HInt64 Int64 where
    convertp _ x = let (a, b) = fromMaybe (error "parse") $ C.readInteger x in (fromIntegral a, b)
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertp _ x = let (a, b) = C.break isSpace x in (C.unpack a, b)
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertp _ x = let (a, b) = convert x in ([a], b)
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => SIO a
get = uncurry (flip (liftM2 seq . StateT.put) . return) =<< fmap convert . getRemain =<< StateT.get
put :: IOInteract a => a -> SIO ()
put = lift . (hPutStr stdout) . toShow
putln :: IOInteract a => a -> SIO ()
putln = lift . (hPutStrLn stdout) . toShow
flush :: SIO ()
flush = lift (hFlush stdout)

main :: IO ()
main = StateT.evalStateT main_ C.empty

main_ :: SIO ()
-------------------------------------------- template ------------------------------------------------------
-- for io performance comparison from @Russell_Emerine's code
main_ = do
  t <- get
  replicateM_ t f1

f1 :: SIO ()
f1 = do
  (a, b) <- liftM2 (,) get get
  putln $ f2 a b

f2 :: Int64 -> Int64 -> Int64
f2 a b = (div (abs (a - b) + 9) 10)

import Control.Monad ( replicateM_ )

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [a, b] <- map read . words <$> getLine
    let  x = abs (a - b) :: Integer
    print $ div (x+9) 10

import Control.Monad
main = do
  n <- fmap read getLine
  forM [1..n]
    (\_ -> do
        [a,b] <- fmap (map read.words) getLine
        print $ calc a b)
calc :: Int -> Int -> Int
calc a b = 1 + div ((abs $ a-b)-1) 10


Burenka came to kindergarden. This kindergarten is quite strange, so each kid there receives two fractions ($$$\frac{a}{b}$$$ and $$$\frac{c}{d}$$$) with integer numerators and denominators. Then children are commanded to play with their fractions.Burenka is a clever kid, so she noticed that when she claps once, she can multiply numerator or denominator of one of her two fractions by any integer of her choice (but she can't multiply denominators by $$$0$$$). Now she wants know the minimal number of claps to make her fractions equal (by value). Please help her and find the required number of claps!

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Then follow the descriptions of each test case. The only line of each test case contains four integers $$$a$$$, $$$b$$$, $$$c$$$ and $$$d$$$ ($$$0 \leq a, c \leq 10^9$$$, $$$1 \leq b, d \leq 10^9$$$) — numerators and denominators of the fractions given to Burenka initially.

For each test case print a single integer — the minimal number of claps Burenka needs to make her fractions equal.

NoteIn the first case, Burenka can multiply $$$c$$$ by $$$2$$$, then the fractions will be equal.In the second case, fractions are already equal.In the third case, Burenka can multiply $$$a$$$ by $$$4$$$, then $$$b$$$ by $$$3$$$. Then the fractions will be equal ($$$\frac{1 \cdot 4}{2 \cdot 3} = \frac{2}{3}$$$).

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [a,b,c,d] <- ri
        return ((a,b),(c,d))
    mapM_ (putStrLn.show.solve) tcs

solve ((aa,bb),(cc,dd)) = cntNum
  where
    gAB = gcd aa bb
    gCD = gcd cc dd
    (a,b) = (aa `div` gAB,  bb `div` gAB)
    (c,d) = (cc `div` gCD,  dd `div` gCD)
    ad = a*d
    bc = b*c
    lcmN = lcm ad bc
    cntNum = length . filter (/=lcmN) $ [ad,bc]

module Main where
import Control.Monad

solve::Int->Int->Int->Int->Int
solve a b c d = do
    if (a * d == b * c)
        then 0
    else if (a * c == 0)
        then 1
    else if (rem (a * d) (b * c) == 0)
        then 1
    else if (rem (b * c) (a * d) == 0)
        then 1
    else 2

main = do
  line<-getLine
  let nTerm=read line::Int
  replicateM_ nTerm$do
    line<-getLine
    let (a:b:c:d:_)=map read (words line)::[Int]
    --line<-getLine
    --let nlist=map read (words line)::[Int]
    print (solve a b c d)


You are given two integers $$$n$$$ and $$$k$$$. You are asked to choose maximum number of distinct integers from $$$1$$$ to $$$n$$$ so that there is no subset of chosen numbers with sum equal to $$$k$$$.A subset of a set is a set that can be obtained from initial one by removing some (possibly all or none) elements of it.

The first line contains the number of test cases $$$T$$$ ($$$1 \le T \le 100$$$). Each of the next $$$T$$$ lines contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 1000$$$) — the description of test cases.

For each test case output two lines. In the first line output a single integer $$$m$$$ — the number of chosen integers. In the second line output $$$m$$$ distinct integers from $$$1$$$ to $$$n$$$ — the chosen numbers. If there are multiple answers, print any. You can print the numbers in any order.

main = interact $ concat . map (solveList . map readI . words) . tail . lines

solveList [n, k] = showL (filter isGood [1..n])
  where
    isGood num
        | num == k  = False
        | num < (k+1) `div` 2  = False
        | otherwise  = True

readI s = read s :: Int

showL xs = show (length xs) ++ "\n" ++ (unwords . map show) xs ++ "\n"

module Main where

import Control.Monad

main :: IO ()
main = do
    n <- ((read :: String -> Int) <$> getLine)
    replicateM_ n action

action = do
    [n, k] <- (map (read :: String -> Int) . words) <$> getLine
    print $ (k `div` 2) + max 0 (n - k)
    putStr $ concatMap (\x -> show x ++ " ") $ mkFst k
    putStrLn $ concatMap (\x -> show x ++ " ") [k+1..n]

mkFst x
    | odd x = [(x+1) `div` 2..(x-1)]
    | even x = [x `div` 2..(x-1)]

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n, k] <- getInts
    let xs = filter (/=k) [(k+1)`quot`2..n]
    C.putStrLn $ C.pack $ show $ length xs
    C.putStrLn $ C.pack $ unwords $ map show xs


You are given two lists of segments $$$[al_1, ar_1], [al_2, ar_2], \dots, [al_n, ar_n]$$$ and $$$[bl_1, br_1], [bl_2, br_2], \dots, [bl_n, br_n]$$$.Initially, all segments $$$[al_i, ar_i]$$$ are equal to $$$[l_1, r_1]$$$ and all segments $$$[bl_i, br_i]$$$ are equal to $$$[l_2, r_2]$$$.In one step, you can choose one segment (either from the first or from the second list) and extend it by $$$1$$$. In other words, suppose you've chosen segment $$$[x, y]$$$ then you can transform it either into $$$[x - 1, y]$$$ or into $$$[x, y + 1]$$$.Let's define a total intersection $$$I$$$ as the sum of lengths of intersections of the corresponding pairs of segments, i.e. $$$\sum\limits_{i=1}^{n}{\text{intersection_length}([al_i, ar_i], [bl_i, br_i])}$$$. Empty intersection has length $$$0$$$ and length of a segment $$$[x, y]$$$ is equal to $$$y - x$$$.What is the minimum number of steps you need to make $$$I$$$ greater or equal to $$$k$$$?

The first line contains the single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 2 \cdot 10^5$$$; $$$1 \le k \le 10^9$$$) — the length of lists and the minimum required total intersection. The second line of each test case contains two integers $$$l_1$$$ and $$$r_1$$$ ($$$1 \le l_1 \le r_1 \le 10^9$$$) — the segment all $$$[al_i, ar_i]$$$ are equal to initially. The third line of each test case contains two integers $$$l_2$$$ and $$$r_2$$$ ($$$1 \le l_2 \le r_2 \le 10^9$$$) — the segment all $$$[bl_i, br_i]$$$ are equal to initially. It's guaranteed that the sum of $$$n$$$ doesn't exceed $$$2 \cdot 10^5$$$.

Print $$$t$$$ integers — one per test case. For each test case, print the minimum number of step you need to make $$$I$$$ greater or equal to $$$k$$$.

NoteIn the first test case, we can achieve total intersection $$$5$$$, for example, using next strategy:   make $$$[al_1, ar_1]$$$ from $$$[1, 2]$$$ to $$$[1, 4]$$$ in $$$2$$$ steps;  make $$$[al_2, ar_2]$$$ from $$$[1, 2]$$$ to $$$[1, 3]$$$ in $$$1$$$ step;  make $$$[bl_1, br_1]$$$ from $$$[3, 4]$$$ to $$$[1, 4]$$$ in $$$2$$$ steps;  make $$$[bl_2, br_2]$$$ from $$$[3, 4]$$$ to $$$[1, 4]$$$ in $$$2$$$ steps.  In result, $$$I = \text{intersection_length}([al_1, ar_1], [bl_1, br_1]) + \text{intersection_length}([al_2, ar_2], [bl_2, br_2]) + \\ + \text{intersection_length}([al_3, ar_3], [bl_3, br_3]) = 3 + 2 + 0 = 5$$$In the second test case, we can make $$$[al_1, ar_1] = [0, 1000000000]$$$ in $$$1000000000$$$ steps and $$$[bl_1, br_1] = [0, 1000000000]$$$ in $$$1000000000$$$ steps.In the third test case, the total intersection $$$I$$$ is already equal to $$$10 > 3$$$, so we don't need to do any steps.

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

import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k] <- map read . words <$> getLine
  [l1, r1] <- map read . words <$> getLine
  [l2, r2] <- map read . words <$> getLine
  if r1 >= l2 && r2 >= l1
    then do
      let i = minimum [r1 - l1, r2 - l2, r1 - l2, r2 - l1]
      let u = maximum [r1 - l1, r2 - l2, r1 - l2, r2 - l1]
      if i * n >= k
        then print 0
        else do
          let k' = k - i * n
          let d = u - i
          if n * d >= k'
            then print k'
            else print $ n * d + 2 * (k' - n * d)
    else do
      let i = max (l1 - r2) (l2 - r1)
      let u = max (r2 - l1) (r1 - l2)
      if u >= k
        then print $ i + k
        else
          if u * n >= k
            then print $ (u + i) * (k `div` u) + min (2 * (k `mod` u)) (i + k `mod` u)
            else print $ (u + i) * n + 2 * (k - u * n)

solveCase :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer
  -> Integer
solveCase n k x1 y1 x2 y2
  | x1 > x2   = solveCase n k x2 y2 x1 y1 -- canonicalize
  | x2 <= y1  = let  -- overlap
    existingOverlap = n * (min y1 y2 - x2)
    attainableOverlap = n * (max y1 y2 - x1)
    in  if  k <= attainableOverlap
        then  max 0 $ k - existingOverlap
        else  2*k - existingOverlap - attainableOverlap
  | otherwise  = let
    value = y2 - x1
    separation = x2 - y1
    cost = value + separation
    in
      case  divMod k value  of
        (0, _)  -> k + x2 - y1
        (q, r)
          | q < n      -> q * cost + min (2*r) (separation + r)
          | otherwise  -> n * cost + 2 * (k - n * value)

soln :: [Integer] -> [Integer]
soln (n : k : x1 : y1 : x2 : y2 : excess)
  = solveCase n k x1 y1 x2 y2 : soln excess
soln _ = []

main :: IO ()
main = interact (unlines . map show . soln . map read . tail . words)

solveCase :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer
  -> Integer
solveCase n k x1 y1 x2 y2
  | x1 > x2   = solveCase n k x2 y2 x1 y1 -- canonicalize
  | x2 <= y1  = let  -- overlap
    existingOverlap = n * (min y1 y2 - x2)
    attainableOverlap = n * (max y1 y2 - x1)
    in  if  k <= attainableOverlap
        then  max 0 $ k - existingOverlap
        else  2*k - existingOverlap - attainableOverlap
  | otherwise  = let
    value = y2 - x1
    separation = x2 - y1
    cost = value + separation
    in
      case  divMod k value  of
        (0, _)  -> k + x2 - y1
        (q, r)
          | q < n      -> q * cost + min (2*r) (separation + r)
          | otherwise  -> q * cost + 2 * (k - n * value)

soln :: [Integer] -> [Integer]
soln (n : k : x1 : y1 : x2 : y2 : excess)
  = solveCase n k x1 y1 x2 y2 : soln excess
soln _ = []

main :: IO ()
main = interact (unlines . map show . soln . map read . tail . words)


Ramesses knows a lot about problems involving trees (undirected connected graphs without cycles)!He created a new useful tree decomposition, but he does not know how to construct it, so he asked you for help!The decomposition is the splitting the edges of the tree in some simple paths in such a way that each two paths have at least one common vertex. Each edge of the tree should be in exactly one path.Help Remesses, find such a decomposition of the tree or derermine that there is no such decomposition.

The first line contains a single integer $$$n$$$ ($$$2 \leq n \leq 10^{5}$$$) the number of nodes in the tree. Each of the next $$$n - 1$$$ lines contains two integers $$$a_i$$$ and $$$b_i$$$ ($$$1 \leq a_i, b_i \leq n$$$, $$$a_i \neq b_i$$$) — the edges of the tree. It is guaranteed that the given edges form a tree.

If there are no decompositions, print the only line containing "No". Otherwise in the first line print "Yes", and in the second line print the number of paths in the decomposition $$$m$$$.  Each of the next $$$m$$$ lines should contain two integers $$$u_i$$$, $$$v_i$$$ ($$$1 \leq u_i, v_i \leq n$$$, $$$u_i \neq v_i$$$) denoting that one of the paths in the decomposition is the simple path between nodes $$$u_i$$$ and $$$v_i$$$.  Each pair of paths in the decomposition should have at least one common vertex, and each edge of the tree should be presented in exactly one path. You can print the paths and the ends of each path in arbitrary order. If there are multiple decompositions, print any.

NoteThe tree from the first example is shown on the picture below:  The number next to each edge corresponds to the path number in the decomposition. It is easy to see that this decomposition suits the required conditions.The tree from the second example is shown on the picture below:  We can show that there are no valid decompositions of this tree.The tree from the third example is shown on the picture below:  The number next to each edge corresponds to the path number in the decomposition. It is easy to see that this decomposition suits the required conditions.

module Main where

import Data.Array
import Data.Array.ST.Safe
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C

import Data.List

type Graph = Array Int [Int]

getTree :: IO Graph
getTree = do
  input <- fmap (C.split '\n') $ BS.getContents
  let verticeCount = read . C.unpack . head $ input
      edgesBS = [(v1,v2) | edgeBS <- tail input, not $ BS.null edgeBS, let [v1, v2] = C.split ' ' edgeBS]
      edges = map (\(v1,v2) -> let
                      Just (v1', _) = C.readInt v1
                      Just (v2', _) = C.readInt v2
                      in (v1',v2')) edgesBS
  return $ runSTArray $ do
    tree <- newArray (1,verticeCount) []
    forM_ edges (\(v1,v2) -> do
                    v1Neighbours <- readArray tree v1
                    v2Neighbours <- readArray tree v2
                    writeArray tree v1 (v2:v1Neighbours)
                    writeArray tree v2 (v1:v2Neighbours))
    return tree

main :: IO ()
main = do
  tree <- getTree
  let degrees = fmap (\(id, neighbours) -> (id, length neighbours)) $ assocs tree
      leafs = filter (\(_, d) -> d == 1) degrees
      maxVerticeDegree = maximumBy (\(_, d1) (_,d2) -> compare d1 d2) degrees
      ok = null . filter (\(_,x) -> x /= 1 && x /= 2 && x /= snd maxVerticeDegree) $ degrees
  if (length leafs) == snd maxVerticeDegree && ok || length degrees == 2 then do
    putStrLn "Yes"
    if snd maxVerticeDegree == 2 || length degrees == 2 then do
      putStrLn "1"
      mapM_ (putStr . (++ " ") .  show . fst) leafs
    else do
      print $ length leafs
      forM_ leafs (\(id,_) -> putStrLn $ show (fst maxVerticeDegree) ++ " " ++ show id)
  else
    putStrLn "No"

module Main where

import Data.Array
import Data.Array.ST.Safe
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C

import Data.List

type Graph = Array Int [Int]

getTree :: IO Graph
getTree = do
  input <- fmap (C.split '\n') $ BS.getContents
  let verticeCount = read . C.unpack . head $ input
      edgesBS = [(v1,v2) | edgeBS <- tail input, not $ BS.null edgeBS, let [v1, v2] = C.split ' ' edgeBS]
      edges = map (\(v1,v2) -> let
                      Just (v1', _) = C.readInt v1
                      Just (v2', _) = C.readInt v2
                      in (v1',v2')) edgesBS
  return $ runSTArray $ do
    tree <- newArray (1,verticeCount) []
    forM_ edges (\(v1,v2) -> do
                    v1Neighbours <- readArray tree v1
                    v2Neighbours <- readArray tree v2
                    writeArray tree v1 (v2:v1Neighbours)
                    writeArray tree v2 (v1:v2Neighbours))
    return tree

main :: IO ()
main = do
  tree <- getTree
  let degrees = fmap (\(id, neighbours) -> (id, length neighbours)) $ assocs tree
      leafs = filter (\(_, d) -> d == 1) degrees
      maxVerticeDegree = maximumBy (\(_, d1) (_,d2) -> compare d1 d2) degrees
      ok = null . filter (\(_,x) -> x /= 1 && x /= 2 && x /= snd maxVerticeDegree) $ degrees
  if (length leafs) == snd maxVerticeDegree && ok then do
    putStrLn "Yes"
    if snd maxVerticeDegree == 2 then do
      putStrLn "1"
      mapM_ (putStr . (++ " ") .  show . fst) leafs
    else do
      print $ length leafs
      forM_ leafs (\(id,_) -> putStrLn $ show (fst maxVerticeDegree) ++ " " ++ show id)
  else
    putStrLn "No"


Dark Assembly is a governing body in the Netherworld. Here sit the senators who take the most important decisions for the player. For example, to expand the range of the shop or to improve certain characteristics of the character the Dark Assembly's approval is needed.The Dark Assembly consists of n senators. Each of them is characterized by his level and loyalty to the player. The level is a positive integer which reflects a senator's strength. Loyalty is the probability of a positive decision in the voting, which is measured as a percentage with precision of up to 10%. Senators make decisions by voting. Each of them makes a positive or negative decision in accordance with their loyalty. If strictly more than half of the senators take a positive decision, the player's proposal is approved. If the player's proposal is not approved after the voting, then the player may appeal against the decision of the Dark Assembly. To do that, player needs to kill all the senators that voted against (there's nothing wrong in killing senators, they will resurrect later and will treat the player even worse). The probability that a player will be able to kill a certain group of senators is equal to A / (A + B), where A is the sum of levels of all player's characters and B is the sum of levels of all senators in this group. If the player kills all undesired senators, then his proposal is approved.Senators are very fond of sweets. They can be bribed by giving them candies. For each received candy a senator increases his loyalty to the player by 10%. It's worth to mention that loyalty cannot exceed 100%. The player can take no more than k sweets to the courtroom. Candies should be given to the senators before the start of voting.Determine the probability that the Dark Assembly approves the player's proposal if the candies are distributed among the senators in the optimal way.

The first line contains three integers n, k and A (1 ≤ n, k ≤ 8, 1 ≤ A ≤ 9999). Then n lines follow. The i-th of them contains two numbers — bi and li — the i-th senator's level and his loyalty. The levels of all senators are integers in range from 1 to 9999 (inclusive). The loyalties of all senators are integers in range from 0 to 100 (inclusive) and all of them are divisible by 10.

Print one real number with precision 10 - 6 — the maximal possible probability that the Dark Assembly approves the player's proposal for the best possible distribution of candies among the senators.

NoteIn the first sample the best way of candies' distribution is giving them to first three of the senators. It ensures most of votes.It the second sample player should give all three candies to the fifth senator.

module Main where

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

main = do
    [n, k, a] <- ( map read . words ) `liftM` getLine

    senators <- replicateM n $ do
        [level, loyalty] <- ( map read . words ) `liftM` getLine :: IO [Int]
        return (level, loyalty)

    let vote = voteDist n
        candy = candyDist n k

    --putStrLn $ show $ candy
    --putStrLn $ show $ vote

    let prob = foldl' (\best cdist ->
                let senators' = zipWith (\(level, loyalty) c -> (level, fromIntegral (min (loyalty + 10 * c) 100) / 100)) senators cdist
                    winProb = foldl' (\prevProb vdist ->
                        let winCount = length $ filter (==True) vdist
                            prob = product $ zipWith (\(level, loyalty) v -> if v then loyalty else 1 - loyalty) senators' vdist
                            b = sum $ zipWith (\(level, loyalty) v -> if v then 0 else level) senators' vdist
                            winProb = if winCount > n `div` 2
                                then 1
                                else (fromIntegral a :: Double) / (fromIntegral (a + b) :: Double)
                        in if prob > 0 then prevProb + prob * winProb else prevProb
                        ) 0 vote
                in max winProb best
            ) 0 candy

    printf "%.10f\n" prob

candyDist :: Int -> Int -> [[Int]]
candyDist 0 0 = [[]]
candyDist 0 _ = []
candyDist n k = [0..k] >>= \k' -> map (k':) $ candyDist (n-1) (k-k')

voteDist :: Int -> [[Bool]]
voteDist 0 = [[]]
voteDist n = [True, False] >>= \v -> map (v:) $ voteDist (n-1)

d 0 k=[[]]
d n k=do{f<-[0..k];o<-d(n-1)$k-f;[f:o]}
b d(s,l)|d+l*10>10.5=[]|1>0=[(s,d/10+l)]
s([n,k,a]:t)=fmap(g(read a)0 0).sequence.($map(\[s,l]->(read s,read l/100))t).zipWith b=<<d(read n)(read k)
g e s p []|p>0=1|1>0=e/(e+s)
g e s p ((q,l):t)=l*g e s(p+1)t+(1-l)*g e(s+q)(p-1)t
main=interact$show.maximum.s.map words.lines

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

import Data.Ord
import Control.Applicative
import Control.Monad
import qualified Data.Map as Map
import Data.Map(Map)
import Data.List
import Control.Arrow
import Data.Maybe

parseSenator :: [String] -> (Double, Integer)
parseSenator [str, loyalty] = (read str, read loyalty `div` 10)

distr 0 k = return []
distr n k = do
  first <- [0..k]
  others <- distr (n-1) (k-first)
  return (first : others)

bribe d (s, l)
  | newL > 10 = Nothing
  | otherwise = Just (s, newL)
                where
                  newL = d+l

main = do
  [n, k, a] <- map read . words <$> getLine
  senators <- sequence $ genericReplicate n $ parseSenator . words <$> getLine
  let distributions = distr (n+1) k -- +1 to account for "keep candy" scenario
      fight s = fromIntegral a / (fromIntegral a + s)
      s l = go l 0 0
        where
          go [] s p | p > 0 = 1
           | otherwise = fight s
          go ((ss, l) : t) s p = l' * go t s (p+1) + (1-l') * go t (s+ss) (p-1)
            where l' = fromIntegral l / 10
      solve distribution = do
        candiedSenators <- sequence $ map maybeToList $ zipWith bribe distribution senators
        return $ s candiedSenators
      result = maximum $ solve =<< distributions :: Double
  putStrLn $ show result


Over time, Alexey's mail box got littered with too many letters. Some of them are read, while others are unread.Alexey's mail program can either show a list of all letters or show the content of a single letter. As soon as the program shows the content of an unread letter, it becomes read letter (if the program shows the content of a read letter nothing happens). In one click he can do any of the following operations: Move from the list of letters to the content of any single letter. Return to the list of letters from single letter viewing mode. In single letter viewing mode, move to the next or to the previous letter in the list. You cannot move from the first letter to the previous one or from the last letter to the next one.The program cannot delete the letters from the list or rearrange them.Alexey wants to read all the unread letters and go watch football. Now he is viewing the list of all letters and for each letter he can see if it is read or unread. What minimum number of operations does Alexey need to perform to read all unread letters?

The first line contains a single integer n (1 ≤ n ≤ 1000) — the number of letters in the mailbox. The second line contains n space-separated integers (zeros and ones) — the state of the letter list. The i-th number equals either 1, if the i-th number is unread, or 0, if the i-th letter is read.

Print a single number — the minimum number of operations needed to make all the letters read.

NoteIn the first sample Alexey needs three operations to cope with the task: open the second letter, move to the third one, move to the fourth one.In the second sample the action plan: open the first letter, move to the second letter, return to the list, open the fifth letter.In the third sample all letters are already read.

main :: IO()
main = print . solve 0 0 . map read . tail . words =<< getContents

solve :: Int -> Int -> [Int] -> Int
solve _ _ []    = 0
solve i _ (0:x) = solve i 0 x
solve _ 1 (1:x) = 1 + solve 1 1 x
solve i 0 (1:x) = i + 1 + solve 1 1 x

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . calAns . findIndices (== 1). tail . getIntArray

calAns :: [Int] -> Int
calAns [] = 0
calAns (x:[]) = 1
calAns (x:y:xs) = calAns (y:xs) + min (y - x) 2

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . calAns . findIndices (== 1). tail . getIntArray

calAns :: [Int] -> Int
calAns [] = 0
calAns (x:[]) = 1
calAns (x:y:xs) = calAns (y:xs) + if y - x >= 2 then 2 else y - x

import qualified Data.List as L
drop0::[[Int]] -> [[Int]]
drop0 [] = []
drop0 x = if (head.head) x == 0 then tail x else x
drop0'::[[Int]] -> [[Int]]
drop0' [] = []
drop0' x = if (head.last) x == 0 then init x else x
transform :: [[Int]] -> [[Int]]
transform = map (\xs -> if head xs == 0 then [0] else xs)
main :: IO()
main = do
  _ <- getLine
  numbers <- fmap (map read.words) getLine :: IO[Int]
  print$sum$map length.transform.drop0'.drop0.L.group$numbers

module Main where

import Control.Monad

main :: IO ()
main =
  do _ <- getLine
     l <- liftM ((++ ['0', '1']) . (map head) . words) getLine
     (print :: Int -> IO ()) $ max 0 $ (\x -> x - 2) $ fst $ foldl (\(c, x) y -> if y == '1' then (c + 1, True) else if x then (c + 1, False) else (c, False)) (0, False) l
     return ()

import Data.List
main=interact$show.max 0.pred.sum.map(succ.length).filter((>0).head).group.map read.tail.words

import Data.List (group)

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

solve :: [Int] -> Int
solve = max 0 . pred . sum . map (succ . length) . filter ((>0) . head) . group

main = getLine >> getLine >>= return . f 0 . words >>= print

f n ("0" : as) = f n as
f n ("1" : as) = f (n + c + 2) tail
  where
    (front, tail) = span (== "1") as
    c = length front
f 0 [] = 0 :: Int
f n [] = n - 1

solve :: [String] -> Int
solve x = count_groups ("0":x) + max ((sum $ map read x) - 1) 0 where
	count_groups [] = 0
	count_groups [x] = 0
	count_groups (x:t@(y:z)) = if x == "0" && y == "1" then 1 + count_groups z else count_groups t

main = interact $ show.solve.words.last.lines

pre ('0':xs) = pre xs
pre (' ':xs) = pre xs
pre xs = xs

solve [] = 0
solve (' ':xs) = solve xs
solve ['0'] = 0
solve ('0':' ':'0':xs) = solve ('0':xs)
solve ('0':' ':'1':xs) = 1 + solve ('1':xs)
solve ('1':xs) = 1 + solve xs

main = do
    n <- getLine
    n <- getLine
    print(solve(pre n))

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

process [] n  = n
process (s:ss) n  | s==1 = process ss (n+1)
                  | otherwise=  process (dropWhile (==0) ss) (n+1)
main= do
	getLine
	s<-  map (fst.fromJust.C.readInt). C.words <$> C.getLine :: IO [Int]
	print $ process (reverse (dropWhile (==0) (reverse (dropWhile (==0) s)))) 0

import qualified Data.List as L
drop0::[[Int]] -> [[Int]]
drop0 [] = []
drop0 x = if (head.head) x == 0 then tail x else x
drop0'::[[Int]] -> [[Int]]
drop0' [] = []
drop0' x = if (head.last) x == 0 then tail x else x
transform :: [[Int]] -> [[Int]]
transform = map (\xs -> if head xs == 0 then [0] else xs)
main :: IO()
main = do
  _ <- getLine
  numbers <- fmap (map length.transform.drop0'.drop0.L.group.map read.words) getLine :: IO[Int]
  print$sum numbers


Numbers $$$1, 2, 3, \dots n$$$ (each integer from $$$1$$$ to $$$n$$$ once) are written on a board. In one operation you can erase any two numbers $$$a$$$ and $$$b$$$ from the board and write one integer $$$\frac{a + b}{2}$$$ rounded up instead.You should perform the given operation $$$n - 1$$$ times and make the resulting number that will be left on the board as small as possible. For example, if $$$n = 4$$$, the following course of action is optimal:  choose $$$a = 4$$$ and $$$b = 2$$$, so the new number is $$$3$$$, and the whiteboard contains $$$[1, 3, 3]$$$;  choose $$$a = 3$$$ and $$$b = 3$$$, so the new number is $$$3$$$, and the whiteboard contains $$$[1, 3]$$$;  choose $$$a = 1$$$ and $$$b = 3$$$, so the new number is $$$2$$$, and the whiteboard contains $$$[2]$$$. It's easy to see that after $$$n - 1$$$ operations, there will be left only one number. Your goal is to minimize it.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The only line of each test case contains one integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the number of integers written on the board initially. It's guaranteed that the total sum of $$$n$$$ over test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, in the first line, print the minimum possible number left on the board after $$$n - 1$$$ operations. Each of the next $$$n - 1$$$ lines should contain two integers — numbers $$$a$$$ and $$$b$$$ chosen and erased in each operation.

{-# LANGUAGE Safe #-}

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

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> map (read >>> solve >>> showAns)
      >>> concat
      >>> unlines
  where
    showAns (x, ys) = show x : map showII ys
    showII (x, y) = show x ++ " " ++ show y

solve :: Int -> (Int, [(Int, Int)])
solve n = (2, ((n - 1, n) :) . reverse $ zip [1 .. n] [3 .. n])

import Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        putStrLn "2"
        putStrLn $ unlines $ map (\(a, b) -> unwords [show a, show b]) $ solve $ [n,n-1..1]

solve :: [Int] -> [(Int, Int)]
solve [] = error "Solve called on empty list."
solve (x:[])
        | x == 2 = []
        | otherwise = error ("Minimum not reached: " ++ show x)
solve (a:b:xs) = (a, b):(solve $ (quot (a + b + 1) 2):xs)

import Control.Monad (forM_)

solve :: Int -> [String]
solve 3 = ["1 3"]
solve 2 = ["1 2"]
solve n = (show (n - 2) ++ " " ++ show n) : solve (n - 1)

solve' :: Int -> [String]
solve' 3 = "3 1" : "2 2" : []
solve' 2 = "2 1" : []
solve' n = (show (n - 2) ++ " " ++ show n) : (show (n - 1) ++ " " ++ show (n - 1)) : solve (n - 1)

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] $ \_ -> do
    n <- pure . read =<< getLine
    putStrLn "2"
    mapM_ putStrLn . solve' $ n


It's now 260 AD. Shapur, being extremely smart, became the King of Persia. He is now called Shapur, His majesty King of kings of Iran and Aniran.Recently the Romans declared war on Persia. They dreamed to occupy Armenia. In the recent war, the Romans were badly defeated. Now their senior army general, Philip is captured by Shapur and Shapur is now going to capture Valerian, the Roman emperor.Being defeated, the cowardly Valerian hid in a room at the top of one of his castles. To capture him, Shapur has to open many doors. Fortunately Valerian was too scared to make impenetrable locks for the doors.Each door has 4 parts. The first part is an integer number a. The second part is either an integer number b or some really odd sign which looks like R. The third one is an integer c and the fourth part is empty! As if it was laid for writing something. Being extremely gifted, after opening the first few doors, Shapur found out the secret behind the locks.c is an integer written in base a, to open the door we should write it in base b. The only bad news is that this R is some sort of special numbering system that is used only in Roman empire, so opening the doors is not just a piece of cake!Here's an explanation of this really weird number system that even doesn't have zero:Roman numerals are based on seven symbols: a stroke (identified with the letter I) for a unit, a chevron (identified with the letter V) for a five, a cross-stroke (identified with the letter X) for a ten, a C (identified as an abbreviation of Centum) for a hundred, etc.: I=1 V=5 X=10 L=50 C=100 D=500 M=1000Symbols are iterated to produce multiples of the decimal (1, 10, 100, 1, 000) values, with V, L, D substituted for a multiple of five, and the iteration continuing: I 1, II 2, III 3, V 5, VI 6, VII 7, etc., and the same for other bases: X 10, XX 20, XXX 30, L 50, LXXX 80; CC 200, DCC 700, etc. At the fourth and ninth iteration, a subtractive principle must be employed, with the base placed before the higher base: IV 4, IX 9, XL 40, XC 90, CD 400, CM 900.Also in bases greater than 10 we use A for 10, B for 11, etc.Help Shapur capture Valerian and bring peace back to Persia, especially Armenia.

The first line contains two integers a and b (2 ≤ a, b ≤ 25). Only b may be replaced by an R which indicates Roman numbering system. The next line contains a single non-negative integer c in base a which may contain leading zeros but its length doesn't exceed 103.  It is guaranteed that if we have Roman numerals included the number would be less than or equal to 300010 and it won't be 0. In any other case the number won't be greater than 101510.

Write a single line that contains integer c in base b. You must omit leading zeros.

NoteYou can find more information about roman numerals here: http://en.wikipedia.org/wiki/Roman_numerals

import Data.Char
ord' = fromIntegral.ord
chr' = chr.fromIntegral
toA::Integer->Integer->[Char]
toA a x = reverse $ toA' a x where
    toA' a x = let
        x' = x `mod` a
        x1 = x `div` a
        s | x' < 10 = chr' (x' + ord' '0')
          | x' >= 10 = chr' (x' + ord' 'A' - 10) in
        if x1 > 0 then s:(toA' a x1) else [s]
fromA::Integer->[Char]->Integer
fromA a ss = fromA' a 0 ss where
    fromA' a sum (s:ss) | s `elem` ['0'..'9'] = fromA' a (sum * a
                            + (ord' s - ord' '0')) ss
                        | s `elem` ['A'..'Z'] = fromA' a (sum * a
                            + (ord' s - ord' 'A' + 10)) ss
    fromA' a sum [] = sum
toRoman x | x > 1000 = replicate (x `div` 1000) 'M' ++ toRoman (x `mod` 1000)
          | x `div` 100 > 0 = (case (x `div` 100) of
                1 -> "C"
                2 -> "CC"
                3 -> "CCC"
                4 -> "CD"
                5 -> "D"
                6 -> "DC"
                7 -> "DCC"
                8 -> "DCCC"
                9 -> "CM") ++ toRoman (x `mod` 100)
          | x `div` 10 > 0 = (case (x `div` 10) of
                1 -> "X"
                2 -> "XX"
                3 -> "XXX"
                4 -> "XL"
                5 -> "L"
                6 -> "LX"
                7 -> "LXX"
                8 -> "LXXX"
                9 -> "XC") ++ toRoman (x `mod` 10)
          | x > 0 = case x of
                1 -> "I"
                2 -> "II"
                3 -> "III"
                4 -> "IV"
                5 -> "V"
                6 -> "VI"
                7 -> "VII"
                8 -> "VIII"
                9 -> "IX"
          | x == 0 = ""

main = do
    [a', b'] <- words `fmap` getLine
    let a = read a'
    x <- fromA a `fmap` getLine
    putStr (if b' == "R" then toRoman $ fromIntegral x else toA (read b') x)

import Char
main = interact solve
solve input = output where
  [[a0,b0],[c]] = map words $ lines input
  a = read a0 :: Integer
  b = if b0=="R" then 0 else read b0 :: Integer
  output = c1
  c0 = fromBase c a
  c1 = toBase c0 b
fromBase :: String -> Integer -> Integer
fromBase x y = fromBase' (map toNumber x) y
fromBase' :: [Integer] -> Integer -> Integer
fromBase' [] y = 0
fromBase' [x] y = x
fromBase' (x:y:xs) z = fromBase' (x*z+y:xs) z
toNumber :: Char -> Integer
toNumber x = toInteger $ ord x - if '0'<=x && x<='9' then ord '0' else ord 'A' - 10
toBase :: Integer -> Integer -> String
toBase x y = if y==0 then roman x else toBase' x y
toBase' :: Integer -> Integer -> String
toBase' x y
  | x<y && x<10 = show x
  | x<y         = [chr $ fromIntegral x - 10 + ord 'A']
  | otherwise   = toBase' (div x y) y ++ toBase' (mod x y) y
roman :: Integer -> String
roman x
  | x>=1000 = "M" ++(roman (x-1000))
  | x>=900  = "CM"++(roman (x-900))
  | x>=500  = "D" ++(roman (x-500))
  | x>=400  = "CD"++(roman (x-400))
  | x>=100  = "C" ++(roman (x-100))
  | x>=90   = "XC"++(roman (x-90))
  | x>=50   = "L" ++(roman (x-50))
  | x>=40   = "XL"++(roman (x-40))
  | x>=10   = "X" ++(roman (x-10))
  | x>=9    = "IX"++(roman (x-9))
  | x>=5    = "V" ++(roman (x-5))
  | x>=4    = "IV"++(roman (x-4))
  | x>=1    = "I" ++(roman (x-1))
  | otherwise = ""

import Data.List
import Data.Char

toBase :: Integer -> Integer -> [Integer]
toBase b v = toBase' [] v where
  toBase' a 0 = a
  toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b

fromBase :: Integer -> [Integer] -> Integer
fromBase b ds = foldl' (\n k -> n * b + k) 0 ds

toAlphaDigits :: [Integer] -> [Char]
toAlphaDigits = map convert where
  convert n | n < 10    = chr ((fromIntegral n) + ord '0')
            | otherwise = chr ((fromIntegral n) + ord 'A' - 10)

fromAlphaDigits :: [Char] -> [Integer]
fromAlphaDigits = map convert where
 convert c | isDigit c = toInteger (ord c - ord '0')
           | isUpper c = toInteger (ord c - ord 'A' + 10)
           | isLower c = toInteger (ord c - ord 'a' + 10)

rep x 0 = []
rep x n = x : rep x (n-1)

toRoman x
  | x >= 1000 = let (q,r) = x `divMod` 1000
                in rep 'M' q ++ toRoman r
  | x >= 100 = toRomanCent x (x `div` 100)
  | x >= 10 = toRomanDec x (x `div` 10)
  | x > 0 = toRomanUn x
  | otherwise = []

toRomanCent x q
  | q >= 9 = "CM" ++ toRoman (x - 900)
  | q >= 5 = "D" ++ toRoman (x - 500)
  | q >= 4 = "CD" ++ toRoman (x - 400)
  | otherwise = rep 'C' q ++ toRoman (x - 100*q)

toRomanDec x q
  | q >= 9 = "XC" ++ toRoman (x - 90)
  | q >= 5 = "L" ++ toRoman (x - 50)
  | q >= 4 = "XL" ++ toRoman (x - 40)
  | otherwise = rep 'X' q ++ toRoman (x - 10*q)

toRomanUn x
  | x >= 9 = "IX"
  | x >= 5 = "V" ++ toRoman (x - 5)
  | x >= 4 = "IV"
  | otherwise = rep 'I' x

main = do
  fstLine <- getLine
  let bases = words fstLine
      inBase = read $ head bases
      outBase = if (head.head.tail $ bases) == 'R'
                then Nothing
                else Just $ read $ head.tail $ bases
  -- print bases
  inputStr <- getLine
  let input = fromBase inBase $ fromAlphaDigits inputStr
  putStrLn $ case input of 0 -> "0"
                           _ -> case outBase of
                                     Nothing -> toRoman input
                                     Just base ->
                                       toAlphaDigits $ toBase base input

import Data.Char
toA a x = reverse $ toA' a x where
    toA' a x = let
        x' = x `mod` a
        x1 = x `div` a
        s | x' < 10 = chr (x' + ord '0')
          | x' >= 10 = chr (x' + ord 'A' - 10) in
        if x1 > 0 then s:(toA' a x1) else [s]
fromA a ss = fromA' a 0 ss where
    fromA' a sum (s:ss) | s `elem` ['0'..'9'] = fromA' a (sum * a + (ord s - ord '0')) ss
                        | s `elem` ['A'..'Z'] = fromA' a (sum * a + (ord s - ord 'A' + 10)) ss
    fromA' a sum [] = sum
toRoman x | x > 1000 = replicate (x `div` 1000) 'M' ++ toRoman (x `mod` 1000)
          | x `div` 100 > 0 = (case (x `div` 100) of
                1 -> "C"
                2 -> "CC"
                3 -> "CCC"
                4 -> "CD"
                5 -> "D"
                6 -> "DC"
                7 -> "DCC"
                8 -> "DCC"
                9 -> "CM") ++ toRoman (x `mod` 100)
          | x `div` 10 > 0 = (case (x `div` 10) of
                1 -> "X"
                2 -> "XX"
                3 -> "XXX"
                4 -> "XL"
                5 -> "L"
                6 -> "LX"
                7 -> "LXX"
                8 -> "LXXX"
                9 -> "XC") ++ toRoman (x `mod` 10)
          | x > 0 = case x of
                1 -> "I"
                2 -> "II"
                3 -> "III"
                4 -> "IV"
                5 -> "V"
                6 -> "VI"
                7 -> "VII"
                8 -> "VIII"
                9 -> "IX"
          | x == 0 = ""

main = do
    [a', b'] <- words `fmap` getLine
    let a = read a'
    x <- fromA a `fmap` getLine
    putStr (if b' == "R" then toRoman x else toA (read b') x)

import Data.Char
ord' = fromIntegral.ord
chr' = chr.fromIntegral
toA::Integer->Integer->[Char]
toA a x = reverse $ toA' a x where
    toA' a x = let
        x' = x `mod` a
        x1 = x `div` a
        s | x' < 10 = chr' (x' + ord' '0')
          | x' >= 10 = chr' (x' + ord' 'A' - 10) in
        if x1 > 0 then s:(toA' a x1) else [s]
fromA::Integer->[Char]->Integer
fromA a ss = fromA' a 0 ss where
    fromA' a sum (s:ss) | s `elem` ['0'..'9'] = fromA' a (sum * a
                            + (ord' s - ord' '0')) ss
                        | s `elem` ['A'..'Z'] = fromA' a (sum * a
                            + (ord' s - ord' 'A' + 10)) ss
    fromA' a sum [] = sum
toRoman x | x > 1000 = replicate (x `div` 1000) 'M' ++ toRoman (x `mod` 1000)
          | x `div` 100 > 0 = (case (x `div` 100) of
                1 -> "C"
                2 -> "CC"
                3 -> "CCC"
                4 -> "CD"
                5 -> "D"
                6 -> "DC"
                7 -> "DCC"
                8 -> "DCC"
                9 -> "CM") ++ toRoman (x `mod` 100)
          | x `div` 10 > 0 = (case (x `div` 10) of
                1 -> "X"
                2 -> "XX"
                3 -> "XXX"
                4 -> "XL"
                5 -> "L"
                6 -> "LX"
                7 -> "LXX"
                8 -> "LXXX"
                9 -> "XC") ++ toRoman (x `mod` 10)
          | x > 0 = case x of
                1 -> "I"
                2 -> "II"
                3 -> "III"
                4 -> "IV"
                5 -> "V"
                6 -> "VI"
                7 -> "VII"
                8 -> "VIII"
                9 -> "IX"
          | x == 0 = ""

main = do
    [a', b'] <- words `fmap` getLine
    let a = read a'
    x <- fromA a `fmap` getLine
    putStr (if b' == "R" then toRoman $ fromIntegral x else toA (read b') x)

import Data.List
import Data.Char

toBase :: Integer -> Integer -> [Integer]
toBase b v = toBase' [] v where
  toBase' a 0 = a
  toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b

fromBase :: Integer -> [Integer] -> Integer
fromBase b ds = foldl' (\n k -> n * b + k) 0 ds

toAlphaDigits :: [Integer] -> [Char]
toAlphaDigits = map convert where
  convert n | n < 10    = chr ((fromIntegral n) + ord '0')
            | otherwise = chr ((fromIntegral n) + ord 'A' - 10)

fromAlphaDigits :: [Char] -> [Integer]
fromAlphaDigits = map convert where
 convert c | isDigit c = toInteger (ord c - ord '0')
           | isUpper c = toInteger (ord c - ord 'A' + 10)
           | isLower c = toInteger (ord c - ord 'a' + 10)

rep x 0 = []
rep x n = x : rep x (n-1)

toRoman x
  | x >= 1000 = let (q,r) = x `divMod` 1000
                in rep 'M' q ++ toRoman r
  | x >= 100 = toRomanCent x (x `div` 100)
  | x >= 10 = toRomanDec x (x `div` 10)
  | x > 0 = toRomanUn x
  | otherwise = []

toRomanCent x q
  | q >= 9 = "CM" ++ toRoman (x - 900)
  | q >= 5 = "D" ++ toRoman (x - 500)
  | q >= 4 = "CD" ++ toRoman (x - 400)
  | otherwise = rep 'C' q ++ toRoman (x - 100*q)

toRomanDec x q
  | q >= 9 = "XC" ++ toRoman (x - 90)
  | q >= 5 = "L" ++ toRoman (x - 50)
  | q >= 4 = "XL" ++ toRoman (x - 40)
  | otherwise = rep 'X' q ++ toRoman (x - 10*q)

toRomanUn x
  | x >= 9 = "IX"
  | x >= 5 = "V" ++ toRoman (x - 5)
  | x >= 4 = "IV"
  | otherwise = rep 'I' x

main = do
  fstLine <- getLine
  let bases = words fstLine
      inBase = read $ head bases
      outBase = if (head.head.tail $ bases) == 'R'
                then Nothing
                else Just $ read $ head.tail $ bases
  -- print bases
  inputStr <- getLine
  let input = fromBase inBase $ fromAlphaDigits inputStr
  putStrLn $ case outBase of Nothing -> toRoman input
                             Just 0 -> "0"
                             Just base -> toAlphaDigits $ toBase base input

import Data.List
import Data.Char

toBase :: Integer -> Integer -> [Integer]
toBase b v = toBase' [] v where
  toBase' a 0 = a
  toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b

fromBase :: Integer -> [Integer] -> Integer
fromBase b ds = foldl' (\n k -> n * b + k) 0 ds

toAlphaDigits :: [Integer] -> [Char]
toAlphaDigits = map convert where
  convert n | n < 10    = chr ((fromIntegral n) + ord '0')
            | otherwise = chr ((fromIntegral n) + ord 'A' - 10)

fromAlphaDigits :: [Char] -> [Integer]
fromAlphaDigits = map convert where
 convert c | isDigit c = toInteger (ord c - ord '0')
           | isUpper c = toInteger (ord c - ord 'A' + 10)
           | isLower c = toInteger (ord c - ord 'a' + 10)

rep x 0 = []
rep x n = x : rep x (n-1)

toRoman x
  | x >= 1000 = let (q,r) = x `divMod` 1000
                in rep 'M' q ++ toRoman r
  | x >= 100 = toRomanCent x (x `div` 100)
  | x >= 10 = toRomanDec x (x `div` 10)
  | x > 0 = toRomanUn x
  | otherwise = []

toRomanCent x q
  | q >= 9 = "CM" ++ toRoman (x - 900)
  | q >= 5 = "D" ++ toRoman (x - 500)
  | q >= 4 = "CD" ++ toRoman (x - 400)
  | otherwise = rep 'C' q ++ toRoman (x - 100*q)

toRomanDec x q
  | q >= 9 = "XC" ++ toRoman (x - 90)
  | q >= 5 = "L" ++ toRoman (x - 50)
  | q >= 4 = "XL" ++ toRoman (x - 40)
  | otherwise = rep 'X' q ++ toRoman (x - 10*q)

toRomanUn x
  | x >= 9 = "IX"
  | x >= 5 = "V" ++ toRoman (x - 5)
  | x >= 4 = "IV"
  | otherwise = rep 'I' x

main = do
  fstLine <- getLine
  let bases = words fstLine
      inBase = read $ head bases
      outBase = if (head.head.tail $ bases) == 'R'
                then Nothing
                else Just $ read $ head.tail $ bases
  -- print bases
  inputStr <- getLine
  let input = fromBase inBase $ fromAlphaDigits inputStr
  putStrLn $ case outBase of Nothing -> toRoman input
                             Just base -> toAlphaDigits $ toBase base input

import Data.List
import Data.Char

toBase :: Int -> Int -> [Int]
toBase b v = toBase' [] v where
  toBase' a 0 = a
  toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b

fromBase :: Int -> [Int] -> Int
fromBase b ds = foldl' (\n k -> n * b + k) 0 ds

toAlphaDigits :: [Int] -> String
toAlphaDigits = map convert where
  convert n | n < 10    = chr (n + ord '0')
            | otherwise = chr (n + ord 'A' - 10)

fromAlphaDigits :: String -> [Int]
fromAlphaDigits = map convert where
 convert c | isDigit c = ord c - ord '0'
           | isUpper c = ord c - ord 'A' + 10
           | isLower c = ord c - ord 'a' + 10

rep :: Char -> Int -> String
rep x 0 = []
rep x n = x : rep x (n-1)

toRoman :: Int -> String
toRoman x
  | x >= 1000 = let (q,r) = x `divMod` 1000
                in rep 'M' q ++ toRoman r
  | x >= 100 = toRomanCent x (x `div` 100)
  | x >= 10 = toRomanDec x (x `div` 10)
  | x > 0 = toRomanUn x
  | otherwise = []

toRomanCent x q
  | q >= 9 = "CM" ++ toRoman (x - 900)
  | q >= 5 = "D" ++ toRoman (x - 500)
  | q >= 4 = "CD" ++ toRoman (x - 400)
  | otherwise = rep 'C' q ++ toRoman (x - 100*q)

toRomanDec x q
  | q >= 9 = "XC" ++ toRoman (x - 90)
  | q >= 5 = "L" ++ toRoman (x - 50)
  | q >= 4 = "XL" ++ toRoman (x - 40)
  | otherwise = rep 'X' q ++ toRoman (x - 10*q)

toRomanUn x
  | x >= 9 = "IX"
  | x >= 5 = "V" ++ toRoman (x - 5)
  | x >= 4 = "IV"
  | otherwise = rep 'I' x

main = do
  fstLine <- getLine
  let bases = words fstLine
      inBase = read $ head bases
      outBase = if (head.head.tail $ bases) == 'R'
                then Nothing
                else Just $ read $ head.tail $ bases
  -- print bases
  inputStr <- getLine
  let input = fromBase inBase $ fromAlphaDigits inputStr
  putStrLn $ case outBase of Nothing -> toRoman input
                             Just base -> toAlphaDigits $ toBase base input


A penguin Rocher has $$$n$$$ sticks. He has exactly one stick with length $$$i$$$ for all $$$1 \le i \le n$$$.He can connect some sticks. If he connects two sticks that have lengths $$$a$$$ and $$$b$$$, he gets one stick with length $$$a + b$$$. Two sticks, that were used in the operation disappear from his set and the new connected stick appears in his set and can be used for the next connections.He wants to create the maximum number of sticks that have the same length. It is not necessary to make all sticks have the same length, some sticks can have the other length. How many sticks with the equal length he can create?

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Next $$$t$$$ lines contain descriptions of test cases. For each test case, the only line contains a single integer $$$n$$$ ($$$1 \le n \le 10^{9}$$$).

For each test case, print a single integer  — the answer to the problem.

NoteIn the third case, he can connect two sticks with lengths $$$1$$$ and $$$2$$$ and he will get one stick with length $$$3$$$. So, he will have two sticks with lengths $$$3$$$.In the fourth case, he can connect two sticks with lengths $$$1$$$ and $$$3$$$ and he will get one stick with length $$$4$$$. After that, he will have three sticks with lengths $$$\{2, 4, 4\}$$$, so two sticks have the same length, and one stick has the other length.

solve :: Integer -> Integer
solve n = (n-1) `div` 2 + 1

readInt :: IO Integer
readInt = do
    line <- getLine
    let a = read line :: Integer
    return a

main :: IO ()
main = do
    t <- readInt
    for t where
        for 0 = return ()
        for t = do
            n <- readInt
            putStrLn $ show $ solve n
            for (t-1)

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

main = getLine >>= flip replicateM_ test . read

test = getLine >>= print . (`div` 2) . succ . read

import           Control.Monad (forM_, replicateM_)

sol n = if even n then n `div` 2 else n `div` 2 + 1

main = do
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    print $ sol n

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

onecase = do
		x<- read <$> getLine ::IO Int
		print $ div (x+1) 2

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

import Control.Monad

main = do
  t <- readLn :: IO Int
  forM_ [1 .. t] $ \_ -> do
    n <- readLn :: IO Int
    print $ (n + 1) `div` 2

import           Control.Monad

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    n <- read <$> getLine :: IO Int
    print ((n-1) `div` 2 + 1)

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = do
	t <- readInt
	replicateM t solve

solve = do
	n <- readInt
	print $ ( n + 1 ) `div` 2


You went to the store, selling $$$n$$$ types of chocolates. There are $$$a_i$$$ chocolates of type $$$i$$$ in stock.You have unlimited amount of cash (so you are not restricted by any prices) and want to buy as many chocolates as possible. However if you buy $$$x_i$$$ chocolates of type $$$i$$$ (clearly, $$$0 \le x_i \le a_i$$$), then for all $$$1 \le j < i$$$ at least one of the following must hold:  $$$x_j = 0$$$ (you bought zero chocolates of type $$$j$$$) $$$x_j < x_i$$$ (you bought less chocolates of type $$$j$$$ than of type $$$i$$$) For example, the array $$$x = [0, 0, 1, 2, 10]$$$ satisfies the requirement above (assuming that all $$$a_i \ge x_i$$$), while arrays $$$x = [0, 1, 0]$$$, $$$x = [5, 5]$$$ and $$$x = [3, 2]$$$ don't.Calculate the maximum number of chocolates you can buy.

The first line contains an integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$), denoting the number of types of chocolate. The next line contains $$$n$$$ integers $$$a_i$$$ ($$$1 \le a_i \le 10^9$$$), denoting the number of chocolates of each type.

Print the maximum number of chocolates you can buy.

NoteIn the first example, it is optimal to buy: $$$0 + 0 + 1 + 3 + 6$$$ chocolates.In the second example, it is optimal to buy: $$$1 + 2 + 3 + 4 + 10$$$ chocolates.In the third example, it is optimal to buy: $$$0 + 0 + 0 + 1$$$ chocolates.

main = interact $ show . i . reverse . map read . words . last . lines

i []   = choco 0 []
i (x:[]) = choco x []
i (x:xs) = choco x xs

choco :: Integer -> [Integer] -> Integer
choco a [] = a
choco a (x:xs)
  | x >= a    = a + choco (max (a-1) 0) xs
  | otherwise = a + choco x xs

main = interact $ show . choco . reverse . map read . words . last . lines

choco :: [Integer] -> Integer
choco [] = 0
choco (a:[]) = a
choco (a:x:xs)
  | x >= a    = a + choco ((max (a-1) 0):xs)
  | otherwise = a + choco (x:xs)

module Main where
import qualified Data.ByteString.Char8 as C
import Data.List

main = do
    C.getLine
    as <- reverse . map ((read :: String -> Integer ). C.unpack ) . C.words <$> C.getLine
    let zero x = if x < 0 then 0 else x
    print $ sum $  foldl' (\acc@(h:_) x -> ((if x >= h then zero $ h-1 else x):acc)) [head as] $ tail as

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

solve :: [Integer] -> Integer
solve = sum . scanr1 greedy

greedy :: Integer -> Integer -> Integer
greedy _ 0 = 0
greedy l r | l >= r = r - 1
           | otherwise = l

{-# 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 :: [Int] -> Builder
solve (n:a) = int64Dec res
  where
    res :: Int64
    res = sum $ map fromIntegral $ scanr1 (\k acc -> max 0 $ min k (pred acc)) $ take n a

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

module Main where
import qualified Data.ByteString.Char8 as C
import Data.List

main = do
    C.getLine
    as <- reverse . map ((read :: String -> Int) . C.unpack ) . C.words <$> C.getLine
    let zero x = if x < 0 then 0 else x
    print $ sum $  foldl' (\acc@(h:_) x -> ((if x >= h then zero $ h-1 else x):acc)) [head as] $ tail as