You are a rebel leader and you are planning to start a revolution in your country. But the evil Government found out about your plans and set your punishment in the form of correctional labor.You must paint a fence which consists of $$$10^{100}$$$ planks in two colors in the following way (suppose planks are numbered from left to right from $$$0$$$):   if the index of the plank is divisible by $$$r$$$ (such planks have indices $$$0$$$, $$$r$$$, $$$2r$$$ and so on) then you must paint it red;  if the index of the plank is divisible by $$$b$$$ (such planks have indices $$$0$$$, $$$b$$$, $$$2b$$$ and so on) then you must paint it blue;  if the index is divisible both by $$$r$$$ and $$$b$$$ you can choose the color to paint the plank;  otherwise, you don't need to paint the plank at all (and it is forbidden to spent paint on it). Furthermore, the Government added one additional restriction to make your punishment worse. Let's list all painted planks of the fence in ascending order: if there are $$$k$$$ consecutive planks with the same color in this list, then the Government will state that you failed the labor and execute you immediately. If you don't paint the fence according to the four aforementioned conditions, you will also be executed.The question is: will you be able to accomplish the labor (the time is not important) or the execution is unavoidable and you need to escape at all costs.

The first line contains single integer $$$T$$$ ($$$1 \le T \le 1000$$$) — the number of test cases. The next $$$T$$$ lines contain descriptions of test cases — one per line. Each test case contains three integers $$$r$$$, $$$b$$$, $$$k$$$ ($$$1 \le r, b \le 10^9$$$, $$$2 \le k \le 10^9$$$) — the corresponding coefficients.

Print $$$T$$$ words — one per line. For each test case print REBEL (case insensitive) if the execution is unavoidable or OBEY (case insensitive) otherwise.

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = fmap words getLine

getIntList :: IO [Integer]
getIntList = fmap (map read) getStrList

f :: Integer -> Integer -> Integer -> String
f a b k
    | r == 0 = if k < d then "REBEL" else "OBEY"
    | otherwise = if k <= div (b - 2) a + 1 then "REBEL" else "OBEY"
    where r = mod b a
          d = div b a
          l = lcm a b

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [r, b, k] <- getIntList
        let x = div r (gcd r b)
            y = div b (gcd r b) in
                putStrLn $ f (min x y) (max x y) k

import Control.Monad

