Some people leave the lights at their workplaces on when they leave that is a waste of resources. As a hausmeister of DHBW, Sagheer waits till all students and professors leave the university building, then goes and turns all the lights off.The building consists of n floors with stairs at the left and the right sides. Each floor has m rooms on the same line with a corridor that connects the left and right stairs passing by all the rooms. In other words, the building can be represented as a rectangle with n rows and m + 2 columns, where the first and the last columns represent the stairs, and the m columns in the middle represent rooms.Sagheer is standing at the ground floor at the left stairs. He wants to turn all the lights off in such a way that he will not go upstairs until all lights in the floor he is standing at are off. Of course, Sagheer must visit a room to turn the light there off. It takes one minute for Sagheer to go to the next floor using stairs or to move from the current room/stairs to a neighboring room/stairs on the same floor. It takes no time for him to switch the light off in the room he is currently standing in. Help Sagheer find the minimum total time to turn off all the lights.Note that Sagheer does not have to go back to his starting position, and he does not have to visit rooms where the light is already switched off.

The first line contains two integers n and m (1 ≤ n ≤ 15 and 1 ≤ m ≤ 100) — the number of floors and the number of rooms in each floor, respectively. The next n lines contains the building description. Each line contains a binary string of length m + 2 representing a floor (the left stairs, then m rooms, then the right stairs) where 0 indicates that the light is off and 1 indicates that the light is on. The floors are listed from top to bottom, so that the last line represents the ground floor. The first and last characters of each string represent the left and the right stairs, respectively, so they are always 0.

Print a single integer — the minimum total time needed to turn off all the lights.

NoteIn the first example, Sagheer will go to room 1 in the ground floor, then he will go to room 2 in the second floor using the left or right stairs.In the second example, he will go to the fourth room in the ground floor, use right stairs, go to the fourth room in the second floor, use right stairs again, then go to the second room in the last floor.In the third example, he will walk through the whole corridor alternating between the left and right stairs at each floor.

module Main where

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

type Maze = [[Char]]

allOff :: [Char] -> Bool
allOff = all (== '0')

completed :: Maze -> Bool
completed [] = True
completed (m:ms) = allOff m && completed ms

solve :: Maze -> Int
solve maze = go (0, width - 1) (reverse maze)
    where width = length $ head maze
          go (tl, tr) maze@(m:ms)
              | completed maze = min tl tr
              | allOff m       = go (tl + 1, tr + 1) ms
              | completed ms   = min (tl + maxOn) (tr + minOn)
              | otherwise      = go (tl' + 1, tr' + 1) ms
              where ons = elemIndices '1' m
                    minOn = width - minimum ons - 1
                    maxOn = maximum ons
                    tl' = min (tl + 2 * maxOn) (tr + width - 1)
                    tr' = min (tr + 2 * minOn) (tl + width - 1)

test0 = [ "0010"
        , "0100"
        ]
test1 = [ "001000"
        , "000010"
        , "000010"
        ]
test2 = [ "01110"
        , "01110"
        , "01110"
        , "01110"
        ]

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

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve m = (\(c, _, _) -> c) . foldl' go (0, 0, 1000)
  where
    go (!t, !tl, !tr) f = case ixs of
      [] -> (t, tl + 1, tr + 1)
      _ -> (min (tl + r) (tr + m + 1 - l), min (tl + 2*r + 1) (tr + m + 2), min (tr + 2*(m + 1 - l) + 1) (tl + m + 2))
      where
        ixs = elemIndices '1' f
        l = head ixs
        r = last ixs

main = do
  n:m:_ <- readInts <$> B.getLine
  b <- reverse <$> replicateM n getLine
  print $ solve m b

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

last' [] = Nothing
last' xs@(_:_) = Just $ last xs

lastIx = (last' .) . elemIndices

solve m r b
  | all (== '0') (concat b) = 0
  | otherwise = solve' m r b

solve' m r (l1':rest) = case rest of
  [] -> ix
  [l2] -> if all (== '0') l2 then ix else time
  _ -> time
  where
    ix = fromMaybe 0 $ lastIx '1' (if r then reverse l1' else l1')
    time
      | ix > (m + 2) `div` 2 = m + 2 + solve m (not r) rest
      | otherwise = 2 * ix + 1 + solve m r rest

main = do
  n:m:_ <- readInts <$> B.getLine
  b <- reverse <$> replicateM n getLine
  print $ solve m False b

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

last' [] = Nothing
last' xs@(_:_) = Just $ last xs

solve m r [l1, l2] = (\p -> if d then p else if p > (m + 2) `div` 2 then  m + 2 + solve m (not r) [l2] else  2*p + 1 + solve m r [l2]) $ fromMaybe 0 $ last' $ elemIndices '1' (if r then reverse l1 else l1)
  where d = all (== '0') l2

solve m r (l1:l2:ls) = (\p -> if p > (m + 2) `div` 2 then  m + 2 + solve m (not r) (l2 : ls) else  2*p + 1 + solve m r (l2 : ls)) $ fromMaybe 0 $ last' $ elemIndices '1' (if r then reverse l1 else l1)

solve _ r [l1] =  fromMaybe 0 $ last' $ elemIndices '1' (if r then reverse l1 else l1)

main = do
  n:m:_ <- readInts <$> B.getLine
  b <- reverse <$> replicateM n getLine
  print $ solve m False b

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve m = (\(c, _, _) -> c) . foldl' go (0, 0, 1000)
  where
    go (!t, !tl, !tr) f = case ixs of
      [] -> (t, tl + 1, tr + 1)
      _ -> (min (tl + r) (tr + m + 1 - l), min (tl + 2*r + 1) (tr + m + 2), min (tr + 2*(m + 1 - l)) (tl + m + 2))
      where
        ixs = elemIndices '1' f
        l = head ixs
        r = last ixs

main = do
  n:m:_ <- readInts <$> B.getLine
  b <- reverse <$> replicateM n getLine
  print $ solve m b


Vasya became interested in bioinformatics. He's going to write an article about similar cyclic DNA sequences, so he invented a new method for determining the similarity of cyclic sequences.Let's assume that strings s and t have the same length n, then the function h(s, t) is defined as the number of positions in which the respective symbols of s and t are the same. Function h(s, t) can be used to define the function of Vasya distance ρ(s, t):  where  is obtained from string s, by applying left circular shift i times. For example, ρ("AGC", "CGT") =  h("AGC", "CGT") + h("AGC", "GTC") + h("AGC", "TCG") +  h("GCA", "CGT") + h("GCA", "GTC") + h("GCA", "TCG") +  h("CAG", "CGT") + h("CAG", "GTC") + h("CAG", "TCG") =  1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 1 = 6Vasya found a string s of length n on the Internet. Now he wants to count how many strings t there are such that the Vasya distance from the string s attains maximum possible value. Formally speaking, t must satisfy the equation: .Vasya could not try all possible strings to find an answer, so he needs your help. As the answer may be very large, count the number of such strings modulo 109 + 7.

The first line of the input contains a single integer n (1 ≤ n ≤ 105). The second line of the input contains a single string of length n, consisting of characters "ACGT".

Print a single number — the answer modulo 109 + 7.

NotePlease note that if for two distinct strings t1 and t2 values ρ(s, t1) и ρ(s, t2) are maximum among all possible t, then both strings must be taken into account in the answer even if one of them can be obtained by a circular shift of another one.In the first sample, there is ρ("C", "C") = 1, for the remaining strings t of length 1 the value of ρ(s, t) is 0.In the second sample, ρ("AG", "AG") = ρ("AG", "GA") = ρ("AG", "AA") = ρ("AG", "GG") = 4.In the third sample, ρ("TTT", "TTT") = 27

