A newspaper is published in Walrusland. Its heading is s1, it consists of lowercase Latin letters. Fangy the little walrus wants to buy several such newspapers, cut out their headings, glue them one to another in order to get one big string. After that walrus erase several letters from this string in order to get a new word s2. It is considered that when Fangy erases some letter, there's no whitespace formed instead of the letter. That is, the string remains unbroken and it still only consists of lowercase Latin letters.For example, the heading is "abc". If we take two such headings and glue them one to the other one, we get "abcabc". If we erase the letters on positions 1 and 5, we get a word "bcac".Which least number of newspaper headings s1 will Fangy need to glue them, erase several letters and get word s2?

The input data contain two lines. The first line contain the heading s1, the second line contains the word s2. The lines only consist of lowercase Latin letters (1 ≤ |s1| ≤ 104, 1 ≤ |s2| ≤ 106).

If it is impossible to get the word s2 in the above-described manner, print "-1" (without the quotes). Otherwise, print the least number of newspaper headings s1, which Fangy will need to receive the word s2.

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    a <- BS.unpack <$> readString
    b <- BS.unpack <$> readString
    return (a, b)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve :: (String, String) -> Int
solve (a, b) = go b (-1) 0
  where
    la = length a
    bnds = ((0, 'a'), (la, 'z'))

    arr = listArray (0, la-1) a :: UArray Int Char

    next :: (Int, Char) -> Int
    next = (cache!)
      where
        cache = listArray bnds $ map go $ range bnds :: Array (Int, Char) Int

        go (pos, _) | pos == la = -1
        go (pos, ch) | (arr ! pos) == ch = pos
        go (pos, ch) = next (pos + 1, ch)

    go [] _ steps = steps
    go (x:xs) (-1) steps
        | next (0, x) == -1 = -1
        | otherwise         = go (x:xs) 0 (steps + 1)
    go (x:xs) p steps
        | p > la || np == -1 = go (x:xs) (-1) steps
        | otherwise          = go xs (np + 1) steps
      where
        np = next (p, x)

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State


Sereja loves all sorts of algorithms. He has recently come up with a new algorithm, which receives a string as an input. Let's represent the input string of the algorithm as q = q1q2... qk. The algorithm consists of two steps:  Find any continuous subsequence (substring) of three characters of string q, which doesn't equal to either string "zyx", "xzy", "yxz". If q doesn't contain any such subsequence, terminate the algorithm, otherwise go to step 2.  Rearrange the letters of the found subsequence randomly and go to step 1. Sereja thinks that the algorithm works correctly on string q if there is a non-zero probability that the algorithm will be terminated. But if the algorithm anyway will work for infinitely long on a string, then we consider the algorithm to work incorrectly on this string.Sereja wants to test his algorithm. For that, he has string s = s1s2... sn, consisting of n characters. The boy conducts a series of m tests. As the i-th test, he sends substring slisli + 1... sri (1 ≤ li ≤ ri ≤ n) to the algorithm input. Unfortunately, the implementation of his algorithm works too long, so Sereja asked you to help. For each test (li, ri) determine if the algorithm works correctly on this test or not.

The first line contains non-empty string s, its length (n) doesn't exceed 105. It is guaranteed that string s only contains characters: 'x', 'y', 'z'. The second line contains integer m (1 ≤ m ≤ 105) — the number of tests. Next m lines contain the tests. The i-th line contains a pair of integers li, ri (1 ≤ li ≤ ri ≤ n).

For each test, print "YES" (without the quotes) if the algorithm works correctly on the corresponding test and "NO" (without the quotes) otherwise.

NoteIn the first example, in test one and two the algorithm will always be terminated in one step. In the fourth test you can get string "xzyx" on which the algorithm will terminate. In all other tests the algorithm doesn't work correctly.

import Control.Monad
import Control.Applicative

import Data.Maybe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B

readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)

main :: IO ()
main = do
    s <- getLine
    let n = length s
    let b2i b = if b then 1 else 0
    let xsum = listArray (0,n) $ scanl (+) 0 $ map (b2i.(=='x')) s
    let ysum = listArray (0,n) $ scanl (+) 0 $ map (b2i.(=='y')) s
    getLine
    qs <- map (l2p.map readInt.B.words) . B.lines <$> B.getContents
    forM_ qs $ \(l,r) ->
        putStrLn $ if query xsum ysum l r then "YES" else "NO"

query :: UArray Int Int -> UArray Int Int -> Int -> Int -> Bool
query xsum ysum l r | r - l + 1 < 3  = True
                    | otherwise =  maximum [x,y,z] - minimum [x,y,z] <= 1
    where
    x = xsum ! r - xsum ! (l-1)
    y = ysum ! r - ysum ! (l-1)
    z = r - l + 1 - x - y

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

main :: IO ()
main = do
    s <- getLine
    let d = initialize s
    m <- readLn
    replicateM_ m $ do
        (l,r) <-readIntPair
        putStrLn $ if query d l r then "YES" else "NO"

type Value = Int
data SegTree = Node Int Int Value SegTree SegTree | Leaf Int Value
    deriving(Show)