solve :: Int-> Int -> Int -> Bool
solve r b k = (n+1)<k
  where
    (x,y) = (max r b,min r b)
    g = gcd x y
    (x',y') = (x `div` g,y `div` g)
    n = (x'-2) `div` y'

routine :: IO ()
routine = do
  l <- fmap (map read . words) getLine
  if solve (head l) (l!!1) (l!!2) then putStrLn "OBEY" else putStrLn "REBEL"

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = fmap words getLine

getIntList :: IO [Integer]
getIntList = fmap (map read) getStrList

f :: Integer -> Integer -> Integer -> String
f r b k
    | k <= div b r = "REBEL"
    | otherwise = "OBEY"

main :: IO()
main = do
    t <- readLn
    replicateM_ t $ do
        [r, b, k] <- getIntList
        putStrLn $ f (min r b) (max r b) k

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = fmap words getLine

getIntList :: IO [Integer]
getIntList = fmap (map read) getStrList

upd :: Integer -> Integer -> Integer
upd u d
    | mod u d == 0 = div u d
    | otherwise = div u d + 1

f :: Integer -> Integer -> Integer -> String
f r b k
    | k < upd b r = "REBEL"
    | otherwise = "OBEY"

main :: IO()
main = do
    t <- readLn
    replicateM_ t $ do
        [r, b, k] <- getIntList
        putStrLn $ f (min r b) (max r b) k

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = fmap words getLine

getIntList :: IO [Integer]
getIntList = fmap (map read) getStrList

f :: Integer -> Integer -> Integer -> String
f a b k
    | r == 0 = if k < d then "REBEL" else "OBEY"
    | otherwise = if k <= div (b - 2) a + 1 then "REBEL" else "OBEY"
    where r = mod b a
          d = div b a

main :: IO()
main = do
    t <- readLn
    replicateM_ t $ do
        [r, b, k] <- getIntList
        putStrLn $ f (min r b) (max r b) k

import Control.Monad

solve :: Int-> Int -> Int -> Bool
solve r b k = n<k
  where
    (x,y) = (max r b,min r b)
    g = gcd x y
    (x',y') = (x `div` g,y `div` g)
    n = (x'-2) `div` y'

routine :: IO ()
routine = do
  l <- fmap (map read . words) getLine
  if solve (head l) (l!!1) (l!!2) then putStrLn "OBEY" else putStrLn "REBEL"

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

import Control.Monad

solve :: Int-> Int -> Int -> Bool
solve r b k = n<k
  where
    (x,y) = (max r b,min r b)
    g = gcd x y
    (x',y') = (x `div` g,y `div` g)
    n = (x'-1) `div` y'

routine :: IO ()
routine = do
  l <- fmap (map read . words) getLine
  if solve (head l) (l!!1) (l!!2) then putStrLn "OBEY" else putStrLn "REBEL"

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine


There are $$$n$$$ boxes with different quantities of candies in each of them. The $$$i$$$-th box has $$$a_i$$$ candies inside.You also have $$$n$$$ friends that you want to give the candies to, so you decided to give each friend a box of candies. But, you don't want any friends to get upset so you decided to eat some (possibly none) candies from each box so that all boxes have the same quantity of candies in them. Note that you may eat a different number of candies from different boxes and you cannot add candies to any of the boxes.What's the minimum total number of candies you have to eat to satisfy the requirements?

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 50$$$) — the number of boxes you have. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq 10^7$$$) — the quantity of candies in each box.

For each test case, print a single integer denoting the minimum number of candies you have to eat to satisfy the requirements.

NoteFor the first test case, you can eat $$$1$$$ candy from the second box, $$$2$$$ candies from the third box, $$$3$$$ candies from the fourth box and $$$4$$$ candies from the fifth box. Now the boxes have $$$[1, 1, 1, 1, 1]$$$ candies in them and you ate $$$0 + 1 + 2 + 3 + 4 = 10$$$ candies in total so the answer is $$$10$$$.For the second test case, the best answer is obtained by making all boxes contain $$$5$$$ candies in them, thus eating $$$995 + 995 + 0 + 995 + 995 + 995 = 4975$$$ candies in total.

import Control.Monad
main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    n <- read <$> getLine :: IO Int
    list <- fmap (fmap read)
          . fmap words
	  $ getLine
    print $ solve list
solve l = sum . map (\x -> x - k) $ l
  where
  k = minimum l

module Main where

import Data.List
import Data.Maybe

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let sols = map (format . solve . parse) $ take t $ sep $ lines input
  mapM_ putStrLn sols

sep [] = []
sep (_:x:xs) = x:(sep xs)

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

format = show

solve xs = sum $ map ((+) (-m)) xs
  where m = minimum xs

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> Int
solve n as = L.sum $ L.map (\x -> x - minA) as
    where
        minA = L.minimum as

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = solve n as
        printf "%d\n" answer

import Data.List
import Data.Char

main :: IO ()
main = do
	n <- getLine
	let number = read n :: Int
	solve number number

solve :: Int -> Int -> IO ()
solve number 0 = return ()
solve number current = 	do
				useles <- getLine
				l <- getLine
				let bruh = ((map read) . words ) l :: [Int]
				let min = minimum bruh
				let ans = foldr (\s -> \acc -> acc + s - min) 0 bruh
				putStrLn $ show $ ans
				solve number (current - 1)

import Control.Monad
import Data.List

sol :: [Int] -> Int
sol xs = foldl' (\acc x -> acc + x - m) 0 xs
  where
    m = minimum xs

readCase :: IO [Int]
readCase = do
  n <- read <$> getLine :: IO Int
  map read . words <$> getLine

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  cases <- replicateM t readCase
  putStrLn $ intercalate "\n" (map (show . sol) cases)

import Control.Arrow ((>>>))

solve :: [Int] -> Int
solve arr = sum $ map (\x -> x - m) arr
  where
    m = minimum arr

second (x : y : xs) = y : second xs
second _ = []

main =
  interact $
    lines
      >>> drop 1
      >>> second
      >>> map (show . solve . map (read :: String -> Int) . words)
      >>> unlines

import Control.Monad (replicateM_, replicateM)

main :: IO ()
main = read <$> getLine >>= flip replicateM_ singleCase

singleCase :: IO ()
singleCase = read <$> getLine >>= \n -> map read . words <$> getLine >>=
             \xs -> let m = minL xs
                        s = sum xs
                    in print (s - n*m)

minL :: [Int] -> Int
minL (x:xs) = foldl min x xs

minn :: [Int] -> Int
minn (x: []) = x
minn (x: xs) = min x (minn xs)

for :: Int -> IO ()
for 0 = pure ()
for i = do
  readLn :: IO Int
  arr <- (map (\s -> read s :: Int)) <$> (words <$> getLine)
  let mn = minn arr
  print $ sum $ map (\a -> a - mn) arr
  for $ i - 1

main = do
  t <- readLn :: IO Int
  for t


Tyndex is again well ahead of the rivals! The reaction to the release of Zoozle Chrome browser was the release of a new browser Tyndex.Brome!The popularity of the new browser is growing daily. And the secret is not even the Tyndex.Bar installed (the Tyndex.Bar automatically fills the glass with the finest 1664 cognac after you buy Tyndex.Bottles and insert in into a USB port). It is highly popular due to the well-thought interaction with the user.Let us take, for example, the system of automatic address correction. Have you entered codehorses instead of codeforces? The gloomy Zoozle Chrome will sadly say that the address does not exist. Tyndex.Brome at the same time will automatically find the closest address and sent you there. That's brilliant!How does this splendid function work? That's simple! For each potential address a function of the F error is calculated by the following rules:  for every letter ci from the potential address c the closest position j of the letter ci in the address (s) entered by the user is found. The absolute difference |i - j| of these positions is added to F. So for every i (1 ≤ i ≤ |c|) the position j is chosen such, that ci = sj, and |i - j| is minimal possible.  if no such letter ci exists in the address entered by the user, then the length of the potential address |c| is added to F. After the values of the error function have been calculated for all the potential addresses the most suitable one is found. To understand the special features of the above described method better, it is recommended to realize the algorithm of calculating the F function for an address given by the user and some set of potential addresses. Good luck!

The first line contains two integers n and k (1 ≤ n ≤ 105, 1 ≤ k ≤ 105). They are the number of potential addresses and the length of the address entered by the user. The next line contains k lowercase Latin letters. They are the address entered by the user (s). Each next i-th (1 ≤ i ≤ n) line contains a non-empty sequence of lowercase Latin letters. They are the potential address. It is guaranteed that the total length of all the lines does not exceed 2·105.

On each n line of the output file print a single number: the value of the error function when the current potential address is chosen. Please, do not use %lld specificator to read or write 64-bit integers in C++. It is preffered to use cout (also you may use %I64d).

9 9
vkontakte
vcontacte
vkontrakte
vkollapse
vkrokodile
vtopke
vkapuste
vpechke
vk
vcodeforcese

import Data.Map as M
import Data.Set as S
main = interact $ solve . lines
solve input = output where
  [n, k] = Prelude.map (read :: String -> Int) $ words $ head input
  entered = input !! 1
  potential = drop 2 input
  output = unlines $ Prelude.map show $ Prelude.map (f mx) potential
   where mx = m $ zip entered [1..]
f xs ys = dif xs (zip ys [1..]) (length ys)
m [] = M.fromList [(x,S.empty)|x<-['a'..'z']]
m ((x,y):xs) = adjust (S.insert y) x (m xs)
dif :: Map Char (Set Int) -> [(Char,Int)] -> Int -> Integer
dif x [] l = 0
dif x ((y,z):ys) l = dif x ys l + toInteger w where
 w
  | S.null xy     = l
  | S.member z xy = 0
  | otherwise     = min i1 i2
  where xy = x!y
        (s1,s2) = S.split z xy
        i1 = if S.null s1 then 999999 else z - S.findMax s1
        i2 = if S.null s2 then 999999 else S.findMin s2 - z

import Data.Map as M
import Data.Set as S
main = interact $ solve . lines
solve input = output where
  [n, k] = Prelude.map (read :: String -> Int) $ words $ head input
  entered = input !! 1
  potential = drop 2 input
  output = unlines $ Prelude.map show $ Prelude.map (f mx) potential
   where mx = m $ zip entered [1..]
f xs ys = dif xs (zip ys [1..]) (length ys)
m [] = M.fromList [(x,S.empty)|x<-['a'..'z']]
m ((x,y):xs) = adjust (S.insert y) x (m xs)
dif :: Map Char (Set Int) -> [(Char,Int)] -> Int -> Integer
dif x [] l = 0
dif x ((y,z):ys) l = dif x ys l + toInteger w where
 w
  | S.null xy     = l
  | S.member z xy = 0
  | otherwise     = min i1 i2
  where xy = x!y
        (s1,s2) = S.split z xy
        i1 = if S.null s1 then l else z - S.findMax s1
        i2 = if S.null s2 then l else S.findMin s2 - z

import Data.Map as M
import Data.Set as S
main = interact $ solve . lines
solve input = output where
  [n, k] = Prelude.map (read :: String -> Int) $ words $ head input
  entered = input !! 1
  potential = drop 2 input
  output = unlines $ Prelude.map show $ Prelude.map (f mx) potential
   where mx = m $ zip entered [1..]
f xs ys = dif xs (zip ys [1..]) (length ys)
m [] = M.fromList [(x,S.empty)|x<-['a'..'z']]
m ((x,y):xs) = adjust (S.insert y) x (m xs)
dif x [] l = 0
dif x ((y,z):ys) l = dif x ys l + w where
 w
  | S.null xy     = l
  | S.member z xy = 0
  | otherwise     = min i1 i2
  where xy = x!y
        (s1,s2) = S.split z xy
        i1 = if S.null s1 then l else z - S.findMax s1
        i2 = if S.null s2 then l else S.findMin s2 - z


Phone number in Berland is a sequence of n digits. Often, to make it easier to memorize the number, it is divided into groups of two or three digits. For example, the phone number 1198733 is easier to remember as 11-987-33. Your task is to find for a given phone number any of its divisions into groups of two or three digits.

The first line contains integer n (2 ≤ n ≤ 100) — amount of digits in the phone number. The second line contains n digits — the phone number to divide into groups.

Output any of divisions of the given phone number into groups of two or three digits. Separate groups by single character -. If the answer is not unique, output any.

solve "" = ""
solve x
	| length x <= 3 = x
	| otherwise = (take 2 x) ++ "-" ++ (solve $ drop 2 x)

main = do
	_ <- getLine
	s <- getLine
	putStrLn $ solve s

main :: IO ()
main = interact func

func :: String -> String
func s = func'.head.tail$lines s

func' :: String -> String
func' [] = ""
func' (_:[]) = error ""
func' xs@(_:_:[]) = xs
func' xs@(_:_:_:[]) = xs
func' (a:b:c:d:[]) = a:b:'-':c:d:[]
func' (a:b:c:xs) = a:b:c:'-':(func' xs)

solve :: String -> [String]
solve []  =  []
solve (a:b:c:[])  =  [[a,b,c]]
solve (c:[])  =  undefined
solve (a:b:cs)  =  [a,b] : solve cs

printAns :: [String] -> IO ()
printAns []  =  undefined
printAns [s]  =  putStrLn s
printAns (x:xs)  =  putStr x >> putStr "-" >> printAns xs

main :: IO ()
main  =  getLine >> getLine >>= printAns . solve

import Data.List
split s = map (map snd) . groupBy  (\(a,_) (b,_) -> div a 3 == div b 3) . zip [0..] $ s
solve s = intercalate "-" . reverse . adjust . reverse . split $ s
    where adjust ([x]:[a,b,c]:xs) = [a,b,'-',c,x]:xs
          adjust xs = xs

main = getLine >> getLine >>= putStrLn . solve

main = getLine >> getLine >>= putStrLn . solve
solve :: String -> String
solve n@[a,b,c] = n
solve n@[a,b] = n
solve (a:b:xs) = a : b : '-' : solve xs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import Text.Printf

