--
{-# 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 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

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


{-# 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

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


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

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 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 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
  print result


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

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 )


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

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

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


{-# 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

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


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

{-# 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

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


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

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.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"