buildSegTree :: (Int,Int) -> [Int] -> SegTree
buildSegTree (l,r) s = go l r
    where
    a :: UArray Int Int
    a = listArray (l,r) s
    get (Node _ _ v _ _) = v
    get (Leaf _ v) = v
    go l r | l == r = Leaf l (a ! l)
           | otherwise = Node l r v t1 t2
        where
        m = div (l + r) 2
        t1 = go l m
        t2 = go (m+1) r
        v = get t1 + get t2

queryTree :: SegTree -> Int -> Int -> Int
queryTree tree ql qr = (go tree)
    where
    go (Leaf i v) | inRange (ql,qr) i = v | otherwise = 0
    go (Node l r v t1 t2)
        | ql <= l && r <= qr = v
        | qr < l || r < ql = 0
        | otherwise = go t1 + go t2

initialize :: String -> (Int,SegTree, SegTree)
initialize s = (n,xtree,ytree)
    where
    n = length s
    b2i b = if b then 1 else 0
    xtree = buildSegTree (1,n) (map (b2i.(=='x')) s)
    ytree = buildSegTree (1,n) (map (b2i.(=='y')) s)

query :: (Int,SegTree,SegTree) -> Int -> Int -> Bool
query (n,xtree,ytree) l r =  maximum [x,y,z] - minimum [x,y,z] <= 1
    where
    x = queryTree xtree l r
    y = queryTree ytree l r
    z = r - l + 1 - x - y


On Children's Day, the child got a toy from Delayyy as a present. However, the child is so naughty that he can't wait to destroy the toy.The toy consists of n parts and m ropes. Each rope links two parts, but every pair of parts is linked by at most one rope. To split the toy, the child must remove all its parts. The child can remove a single part at a time, and each remove consume an energy. Let's define an energy value of part i as vi. The child spend vf1 + vf2 + ... + vfk energy for removing part i where f1, f2, ..., fk are the parts that are directly connected to the i-th and haven't been removed.Help the child to find out, what is the minimum total energy he should spend to remove all n parts.

The first line contains two integers n and m (1 ≤ n ≤ 1000; 0 ≤ m ≤ 2000). The second line contains n integers: v1, v2, ..., vn (0 ≤ vi ≤ 105). Then followed m lines, each line contains two integers xi and yi, representing a rope from part xi to part yi (1 ≤ xi, yi ≤ n; xi ≠ yi). Consider all the parts are numbered from 1 to n.

Output the minimum total energy the child should spend to remove all n parts of the toy.

NoteOne of the optimal sequence of actions in the first sample is:  First, remove part 3, cost of the action is 20.  Then, remove part 2, cost of the action is 10.  Next, remove part 4, cost of the action is 10.  At last, remove part 1, cost of the action is 0. So the total energy the child paid is 20 + 10 + 10 + 0 = 40, which is the minimum.In the second sample, the child will spend 400 no matter in what order he will remove the parts.

convert_edges :: [Integer] -> [(Int, Int)] -> [(Int, Int)]
convert_edges weight edges =
  map (\(u, v) -> if (weight !! u > weight !! v) then (u, v) else (v, u)) edges

solve :: [Integer] -> [(Int, Int)] -> Integer
solve weight edges = iter $ convert_edges weight edges
  where
    iter :: [(Int, Int)] -> Integer
    iter rem
      | null rem = 0
      | otherwise = (weight !! (snd $ head rem)) + (iter $ tail rem)

main = do
  contents <- getContents
  let
    buf = lines contents
    [n, m] = map (read :: String -> Int) $ words $ head buf
    weight = -1:(map (read :: String -> Integer) $ words $ head $ tail buf)
    edges = map ((\[u, v] -> (u, v)) . (map (read :: String -> Int)) . words) (tail $ tail buf)
    in putStrLn $ show $ solve weight edges