{-# SPECIALIZE for_ :: Char -> Char -> (Char -> IO ()) -> IO () #-}
{-# SPECIALIZE for_ :: Int -> Int -> (Int -> IO ()) -> IO () #-}
for_ :: (Monad m, Ord a, Enum a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
      output cs@(_ : _ : _ : []) = printf "%s\n" cs
      output cs@(_ : _ : [])     = printf "%s\n" cs
      output cs                  = printf "%s-" (take 2 cs) >> output (drop 2 cs)
  n : _ <- readData
  cs <- take n <$> getLine
  output cs


You are given $$$n$$$ patterns $$$p_1, p_2, \dots, p_n$$$ and $$$m$$$ strings $$$s_1, s_2, \dots, s_m$$$. Each pattern $$$p_i$$$ consists of $$$k$$$ characters that are either lowercase Latin letters or wildcard characters (denoted by underscores). All patterns are pairwise distinct. Each string $$$s_j$$$ consists of $$$k$$$ lowercase Latin letters.A string $$$a$$$ matches a pattern $$$b$$$ if for each $$$i$$$ from $$$1$$$ to $$$k$$$ either $$$b_i$$$ is a wildcard character or $$$b_i=a_i$$$.You are asked to rearrange the patterns in such a way that the first pattern the $$$j$$$-th string matches is $$$p[mt_j]$$$. You are allowed to leave the order of the patterns unchanged.Can you perform such a rearrangement? If you can, then print any valid order.

The first line contains three integers $$$n$$$, $$$m$$$ and $$$k$$$ ($$$1 \le n, m \le 10^5$$$, $$$1 \le k \le 4$$$) — the number of patterns, the number of strings and the length of each pattern and string. Each of the next $$$n$$$ lines contains a pattern — $$$k$$$ characters that are either lowercase Latin letters or underscores. All patterns are pairwise distinct. Each of the next $$$m$$$ lines contains a string — $$$k$$$ lowercase Latin letters, and an integer $$$mt$$$ ($$$1 \le mt \le n$$$) — the index of the first pattern the corresponding string should match.

Print "NO" if there is no way to rearrange the patterns in such a way that the first pattern that the $$$j$$$-th string matches is $$$p[mt_j]$$$. Otherwise, print "YES" in the first line. The second line should contain $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ — the order of the patterns. If there are multiple answers, print any of them.

5 3 4
_b_d
__b_
aaaa
ab__
_bcd
abcd 4
abba 2
dbcd 5

NoteThe order of patterns after the rearrangement in the first example is the following:   aaaa  __b_  ab__  _bcd  _b_d Thus, the first string matches patterns ab__, _bcd, _b_d in that order, the first of them is ab__, that is indeed $$$p[4]$$$. The second string matches __b_ and ab__, the first of them is __b_, that is $$$p[2]$$$. The last string matches _bcd and _b_d, the first of them is _bcd, that is $$$p[5]$$$.The answer to that test is not unique, other valid orders also exist.In the second example cba doesn't match __c, thus, no valid order exists.In the third example the order (a_, _b) makes both strings match pattern $$$1$$$ first and the order (_b, a_) makes both strings match pattern $$$2$$$ first. Thus, there is no order that produces the result $$$1$$$ and $$$2$$$.

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

import Data.Char
import Data.Array.Unboxed
import qualified Data.Graph

import Control.Monad.ST
import Data.Array.ST.Safe
import qualified Control.Monad.ST.Lazy as L

type SIO = StateT P.ByteString IO

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

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

charOpts :: [Char]
charOpts = '_' : ['a' .. 'z']

least :: Int
least = minimum (ord <$> charOpts)

radix :: Int
radix = maximum (ord <$> charOpts) - least + 1

maxk :: Int
maxk = 4

maxhash :: Int
maxhash = radix ^ maxk

hash :: P.ByteString -> Int
hash = let
  step x c = (ord c - least) + radix * x
  in  P.foldl' step 0

opts :: P.ByteString -> [Int]
opts = let
  step xs c = [(ord ac - least) + radix * x | x <- xs, ac <- c : "_"]
  in  P.foldl' step [0]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m, k] <- readInts
  when (k > maxk) $ error "k exceeds bounds, hashing may fail"
  pats <- replicateM n readLine
  toMatch <- replicateM m readLine
  let
    patArr :: UArray Int Int
    patArr = array (1, n) . zip [1..] $ map (hash {-. P.unpack-}) pats
    reversePatArr :: UArray Int Int
    reversePatArr = accumArray (const id) (0-1) (0, maxhash)
      [(hs, i) | (i, hs) <- assocs patArr]
    edges = foldr (liftM2 (:)) (pure []) $ do
      [currStr, mtjStr] <- map P.words toMatch
      let
        Just (mtj, _) = P.readInt mtjStr
        currOpts = [j | h <- opts currStr, let  j = reversePatArr ! h, j >= 0]
      if  elem mtj currOpts
        then  [Just (mtj, opt) | opt <- currOpts, opt /= mtj]
        else  [Nothing]
  lift $ case  edges >>= topoSort (1, n)  of
    Nothing -> P.putStrLn $ P.pack "NO"
    Just reorder -> do
      P.putStrLn $ P.pack "YES"
      P.putStrLn . P.pack . unwords $ map show reorder

topoSort :: (Int, Int) -> [(Int, Int)] -> Maybe [Int]
topoSort grBounds edges = let
  graph = Data.Graph.buildG grBounds edges
  -- can't use Data.Graph.topSort, because we need to check existence
  sccs = Data.Graph.scc graph
  in  forM (reverse sccs) $ \tree -> case  tree  of
  Data.Graph.Node x []  -> Just x
  _  -> Nothing

{- -- My topological sort
seenBefore :: (Int, Int) -> [Int] -> [Int]
seenBefore bnds li = L.runST $ do
  seenArr <- L.strictToLazyST (newArray bnds 0 :: ST s (STUArray s Int Int))
  let
    check :: STUArray s Int Int -> Int -> L.ST s Int
    check arr val = L.strictToLazyST $ do
      res <- readArray arr val
      writeArray arr val $ res + 1
      pure res
    go [] = pure []
    go (val : vals) = liftM2 (:) (check seenArr val) (go vals)
  go li

-- This is still kind of unpleasant, but it's nice that all of
-- the mutability is abstracted into one lazy function
topoSort :: (Int, Int) -> [(Int, Int)] -> Maybe [Int]
topoSort grBounds edges = let
  graph :: Array Int [Int]
  graph = accumArray (flip (:)) [] grBounds edges
  inDegrees :: UArray Int Int
  inDegrees = accumArray (\p _ -> p + 1) 0 grBounds [(y, ()) | (_, y) <- edges]
  -- Use Nothing to separate iterations, to allow termination detection
  keepAppropriateVisits :: [Maybe Int] -> [Maybe Int]
  keepAppropriateVisits li = let
    visCts = seenBefore grBounds [x | Just x <- li]
    step _ [] = []
    step cts (Nothing : xs) = Nothing : step cts xs
    step (ct : cts) (Just x : xs) = if ct == inDegrees ! x
      then  Just x : step cts xs
      else           step cts xs
    step [] _ = error "topoSort.keepAppropriateVisits: expected longer visCts"
    in  step visCts li
  neighbors :: Maybe Int -> [Maybe Int]
  neighbors Nothing = [Nothing]
  neighbors (Just x) = map Just (graph ! x)
  reachableNodes = keepAppropriateVisits queries
  queries = map Just (indices graph) ++ Nothing : concatMap neighbors reachableNodes
  cleanUp :: [Maybe Int] -> [Int]
  cleanUp (Nothing : Nothing : _) = []
  cleanUp (Just x : xs) = x : cleanUp xs
  cleanUp (_ : xs) = cleanUp xs
  cleanUp [] = error "topoSort.cleanUp: expected infinite list"
  ans = cleanUp reachableNodes
  in  if  length ans == rangeSize grBounds
  then  Just ans
  else  Nothing
-}

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

import Data.Char
import Data.Array.Unboxed

import Control.Monad.ST
import Data.Array.ST.Safe
import qualified Control.Monad.ST.Lazy as L
--import Data.STRef

type SIO = StateT P.ByteString IO

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

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

charOpts :: [Char]
charOpts = '_' : ['a' .. 'z']

least :: Int
least = minimum (ord <$> charOpts)

radix :: Int
radix = maximum (ord <$> charOpts) - least + 1

maxk :: Int
maxk = 4

maxhash :: Int
maxhash = radix ^ maxk

{-
hash :: String -> Int
hash = let
  in  sum . zipWith (\x c -> (ord c - least) * x) (iterate (* radix) 1)

opts :: P.ByteString -> [Int]
opts = map hash . foldr (liftM2 (:)) [[]] . map (: "_") . P.unpack
-}

hash :: P.ByteString -> Int
hash = let
  step x c = (ord c - least) + radix * x
  in  P.foldl' step 0

opts :: P.ByteString -> [Int]
opts = let
  step xs c = [(ord ac - least) + radix * x | x <- xs, ac <- c : "_"]
  in  P.foldl' step [0]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m, k] <- readInts
  when (k > maxk) $ error "k exceeds bounds, hashing may fail"
  pats <- replicateM n readLine
  toMatch <- replicateM m readLine
  let
    patArr :: UArray Int Int
    patArr = array (1, n) . zip [1..] $ map (hash {-. P.unpack-}) pats
    reversePatArr :: UArray Int Int
    reversePatArr = accumArray (const id) (0-1) (0, maxhash)
      [(hs, i) | (i, hs) <- assocs patArr]
    edges = foldr (liftM2 (:)) (pure []) $ do
      [currStr, mtjStr] <- map P.words toMatch
      let
        Just (mtj, _) = P.readInt mtjStr
        currOpts = [j | h <- opts currStr, let  j = reversePatArr ! h, j >= 0]
      if  elem mtj currOpts
        then  [Just (mtj, opt) | opt <- currOpts, opt /= mtj]
        else  [Nothing]
  lift $ case  edges >>= topoSort (1, n)  of
    Nothing -> P.putStrLn $ P.pack "NO"
    Just reorder -> do
      P.putStrLn $ P.pack "YES"
      P.putStrLn . P.pack . unwords $ map show reorder

{-
while :: Monad m => m Bool -> m () -> m ()
while condition action = loop  where
  loop = condition >>= flip when (action >> loop)

updateEntry :: STUArray s Int Int -> Int -> (Int -> Int) -> ST s Int
updateEntry arr ix f = do
  newVal <- f <$> readArray arr ix
  writeArray arr ix newVal -- No thunk accumulation: STUArray will force next
  pure newVal

topoSort :: (Int, Int) -> [(Int, Int)] -> Maybe [Int]
topoSort grBounds edges = runST $ do
  inDegrees <- newArray grBounds 0 :: ST s (STUArray s Int Int)
  forM_ edges $ \(_, j) -> updateEntry inDegrees j (+1)
  let  outEdges = accumArray (flip (:)) [] grBounds edges :: Array Int [Int]
  -- Is there a purer way to find a topological sort?
  -- This is disgustingly mutable.
  toProcess <- getAssocs inDegrees >>= \li -> newSTRef [i | (i, 0) <- li]
  ansVar <- newSTRef []
  while (not . null <$> readSTRef toProcess) $ do
    i : rest <- readSTRef toProcess
    writeSTRef toProcess rest
    modifySTRef ansVar (i :)
    forM_ (outEdges ! i) $ \j -> do
      newInDeg <- updateEntry inDegrees j (subtract 1)
      when (newInDeg == 0) $ modifySTRef toProcess (j :)
  ans <- readSTRef ansVar
  pure $ if  length ans == rangeSize grBounds
    then  Just $ reverse ans
    else  Nothing
-}

seenBefore :: (Int, Int) -> [Int] -> [Int]
seenBefore bnds li = L.runST $ do
  seenArr <- L.strictToLazyST (newArray bnds 0 :: ST s (STUArray s Int Int))
  let
    check :: STUArray s Int Int -> Int -> L.ST s Int
    check arr val = L.strictToLazyST $ do
      res <- readArray arr val
      writeArray arr val $ res + 1
      pure res
    go [] = pure []
    go (val : vals) = liftM2 (:) (check seenArr val) (go vals)
  go li

-- This is still kind of unpleasant, but it's nice that all of
-- the mutability is abstracted into one lazy function
topoSort :: (Int, Int) -> [(Int, Int)] -> Maybe [Int]
topoSort grBounds edges = let
  graph :: Array Int [Int]
  graph = accumArray (flip (:)) [] grBounds edges
  inDegrees :: UArray Int Int
  inDegrees = accumArray (\p _ -> p + 1) 0 grBounds [(y, ()) | (_, y) <- edges]
  -- Use Nothing to separate iterations, to allow termination detection
  keepAppropriateVisits :: [Maybe Int] -> [Maybe Int]
  keepAppropriateVisits li = let
    visCts = seenBefore grBounds [x | Just x <- li]
    step _ [] = []
    step cts (Nothing : xs) = Nothing : step cts xs
    step (ct : cts) (Just x : xs) = if ct == inDegrees ! x
      then  Just x : step cts xs
      else           step cts xs
    step [] _ = error "topoSort.keepAppropriateVisits: expected longer visCts"
    in  step visCts li
  neighbors :: Maybe Int -> [Maybe Int]
  neighbors Nothing = [Nothing]
  neighbors (Just x) = map Just (graph ! x)
  reachableNodes = keepAppropriateVisits queries
  queries = map Just (indices graph) ++ Nothing : concatMap neighbors reachableNodes
  cleanUp :: [Maybe Int] -> [Int]
  cleanUp (Nothing : Nothing : _) = []
  cleanUp (Just x : xs) = x : cleanUp xs
  cleanUp (_ : xs) = cleanUp xs
  cleanUp [] = error "topoSort.cleanUp: expected infinite list"
  ans = cleanUp reachableNodes
  in  if  length ans == rangeSize grBounds
  then  Just ans
  else  Nothing


Bob has a permutation of integers from 1 to n. Denote this permutation as p. The i-th element of p will be denoted as pi. For all pairs of distinct integers i, j between 1 and n, he wrote the number ai, j = min(pi, pj). He writes ai, i = 0 for all integer i from 1 to n.Bob gave you all the values of ai, j that he wrote down. Your job is to reconstruct any permutation that could have generated these values. The input will be formed so that it is guaranteed that there is at least one solution that is consistent with the information given.

The first line of the input will contain a single integer n (2 ≤ n ≤ 50). The next n lines will contain the values of ai, j. The j-th number on the i-th line will represent ai, j. The i-th number on the i-th line will be 0. It's guaranteed that ai, j = aj, i and there is at least one solution consistent with the information given.

Print n space separated integers, which represents a permutation that could have generated these values. If there are multiple possible solutions, print any of them.

NoteIn the first case, the answer can be {1, 2} or {2, 1}.In the second case, another possible answer is {2, 4, 5, 1, 3}.

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

getIntList :: IO [Int]
getIntList = fmap read . words <$> getLine

getIntMat :: Int -> IO [[Int]]
getIntMat r = replicateM r (fmap read . words <$> getLine)

main :: IO ()
main = putStrLn . unwords . fmap show =<< sol <$> (readLn >>= getIntMat)

sol :: [[Int]] -> [Int]
sol mat = fmap (+1) [fromMaybe (n-1) $ findIndex (==r) rs | r <- [0..n-1]]
  where
  n = length mat
  f i row = length $ filter (==i) row
  g i = fromJust $ findIndex (==(n-i)) [f i (mat!!r) | r <- [0..n-1]]
  rs = [g i | i <- [1..n-1]]

import Data.List(sort)

readRows :: Int ->IO [[Int]]
readRows 0 = return []
readRows i = do
  raw_line <-getLine
  this <-return . fmap (read::String ->Int) . words $ raw_line
  next <-readRows (i-1)
  return (this:next)

solve :: [(Int, [Int])] ->Int ->[Int]
solve [] _ = []
solve list iter =
  (\(xs,((i,_):ys)) -> (i : solve (xs ++ ys) (iter+1)))
  $ (span (any (>iter) . snd) list)

permute :: [Int] ->[Int]
permute = fmap snd . sort . (`zip` [1..])

main :: IO()
main = do
  n <-(readLn::IO Int)
  input <-readRows n
  result <-return $ permute $ solve (zip [1..] input) 1
  putStrLn . unwords . fmap show $ result

import Data.List(sort)

readRows :: Int ->IO [[Int]]
readRows 0 = return []
readRows i = do
  raw_line <-getLine
  this <-return . fmap (read::String ->Int) . words $ raw_line
  next <-readRows (i-1)
  return (this:next)

solve :: [(Int, [Int])] ->Int ->[Int]
solve [] _ = []
solve list iter =
  (\(xs,((i,_):ys)) -> (i : solve (xs ++ ys) (iter+1)))
  $ (span (any (>iter) . snd) list)

permute :: [Int] ->[Int]
permute = fmap snd . sort . (`zip` [1..])

main :: IO()
main = do
  n <-(readLn::IO Int)
  input <-readRows n
  result <-return $ permute $ solve (zip [1..] input) 1
  print result


There is a given sequence of integers a1, a2, ..., an, where every number is from 1 to 3 inclusively. You have to replace the minimum number of numbers in it so that all the numbers in the sequence are equal to each other.

The first line contains an integer n (1 ≤ n ≤ 106). The second line contains a sequence of integers a1, a2, ..., an (1 ≤ ai ≤ 3).

Print the minimum number of replacements needed to be performed to make all the numbers in the sequence equal.

NoteIn the example all the numbers equal to 1 and 3 should be replaced by 2.

import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe
import IO

main = do C.hGetContents stdin >>= putStr . show . gao . map (fst . fromJust . C.readInt) . C.words where
	gao (n:a) = n - maximum [length $ filter (==i) a | i <- [1 .. 3]]

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List

main = do
    getLine
    xs <- fmap B.words B.getContents
    print $ solve xs

solve :: [B.ByteString] -> Integer
solve xs = a + b
  where [a,b,c] = sort $ foldl(#)[0,0,0] xs

[a,b,c]# "1" = [a+1,b,c]
[a,b,c]# "2" = [a,b+1,c]
[a,b,c]# "3" = [a,b,c+1]

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List

main = do
  _ <- getLine
  xs <- fmap B.words B.getContents
  print (solve xs)

solve :: [B.ByteString] -> Int
solve xs =
  let (a,b,c) = foldl' f (0,0,0) xs
      m = (max a (max b c))
  in a+b+c-m
  where
    f (a,b,c) x | x == "1" = (a+1,b,c)
                | x == "2" = (a,b+1,c)
                |otherwise = (a,b,c+1)

import Data.List

main = do
    getLine
    xs <- fmap words getContents
    print $ solve xs

solve :: [String] -> Integer
solve xs = a + b
  where [a,b,c] = sort $ foldl(#)[0,0,0] xs

[a,b,c]# "1" = [a+1,b,c]
[a,b,c]# "2" = [a,b+1,c]
[a,b,c]# "3" = [a,b,c+1]

import Data.List

main = do
    getLine
    xs <- fmap words getLine
    print $ solve xs

solve :: [String] -> Integer
solve xs = a + b
  where [a,b,c] = sort $ foldl(#)[0,0,0] xs

[a,b,c]# "1" = [a+1,b,c]
[a,b,c]# "2" = [a,b+1,c]
[a,b,c]# "3" = [a,b,c+1]

module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.Unboxed
import Data.Array.ST

main = do
    n <- read `liftM` getLine
    nums <- getLine
    let countArray = runSTUArray $ do
        countArray <- newArray ('1','3') 0 :: ST s (STUArray s Char Int)
        forM_ nums $ \c -> if c == ' '
            then return ()
            else readArray countArray c >>= writeArray countArray c . (1+)
        return countArray

    putStrLn $ show $ n - ( maximum $ elems countArray )

import Data.List

main = interact $ show . f . lines
f [n,as] = read n - g (words as) [0,0,0]
  where
  g ("1":as) [x,y,z] = x `seq` g as [x+1, y, z]
  g ("2":as) [x,y,z] = y `seq` g as [x, y+1, z]
  g ("3":as) [x,y,z] = z `seq` g as [x, y, z+1]
  g  _        bs     = maximum bs

readI :: String -> Int
readI = read

main = do
    n <- getLine >>= return . readI
    xs <- getLine
    print $ solve n xs

solve n xs = caiser (words xs) [0,0,0] where

    caiser ("1":xs) [c1, c2, c3] = c1 `seq` caiser xs [c1+1, c2, c3]
    caiser ("2":xs) [c1, c2, c3] = c2 `seq` caiser xs [c1, c2+1, c3]
    caiser ("3":xs) [c1, c2, c3] = c3 `seq` caiser xs [c1, c2, c3+1]
    caiser _        cs           = n - maximum cs

solve :: Int -> String -> Int
solve n xs  =  n - maximum [c1, c2, c3]
  where
    (c1, c2, c3)  =  solve' 0 0 0 xs
    solve' c1 c2 c3 []  =  (c1, c2, c3)
    solve' c1 c2 c3 ('1':xs)  =  seq c1' solve' c1' c2 c3 xs
      where
        c1'  =  c1 + 1
    solve' c1 c2 c3 ('2':xs)  =  seq c2' solve' c1 c2' c3 xs
      where
        c2'  =  c2 + 1
    solve' c1 c2 c3 ('3':xs)  =  seq c3' solve' c1 c2 c3' xs
      where
        c3'  =  c3 + 1
    solve' c1 c2 c3 (_:xs)  =  solve' c1 c2 c3 xs

main :: IO ()
main  =  do
    n  <-  readLn
    xs  <-  getLine
    print $ solve n xs

import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B
main=B.interact$B.pack.show.f.tail.map(fst.fromJust.B.readInt).B.words
f x=sum$init$sort[g 1 x, g 2 x, g 3 x]
g k x=length$filter(==k)$x

{-# OPTIONS_GHC -O2 #-}

import Data.Char

count :: Eq a => a -> [a] -> Int
count t = foldl (\x y -> if y == t then x + 1 else x) 0

solve arr = (a + b + c) - (a `max` b `max` c)
  where
    a = count '1' arr
    b = count '2' arr
    c = count '3' arr

main = do
    line <- getLine
    arr <- fmap (filter isDigit) getLine
    print $ solve arr


Marina loves Sasha. But she keeps wondering whether Sasha loves her. Of course, the best way to know it is fortune telling. There are many ways of telling fortune, but Marina has picked the easiest one. She takes in her hand one or several camomiles and tears off the petals one by one. After each petal she pronounces alternatively "Loves" and "Doesn't love", at that Marina always starts with "Loves". There are n camomiles growing in the field, possessing the numbers of petals equal to a1, a2, ... an. Marina wants to pick a bouquet with the maximal possible total number of petals so that the result would still be "Loves". Help her do that; find the maximal number of petals possible in the bouquet.

The first line contains an integer n (1 ≤ n ≤ 100), which is the number of flowers growing in the field. The second line contains n integers ai (1 ≤ ai ≤ 100) which represent the number of petals on a given i-th camomile.

Print a single number which is the maximal number of petals in the bouquet, the fortune telling on which would result in "Loves". If there are no such bouquet, print 0 instead. The bouquet may consist of a single flower.

import List

main = do
	n <- fmap read getLine
	a <- fmap (map read . words) getLine
	putStrLn $ show $ gao n a

gao :: Int -> [Integer] -> Integer
gao n a = if null o then 0 else sum e + sum (if odd $ length o then o else tail o) where
	o = sort $ filter odd a
	e = sort $ filter even a

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.List

readInt = fst . fromJust . C.readInt
readIntList = map readInt . C.words

solve a
	| sum a `mod` 2 == 1 = sum a
	| otherwise = case firstOdd of
		Nothing -> 0
		Just x -> sum a - x
	where firstOdd = find (\x -> x `mod` 2 == 1) a

main = do
	input <- fmap (map (C.takeWhile (/='\r')) . C.lines) $ C.hGetContents stdin
	let n = readInt $ input !! 0
	let a = readIntList $ input !! 1
	print $ solve $ sort a

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

import Control.Applicative
import Control.DeepSeq (deepseq)
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 Data.STRef
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.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
-- import Debug.Trace
import System.IO
import System.Random

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

main = do
  getLine
  as <- getInts

  let
    s1 = sum $ filter even as
    os = filter odd as

    s2 = sum $ if odd (length os) then os else tail $ sort os

  print $
    if null os
      then 0
      else s1 + s2

main=interact(show.o.map read.words)
o(n:ds)=if odd s then s else if all even ds then 0 else s-(minimum.filter odd)ds where s=sum ds

solve :: [Int] -> Int
solve xs
  | length odds == 0  =  0
  | otherwise  =  sum xs - if (odd $ length odds) then 0 else minimum odds
  where
    odds  =  filter odd xs
    evens  =  filter even xs

main :: IO ()
main  =  getLine >> fmap (map read . words) getLine >>= print . solve

import Data.List
main = do
    [n] <- map read `fmap` (words `fmap` getLine)
    flowers <-  fmap (\s -> map (\(a, _) -> read a) $ zip s [1..n]) (words `fmap` getLine)
    if all even flowers then putStr "0" else
        if even $ sum flowers then do
            let f' = sort flowers
                firstOdd = find odd f'
            putStr $ show $ case firstOdd of
                Just e -> sum flowers - e
                Nothing -> 0
        else putStr $ show $ sum flowers

import Data.Char

numbers = (\s-> ([0] ++ (map (\s-> read s ::Int) $ words s)))
ans = (\s-> ( maximum $ [0] ++ (filter (\n-> n`mod`2 == 1) $ map (\x-> sum (numbers s) - x) (numbers s) )))

main = do
  getLine
  line <- getLine
  putStrLn (show (ans line))

opt [] _ oddOpt = oddOpt
opt (x:xs) evenOpt oddOpt
  | odd x	= opt xs (max evenOpt $ if oddOpt>0 then oddOpt+x else 0)
                  (max oddOpt $ evenOpt+x)
  | otherwise	= opt xs (evenOpt+x) $ if oddOpt>0 then oddOpt+x else 0

main = do
  n <- getLine
  line <- getLine
  print $ opt (map read $ words line) 0 0


Riley is a very bad boy, but at the same time, he is a yo-yo master. So, he decided to use his yo-yo skills to annoy his friend Anton.Anton's room can be represented as a grid with $$$n$$$ rows and $$$m$$$ columns. Let $$$(i, j)$$$ denote the cell in row $$$i$$$ and column $$$j$$$. Anton is currently standing at position $$$(i, j)$$$ in his room. To annoy Anton, Riley decided to throw exactly two yo-yos in cells of the room (they can be in the same cell).Because Anton doesn't like yo-yos thrown on the floor, he has to pick up both of them and return back to the initial position. The distance travelled by Anton is the shortest path that goes through the positions of both yo-yos and returns back to $$$(i, j)$$$ by travelling only to adjacent by side cells. That is, if he is in cell $$$(x, y)$$$ then he can travel to the cells $$$(x + 1, y)$$$, $$$(x - 1, y)$$$, $$$(x, y + 1)$$$ and $$$(x, y - 1)$$$ in one step (if a cell with those coordinates exists).Riley is wondering where he should throw these two yo-yos so that the distance travelled by Anton is maximized. But because he is very busy, he asked you to tell him.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of each test case contains four integers $$$n$$$, $$$m$$$, $$$i$$$, $$$j$$$ ($$$1 \leq n, m \leq 10^9$$$, $$$1\le i\le n$$$, $$$1\le j\le m$$$) — the dimensions of the room, and the cell at which Anton is currently standing.

For each test case, print four integers $$$x_1$$$, $$$y_1$$$, $$$x_2$$$, $$$y_2$$$ ($$$1 \leq x_1, x_2 \leq n$$$, $$$1\le y_1, y_2\le m$$$) — the coordinates of where the two yo-yos should be thrown. They will be thrown at coordinates $$$(x_1,y_1)$$$ and $$$(x_2,y_2)$$$. If there are multiple answers, you may print any.

NoteHere is a visualization of the first test case.

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

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

solve [n,m,i,j] = putStrLn $ toStr [1,1,n,m]

main = do
    t <- readLn :: IO Int
    xss <- replicateM t readInts
    mapM_ solve xss

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

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

solve [n,m,i,j] = putStrLn $ toStr [x1,y1,x2,y2]
                where
                x1 = 1
                y1 = 1
                x2 = n
                y2 = m

main = do
    t <- readLn :: IO Int
    xss <- replicateM t readInts
    mapM_ solve xss

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n, m, i, j] <- map fromIntegral <$> getInts :: IO [Int64]
    let corners = [(x, y) | x <- [1, n], y <- [1, m]]
        distance (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
        func q p1 p2 = distance q p1 + distance p1 p2 + distance p2 q
        calc q p1 p2 = min (func q p1 p2) (func q p2 p1)
        (_, (x1, y1), (x2, y2)) = maximum [(calc (i, j) p1 p2, p1, p2) | p1 <- corners, p2 <- corners]
    return $ string7 (printf "%d %d %d %d\n" x1 y1 x2 y2)
  hPutBuilder stdout output

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

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

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

import qualified Data.ByteString.Char8 as B

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

import Debug.Trace
import Text.Printf

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

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

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

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

main = readInt >>= flip replicateM solve

solve = do
	[ h, w, _, _ ] <- readInts
	printf "%d %d %d %d\n" ( 1 :: Int ) ( 1 :: Int ) h w

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
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 qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

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

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

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        [n,m,i,j] <- map parseInt . BS.words <$> BS.getLine
        putStrLn $ "1 1 " ++ show n ++ " " ++ show m

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

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

solve [n,m,i,j] = putStrLn $ toStr [x1,y1,x2,y2]
                where
                x1 = 1
                y1 = j
                x2 = n
                y2 = if m - j > j - 1 then m else 1

main = do
    t <- readLn :: IO Int
    xss <- replicateM t readInts
    mapM_ solve xss

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n, m, i, j] <- getInts
    let corners = [(x, y) | x <- [1, n], y <- [1, m]]
        distance (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
        func q p1 p2 = distance q p1 + distance p1 p2 + distance p2 q
        calc q p1 p2 = min (func q p1 p2) (func q p2 p1)
        (_, (x1, y1), (x2, y2)) = maximum [(calc (i, j) p1 p2, p1, p2) | p1 <- corners, p2 <- corners]
    return $ string7 (printf "%d %d %d %d\n" x1 y1 x2 y2)
  hPutBuilder stdout output

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n, m, i, j] <- getInts
    let corners = [(x, y) | x <- [1, n], y <- [1, m]]
        distance (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
        (_, (x1, y1), (x2, y2)) = maximum [(distance (i, j) p1 + distance p1 p2 + distance p2 (i, j), p1, p2) | p1 <- corners, p2 <- corners]
    return $ string7 (printf "%d %d %d %d\n" x1 y1 x2 y2)
  hPutBuilder stdout output


You are given the array $$$a$$$ consisting of $$$n$$$ positive (greater than zero) integers.In one move, you can choose two indices $$$i$$$ and $$$j$$$ ($$$i \ne j$$$) such that the absolute difference between $$$a_i$$$ and $$$a_j$$$ is no more than one ($$$|a_i - a_j| \le 1$$$) and remove the smallest of these two elements. If two elements are equal, you can remove any of them (but exactly one).Your task is to find if it is possible to obtain the array consisting of only one element using several (possibly, zero) such moves or not.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 50$$$) — the length of $$$a$$$. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 100$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$.

For each test case, print the answer: "YES" if it is possible to obtain the array consisting of only one element using several (possibly, zero) moves described in the problem statement, or "NO" otherwise.

NoteIn the first test case of the example, we can perform the following sequence of moves:  choose $$$i=1$$$ and $$$j=3$$$ and remove $$$a_i$$$ (so $$$a$$$ becomes $$$[2; 2]$$$);  choose $$$i=1$$$ and $$$j=2$$$ and remove $$$a_j$$$ (so $$$a$$$ becomes $$$[2]$$$). In the second test case of the example, we can choose any possible $$$i$$$ and $$$j$$$ any move and it doesn't matter which element we remove.In the third test case of the example, there is no way to get rid of $$$2$$$ and $$$4$$$.

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
import safe Data.List (sort)

main :: IO ()
main =
  interact $
    lines >>> drop 1
      >>> map (words >>> map read)
      >>> process
      >>> map (\b -> if b then "YES" else "NO")
      >>> unlines

process :: [[Int]] -> [Bool]
process [] = []
process ([_] : xs : rest) = solve xs : process rest

solve :: [Int] -> Bool
solve [_] = True
solve xs = let xs' = sort xs in maximum (zipWith (-) (drop 1 xs') xs') <= 1

import Data.List

solve :: [Int] -> String
solve [] = "NO"
solve [_] = "YES"
solve (x':x:xs) | abs (x' - x) <= 1 = solve (x:xs)
                | otherwise = "NO"

clean :: [String] -> [String]
clean []           = []
clean (_ : s : ss) = s : clean ss
clean _            = undefined

main :: IO ()
main = interact
  (unlines . map (solve . sort . map read . words) . clean . tail . lines)

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

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  putStrLn $ bool "NO" "YES" $ all (<= 1) $ zipWith subtract <*> tail $ sort as

import Control.Monad
import Data.Bool
import Data.List

solve :: IO ()
solve = do
  getLine
  as <- map read . words <$> getLine
  putStrLn $ bool "NO" "YES" $ all (<= 1) $ zipWith subtract <*> tail $ sort as

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

module Main where

import Data.List

second (_:x:xs) = x : second xs
second _ = []

process :: [Int] -> Bool
process x = not $ any (> 1) diffs
  where diffs = zipWith (-) (tail s) s
        s = sort x

main = interact $ unlines . map (out . process . map read . words) . second . tail . lines
  where out x = if x then "YES" else "NO"

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t $
    getLine >> getLine >>= putStrLn . yesNo . solve . map read . words

solve :: [Int] -> Bool
solve a =
  let l = sort a
   in all (<= 1) $ zipWith (-) (tail l) l

yesNo :: Bool -> String
yesNo True = "YES"
yesNo False = "NO"

module Main where

    import Data.List

    solve :: IO ()
    solve = do
        _ <- getLine
        s <- getLine
        let a = sort $ map (\x -> read x :: Integer) $ words s
            n = length a
            l = length [i | i <- [0..n - 2], a !! (i + 1) - a !! i <= 1]
        putStrLn $ if n == l + 1 then
            "YES"
        else
            "NO"

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

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

import Control.Monad -- for replicateM_

sort :: Ord a => [a] -> [a]
sort []     = []
sort (p:xs) = (sort lesser) ++ [p] ++ (sort greater)
    where
        lesser  = filter (< p) xs
        greater = filter (>= p) xs

solve :: [Int] -> Bool
solve (x:xs)
    | null xs = True
    | otherwise =  continuous && solve xs
    where
        continuous = abs (x - (head xs)) <= 1

formatOutput :: String -> String -> Bool -> String
formatOutput true false boolean
    | boolean == True = true
    | otherwise = false

deal :: IO()
deal = do
    getLine
    x <- map read . words <$> getLine
    putStrLn $ formatOutput "YES" "NO" $ solve $ sort x

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

import Control.Monad
-- 1. sorting
-- 2. False when there are non continuous && non duplicate && !Solve
-- True when
--      (continuous || (non continuous && next two is duplicate)) && solve xs

sort :: Ord a => [a] -> [a]
sort []     = []
sort (p:xs) = (sort lesser) ++ [p] ++ (sort greater)
    where
        lesser  = filter (< p) xs
        greater = filter (>= p) xs

solve :: [Int] -> Bool
solve (x:xs)
    | null xs = True
    | otherwise =  continuous && solve xs
    where
        continuous = abs (x - (head xs)) <= 1

formatOutput :: String -> String -> Bool -> String
formatOutput true false boolean
    | boolean == True = true
    | otherwise = false

-- show . solve . sort . map read . words
deal :: IO()
deal = do
    getLine
    x <- map read . words <$> getLine
    putStrLn $ formatOutput "YES" "NO" $ solve $ sort x
    -- putStrLn "hello"

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

-- SPDX-License-Identifier: X11
-- 2020-08-25
-- Remove Smallest

module Main where

import Data.List (sort)

solve :: (Num a, Ord a) => [a] -> String
solve = (\x -> if x then "YES\n" else "NO\n") . comp . sort
  where
    comp :: (Num a, Ord a) => [a] -> Bool
    comp (x : ys@(y : _)) = abs (x - y) <= 1 && comp ys
    comp _                = True

parse :: String -> String
parse = concatMap (solve . map (read :: String -> Int) . words) .
          subl [] . tail . lines
  where
    subl :: [a] -> [a] -> [a]
    subl l [_, y]       = reverse (y : l)
    subl l (_ : y : zs) = subl (y : l) zs
    subl _ _            = error "subl: Unhandled case"

main :: IO ()
main = getContents >>= \x -> putStr . parse $ x

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

onecase = do
		getLine
		x<- sort <$> map read <$> words <$> getLine ::IO [Int]
		if length x ==1 then putStrLn "YES"
				else
					do
						let y = maximum $ map abs $ zipWith (-) x (tail x)
						putStrLn $ if y>1 then "NO" else "YES"

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

import System.IO
import Data.List
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int)) . words <$> tail contents
    sequence $ solve arr

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve [] = []
solve (_:arr:xs) =
    let go :: Int -> [Int] -> Bool
        go x []     = True
        go x (a:xs) = a-x <= 1 && go a xs
        sorted = sort arr
    in putStrLn (toYes (go (head sorted) (tail sorted))):solve xs

toYes True = "YES"
toYes _ = "NO"

import Control.Arrow
import Data.List

main :: IO ()
main = interact $
    lines >>> tail >>> process >>> unlines

process :: [String] -> [String]
process [] = []
process [x] = []
process (_:x:xs) = (res) : (process xs)
    where
        x' = map read $ words x
        ans = solve x'
        res = if ans then "YES" else "NO"

solve :: [Int] -> Bool
solve [a] = True
solve a = maximum gaps <= 1
    where
        a' = sort a
        -- gaps = map (\(x, y) -> x - y) $ zip a' (tail a')
        -- gaps = zipWith (\ x  y -> x - y) (tail a') a'
        gaps = zipWith (-) (tail a') a'
        -- operators need to be enclosed in parentheses if you want to pass it as argument

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

onecase = do
		getLine
		x<- map read <$> words <$> getLine ::IO [Int]
		if length x ==1 then putStrLn "YES"
				else
					do
						let y = maximum $ map abs $ zipWith (-) x (tail x)
						putStrLn $ if y>1 then "NO" else "YES"

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

import System.IO
import Data.List
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int)) . words <$> tail contents
    sequence $ solve arr

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve [] = []
solve (_:arr:xs) =
    let go :: Int -> [Int] -> Bool
        go x []     = True
        go x (a:xs) = a-x <= 1 && go a xs
        sorted = sort arr
    in print (go (head sorted) (tail sorted)):solve xs


In the Main Berland Bank n people stand in a queue at the cashier, everyone knows his/her height hi, and the heights of the other people in the queue. Each of them keeps in mind number ai — how many people who are taller than him/her and stand in queue in front of him.After a while the cashier has a lunch break and the people in the queue seat on the chairs in the waiting room in a random order.When the lunch break was over, it turned out that nobody can remember the exact order of the people in the queue, but everyone remembers his number ai.Your task is to restore the order in which the people stood in the queue if it is possible. There may be several acceptable orders, but you need to find any of them. Also, you need to print a possible set of numbers hi — the heights of people in the queue, so that the numbers ai are correct.

The first input line contains integer n — the number of people in the queue (1 ≤ n ≤ 3000). Then n lines contain descriptions of the people as "namei ai" (one description on one line), where namei is a non-empty string consisting of lowercase Latin letters whose length does not exceed 10 characters (the i-th person's name), ai is an integer (0 ≤ ai ≤ n - 1), that represents the number of people who are higher and stand in the queue in front of person i. It is guaranteed that all names are different.

If there's no acceptable order of the people in the queue, print the single line containing "-1" without the quotes. Otherwise, print in n lines the people as "namei hi", where hi is the integer from 1 to 109 (inclusive), the possible height of a man whose name is namei. Print the people in the order in which they stand in the queue, starting from the head of the queue and moving to its tail. Numbers hi are not necessarily unique.

module Main where

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

import Data.Time.Calendar

main = interact (unlines . solve .
    map (\s -> let a = words s in (a !! 0, read $ a !! 1)) .
    tail . lines)

solve :: [(String, Int)] -> [String]
solve humans = result where
    result = case heightOrder of
        Nothing -> ["-1"]
        Just h  -> answer where
            answer = map (\(name, height) -> name ++ (' ' : show height)) que
            que = map (\(x, y, z) -> (y, z)) $ sort $ zipWith (\(name, num) height -> (num, name, height)) (reverse h) [1..]

    heightOrder = getOrder sortedHumans
    sortedHumans = sortBy (\(n1, c1) (n2, c2) -> compare c1 c2) humans

getOrder :: [(String, Int)] -> Maybe [(String, Int)]
getOrder = getOrder' (Just []) 0
getOrder' result _ [] = result
getOrder' result k ((n, c) : humans) = getOrder' (ins (n, k) c result) (k + 1) humans

ins :: a -> Int -> Maybe [a] -> Maybe [a]
ins _ _ Nothing = Nothing
ins x i (Just xs) = if i <= length xs
    then let (b, e) = splitAt i xs in Just (b ++ (x : e))
    else Nothing

import Data.Array.IO
import Control.Monad
import Data.Array
import Data.List

-- set next[x] to be at level c
add :: IOUArray Int Int -> Int -> Int -> IO ()
add next x c = do
  let loop p 0 = return p
      loop p c = do p' <- readArray next p; loop p' (c-1)
  do p <- loop 0 c
     q <- readArray next p
     writeArray next p x
     writeArray next x q
  return ()

main = do
  n <- fmap read getLine
  pairs <- replicateM n $ do (name:ds:_) <- fmap words getLine; return (read ds, name)
  let sorted = sort pairs
  -- check
  if not $ all (\(i,(d,_)) -> d < i) (zip [(1::Int)..] sorted)
    then putStrLn "-1"
    else do next <- newArray (0,n) 0 :: IO (IOUArray Int Int)
            forM_ (zip [1..] sorted) $ \(i,(d,_)) -> add next i d
            vals <- newArray (0,n) 0 :: IO (IOUArray Int Int)
            let loop 0 v = return ()
                loop p v = do writeArray vals p v;
                              p' <- readArray next p
                              loop p' (v-1)
            h <- readArray next 0
            loop h n
            forM_ (zip [1..] sorted) $ \(i,(d,name)) -> do
              v <- readArray vals i
              putStrLn $ name ++ " " ++ show v

test = do
  next <- newArray (0,10) 0 :: IO (IOUArray Int Int)
  add next 1 0
  add next 2 0
  add next 3 0
  add next 4 0
  add next 5 2

  vals <- newArray (0,10) 0 :: IO (IOUArray Int Int)
  let loop 0 v = return ()
      loop p v = do writeArray vals p v;
                    p' <- readArray next p
                    loop p' (v-1)

  h <- readArray next 0
  loop h 10

  putStrLn "vals: "
  forM_ [0..10] $ \i -> do
    v <- readArray vals i
    putStr $ show v ++ " "
  putStrLn ""

import Data.Ord
import Data.List(sortBy,groupBy)
import Control.Applicative

main = do n <- read <$> getLine
          css <- mapM (\i -> getLine) [1..n]
          putStrLn $ unlines $ solve n $ sortBy (comparing snd) $ map ((\ [x,y] -> (x,read y)) . words) css

solve :: Int -> [(String,Int)] -> [String]
solve n xxs@(x:xs)
  | (any id $ zipWith (\i j -> (snd i) > j) xxs [0..]) = ["-1"]
  | otherwise = g $ zipWith f [n,(n-1)..] $ groupBy (\i j-> (snd i)==(snd j)) xxs

f :: Int -> [(String,Int)] -> [(String,Int)]
f n = map (\ (cs,i) -> ((cs ++ " " ++ (show n)),i))

g :: [[(String,Int)]] -> [String]
g [] = []
g xs = map fst $ h [] xs

h :: [(String,Int)] -> [[(String,Int)]] -> [(String,Int)]
h xs [] = xs
h [] (y:ys) = h y ys
h xs (y:ys) = h (xs1 ++ y ++ xs2) ys
   where i = snd $ head y
         (xs1,xs2) = splitAt i xs

import Data.Ord
import Data.List
g a 0 l=Just$a:l
g a i(h:t)=fmap(h:)$g a(i-1)t
g _ _ _=Nothing
f l(a,i)=l>>=g a i
p=unlines.map(\(i,(_,a))->a++" "++show i).sortBy(comparing$fst.snd).zip[1..].reverse
main=interact$maybe"-1"p.foldl f(Just[]).map(\(i,(a,n))->((i,a),n)).zip[1..].sortBy(comparing snd).map((\[a,n]->(a,read n)).words).tail.lines

import List
g a 0 l=[a:l]
g a i(h:t)=map(h:)$g a(i-1)t
g _ _ _=[]
f l((n,a),i)=l>>=g(i,a)n
z x=zip x[1..]
main=interact$last.("-1":).map(unlines.map(\((_,a),i)->a++" "++show i).sort.z.reverse).foldl f[[]].z.sort.map((\[a,n]->(read n,a)).words).tail.lines

import List
g a 0 l=[a:l]
g a i(h:t)=map(h:)$g a(i-1)t
g _ _ _=[]
f(i,(n,a))l=l>>=g(a++" "++show i)n
q[a,n]=(read n,a)
main=interact$unlines.last.(["-1"]:).foldr f[[]].zip[1..].reverse.sort.map(q.words).tail.lines

import Data.List(sortBy,groupBy)
import Control.Applicative

main = do n <- read <$> getLine
          css <- mapM (\i -> getLine) [1..n]
          putStrLn $ unlines $ solve n $ sortBy comp $ map ((\ (x:y:_) -> (x,read y)) . words) css

comp :: (String,Int) -> (String,Int) -> Ordering
comp x y = compare (snd x) (snd y)

solve :: Int -> [(String,Int)] -> [String]
solve n xxs@(x:xs)
  | snd x /= 0 = ["-1"]
  | null nzs = map (flip m 1) zs'
  | (length zs) < ((snd.head.last) $ nzss) = ["-1"]
  | otherwise = zipWith m (f zs nzss) [1..n]
   where (zs,nzs) = span ((0==).snd) xxs
         nzss = groupBy (\i j-> (snd i)==(snd j)) nzs
         zs' = map (\ (cs,i)-> (cs,pred i)) zs

f :: [(String,Int)] -> [[(String,Int)]] -> [(String,Int)]
f xs [] = xs
f [] ys = head ys
f xxs@(x:xs) (y:ys) = xs1 ++ y ++ (f xs2 ys')
   where n = snd $ head y
         (xs1,xs2) = splitAt n xxs
         ys' = map (map (\ (i,j)-> (i,j-n))) ys

m :: (String,Int) -> Int -> String
m (cs,i) j = if i == -1 then cs ++ " 2" else cs ++ " 1"

import Data.List(sortBy,groupBy)
import Control.Applicative

main = do n <- read <$> getLine
          css <- mapM (\i -> getLine) [1..n]
          putStrLn $ unlines $ solve n $ sortBy comp $ map ((\ (x:y:_) -> (x,read y)) . words) css

comp :: (String,Int) -> (String,Int) -> Ordering
comp x y = compare (snd x) (snd y)

solve :: Int -> [(String,Int)] -> [String]
solve n xxs@(x:xs)
  | snd x /= 0 = ["-1"]
  | null nzs = map (flip m 1) zs
  | (length zs) < ((snd.head.last) $ nzss) = ["-1"]
  | otherwise = zipWith m (f zs nzss) [1..n]
   where (zs,nzs) = span ((0==).snd) xxs
         nzss = groupBy (\i j-> (snd i)==(snd j)) nzs

f :: [(String,Int)] -> [[(String,Int)]] -> [(String,Int)]
f xs [] = xs
f [] ys = head ys
f xxs@(x:xs) (y:ys) = xs1 ++ y ++ (f xs2 ys')
   where n = snd $ head y
         (xs1,xs2) = splitAt n xxs
         ys' = map (map (\ (i,j)-> (i,j-n))) ys

m :: (String,Int) -> Int -> String
m (cs,i) j = if i == 0 then cs ++ " 2" else cs ++ " 1"

import Data.List(sortBy,groupBy)
import Control.Applicative

main = do n <- read <$> getLine
          css <- mapM (\i -> getLine) [1..n]
          putStrLn $ unlines $ solve n $ sortBy comp $ map ((\ (x:y:_) -> (x,read y)) . words) css

comp :: (String,Int) -> (String,Int) -> Ordering
comp x y = compare (snd x) (snd y)

solve :: Int -> [(String,Int)] -> [String]
solve n xxs@(x:xs)
  | snd x /= 0 = ["-1"]
  | null nzs = map (flip m 1) zs'
  | (length zs) < ((snd.head.last) $ nzss) = ["-1"]
  | otherwise = zipWith m (f zs' nzss) [1..n]
   where (zs,nzs) = span ((0==).snd) xxs
         nzss = groupBy (\i j-> (snd i)==(snd j)) nzs
         zs' = map (\ (cs,i)-> (cs,pred i)) zs

f :: [(String,Int)] -> [[(String,Int)]] -> [(String,Int)]
f xs [] = xs
f [] ys = head ys
f xxs@(x:xs) (y:ys) = xs1 ++ y ++ (f xs2 ys')
   where n = snd $ head y
         (xs1,xs2) = splitAt n xxs
         ys' = map (map (\ (i,j)-> (i,j-n))) ys

m :: (String,Int) -> Int -> String
m (cs,i) j = if i == -1 then cs ++ " 2" else cs ++ " 1"

import Data.List(sortBy,groupBy)
import Control.Applicative

main = do n <- read <$> getLine
          css <- mapM (\i -> getLine) [1..n]
          putStrLn $ unlines $ solve n $ sortBy comp $ map ((\ (x:y:_) -> (x,read y)) . words) css

comp :: (String,Int) -> (String,Int) -> Ordering
comp x y = compare (snd x) (snd y)

solve :: Int -> [(String,Int)] -> [String]
solve n xxs@(x:xs)
  | snd x /= 0 = ["-1"]
  | null nzs = map (flip m 1) zs'
  | (length zs) < ((snd.head.last) $ nzss) = ["-1"]
  | otherwise = zipWith m (f zs' nzss) [1..n]
   where (zs,nzs) = span ((0==).snd) xxs
         nzss = groupBy (\i j-> (snd i)==(snd j)) nzs
         zs' = map (\ (cs,i)-> (cs,pred i)) zs

f :: [(String,Int)] -> [[(String,Int)]] -> [(String,Int)]
f xs [] = xs
f [] ys = concat ys
f xxs@(x:xs) (y:ys) = xs1 ++ y ++ (f xs2 ys')
   where n = snd $ head y
         (xs1,xs2) = splitAt n xxs
         ys' = map (map (\ (i,j)-> (i,j-n))) ys

m :: (String,Int) -> Int -> String
m (cs,i) j = if i == -1 then cs ++ " 2" else cs ++ " 1"