{-# LANGUAGE BangPatterns #-}
import Data.Int (Int64)
import Data.Foldable (foldl')
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: String -> Int64
solve line = foldr (*:) 1 . take n $ repeat k
    where
    n = length line
    (*:) !i !j = (i * j) `mod` 1000000007

    cnt = (\(i, j, k, l) -> [i, j, k, l]) $ foldl' count (0, 0, 0, 0) line
        where
        count (!i, !j, !k, !l) 'A' = (i + 1, j, k, l)
        count (!i, !j, !k, !l) 'C' = (i, j + 1, k, l)
        count (!i, !j, !k, !l) 'G' = (i, j, k + 1, l)
        count (!i, !j, !k, !l) 'T' = (i, j, k, l + 1)

    k = foldr (\i acc -> if i == m then acc + 1 else acc) 0 cnt
        where m = maximum cnt

main = do
    B.getLine
    line <- B.getLine
    print . solve . C.unpack $ C.init line

import Data.List (genericLength)
solve :: [Int] -> String -> Integer
solve ks [] = mod (g ^ sum ks) (10 ^ 9 + 7)
    where m = maximum ks
          g = genericLength $ filter (==m) ks
solve [a, c, g, t] (x:xs) = case x of
    'A' -> solve [a + 1, c, g, t] xs
    'C' -> solve [a, c + 1, g, t] xs
    'G' -> solve [a, c, g + 1, t] xs
    'T' -> solve [a, c, g, t + 1] xs
main = getLine >> getLine >>= putStrLn . show . solve [0, 0, 0, 0]

import Data.List

modulo :: Integer
modulo = 1000 * 1000 * 1000 + 7

powerMod :: Integer -> Integer -> Integer -> Integer
powerMod base 0 _ = 1
powerMod base exp modulo
    | exp `mod` 2 == 1 = base * powerMod base (exp - 1) modulo `mod` modulo
    | otherwise =
        let halfPow = powerMod base (exp `div` 2) modulo
        in
            halfPow * halfPow `mod` modulo

count :: Char -> String -> Int
count c str = length $ filter (== c) str

main = do
    getLine
    s <- getLine
    let frequences = [count 'A' s, count 'C' s, count 'T' s, count 'G' s]
    let max = maximum frequences
    let cntMax = length $ filter(== max) frequences
    putStrLn $ show $
        powerMod (fromIntegral cntMax) (fromIntegral (length s)) modulo


You are given two integers $$$A$$$ and $$$B$$$, calculate the number of pairs $$$(a, b)$$$ such that $$$1 \le a \le A$$$, $$$1 \le b \le B$$$, and the equation $$$a \cdot b + a + b = conc(a, b)$$$ is true; $$$conc(a, b)$$$ is the concatenation of $$$a$$$ and $$$b$$$ (for example, $$$conc(12, 23) = 1223$$$, $$$conc(100, 11) = 10011$$$). $$$a$$$ and $$$b$$$ should not contain leading zeroes.

The first line contains $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Each test case contains two integers $$$A$$$ and $$$B$$$ $$$(1 \le A, B \le 10^9)$$$.

Print one integer — the number of pairs $$$(a, b)$$$ such that $$$1 \le a \le A$$$, $$$1 \le b \le B$$$, and the equation $$$a \cdot b + a + b = conc(a, b)$$$ is true.

NoteThere is only one suitable pair in the first test case: $$$a = 1$$$, $$$b = 9$$$ ($$$1 + 9 + 1 \cdot 9 = 19$$$).

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

main = getLine >> getContents >>= putStrLn.unlines.map (show.(\(a:b:_) -> a * (toInteger $ pred $ length $ show $ succ b)).map read.words).lines

-- ayy it's a one-liner

solveTask :: (Integer, Integer) -> Integer
solveTask (a, b) =
    let d = length $ show $ b
        d' = length $ show $ b + 1
    in if d == d'
          then a * toInteger(d-1)
          else a * toInteger(d)

groupTaskInput :: [String] -> [(Integer, Integer)]
groupTaskInput [] = []
groupTaskInput (n:(d:xs)) = (read n, read d) : groupTaskInput(xs)

makeTaskInput :: String -> [(Integer, Integer)]
makeTaskInput s = groupTaskInput . tail . words $ s

solve :: String -> String
solve s = concat $ (map (++ "\n") ) $ (map $ show.solveTask) $ makeTaskInput s

main' :: IO ()
main' = do interact $ solve

main = main'

import Data.Ord
import Data.Int
import Data.Sequence as DSeq (null, Seq( Empty ), (|>), (><), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s |> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn(s)

main_ :: EIO ()
main_ = do
    t <- get :: EIO Int
    replicateM_ t f1

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

f2 :: Int64 -> Int64 -> Int64
f2 a b = (*) a $ log10 $ (+) b 1

log10 :: Int64 -> Int64
log10 n = if n <= 9 then 0 else (+) 1 $ log10 $ div n 10

import System.IO
-- import Prelude

readInt :: IO Int
readInt = readLn

castToInteger x = read x::Integer

main = do
    t <- readInt
    mainLoop t

mainLoop t = do
    if t == 0 then
        return ()
    else do
        line <- getLine
        let test_case = (map castToInteger . take 2 . words) line

        solveTask test_case

        mainLoop (t - 1)

solveTask :: [Integer] -> IO ()
solveTask [a, b] = do
    let bs = [10^i - 1| i <- [1..11], 10^i - 1 <= b]
    let res = a * count bs
    print res

count :: [Integer] -> Integer
count [] = 0
count (x:xs) = 1 + count xs

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

main = getLine >> getContents >>= putStrLn.unlines.map (show.(\(a:b:_) -> a * (pred $ length $ show $ succ b)).map read.words).lines

-- ayy it's a one-liner

import System.IO
-- import Prelude

readInt :: IO Int
readInt = readLn

readTuple :: IO (Int, Int)
readTuple = readLn

castToInt x = read x::Int

main = do
    t <- readInt
    mainLoop t

mainLoop t = do
    if t == 0 then
        return ()
    else do
        line <- getLine
        let test_case = (map castToInt . take 2 . words) line

        solveTask test_case

        mainLoop (t - 1)

solveTask [a, b] = do
    let bs = [10^i - 1| i <- [1..10], 10^i - 1 <= b]
    let res = a * count bs
    print res

count [] = 0
count (x:xs) = 1 + count xs


One Big Software Company has n employees numbered from 1 to n. The director is assigned number 1. Every employee of the company except the director has exactly one immediate superior. The director, of course, doesn't have a superior.We will call person a a subordinates of another person b, if either b is an immediate supervisor of a, or the immediate supervisor of a is a subordinate to person b. In particular, subordinates of the head are all other employees of the company.To solve achieve an Important Goal we need to form a workgroup. Every person has some efficiency, expressed by a positive integer ai, where i is the person's number. The efficiency of the workgroup is defined as the total efficiency of all the people included in it.The employees of the big software company are obsessed with modern ways of work process organization. Today pair programming is at the peak of popularity, so the workgroup should be formed with the following condition. Each person entering the workgroup should be able to sort all of his subordinates who are also in the workgroup into pairs. In other words, for each of the members of the workgroup the number of his subordinates within the workgroup should be even.Your task is to determine the maximum possible efficiency of the workgroup formed at observing the given condition. Any person including the director of company can enter the workgroup.

The first line contains integer n (1 ≤ n ≤ 2·105) — the number of workers of the Big Software Company.  Then n lines follow, describing the company employees. The i-th line contains two integers pi, ai (1 ≤ ai ≤ 105) — the number of the person who is the i-th employee's immediate superior and i-th employee's efficiency. For the director p1 =  - 1, for all other people the condition 1 ≤ pi < i is fulfilled.

Print a single integer — the maximum possible efficiency of the workgroup.

NoteIn the sample test the most effective way is to make a workgroup from employees number 1, 2, 4, 5, 6.

import Control.Applicative
import Data.Array.IArray
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
    n <- readLn
    (ps, a) <- splitEveryTwo . map fst . mapMaybe BS.readInt . BS.words <$> BS.getContents
    let _ : edges = zip ps [1 ..]
    let graph = accumArray (flip (:)) [] (1, n) edges
    putStrLn . show . snd $ solve (listArray (1, n) (map toInteger a)) graph 1

splitEveryTwo [] = ([], [])
splitEveryTwo (x1 : x2 : xs) = let (l1, l2) = splitEveryTwo xs in (x1 : l1, x2 : l2)

solve :: Array Int Integer -> Array Int [Int] -> Int -> (Integer, Integer)
solve a graph n
	| null (graph ! n)	= (0, a ! n)
	| otherwise	= let
		l = map (solve a graph) (graph ! n)
		s = sum . map snd $ l
		minD = minimum [(snd x) - (fst x) | x <- l]
		in if odd . length $ l then (s - minD, s + (max 0 ((a ! n) - minD))) else (s, s + (a ! n))

main = interact $ show . solve 0 0 . tail . map read . words

solve ans _ [] = ans - 1
solve ans k l = let (newK, newL) = foldl (\(k, l) v -> if v > k then (k, v : l) else (k + 1, l)) (k, []) l in solve (ans + 1) newK newL

import Control.Applicative
import Data.Array.IArray
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
    n <- readLn
    (ps, a) <- splitEveryTwo . map fst . mapMaybe BS.readInt . BS.words <$> BS.getContents
    let _ : edges = zip ps [1 ..]
    let graph = accumArray (flip (:)) [] (1, n) edges
    putStrLn . show . snd $ solve (listArray (1, n) a) graph 1

splitEveryTwo [] = ([], [])
splitEveryTwo (x1 : x2 : xs) = let (l1, l2) = splitEveryTwo xs in (x1 : l1, x2 : l2)

solve :: Array Int Int -> Array Int [Int] -> Int -> (Int, Int)
solve a graph n
	| null (graph ! n)	= (0, a ! n)
	| otherwise	= let
		l = map (solve a graph) (graph ! n)
		s = sum . map snd $ l
		minD = minimum [(snd x) - (fst x) | x <- l]
		in if odd . length $ l then (s - minD, s + (max 0 ((a ! n) - minD))) else (s, s + (a ! n))


Polycarp thinks about the meaning of life very often. He does this constantly, even when typing in the editor. Every time he starts brooding he can no longer fully concentrate and repeatedly presses the keys that need to be pressed only once. For example, instead of the phrase "how are you" he can type "hhoow aaaare yyoouu". Polycarp decided to automate the process of correcting such errors. He decided to write a plug-in to the text editor that will remove pairs of identical consecutive letters (if there are any in the text). Of course, this is not exactly what Polycarp needs, but he's got to start from something! Help Polycarp and write the main plug-in module. Your program should remove from a string all pairs of identical letters, which are consecutive. If after the removal there appear new pairs, the program should remove them as well. Technically, its work should be equivalent to the following: while the string contains a pair of consecutive identical letters, the pair should be deleted. Note that deleting of the consecutive identical letters can be done in any order, as any order leads to the same result.

The input data consists of a single line to be processed. The length of the line is from 1 to 2·105 characters inclusive. The string contains only lowercase Latin letters.

Print the given string after it is processed. It is guaranteed that the result will contain at least one character.

main=interact$q" "
q(h:p)(x:s)|x==h=q p s|1<2=q(x:h:p)s
q p _=reverse$p

module Main where

main = do
    str <- getLine
    putStrLn $ shrink str

shrink (s1:ss) =
    case shrink ss of
        s@(s2:ss) -> if s1 == s2
            then ss
            else s1:s
        s -> s1:s
shrink s = s

solve ys [] = ys
solve [] (x:xs) = solve [x] xs
solve (y:ys) (x:xs)
	| x == y = solve ys xs
	| otherwise = solve (x:y:ys) xs

main = getLine >>= putStrLn . reverse . solve []

fix rest [] = reverse rest
fix rest (x:[]) = fix (x:rest) []
fix [] (x:y:xs)
    | x == y    = fix [] xs
    | otherwise = fix [x] (y:xs)
fix rest (x:y:xs)
    | x == y    = fix (tail rest) ((head rest):xs)
    | otherwise = fix (x:rest) (y:xs)

main :: IO ()
main = do
    seq <- getLine
    putStr (fix [] seq)

solve s = solve' s []
	where
		solve' [] stack = reverse stack
		solve' (x:xs) stack
			| not (null stack) && head stack == x = solve' xs $ tail stack
			| otherwise =  solve' xs $ x:stack

main = interact solve

import Data.List

solve :: String -> String -> String
solve [] acc = acc
solve (x:xs) (a:as) | x == a = solve xs as
solve (x:xs) acc = solve xs (x:acc)

-- xraccabccbry

main = do
    stuff <- getLine
    putStrLn $ reverse $ solve stuff ""

--import CPUTime

bigWord :: String
bigWord = take 100000 (cycle "ab") ++ (take 100000 (cycle "ba")) ++ "c"

solve :: String -> String -> String
solve [] s = s
solve (x:xs) [] = solve xs [x]
solve (x:xs) (y:ys) = if x == y then solve xs ys else solve xs (x:y:ys)

main = do
    s <- getLine
--    let s = bigWord
--    t0 <- getCPUTime
    putStrLn (reverse (solve s ""))
--    t1 <- getCPUTime
--    putStrLn (show (fromInteger (t1 - t0) * 1e-012) ++ " sec.")

solve xs = solve' xs []
  where solve' xs (s1:s2:stack) | s1 == s2 = solve' xs stack
        solve' (x:xs) stack = solve' xs (x:stack)
        solve' [] stack = reverse stack

main = do line <- getLine
          putStrLn $ solve line

main=interact g
g (a:b:s)|a==b=g s
 |null t=[]
 |a==head t=tail t
 |0<1=a:t
 where t=g(b:s)
g a=a

main :: IO ()
main = putStrLn . solve =<< getLine

solve :: String -> String
solve = reverse . foldl go ""
  where
    go (y:ys) x | x == y = ys
    go ys x = x : ys

main = putStrLn . solve [] =<< getLine
solve [] (y:ys) = solve [y] ys
solve (x:xs) (y:ys) | x == y    = solve xs ys
                    | otherwise = solve (y:x:xs) ys
solve xs [] = reverse xs

main = getLine >>= putStrLn . solve

solve = reverse . foldl f ""
f (y:ys) x | x==y = ys
f ys x = x:ys

f (s:ss) (b, (r:rs), dir) | s==r = f ss (b, rs, dir)
                          | otherwise = f ss (b, (s:r:rs), dir)
f (s:ss) (b, rs, dir) = f ss (b, (s:rs), dir)
f [] (True, (r:rs), dir) = f [r] (False, rs, not dir)
f [] (b, [], dir) = []
f [] (False, r, True) = reverse r
f [] (False, r, False) = r
main = do
    l <- getLine
    putStrLn $ f (tail l) (False, [head l], True)

proc' line = proc [] line

proc h [] = reverse h
proc [] [] = []
proc [] (a:xs) = proc [a] xs
proc (a:xs) (b:ys) =
  if a==b then
    proc xs ys
  else
    proc (b:a:xs) ys

main = do
  line <- getLine
  putStrLn(proc' line)

g(o:p)(a:b)|a==o=g p b|1>0=g(a:o:p)b
g l r=reverse l
main=interact$g" "

solve [] = []
solve (a:b:t) | a==b = solve t
solve (a:t) =
    let t' = solve t
    in case t' of
        [] -> [a]
        (b:t) | a==b -> t
        _ -> a:t'

main = interact solve

main = interact solve
solve x = check x []
check [] x = reverse x
check (x:xs) [] = check xs [x]
check (x:xs) (y:ys) = if x==y then check xs ys else check xs (x:y:ys)

main=interact$q"$"
q p(x:s)|x==head p=q(tail p)s
        |1<2=q(x:p)s
q p _=reverse$init p

main=interact$q"$"
q(h:p)(x:s)|x==h=q p s|1<2=q(x:h:p)s
q p _=reverse$init p

main = putStrLn . solve "$" =<< getLine

solve ps (x:xs) | x == head ps = solve (tail ps) xs
                | otherwise    = solve (x : ps) xs
solve ps _ = reverse $ init ps

main=interact$q"$"
q p(x:s)|x==head p=q(tail p)s|1<2=q(x:p)s
q p _=reverse$init p

main=interact$q" "
q(h:p)(x:s)|x==h=q p s|1<2=q(x:h:p)s
q p _=reverse p

main=putStr.q"$"=<<getLine
q p(x:s)|x==head p=q(tail p)s
        |1<2=q(x:p)s
q p _=reverse$init p

import Data.List
main=interact g
g s|s==w=s
 |0<1=g w
 where w=map head.filter((==1).length).group$s

main :: IO ()
main = putStrLn . solve =<< getLine

solve :: String -> String
solve = fixed . iterate go
  where go (x:yxs@(y:xs)) | x == y = go (dropWhile (==x) xs)
                          | otherwise = x : go yxs
        go xs = xs

fixed :: Eq a => [a] -> a
fixed (x0:xs@(x1:_)) | x0 == x1 = x0
                     | otherwise = fixed xs
fixed [x] = x
fixed _ = error "fixed: empty list"

main :: IO ()
main = putStrLn . solve =<< getLine

solve :: String -> String
solve = fixed . iterate go
  where go (x:yxs@(y:xs)) | x == y = go $ dropWhile (==x) xs
                          | otherwise = x : go yxs
        go xs = xs

fixed :: Eq a => [a] -> a
fixed (x0:xs@(x1:_)) | x0 == x1 = x0
                     | otherwise = fixed xs
fixed [x] = x
fixed _ = error "fixed: empty list"


The employees of the R1 company often spend time together: they watch football, they go camping, they solve contests. So, it's no big deal that sometimes someone pays for someone else.Today is the day of giving out money rewards. The R1 company CEO will invite employees into his office one by one, rewarding each one for the hard work this month. The CEO knows who owes money to whom. And he also understands that if he invites person x to his office for a reward, and then immediately invite person y, who has lent some money to person x, then they can meet. Of course, in such a situation, the joy of person x from his brand new money reward will be much less. Therefore, the R1 CEO decided to invite the staff in such an order that the described situation will not happen for any pair of employees invited one after another.However, there are a lot of employees in the company, and the CEO doesn't have a lot of time. Therefore, the task has been assigned to you. Given the debt relationships between all the employees, determine in which order they should be invited to the office of the R1 company CEO, or determine that the described order does not exist.

The first line contains space-separated integers n and m  — the number of employees in R1 and the number of debt relations. Each of the following m lines contains two space-separated integers ai, bi (1 ≤ ai, bi ≤ n; ai ≠ bi), these integers indicate that the person number ai owes money to a person a number bi. Assume that all the employees are numbered from 1 to n. It is guaranteed that each pair of people p, q is mentioned in the input data at most once. In particular, the input data will not contain pairs p, q and q, p simultaneously.

Print -1 if the described order does not exist. Otherwise, print the permutation of n distinct integers. The first number should denote the number of the person who goes to the CEO office first, the second number denote the person who goes second and so on. If there are multiple correct orders, you are allowed to print any of them.

import Data.Graph

strToList = (map (read :: String -> Vertex)).words

main = do
    s <- getLine
    let [n, m] = strToList s
    t <- getContents
    putStrLn $ unwords $ map show $ reverse $ topSort $ buildG (1, n) (map (\[a, b] -> (a, b)) (map strToList (lines t)))

import Data.Graph
import Control.Applicative
import Control.Monad

main = do
    [n,m] <- map read . words <$> getLine
    ts <- map (toTuple . map read . words) . lines <$> getContents
    let graph = buildG (1,n) ts
    putStrLn . unwords . map show . reverse . topSort $ graph

toTuple [x,y] = (x,y)

import Data.Graph
import Control.Applicative
import Control.Monad

main = do
    [n,m] <- map read . words <$> getLine
    ts <- map (toTuple . map read . words) <$> replicateM m getLine
    let graph = buildG (1,n) ts
    putStrLn . unwords . map show . reverse . topSort $ graph

toTuple [x,y] = (x,y)

import Data.Graph
import Control.Applicative
import Control.Monad

main = do
    [n,m] <- map read . words <$> getLine
    ts <- map (toTuple . map read . words) . lines <$> getLine
    let graph = buildG (1,n) ts
    putStrLn . unwords . map show . reverse . topSort $ graph

toTuple [x,y] = (x,y)


Having bought his own apartment, Boris decided to paper the walls in every room. Boris's flat has n rooms, each of which has the form of a rectangular parallelepiped. For every room we known its length, width and height of the walls in meters (different rooms can have different dimensions, including height).Boris chose m types of wallpaper to paper the walls of the rooms with (but it is not necessary to use all the types). Each type of wallpaper is sold in rolls of a fixed length and width (the length, naturally, shows how long the unfolded roll will be). In addition, for each type we know the price of one roll of this type.The wallpaper of each type contains strips running along the length of the roll. When gluing the strips must be located strictly vertically (so the roll cannot be rotated, even if the length is less than the width). Besides, a roll can be cut in an arbitrary manner, but the joints of glued pieces should also be vertical. In addition, each room should be papered by only one type of wallpaper. And pieces of the same roll cannot be used to paper different rooms. That is, for each room the rolls are purchased separately. Also, some rolls can be used not completely.After buying an apartment Boris is short of cash, so he wants to spend the minimum money on wallpaper. Help him.

The first line contains a positive integer n (1 ≤ n ≤ 500) — the number of rooms in Boris's apartment. Each of the next n lines contains three space-separated positive integers — the length, width and height of the walls in a given room in meters, respectively. The next line contains a positive integer m (1 ≤ m ≤ 500) — the number of available wallpaper types. Each of the following m lines contains three space-separated positive integers — the length and width in meters of a given wallpaper and the price of one roll, respectively. All numbers in the input data do not exceed 500. It is guaranteed that each room can be papered using these types of wallpaper.

Print a single number — the minimum total cost of the rolls.

NoteNote to the sample:The total length of the walls (the perimeter) of the room is 20 m.One roll of the first type can be cut into pieces to get three vertical 1 meter wide strips, ergo you need 7 rolls of this type, the price equals 700.A roll of the second type can be cut into pieces to get five 2 meter wide strips, we need 2 rolls, the price is 640.One roll of the third type can immediately paper 19 meters out of 20, but we cannot use other types and we have to buy a second roll, the price is 1000.

import Control.Applicative

main = do n <- read <$> getLine
          rss <- mapM (\i -> map read <$> words <$> getLine) [1..n]
          m <- read <$> getLine
          wss <- mapM (\i -> map read <$> words <$> getLine) [1..m]
          print $ solve n rss m wss

solve :: Int -> [[Int]] -> Int -> [[Int]] -> Int
solve _ rss _ wss =  sum $ map (solve' wss) rss
solve' :: [[Int]] -> [Int] -> Int
solve' wss lwh@(l:w:h:_) = minimum $ map (price lwh) $ filter ((h<=).head) wss

price :: [Int] -> [Int] -> Int
price (l:w:h:_) (l':w':p:_) = ((((2*(l+w))`div'`w')*h)`div'`(l'-(mod l' h)))*p

div' x y = if q == 0 then p else succ p
   where (p,q) = divMod x y

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.Int

main :: IO ()
main = do
  n           <- readLn
  rooms       <- replicateM n readInts
  m           <- readLn
  papers      <- replicateM m readInts
  prices      <- forM rooms $ \[l, w, h] -> do
    candidates <- forM papers $ \[l', w', price] -> do
      if l' < h
        then return (1234567890 :: Integer)
        else do
          let !h'       = l' `quot` h
              !rolls    = ((l + w) * 2 - 1) `quot` (w' * h') + 1
          return $! rolls * price
    return $! minimum candidates
  print $ sum prices
 where
  readInts = map read . words <$> getLine

import Data.Maybe
import Control.Monad

type Room = (Int, Int, Int)
type Paper = (Int, Int, Int)

single :: Room -> Paper -> Maybe Int
single (ra, rb, rh) (h, a, cost) =
    let p = (ra + rb) * 2
        count  = (p + a - 1) `div` a
        count' = h `div` rh
        ans    = (count + count' - 1) `div` count'
    in if count' == 0 then Nothing
       else Just $ ans * cost

solve :: [Room] -> [Paper] -> Int
solve rooms papers = sum $ map solve' rooms
    where solve' room = minimum $ catMaybes $ map (single room) papers

main = do
    n <- read `fmap` getLine
    rooms <- replicateM n $ do
        [a, b, h] <- (map read . words) `fmap` getLine
        return (a, b, h)

    m <- read `fmap` getLine
    papers <- replicateM m $ do
        [h, a, cost] <- (map read . words) `fmap` getLine
        return (h, a, cost)

    let ans = solve rooms papers
    putStrLn $ show ans

import Control.Monad

parse :: String -> [Int]
parse stuff = map read (words stuff)

solve rooms papers = map (solve_one papers) rooms

solve_one papers [a, b, c] = minimum $ map give_price papers
    where give_price [l, w, p] =
              let perim = 2 * (a + b)
                  stripes = l `div` c
                  segments = perim `ceil` w
              in
                if stripes /= 0
                then (segments `ceil` stripes) * p
                else (maxBound :: Int)

ceil :: Int -> Int -> Int
ceil a b
    | a `rem` b > 0 = 1 + d
    | otherwise     = d
    where d = a `div` b

main = do
  n <- getLine
  rooms <- sequence [getLine | _ <- [1.. (read n)]]
  m <- getLine
  papers <- sequence [getLine | _ <- [1.. (read m)]]
  print $ sum $ solve (map parse rooms) (map parse papers)

solve ws wps = sum $ map (solve' wps) ws

solve' wps [h,l] = minimum $ map cost wps
   where
      cost [h',w',c']
         | h > h'    = inf
         | otherwise = l `divup` ((h' `div` h) * w') * c'
      inf = 99999999
      divup x y = div (x+y-1) y

main = do
   n <- fmap read getLine
   ws <- mapM (fmap $ map read . words) (replicate n getLine)
   m <- fmap read getLine
   wps <- mapM (fmap $ map read . words) (replicate m getLine)
   print $ solve (map (\[x,y,z] -> [z,(x+y)*2]) ws) wps

-- vim: set expandtab:

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

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

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

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

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

ceilDiv a b = (a + b - 1) `div` b

main = do nrooms <- readNum
          rooms  <- replicateM nrooms readRoom

          npapers <- readNum
          papers  <- replicateM npapers readPaper

          let values = map (solve papers) rooms
          print (sum values)

  where
    readRoom = do width  <- readNum
                  length <- readNum
                  height <- readNum
                  return (width + width + length + length, height)

    readPaper = do length <- readNum
                   width  <- readNum
                   price  <- readNum
                   return (length, width, price)

solve papers (columns, height) = foldl1 min [ effectivePrice p | p <- papers ]
  where
    effectivePrice (length, width, price) | length < height = 100000000
                                          | otherwise       =
      price * (columns `ceilDiv` ((length `div` height) * width))

import Control.Monad
import Data.Maybe

data Room  = Room Int Int Int
  deriving (Eq,Show)

data Paper = Paper Int Int Int
  deriving (Eq,Show)

divceil a b = (a + b -1) `div` b

-- return the number of rolls needed
rolls roomh roomw rooml paperh paperw | paperh < roomh = Nothing
rolls roomh roomw rooml paperh paperw = Just r
  where
    w = 2*(roomw+rooml)
    r = divceil w ((paperh `div` roomh) * paperw)

cost :: Room -> Paper -> Maybe Int
cost (Room h l w) (Paper ph pw pc) = fmap (pc*) $ rolls h l w ph pw

minCost :: [Paper] -> Room -> Int
minCost ps r = minimum $ catMaybes $ map (cost r) ps

main = do
  n <- fmap read getLine
  rooms <- replicateM n $ do [l,w,h] <- fmap (map read . words) getLine
                             return $ Room h l w
  m <- fmap read getLine
  papers <- replicateM m $ do [h,w,c] <- fmap (map read . words) getLine
                              return $ Paper h w c

  let answer = sum $ map (minCost papers) rooms
  print answer

import Maybe (mapMaybe)

type Room  =  (Int, Int, Int)
type Roll  =  (Int, Int, Int)

parseRoom :: String -> Room
parseRoom line  =  case words line of
    [x, y, z]  ->  (read x, read y, read z)

parseRoll :: String -> Roll
parseRoll  =  parseRoom

solve :: [Room] -> [Roll] -> Int
solve rooms rolls  =  sum $ map solve' rooms
  where
    solve' room  =  minimum $ mapMaybe (solve'' room) rolls
    solve'' (l, w, h) (l', w', c)
      | l' >= h  =  Just $ c * (1 + div (2 * (l+w) - 1) (w' * div l' h))
      | otherwise  =  Nothing

main :: IO ()
main  =  do
    lines'    <-  fmap lines getContents
    let n      =  read . head $ lines'
    let rooms  =  map parseRoom . take n . tail $ lines'
    let m      =  read . head . drop n . tail $ lines'
    let rolls  =  map parseRoll . take m . tail . drop n . tail $ lines'
    print $ solve rooms rolls

import Data.List
import Control.Monad

solve :: [(Int, Int, Int)] -> [(Int, Int, Int)] -> Int
solve xs ys = sum $ map best xs
  where best x = minimum $ filter (>= 0) $ map (calc x) ys
        calc (a1, b1, c1) (a2, b2, c2) =
          let p = (a1 + b1) * 2
              q = div (p + b2 - 1) b2
              t = a2 `div` c1
          in if t == 0 then -1
             else c2 * div (q + t - 1) t

main = do n <- fmap read getLine
          xs <- replicateM n readTriplet
          m <- fmap read getLine
          ys <- replicateM m readTriplet
          print $ solve xs ys
  where readTriplet = do [a, b, c] <- fmap (map read.words) getLine
                         return (a, b, c)

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

solve :: [(Int, Int, Int)] -> [(Int, Int, Int)] -> Int
solve xs ys = sum $ map best xs
  where best x = minimum $ filter (>= 0) $ map (calc x) ys
        calc (a1, b1, c1) (a2, b2, c2) =
          let p = (a1 + b1) * 2
              q = div (p + b2 - 1) b2
              t = a2 `div` c1
          in if t == 0 then -1
             else c2 * div (q + t - 1) t

main = do n <- fmap readInt BS.getLine
          xs <- replicateM n readTriplet
          m <- fmap readInt BS.getLine
          ys <- replicateM m readTriplet
          print $ solve xs ys
  where readTriplet = do [a, b, c] <- fmap (map readInt . BS.words) BS.getLine
                         return (a, b, c)
        readInt x = let Just (int, _) = BS.readInt x
                    in int

import Control.Applicative

main = do n <- read <$> getLine
          rss <- mapM (\i -> map read <$> words <$> getLine) [1..n]
          m <- read <$> getLine
          wss <- mapM (\i -> map read <$> words <$> getLine) [1..m]
          print $ solve n rss m wss

solve :: Int -> [[Int]] -> Int -> [[Int]] -> Int
solve n rss m wss =  sum $ map (solve' wss) rss
solve' :: [[Int]] -> [Int] -> Int
solve' wss (l:w:h:_) = minimum $ map (price [l,w,h]) $ wss
price :: [Int] -> [Int] -> Int
price (l:w:h:_) (l':w':p:_) = (((2*(l+w)`div'`w')*h)`div'`(f l' h))*p

f l' h
  | l' >= h = l'-(mod l' h)
  | otherwise = l'

div' x y = if q == 0 then p else succ p
   where (p,q) = divMod x y

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  n           <- readLn
  prices      <- replicateM n $ do
    [l, w, h]   <- readInts
    m           <- readLn
    candidates  <- replicateM m $ do
      [l', w', price] <- readInts
      let !h'       = head $ dropWhile (< h) [l', l' * 2 ..]
          !rolls    = (((l + w) * 2 - 1) `quot` (w' * (h' `quot` h)) + 1) * (h' `quot` l')
      return $! rolls * price
    return $! minimum candidates
  print $ sum prices
 where
  readInts = map read . words <$> getLine

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  n           <- readLn
  [l, w, h]   <- readInts
  m           <- readLn
  candidates  <- replicateM m $ do
    [l', w', price] <- readInts
    let !h'       = head $ dropWhile (< h) [l', l' * 2 ..]
        !rolls    = (((l + w) * 2 - 1) `quot` (w' * (h' `quot` h)) + 1) * (h' `quot` l')
    return $! rolls * price
  print $ minimum candidates * n
 where
  readInts = map read . words <$> getLine

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  n           <- readLn
  [l, w, h]   <- readInts
  m           <- readLn
  prices      <- replicateM n $ do
    candidates  <- replicateM m $ do
      [l', w', price] <- readInts
      let !h'       = head $ dropWhile (< h) [l', l' * 2 ..]
          !rolls    = (((l + w) * 2 - 1) `quot` (w' * (h' `quot` h)) + 1) * (h' `quot` l')
      return $! rolls * price
    return $! minimum candidates
  print $ sum prices
 where
  readInts = map read . words <$> getLine

import Control.Monad

parse :: String -> [Int]
parse stuff = map read (words stuff)

solve rooms papers = map (solve_one papers) rooms

solve_one papers [a, b, c] = minimum $ map give_price papers
    where give_price [l, w, p] =
              let perim = 2 * (a + b)
                  stripes = l `div` c
                  segments = perim `ceil` w
              in
                if stripes /= 0
                then (segments `ceil` stripes) * p
                else 123456789
-- else (maxBound :: Int)

-- ceil :: Int -> Int -> Int
ceil a b
    | a `rem` b > 0 = 1 + d
    | otherwise     = d
    where d = a `div` b

main = do
  n <- getLine
  rooms <- sequence [getLine | _ <- [1.. (read n)]]
  m <- getLine
  papers <- sequence [getLine | _ <- [1.. (read m)]]
  mapM_ print (solve (map parse rooms) (map parse papers))

import Control.Monad

parse :: String -> [Int]
parse stuff = map read (words stuff)

solve rooms papers = map (solve_one papers) rooms

solve_one papers [a, b, c] = minimum $ map give_price papers
    where give_price [l, w, p] =
              let perim = 2 * (a + b)
                  stripes = l `div` c
                  segments = perim `ceil` w
              in
                if stripes /= 0
                then (segments `ceil` stripes) * p
                else (maxBound :: Int)

-- ceil :: Int -> Int -> Int
ceil a b
    | a `rem` b > 0 = 1 + d
    | otherwise     = d
    where d = a `div` b

main = do
  n <- getLine
  rooms <- sequence [getLine | _ <- [1.. (read n)]]
  m <- getLine
  papers <- sequence [getLine | _ <- [1.. (read m)]]
  mapM_ print (solve (map parse rooms) (map parse papers))

import Control.Monad

parse :: String -> [Int]
parse stuff = map read (words stuff)

solve rooms papers = map (solve_one papers) rooms

solve_one papers [a, b, c] = {-minimum $ -} map give_price papers
    where give_price [l, w, p] =
              let perim = 2 * (a + b)
                  stripes = l `div` c
                  segments = perim `ceil` w
              in
                (segments `ceil` stripes) * p

-- ceil :: Int -> Int -> Int
ceil a b
    | a `rem` b > 0 = 1 + d
    | otherwise     = d
    where d = a `div` b

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

import Control.Monad

parse :: String -> [Int]
parse stuff = map read (words stuff)

solve rooms papers = map (solve_one papers) rooms

solve_one papers [a, b, c] = minimum $ map give_price papers
    where give_price [l, w, p] =
              let perim = 2 * (a + b)
                  stripes = l `div` c
                  segments = perim `ceil` w
              in
                (segments `ceil` stripes) * p

-- ceil :: Int -> Int -> Int
ceil a b
    | b == 0        = 12345678987654321
    | a `rem` b > 0 = 1 + d
    | otherwise     = d
    where d = a `div` b

main = do
  n <- getLine
  rooms <- sequence [getLine | _ <- [1.. (read n)]]
  m <- getLine
  papers <- sequence [getLine | _ <- [1.. (read m)]]
  mapM_ print (solve (map parse rooms) (map parse papers))

solve ws wps = sum $ map (solve' wps) ws

solve' wps [h,l] = minimum $ map cost wps
   where
      cost [h',w',c']
         | h > h'    = inf
         | otherwise = l `div` ((h' `div` h) * w') * c'
      inf = 99999999

main = do
   n <- fmap read getLine
   ws <- mapM (fmap $ map read . words) (replicate n getLine)
   m <- fmap read getLine
   wps <- mapM (fmap $ map read . words) (replicate m getLine)
   print $ solve (map (\[x,y,z] -> [x,(y+z)*2]) ws) wps

-- vim: set expandtab:

import Control.Applicative

main = do n <- read <$> getLine
          rss <- mapM (\i -> map read <$> words <$> getLine) [1..n]
          m <- read <$> getLine
          wss <- mapM (\i -> map read <$> words <$> getLine) [1..m]
          print $ solve n rss m wss

solve :: Int -> [[Int]] -> Int -> [[Int]] -> Int
solve n rss m wss =  sum $ map (solve' wss) rss
solve' :: [[Int]] -> [Int] -> Int
solve' wss (l:w:h:_) = minimum $ map (price [l,w,h]) $ filter ((h<=).head) wss

price :: [Int] -> [Int] -> Int
price (l:w:h:_) (l':w':p:_) = (((2*(l+w)`div'`w')*h)`div'`(l'-(mod l' h)))*p

div' x y = if q == 0 then p else succ p
   where (p,q) = divMod x y


Professor GukiZ likes programming contests. He especially likes to rate his students on the contests he prepares. Now, he has decided to prepare a new contest. In total, n students will attend, and before the start, every one of them has some positive integer rating. Students are indexed from 1 to n. Let's denote the rating of i-th student as ai. After the contest ends, every student will end up with some positive integer position. GukiZ expects that his students will take places according to their ratings. He thinks that each student will take place equal to . In particular, if student A has rating strictly lower then student B, A will get the strictly better position than B, and if two students have equal ratings, they will share the same position. GukiZ would like you to reconstruct the results by following his expectations. Help him and determine the position after the end of the contest for each of his students if everything goes as expected.

The first line contains integer n (1 ≤ n ≤ 2000), number of GukiZ's students.  The second line contains n numbers a1, a2, ... an (1 ≤ ai ≤ 2000) where ai is the rating of i-th student (1 ≤ i ≤ n).

In a single line, print the position after the end of the contest for each of n students in the same order as they appear in the input.

NoteIn the first sample, students 2 and 3 are positioned first (there is no other student with higher rating), and student 1 is positioned third since there are two students with higher rating.In the second sample, first student is the only one on the contest.In the third sample, students 2 and 5 share the first position with highest rating, student 4 is next with third position, and students 1 and 3 are the last sharing fourth position.

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

solve :: [Int] -> [Int]
solve a = map (\x -> 1 + length (filter (> x) a)) a

import Data.List
import Data.Maybe
import qualified Data.Map as Map

--------------------------------

createMapList :: [[Int]] -> [(Int, Int)]
createMapList xs = createMapList' xs 0
	where
		createMapList' [] _ = []
		createMapList' (x:xs) higher = (head x, higher) : createMapList' xs (higher + length x)

--------------------------------

main = do

	n <- fmap read $ getLine :: IO Int
	ratings <- fmap (map read . words) $ getLine :: IO [Int]

	let
		sorted_ratings =
			createMapList $
			group $
			sortBy (\a b -> compare b a) ratings

		rating_map = Map.fromList sorted_ratings

	putStrLn $
		intercalate " " $ map show $ mapPositions rating_map ratings

--------------------------------

mapPositions :: Map.Map Int Int -> [Int] -> [Int]
mapPositions _ [] = []
mapPositions map (x:xs)
	| higher == Nothing = 0 : mapPositions map xs
	| otherwise = (1 + fromJust higher) : mapPositions map xs
	where
		higher = Map.lookup x map

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

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

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

main = do
  getLine
  as <- getInts

  let
    r = map snd $ sort $ concat $ map f $ groupBy ((==) `on` (fst . fst)) $ zip (reverse $ sort $ zip as [1..]) [1..]
      where
        f :: [((Int, Int), Int)] -> [(Int, Int)]
        f g = zip (map (snd . fst) g) (repeat m)
          where
            m = minimum $ map snd g

  putStrLn $ unwords $ map show r

import Data.Functor
import Data.List

getInts :: IO [Int]
getInts = map read <$> words <$> getContents

main = getInts >>= putStrLn . intercalate " " . map show . solve

solve :: [Int] -> [Int]
solve (n:xs) = map snd . sort $ zip is es
    where (ys, is) = unzip . reverse . sort $ zip xs [0..]
          (zs, es) = unzip . scanl1 min $ zip ys [1,2..]

main = do
  num <- getLine
  ratings <- getLine
  mapM_ pwSpace $ positions (read num) (readNums ratings)
  putChar '\n'

pwSpace n = do
  putStr $ (show n) ++ " "

readNums :: String -> [Int]
readNums s = map read $ words s

positions :: Int -> [Int] -> [Int]
positions n rs = map (getPos rs) [1..n]

getPos :: [Int] -> Int -> Int
getPos rs x = 1 + (length $ filter (\y -> y > (rs !! (x-1))) rs)

import Data.List
answer::[Int]->[Int]
answer a = [getNum n a | n <- (enumFromTo 0 ((length a) - 1))]
getNum::Int -> [Int] -> Int
getNum n a = 1 + (length (filter ((a !! n)<) a))
main = do
  w <- getLine
  w0 <- getLine
  let a = [read n::Int|n<-(words w0)]
  putStrLn $ intercalate " " (map show (answer a))

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine>>(solve.concat =<< forM [1.. 1] ( \i -> map (fst.fromJust.C.readInteger).C.words<$>C.getLine))
solve xs = let bs = zip [1..] xs; sbs = sortBy ( flip (compare `on` snd)) bs; gsbs=groupBy ((==) `on` snd)  sbs in putStr $ unwords $ map (\(a,b)->show b)  $  sortBy (compare `on` fst) $ concat $ slv1 gsbs
slv1 (xs:xss)= map fst $ scanl (\(bs,b) as->(map(\(c1,c2)->(c1,1+b)) as, b+length as) ) (map (\(a,b) ->(a,1)) xs,length xs) xss

module Main where

import Data.List
import Data.Maybe

main = do
    n <- (readLn :: IO Int)
    xs <- getLine >>= return .map (read :: String -> Int) . words
    let as = fst . foldr (\ (a,b)  (cs,c) -> ((a,c):cs, b+c)) ([],1) . map (\x -> (head x, length x)) . group . sort $ xs
        bs = map ( fromJust . (flip lookup) as ) xs
    putStrLn $ concat $ intersperse " " $ map show bs

import Control.Monad

main :: IO ()
main = getLine >> getLine >>= mapM_ (putStr . (++ " ") . show) . rank . map read . words >> putStrLn ""

rank :: [Int] -> [Int]
rank a = [1 + length (filter (> x) a) | x <- a]

main=getLine>>getLine>>=putStrLn.unwords.(map show).solve.(map read).words
solve::[Int]->[Int]
solve l = map (\x->1+(length$filter(x<) l)) l

import Data.Functor ((<$>))

main :: IO ()
main = putStrLn <$> unwords <$> map show =<< solve <$> (map read <$> tail <$> words <$> getContents)

solve :: [Integer] -> [Integer]
solve xs = [ 1 + sum [ 1 | y <- xs, y > x ] | x <- xs ]

import Data.Ord
import Data.List
import Data.Function
main = interact $ unwords . map show . solve . map read . tail . words
solve :: [Int] -> [Int]
solve = map snd . sort .
        concat . snd . mapAccumL f 1 .
        groupBy ((==) `on` snd) .
        sortBy (flip $ comparing snd) .
        zip [1..]
f n xs = (n + length xs, map (flip (,) n . fst) xs)

import Data.List
import Data.Function

f :: [Int] -> [Int]
f xs = map snd . sortBy (compare `on` fst) . g 1 $ xxs'
    where xxs' = groupBy ((==) `on` snd) . reverse . sortBy (compare `on` snd) . zip [1..] $ xs
          g _ [] = []
          g place (ys:yys) = map (\(num, rate) -> (num, place)) ys ++ g (place + length ys) yys

main = getLine >> fmap (map read . words) getLine >>= putStrLn . intercalate " " . map show . f

import Data.List
main = do
    getLine
    s <- getLine >>= return . map read . words :: IO [Int]
    let t x = sum . map (\k -> if k > x then 1 else 0)
    let l = map (\x -> 1 + t x s) s
    putStrLn $ unwords . intersperse " " $ map show l

import Control.Applicative
import Data.List

mymax s =  snd $ head $ filter (\z-> fst z ==m) $ zip s [1..]
	where m = maximum s

myfunc r x = zip  (map snd x) (repeat r)

main=do
	n<-  read  <$> getLine:: IO Int
	s<-  map read.   words   <$> getLine ::IO [Int]
	let t=  groupBy (\a b-> fst a==fst b) $ reverse $ sort $ zip s [1..]
	let t1= scanl (+) 1 $ map length t
	putStrLn $ intercalate " " $ map show $ map snd $ sort $ concat $ zipWith myfunc t1 t

type Input  = [Int]
type Output = [Int]

parse :: String -> Input
parse contents = rs where [_, rs] = map (map read . words) . lines $ contents

solve :: Input -> Output
solve rs = map rank rs
           where rank r = 1 + length (filter (> r) rs)

pretty :: Output -> String
pretty = unwords . map show

main :: IO ()
main = putStrLn . pretty . solve . parse =<< getContents

import Data.List
import Data.Function
sortOn' fun = sortBy (compare `on` fun)
main = interact $ unwords.map (show.snd).sortOn' fst.f.zip [1..].map read.words.last.lines
hs = snd.head
f xs = g 1 (hs xs).reverse.sortOn' snd $ xs
g _ _ [] = []
g pos val xs = let (front,end) = span (\x->val==snd x) xs
                   n = length front
                   begin = zip (map fst front) (replicate n pos)
               in begin ++ (g (pos+n) (if end==[] then 0 else hs end) end)

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Control.Applicative
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Function as F
import Debug.Trace

import qualified Numeric as N

readInt :: String -> Int
readInt ('-':s) = case N.readDec s of [(n, "")] -> -n
readInt s = case N.readDec s of [(n, "")] -> n

readFloat :: String -> Double
readFloat ('-':s) = case N.readFloat s of [(x, "")] -> -x
readFloat s = case N.readFloat s of [(x, "")] -> x

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

solve :: Int -> [[(Int, Int)]] -> [(Int, Int)]
solve _ [] = []
solve n (l:xs) = [(n, x) | x <- map snd l] ++ (solve (n + length l) xs)

main = do
  _ <- getLine
  s <- getInts
  let
    res = L.sortBy (compare `F.on` snd) . solve 0 . reverse . L.groupBy ((==) `F.on` fst) . L.sortBy (compare `F.on` fst) $ (zip s [1..])
  forM_ res $ \(r, i) -> putStr $ (show $ r + 1) ++ " "

main=getLine>>getLine>>=putStrLn.unwords.(map show).solve.(map read).words
solve::[Int]->[Int]
solve l = map (\x->length$filter(x<) l) l

import Data.List
main = do
    getLine
    s <- getLine >>= return . map read . words :: IO [Int]
    let t x = sum . map (\k -> if k > x then 1 else 0)
    let l = map (\x -> 1 + t x s) s
    putStrLn $ intersperse ' ' . unwords $ map show l


Petya loves computer games. Finally a game that he's been waiting for so long came out!The main character of this game has n different skills, each of which is characterized by an integer ai from 0 to 100. The higher the number ai is, the higher is the i-th skill of the character. The total rating of the character is calculated as the sum of the values of  for all i from 1 to n. The expression ⌊ x⌋ denotes the result of rounding the number x down to the nearest integer.At the beginning of the game Petya got k improvement units as a bonus that he can use to increase the skills of his character and his total rating. One improvement unit can increase any skill of Petya's character by exactly one. For example, if a4 = 46, after using one imporvement unit to this skill, it becomes equal to 47. A hero's skill cannot rise higher more than 100. Thus, it is permissible that some of the units will remain unused.Your task is to determine the optimal way of using the improvement units so as to maximize the overall rating of the character. It is not necessary to use all the improvement units.

The first line of the input contains two positive integers n and k (1 ≤ n ≤ 105, 0 ≤ k ≤ 107) — the number of skills of the character and the number of units of improvements at Petya's disposal. The second line of the input contains a sequence of n integers ai (0 ≤ ai ≤ 100), where ai characterizes the level of the i-th skill of the character.

The first line of the output should contain a single non-negative integer — the maximum total rating of the character that Petya can get using k or less improvement units.

NoteIn the first test case the optimal strategy is as follows. Petya has to improve the first skill to 10 by spending 3 improvement units, and the second skill to 10, by spending one improvement unit. Thus, Petya spends all his improvement units and the total rating of the character becomes equal to  lfloor frac{100}{10} rfloor +  lfloor frac{100}{10} rfloor = 10 + 10 =  20.In the second test the optimal strategy for Petya is to improve the first skill to 20 (by spending 3 improvement units) and to improve the third skill to 20 (in this case by spending 1 improvement units). Thus, Petya is left with 4 improvement units and he will be able to increase the second skill to 19 (which does not change the overall rating, so Petya does not necessarily have to do it). Therefore, the highest possible total rating in this example is .In the third test case the optimal strategy for Petya is to increase the first skill to 100 by spending 1 improvement unit. Thereafter, both skills of the character will be equal to 100, so Petya will not be able to spend the remaining improvement unit. So the answer is equal to .

import Debug.Trace

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

solve :: [Int] -> Int
solve (n:k:a) = let b = getRem a (replicate 11 0)
                in  divide k b 0

addToList :: [Int] -> Int -> Int -> [Int]
addToList (a:s) 0 v = (a + v) : s
addToList (a:s) i v = a : (addToList s (i - 1) v)

getRem :: [Int] -> [Int] -> [Int]
getRem []    cnt = cnt
getRem (a:s) cnt = let next = (addToList (addToList cnt 0 (div a 10)) 10 (div (100 - (a + (rem (10 - (rem a 10)) 10))) 10))
                   in  if mod a 10 == 0 then getRem s next else getRem s (addToList next (10 - (rem a 10)) 1)

divide :: Int -> [Int] -> Int -> Int
divide k (b:bs) 0   = b + (divide k bs 1)
divide 0 (b:bs) _   = 0
divide k []     _   = 0
divide k (b:bs) idx | (div k idx) >= b = b + (divide (k - b * idx) bs (idx + 1))
                    | otherwise        = div k idx

import Data.List (sort)

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

	let
		r = sum $ map (`div` 10) as
		sums = takeWhile (<= k) $ scanl1 (+) $ sort $ filter (/= 10) $ map (\a -> 10 - a `mod` 10) as
		r' = if null sums then 0 else length sums
		r'' = if null sums then k else k - (last sums)

		t = r + r' + (r'' `div` 10)

		ans = if t >= 10 * n then 10 * n else t

	print ans

import Data.List

add3 (a,b,c) (x,y,z) = (a+x,b+y,c+z)

solve :: Int -> Int -> [Int] -> Int
solve n k levels =
  let
      -- the base level
      a0 = sum [ div a 10 | a <- levels ]  :: Int

      -- sort by 10 - remainder mod 10
      sorted = sort [ (10-r,  a) | a <- levels, let r = mod a 10 ]

      loop :: Int -> (Int,Int) -> [(Int,Int)] -> (Int, (Int,Int))
      loop k acc [] = (k, acc)
      loop k acc@(da, tens) ( (r,a) : rest )
        | k <= 0  = (0, acc)
        | r == 10 = let dtens = 10 - div a 10 in
                    loop k (da, tens+dtens) rest
        | r <= k  = let dtens = 9 - div a 10 in
                    loop (k-r) (da+1, tens+dtens) rest
        | otherwise = (k, acc)

      (k',(da, tens)) = loop k (0,0) sorted :: (Int,(Int,Int))

      answer = min (n*10) (a0 + da + min tens (div k' 10))
  in answer

main = do
  (n : k : levels) <- fmap (map read . words) getContents
  print $ solve n k levels

test1 = print $ solve 2 4 [7,9]

test2 = print $ solve 3 8 [17, 15, 19]

test3 = print $ solve 2 2 [99, 100]

test4 = print $ solve 231 100 $ replicate 231 100

test5 = print $ solve 100 10000 $ replicate 100 0

import Data.List

main = do
	l1 <- getLine
	n : k : [] <- return $ map (read :: String->Int) $ words l1
	l2 <- getLine
	v <- return $ map (read :: String->Int) $ words l2
	putStr $ show $ solve n k v

solve n k v = score0 + score1 + min rem_groups (rem' `div` 10) where
	rems = sort $ map (\x -> 10 - x `mod` 10) $ filter (\x -> x `mod` 10 > 0) v
	rem_groups = sum $ map (\x -> 10 - (x + 9) `div` 10) v
	score0 = sum $ map (`div` 10) v
	(rem' , score1) = take_remainders k rems

take_remainders n [] = (n, 0)
take_remainders n (h : t)
		| n >= h	= let (n', s') = take_remainders (n - h) t in (n', 1 + s')
		| otherwise	= (n, 0)

import Data.Array
getPlus::Int -> [Int]-> Int
getPlus k a = getPlus0 k a 1
getPlus0::Int -> [Int] -> Int -> Int
getPlus0 k [] n = 0
getPlus0 k (a:as) n | k >= an = a + getPlus0 (k-an) as (n+1)
                    | otherwise = m
  where  an = a*n
         m = k `div` n
makeData::[Int] -> [(Int,Int)]
makeData [] = []
makeData (a:as) | d == 10 = makeData as
                | r == 0 = (10,10-d):(makeData as)
                | otherwise = [(10-r,1),(10,9-d)]++(makeData as)
  where d = a `div` 10
        r = a `rem` 10
getRate ::[Int] -> Int
getRate a= foldl (\x y -> x + (y `div` 10)) 0 a
main = do
  w0 <- getLine
  let [n,k] = [read n::Int|n<-(words w0)]
  w1 <- getLine
  let a = [read n::Int| n<-(words w1)]
  let preSum = getRate a
  print (preSum + (getPlus k (elems (accumArray (+) 0 (1,10) (makeData a)))))

import Data.List

main = do
  nk <- getLine
  skillValues <- getLine
  putStrLn $ show $ solve (read $ last $ words nk) $ map read (words skillValues)

solve :: Int -> [Int] -> Int
solve k xss =
  let moduli = sort $ map ((10-) . (`mod` 10)) $ filter (/= 100) xss
      initialLevel = sum $ map (`quot` 10) xss
      filteredModuliSums = filter (<= k) $ scanl1 (+) moduli
      numFiltered = length filteredModuliSums
      numUsed = if numFiltered == 0 then
                  0
                else
                  last filteredModuliSums
      remainingSlots = (sum $ map (100-) xss) - numUsed
      remainingLevels = remainingSlots `quot` 10
      remainingSpend = k - numUsed
  in
   if numFiltered /= length moduli then
     numFiltered + initialLevel
   else
     initialLevel + numFiltered + min (remainingSpend `quot` 10) remainingLevels

import Data.List

perlevel :: Integral a => a
perlevel = 10

maxlevel :: Integral a => a
maxlevel = 100

rating :: (Integral a) => [a] -> a -> a
rating xs units =
    let xs' = sortBy perlevelcmp xs
        (incrxs, rest) = foldr step ([], units) xs'
    in (min (foldr (\v s -> s + (maxlevel - v)) 0 incrxs) rest) `div` perlevel +
            (foldr (\v s -> s + v `div` perlevel) 0 incrxs)
        where step v (vs, units) | v < maxlevel && v `mod` perlevel + units >= perlevel =
                    ((v + perlevel - v `mod` perlevel):vs, units - (perlevel - v `mod` perlevel))
                | otherwise = (v:vs, units)

perlevelcmp l r = compare (l `mod` perlevel) (r `mod` perlevel)

main = do
    inp <- getContents
    let ls = lines inp
        k = read $ (words $ head ls) !! 1
        xs = map read $ words $ ls !! 1 :: [Int]
    putStrLn $ show $ rating xs k

import Data.List (sort)

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

	let
		r = sum $ map (`div` 10) as
		sums = takeWhile (<= k) $ scanl1 (+) $ reverse $ sort $ filter (/= 10) $ map (\a -> 10 - a `mod` 10) as
		r' = if null sums then 0 else length sums
		r'' = if null sums then k else k - (last sums)

		t = r + r' + (r'' `div` 10)

		ans = if t >= 10 * n then 10 * n else t

	print ans

import Data.List

solve :: Int -> Int -> [Int] -> Int
solve n k levels =
  let
      -- the base level
      a0 = sum [ div a 10 | a <- levels ]
      -- sort by 10 - remainder mod 10
      sorted = map fst $ sort [ (10 - mod a 10, a) | a <- levels ]
      sums = scanl (+) 0 sorted
      (s,i) = last $ takeWhile (\(s,i) -> s <= k) (zip sums [0..])
  in a0 + i + (div (k-s) 10)

main = do
  (n : k : levels) <- fmap (map read . words) getContents
  print $ solve n k levels

test1 = print $ solve 2 4 [7,9]

test2 = print $ solve 3 8 [17, 15, 19]

test3 = print $ solve 2 2 [99, 100]

import Data.List

add3 (a,b,c) (x,y,z) = (a+x,b+y,c+z)

-- solve :: Int -> Int -> [Int] ->
solve n k levels =
  let
      -- the base level
      a0 = sum [ div a 10 | a <- levels ]
      -- sort by 10 - remainder mod 10
      sorted = sort [ (10 - r, q', if r == 0 then 0 else 1)
                      | a <- levels
                      , let (q,r) = divMod a 10
                      , let q' = 10-q - (if r == 0 then 0 else 1)
                      ]
      sums = scanl add3  (0,0,0) sorted
      (s,tens,i) = last $ takeWhile (\(s,_,_) -> s <= k) sums
      -- tens = # of tens available
  in (a0 + i + min tens (div (k-s) 10)) -- , a0, i, tens)

main = do
  (n : k : levels) <- fmap (map read . words) getContents
  print $ solve n k levels

test1 = print $ solve 2 4 [7,9]

test2 = print $ solve 3 8 [17, 15, 19]

test3 = print $ solve 2 2 [99, 100]

test4 = print $ solve 231 100 $ replicate 231 100

import Data.List

main = do
	l1 <- getLine
	n : k : [] <- return $ map (read :: String->Int) $ words l1
	l2 <- getLine
	v <- return $ map (read :: String->Int) $ words l2
	putStr $ show $ solve n k v

solve n k v = score0 + score1 + min rem_groups (rem' `div` 10) where
	rems = sort $ map (\x -> 10 - x `mod` 10) v
	rem_groups = sum $ map (\x -> 10 - (x + 9) `div` 10) v
	score0 = sum $ map (`div` 10) v
	(rem' , score1) = take_remainders k rems

take_remainders n [] = (n, 0)
take_remainders n (h : t)
		| n >= h	= let (n', s') = take_remainders (n - h) t in (n', 1 + s')
		| otherwise	= (n, 0)

import Data.List

main = do
	l1 <- getLine
	n : k : [] <- return $ map (read :: String->Int) $ words l1
	l2 <- getLine
	v <- return $ map (read :: String->Int) $ words l2
	putStr $ show $ solve n k v

solve n k v = score0 + score1 + min rem_groups (rem' `div` 10) where
	rems = sort $ map (\x -> 10 - x `mod` 10) v
	rem_groups = sum $ map (\x -> 10 - (x + 9) `div` 10) $ filter (< 100) v
	score0 = sum $ map (`div` 10) v
	(rem' , score1) = take_remainders k rems

take_remainders n [] = (n, 0)
take_remainders n (h : t)
		| n >= h	= let (n', s') = take_remainders (n - h) t in (n', 1 + s')
		| otherwise	= (n, 0)

import Data.List

main = do
	l1 <- getLine
	n : k : [] <- return $ map (read :: String->Int) $ words l1
	l2 <- getLine
	v <- return $ map (read :: String->Int) $ words l2
	putStr $ show $ solve n k v

solve n k v = score0 + score1 + min rem_groups (rem' `div` 10) where
	rems = sort $ map (\x -> 10 - x `mod` 10) $ filter (< 100) v
	rem_groups = sum $ map (\x -> 10 - (x + 9) `div` 10) v
	score0 = sum $ map (`div` 10) v
	(rem' , score1) = take_remainders k rems

take_remainders n [] = (n, 0)
take_remainders n (h : t)
		| n >= h	= let (n', s') = take_remainders (n - h) t in (n', 1 + s')
		| otherwise	= (n, 0)

import Data.List

main = do
  nk <- getLine
  skillValues <- getLine
  putStrLn $ show $ solve (read $ last $ words nk) $ map read (words skillValues)

solve :: Int -> [Int] -> Int
solve k xss =
  let moduli = sort $ map ((10-) . (`mod` 10)) $ filter (/= 100) xss
      initialLevel = sum $ map (`quot` 10) xss
      filteredModuliSums = filter (<= k) $ scanl1 (+) moduli
      numFiltered = length filteredModuliSums
      remainingSlots = (sum $ map (100-) moduli) - last filteredModuliSums
      remainingLevels = remainingSlots `quot` 10
      remainingSpend = k - last filteredModuliSums
  in
   if numFiltered /= length moduli then
     numFiltered + initialLevel
   else
     initialLevel + numFiltered + min (remainingSpend `quot` 10) remainingLevels

import Data.List

perlevel :: Integral a => a
perlevel = 10

rating :: (Integral a) => [a] -> a -> a
rating xs units =
    let xs' = reverse $ sort $ map (`mod` perlevel) xs
        units' = units `mod` perlevel
        (rat, rest) = count 0 xs' units'
    in rat + (rest `div` perlevel) + foldr (\v r -> r+(v `div` perlevel)) 0 xs
        where count cur [] k = (cur, k)
              count cur (v:vs) k | v+k >= perlevel = count (cur+1) vs (k-(perlevel-v))
                             | otherwise = (cur, k)

main = do
    inp <- getContents
    let ls = lines inp
        k = read $ (words $ head ls) !! 1
        xs = map read $ words $ ls !! 1 :: [Int]
    putStrLn $ show $ rating xs k

import Data.List

perlevel :: Integral a => a
perlevel = 10

rating :: (Integral a) => [a] -> a -> a
rating xs units =
    let xs' = reverse $ sort $ map (`mod` perlevel) xs
        (rat, rest) = count 0 xs' units
    in rat + (rest `div` perlevel) + foldr (\v r -> r+(v `div` perlevel)) 0 xs
        where count cur [] k = (cur, k)
              count cur (v:vs) k | v+k >= perlevel = count (cur+1) vs (k-(perlevel-v))
                             | otherwise = (cur, k)

main = do
    inp <- getContents
    let ls = lines inp
        k = read $ (words $ head ls) !! 1
        xs = map read $ words $ ls !! 1 :: [Int]
    putStrLn $ show $ rating xs k

import Data.List

perlevel :: Integral a => a
perlevel = 10

maxlevel :: Integral a => a
maxlevel = 100

rating :: (Integral a) => [a] -> a -> a
rating xs units =
    let xs' = reverse $ sortBy (\l r -> compare (l `div` perlevel) (r `div` perlevel)) xs
        (incrxs, rest) = foldl step ([], units) xs'
        (rs', _) = foldl step' ([], rest) incrxs
    in sum $ map (`div` perlevel) rs'
        where step (vs, units) v | v < maxlevel && v `mod` perlevel + units >= perlevel =
                    ((v + perlevel - v `mod` perlevel):vs, units - (perlevel - v `mod` perlevel))
                | otherwise = (v:vs, units)
              step' (vs, units) v =
                  let incr = min (maxlevel - v) units
                  in ((v+incr):vs, units-incr)

main = do
    inp <- getContents
    let ls = lines inp
        k = read $ (words $ head ls) !! 1
        xs = map read $ words $ ls !! 1 :: [Int]
    putStrLn $ show $ rating xs k


$$$2^k$$$ teams participate in a playoff tournament. The tournament consists of $$$2^k - 1$$$ games. They are held as follows: first of all, the teams are split into pairs: team $$$1$$$ plays against team $$$2$$$, team $$$3$$$ plays against team $$$4$$$ (exactly in this order), and so on (so, $$$2^{k-1}$$$ games are played in that phase). When a team loses a game, it is eliminated, and each game results in elimination of one team (there are no ties). After that, only $$$2^{k-1}$$$ teams remain. If only one team remains, it is declared the champion; otherwise, $$$2^{k-2}$$$ games are played: in the first one of them, the winner of the game "$$$1$$$ vs $$$2$$$" plays against the winner of the game "$$$3$$$ vs $$$4$$$", then the winner of the game "$$$5$$$ vs $$$6$$$" plays against the winner of the game "$$$7$$$ vs $$$8$$$", and so on. This process repeats until only one team remains.For example, this picture describes the chronological order of games with $$$k = 3$$$:  Let the string $$$s$$$ consisting of $$$2^k - 1$$$ characters describe the results of the games in chronological order as follows:  if $$$s_i$$$ is 0, then the team with lower index wins the $$$i$$$-th game;  if $$$s_i$$$ is 1, then the team with greater index wins the $$$i$$$-th game;  if $$$s_i$$$ is ?, then the result of the $$$i$$$-th game is unknown (any team could win this game). Let $$$f(s)$$$ be the number of possible winners of the tournament described by the string $$$s$$$. A team $$$i$$$ is a possible winner of the tournament if it is possible to replace every ? with either 1 or 0 in such a way that team $$$i$$$ is the champion.You are given the initial state of the string $$$s$$$. You have to process $$$q$$$ queries of the following form:   $$$p$$$ $$$c$$$ — replace $$$s_p$$$ with character $$$c$$$, and print $$$f(s)$$$ as the result of the query.

The first line contains one integer $$$k$$$ ($$$1 \le k \le 18$$$). The second line contains a string consisting of $$$2^k - 1$$$ characters — the initial state of the string $$$s$$$. Each character is either ?, 0, or 1. The third line contains one integer $$$q$$$ ($$$1 \le q \le 2 \cdot 10^5$$$) — the number of queries. Then $$$q$$$ lines follow, the $$$i$$$-th line contains an integer $$$p$$$ and a character $$$c$$$ ($$$1 \le p \le 2^k - 1$$$; $$$c$$$ is either ?, 0, or 1), describing the $$$i$$$-th query.

For each query, print one integer — $$$f(s)$$$.

import Control.Monad
import Data.Maybe
import Data.Bits
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

data Tree = Node Int Char Tree Tree | Nil

getNum :: Tree -> Int
getNum Nil = 1
getNum (Node num _ _ _) = num

main :: IO ()
main = do
  [k] <- getInts
  s <- C.getLine
  let t = change (2 ^ (k - 1)) s
        where change 1 str = C.take 1 str
              change i str = C.concat [change (i `div` 2) s2, s1]
                where (s1, s2) = C.splitAt i str
      merge ch l r = Node num ch l r
        where num = case ch of
                '0' -> getNum l
                '1' -> getNum r
                _ -> getNum l + getNum r
      build i
        | i <= 2 ^ k - 1 = merge (C.index t (i - 1)) l r
        | otherwise = Nil
        where l = build (i * 2)
              r = build (i * 2 + 1)
      update _ Nil _ = error ""
      update ch (Node _ _ ls rs) [] = merge ch ls rs
      update ch (Node _ char ls rs) (p : ps) = merge char ls' rs'
        where ls' = if p == 0 then update ch ls ps else ls
              rs' = if p == 1 then update ch rs ps else rs
  [q] <- getInts
  (output', _) <- foldM (\(output, tree) _ -> do
    [ps, cs] <- C.words <$> C.getLine
    let changeIndex i target
          | target <= i = i - 1 + target
          | otherwise = changeIndex (i `div` 2) (target - i)
        changeIndex' i
          | i <= 1 = []
          | otherwise = (i .&. 1) : changeIndex' (i `div` 2)
        p = changeIndex (2 ^ (k - 1)) $ parseInt ps
        (c : _) = C.unpack cs
        tree' = update c tree $ reverse $ changeIndex' p
    return $ (output `mappend` intDec (getNum tree') `mappend` charUtf8 '\n', tree')) (mempty, build 1) $ replicate q ()
  hPutBuilder stdout output'

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Bits

solve :: IO ()
solve = do
    k <- readLn :: IO Int
    s <- getLine
    q <- readLn :: IO Int
    qs <- replicateM q $ do
        [p, c] <- words <$> getLine
        return (read p, head c) :: IO (Int, Char)
    let n = 2 ^ k
        pos x = h + (h - 1) `xor` (y - h)
            where y = n - x
                  h = 1 `shiftL` (finiteBitSize y - countLeadingZeros y - 1)
        getf '0' = const
        getf '1' = const id
        getf _   = (+)
        ans :: forall s. ST s [Int]
        ans = do
            f :: STUArray s Int Char <- newArray (1, n) 'x'
            b :: STUArray s Int Int <- newArray (1, 2 * n) 1
            let upd :: Int -> ST s ()
                upd i | i < 1 = return ()
                upd i = do
                    c <- readArray f i
                    liftM2 (getf c) (readArray b $ i * 2) (readArray b $ i * 2 + 1) >>= writeArray b i
                    upd $ i `div` 2
            forM (zip [1..] s ++ qs) $ \(p, c) -> do
                let i = pos p
                writeArray f i c
                upd i
                readArray b 1
    putStr $ unlines $ map show $ drop (n - 1) $ runST ans

main :: IO ()
main = solve

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: Int -> String -> [(Int, Char)] -> [Int]
solve k s' qs =
    runST $ do
        let n = 1 `shift` k :: Int
        s <- newListArray (0, n-2) s' :: ST s (STUArray s Int Char)
        dp <- newArray (1, 2 * n) 1 :: ST s (STUArray s Int Int)

        let
            update k = do
                x0 <- readArray dp (2*k+1)
                x1 <- readArray dp (2*k)
                c <- readArray s (n-1-k)
                let r = case c of
                                '0' -> x0
                                '1' -> x1
                                '?' -> x0 + x1
                writeArray dp k r

        forM_ [0..n-2] $ \i -> do
            let k = n-1-i
            update k

        let
            runqs [] = return []
            runqs ((i,c):qs) = do
                writeArray s i c
                go (n-1-i)
                r <- readArray dp 1
                rs <- runqs qs
                return $ r : rs

            go 0 = return ()
            go k = update k >> go (k `div` 2)

        runqs qs

main = do
    k <- parseInt <$> BS.getLine
    s <- dropWhile isSpace . BS.unpack <$> BS.getLine
    qn <- parseInt <$> BS.getLine
    qs <- replicateM qn $ do
        [p,c] <- map BS.unpack . BS.words <$> BS.getLine
        return (read p - 1, head c)
    let rs = solve k s qs
    putStr . unlines . map show $ rs

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

data Tree = Node Int Char Tree Tree | Nil

getNum :: Tree -> Int
getNum Nil = 1
getNum (Node num _ _ _) = num

putTree :: Tree -> IO ()
putTree Nil = return ()
putTree (Node num ch ls rs) = do
  putStrLn $ show num ++ " ch:" ++ show ch
  putTree ls
  putTree rs

main :: IO ()
main = do
  [k] <- getInts
  s <- C.getLine
  let t = change (2 ^ (k - 1)) s
        where change 1 str = C.take 1 str
              change i str = C.concat [change (i `div` 2) s2, s1]
                where (s1, s2) = C.splitAt i str
      merge ch l r = Node num ch l r
        where num = case ch of
                '0' -> getNum l
                '1' -> getNum r
                _ -> getNum l + getNum r
      build i
        | i <= 2 ^ k - 1 = merge (C.index t (i - 1)) l r
        | otherwise = Nil
        where l = build (i * 2)
              r = build (i * 2 + 1)
      changeIndex prev i target
        | target <= prev + i = i - 1 + target - prev
        | otherwise = changeIndex (prev + i) (i `div` 2) target
      update _ Nil _ = error ""
      update ch (Node _ _ ls rs) 1 = merge ch ls rs
      update ch (Node _ char ls rs) target = merge char ls' rs'
        where target' = target `div` 2
              ls' = if even target then update ch ls target' else ls
              rs' = if odd target then update ch rs target' else rs
  [q] <- getInts
  (output', _) <- foldM (\(output, tree) _ -> do
    [ps, cs] <- C.words <$> C.getLine
    let p = changeIndex 0 (2 ^ (k - 1)) $ parseInt ps
        (c : _) = C.unpack cs
        tree' = update c tree p
    -- putStrLn $ "p:" ++ show p
    -- putTree tree'
    return $ (output `mappend` intDec (getNum tree') `mappend` charUtf8 '\n', tree')) (mempty, build 1) $ replicate q ()
  hPutBuilder stdout output'

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

data Tree = Node Int Char Tree Tree | Nil

getNum :: Tree -> Int
getNum Nil = 1
getNum (Node num _ _ _) = num

putTree :: Tree -> IO ()
putTree Nil = return ()
putTree (Node num ch ls rs) = do
  putStrLn $ show num ++ " ch:" ++ show ch
  putTree ls
  putTree rs

main :: IO ()
main = do
  [k] <- getInts
  s <- C.getLine
  let t = change (2 ^ (k - 1)) s
        where change 1 str = C.take 1 str
              change i str = C.concat [change (i `div` 2) s2, s1]
                where (s1, s2) = C.splitAt i str
      merge ch l r = Node num ch l r
        where num = case ch of
                '0' -> getNum l
                '1' -> getNum r
                _ -> getNum l + getNum r
      build i
        | i <= 2 ^ k - 1 = merge (C.index t (i - 1)) l r
        | otherwise = Nil
        where l = build (i * 2)
              r = build (i * 2 + 1)
      changeIndex prev i target
        | target <= prev + i = i - 1 + target - prev
        | otherwise = changeIndex (prev + i) (i `div` 2) target
      update _ Nil _ = error ""
      update ch (Node _ _ ls rs) 1 = merge ch ls rs
      update ch (Node _ char ls rs) target = merge char ls' rs'
        where target' = target `div` 2
              ls' = if even target then update ch ls target' else ls
              rs' = if odd target then update ch rs target' else rs
  [q] <- getInts
  (output', _) <- foldM (\(output, tree) _ -> do
    [ps, cs] <- C.words <$> C.getLine
    let p = changeIndex 0 (2 ^ (k - 1)) $ parseInt ps
        (c : _) = C.unpack cs
        tree' = update c tree p
    putStrLn $ "p:" ++ show p
    putTree tree'
    return $ (output `mappend` intDec (getNum tree') `mappend` charUtf8 '\n', tree')) (mempty, build 1) $ replicate q ()
  hPutBuilder stdout output'


You are given $$$n$$$ strings $$$a_1, a_2, \ldots, a_n$$$: all of them have the same length $$$m$$$. The strings consist of lowercase English letters.Find any string $$$s$$$ of length $$$m$$$ such that each of the given $$$n$$$ strings differs from $$$s$$$ in at most one position. Formally, for each given string $$$a_i$$$, there is no more than one position $$$j$$$ such that $$$a_i[j] \ne s[j]$$$.Note that the desired string $$$s$$$ may be equal to one of the given strings $$$a_i$$$, or it may differ from all the given strings.For example, if you have the strings abac and zbab, then the answer to the problem might be the string abab, which differs from the first only by the last character, and from the second only by the first.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case starts with a line containing two positive integers $$$n$$$ ($$$1 \le n \le 10$$$) and $$$m$$$ ($$$1 \le m \le 10$$$) — the number of strings and their length. Then follow $$$n$$$ strings $$$a_i$$$, one per line. Each of them has length $$$m$$$ and consists of lowercase English letters.

Print $$$t$$$ answers to the test cases. Each answer (if it exists) is a string of length $$$m$$$ consisting of lowercase English letters. If there are several answers, print any of them. If the answer does not exist, print "-1" ("minus one", without quotes).

5
2 4
abac
zbab
2 4
aaaa
bbbb
3 3
baa
aaa
aab
2 2
ab
bb
3 1
a
b
c

NoteThe first test case was explained in the statement.In the second test case, the answer does not exist.

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

diff xs ys = sum $ zipWith (\x y -> if x /= y then 1 else 0) xs ys

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : _ <- map read . words <$> getLine
        as        <- replicateM n getLine
        putStrLn
            $ case
                  filter (\xs -> all (\ys -> diff xs ys <= 1) as)
                  . cands
                  . head
                  $ as
              of
                  [] -> "-1"
                  vs -> head vs

cands :: String -> [String]
cands []       = []
cands (x : xs) = [ y : xs | y <- ['a' .. 'z'] ] ++ [ x : y | y <- cands xs ]

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

main = getLine >>= flip replicateM_ test . read

test = do
    (n:m:_) <- map read . words <$> getLine
    as <- replicateM n getLine
    putStrLn $ fromMaybe "-1" (solve as)

solve as =
    listToMaybe
        [ s
        | let a = head as
        , i <- [0 .. length a - 1]
        , c <- (!! i) <$> as
        , let s = take i a ++ c : drop (i + 1) a
        , all ((<= 1) . length . filter (== False) . zipWith (==) s) as
        ]

import Control.Monad (replicateM, replicateM_)

readSizes :: IO [Int]
readSizes = (map read) . words <$> getLine

readStrings :: IO [String]
readStrings = readSizes >>= \ [n, _] ->
     replicateM n getLine

are1CharAway :: String -> String -> Bool
are1CharAway s1 s2 = foldl accumulate 0 (zip s1 s2) <= 1
    where
        accumulate = \ acc (c1, c2) -> acc + if c1 == c2 then 0 else 1

checkString :: String -> [String] -> Bool
checkString s ss = all (are1CharAway s) ss

replaceChar :: Int -> Char -> String -> String
replaceChar idx c xs = [if idx == i then c else x | (x, i) <- zip xs [0..]]

permutateString :: String -> [String]
permutateString xs = [replaceChar idx c xs | idx <- [0..m], c <- enumFromTo 'a' 'z']
    where m = length xs - 1

solve :: [String] -> String
solve xss = if length ans > 0 then head ans else "-1"
    where
        template = head xss
        ans = filter (\xs -> checkString xs xss) (permutateString template)

main =
    read <$> getLine >>= \t ->
    replicateM_ t (
        readStrings >>= \xss ->
        putStrLn $ solve xss
    )

--- frederick99, 6/2020
--- https://codeforces.com/contest/1360/problem/F

{-# LANGUAGE TupleSections #-}
import Control.Monad ( replicateM_ )

spyString :: Int -> [String] -> String
spyString m [] = replicate m '0'
spyString m (leader : members) =
    case filter isSpy candidates of
        (spy : _) -> spy
        _         -> "-1"
    where
        isSpy cand = all ((2 >) . hammingDistance cand) members
        candidates = gen `concatMap` map (`splitAt` leader) [0..m-1]
        gen (l, r) = ((l ++) . (: tail r)) `map` ['a'..'z']

hammingDistance :: String -> String -> Int
hammingDistance a b = sum $ zipWith ((fromEnum.) . (/=)) a b

readInput :: IO (Int, [String])
readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (uncurry spyString <$> readInput >>= putStrLn)

{-# LANGUAGE TupleSections #-}

import Control.Monad ( replicateM_ )

readInput = do
    [n, m] <- map read . words <$> getLine
    (m, ) <$> (sequence $ replicate n getLine)

spyString :: (Int, [String]) -> String
spyString (m, (leader : members)) =
    case filter isSpy candidates of
        (spy : _) -> spy
        _         -> "-1"
    where
        isSpy cand = all ((< 2) . sum . map(fromEnum . uncurry (/=)) . zip cand) members
        candidates = concatMap gen (map (flip splitAt leader) [0..m-1])
        gen (l, r) = map ((l ++) . (: tail r)) ['a'..'z']

main = do
    t <- read <$> getLine
    replicateM_ t (spyString <$> readInput >>= putStrLn)

import Data.Traversable (for)
import Control.Applicative (liftA2)

alpha :: String
alpha = enumFromTo 'a' 'z'

solns :: Int -> [String] -> [String]
solns k [] = foldr (liftA2 (:)) [""] $ replicate k alpha
solns _ (s:os) = filter isNbrOs $ neighbors s  where
  neighbors [] = [[]]
  neighbors (c:cs) = ((: cs) <$> alpha) ++ ((c :) <$> neighbors cs)
  isNbrOs str = and (map (isNeighbor str) os)
  isNeighbor s1 s2 = length (filter id (zipWith (/=) s1 s2)) <= 1

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  _ <- for [1..t] $ \_ -> do
    [n, m] <- map read . words <$> getLine :: IO [Int]
    strs <- for [1..n] $ const getLine
    putStrLn $ case  solns m strs  of
      []    -> "-1"
      ans:_ -> ans
  pure ()

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

findElements :: String -> String
findElements xs = map fst $ filter
    (\(x, y) -> abs (arr ! x - arr ! y) <= 1)
    [ (x, y) | x <- cands, y <- xs ]
  where
    maxval = maximum arr
    arr    = accumArray (+) 0 ('a', 'z') $ zip xs (repeat 1)
    cands =
        concatMap (take 1)
            . accumArray (flip (:)) [] (max 0 $ maxval - 1, maxval)
            . filter ((\v -> maxval - v <= 1) . fst)
            . map (\(a, b) -> (b, a))
            $ assocs arr

diff xs ys = sum $ zipWith (\x y -> if x /= y then 1 else 0) xs ys

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : _ <- map read . words <$> getLine
        as        <- replicateM n getLine
        putStrLn
            $ case
                  filter (\x -> all (\a -> diff x a <= 1) as)
                  . mapM findElements
                  $ transpose as
              of
                  [] -> "-1"
                  as -> head as

import           Control.Monad
import           Data.List
import           Data.Maybe

diff :: String -> String -> Int
diff xs ys = sum $ zipWith (\x y -> if x /= y then 1 else 0) xs ys

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : _ <- map read . words <$> getLine
        as        <- replicateM n getLine
        putStrLn $ fromMaybe
            "-1"
            (find (\a -> maximum (map (diff a) as) == 1) as)