{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import           Data.Foldable
import           Data.Function
import           Data.Functor
import           Data.Maybe
import           Data.Traversable
import           Text.Printf           (printf)

import           Prelude hiding (sum)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

-----

main :: IO ()
main = do
  [n, m] <- getInts
  vs <- listArray (1, n) <$> getInts :: IO (UArray Int Int)
  cs <- replicateM m $ do
    [f, t] <- getInts
    return $ min (vs!f) (vs!t)
  print $ sum cs

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

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

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

main = do
  [n, m] <- getInts
  vs <- getInts
  es <- replicateM m getInts

  let vsa = listArray (1, n) vs

  print $ sum $ map (\[u, v] -> min (vsa!u) (vsa!v)) es

-- Bartosz Bednarczyk

import Control.Monad

solve :: [Int] -> [ [Int] ] -> Int
solve xs ys = foldr (+) 0 $ map (\[x,y] -> min (xs !! (x-1)) (xs !! (y-1)) ) ys

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

main = do
  [n, m] <- readInts
  xs <- readInts
  ys <- replicateM (read (show m)) readInts
  putStrLn $ show $ solve xs ys


Little C loves number «3» very much. He loves all things about it.Now he has a positive integer $$$n$$$. He wants to split $$$n$$$ into $$$3$$$ positive integers $$$a,b,c$$$, such that $$$a+b+c=n$$$ and none of the $$$3$$$ integers is a multiple of $$$3$$$. Help him to find a solution.

A single line containing one integer $$$n$$$ ($$$3 \leq n \leq 10^9$$$) — the integer Little C has.

Print $$$3$$$ positive integers $$$a,b,c$$$ in a single line, such that $$$a+b+c=n$$$ and none of them is a multiple of $$$3$$$. It can be proved that there is at least one solution. If there are multiple solutions, print any of them.

{-# LANGUAGE Safe #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Control.Applicative
import Control.Arrow
import Data.List
import Data.Array
import Data.Array.IO.Safe
import Data.Array.ST.Safe
import Data.IORef
import Data.STRef
import Data.Maybe
import Data.Bits
import Data.Ord
import Data.Ratio
import Data.Int
import Data.Char
import qualified Data.IntMap as IM
import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as Set
import qualified Data.Sequence as Sq
import Data.Tuple
import Data.Function
import Text.Printf
--import Debug.Trace
import Numeric

readIntBS = fst . fromJust . BS.readInt

infixr 1 ?
(?) :: Bool -> (a,a) -> a
(?) b t = (if b then fst else snd) t

main = do
  n <- readLn :: IO Int

  printf "%d %d %d\n" (1::Int) (1+(if (n-2)`mod`3==0 then 1 else 0) :: Int) (n-2-(if (n-2)`mod`3==0 then 1 else 0))

main = do
       e1<-getLine
       let x=read e1::Integer
           a=1
           b= if (x-2) `mod` 3==0 then 2 else 1
           c=x-a-b
       putStrLn $ show(a)++" "++show(b)++" "++show(c)

import Control.Applicative
import Control.Monad

main = sol <$> readLn >>= put

put = putStrLn . unwords . fmap show

sol n
    | n `mod` 3==0  = [1,1,n-2]
    | otherwise     = [1,2,n-3]

split :: Int -> (Int, Int, Int)
split 3 = (1, 1, 1)
split x
    | x `mod` 3 == 0 = (1, 1, x - 2)
    | otherwise = (1, 2, x - 3)

main :: IO ()
main = do
    x <- (fmap read getLine) :: IO Int
    let (a, b, c) = split x
    putStrLn $ show a ++ " " ++ show b ++ " " ++ show c

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

process n | mod n 3 <2  = do
				putStr "1 1 "
				putStrLn $ show (n-2)
	  | otherwise  = do
				putStr "1 2 "
				putStrLn $ show (n-3)

main = do
	n<- read <$> getLine ::IO Int
	process n

main = do
    n <- readLn :: IO Integer
    putStrLn $ solve n

solve :: Integer -> String
solve n
 | mod (n-2) 3 > 0 = "1 1 " ++ show (n-2)
 | otherwise = "1 2 " ++ show (n-3)

main = do
  n <- read `fmap` getLine :: IO Integer
  putStrLn $ foldl (++) "" $ map ((++ " ") . show) $ solve n

solve :: Integer -> [Integer]
solve n
  | (n - 2) `mod` 3 /= 0 = [n-2, 1, 1]
  | otherwise = [n-3, 1, 2]

process :: Int -> (Int, Int, Int)
process n
    | m == 0 = (1,1,n-2)
    | otherwise = (1,2,n-3)
    where m = n `mod` 3

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    let (a,b,c) = process n
    putStrLn (show a ++ " " ++ show b ++ " " ++ show c)

main = do
       e1<-getLine
       let x=read e1::Int
           a=(x `div` 3)
           b=a
           c=x-a-b
       putStrLn $ show(a)++" "++show(b)++" "++show(c)

import Control.Applicative
import Control.Monad

main = sol <$> readLn >>= put

put = putStrLn . unwords . fmap show

sol n = [m,m,n-2*m] where m = n `div` 3

main = interact $ unwords . map show . solve . read
solve n = case d `mod` 3 of
            0 -> [d+2,d-1,d-1]
            1 -> [d,d,d+1]
            2 -> [d,d,d+2]
  where d = n `div` 3

main = do
  n <- read `fmap` getLine :: IO Integer
  putStrLn $ foldl (++) "" $ map ((++ " ") . show) $ solve n

solve :: Integer -> [Integer]
solve n
  | (n - 2 `mod` 3) /= 0 = [n-2, 1, 1]
  | otherwise = [n-3, 1, 2]

main = do
  n <- read `fmap` getLine :: IO Integer
  putStrLn $ foldl (++) "" $ map ((++ " ") . show) $ solve n

solve :: Integer -> [Integer]
solve n
  | n - 2 `mod` 3 /= 0 = [n-2, 1, 1]
  | otherwise = [n-3, 1, 2]


You are given a sequence $$$a_1, a_2, \dots, a_n$$$, consisting of integers.You can apply the following operation to this sequence: choose some integer $$$x$$$ and move all elements equal to $$$x$$$ either to the beginning, or to the end of $$$a$$$. Note that you have to move all these elements in one direction in one operation.For example, if $$$a = [2, 1, 3, 1, 1, 3, 2]$$$, you can get the following sequences in one operation (for convenience, denote elements equal to $$$x$$$ as $$$x$$$-elements):   $$$[1, 1, 1, 2, 3, 3, 2]$$$ if you move all $$$1$$$-elements to the beginning;  $$$[2, 3, 3, 2, 1, 1, 1]$$$ if you move all $$$1$$$-elements to the end;  $$$[2, 2, 1, 3, 1, 1, 3]$$$ if you move all $$$2$$$-elements to the beginning;  $$$[1, 3, 1, 1, 3, 2, 2]$$$ if you move all $$$2$$$-elements to the end;  $$$[3, 3, 2, 1, 1, 1, 2]$$$ if you move all $$$3$$$-elements to the beginning;  $$$[2, 1, 1, 1, 2, 3, 3]$$$ if you move all $$$3$$$-elements to the end; You have to determine the minimum number of such operations so that the sequence $$$a$$$ becomes sorted in non-descending order. Non-descending order means that for all $$$i$$$ from $$$2$$$ to $$$n$$$, the condition $$$a_{i-1} \le a_i$$$ is satisfied.Note that you have to answer $$$q$$$ independent queries.

The first line contains one integer $$$q$$$ ($$$1 \le q \le 3 \cdot 10^5$$$) — the number of the queries. Each query is represented by two consecutive lines. The first line of each query contains one integer $$$n$$$ ($$$1 \le n \le 3 \cdot 10^5$$$) — the number of elements. The second line of each query contains $$$n$$$ integers $$$a_1, a_2, \dots , a_n$$$ ($$$1 \le a_i \le n$$$) — the elements. It is guaranteed that the sum of all $$$n$$$ does not exceed $$$3 \cdot 10^5$$$.

For each query print one integer — the minimum number of operation for sorting sequence $$$a$$$ in non-descending order.

NoteIn the first query, you can move all $$$1$$$-elements to the beginning (after that sequence turn into $$$[1, 1, 1, 3, 6, 6, 3]$$$) and then move all $$$6$$$-elements to the end.In the second query, the sequence is sorted initially, so the answer is zero.In the third query, you have to move all $$$2$$$-elements to the beginning.

import Data.List
import Control.Monad
import qualified Data.IntMap.Strict as M

main = do
  q <- readLn
  replicateM_ q $ do
    getLine -- n
    as <- map read . words <$> getLine
    let maxInd = M.fromListWith max $ zip as [0..]
        minInd = M.fromListWith min $ zip as [0..]
        t = M.size maxInd
        ss = M.keys maxInd
    let d = maximum $ (0 :) $ map length $ filter head $ group $
            zipWith (<) (map (maxInd M.!) ss)
                        (tail $ map (minInd M.!) ss)
    print $ t - d - 1

import Data.List
import Control.Monad
import Control.Arrow
import qualified Data.IntSet as S

main = do
  q <- readLn
  replicateM_ q $ do
    getLine -- n <- readLn
    as <- map read . words <$> getLine
    let rs = reverse as
    let value s = min (S.size (S.union il cr) + S.size ir)
                      (S.size (S.union ir cl) + S.size il) where
          (il,cl) = second (snd . S.split (s-1)) $ inversions (< s) hasHigher as
          (ir,cr) = second (fst . S.split s) $ inversions (>= s) hasLower rs
          inversions p check = fst . foldl' f ((S.empty,S.empty),S.empty) where
            f ((is,cr),cl) n | p n       = ((is',cl),cl')
                             | otherwise = ((is ,cr),cl')
              where cl' = S.insert n cl
                    is' | check cl n = S.insert n is
                        | otherwise = is
          hasHigher s n = not $ S.null $ snd $ S.split n s
          hasLower s n = not $ S.null $ fst $ S.split n s
    let tsearch f = go where
          go lo hi
            | delta < 1 = minimum (map f [lo..hi])
            | f m1 > f m2 = go m1 hi
            | otherwise = go lo m2
            where delta = (hi-lo) `div` 3
                  m1 = lo + delta
                  m2 = hi - delta
    print $ tsearch value (minimum as) (maximum as)

import Data.List
import Control.Monad
import qualified Data.IntMap.Strict as M

main = do
  q <- readLn
  replicateM_ q $ do
    getLine -- n
    as <- map read . words <$> getLine
    let maxInd = M.fromListWith max $ zip as [0..]
        minInd = M.fromListWith min $ zip as [0..]
        t = M.size maxInd
        ss = M.keys maxInd
    let d = maximum $ (0 :) $ map length $ filter head $ group $ filter id $
            zipWith (<) (map (maxInd M.!) ss)
                        (tail $ map (minInd M.!) ss)
    print $ t - d - 1


Misha hacked the Codeforces site. Then he decided to let all the users change their handles. A user can now change his handle any number of times. But each new handle must not be equal to any handle that is already used or that was used at some point.Misha has a list of handle change requests. After completing the requests he wants to understand the relation between the original and the new handles of the users. Help him to do that.

The first line contains integer q (1 ≤ q ≤ 1000), the number of handle change requests. Next q lines contain the descriptions of the requests, one per line. Each query consists of two non-empty strings old and new, separated by a space. The strings consist of lowercase and uppercase Latin letters and digits. Strings old and new are distinct. The lengths of the strings do not exceed 20. The requests are given chronologically. In other words, by the moment of a query there is a single person with handle old, and handle new is not used and has not been used by anyone.

In the first line output the integer n — the number of users that changed their handles at least once. In the next n lines print the mapping between the old and the new handles of the users. Each of them must contain two strings, old and new, separated by a space, meaning that before the user had handle old, and after all the requests are completed, his handle is new. You may output lines in any order. Each user who changes the handle must occur exactly once in this description.

5
Misha ILoveCodeforces
Vasya Petrov
Petrov VasyaPetrov123
ILoveCodeforces MikeMirzayanov
Petya Ivanov

3
Petya Ivanov
Misha MikeMirzayanov
Vasya VasyaPetrov123

import qualified Data.Set as Set
import qualified Data.Map as Map
import Control.Applicative

main = getContents >>= putStrLn . solve . tail . words

solve :: [String] -> String
solve rs = unlines $ [show $ Set.size s] ++ [upwrap (Map.lookup x m) ++ " " ++ x | x <- Set.toList s]
    where (s, m) = solve' $ reverse rs
          upwrap (Just x) = x

solve' :: [String] -> (Set.Set String, Map.Map String String)
solve' [] = (Set.empty, Map.empty)
solve' (y:x:rs) = (s', m')
    where (s, m) = solve' rs
          s' = Set.delete x . Set.insert y $ s
          m' = case Map.lookup x m of
            Nothing -> Map.insert y x m
            Just z -> Map.insert y z m
solve' _ = (Set.fromList ["a","b"], Map.fromList [("a","A"), ("b","B")])

main = interact $ f [] . tail . words
f m (a:b:c) = f (g m a b) c
f m _ = unlines $ (show $ length m) : map unwords m
g ([m,n]:o) a b | n == a = [m,b]:o | otherwise = [m,n]:g o a b
g _ a b = [[a,b]]

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  getLine >>= \n -> (mapM_ C.putStrLn).solve =<< (forM [1..read n] $ \ i ->C.getLine>>= \js -> let [a,b] = C.words js in return $ (a,b) )
solve xs = let ms=slv1 (Map.empty) xs in  [(C.pack $ show $ Map.size ms)] ++map (\(a,b)-> C.unwords [b, a]) (Map.toList ms)
slv1 ms [] = ms
slv1 ms ((x1,x2):xs) = slv1 fm xs
  where
  fm= let m =  Map.lookup x1 ms in if m == Nothing then Map.insert x2 x1 ms else  Map.delete x1 $ Map.insert x2 (fromJust m) ms

import qualified Data.Map.Strict as M
import Control.Applicative
import Control.Monad
import Data.List

main = do
    n <- readLn :: IO Int
    ns <- replicateM n ( words <$> getLine )
    let as = foldl' (\acc [k,v] ->  let b = M.filter (==k) acc
                                    in if b == M.empty
                                        then M.insert k v acc
                                        else let (e,f) = head $ M.toList b in M.alter (\_ -> Just v) e acc
                                    ) M.empty ns
    print $ M.size as
    mapM_ (putStrLn . uncurry (\a b -> a ++ " " ++ b)) $ M.toList  as

import Data.List (foldl')
import qualified Data.Map as M

main :: IO ()
main = getContents >>= printSolution . solve . map words . tail . lines

solve :: [[String]] -> [[String]]
solve = map (\(b, a) -> [a, b]) . M.toList . foldl' (\m [a, b] -> M.insert b (M.findWithDefault a a m) $ M.delete a m) M.empty

printSolution :: [[String]] -> IO ()
printSolution xs = print (length xs) >> mapM_ (putStrLn . unwords) xs

import Data.List (foldl')
import qualified Data.Map as M

main :: IO ()
main = getContents >>= printSolution . solve . map (toTuple . words) . tail . lines

solve :: [(String, String)] -> [(String, String)]
solve = M.toList . foldl' (\m (a, b) -> M.insert b (M.findWithDefault a a m) $ M.delete a m) M.empty

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

printSolution :: [(String, String)] -> IO ()
printSolution xs = print (length xs) >> mapM_ (\(a, b) -> putStrLn $ b ++ " " ++ a) xs


Ayush is a cashier at the shopping center. Recently his department has started a ''click and collect" service which allows users to shop online. The store contains k items. n customers have already used the above service. Each user paid for m items. Let aij denote the j-th item in the i-th person's order.Due to the space limitations all the items are arranged in one single row. When Ayush receives the i-th order he will find one by one all the items aij (1 ≤ j ≤ m) in the row. Let pos(x) denote the position of the item x in the row at the moment of its collection. Then Ayush takes time equal to pos(ai1) + pos(ai2) + ... + pos(aim) for the i-th customer.When Ayush accesses the x-th element he keeps a new stock in the front of the row and takes away the x-th element. Thus the values are updating.Your task is to calculate the total time it takes for Ayush to process all the orders.You can assume that the market has endless stock.

The first line contains three integers n, m and k (1 ≤ n, k ≤ 100, 1 ≤ m ≤ k) — the number of users, the number of items each user wants to buy and the total number of items at the market. The next line contains k distinct integers pl (1 ≤ pl ≤ k) denoting the initial positions of the items in the store. The items are numbered with integers from 1 to k. Each of the next n lines contains m distinct integers aij (1 ≤ aij ≤ k) — the order of the i-th person.

Print the only integer t — the total time needed for Ayush to process all the orders.

NoteCustomer 1 wants the items 1 and 5.pos(1) = 3, so the new positions are: [1, 3, 4, 2, 5].pos(5) = 5, so the new positions are: [5, 1, 3, 4, 2].Time taken for the first customer is 3 + 5 = 8.Customer 2 wants the items 3 and 1.pos(3) = 3, so the new positions are: [3, 5, 1, 4, 2].pos(1) = 3, so the new positions are: [1, 3, 5, 4, 2].Time taken for the second customer is 3 + 3 = 6.Total time is 8 + 6 = 14.Formally pos(x) is the index of x in the current row.

import Control.Monad
import Control.Applicative
import Data.List (delete)

findPos (x:xs) v ind
  | x == v = ind
  | otherwise = findPos xs v (ind+1)

buy xs v = (cost+1,xs')
  where
    cost = findPos xs v 0
    xs' = v : delete v xs

process [] _ total = total
process (o:orders) xs total = process orders xs' (total+cost)
  where
    (cost, xs') = buy xs o

main = do
  [n,m,k] <- map read . words <$> getLine :: IO [Int]
  xs <- map read . words <$> getLine :: IO [Int]

  aa <- replicateM n getLine
  let orders = map read $ concat $ map words aa :: [Int]

  print $ process orders xs 0

import Data.List (elemIndex, delete)
solve :: [Int] -> [Int] -> Int
solve _ [] = 0
solve xs (q:qs) = pos + solve (q : delete q xs) qs
    where pos = case elemIndex q xs of Just p -> p + 1
main = do
    getLine
    row <- getLine
    queries <- getContents
    putStrLn . show $ solve (norm row) (norm queries)
    where norm = map read . words

import Data.List (elemIndex, delete)
access :: (Int, ([Int], [Int])) -> (Int, ([Int], [Int]))
access (res, (row, (q:qs))) = (res + pos, (q : (delete q row), qs))
    where pos = case elemIndex q row of Just x -> x + 1
solve :: [Int] -> [Int] -> Int
solve rs xs = fst . until (null . snd . snd) access $ (0, (rs, xs))
norm = map read . words
main = do
    getLine
    row <- getLine
    queries <- getContents
    putStrLn . show $ solve (norm row) (norm queries)


Black is gifted with a Divine array $$$a$$$ consisting of $$$n$$$ ($$$1 \le n \le 2000$$$) integers. Each position in $$$a$$$ has an initial value. After shouting a curse over the array, it becomes angry and starts an unstoppable transformation.The transformation consists of infinite steps. Array $$$a$$$ changes at the $$$i$$$-th step in the following way: for every position $$$j$$$, $$$a_j$$$ becomes equal to the number of occurrences of $$$a_j$$$ in $$$a$$$ before starting this step.Here is an example to help you understand the process better:  Initial array:$$$2$$$ $$$1$$$ $$$1$$$ $$$4$$$ $$$3$$$ $$$1$$$ $$$2$$$After the $$$1$$$-st step:$$$2$$$ $$$3$$$ $$$3$$$ $$$1$$$ $$$1$$$ $$$3$$$ $$$2$$$After the $$$2$$$-nd step:$$$2$$$ $$$3$$$ $$$3$$$ $$$2$$$ $$$2$$$ $$$3$$$ $$$2$$$After the $$$3$$$-rd step:$$$4$$$ $$$3$$$ $$$3$$$ $$$4$$$ $$$4$$$ $$$3$$$ $$$4$$$...... In the initial array, we had two $$$2$$$-s, three $$$1$$$-s, only one $$$4$$$ and only one $$$3$$$, so after the first step, each element became equal to the number of its occurrences in the initial array: all twos changed to $$$2$$$, all ones changed to $$$3$$$, four changed to $$$1$$$ and three changed to $$$1$$$.The transformation steps continue forever.You have to process $$$q$$$ queries: in each query, Black is curious to know the value of $$$a_x$$$ after the $$$k$$$-th step of transformation.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1000$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \le n \le 2000$$$) — the size of the array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$) — the initial values of array $$$a$$$. The third line of each test case contains a single integer $$$q$$$ ($$$1 \le q \le 100\,000$$$) — the number of queries. Next $$$q$$$ lines contain the information about queries — one query per line. The $$$i$$$-th line contains two integers $$$x_i$$$ and $$$k_i$$$ ($$$1 \le x_i \le n$$$; $$$0 \le k_i \le 10^9$$$), meaning that Black is asking for the value of $$$a_{x_i}$$$ after the $$$k_i$$$-th step of transformation. $$$k_i = 0$$$ means that Black is interested in values of the initial array. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2000$$$ and the sum of $$$q$$$ over all test cases doesn't exceed $$$100\,000$$$.

For each test case, print $$$q$$$ answers. The $$$i$$$-th of them should be the value of $$$a_{x_i}$$$ after the $$$k_i$$$-th step of transformation. It can be shown that the answer to each query is unique.

import Prelude hiding (lookup)
import Data.Char
import Data.List hiding (lookup)
import Data.Map (fromList, insertWith, lookup)
import System.IO

fromJust :: Maybe a -> a
fromJust (Just a) = a
fromJust _ = undefined

getWord' :: String -> IO (String)
getWord' "" = do ch <- getChar ; eof <- isEOF
                 if eof then return "" else if isSpace ch then getWord' "" else getWord' [ch]
getWord' chs = do ch <- getChar ; eof <- isEOF
                  if eof then return chs else if isSpace ch then return chs else getWord' (chs ++ [ch])

getWord = getWord' ""

getInt :: IO (Int)
getInt = fmap read getWord

getInts' 0 acc = return acc
getInts' n acc = do x <- getInt ; getInts' (n-1) (acc ++ [x])

getInts :: Int -> IO ([Int])
getInts n = getInts' n []

-- SOLUTION

count xs = foldl f (fromList []) xs
           where f acc x = insertWith (+) x 1 acc

iter xs = map f xs
          where f x = fromJust (lookup x (count xs))

data Query = Query {
      posQuery :: Int
    , kQuery :: Int
    , idxQuery :: Int
    } deriving (Show)

type QResult = (Query, Int)

getQuery i n xs | i == n = return xs
getQuery i n xs = do
    idx <- getInt
    k <- getInt
    getQuery (i+1) n (xs ++ [Query i k (idx-1)])

getQueries = do
    q <- getInt
    getQuery 0 q []

sortQueries qs f = sortBy compareQueries qs
                 where compareQueries a b = compare (f a) (f b)
sortByK qs = sortQueries qs kQuery

sortResults qs = sortBy f qs
                 where f (a, _) (b, _) = compare (posQuery a) (posQuery b)

calcQueries :: [Query] -> [Int] -> Int -> Int -> [QResult] -> [QResult]
calcQueries [] _ _ _ res = res
calcQueries (q:qs) xs k n res
    | (k == (kQuery q)) || (k >= n) = calcQueries qs xs k n (res ++ [(q, xs !! (idxQuery q))])
calcQueries qs xs k n res = calcQueries qs (iter xs) (k+1) n res

putRes :: QResult -> IO ()
putRes res = do putStrLn (show (snd res))

forEach :: [a] -> (a -> IO ()) -> IO ()
forEach [] _ = return ()
forEach (x:xs) a = do a x; forEach xs a

--2
isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

maxK n = 2 * (isqrt (2*n))

iterNums :: [[Int]] -> Int -> [[Int]]
iterNums rs target | ((length rs)-1) < target = iterNums (rs ++ [iter (last rs)]) target
iterNums rs target = rs

getRes :: [[Int]] -> Int -> Int -> Int
getRes rs idx k = (rs !! k) !! (idx-1)

doQuery :: [[Int]] -> Int -> Int -> IO ()
doQuery _ _ 0 = return ()
doQuery rs mK i = do
    idx <- getInt
    k <- getInt
    let nk = min k mK
    let nrs = iterNums rs nk
    putStrLn (show (getRes nrs idx nk))
    doQuery nrs mK (i-1)

loop :: IO () -> Int -> IO ()
loop a 0 = return ()
loop a n = do a; loop a (n-1)

doTests 0 = return ()
doTests t = do
    n <- getInt
    nums <- getInts n
    q <- getInt
    doQuery [nums] (maxK n) q
    doTests (t-1)

main = do t <- getInt ; doTests t

import Control.Monad (forM_)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntMap as Map
import Data.List (sort)
import Data.Maybe (fromJust)

main = do
  t <- readInt <$> BS.getLine
  forM_ [1 .. t] $ \_ -> do
    _ <- BS.getLine
    xs <- map readInt . BS8.words <$> BS.getLine
    let xss = solve xs
    let lxss = length xss - 1
    q <- readInt <$> BS.getLine
    forM_ [1 .. q] $ \_ -> do
      [xi, ki] <- map readInt . BS8.words <$> BS.getLine
      print $ (xss !! min lxss ki) !! (xi - 1)

solve :: [Int] -> [[Int]]
solve xs = do
  let freq = foldl (\m x -> Map.insertWith (+) x 1 m) Map.empty xs
  let xs' = map (\x -> fromJust (Map.lookup x freq)) xs
  if xs == xs' then [xs] else xs : solve xs'

readInt = fst . fromJust . BS8.readInt

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

type PII = (Int, Int)

data TC = TC {n :: Int, as :: [Int], qs :: [PII]}

input :: Scanner TC
input = do
  n <- int
  as <- n >< int
  qs <- numberOf (pair int int)
  return TC {..}

type Output = [Int]

output :: Output -> C.ByteString
output = map showB >>> C.unlines

type VI = UArray Int Int

solve :: TC -> Output
solve TC {..} = map query qs
  where
    it = 12
    ls = take it $ iterate step as

    query (x, k) = ls !! min k (it - 1) !! (x - 1)

    step :: [Int] -> [Int]
    step ai = map (fs !) ai
      where
        fs :: VI
        fs = accumArray (+) 0 (1, n) $ map (,1) ai

    is = 0

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

import Prelude hiding (lookup)
import Data.Char
import Data.List hiding (lookup)
import Data.Map (fromList, insertWith, lookup)
import System.IO

fromJust :: Maybe a -> a
fromJust (Just a) = a
fromJust _ = undefined

getWord' :: String -> IO (String)
getWord' "" = do ch <- getChar ; eof <- isEOF
                 if eof then return "" else if isSpace ch then getWord' "" else getWord' [ch]
getWord' chs = do ch <- getChar ; eof <- isEOF
                  if eof then return chs else if isSpace ch then return chs else getWord' (chs ++ [ch])

getWord = getWord' ""

getInt :: IO (Int)
getInt = fmap read getWord

getInts' 0 acc = return acc
getInts' n acc = do x <- getInt ; getInts' (n-1) (acc ++ [x])

getInts :: Int -> IO ([Int])
getInts n = getInts' n []

-- SOLUTION

count xs = foldl f (fromList []) xs
           where f acc x = insertWith (+) x 1 acc

iter xs = map f xs
          where f x = fromJust (lookup x (count xs))

data Query = Query {
      posQuery :: Int
    , kQuery :: Int
    , idxQuery :: Int
    } deriving (Show)

type QResult = (Query, Int)

getQuery i n xs | i == n = return xs
getQuery i n xs = do
    idx <- getInt
    k <- getInt
    getQuery (i+1) n (xs ++ [Query i k (idx-1)])

getQueries = do
    q <- getInt
    getQuery 0 q []

sortQueries qs f = sortBy compareQueries qs
                 where compareQueries a b = compare (f a) (f b)
sortByK qs = sortQueries qs kQuery

sortResults qs = sortBy f qs
                 where f (a, _) (b, _) = compare (posQuery a) (posQuery b)

calcQueries :: [Query] -> [Int] -> Int -> Int -> [QResult] -> [QResult]
calcQueries [] _ _ _ res = res
calcQueries (q:qs) xs k n res
    | (k == (kQuery q)) || (k >= n) = calcQueries qs xs k n (res ++ [(q, xs !! (idxQuery q))])
calcQueries qs xs k n res = calcQueries qs (iter xs) (k+1) n res

putRes :: QResult -> IO ()
putRes res = do putStrLn (show (snd res))

forEach :: [a] -> (a -> IO ()) -> IO ()
forEach [] _ = return ()
forEach (x:xs) a = do a x; forEach xs a

--2
isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

maxK n = 2 * (isqrt (2*n))

iterNums :: [[Int]] -> Int -> [[Int]]
iterNums rs target | ((length rs)-1) < target = iterNums (rs ++ [iter (head rs)]) target
iterNums rs target = rs

getRes :: [[Int]] -> Int -> Int -> Int
getRes rs idx k = (rs !! k) !! (idx-1) where l = length rs

doQuery :: [[Int]] -> Int -> Int -> IO ()
doQuery _ _ 0 = return ()
doQuery rs mK i = do
    idx <- getInt
    k <- getInt
    let nk = min k mK
    let nrs = iterNums rs nk
    putStrLn (show (getRes nrs idx nk))
    doQuery nrs mK (i-1)

loop :: IO () -> Int -> IO ()
loop a 0 = return ()
loop a n = do a; loop a (n-1)

doTests 0 = return ()
doTests t = do
    n <- getInt
    nums <- getInts n
    q <- getInt
    doQuery [nums] (maxK n) q
    doTests (t-1)

main = do t <- getInt ; doTests t

import Control.Monad (forM_)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntMap as Map
import Data.List (sort)
import Data.Maybe (fromJust)

main = do
  t <- readInt <$> BS.getLine
  forM_ [1 .. t] $ \_ -> do
    _ <- BS.getLine
    xs <- map readInt . BS8.words <$> BS.getLine
    let xss = solve xs
    let lxss = length xss - 1
    q <- readInt <$> BS.getLine
    forM_ [1 .. q] $ \_ -> do
      [xi, ki] <- map readInt . BS8.words <$> BS.getLine
      print $ (xss !! min lxss ki) !! (xi - 1)

solve :: [Int] -> [[Int]]
solve xs = do
  let freq = foldl (\m x -> Map.insertWith (+) x 1 m) Map.empty xs
  let xs' = map (\x -> fromJust (Map.lookup x freq)) xs
  if xs == xs' then [] else xs' : solve xs'

readInt = fst . fromJust . BS8.readInt